From 6119895d4405e0a2d74a4a03052b0b404ed488b1 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 22 Jan 1990 23:41:39 +0000 Subject: [PATCH] Add new representation for `dbg-label', that is optimized for minimum space consumption. Make the dbg-label operations generic so that they handle both the old and new representations. By default, the constructor makes the old representation. These changes are upwards-compatible for old programs and old versions of the compiler. --- v7/src/runtime/infstr.scm | 60 ++++++++++++++++++++++++++++++++++---- v7/src/runtime/version.scm | 4 +-- v8/src/runtime/infstr.scm | 60 ++++++++++++++++++++++++++++++++++---- 3 files changed, 110 insertions(+), 14 deletions(-) diff --git a/v7/src/runtime/infstr.scm b/v7/src/runtime/infstr.scm index d24e918d8..a61abbcfb 100644 --- a/v7/src/runtime/infstr.scm +++ b/v7/src/runtime/infstr.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/infstr.scm,v 1.2 1989/01/06 21:00:12 cph Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/infstr.scm,v 1.3 1990/01/22 23:41:23 cph Rel $ -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -157,14 +157,62 @@ MIT in each case. |# (dbg-block-name normal-closure) (dbg-block-name return-address) (dbg-block-name static-link)) - -(define-structure (dbg-label + +(define (dbg-label/name label) + (cond ((dbg-label-2? label) (dbg-label-2/name label)) + ((dbg-label-1? label) (dbg-label-1/name label)) + (else (error error-type:wrong-type-argument label)))) + +(define (set-dbg-label/name! label name) + (cond ((dbg-label-1? label) (set-dbg-label-1/name! label name)) + (else (error error-type:wrong-type-argument label)))) + +(define (dbg-label/offset label) + (cond ((dbg-label-2? label) (dbg-label-2/offset label)) + ((dbg-label-1? label) (dbg-label-1/offset label)) + (else (error error-type:wrong-type-argument label)))) + +(define (dbg-label/external? label) + (cond ((dbg-label-2? label) (dbg-label-2/external? label)) + ((dbg-label-1? label) (dbg-label-1/external? label)) + (else (error error-type:wrong-type-argument label)))) + +(define (set-dbg-label/external?! label external?) + (cond ((dbg-label-2? label) (set-dbg-label-2/external?! label external?)) + ((dbg-label-1? label) (set-dbg-label-1/external?! label external?)) + (else (error error-type:wrong-type-argument label)))) + +(define (dbg-label/names label) + (cond ((dbg-label-2? label) (dbg-label-2/names label)) + ((dbg-label-1? label) (dbg-label-1/names label)) + (else (error error-type:wrong-type-argument label)))) + +(define (set-dbg-label/names! label names) + (cond ((dbg-label-1? label) (set-dbg-label-1/names! label names)) + (else (error error-type:wrong-type-argument label)))) + +(define-structure (dbg-label-1 (named (string->symbol "#[(runtime compiler-info)dbg-label]")) (constructor make-dbg-label (name offset)) - (conc-name dbg-label/)) + (conc-name dbg-label-1/)) (name false) ;a string, primary name (offset false read-only true) ;mach. dependent offset into code block (external? false) ;if true, can have pointer to this (names (list name)) ;names of all labels at this offset - ) \ No newline at end of file + ) + +(define-integrable make-dbg-label-2 cons) +(define-integrable dbg-label-2? pair?) +(define-integrable dbg-label-2/name car) +(define-integrable (dbg-label-2/offset label) (abs (cdr label))) +(define-integrable (dbg-label-2/external? label) (negative? (cdr label))) +(define-integrable (dbg-label-2/names label) (list (car label))) + +(define (set-dbg-label-2/external?! label external?) + (let ((offset (cdr label))) + (if (if external? + (not (negative? offset)) + (negative? offset)) + (set-cdr! label (- offset)))) + unspecific) \ No newline at end of file diff --git a/v7/src/runtime/version.scm b/v7/src/runtime/version.scm index 475b714b4..02f96b058 100644 --- a/v7/src/runtime/version.scm +++ b/v7/src/runtime/version.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.71 1990/01/15 21:27:55 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/version.scm,v 14.72 1990/01/22 23:41:39 cph Exp $ Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology @@ -45,7 +45,7 @@ MIT in each case. |# '())) (add-system! microcode-system) (add-event-receiver! event:after-restore snarf-microcode-version!) - (add-identification! "Runtime" 14 71)) + (add-identification! "Runtime" 14 72)) (define microcode-system) diff --git a/v8/src/runtime/infstr.scm b/v8/src/runtime/infstr.scm index f321955ea..dcab0726e 100644 --- a/v8/src/runtime/infstr.scm +++ b/v8/src/runtime/infstr.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/infstr.scm,v 1.2 1989/01/06 21:00:12 cph Rel $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/infstr.scm,v 1.3 1990/01/22 23:41:23 cph Rel $ -Copyright (c) 1988 Massachusetts Institute of Technology +Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology This material was developed by the Scheme project at the Massachusetts Institute of Technology, Department of Electrical Engineering and @@ -157,14 +157,62 @@ MIT in each case. |# (dbg-block-name normal-closure) (dbg-block-name return-address) (dbg-block-name static-link)) - -(define-structure (dbg-label + +(define (dbg-label/name label) + (cond ((dbg-label-2? label) (dbg-label-2/name label)) + ((dbg-label-1? label) (dbg-label-1/name label)) + (else (error error-type:wrong-type-argument label)))) + +(define (set-dbg-label/name! label name) + (cond ((dbg-label-1? label) (set-dbg-label-1/name! label name)) + (else (error error-type:wrong-type-argument label)))) + +(define (dbg-label/offset label) + (cond ((dbg-label-2? label) (dbg-label-2/offset label)) + ((dbg-label-1? label) (dbg-label-1/offset label)) + (else (error error-type:wrong-type-argument label)))) + +(define (dbg-label/external? label) + (cond ((dbg-label-2? label) (dbg-label-2/external? label)) + ((dbg-label-1? label) (dbg-label-1/external? label)) + (else (error error-type:wrong-type-argument label)))) + +(define (set-dbg-label/external?! label external?) + (cond ((dbg-label-2? label) (set-dbg-label-2/external?! label external?)) + ((dbg-label-1? label) (set-dbg-label-1/external?! label external?)) + (else (error error-type:wrong-type-argument label)))) + +(define (dbg-label/names label) + (cond ((dbg-label-2? label) (dbg-label-2/names label)) + ((dbg-label-1? label) (dbg-label-1/names label)) + (else (error error-type:wrong-type-argument label)))) + +(define (set-dbg-label/names! label names) + (cond ((dbg-label-1? label) (set-dbg-label-1/names! label names)) + (else (error error-type:wrong-type-argument label)))) + +(define-structure (dbg-label-1 (named (string->symbol "#[(runtime compiler-info)dbg-label]")) (constructor make-dbg-label (name offset)) - (conc-name dbg-label/)) + (conc-name dbg-label-1/)) (name false) ;a string, primary name (offset false read-only true) ;mach. dependent offset into code block (external? false) ;if true, can have pointer to this (names (list name)) ;names of all labels at this offset - ) \ No newline at end of file + ) + +(define-integrable make-dbg-label-2 cons) +(define-integrable dbg-label-2? pair?) +(define-integrable dbg-label-2/name car) +(define-integrable (dbg-label-2/offset label) (abs (cdr label))) +(define-integrable (dbg-label-2/external? label) (negative? (cdr label))) +(define-integrable (dbg-label-2/names label) (list (car label))) + +(define (set-dbg-label-2/external?! label external?) + (let ((offset (cdr label))) + (if (if external? + (not (negative? offset)) + (negative? offset)) + (set-cdr! label (- offset)))) + unspecific) \ No newline at end of file -- 2.25.1