From 01bd9b953749bccd7d9d36ceb834345f64e71239 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 15 Feb 1991 00:25:17 +0000 Subject: [PATCH] Eliminate syntax phase for assembly since assembler now directly accepts LAP. --- v7/src/compiler/etc/asm.scm | 76 +++++++++++-------------------------- v8/src/compiler/etc/asm.scm | 76 +++++++++++-------------------------- 2 files changed, 44 insertions(+), 108 deletions(-) diff --git a/v7/src/compiler/etc/asm.scm b/v7/src/compiler/etc/asm.scm index de2918616..6e321bd8b 100644 --- a/v7/src/compiler/etc/asm.scm +++ b/v7/src/compiler/etc/asm.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/etc/asm.scm,v 1.1 1989/11/30 15:54:29 jinx Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/etc/asm.scm,v 1.2 1991/02/15 00:25:17 cph Exp $ -Copyright (c) 1989 Massachusetts Institute of Technology +Copyright (c) 1989-91 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -38,56 +38,11 @@ MIT in each case. |# ;; To be loaded in (compiler top-level) -(define *lap*) - -(define (syntax-lap lap) - (define (phase-1 lap accum) - (if (null? lap) - (phase-2 accum empty-instruction-sequence) - (phase-1 (cdr lap) - (cons (lap:syntax-instruction (car lap)) - accum)))) - (define (phase-2 lap accum) - (if (null? lap) - accum - (phase-2 (cdr lap) - (append-instruction-sequences! - (car lap) - accum)))) - (phase-1 lap '())) - -(define (phase/syntax-lap) - (compiler-phase - "Syntax Lap" - (lambda () - (set! *bits* - (append-instruction-sequences! - (lap:make-entry-point *entry-label* *block-label*) - (syntax-lap *lap*)))))) - -(define (lap->code label lap) - (in-compiler - (lambda () - (fluid-let ((*lap* lap)) - (set! *entry-label* label) - (set! *current-label-number* 0) - (set! *next-constant* 0) - (set! *interned-constants* '()) - (set! *interned-variables* '()) - (set! *interned-assignments* '()) - (set! *interned-uuo-links* '()) - (set! *block-label* (generate-label)) - (set! *external-labels* '()) - (set! *ic-procedure-headers* '()) - (phase/syntax-lap) - (phase/assemble) - (phase/link) - *result*)))) - -#| -;;;; Example of usage +;;; Example of `lap->code' usage: (define bar + ;; defines bar to be a procedure that adds 1 to its argument + ;; with no type or range checks. (scode-eval (lap->code 'start @@ -106,7 +61,20 @@ MIT in each case. |# (rts))) '())) -;; defines bar to be a procedure that adds 1 to its argument -;; with no type or range checks. - -|# \ No newline at end of file +(define (lap->code label lap) + (in-compiler + (lambda () + (set! *lap* lap) + (set! *entry-label* label) + (set! *current-label-number* 0) + (set! *next-constant* 0) + (set! *interned-constants* '()) + (set! *interned-variables* '()) + (set! *interned-assignments* '()) + (set! *interned-uuo-links* '()) + (set! *block-label* (generate-label)) + (set! *external-labels* '()) + (set! *ic-procedure-headers* '()) + (phase/assemble) + (phase/link) + *result*))) \ No newline at end of file diff --git a/v8/src/compiler/etc/asm.scm b/v8/src/compiler/etc/asm.scm index 4cd5bd324..8b85e84b8 100644 --- a/v8/src/compiler/etc/asm.scm +++ b/v8/src/compiler/etc/asm.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/compiler/etc/asm.scm,v 1.1 1989/11/30 15:54:29 jinx Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/compiler/etc/asm.scm,v 1.2 1991/02/15 00:25:17 cph Exp $ -Copyright (c) 1989 Massachusetts Institute of Technology +Copyright (c) 1989-91 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -38,56 +38,11 @@ MIT in each case. |# ;; To be loaded in (compiler top-level) -(define *lap*) - -(define (syntax-lap lap) - (define (phase-1 lap accum) - (if (null? lap) - (phase-2 accum empty-instruction-sequence) - (phase-1 (cdr lap) - (cons (lap:syntax-instruction (car lap)) - accum)))) - (define (phase-2 lap accum) - (if (null? lap) - accum - (phase-2 (cdr lap) - (append-instruction-sequences! - (car lap) - accum)))) - (phase-1 lap '())) - -(define (phase/syntax-lap) - (compiler-phase - "Syntax Lap" - (lambda () - (set! *bits* - (append-instruction-sequences! - (lap:make-entry-point *entry-label* *block-label*) - (syntax-lap *lap*)))))) - -(define (lap->code label lap) - (in-compiler - (lambda () - (fluid-let ((*lap* lap)) - (set! *entry-label* label) - (set! *current-label-number* 0) - (set! *next-constant* 0) - (set! *interned-constants* '()) - (set! *interned-variables* '()) - (set! *interned-assignments* '()) - (set! *interned-uuo-links* '()) - (set! *block-label* (generate-label)) - (set! *external-labels* '()) - (set! *ic-procedure-headers* '()) - (phase/syntax-lap) - (phase/assemble) - (phase/link) - *result*)))) - -#| -;;;; Example of usage +;;; Example of `lap->code' usage: (define bar + ;; defines bar to be a procedure that adds 1 to its argument + ;; with no type or range checks. (scode-eval (lap->code 'start @@ -106,7 +61,20 @@ MIT in each case. |# (rts))) '())) -;; defines bar to be a procedure that adds 1 to its argument -;; with no type or range checks. - -|# \ No newline at end of file +(define (lap->code label lap) + (in-compiler + (lambda () + (set! *lap* lap) + (set! *entry-label* label) + (set! *current-label-number* 0) + (set! *next-constant* 0) + (set! *interned-constants* '()) + (set! *interned-variables* '()) + (set! *interned-assignments* '()) + (set! *interned-uuo-links* '()) + (set! *block-label* (generate-label)) + (set! *external-labels* '()) + (set! *ic-procedure-headers* '()) + (phase/assemble) + (phase/link) + *result*))) \ No newline at end of file -- 2.25.1