From 8e93cd91d736e25daa296177883424feecabaaaa Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Wed, 8 Dec 1993 19:30:58 +0000 Subject: [PATCH] Several changes: - Closures are allocated differently: the compiler prepares a pattern, the linker finalizes it, the garbage collector relocates it, and the pattern is copied at runtime to make a new closure. - Tighten up the closure code: eliminate the privilege-bit-clearing instruction, and share the closure gc stubs between all the closures in a block. - Add a code segment facility to the linearizer. - Add a padding facility to the assembler. - Compiled code blocks are now aligned to floating-point boundaries so that they can contain embedded floating-point values and closure patterns can be copied using floating-point loads and stores. - Floating-point constants are now embedded in the code area, requiring fewer operations. --- v7/src/compiler/back/linear.scm | 88 ++++++++++++++++++++++++++++----- 1 file changed, 76 insertions(+), 12 deletions(-) diff --git a/v7/src/compiler/back/linear.scm b/v7/src/compiler/back/linear.scm index 3bb7e613b..af8f1253d 100644 --- a/v7/src/compiler/back/linear.scm +++ b/v7/src/compiler/back/linear.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: linear.scm,v 4.15 1992/10/19 19:14:03 jinx Exp $ +$Id: linear.scm,v 4.16 1993/12/08 19:30:58 gjr Exp $ -Copyright (c) 1987-1992 Massachusetts Institute of Technology +Copyright (c) 1987-1993 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -185,24 +185,88 @@ MIT in each case. |# (linearize-bblock bblock)) +(define-integrable (set-current-branches! consequent alternative) + (set-pblock-consequent-lap-generator! *current-bblock* consequent) + (set-pblock-alternative-lap-generator! *current-bblock* alternative)) + (define *end-of-block-code*) +(define-structure (extra-code-block + (conc-name extra-code-block/) + (constructor extra-code-block/make + (name constraint xtra))) + (name false read-only true) + (constraint false read-only true) + (code (LAP) read-only false) + (xtra false read-only false)) + (define linearize-lap (make-linearizer bblock-linearize-lap (lambda () (LAP)) (lambda (x y) (LAP ,@x ,@y)) (lambda (linearized-lap) (let ((end-code *end-of-block-code*)) - (set! *end-of-block-code* (LAP)) + (set! *end-of-block-code* '()) (LAP ,@linearized-lap - ,@end-code))))) + ,@(let process ((end-code end-code)) + (if (null? end-code) + (LAP) + (LAP ,@(extra-code-block/code (car end-code)) + ,@(process (cdr end-code)))))))))) -(define (add-end-of-block-code! code-thunk) - (set! *end-of-block-code* - (LAP ,@*end-of-block-code* - ,@(code-thunk))) - 'done) +(define (find-extra-code-block name) + (let loop ((end-code *end-of-block-code*)) + (cond ((null? end-code) false) + ((eq? name (extra-code-block/name (car end-code))) + (car end-code)) + (else + (loop (cdr end-code)))))) + +(define (declare-extra-code-block! name constraint xtra) + (if (find-extra-code-block name) + (error "declare-extra-code-block!: Multiply defined block" + name) + (let ((new (extra-code-block/make name constraint xtra)) + (all *end-of-block-code*)) -(define-integrable (set-current-branches! consequent alternative) - (set-pblock-consequent-lap-generator! *current-bblock* consequent) - (set-pblock-alternative-lap-generator! *current-bblock* alternative)) \ No newline at end of file + (define (constraint-violation new old) + (error "declare-extra-code-block!: Inconsistent constraints" + new old)) + + (case constraint + ((FIRST) + (if (and (not (null? all)) + (eq? 'FIRST + (extra-code-block/constraint (car all)))) + (constraint-violation new (car all))) + (set! *end-of-block-code* (cons new all))) + ((ANYWHERE) + (if (or (null? all) + (not (eq? 'FIRST + (extra-code-block/constraint (car all))))) + (set! *end-of-block-code* (cons new all)) + (set-cdr! all (cons new (cdr all))))) + ((LAST) + (if (null? all) + (set! *end-of-block-code* (list new)) + (let* ((lp (last-pair all)) + (old (car lp))) + (if (eq? 'LAST (extra-code-block/constraint old)) + (constraint-violation new old)) + (set-cdr! lp (cons new '()))))) + (else + (error "declare-extra-code-block!: Unknown constraint" + constraint))) + new))) + +(define (add-extra-code! block new-code) + (set-extra-code-block/code! + block + (LAP ,@(extra-code-block/code block) + ,@new-code))) + +(define (add-end-of-block-code! code-thunk) + (add-extra-code! + (or (find-extra-code-block 'END-OF-BLOCK) + (declare-extra-code-block! 'END-OF-BLOCK 'ANYWHERE false)) + (code-thunk))) \ No newline at end of file -- 2.25.1