#| -*-Scheme-*-
-$Id: 6001.pkg,v 1.11 1999/01/02 06:06:43 cph Exp $
+$Id: 6001.pkg,v 1.12 2001/08/18 04:50:08 cph Exp $
Copyright (c) 1991-1999 Massachusetts Institute of Technology
;;;; 6.001 packaging
(global-definitions "../runtime/runtime")
+(global-definitions "../edwin/edwinunx")
(define-package (student)
(parent ()))
;picture-scale
;picture-set!
;picture-v-reflect
- ))
\ No newline at end of file
+ ))
+
+(extend-package (edwin)
+ (files "edextra"))
\ No newline at end of file
#| -*-Scheme-*-
-$Id: make.scm,v 15.31 2001/08/17 13:00:29 cph Exp $
+$Id: make.scm,v 15.32 2001/08/18 04:50:22 cph Exp $
Copyright (c) 1991-1999, 2001 Massachusetts Institute of Technology
(pathname-as-directory "6001")
(lambda ()
(load-package-set "6001")
- (let ((edwin (->environment '(edwin))))
- (load "edextra" edwin)
- (if (and (eq? 'UNIX microcode-id/operating-system)
- (string-ci=? "HP-UX" microcode-id/operating-system-variant))
- (load "floppy" edwin)))))))
-((access initialize-package! (->environment '(student scode-rewriting))))
+ (if (and (eq? 'UNIX microcode-id/operating-system)
+ (string-ci=? "HP-UX" microcode-id/operating-system-variant))
+ (load "floppy" (->environment '(edwin))))))))
(add-identification! "6.001" 15 30)
;;; Customize the runtime system:
#| -*-Scheme-*-
-$Id: make.scm,v 4.112 2001/08/17 13:00:45 cph Exp $
+$Id: make.scm,v 4.113 2001/08/18 04:52:33 cph Exp $
Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
(load-option 'HASH-TABLE)
(load-option 'RB-TREE)
(load-package-set "compiler")))
- (let ((initialize-package!
- (lambda (package-name)
- ((environment-lookup (->environment package-name)
- 'INITIALIZE-PACKAGE!)))))
- (initialize-package! '(COMPILER MACROS))
- (initialize-package! '(COMPILER DECLARATIONS)))
(add-identification! (string-append "Liar (" architecture-name ")") 4 111))
\ No newline at end of file
#| -*-Scheme-*-
-$Id: conpkg.scm,v 1.10 2001/08/16 20:02:58 cph Exp $
+$Id: conpkg.scm,v 1.11 2001/08/18 04:48:34 cph Exp $
Copyright (c) 1988-2001 Massachusetts Institute of Technology
(define (construct-external-descriptions pmodel)
(let* ((packages (pmodel/packages pmodel))
(alist
- (map (lambda (package)
- (cons package (construct-external-description package)))
- packages)))
+ (append! (map (lambda (package)
+ (cons package
+ (construct-external-description package #f)))
+ packages)
+ (map (lambda (package)
+ (cons package
+ (construct-external-description package #t)))
+ (list-transform-positive
+ (pmodel/extra-packages pmodel)
+ (lambda (package)
+ (pair? (package/files package))))))))
(vector 'PACKAGE-DESCRIPTIONS ;tag
2 ;version
(list->vector
- (map (lambda (package)
- (cdr (assq package alist)))
- (sort packages package-structure<?)))
+ (map cdr
+ (sort alist
+ (lambda (a b)
+ (package-structure<? (car a) (car b))))))
(list->vector (map cdr alist)))))
-(define (construct-external-description package)
+(define (construct-external-description package extension?)
(call-with-values
(lambda ()
(split-bindings-list (package/sorted-bindings package)))
- (lambda (internal external)
+ (lambda (internal exports imports)
(vector (package/name package)
(let loop ((package package))
(let ((parent (package/parent package)))
(package/file-cases package))
(package/initialization package)
(package/finalization package)
+ (list->vector internal)
(list->vector
- (map binding/name
- (list-transform-negative internal
- (lambda (binding)
- (pair? (binding/links binding))))))
- (list->vector
- (map (lambda (binding)
+ (map (lambda (n.l)
(list->vector
- (cons (binding/name binding)
+ (cons (car n.l)
(map (lambda (link)
(let ((dest (link/destination link)))
(cons (package/name
(binding/package dest))
(binding/name dest))))
- (binding/links binding)))))
- (list-transform-positive internal
- (lambda (binding)
- (pair? (binding/links binding))))))
+ (cdr n.l)))))
+ exports))
(list->vector
- (map (lambda (binding)
- (let ((source (binding/source-binding binding)))
- (if (eq? (binding/name binding) (binding/name source))
- (vector (binding/name binding)
+ (map (lambda (n.s)
+ (let ((name (car n.s))
+ (source (cdr n.s)))
+ (if (eq? name (binding/name source))
+ (vector name
(package/name (binding/package source)))
- (vector (binding/name binding)
+ (vector name
(package/name (binding/package source))
(binding/name source)))))
- external))))))
-
+ imports))
+ extension?))))
+\f
(define (split-bindings-list bindings)
- (let loop ((bindings bindings) (internal '()) (external '()))
+ (let loop ((bindings bindings) (internal '()) (exports '()) (imports '()))
(if (pair? bindings)
- (if (binding/internal? (car bindings))
- (loop (cdr bindings)
- (cons (car bindings) internal)
- external)
- (loop (cdr bindings)
- internal
- (cons (car bindings) external)))
- (values (reverse! internal) (reverse! external)))))
+ (let ((binding (car bindings))
+ (bindings (cdr bindings)))
+ (let ((name (binding/name binding))
+ (source (binding/source-binding binding))
+ (links
+ (list-transform-positive (binding/links binding) link/new?)))
+ (if (and source
+ (or (binding/new? binding)
+ (pair? links)))
+ (if (eq? binding source)
+ (if (pair? links)
+ (loop bindings
+ internal
+ (cons (cons name links) exports)
+ imports)
+ (loop bindings
+ (cons name internal)
+ exports
+ imports))
+ (loop bindings
+ internal
+ exports
+ (cons (cons name source) imports)))
+ (loop bindings internal exports imports))))
+ (values (reverse! internal) (reverse! exports) (reverse! imports)))))
(define (package-structure<? x y)
(cond ((package/topological<? x y) true)
#| -*-Scheme-*-
-$Id: make.scm,v 1.22 2001/08/17 13:00:53 cph Exp $
+$Id: make.scm,v 1.23 2001/08/18 04:48:16 cph Exp $
Copyright (c) 1988-2001 Massachusetts Institute of Technology
(lambda ()
(load-option 'RB-TREE)
(load-package-set "cref")))))
-(add-identification! "CREF" 2 0)
\ No newline at end of file
+(add-identification! "CREF" 2 1)
\ No newline at end of file
#| -*-Scheme-*-
-$Id: object.scm,v 1.11 2001/08/15 02:59:54 cph Exp $
+$Id: object.scm,v 1.12 2001/08/18 04:48:44 cph Exp $
Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
(type vector)
(named (string->symbol "#[(cross-reference)pmodel]"))
(conc-name pmodel/))
- (root-package false read-only true)
- (primitive-package false read-only true)
- (packages false read-only true)
- (extra-packages false read-only true)
- (pathname false read-only true))
+ (root-package #f read-only #t)
+ (primitive-package #f read-only #t)
+ (packages #f read-only #t)
+ (extra-packages #f read-only #t)
+ (pathname #f read-only #t))
(define-structure
(package
(binding
(type vector)
(named (string->symbol "#[(cross-reference)binding]"))
- (constructor %make-binding (package name value-cell))
+ (constructor %make-binding (package name value-cell new?))
(conc-name binding/)
(print-procedure
(standard-unparser-method 'BINDING
(write (binding/name binding) port)
(write-char #\space port)
(write (package/name (binding/package binding)) port)))))
- (package false read-only true)
- (name false read-only true)
- (value-cell false read-only true)
+ (package #f read-only #t)
+ (name #f read-only #t)
+ (value-cell #f read-only #t)
+ (new? #f)
(references '())
(links '()))
-(define (make-binding package name value-cell)
- (let ((binding (%make-binding package name value-cell)))
+(define (make-binding package name value-cell new?)
+ (let ((binding (%make-binding package name value-cell new?)))
(set-value-cell/bindings!
value-cell
(cons binding (value-cell/bindings value-cell)))
(conc-name value-cell/))
(bindings '())
(expressions '())
- (source-binding false))
+ (source-binding #f))
(define-structure
(link
(type vector)
(named (string->symbol "#[(cross-reference)link]"))
- (constructor %make-link)
+ (constructor %make-link (source destination new?))
(conc-name link/))
- (source false read-only true)
- (destination false read-only true))
+ (source #f read-only #t)
+ (destination #f read-only #t)
+ (new? #f read-only #t))
-(define (make-link source-binding destination-binding)
- (let ((link (%make-link source-binding destination-binding)))
+(define (make-link source-binding destination-binding new?)
+ (let ((link (%make-link source-binding destination-binding new?)))
(set-binding/links! source-binding
(cons link (binding/links source-binding)))
link))
-
+\f
(define-structure
(expression
(type vector)
(named (string->symbol "#[(cross-reference)expression]"))
(constructor make-expression (package file type))
(conc-name expression/))
- (package false read-only true)
- (file false read-only true)
- (type false read-only true)
+ (package #f read-only #t)
+ (file #f read-only #t)
+ (type #f read-only #t)
(references '())
- (value-cell false))
+ (value-cell #f))
(define-structure
(reference
(write (reference/name reference) port)
(write-char #\space port)
(write (package/name (reference/package reference)) port)))))
- (package false read-only true)
- (name false read-only true)
+ (package #f read-only #t)
+ (name #f read-only #t)
(expressions '())
- (binding false))
-\f
+ (binding #f))
+
(define (symbol-list=? x y)
- (if (null? x)
- (null? y)
- (and (not (null? y))
+ (if (pair? x)
+ (and (pair? y)
(eq? (car x) (car y))
- (symbol-list=? (cdr x) (cdr y)))))
+ (symbol-list=? (cdr x) (cdr y)))
+ (not (pair? y))))
(define (symbol-list<? x y)
- (and (not (null? y))
- (if (or (null? x)
- (symbol<? (car x) (car y)))
- true
+ (and (pair? y)
+ (or (not (pair? x))
+ (symbol<? (car x) (car y))
(and (eq? (car x) (car y))
(symbol-list<? (cdr x) (cdr y))))))
#| -*-Scheme-*-
-$Id: redpkg.scm,v 1.15 2001/08/16 20:50:26 cph Exp $
+$Id: redpkg.scm,v 1.16 2001/08/18 04:48:59 cph Exp $
Copyright (c) 1988-2001 Massachusetts Institute of Technology
(changes? (list #f)))
(let ((result
(let ((caches (if (file-exists? pathname) (fasload pathname) '())))
- (append-map! (lambda (package)
- (map (lambda (pathname)
- (cons package
- (cache-file-analysis! pmodel
- caches
- pathname
- changes?)))
- (package/files package)))
- (pmodel/packages pmodel)))))
+ (let ((cache-packages
+ (lambda (packages)
+ (append-map!
+ (lambda (package)
+ (map (lambda (pathname)
+ (cons package
+ (cache-file-analysis! pmodel
+ caches
+ pathname
+ changes?)))
+ (package/files package)))
+ packages))))
+ (append! (cache-packages (pmodel/packages pmodel))
+ (cache-packages (pmodel/extra-packages pmodel)))))))
(if (car changes?)
(fasdump (map cdr result) pathname))
(values result (car changes?)))))
(else
(error "Illegal reference name" name)))))
(if name
- (bind! package name expression)))))
+ (bind! package name expression #t)))))
entries))
(define (resolve-references! pmodel)
(set-package/children!
parent
(cons package (package/children parent)))))
- (process-package-description package description get-package))
+ (process-package-description package description get-package #t))
packages
descriptions)
(for-each
(process-package-description
(get-package (package-description/name extension) #f)
extension
- get-package))
+ get-package
+ #f))
extensions))
(make-pmodel root-package
(make-package primitive-package-name #f)
;; Unlinked internal names: just bind them.
(for-each-vector-element (vector-ref desc 5)
(lambda (name)
- (bind! package name expression)))
- ;; Exported bindings: bind the internal and external names.
- ;; Perhaps should link them here.
+ (bind! package name expression #f)))
+ ;; Exported bindings: bind the name and link it to the
+ ;; external names.
(for-each-vector-element (vector-ref desc 6)
(lambda (entry)
- (bind! package (vector-ref entry 0) expression)
- (let ((n (vector-length entry)))
- (do ((i 1 (fix:+ i 1)))
- ((fix:= i n))
- (let ((p.n (vector-ref entry i)))
- (bind! (get-package (car p.n) #t)
- (cdr p.n)
- expression))))))
- ;; Imported bindings: bind just the internal name.
+ (let ((name (vector-ref entry 0)))
+ (bind! package name expression #f)
+ (let ((n (vector-length entry)))
+ (do ((i 1 (fix:+ i 1)))
+ ((fix:= i n))
+ (let ((p.n (vector-ref entry i)))
+ (link! package
+ name
+ (get-package (car p.n) #t)
+ (cdr p.n)
+ #f)))))))
+ ;; Imported bindings: bind just the external name and link
+ ;; it to the internal name.
(for-each-vector-element (vector-ref desc 7)
(lambda (entry)
- (bind! package (vector-ref entry 0) expression))))))))
-
+ (let ((external-package (get-package (vector-ref entry 1) #t))
+ (external-name
+ (if (fix:= (vector-length entry) 2)
+ (vector-ref entry 0)
+ (vector-ref entry 2))))
+ (bind! external-package external-name expression #f)
+ (link! external-package
+ external-name
+ package
+ (vector-ref entry 0)
+ #f)))))))))
+\f
(define (package-lookup package name)
(let package-loop ((package package))
(or (package/find-binding package name)
(lambda (package)
(symbol-list=? name (package/name package)))))
-(define (process-package-description package description get-package)
+(define (process-package-description package description get-package new?)
(let ((file-cases (package-description/file-cases description)))
(set-package/file-cases! package
(append! (package/file-cases package)
(let ((destination (get-package (car export) #t)))
(for-each (lambda (names)
(link! package (car names)
- destination (cdr names)))
+ destination (cdr names)
+ new?))
(cdr export))))
(package-description/exports description))
(for-each (lambda (import)
(let ((source (get-package (car import) #t)))
(for-each (lambda (names)
(link! source (cdr names)
- package (car names)))
+ package (car names)
+ new?))
(cdr import))))
(package-description/imports description)))
\f
;;;; Binding and Reference
-(define (bind! package name expression)
- (let ((value-cell (binding/value-cell (intern-binding! package name))))
+(define (bind! package name expression new?)
+ (let ((value-cell (binding/value-cell (intern-binding! package name new?))))
(set-expression/value-cell! expression value-cell)
(set-value-cell/expressions!
value-cell
(cons expression (value-cell/expressions value-cell)))))
-(define (link! source-package source-name destination-package destination-name)
- (if (package/find-binding destination-package destination-name)
- (error "Attempt to reinsert binding" destination-name))
- (let ((source-binding (intern-binding! source-package source-name)))
+(define (link! source-package source-name
+ destination-package destination-name
+ new?)
+ (let ((source-binding (intern-binding! source-package source-name new?))
+ (destination-binding
+ (package/find-binding destination-package destination-name)))
+ (if (and destination-binding
+ (not (eq? (binding/value-cell destination-binding)
+ (binding/value-cell source-binding))))
+ (error "Attempt to reinsert binding:" destination-name))
(let ((destination-binding
(make-binding destination-package
destination-name
- (binding/value-cell source-binding))))
+ (binding/value-cell source-binding)
+ new?)))
(rb-tree/insert! (package/bindings destination-package)
destination-name
destination-binding)
- (make-link source-binding destination-binding))))
-
-(define (intern-binding! package name)
- (or (package/find-binding package name)
- (let ((binding
- (let ((value-cell (make-value-cell)))
- (let ((binding (make-binding package name value-cell)))
- (set-value-cell/source-binding! value-cell binding)
- binding))))
- (rb-tree/insert! (package/bindings package) name binding)
- binding)))
+ (make-link source-binding destination-binding new?))))
+
+(define (intern-binding! package name new?)
+ (let ((binding (package/find-binding package name)))
+ (if binding
+ (begin
+ (if new? (set-binding/new?! binding #t))
+ binding)
+ (let ((binding
+ (let ((value-cell (make-value-cell)))
+ (let ((binding (make-binding package name value-cell new?)))
+ (set-value-cell/source-binding! value-cell binding)
+ binding))))
+ (rb-tree/insert! (package/bindings package) name binding)
+ binding))))
(define (make-reference package name expression)
(let ((references (package/references package))
#| -*-Scheme-*-
-$Id: triv.pkg,v 1.4 2001/08/16 20:59:56 cph Exp $
+$Id: triv.pkg,v 1.5 2001/08/18 04:49:06 cph Exp $
Copyright (c) 2001 Massachusetts Institute of Technology
(let ((v
(let ((package
- (lambda (package-name ancestors files exported-names)
+ (lambda (package-name ancestors files
+ exported-names imported-names)
(vector package-name
ancestors
(list (cons #f files))
(map (lambda (name)
(vector name (cons (car ancestors) name)))
exported-names))
- '#()))))
+ (list->vector
+ (map (lambda (n.p)
+ (vector (car n.p) (cdr n.p)))
+ imported-names))
+ #f))))
(vector (package '(cross-reference)
'(())
'("mset" "object" "toplev")
cref/generate-constructors
cref/generate-cref
cref/generate-cref-unusual
- cref/generate-trivial-constructor))
+ cref/generate-trivial-constructor)
+ '())
(package '(cross-reference analyze-file)
'((cross-reference) ())
'("anfile")
- '(analyze-file))
+ '(analyze-file)
+ '())
(package '(cross-reference constructor)
'((cross-reference) ())
'("conpkg")
- '(construct-external-descriptions))
-
+ '(construct-external-descriptions)
+ '())
(package '(cross-reference formatter)
'((cross-reference) ())
'("forpkg")
'(format-packages
- format-packages-unusual))
-
+ format-packages-unusual)
+ '())
(package '(cross-reference reader)
'((cross-reference) ())
'("redpkg")
'(read-file-analyses!
read-package-model
- resolve-references!))))))
+ resolve-references!)
+ '((package-file? . (package))))))))
(vector 'PACKAGE-DESCRIPTIONS 2 v v))
\ No newline at end of file
#| -*-Scheme-*-
-$Id: packag.scm,v 14.31 2001/08/17 12:50:15 cph Exp $
+$Id: packag.scm,v 14.32 2001/08/18 04:47:26 cph Exp $
Copyright (c) 1988-1999, 2001 Massachusetts Institute of Technology
(load component environment syntax-table #t)))))))
(if alternate-loader
(alternate-loader load-component options)
- (load-packages-from-file file options load-component))))))))
+ (begin
+ (load-packages-from-file file options load-component)
+ (initialize-packages-from-file file)))))))))
;; Make sure that everything we just loaded is purified. If the
;; program runs before it gets purified, some of its run-time state
;; can end up being purified also.
(finalization #f read-only #t)
(internal-names #f read-only #t)
(internal-bindings #f read-only #t)
- (external-bindings #f read-only #t))
+ (external-bindings #f read-only #t)
+ (extension? #f read-only #t))
(define (package-file? object)
(and (vector? object)
(define (package-description? object)
(and (vector? object)
- (fix:= (vector-length object) 8)
+ (fix:= (vector-length object) 9)
(package-name? (package-description/name object))
(list-of-type? (package-description/ancestors object) package-name?)
(list-of-type? (package-description/file-cases object)
(symbol? (vector-ref binding 0))
(package-name? (vector-ref binding 1))
(or (fix:= (vector-length binding) 2)
- (symbol? (vector-ref binding 2))))))))
+ (symbol? (vector-ref binding 2))))))
+ (boolean? (package-description/extension? object))))
\f
+;; CONSTRUCT-PACKAGES-FROM-FILE is called from the cold load and must
+;; only use procedures that are inline-coded by the compiler.
+
(define (construct-packages-from-file file)
(let ((descriptions (package-file/sorted-descriptions file))
(skip-package?
(define (construct-normal-package-from-description description)
(let ((name (package-description/name description))
+ (extension? (package-description/extension? description))
(environment
(extend-package-environment
(let ((ancestors (package-description/ancestors description)))
(or (package/child package (car path))
(error "Unable to find package:"
(list-difference name (cdr path)))))
- (package/add-child! package (car path) environment)))))
+ (if (not (and extension? (package/child package (car path))))
+ (package/add-child! package (car path) environment))))))
(define (create-links-from-description description)
(let ((environment
(define-primitives
link-variables)
\f
+;; LOAD-PACKAGES-FROM-FILE is called from the cold load and must only
+;; use procedures that are inline-coded by the compiler.
+
(define (load-packages-from-file file options file-loader)
(let ((descriptions (package-file/descriptions file)))
(let ((n (vector-length descriptions)))
(and (pair? options)
(if (eq? (car (car options)) key)
(cdr (car options))
- (loop (cdr options))))))
\ No newline at end of file
+ (loop (cdr options))))))
+
+(define (initialize-packages-from-file file)
+ (initialize/finalize file package-description/initialization "Initializing"))
+
+(define (finalize-packages-from-file file)
+ (initialize/finalize file package-description/finalization "Finalizing"))
+
+(define (initialize/finalize file selector verb)
+ (for-each-vector-element (package-file/descriptions file)
+ (lambda (description)
+ (let ((expression (selector description)))
+ (if expression
+ (let ((name (package-description/name description))
+ (port (notification-output-port)))
+ (fresh-line port)
+ (write-string ";" port)
+ (write-string verb port)
+ (write-string " package " port)
+ (write name port)
+ (eval expression (find-package-environment name))
+ (write-string " -- done" port)
+ (newline port)))))))
\ No newline at end of file
#| -*-Scheme-*-
-$Id: make.scm,v 1.7 2001/08/17 13:01:32 cph Exp $
+$Id: make.scm,v 1.8 2001/08/18 04:52:08 cph Exp $
Copyright (c) 1993-1999, 2001 Massachusetts Institute of Technology
;;;; Win32 subsystem: System Construction
(declare (usual-integrations))
-\f
+
(with-working-directory-pathname (directory-pathname (current-load-pathname))
(lambda ()
((access with-directory-rewriting-rule
(lambda ()
(load "ffimacro")
(load-package-set "win32")))))
-
-;((package/reference (find-package '(WIN32))
-; 'INITIALIZE-PACKAGE!))
-(add-identification! "Win32" 1 5)
-
-
-(define (package-initialize package-name procedure-name mandatory?)
- (define (print-name string)
- (display "\n")
- (display string)
- (display " (")
- (let loop ((name package-name))
- (if (not (null? name))
- (begin
- (if (not (eq? name package-name))
- (display " "))
- (display (system-pair-car (car name)))
- (loop (cdr name)))))
- (display ")"))
-
- (define (package-reference name)
- (package/environment (find-package name)))
-
- (let ((env (package-reference package-name)))
- (cond ((not (lexical-unreferenceable? env procedure-name))
- (print-name "initialize:")
- (if (not (eq? procedure-name 'INITIALIZE-PACKAGE!))
- (begin
- (display " [")
- (display (system-pair-car procedure-name))
- (display "]")))
- ((lexical-reference env procedure-name)))
- ((not mandatory?)
- (print-name "* skipping:"))
- (else
- ;; Missing mandatory package! Report it and die.
- (print-name "Package")
- (display " is missing initialization procedure ")
- (display (system-pair-car procedure-name))
- (fatal-error "Could not initialize a required package.")))))
-
-
-(package-initialize '(win32) 'initialize-protection-list-package! #t)
-(package-initialize '(win32) 'initialize-module-package! #t)
-(package-initialize '(win32) 'initialize-package! #t)
-(package-initialize '(win32) 'init-wf_user! #t)
-(package-initialize '(win32 scheme-graphics) 'initialize-package! #t)
-(package-initialize '(win32 dib) 'initialize-package! #t)
\ No newline at end of file
+(add-identification! "Win32" 1 5)
\ No newline at end of file
#| -*-Scheme-*-
-$Id: win32.pkg,v 1.12 2000/04/13 03:13:46 cph Exp $
+$Id: win32.pkg,v 1.13 2001/08/18 04:52:11 cph Exp $
-Copyright (c) 1993-2000 Massachusetts Institute of Technology
+Copyright (c) 1993-2001 Massachusetts Institute of Technology
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
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+USA.
|#
;;;; WIN32 Packaging
\f
(global-definitions "../runtime/runtime")
-;(define-package (win32)
-; (parent ())
-; (file-case os-type
-; ((nt) "winuser" "wingdi" "win_ffi")
-; (else))
-; (initialization (initialize-package!)))
-
(define-package (win32)
(parent ())
(files "winuser"
win32-clipboard-write-text
win32-screen-height
win32-screen-width)
- (initialization (initialize-package!))
-)
+ (initialization
+ (begin
+ (initialize-protection-list-package!)
+ (initialize-module-package!)
+ (initialize-package!)
+ (init-wf_user!))))
(define-package (win32 scheme-graphics)
(files "graphics")
(parent (win32))
-; (export ()
-; win32-graphics-device-type)
(export ()
win32/define-color
win32/find-color)
(import (runtime graphics)
graphics-device/buffer?
make-image-type)
- (initialization (initialize-package!))
-)
+ (initialization (initialize-package!)))
(define-package (win32 dib)
(files "dib")
- (parent (win32)))
\ No newline at end of file
+ (parent (win32))
+ (initialization (initialize-package!)))
\ No newline at end of file
projects / mit-scheme.git / commitdiff