; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING. (define-structures ((scheme-level-1 scheme-level-1-interface) (util util-interface)) (open scheme-level-0 ascii signals code-quote) ; needed by SYNTAX-RULES (usual-transforms case quasiquote syntax-rules) (files (rts base) (rts util) (rts number) (rts lize)) ; Rationalize (optimize auto-integrate)) ; "Level 2" (define-structures ((records records-interface) (records-internal records-internal-interface)) (open scheme-level-1 signals primitives) (files (rts record)) (optimize auto-integrate)) ; The external code needs this to check the types of records. (define-structure export-the-record-type (export) (open scheme-level-1 records-internal shared-bindings) (begin (define-exported-binding "s48-the-record-type" :record-type))) (define-structure define-record-types define-record-types-interface (open scheme-level-1 records records-internal loopholes primitives) ; unspecific (files (rts jar-defrecord))) (define-structures ((methods methods-interface) (meta-methods meta-methods-interface)) (open scheme-level-1 define-record-types records records-internal bitwise util primitives signals) (files (rts method)) (optimize auto-integrate)) (define-structure number-i/o number-i/o-interface (open scheme-level-1 methods signals ascii) (files (rts numio))) (define-structures ((fluids fluids-interface) (fluids-internal fluids-internal-interface) (thread-cells thread-cells-interface) (thread-cells-internal thread-cells-internal-interface)) (open scheme-level-1 define-record-types primitives cells) (files (rts thread-env)) (optimize auto-integrate)) (define-structure wind wind-interface (open scheme-level-1 signals define-record-types fluids fluids-internal escapes) (files (rts wind)) (optimize auto-integrate)) (define-structure session-data (export make-session-data-slot! initialize-session-data! session-data-ref session-data-set!) (open scheme-level-1 primitives) (files (rts session)) (optimize auto-integrate)) (define-structures ((i/o i/o-interface) (i/o-internal i/o-internal-interface)) (open scheme-level-1 signals fluids architecture primitives ports code-vectors bitwise define-record-types ascii threads locks threads-internal ; JMG for scsh methods ; &disclose :input-port :output-port interrupts ; {en|dis}able-interrupts! number-i/o ; number->string for debugging exceptions ; wrong-number-of-args stuff handle) ; report-errors-as-warnings with-handler (files (rts port) (rts current-port)) (optimize auto-integrate)) (define-structure channels channels-interface (open scheme-level-1 low-channels architecture signals) ; error, call-error (files (rts channel))) (define-structure channel-i/o channel-i/o-interface (open scheme-level-1 i/o i/o-internal signals channels low-channels architecture code-vectors wind define-record-types queues threads threads-internal locks exceptions interrupts ascii ports util session-data structure-refs debug-messages ; for error messages handle) ; report-errors-as-warnings (access primitives) ; add-finalizer, channel stuff (files (rts channel-port) (rts channel-io))) (define-structure conditions conditions-interface (open scheme-level-1 signals) (files (rts condition))) (define-structure writing writing-interface (open scheme-level-1 number-i/o i/o ;output-port-option, write-string methods ;disclose structure-refs) (access low-channels ;channel? channel-id code-vectors) ;code-vector? (files (rts write))) (define-structure reading reading-interface (open scheme-level-1 number-i/o i/o ;input-port-option ascii ;for dispatch table signals ;warn, signal-condition, make-condition conditions ;define-condition-type primitives ;make-immutable! silly) ;reverse-list->string (files (rts read)) (optimize auto-integrate)) (define-structure scheme-level-2 scheme-level-2-interface (open scheme-level-1 number-i/o writing reading wind i/o channel-i/o)) (define-structure features features-interface (open primitives i/o)) ; Hairier stuff now. (define-structure templates templates-interface (open scheme-level-1 primitives methods) (files (rts template)) (optimize auto-integrate)) (define-structure continuations continuations-interface (open scheme-level-1 primitives templates methods architecture code-vectors) (files (rts continuation)) (optimize auto-integrate)) (define-structure more-types (export :closure :code-vector :location :double :template :channel :port :weak-pointer :shared-binding) (open scheme-level-1 methods closures code-vectors locations templates low-channels ports primitives shared-bindings) (begin (define-simple-type :closure (:value) closure?) (define-simple-type :code-vector (:value) code-vector?) (define-simple-type :location (:value) location?) (define-simple-type :template (:value) template?) (define-simple-type :channel (:value) channel?) (define-simple-type :port (:value) port?) (define-simple-type :double (:rational) double?) (define-simple-type :weak-pointer (:value) weak-pointer?) (define-method &disclose ((obj :weak-pointer)) (list 'weak-pointer)) (define-simple-type :shared-binding (:value) shared-binding?) (define-method &disclose ((obj :shared-binding)) (list (if (shared-binding-is-import? obj) 'imported-binding 'exported-binding) (shared-binding-name obj))))) (define-structure enumerated enumerated-interface (open scheme-level-1 signals) (files (rts defenum scm))) (define-structure architecture architecture-interface (open scheme-level-1 signals enumerated) (files (vm arch))) (define-structures ((exceptions exceptions-interface) (handle handle-interface)) (open scheme-level-1 signals fluids conditions ;make-exception, etc. primitives ;set-exception-handlers!, etc. wind ;CWCC methods meta-methods more-types architecture vm-exposure ;primitive-catch templates ;template-code, template-info continuations ;continuation-pc, etc. locations ;location?, location-id closures ;closure-template number-i/o) ; number->string, for backtrace (files (rts exception))) ; Needs generic, arch (define-structure interrupts interrupts-interface (open scheme-level-1 signals fluids conditions bitwise escapes session-data primitives architecture) (files (rts interrupt)) (optimize auto-integrate)) ;mostly for threads package... (define-structures ((rts-sigevents rts-sigevents-interface) (rts-sigevents-internal rts-sigevents-internal-interface)) (open scheme-level-1 define-record-types threads threads-internal interrupts architecture) (files (rts sigevents)) (optimize auto-integrate)) (define-structures ((threads threads-interface) (threads-internal threads-internal-interface)) (open scheme-level-1 enumerated define-record-types queues interrupts wind fluids fluids-internal ;get-dynamic-env thread-cells-internal ;get-thread-cell-env, empty-thread-cell-env escapes ;primitive-cwcc conditions ;error? handle ;with-handler signals ;signal, warn loopholes ;for converting #f to a continuation architecture ;time-option session-data debug-messages structure-refs) (access primitives) ;time current-thread set-current-thread! etc. (optimize auto-integrate) (files (rts thread) (rts sleep))) (define-structure scheduler scheduler-interface (open scheme-level-1 threads threads-internal enumerated enum-case debug-messages signals) ;error (files (rts scheduler))) (define-structure root-scheduler (export root-scheduler spawn-on-root scheme-exit-now call-when-deadlocked!) (open scheme-level-1 threads threads-internal scheduler structure-refs session-data signals ;error handle ;with-handler i/o ;current-error-port conditions ;warning?, error? writing ;display i/o-internal ;output-port-forcer, output-forcer-id fluids-internal ;get-dynamic-env interrupts ;with-interrupts-inhibited wind ;call-with-current-continuation channel-i/o ;waiting-for-i/o? rts-sigevents-internal) ;waiting-for-os-sigevent? (access primitives) ;unspecific, wait (files (rts root-scheduler))) (define-structure enum-case (export (enum-case :syntax)) (open scheme-level-1 enumerated util) (begin (define-syntax enum-case (syntax-rules (else) ((enum-case enumeration (x ...) clause ...) (let ((temp (x ...))) (enum-case enumeration temp clause ...))) ((enum-case enumeration value ((name ...) body ...) rest ...) (if (or (= value (enum enumeration name)) ...) (begin body ...) (enum-case enumeration value rest ...))) ((enum-case enumeration value (else body ...)) (begin body ...)) ((enum-case enumeration value) (unspecific)))))) (define-structure queues queues-interface (open scheme-level-1 define-record-types signals) (files (big queue)) (optimize auto-integrate)) ; No longer used ;(define-structure linked-queues (compound-interface ; queues-interface ; (export delete-queue-entry! ; queue-head)) ; (open scheme-level-1 define-record-types signals primitives) ; (files (big linked-queue)) ; (optimize auto-integrate)) (define-structure locks locks-interface (open scheme-level-1 define-record-types interrupts threads threads-internal) (optimize auto-integrate) (files (rts lock))) (define-structure usual-resumer (export usual-resumer) (open scheme-level-1 i/o ;initialize-i/o, etc. channel-i/o ;{in,out}put-channel->port, initialize-channel-i/o session-data ;initialize-session-data! fluids-internal ;initialize-dynamic-state! exceptions ;initialize-exceptions! interrupts ;initialize-interrupts! rts-sigevents-internal ;initialize-sigevents! records-internal ;initialize-records! export-the-record-type ;just what it says threads-internal ;start threads root-scheduler) ;start a scheduler (files (rts init))) ; Weak pointers & populations (define-structure weak weak-interface (open scheme-level-1 signals primitives) ;Open primitives instead of loading (alt weak) (files ;;(alt weak) ;Only needed if VM's weak pointers are buggy (rts population))) ; Utility for displaying error messages (define-structure display-conditions display-conditions-interface (open scheme-level-2 writing methods handle) ;ignore-errors (files (env dispcond)))