diff --git a/devel/vm/ior/ior.text b/devel/vm/ior/ior.text index 9730de55d..e69de29bb 100644 --- a/devel/vm/ior/ior.text +++ b/devel/vm/ior/ior.text @@ -1,665 +0,0 @@ -*** -*** These notes about the design of a new type of Scheme interpreter -*** "Ior" are cut out from various emails from early spring 2000. -*** -*** MDJ 000817 -*** - -Generally, we should try to make a design which is clean and -minimalistic in as many respects as possible. For example, even if we -need more primitives than those in R5RS internally, I don't think -these should be made available to the user in the core, but rather be -made available *through* libraries (implementation in core, -publication via library). - -The suggested working name for this project is "Ior" (Swedish name for -the donkey in "Winnie the Pooh" :). If, against the odds, we really -would succeed in producing an Ior, and we find it suitable, we could -turn it into a Guile 2.0 (or whatever). (The architecture still -allows for support of the gh interface and uses conservative GC (Hans -Böhm's, in fact).) - - Beware now that I'm just sending over my original letter, which is - just a sketch of the more detailed, but cryptic, design notes I made - originally, which are, in turn, not as detailed as the design has - become now. :) - - Please also excuse the lack of structure. I shouldn't work on this at - all right now. Choose for yourselves if you want to read this - unstructured information or if you want to wait until I've structured - it after end of January. - -But then I actually have to blurt out the basic idea of my -architecture already now. (I had hoped to present you with a proper -and fairly detailed spec, but I won't be able to complete such a spec -quickly.) - - -The basic idea is this: - -* Don't waste time on non-computation! - -Why waste a lot of time on type-checks, unboxing and boxing of data? -Neither of these actions do any computations! - -I'd like both interpreter and compiled code to work directly with data -in raw, native form (integers represented as 32bit longs, inexact -numbers as doubles, short strings as bytes in a word, longer strings -as a normal pointer to malloced memory, bignums are just pointers to a -gmp (GNU MultiPrecision library) object, etc.) - -* Don't we need to dispatch on type to know what to do? - -But don't we need to dispatch on the type in order to know how to -compute with the data? E.g., `display' does entirely different -computations on a and a . ( is an integer -between -2^31 and 2^31-1.) - -The answer is *no*, not in 95% of all cases. The main reason is that -the interpreter does type analysis while converting closures to -bytecode, and knows already when _calling_ `display' what type it's -arguments has. This means that the bytecode compiler can choose a -suitable _version_ of `display' which handles that particular type. - - - -This type analysis is greatly simplified by the fact that just as the -type analysis _results_ in the type of the argument in the call to -`display', and, thus, we can select the correct _version_ of -`display', the closure byte-code itself will only be one _version_ of -the closure with the types of its arguments fixed at the start of the -analysis. - -As you already have understood by now, the basic architecture is that -all procedures are generic functions, and the "versions" I'm speaking -about is a kind of methods. Let's call them "branches" by now. - -For example: - -(define foo - (lambda (x) - ... - (display x) - ...) - -may result in the following two branches: - -1. [-foo] = - (branch ((x )) - ... - ([-display] x) - ...) - -2. [-foo] = - (branch ((x )) - ... - ([-display] x) - ...) - -and a new closure - -(define bar - (lambda (x y) - ... - (foo x) - ...)) - -results in - -[--bar] = - (branch ((x ) (y )) - ... - ([-foo] x) - ...) - -Note how all type dispatch is eliminated in these examples. - -As a further reinforcement to the type analysis, branches will not -only have typed parameters but also have return types. This means -that the type of a branch will look like - - x ... x --> - -In essence, the entire system will be very ML-like internally, and we -can benefit from the research done on ML-compilation. - -However, we now get three major problems to confront: - -1. In the Scheme language not all situations can be completely type - analyzed. - -2. In particular, for some operations, even if the types of the - parameters are well defined, we can't determine the return type - generically. For example, [--+] may have return - type _or_ . - -3. Even if we can do a complete analysis, some closures will generate - a combinatoric explosion of branches. - - -Problem 1: Incomplete analysis - -We introduce a new type . This data type has type and -contents - -struct ior_boxed_t { - ior_type *type; /* pointer to class struct */ - void *data; /* generic field, may also contain immediate objects - */ -} - -For example, a boxed fixnum 4711 has type and contents -{ , 4711 }. The boxed type essentially corresponds to Guile's -SCM type. It's just that the 1 or 3 or 7 or 16-bit type tag has been -replaced with a 32-bit type tag (the pointer to the class structure -describing the type of the object). - -This is more inefficient than the SCM type system, but it's no problem -since it won't be used in 95% of all cases. The big advantage -compared to SCM's type system is that it is so simple and uniform. - -I should note here that while SCM and Guile are centered around the -cell representation and all objects either _are_ cells or have a cell -handle, objects in ior will more look like mallocs. This is the -reason why I planned to start with Böhm's GC which has C pointers as -object handles. But it is of course still possible to use a heap, or, -preferably several heaps for different kinds of objects. (Böhm's GC -has multiple heaps for different sizes of objects.) If we write a -custom GC, we can increase speed further. - - -Problem 3 (yes, I skipped :) Combinatoric explosion - -We simply don't generate all possible branches. In the interpreter we -generate branches "just-too-late" (well, it's normally called "lazy -compilation" or "just-in-time", but if it was "in-time", the procedure -would already be compiled when it was needed, right? :) as when Guile -memoizes or when a Java machine turns byte-codes into machine code, or -as when GOOPS turns methods into cmethods for that matter. - -Have noticed that branches (although still without return type -information) already exist in GOOPS? They are currently called -"cmethods" and are generated on demand from the method code and put -into the GF cache during evaluation of GOOPS code. :-) (I have not -utilized this fully yet. I plan to soon use this method compilation -(into branches) to eliminate almost all type dispatch in calls to -accessors.) - -For the compiler, we use profiling information, just as the modern GCC -scheduler, or else relies on some type analysis (if a procedure says -(+ x y), x is not normally a but rather some subclass of -) and some common sense (it's usually more important to -generate branches than branches). - -The rest of the cases can be handled by -branches. We can, for -example, have a: - -[--bar] = - (branch ((x ) (y )) - ... - ([-foo] x) - ...) - -[-foo] will use an efficient type dispatch mechanism (for -example akin to the GOOPS one) to select the right branch of -`display'. - - -Problem 2: Ambiguous return type - -If the return type of a branch is ambiguous, we simply define the -return type as , and box data at the point in the branch where -it can be decided which type of data we will return. This is how -things can be handled in the general case. However, we might be able -to handle things in a more neat way, at least in some cases: - -During compilation to byte code, we'll probably use an intermediate -representation in continuation passing style. We might even use a -subtype of branches reprented as continuations (not a heavy -representation, as in Guile and SCM, but probably not much more than a -function pointer). This is, for example, one way of handling tail -recursion, especially mutual tail recursion. - -One case where we would like to try really hard not to box data is -when fixnums "overflow into" bignums. - -Let's say that the branch [--bar] contains a form - - (+ x y) - -where the type analyzer knows that x and y are fixnums. We then split -the branch right after the form and let it fork into two possible -continuation branches bar1 and bar2: - -[The following is only pseudo code. It can be made efficient on the C - level. We can also use the asm compiler directive in conditional - compilation for GCC on i386. We could even let autoconf/automake - substitute an architecture specific solution for multiple - architectures, but still support a C level default case.] - - (if (sum-over/underflow? x y) - (bar1 (fixnum->bignum x) (fixnum->bignum y) ...) - (bar2 x y ...)) - -bar1 begins with the evaluation of the form - - ([--+] x y) - -while bar 2 begins with - - ([--+] x y) - -Note that the return type of each of these forms is unambiguous. - - -Now some random points from the design: - -* The basic concept in Ior is the class. A type is a concrete class. - Classes which are subclasses of are concrete, otherwise they - are abstract. - -* A procedure is a collection of methods. Each method can have - arbitrary number of parameters of arbitrary class (not type). - -* The type of a method is the tuple of it's argument classes. - -* The type of a procedure is the set of it's method types. - -But the most important new concept is the branch. -Regard the procedure: - -(define (half x) - (quotient x 2)) - -The procedure half will have the single method - - (method ((x )) - (quotient x 2)) - -When `(half 128)' is called the Ior evaluator will create a new branch -during the actual evaluation. I'm now going to extend the branch -syntax by adding a second list of formals: the continuations of the -branch. - -* The type of a branch is namely the tuple of the tuple of it's - argument types (not classes!) and the tuple of it's continuation - argument types. The branch generated above will be: - - (branch ((x ) ((c )) - (c (quotient x 2))) - - If the method - - (method ((x ) (y )) - (quotient (+ x 1) y)) - - is called with arguments 1 and 2 it results in the branch - - (branch ((x ) (y )) ((c1 ) (c2 )) - (quotient (+ x 1 c3) 2)) - - where c3 is: - - (branch ((x ) (y )) ((c )) - (quotient (+ (fixnum->bignum x) 1) 2) - -The generated branches are stored in a cache in the procedure object. - - -But wait a minute! What about variables and data structures? - -In essence, what we do is that we fork up all data paths so that they -can be typed: We put the type tags on the _data paths_ instead of on -the data itself. You can look upon the "branches" as tubes of -information where the type tag is attached to the tube instead of on -what passes through it. - -Variables and data structures are part of the "tubes", so they need to -be typed. For example, the generic pair looks like: - -(define-class () - car-type - car - cdr-type - cdr) - -But note that since car and cdr are generic procedures, we can let -more efficient pairs exist in parallel, like - -(define-class () - (car (class )) - (cdr (class ))) - -Note that instances of this last type only takes two words of memory! -They are easy to use too. We can't use `cons' or `list' to create -them, since these procedures can't assume immutability, but we don't -need to specify the type in our program. Something like - - (const-cons 1 x) - -where x is in the data flow path tagged as , or - - (const-list 1 2 3) - - -Some further notes: - -* The concepts module and instance are the same thing. Using other - modules means 1. creating a new module class which inherits the - classes of the used modules and 2. instantiating it. - -* Module definitions and class definitions are equivalent but - different syntactic sugar adapted for each kind of use. - -* (define x 1) means: create an instance variable which is itself a - subclass of with initial value 1 (which is an instance of - ). - - -The interpreter is a mixture between a stack machine and a register -machine. The evaluator looks like this... :) - - /* the interpreter! */ - if (!setjmp (ior_context->exit_buf)) -#ifndef i386_GCC - while (1) -#endif - (*ior_continue) (IOR_MICRO_OP_ARGS); - -The branches are represented as an array of pointers to micro -operations. In essence, the evaluator doesn't exist in itself, but is -folded out over the entire implementation. This allows for an extreme -form of modularity! - -The i386_GCC is a machine specific optimization which avoids all -unnecessary popping and pushing of the CPU stack (which is different -from the Ior data stack). - -The execution environment consists of - -* a continue register similar to the program counter in the CPU -* a data stack (where micro operation arguments and results are stored) -* a linked chain of environment frames (but look at exception below!) -* a dynamic context - -I've written a small baby Ior which uses Guile's infrastructure. -Here's the context from that baby Ior: - -typedef struct ior_context_t { - ior_data_t *env; /* rest of environment frames */ - ior_cont_t save_continue; /* saves or represents continuation */ - ior_data_t *save_env; /* saves or represents environment */ - ior_data_t *fluids; /* array of fluids (use GC_malloc!) */ - int n_fluids; - int fluids_size; - /* dynwind chain is stored directly in the environment, not in context */ - jmp_buf exit_buf; - IOR_SCM guile_protected; /* temporary */ -} ior_context_t; - -There's an important exception regarding the lowest environment -frame. That frame isn't stored in a separate block on the heap, but -on Ior's data stack. Frames are copied out onto the heap when -necessary (for example when closures "escape"). - - -Now a concrete example: - -Look at: - -(define sum - (lambda (from to res) - (if (= from to) - res - (sum (+ 1 from) to (+ from res))))) - -This can be rewritten into CPS (which captures a lot of what happens -during flow analysis): - -(define sum - (lambda (from to res c1) - (let ((c2 (lambda (limit?) - (let ((c3 (lambda () - (c1 res))) - (c4 (lambda () - (let ((c5 (lambda (from+1) - (let ((c6 (lambda (from+res) - (sum from+1 to from+res c1)))) - (_+ from res c6))))) - (_+ 1 from c5))))) - (_if limit? c3 c4))))) - (_= from to c2)))) - -Finally, after branch expansion, some optimization, code generation, -and some optimization again, we end up with the byte code for the two -branches (here marked by labels `sum' and `sumbig'): - - c5 - (ref -3) - (shift -1) - (+ c4big) - ;; c4 - (shift -2) - (+ 1 sumbig) - ;; c6 - sum - (shift 3) - (ref2 -3) - ;; c2 - (if!= c5) - ;; c3 - (ref -1) - ;; c1 - (end) - - c5big - (ref -3) - (shift -1) - (+ ) - c4big - (shift -2) - (+ 1) - ;; c6 - sumbig - (shift 3) - (ref2 -3) - ;; c2 - (= ) - (if! c5big) - ;; c3 - (ref -1) - ;; c1 - (end) - -Let's take a closer look upon the (+ 1 sumbig) micro -operation. The generated assembler from the Ior C source + machine -specific optimizations for i386_GCC looks like this (with some rubbish -deleted): - -ior_int_int_sum_intbig: - movl 4(%ebx),%eax ; fetch arg 2 - addl (%ebx),%eax ; fetch arg 1 and do the work! - jo ior_big_sum_int_int ; dispatch to other branch on overflow - movl %eax,(%ebx) ; store result in first environment frame - addl $8,%esi ; increment program counter - jmp (%esi) ; execute next opcode - -ior_big_sum_int_int: - -To clearify: This is output from the C compiler. I added the comments -afterwards. - -The source currently looks like this: - -IOR_MICRO_BRANCH_2_2 ("+", int, big, sum, int, int, 1, 0) -{ - int res = IOR_ARG (int, 0) + IOR_ARG (int, 1); - IOR_JUMP_OVERFLOW (res, ior_big_sum_int_int); - IOR_NEXT2 (z); -} - -where the macros allow for different definitions depending on if we -want to play pure ANSI or optimize for a certain machine/compiler. - -The plan is actually to write all source in the Ior language and write -Ior code to translate the core code into bootstrapping C code. - -Please note that if i386_GCC isn't defined, we run plain portable ANSI C. - - -Just one further note: - -In Ior, there are three modes of evaluation - -1. evaluating and type analyzing (these go in parallel) -2. code generation -3. executing byte codes - -It is mode 3 which is really fast in Ior. - -You can look upon your program as a web of branch segments where one -branch segment can be generated from fragments of many closures. Mode -switches doesn't occur at the procedure borders, but at "growth -points". I don't have time to define them here, but they are based -upon the idea that the continuation together with the type signature -of the data flow path is unique. - -We normally run in mode 3. When we come to a source growth point -(essentially an apply instruction) for uncompiled code we "dive out" -of mode 3 into mode 1 which starts to eval/analyze code until we come -to a "sink". When we reach the "sink", we have enough information -about the data path to do code generation, so we backtrack to the -source growth point and grow the branch between source and sink. -Finally, we "dive into" mode 3! - -So, code generation doesn't respect procedure borders. We instead get -a very neat kind of inlining, which, e.g., means that it is OK to use -closures instead of macros in many cases. ----------------------------------------------------------------------- -Ior and module system -===================== - -How, exactly, should the module system of Ior look like? - -There is this general issue of whether to have a single-dispatch or -multi-dispatch system. Personally, I see that Scheme already use -multi-dispatch. Compare (+ 1.0 2) and (+ 1 2.0). - -As you've seen if you've read the notes about Ior design, efficiency -is not an issue here, since almost all dispatch will be eliminated -anyway. - -Also, note an interesting thing: GOOPS actually has a special, -implicit, argument to all of it's methods: the lexical environment. -It would be very ugly to add a second, special, argument to this. - -Of course, the theoreticians have already recognised this, and in many -systems, the implicit argument (the object) and the environment for -the method is the same thing. - -I think we should especially take impressions from Matthias Blume's -module/object system. - -The idea, now, for Ior (remember that everything about Ior is -negotiable between us) is that a module is a type, as well as an -instance of that type. The idea is that we basically keep the GOOPS -style of methods, with the implicit argument being the module object -(or some other lexical environment, in a chain with the module as -root). - -Let's say now that module C uses modules A and B. Modules A and B -both exports the procedure `foo'. But A:foo and B:foo as different -sets of methods. - -What does this mean? Well, it obviously means that the procedure -`foo' in module C is a subtype of A:foo and B:foo. Note how this is -similar in structure to slot inheritance: When class C is created with -superclasses A and B, the properties of a slot in C are created -through slot inheritance. One way of interpreting variable foo in -module A is as a slot with init value foo. Through the MOP, we can -specify that procedure slot inheritance in a module class implies -creation of new init values through inheritance. - -This may look like a kludge, and perhaps it is, and, sure, we are not -going to accept any kludges in Ior. But, it might actually not be a -kludge... - -I think it is commonly accepted by computer scientists that a module, -and/or at least a module interface is a type. Again, this type can be -seen as the set of types of the functions in the interface. The types -of our procedures are the set of branch types the provide. It is then -natural that a module using two other modules create new procedure -types by folding. - -This thing would become less cloudy (yes, this is a cloudy part of my -reasoning; I meant previously that the interpreter itself is now -clear) if module interfaces were required to be explicitly types. - -Actually, this would fit much better together with the rest of Ior's -design. On one hand, we might be free to introduce such a restriction -(compiler writers would applaud it), since R5RS hasn't specified any -module system. On the other hand, it might be strange to require -explicit typing when Scheme is fundamentally implicitly types... - -We also have to consider that a module has an "inward" face, which is -one type, and possibly many "outward" faces, which are different -types. (Compare the idea of "interfaces" in Scheme48.) - -It thus, seems that, while a module can truly be an Ior class, the -reverse should probably not hold in the general case... - -Unless - - instance <-> module proper - class of the instance <-> "inward interface" - superclasses <-> "outward interfaces + inward uses" - -...hmm, is this possible to reconcile with Rees' object system? - -Please think about these issues. We should try to end up with a -beautiful and consistent object/module system. - ----------------------------------------------------------------------- - -Here's a difficult problem in Ior's design: - -Let's say that we have a mutable data structure, like an ordinary -list. Since, in Ior, the type tag (which is really a pointer to a -class structure) is stored separately from the data, it is thinkable -that another thread modifies the location in the list between when our -thread reads the type tag and when it reads the data. - -The reading of type and data must be made atomic in some way. -Probably, some kind of locking of the heap is required. It's just -that it may cause a lot of overhead to look the heap at every *read* -from a mutable data structure. - -Look how much trouble those set!-operations cause! Not only does it -force us to store type tags for each car and cdr in the list, but it -also forces a lot of explicit dispatch to be done, and causes troubles -in a threaded system... - ----------------------------------------------------------------------- - -Jim Blandy writes: - -> We also should try to make less work for the GC, by avoiding consing -> up local environments until they're closed over. - -Did the texts which I sent to you talk about Ior's solution? - -It basically is: Use *two* environment "arguments" to the evaluator -(in Ior, they aren't arguments but registers): - -* One argument is a pointer to the "top" of an environment stack. - This is used in the "inner loop" for very efficient access to - in-between results. The "top" segment of the environment stack is - also regarded as the first environment frame in the lexical - environment. ("top" is bottom on a stack which grows downwards) - -* The other argument points to a structure holding the evaluation - context. In this context, there is a pointer to the chain of the - rest of the environment frames. Note that since frames are just - blocks of SCM values, you can very efficiently "release" a frame - into the heap by block copying it (remember that Ior uses Boehms GC; - this is how we allocate the block). diff --git a/doc/ref/ChangeLog b/doc/ref/ChangeLog index f07a7ee11..5f18640a3 100644 --- a/doc/ref/ChangeLog +++ b/doc/ref/ChangeLog @@ -1,3 +1,7 @@ +2002-02-26 Thien-Thi Nguyen + + * Makefile.am: Update path to pre-inst-guile automake frag. + 2002-02-24 Rob Browning * .cvsignore: add autoconf-macros.texi. diff --git a/emacs/patch.el b/emacs/patch.el index af8c45dfc..868310a80 100644 --- a/emacs/patch.el +++ b/emacs/patch.el @@ -45,6 +45,9 @@ ;;; Code: (require 'cl) +(require 'update-changelog) ; for stitching + +;; outgoing (defvar patch-greeting "hello guile maintainers,\n\n" "*String to insert at beginning of patch mail.") @@ -95,4 +98,9 @@ (patch-changelog-skeleton) "\n\n\n" (make-string 72 ?_) "\n"))) +;; incoming + + + + ;;; patch.el ends here diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog index a41923c83..8f3a73b38 100644 --- a/ice-9/ChangeLog +++ b/ice-9/ChangeLog @@ -1,3 +1,7 @@ +2002-02-26 Thien-Thi Nguyen + + * Makefile.am: Update path to pre-inst-guile automake frag. + 2002-02-24 Rob Browning * syncase.scm (gensym): redefine locally so we can control it's diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 5a3072f23..a3704cbe0 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,7 @@ +2002-02-26 Thien-Thi Nguyen + + * Makefile.am: Update path to pre-inst-guile automake frag. + 2002-02-25 Dirk Herrmann * gc.c (scm_gc_sweep): Make it compile even when deprecated diff --git a/oop/goops/dispatch.scm b/oop/goops/dispatch.scm index 749cf9273..137def45b 100644 --- a/oop/goops/dispatch.scm +++ b/oop/goops/dispatch.scm @@ -1,15 +1,17 @@ +;;;; oop/goop/dispatch.scm --- provide `memoize-method!' + ;;;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc. -;;;; +;;;; ;;;; This program is free software; you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by ;;;; the Free Software Foundation; either version 2, or (at your option) ;;;; any later version. -;;;; +;;;; ;;;; This program is distributed in the hope that it will be useful, ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;;; GNU General Public License for more details. -;;;; +;;;; ;;;; You should have received a copy of the GNU General Public License ;;;; along with this software; see the file COPYING. If not, write to ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, @@ -38,7 +40,7 @@ ;;;; If you write modifications of your own for GUILE, it is your choice ;;;; whether to permit this exception to apply to your modifications. ;;;; If you do not wish that, delete this exception notice. -;;;; +;;;; (define-module (oop goops dispatch) @@ -235,7 +237,26 @@ (define (lookup-create-cmethod gf args) (no-applicable-method (car args) (cadr args)))) -(define (memoize-method! gf args exp) +(define method-cache-install! + (letrec ((first-n + (lambda (ls n) + (if (or (zero? n) (null? ls)) + '() + (cons (car ls) (first-n (cdr ls) (- n 1))))))) + (lambda (insert! exp args applicable) + (let* ((specializers (method-specializers (car applicable))) + (n-specializers + (if (list? specializers) + (length specializers) + (+ 1 (slot-ref (method-cache-generic-function exp) + 'n-specialized))))) + (let* ((types (map class-of (first-n args n-specializers))) + (entry+cmethod (compute-entry-with-cmethod applicable types))) + (insert! exp (car entry+cmethod)) ; entry = types + cmethod + (cdr entry+cmethod) ; cmethod + ))))) + +(define (memoize-method!-uninstrumented gf args exp) (if (not (slot-ref gf 'used-by)) (slot-set! gf 'used-by '())) (let ((applicable ((if (eq? gf compute-applicable-methods) @@ -271,23 +292,17 @@ (set-car! args gf) (lookup-create-cmethod no-applicable-method args))))) +(define -memoize-method!-stats #f) + +(define (memoize-method! gf args exp) + (memoize-method!-uninstrumented gf args exp)) + (set-procedure-property! memoize-method! 'system-procedure #t) -(define method-cache-install! - (letrec ((first-n - (lambda (ls n) - (if (or (zero? n) (null? ls)) - '() - (cons (car ls) (first-n (cdr ls) (- n 1))))))) - (lambda (insert! exp args applicable) - (let* ((specializers (method-specializers (car applicable))) - (n-specializers - (if (list? specializers) - (length specializers) - (+ 1 (slot-ref (method-cache-generic-function exp) - 'n-specialized))))) - (let* ((types (map class-of (first-n args n-specializers))) - (entry+cmethod (compute-entry-with-cmethod applicable types))) - (insert! exp (car entry+cmethod)) ; entry = types + cmethod - (cdr entry+cmethod) ; cmethod - ))))) +;;; +;;; Memoization Reflection +;;; + + + +;;; oop/goop/dispatch.scm ends here diff --git a/qthreads.m4 b/qthreads.m4 index 585892c01..e69de29bb 100644 --- a/qthreads.m4 +++ b/qthreads.m4 @@ -1,156 +0,0 @@ -dnl Autoconf macros for configuring the QuickThreads package -dnl Jim Blandy --- July 1998 -dnl -dnl Copyright (C) 1998, 1999 Free Software Foundation, Inc. -dnl -dnl This file is part of GUILE. -dnl -dnl GUILE is free software; you can redistribute it and/or modify -dnl it under the terms of the GNU General Public License as -dnl published by the Free Software Foundation; either version 2, or -dnl (at your option) any later version. -dnl -dnl GUILE is distributed in the hope that it will be useful, but -dnl WITHOUT ANY WARRANTY; without even the implied warranty of -dnl MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -dnl GNU General Public License for more details. -dnl -dnl You should have received a copy of the GNU General Public -dnl License along with GUILE; see the file COPYING. If not, write -dnl to the Free Software Foundation, Inc., 59 Temple Place, Suite -dnl 330, Boston, MA 02111-1307 USA - - - -dnl QTHREADS_CONFIGURE configures the QuickThreads package. The QT -dnl sources should be in $srcdir/qt. If configuration succeeds, this -dnl macro creates the appropriate symlinks in the qt object directory, -dnl and sets the following variables, used in building libqthreads.a: -dnl QTHREAD_LTLIBS --- set to libqthreads.la if configuration -dnl succeeds, or the empty string if configuration fails. -dnl qtmd_h, qtmds_s, qtmdc_c, qtdmdb_s --- the names of the machine- -dnl dependent source files. -dnl qthread_asflags --- flags to pass to the compiler when processing -dnl assembly-language files. -dnl -dnl It also sets the following variables, which describe how clients -dnl can link against libqthreads.a: -dnl THREAD_PACKAGE --- set to "QT" if configuration succeeds, or -dnl the empty string if configuration fails. -dnl THREAD_LIBS_LOCAL --- linker options for use in this source tree -dnl THREAD_LIBS_INSTALLED --- linker options for use after this package -dnl is installed -dnl It would be nice if all thread configuration packages for Guile -dnl followed the same conventions. -dnl -dnl All of the above variables will be substituted into Makefiles in -dnl the usual autoconf fashion. -dnl -dnl We distinguish between THREAD_LIBS_LOCAL and -dnl THREAD_LIBS_INSTALLED because the thread library might be in -dnl this tree, and be built using libtool. This means that: -dnl 1) when building other executables in this tree, one must -dnl pass the relative path to the ../libfoo.la file, but -dnl 2) once the whole package has been installed, users should -dnl link using -lfoo. -dnl Normally, we only care about the first case, but since the -dnl guile-config script needs to give users all the flags they need -dnl to link programs against guile, the GUILE_WITH_THREADS macro -dnl needs to supply the second piece of information as well. -dnl -dnl This whole thing is a little confused about what ought to be -dnl done in the top-level configure script, and what ought to be -dnl taken care of in the subdirectory. For example, qtmds_s and -dnl friends really ought not to be even mentioned in the top-level -dnl configure script, but here they are. - -AC_DEFUN([QTHREADS_CONFIGURE],[ - AC_REQUIRE([AC_PROG_LN_S]) - - AC_MSG_CHECKING(QuickThreads configuration) - - changequote(,)dnl We use [ and ] in a regexp in the case - - THREAD_PACKAGE=QT - qthread_asflags='' - case "$host" in - i[3456]86-*-*) - port_name=i386 - qtmd_h=md/i386.h - qtmds_s=md/i386.s - qtmdc_c=md/null.c - qtdmdb_s= - case "$host" in - *-*-netbsd* ) - ## NetBSD needs to be told to pass the assembly code through - ## the C preprocessor. Other GCC installations seem to do - ## this by default, but NetBSD's doesn't. We could get the - ## same effect by giving the file a name ending with .S - ## instead of .s, but I don't see how to tell automake to do - ## that. - qthread_asflags='-x assembler-with-cpp' - ;; - esac - ;; - mips-sgi-irix[56]*) - port_name=irix - qtmd_h=md/mips.h - qtmds_s=md/mips-irix5.s - qtmdc_c=md/null.c - qtdmdb_s=md/mips_b.s - ;; - mips-*-*) - port_name=mips - qtmd_h=md/mips.h - qtmds_s=md/mips.s - qtmdc_c=md/null.c - qtdmdb_s=md/mips_b.s - ;; - sparc-*-sunos*) - port_name=sparc-sunos - qtmd_h=md/sparc.h - qtmds_s=md/_sparc.s - qtmdc_c=md/null.c - qtdmdb_s=md/_sparc_b.s - ;; - sparc-*-*) - port_name=sparc - qtmd_h=md/sparc.h - qtmds_s=md/sparc.s - qtmdc_c=md/null.c - qtdmdb_s=md/sparc_b.s - ;; - alpha*-*-*) - port_name=alpha - qtmd_h=md/axp.h - qtmds_s=md/axp.s - qtmdc_c=md/null.c - qtdmdb_s=md/axp_b.s - ;; - *) - echo "Unknown configuration; threads package disabled" - THREAD_PACKAGE="" - ;; - esac - changequote([, ]) - - # Did configuration succeed? - if test -n "$THREAD_PACKAGE"; then - AC_MSG_RESULT($port_name) - QTHREAD_LTLIBS=libqthreads.la - THREAD_LIBS_LOCAL="../qt/libqthreads.la" - THREAD_LIBS_INSTALLED="-lqthreads" - else - AC_MSG_RESULT(none; disabled) - fi - - AC_SUBST(QTHREAD_LTLIBS) - AC_SUBST(qtmd_h) - AC_SUBST(qtmds_s) - AC_SUBST(qtmdc_c) - AC_SUBST(qtdmdb_s) - AC_SUBST(qthread_asflags) - AC_SUBST(THREAD_PACKAGE) - AC_SUBST(THREAD_LIBS_LOCAL) - AC_SUBST(THREAD_LIBS_INSTALLED) -]) diff --git a/scripts/ChangeLog b/scripts/ChangeLog index d6484894c..912000ea8 100644 --- a/scripts/ChangeLog +++ b/scripts/ChangeLog @@ -1,3 +1,7 @@ +2002-02-26 Thien-Thi Nguyen + + * Makefile.am: Update path to pre-inst-guile automake frag. + 2002-02-22 Thien-Thi Nguyen * api-diff: New script.