#| -*-Scheme-*-
-$Id: bitstr.scm,v 14.3 1999/01/02 06:11:34 cph Exp $
+$Id: bitstr.scm,v 14.4 2001/12/18 18:39:17 cph Exp $
-Copyright (c) 1988, 1999 Massachusetts Institute of Technology
+Copyright (c) 1988, 1999, 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.
|#
;;;; Bit String Primitives
-;;; package: ()
+;;; package: (runtime bit-string)
(declare (usual-integrations))
\f
(define-primitives
- bit-string-allocate make-bit-string bit-string?
- bit-string-length bit-string-ref bit-string-clear! bit-string-set!
- bit-string-zero? bit-string=?
- bit-string-fill! bit-string-move! bit-string-movec!
- bit-string-or! bit-string-and! bit-string-andc!
- bit-string-xor! bit-substring-move-right!
- bit-string->unsigned-integer unsigned-integer->bit-string
- read-bits! write-bits!
- bit-substring-find-next-set-bit)
+ bit-string-allocate make-bit-string bit-string?
+ bit-string-length bit-string-ref bit-string-clear! bit-string-set!
+ bit-string-zero? bit-string=?
+ bit-string-fill! bit-string-move! bit-string-movec!
+ bit-string-or! bit-string-and! bit-string-andc!
+ bit-string-xor! bit-substring-move-right!
+ bit-string->unsigned-integer unsigned-integer->bit-string
+ read-bits! write-bits!
+ bit-substring-find-next-set-bit)
(define (bit-string-copy bit-string)
(let ((result (bit-string-allocate (bit-string-length bit-string))))
#| -*-Scheme-*-
-$Id: blowfish.scm,v 1.23 2001/03/08 19:27:33 cph Exp $
+$Id: blowfish.scm,v 1.24 2001/12/18 18:39:19 cph Exp $
Copyright (c) 1997-2001 Massachusetts Institute of Technology
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.
|#
;;;; Interface to Blowfish
-;;; package: ()
+;;; package: (runtime blowfish)
(declare (usual-integrations))
\f
#| -*-Scheme-*-
-$Id: boole.scm,v 14.3 1999/01/02 06:11:34 cph Exp $
+$Id: boole.scm,v 14.4 2001/12/18 18:39:22 cph Exp $
-Copyright (c) 1988, 1999 Massachusetts Institute of Technology
+Copyright (c) 1988, 1999, 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.
|#
;;;; Boolean Operations
-;;; package: ()
+;;; package: (runtime boolean)
(declare (usual-integrations))
-\f
+
(define-primitives not (false? not))
-(define false #F)
-(define true #T)
+(define false #f)
+(define true #t)
(define (boolean? object)
- (or (eq? object #F)
- (eq? object #T)))
+ (or (eq? object #f)
+ (eq? object #t)))
(define (boolean=? x y)
(if x y (not y)))
(define (boolean/or . arguments)
(let loop ((arguments arguments))
- (cond ((null? arguments) false)
- ((car arguments) true)
- (else (loop (cdr arguments))))))
+ (if (pair? arguments)
+ (if (car arguments)
+ #t
+ (loop (cdr arguments)))
+ #f)))
(define (boolean/and . arguments)
(let loop ((arguments arguments))
- (cond ((null? arguments) true)
- ((car arguments) (loop (cdr arguments)))
- (else false))))
+ (if (pair? arguments)
+ (if (car arguments)
+ (loop (cdr arguments))
+ #f)
+ #t)))
(define (there-exists? items predicate)
(let loop ((items items))
- (and (not (null? items))
- (or (predicate (car items))
- (loop (cdr items))))))
+ (if (pair? items)
+ (or (predicate (car items))
+ (loop (cdr items)))
+ #f)))
(define (for-all? items predicate)
(let loop ((items items))
- (or (null? items)
- (and (predicate (car items))
- (loop (cdr items))))))
\ No newline at end of file
+ (if (pair? items)
+ (if (predicate (car items))
+ (loop (cdr items))
+ #f)
+ #t)))
\ No newline at end of file
#| -*-Scheme-*-
-$Id: boot.scm,v 14.12 1999/01/02 06:11:34 cph Exp $
+$Id: boot.scm,v 14.13 2001/12/18 18:39:24 cph Exp $
-Copyright (c) 1988-1999 Massachusetts Institute of Technology
+Copyright (c) 1988-1999, 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.
|#
;;;; Boot Time Definitions
-;;; package: ()
+;;; package: (runtime boot-definitions)
(declare (usual-integrations))
\f
#| -*- Scheme -*-
-$Id: ed-ffi.scm,v 1.30 2001/11/11 05:58:39 cph Exp $
+$Id: ed-ffi.scm,v 1.31 2001/12/18 18:39:26 cph Exp $
Copyright (c) 1988-2001 Massachusetts Institute of Technology
(declare (usual-integrations))
\f
(standard-scheme-find-file-initialization
- '#(
- ("advice" (runtime advice)
- syntax-table/system-internal)
- ("apply" (runtime apply)
- syntax-table/system-internal)
- ("apropos" (runtime apropos)
- syntax-table/system-internal)
- ("arith" (runtime number)
- syntax-table/system-internal)
- ("bitstr" ()
- syntax-table/system-internal)
- ("blowfish" ()
- syntax-table/system-internal)
- ("boole" ()
- syntax-table/system-internal)
- ("boot" ()
- syntax-table/system-internal)
- ("char" (runtime character)
- syntax-table/system-internal)
- ("chrset" (runtime character-set)
- syntax-table/system-internal)
- ("chrsyn" (runtime char-syntax)
- syntax-table/system-internal)
- ("codwlk" (runtime scode-walker)
- syntax-table/system-internal)
- ("conpar" (runtime continuation-parser)
- syntax-table/system-internal)
- ("contin" (runtime continuation)
- syntax-table/system-internal)
- ("cpoint" (runtime control-point)
- syntax-table/system-internal)
- ("cpress" (runtime compress)
- syntax-table/system-internal)
- ("crypto" (runtime crypto)
- syntax-table/system-internal)
- ("datime" (runtime date/time)
- syntax-table/system-internal)
- ("dbgcmd" (runtime debugger-command-loop)
- syntax-table/system-internal)
- ("dbgutl" (runtime debugger-utilities)
- syntax-table/system-internal)
- ("debug" (runtime debugger)
- syntax-table/system-internal)
- ("defstr" (runtime defstruct)
- syntax-table/system-internal)
- ("dosdir" (runtime directory)
- syntax-table/system-internal)
- ("dosprm" ()
- syntax-table/system-internal)
- ("dosproc" ()
- syntax-table/system-internal)
- ("dospth" (runtime pathname dos)
- syntax-table/system-internal)
- ("dragon4" (runtime number)
- syntax-table/system-internal)
- ("emacs" (runtime emacs-interface)
- syntax-table/system-internal)
- ("equals" ()
- syntax-table/system-internal)
- ("error" (runtime error-handler)
- syntax-table/system-internal)
- ("events" (runtime event-distributor)
- syntax-table/system-internal)
- ("fileio" (runtime file-i/o-port)
- syntax-table/system-internal)
- ("fixart" ()
- syntax-table/system-internal)
- ("format" (runtime format)
- syntax-table/system-internal)
- ("framex" (runtime debugging-info)
- syntax-table/system-internal)
- ("gc" (runtime garbage-collector)
- syntax-table/system-internal)
- ("gcdemn" (runtime gc-daemons)
- syntax-table/system-internal)
- ("gcfinal" (runtime gc-finalizer)
- syntax-table/system-internal)
- ("gcnote" (runtime gc-notification)
- syntax-table/system-internal)
- ("gcstat" (runtime gc-statistics)
- syntax-table/system-internal)
- ("gdatab" (runtime global-database)
- syntax-table/system-internal)
- ("gdbm" (runtime gdbm)
- syntax-table/system-internal)
- ("gencache" (runtime generic-procedure)
- syntax-table/system-internal)
- ("geneqht" (runtime generic-procedure)
- syntax-table/system-internal)
- ("generic" (runtime generic-procedure)
- syntax-table/system-internal)
- ("genio" (runtime generic-i/o-port)
- syntax-table/system-internal)
- ("genmult" (runtime generic-procedure multiplexer)
- syntax-table/system-internal)
- ("gensym" (runtime gensym)
- syntax-table/system-internal)
- ("gentag" (runtime generic-procedure)
- syntax-table/system-internal)
- ("global" ()
- syntax-table/system-internal)
- ("graphics" (runtime graphics)
- syntax-table/system-internal)
- ("hash" (runtime hash)
- syntax-table/system-internal)
- ("hashtb" (runtime hash-table)
- syntax-table/system-internal)
- ("histry" (runtime history)
- syntax-table/system-internal)
- ("illdef" (runtime illegal-definitions)
- syntax-table/system-internal)
- ("infstr" (runtime compiler-info)
- syntax-table/system-internal)
- ("infutl" (runtime compiler-info)
- syntax-table/system-internal)
- ("input" (runtime input-port)
- syntax-table/system-internal)
- ("intrpt" (runtime interrupt-handler)
- syntax-table/system-internal)
- ("io" (runtime primitive-io)
- syntax-table/system-internal)
- ("krypt" (runtime krypt)
- syntax-table/system-internal)
- ("kryptdum" (runtime krypt)
- syntax-table/system-internal)
- ("lambda" (runtime lambda-abstraction)
- syntax-table/system-internal)
- ("lambdx" ()
- syntax-table/system-internal)
- ("list" (runtime list)
- syntax-table/system-internal)
- ("load" (runtime load)
- syntax-table/system-internal)
- ("macros" (runtime macros)
- syntax-table/system-internal)
- ("mime-codec" (runtime mime-codec)
- syntax-table/system-internal)
- ("msort" ()
- syntax-table/system-internal)
- ("ntdir" (runtime directory)
- syntax-table/system-internal)
- ("ntprm" ()
- syntax-table/system-internal)
- ("numint" (runtime number interface)
- syntax-table/system-internal)
- ("numpar" (runtime number-parser)
- syntax-table/system-internal)
- ("option" (runtime options)
- syntax-table/system-internal)
- ("ordvec" (runtime ordered-vector)
- syntax-table/system-internal)
- ("os2ctype" (runtime os2-graphics)
- syntax-table/system-internal)
- ("os2dir" (runtime directory)
- syntax-table/system-internal)
- ("os2graph" (runtime os2-graphics)
- syntax-table/system-internal)
- ("os2prm" ()
- syntax-table/system-internal)
- ("os2winp" (runtime os2-window-primitives)
- syntax-table/system-internal)
- ("output" (runtime output-port)
- syntax-table/system-internal)
- ("packag" (package)
- syntax-table/system-internal)
- ("parse" (runtime parser)
- syntax-table/system-internal)
- ("parser-buffer" (runtime parser-buffer)
- syntax-table/system-internal)
- ("partab" (runtime parser-table)
- syntax-table/system-internal)
- ("pathnm" (runtime pathname)
- syntax-table/system-internal)
- ("poplat" (runtime population)
- syntax-table/system-internal)
- ("port" (runtime port)
- syntax-table/system-internal)
- ("pp" (runtime pretty-printer)
- syntax-table/system-internal)
- ("prgcop" (runtime program-copier)
- syntax-table/system-internal)
- ("process" (runtime subprocess)
- syntax-table/system-internal)
- ("prop1d" (runtime 1d-property)
- syntax-table/system-internal)
- ("prop2d" (runtime 2D-property)
- syntax-table/system-internal)
- ("qsort" ()
- syntax-table/system-internal)
- ("queue" ()
- syntax-table/system-internal)
- ("random" (runtime random-number)
- syntax-table/system-internal)
- ("rbtree" (runtime rb-tree)
- syntax-table/system-internal)
- ("record" (runtime record)
- syntax-table/system-internal)
- ("recslot" (runtime record-slot-access)
- syntax-table/system-internal)
- ("regexp" (runtime regular-expression)
- syntax-table/system-internal)
- ("rep" (runtime rep)
- syntax-table/system-internal)
- ("rexp" (runtime rexp)
- syntax-table/system-internal)
- ("rgxcmp" (runtime regular-expression-compiler)
- syntax-table/system-internal)
- ("savres" (runtime save/restore)
- syntax-table/system-internal)
- ("scan" (runtime scode-scan)
- syntax-table/system-internal)
- ("scode" (runtime scode)
- syntax-table/system-internal)
- ("scomb" (runtime scode-combinator)
- syntax-table/system-internal)
- ("sdata" (runtime scode-data)
- syntax-table/system-internal)
- ("sfile" ()
- syntax-table/system-internal)
- ("socket" (runtime socket)
- syntax-table/system-internal)
- ("starbase" (runtime starbase-graphics)
- syntax-table/system-internal)
- ("stream" (runtime stream)
- syntax-table/system-internal)
- ("string" (runtime string)
- syntax-table/system-internal)
- ("strnin" (runtime string-input)
- syntax-table/system-internal)
- ("strott" (runtime truncated-string-output)
- syntax-table/system-internal)
- ("strout" (runtime string-output)
- syntax-table/system-internal)
- ("symbol" ()
- syntax-table/system-internal)
- ("syncproc" (runtime synchronous-subprocess)
- syntax-table/system-internal)
- ("syntab" (runtime syntax-table)
- syntax-table/system-internal)
- ("syntax" (runtime syntaxer)
- syntax-table/system-internal)
- ("sysclk" (runtime system-clock)
- syntax-table/system-internal)
- ("sysmac" (runtime system-macros)
- syntax-table/system-internal)
- ("system" (runtime system)
- syntax-table/system-internal)
- ("thread" (runtime thread)
- syntax-table/system-internal)
- ("tscript" (runtime transcript)
- syntax-table/system-internal)
- ("ttyio" (runtime console-i/o-port)
- syntax-table/system-internal)
- ("tvector" (runtime tagged-vector)
- syntax-table/system-internal)
- ("udata" ()
- syntax-table/system-internal)
- ("uenvir" (runtime environment)
- syntax-table/system-internal)
- ("uerror" (runtime microcode-errors)
- syntax-table/system-internal)
- ("unicode" (runtime unicode)
- syntax-table/system-internal)
- ("unpars" (runtime unparser)
- syntax-table/system-internal)
- ("unsyn" (runtime unsyntaxer)
- syntax-table/system-internal)
- ("unxdir" (runtime directory)
- syntax-table/system-internal)
- ("unxprm" ()
- syntax-table/system-internal)
- ("unxpth" (runtime pathname unix)
- syntax-table/system-internal)
- ("uproc" (runtime procedure)
- syntax-table/system-internal)
- ("urtrap" (runtime reference-trap)
- syntax-table/system-internal)
- ("usrint" (runtime user-interface)
- syntax-table/system-internal)
- ("utabs" (runtime microcode-tables)
- syntax-table/system-internal)
- ("vector" ()
- syntax-table/system-internal)
- ("version" (runtime)
- syntax-table/system-internal)
- ("where" (runtime environment-inspector)
- syntax-table/system-internal)
- ("wind" (runtime state-space)
- syntax-table/system-internal)
- ("wrkdir" (runtime working-directory)
- syntax-table/system-internal)
- ("wttree" (runtime wt-tree)
- syntax-table/system-internal)
- ("x11graph" (runtime X-graphics)
- syntax-table/system-internal)
- ("xeval" (runtime extended-scode-eval)
- syntax-table/system-internal)
- ("ystep" (runtime stepper)
- syntax-table/system-internal)))
\ No newline at end of file
+ '#(("advice" (runtime advice))
+ ("apply" (runtime apply))
+ ("apropos" (runtime apropos))
+ ("arith" (runtime number))
+ ("bitstr" (runtime bit-string))
+ ("blowfish" (runtime blowfish))
+ ("boole" (runtime boolean))
+ ("boot" (runtime boot-definitions))
+ ("char" (runtime character))
+ ("chrset" (runtime character-set))
+ ("chrsyn" (runtime char-syntax))
+ ("codwlk" (runtime scode-walker))
+ ("conpar" (runtime continuation-parser))
+ ("contin" (runtime continuation))
+ ("cpoint" (runtime control-point))
+ ("cpress" (runtime compress))
+ ("crypto" (runtime crypto))
+ ("datime" (runtime date/time))
+ ("dbgcmd" (runtime debugger-command-loop))
+ ("dbgutl" (runtime debugger-utilities))
+ ("debug" (runtime debugger))
+ ("defstr" (runtime defstruct))
+ ("dospth" (runtime pathname dos))
+ ("dragon4" (runtime number))
+ ("emacs" (runtime emacs-interface))
+ ("equals" (runtime equality))
+ ("error" (runtime error-handler))
+ ("events" (runtime event-distributor))
+ ("fileio" (runtime file-i/o-port))
+ ("fixart" (runtime fixnum-arithmetic))
+ ("format" (runtime format))
+ ("framex" (runtime debugging-info))
+ ("gc" (runtime garbage-collector))
+ ("gcdemn" (runtime gc-daemons))
+ ("gcfinal" (runtime gc-finalizer))
+ ("gcnote" (runtime gc-notification))
+ ("gcstat" (runtime gc-statistics))
+ ("gdatab" (runtime global-database))
+ ("gdbm" (runtime gdbm))
+ ("gencache" (runtime generic-procedure))
+ ("geneqht" (runtime generic-procedure))
+ ("generic" (runtime generic-procedure))
+ ("genio" (runtime generic-i/o-port))
+ ("genmult" (runtime generic-procedure multiplexer))
+ ("gensym" (runtime gensym))
+ ("gentag" (runtime generic-procedure))
+ ("global" (runtime miscellaneous-global))
+ ("graphics" (runtime graphics))
+ ("hash" (runtime hash))
+ ("hashtb" (runtime hash-table))
+ ("histry" (runtime history))
+ ("illdef" (runtime illegal-definitions))
+ ("infstr" (runtime compiler-info))
+ ("infutl" (runtime compiler-info))
+ ("input" (runtime input-port))
+ ("intrpt" (runtime interrupt-handler))
+ ("io" (runtime primitive-io))
+ ("krypt" (runtime krypt))
+ ("kryptdum" (runtime krypt))
+ ("lambda" (runtime lambda-abstraction))
+ ("lambdx" (runtime alternative-lambda))
+ ("list" (runtime list))
+ ("load" (runtime load))
+ ("macros" (runtime macros))
+ ("mime-codec" (runtime mime-codec))
+ ("msort" (runtime merge-sort))
+ ("ntdir" (runtime directory))
+ ("ntprm" (runtime os-primitives))
+ ("numint" (runtime number interface))
+ ("numpar" (runtime number-parser))
+ ("option" (runtime options))
+ ("ordvec" (runtime ordered-vector))
+ ("os2ctype" (runtime os2-graphics))
+ ("os2dir" (runtime directory))
+ ("os2graph" (runtime os2-graphics))
+ ("os2prm" (runtime os-primitives))
+ ("os2winp" (runtime os2-window-primitives))
+ ("output" (runtime output-port))
+ ("packag" (package))
+ ("parse" (runtime parser))
+ ("parser-buffer" (runtime parser-buffer))
+ ("partab" (runtime parser-table))
+ ("pathnm" (runtime pathname))
+ ("poplat" (runtime population))
+ ("port" (runtime port))
+ ("pp" (runtime pretty-printer))
+ ("prgcop" (runtime program-copier))
+ ("process" (runtime subprocess))
+ ("prop1d" (runtime 1d-property))
+ ("prop2d" (runtime 2D-property))
+ ("qsort" (runtime quick-sort))
+ ("queue" (runtime simple-queue))
+ ("random" (runtime random-number))
+ ("rbtree" (runtime rb-tree))
+ ("record" (runtime record))
+ ("recslot" (runtime record-slot-access))
+ ("regexp" (runtime regular-expression))
+ ("rep" (runtime rep))
+ ("rexp" (runtime rexp))
+ ("rgxcmp" (runtime regular-expression-compiler))
+ ("savres" (runtime save/restore))
+ ("scan" (runtime scode-scan))
+ ("scode" (runtime scode))
+ ("scomb" (runtime scode-combinator))
+ ("sdata" (runtime scode-data))
+ ("sfile" (runtime simple-file-ops))
+ ("socket" (runtime socket))
+ ("starbase" (runtime starbase-graphics))
+ ("stream" (runtime stream))
+ ("string" (runtime string))
+ ("strnin" (runtime string-input))
+ ("strott" (runtime truncated-string-output))
+ ("strout" (runtime string-output))
+ ("symbol" (runtime symbol))
+ ("syncproc" (runtime synchronous-subprocess))
+ ("syntab" (runtime syntax-table))
+ ("syntax" (runtime syntaxer))
+ ("sysclk" (runtime system-clock))
+ ("sysmac" (runtime system-macros))
+ ("system" (runtime system))
+ ("thread" (runtime thread))
+ ("tscript" (runtime transcript))
+ ("ttyio" (runtime console-i/o-port))
+ ("tvector" (runtime tagged-vector))
+ ("udata" (runtime microcode-data))
+ ("uenvir" (runtime environment))
+ ("uerror" (runtime microcode-errors))
+ ("unicode" (runtime unicode))
+ ("unpars" (runtime unparser))
+ ("unsyn" (runtime unsyntaxer))
+ ("unxdir" (runtime directory))
+ ("unxprm" (runtime os-primitives))
+ ("unxpth" (runtime pathname unix))
+ ("uproc" (runtime procedure))
+ ("urtrap" (runtime reference-trap))
+ ("usrint" (runtime user-interface))
+ ("utabs" (runtime microcode-tables))
+ ("vector" (runtime vector))
+ ("version" (runtime))
+ ("where" (runtime environment-inspector))
+ ("wind" (runtime state-space))
+ ("wrkdir" (runtime working-directory))
+ ("wttree" (runtime wt-tree))
+ ("x11graph" (runtime X-graphics))
+ ("xeval" (runtime extended-scode-eval))
+ ("ystep" (runtime stepper))))
\ No newline at end of file
#| -*-Scheme-*-
-$Id: equals.scm,v 14.8 1999/01/02 06:11:34 cph Exp $
+$Id: equals.scm,v 14.9 2001/12/18 18:39:29 cph Exp $
-Copyright (c) 1988-1999 Massachusetts Institute of Technology
+Copyright (c) 1988-1999, 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.
|#
;;;; Equality
-;;; package: ()
+;;; package: (runtime equality)
(declare (usual-integrations))
\f
((pathname? x)
(and (pathname? y)
(pathname=? x y)))
- (else false))
+ (else #f))
(and (number? x)
(number? y)
(= x y)
#| -*-Scheme-*-
-$Id: fixart.scm,v 1.7 2001/10/22 00:28:09 cph Exp $
+$Id: fixart.scm,v 1.8 2001/12/18 18:39:31 cph Exp $
Copyright (c) 1988-2001 Massachusetts Institute of Technology
|#
;;;; Fixnum Arithmetic
-;;; package: ()
+;;; package: (runtime fixnum-arithmetic)
(declare (usual-integrations))
\f
#| -*-Scheme-*-
-$Id: global.scm,v 14.54 2001/10/02 18:51:54 cph Exp $
+$Id: global.scm,v 14.55 2001/12/18 18:39:33 cph Exp $
Copyright (c) 1988-2001 Massachusetts Institute of Technology
|#
;;;; Miscellaneous Global Definitions
-;;; package: ()
+;;; package: (runtime miscellaneous-global)
(declare (usual-integrations))
\f
;;;; Primitive Operators
(define-primitives
- force error-procedure
+ error-procedure
set-interrupt-enables! enable-interrupts! with-interrupt-mask
get-fixed-objects-vector with-history-disabled
(primitive-procedure-arity 1)
(define (identity-procedure x) x)
(define (null-procedure . args) args '())
-(define (false-procedure . args) args false)
-(define (true-procedure . args) args true)
+(define (false-procedure . args) args #f)
+(define (true-procedure . args) args #t)
;; This definition is replaced when the
;; later in the boot sequence.
(define apply (ucode-primitive apply 2))
(define (eval expression environment)
- (extended-scode-eval (syntax expression
- (environment-syntax-table environment))
- environment))
+ (extended-scode-eval (syntax expression environment) environment))
(define (scode-eval scode environment)
(hook/scode-eval scode environment))
(lambda ()
(set! old-value (get-component object))
(set-component! object new-value)
- (set! new-value false)
+ (set! new-value #f)
unspecific)
thunk
(lambda ()
(set! new-value (get-component object))
(set-component! object old-value)
- (set! old-value false)
+ (set! old-value #f)
unspecific)))))
(define (bind-cell-contents! cell new-value thunk)
(wait-loop)))))
(define (exit #!optional integer)
- (hook/exit (if (default-object? integer) false integer)))
+ (hook/exit (if (default-object? integer) #f integer)))
(define (default/exit integer)
(if (prompt-for-confirmation "Kill Scheme")
(define hook/quit default/quit)
(define syntaxer/default-environment
- (let () (the-environment)))
+ (*make-environment system-global-environment
+ (vector lambda-tag:unnamed)))
(define user-initial-environment
- (let () (the-environment)))
+ (*make-environment system-global-environment
+ (vector lambda-tag:unnamed)))
(define user-initial-prompt
"]=>")
(if ((ucode-primitive primitive-fasdump)
object filename
(if (default-object? dump-option)
- false
+ #f
dump-option))
(end-message)
(begin
(let per-symbol
((bucket (vector-ref obarray index))
(accumulator accumulator))
- (if (null? bucket)
- (per-bucket (fix:- index 1) accumulator)
- (per-symbol (cdr bucket) (cons (car bucket) accumulator))))))))
\ No newline at end of file
+ (if (pair? bucket)
+ (per-symbol (cdr bucket) (cons (car bucket) accumulator))
+ (per-bucket (fix:- index 1) accumulator)))))))
\ No newline at end of file
#| -*-Scheme-*-
-$Id: lambdx.scm,v 14.9 2000/10/14 00:56:20 cph Exp $
+$Id: lambdx.scm,v 14.10 2001/12/18 18:39:35 cph Exp $
-Copyright (c) 1988-2000 Massachusetts Institute of Technology
+Copyright (c) 1988-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.
|#
;;;; Alternative Components for Lambda
-;;; package: ()
+;;; package: (runtime alternative-lambda)
(declare (usual-integrations))
-\f
+
(define (make-lambda* name required optional rest body)
(scan-defines
body
(lambda-components* *lambda
(lambda (name required optional rest body)
(receiver (make-lambda-pattern name required optional rest)
- (append required optional (if (false? rest) '() (list rest)))
+ (append required optional (if rest (list rest) '()))
body))))
(define-structure (lambda-pattern (conc-name lambda-pattern/))
- (name false read-only true)
- (required false read-only true)
- (optional false read-only true)
- (rest false read-only true))
+ (name #f read-only #t)
+ (required #f read-only #t)
+ (optional #f read-only #t)
+ (rest #f read-only #t))
(define (make-lambda** pattern bound body)
(define (split pattern bound receiver)
- (cond ((null? pattern)
- (receiver '() bound))
- (else
- (split (cdr pattern) (cdr bound)
- (lambda (copy tail)
- (receiver (cons (car bound) copy)
- tail))))))
+ (if (pair? pattern)
+ (split (cdr pattern) (cdr bound)
+ (lambda (copy tail)
+ (receiver (cons (car bound) copy)
+ tail)))
+ (receiver '() bound)))
(split (lambda-pattern/required pattern) bound
(lambda (required tail)
(make-lambda* (lambda-pattern/name pattern)
required
optional
- (if (null? rest) #F (car rest))
+ (if (pair? rest) (car rest) #f)
body))))))
\ No newline at end of file
#| -*-Scheme-*-
-$Id: make.scm,v 14.74 2001/12/18 18:27:24 cph Exp $
+$Id: make.scm,v 14.75 2001/12/18 18:39:38 cph Exp $
Copyright (c) 1988-2001 Massachusetts Institute of Technology
((RUNTIME RECORD-SLOT-ACCESS) INITIALIZE-CONDITIONS! #t)
((RUNTIME STREAM) INITIALIZE-CONDITIONS! #t)
;; System dependent stuff
- (() INITIALIZE-SYSTEM-PRIMITIVES! #f)
+ ((RUNTIME OS-PRIMITIVES) INITIALIZE-SYSTEM-PRIMITIVES! #t)
;; Threads
(RUNTIME THREAD)
;; I/O
#| -*-Scheme-*-
-$Id: msort.scm,v 14.8 2001/11/26 19:11:18 cph Exp $
+$Id: msort.scm,v 14.9 2001/12/18 18:39:40 cph Exp $
Copyright (c) 1988-2001 Massachusetts Institute of Technology
|#
;;;; Merge Sort
-;;; package: ()
+;;; package: (runtime merge-sort)
(declare (usual-integrations))
\f
#| -*-Scheme-*-
-$Id: ntprm.scm,v 1.36 2001/05/09 03:17:05 cph Exp $
+$Id: ntprm.scm,v 1.37 2001/12/18 18:39:42 cph Exp $
Copyright (c) 1992-2001 Massachusetts Institute of Technology
|#
;;;; Miscellaneous Win32 Primitives
-;;; package: ()
+;;; package: (runtime os-primitives)
(declare (usual-integrations))
\f
(guarantee-init-file-specifier specifier 'INIT-FILE-SPECIFIER->PATHNAME)
(let ((long-base (merge-pathnames ".mit-scheme/" (user-homedir-pathname))))
(if (dos/fs-long-filenames? long-base)
- (if (null? specifier)
- (directory-pathname-as-file long-base)
+ (if (pair? specifier)
(merge-pathnames
(apply string-append
(cons (car specifier)
(append-map (lambda (string) (list "/" string))
(cdr specifier))))
- long-base))
+ long-base)
+ (directory-pathname-as-file long-base))
(let ((short-base
(merge-pathnames "mitschem.ini/" (user-homedir-pathname))))
(let ((file-map-pathname (merge-pathnames "filemap.dat" short-base)))
(map (lambda (s) (fix:+ (string-length s) 1))
strings)))))
(let loop ((strings strings) (index 0))
- (if (not (null? strings))
+ (if (pair? strings)
(let ((n (string-length (car strings))))
(substring-move! (car strings) 0 n result index)
(let ((index* (fix:+ index n)))
quote-char escape-char))))
\f
(define (nt/rewrite-subprocess-arguments/no-quoting strings)
- (if (null? strings)
- ""
+ (if (pair? strings)
(let ((result
(make-string
(fix:+ (reduce +
(string-set! result index #\space)
(substring-move! (car strings) 0 n result (fix:+ index 1))
(loop (cdr strings) (fix:+ (fix:+ index 1) n))))))
- result)))
+ result)
+ ""))
(define (nt/rewrite-subprocess-arguments/quoting strings
quote-char escape-char)
(fix:+ index 1))))))
((fix:= i n) index))))
(let loop ((index 0) (strings strings) (analyses analyses))
- (if (not (null? strings))
+ (if (pair? strings)
(loop (do-arg index (car strings) (car analyses))
(cdr strings)
(cdr analyses))))
(file-exists? pathname)
(->namestring pathname))
(let loop ((types types))
- (and (not (null? types))
+ (and (pair? types)
(let ((p
(pathname-new-type pathname
(car types))))
(try-dir (directory-pathname ns))))
(if (not default-directory)
(let loop ((path exec-path))
- (and (not (null? path))
+ (and (pair? path)
(or (and (pathname-absolute? (car path))
(try-dir (car path)))
(loop (cdr path)))))
(let ((default-directory
(merge-pathnames default-directory)))
(let loop ((path exec-path))
- (and (not (null? path))
+ (and (pair? path)
(or (try-dir
(merge-pathnames (car path)
default-directory))
#| -*-Scheme-*-
-$Id: os2prm.scm,v 1.47 2001/05/09 03:17:08 cph Exp $
+$Id: os2prm.scm,v 1.48 2001/12/18 18:39:45 cph Exp $
Copyright (c) 1994-2001 Massachusetts Institute of Technology
|#
;;;; Miscellaneous OS/2 Primitives
-;;; package: ()
+;;; package: (runtime os-primitives)
(declare (usual-integrations))
\f
(guarantee-init-file-specifier specifier 'INIT-FILE-SPECIFIER->PATHNAME)
(let ((long-base (merge-pathnames ".mit-scheme/" (user-homedir-pathname))))
(if (dos/fs-long-filenames? long-base)
- (if (null? specifier)
- (directory-pathname-as-file long-base)
+ (if (pair? specifier)
(merge-pathnames
(apply string-append
(cons (car specifier)
(append-map (lambda (string) (list "/" string))
(cdr specifier))))
- long-base))
+ long-base)
+ (directory-pathname-as-file long-base))
(let ((short-base
(merge-pathnames "mitschem.ini/" (user-homedir-pathname))))
(let ((file-map-pathname (merge-pathnames "filemap.dat" short-base)))
(let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
(let ((v
(let loop ((rv select-registry-result-vectors))
- (cond ((null? rv)
- (make-string os2/select-registry-lub))
- ((car rv)
- => (lambda (v) (set-car! rv #f) v))
- (else
- (loop (cdr rv)))))))
+ (if (pair? rv)
+ (let ((v (car rv)))
+ (if v
+ (begin
+ (set-car! rv #f)
+ v)
+ (loop (cdr rv))))
+ (make-string os2/select-registry-lub)))))
(set-interrupt-enables! interrupt-mask)
v)))
(define (deallocate-select-registry-result-vector v)
(let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
(let loop ((rv select-registry-result-vectors))
- (cond ((null? rv)
- (set! select-registry-result-vectors
- (cons v select-registry-result-vectors)))
- ((car rv)
- (loop (cdr rv)))
- (else
- (set-car! rv v))))
+ (if (pair? rv)
+ (if (car rv)
+ (loop (cdr rv))
+ (set-car! rv v))
+ (set! select-registry-result-vectors
+ (cons v select-registry-result-vectors))))
(set-interrupt-enables! interrupt-mask))
unspecific)
\f
(let ((registry (make-string os2/select-registry-lub)))
(vector-8b-fill! registry 0 os2/select-registry-lub 0)
(do ((descriptors descriptors (cdr descriptors)))
- ((null? descriptors))
+ ((not (pair? descriptors)))
(add-to-select-registry! registry (car descriptors)))
registry))
(define (os2/rewrite-subprocess-arguments strings)
(let ((strings
- (cond ((null? strings) (list "" ""))
- ((null? (cdr strings)) (list (car strings) ""))
- (else strings))))
+ (if (pair? strings)
+ (if (pair? (cdr strings))
+ strings
+ (list (car strings) ""))
+ (list "" ""))))
(let ((result
(make-string
(reduce +
(let loop ((strings (cdr strings)) (index (fix:+ n 1)))
(let ((n (string-length (car strings))))
(substring-move! (car strings) 0 n result index)
- (if (null? (cdr strings))
- (string-set! result (fix:+ index n) #\NUL)
+ (if (pair? (cdr strings))
(begin
(string-set! result (fix:+ index n) #\space)
- (loop (cdr strings) (fix:+ (fix:+ index n) 1)))))))
+ (loop (cdr strings) (fix:+ (fix:+ index n) 1)))
+ (string-set! result (fix:+ index n) #\NUL)))))
result)))
(define (os2/rewrite-subprocess-environment strings)
0
(map (lambda (s) (fix:+ (string-length s) 1)) strings)))))
(let loop ((strings strings) (index 0))
- (if (not (null? strings))
+ (if (pair? strings)
(let ((n (string-length (car strings))))
(substring-move! (car strings) 0 n result index)
(string-set! result (fix:+ index n) #\NUL)
(file-exists? pathname)
(->namestring pathname))
(let loop ((types types))
- (and (not (null? types))
+ (and (pair? types)
(let ((p
(pathname-new-type pathname
(car types))))
(try program))
((not default-directory)
(let loop ((path exec-path))
- (and (not (null? path))
+ (and (pair? path)
(or (and (pathname-absolute? (car path))
(try-dir (car path)))
(loop (cdr path))))))
(let ((default-directory
(merge-pathnames default-directory)))
(let loop ((path exec-path))
- (and (not (null? path))
+ (and (pair? path)
(or (try-dir
(merge-pathnames (car path) default-directory))
(loop (cdr path)))))))))))
#| -*-Scheme-*-
-$Id: qsort.scm,v 14.4 1999/01/02 06:11:34 cph Exp $
+$Id: qsort.scm,v 14.5 2001/12/18 18:39:47 cph Exp $
-Copyright (c) 1988-1999 Massachusetts Institute of Technology
+Copyright (c) 1988-1999, 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.
|#
;;;; Quick Sort
-;;; package: ()
+;;; package: (runtime quick-sort)
(declare (usual-integrations))
-\f
+
(define (quick-sort vector predicate)
(if (vector? vector)
(quick-sort! (vector-copy vector) predicate)
#| -*-Scheme-*-
-$Id: queue.scm,v 14.4 1999/01/02 06:11:34 cph Exp $
+$Id: queue.scm,v 14.5 2001/12/18 18:39:49 cph Exp $
-Copyright (c) 1988-1999 Massachusetts Institute of Technology
+Copyright (c) 1988-1999, 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.
|#
;;;; Simple Queue Abstraction
-;;; package: ()
+;;; package: (runtime simple-queue)
(declare (usual-integrations))
\f
(cons '() '()))
(define-integrable (queue-empty? queue)
- (null? (car queue)))
+ (not (pair? (car queue))))
(define-integrable (queued?/unsafe queue item)
(memq item (car queue)))
(define (enqueue!/unsafe queue object)
(let ((next (cons object '())))
- (if (null? (cdr queue))
- (set-car! queue next)
- (set-cdr! (cdr queue) next))
+ (if (pair? (cdr queue))
+ (set-cdr! (cdr queue) next)
+ (set-car! queue next))
(set-cdr! queue next)
unspecific))
(define (dequeue!/unsafe queue)
(let ((next (car queue)))
- (if (null? next)
+ (if (not (pair? next))
(error "Attempt to dequeue from empty queue"))
- (if (null? (cdr next))
- (begin (set-car! queue '())
- (set-cdr! queue '()))
- (set-car! queue (cdr next)))
+ (if (pair? (cdr next))
+ (set-car! queue (cdr next))
+ (begin
+ (set-car! queue '())
+ (set-cdr! queue '())))
(car next)))
(define (queue-map!/unsafe queue procedure)
(let loop ()
(if (not (queue-empty? queue))
- (begin (procedure (dequeue!/unsafe queue))
- (loop)))))
+ (begin
+ (procedure (dequeue!/unsafe queue))
+ (loop)))))
(define-integrable (queue->list/unsafe queue)
(car queue))
-\f
+
;;; Safe (interrupt locked) versions of the above operations.
(define-integrable (queued? queue item)
(without-interrupts (lambda () (dequeue!/unsafe queue))))
(define (queue-map! queue procedure)
- (let ((empty "empty"))
+ (let ((empty (list 'EMPTY)))
(let loop ()
(let ((item
(without-interrupts
empty
(dequeue!/unsafe queue))))))
(if (not (eq? item empty))
- (begin (procedure item)
- (loop)))))))
+ (begin
+ (procedure item)
+ (loop)))))))
(define (queue->list queue)
(without-interrupts
#| -*-Scheme-*-
-$Id: runtime.pkg,v 14.384 2001/12/17 17:40:59 cph Exp $
+$Id: runtime.pkg,v 14.385 2001/12/18 18:39:52 cph Exp $
Copyright (c) 1988-2001 Massachusetts Institute of Technology
;;;; Runtime System Packaging
\f
-(define-package ()
- (files "blowfish"
- "bitstr"
- "boole"
- "boot"
- "equals"
- "fixart"
- "global"
- "lambdx"
- "msort"
- "qsort"
- "queue"
- "sfile"
- "symbol"
- "udata"
- "vector")
- (file-case os-type
- ((unix) "unxprm")
- ((nt) "ntprm")
- ((os/2) "os2prm")
- (else)))
+(define-package ())
(define-package (package)
;; The information appearing here must be exactly duplicated in the
(parent ())
(initialization (initialize-package!)))
+(define-package (runtime bit-string)
+ (files "bitstr")
+ (parent (runtime))
+ (export ()
+ bit-string->signed-integer
+ bit-string->unsigned-integer
+ bit-string-allocate
+ bit-string-and
+ bit-string-and!
+ bit-string-andc
+ bit-string-andc!
+ bit-string-append
+ bit-string-append-reversed
+ bit-string-clear!
+ bit-string-copy
+ bit-string-fill!
+ bit-string-length
+ bit-string-move!
+ bit-string-movec!
+ bit-string-not
+ bit-string-or
+ bit-string-or!
+ bit-string-ref
+ bit-string-set!
+ bit-string-xor
+ bit-string-xor!
+ bit-string-zero?
+ bit-string=?
+ bit-string?
+ bit-substring
+ bit-substring-extend
+ bit-substring-find-next-set-bit
+ bit-substring-move-right!
+ make-bit-string
+ read-bits!
+ signed-integer->bit-string
+ unsigned-integer->bit-string
+ write-bits!))
+
+(define-package (runtime blowfish)
+ (files "blowfish")
+ (parent (runtime))
+ (export ()
+ blowfish-available?
+ blowfish-cbc
+ blowfish-cfb64
+ blowfish-ecb
+ blowfish-encrypt-port
+ blowfish-file?
+ blowfish-ofb64
+ blowfish-set-key
+ compute-blowfish-init-vector
+ read-blowfish-file-header
+ write-blowfish-file-header))
+
+(define-package (runtime boolean)
+ (files "boole")
+ (parent (runtime))
+ (export ()
+ boolean/and
+ boolean/or
+ boolean=?
+ boolean?
+ false
+ false?
+ for-all?
+ not
+ there-exists?
+ true))
+
+(define-package (runtime boot-definitions)
+ (files "boot")
+ (parent (runtime))
+ (export ()
+ future?
+ get-next-constant
+ interrupt-bit/after-gc
+ interrupt-bit/gc
+ interrupt-bit/global-1
+ interrupt-bit/global-3
+ interrupt-bit/global-gc
+ interrupt-bit/kbd
+ interrupt-bit/stack
+ interrupt-bit/suspend
+ interrupt-bit/timer
+ interrupt-mask/all
+ interrupt-mask/gc-ok
+ interrupt-mask/no-background
+ interrupt-mask/none
+ interrupt-mask/timer-ok
+ object-constant?
+ object-pure?
+ standard-unparser-method
+ unparser-method?
+ unparser/standard-method
+ with-absolutely-no-interrupts
+ without-background-interrupts
+ without-interrupts))
+
+(define-package (runtime equality)
+ (files "equals")
+ (parent (runtime))
+ (export ()
+ equal?
+ eqv?))
+
+(define-package (runtime fixnum-arithmetic)
+ (files "fixart")
+ (parent (runtime))
+ (export ()
+ ->flonum
+ fix:*
+ fix:+
+ fix:-
+ fix:-1+
+ fix:1+
+ fix:<
+ fix:<=
+ fix:=
+ fix:>
+ fix:>=
+ fix:and
+ fix:andc
+ fix:divide
+ fix:fixnum?
+ fix:gcd
+ fix:lsh
+ fix:max
+ fix:min
+ fix:negative?
+ fix:not
+ fix:or
+ fix:positive?
+ fix:quotient
+ fix:remainder
+ fix:xor
+ fix:zero?
+ fixnum?
+ flo:*
+ flo:+
+ flo:-
+ flo:/
+ flo:<
+ flo:<=
+ flo:=
+ flo:>
+ flo:>=
+ flo:abs
+ flo:acos
+ flo:asin
+ flo:atan
+ flo:atan2
+ flo:ceiling
+ flo:ceiling->exact
+ flo:cos
+ flo:exp
+ flo:expt
+ flo:finite?
+ flo:flonum?
+ flo:floor
+ flo:floor->exact
+ flo:log
+ flo:max
+ flo:min
+ flo:negate
+ flo:negative?
+ flo:positive?
+ flo:round
+ flo:round->exact
+ flo:sin
+ flo:sqrt
+ flo:tan
+ flo:truncate
+ flo:truncate->exact
+ flo:vector-cons
+ flo:vector-length
+ flo:vector-ref
+ flo:vector-set!
+ flo:zero?
+ index-fixnum?
+ int:*
+ int:+
+ int:-
+ int:-1+
+ int:->flonum
+ int:1+
+ int:<
+ int:<=
+ int:=
+ int:>
+ int:>=
+ int:divide
+ int:integer?
+ int:negate
+ int:negative?
+ int:positive?
+ int:quotient
+ int:remainder
+ int:zero?))
+
+(define-package (runtime miscellaneous-global)
+ (files "global")
+ (parent (runtime))
+ (export ()
+ %exit
+ %quit
+ *the-non-printing-object*
+ apply
+ bind-cell-contents!
+ call-with-values
+ cd
+ cell-contents
+ cell?
+ default/exit
+ default/quit
+ enable-interrupts!
+ environment-link-name
+ eq?
+ error-procedure
+ eval
+ exit
+ false-procedure
+ fasdump
+ get-fixed-objects-vector
+ hook/exit
+ hook/quit
+ hook/scode-eval
+ hunk3-cons
+ identity-procedure
+ impurify
+ lexical-assignment
+ lexical-reference
+ lexical-unassigned?
+ lexical-unbound?
+ lexical-unreferenceable?
+ link-variables
+ local-assignment
+ make-cell
+ make-non-pointer-object
+ null-procedure
+ obarray->list
+ object-component-binder
+ object-datum
+ object-gc-type
+ object-new-type
+ object-non-pointer?
+ object-pointer?
+ object-type
+ object-type?
+ pa
+ primitive-procedure-arity
+ primitive-procedure-documentation
+ pwd
+ quit
+ scode-eval
+ set-cell-contents!
+ set-interrupt-enables!
+ show-time
+ syntaxer/default-environment
+ system-hunk3-cons
+ system-hunk3-cxr0
+ system-hunk3-cxr1
+ system-hunk3-cxr2
+ system-hunk3-set-cxr0!
+ system-hunk3-set-cxr1!
+ system-hunk3-set-cxr2!
+ system-list->vector
+ system-pair-car
+ system-pair-cdr
+ system-pair-cons
+ system-pair-set-car!
+ system-pair-set-cdr!
+ system-pair?
+ system-subvector->list
+ system-vector-length
+ system-vector-ref
+ system-vector-set!
+ system-vector?
+ true-procedure
+ unbind-variable
+ undefined-value?
+ unspecific
+ user-initial-environment
+ user-initial-prompt
+ values
+ wait-interval
+ with-history-disabled
+ with-interrupt-mask
+ with-values
+ write-to-string))
+
+(define-package (runtime alternative-lambda)
+ (files "lambdx")
+ (parent (runtime))
+ (export ()
+ lambda-components*
+ lambda-components**
+ lambda-pattern/name
+ lambda-pattern/optional
+ lambda-pattern/required
+ lambda-pattern/rest
+ lambda-pattern?
+ make-lambda*
+ make-lambda**
+ make-lambda-pattern))
+
+(define-package (runtime merge-sort)
+ (files "msort")
+ (parent (runtime))
+ (export ()
+ merge-sort
+ merge-sort!
+ sort
+ sort!))
+
+(define-package (runtime quick-sort)
+ (files "qsort")
+ (parent (runtime))
+ (export ()
+ quick-sort
+ quick-sort!))
+
+(define-package (runtime simple-queue)
+ (files "queue")
+ (parent (runtime))
+ (export ()
+ make-queue
+ queue-empty?
+ queued?/unsafe
+ enqueue!/unsafe
+ dequeue!/unsafe
+ queue-map!/unsafe
+ queue->list/unsafe
+ queued?
+ enqueue!
+ dequeue!
+ queue-map!
+ queue->list))
+
+(define-package (runtime simple-file-ops)
+ (files "sfile")
+ (parent (runtime))
+ (export ()
+ allocate-temporary-file
+ call-with-temporary-file-pathname
+ call-with-temporary-filename
+ current-file-time
+ deallocate-temporary-file
+ delete-directory
+ delete-file
+ delete-file-no-errors
+ directory-file-names
+ file-access
+ file-directory?
+ file-eq?
+ file-executable?
+ file-exists-direct?
+ file-exists-indirect?
+ file-exists?
+ file-modification-time<?
+ file-processed?
+ file-readable?
+ file-regular?
+ file-soft-link?
+ file-symbolic-link?
+ file-touch
+ file-type-direct
+ file-type-indirect
+ file-writable?
+ file-writeable?
+ guarantee-init-file-directory
+ guarantee-init-file-specifier
+ hard-link-file
+ init-file-specifier?
+ make-directory
+ open-input-init-file
+ open-output-init-file
+ rename-file
+ soft-link-file))
+
+(define-package (runtime symbol)
+ (files "symbol")
+ (parent (runtime))
+ (export ()
+ intern
+ intern-soft
+ interned-symbol?
+ string->symbol
+ string->uninterned-symbol
+ symbol->string
+ symbol-append
+ symbol-hash
+ symbol-hash-mod
+ symbol-name
+ symbol<?
+ symbol?
+ uninterned-symbol?))
+
+(define-package (runtime microcode-data)
+ (files "udata")
+ (parent (runtime))
+ (export ()
+ compiled-code-address->block
+ compiled-code-address->offset
+ compiled-code-address?
+ compiled-code-block/bytes-per-object
+ compiled-code-block/code-end
+ compiled-code-block/code-length
+ compiled-code-block/code-start
+ compiled-code-block/constants-end
+ compiled-code-block/constants-start
+ compiled-code-block/debugging-info
+ compiled-code-block/debugging-info?
+ compiled-code-block/environment
+ compiled-code-block/index->offset
+ compiled-code-block/manifest-closure?
+ compiled-code-block/marked-start
+ compiled-code-block/offset->index
+ compiled-code-block/read-file
+ compiled-code-block?
+ compiled-continuation/next-continuation-offset
+ compiled-continuation/reflect-to-interface?
+ compiled-continuation/return-to-interpreter?
+ compiled-entry-type
+ compiled-expression?
+ compiled-return-address?
+ discriminate-compiled-entry
+ environment-extension-aux-list
+ environment-extension-parent
+ environment-extension-procedure
+ environment-extension?
+ force
+ interpreter-return-address?
+ make-return-address
+ microcode-error
+ microcode-return
+ microcode-termination
+ microcode-type
+ promise-environment
+ promise-expression
+ promise-forced?
+ promise-non-expression?
+ promise-value
+ promise?
+ return-address/code
+ return-address/name
+ return-address?
+ set-compiled-code-block/debugging-info!
+ set-environment-extension-parent!
+ stack-address->index
+ stack-address-offset
+ stack-address?))
+
+(define-package (runtime vector)
+ (files "vector")
+ (parent (runtime))
+ (export ()
+ for-each-vector-element
+ guarantee-subvector
+ guarantee-vector
+ list->vector
+ make-initialized-vector
+ make-vector
+ subvector
+ subvector->list
+ subvector-fill!
+ subvector-filled?
+ subvector-find-next-element
+ subvector-find-next-element-not
+ subvector-find-previous-element
+ subvector-find-previous-element-not
+ subvector-move-left!
+ subvector-move-right!
+ subvector-uniform?
+ vector
+ vector->list
+ vector-append
+ vector-binary-search
+ vector-copy
+ vector-eighth
+ vector-fifth
+ vector-fill!
+ vector-filled?
+ vector-find-next-element
+ vector-find-previous-element
+ vector-first
+ vector-fourth
+ vector-grow
+ vector-head
+ vector-length
+ vector-map
+ vector-move!
+ vector-of-type?
+ vector-ref
+ vector-second
+ vector-set!
+ vector-seventh
+ vector-sixth
+ vector-tail
+ vector-third
+ vector-uniform?
+ vector?))
+
+(define-package (runtime os-primitives)
+ (parent (runtime))
+ (export ()
+ add-to-select-registry!
+ copy-file
+ current-home-directory
+ current-user-name
+ decode-file-time
+ decoded-time->file-time
+ encode-file-time
+ file-access-time
+ file-access-time-direct
+ file-access-time-indirect
+ file-attributes
+ file-attributes-direct
+ file-attributes-indirect
+ file-attributes/access-time
+ file-attributes/change-time
+ file-attributes/length
+ file-attributes/mode-string
+ file-attributes/modification-time
+ file-attributes/n-links
+ file-attributes/type
+ file-length
+ file-modes
+ file-modification-time
+ file-modification-time-direct
+ file-modification-time-indirect
+ file-time->global-decoded-time
+ file-time->local-decoded-time
+ file-time->universal-time
+ get-environment-variable
+ init-file-specifier->pathname
+ make-select-registry
+ os/default-end-of-line-translation
+ os/exec-path
+ os/executable-pathname-types
+ os/file-end-of-line-translation
+ os/find-program
+ os/form-shell-command
+ os/make-subprocess
+ os/parse-path-string
+ os/shell-file-name
+ remove-from-select-registry!
+ select-descriptor
+ select-registry-test
+ set-file-modes!
+ set-file-times!
+ temporary-directory-pathname
+ temporary-file-pathname
+ universal-time->file-time
+ user-home-directory)
+ (initialization (initialize-system-primitives!)))
+
+(os-type-case
+ ((unix)
+ (extend-package (runtime os-primitives)
+ (files "unxprm")
+ (export ()
+ delete-environment-variable!
+ file-attributes/gid
+ file-attributes/inode-number
+ file-attributes/uid
+ set-environment-variable!
+ unix/current-gid
+ unix/current-pid
+ unix/current-uid
+ unix/gid->string
+ unix/system
+ unix/uid->string)))
+ ((nt)
+ (extend-package (runtime os-primitives)
+ (files "ntprm")
+ (export ()
+ console-channel-descriptor
+ delete-environment-variable!
+ dos/fs-drive-type
+ dos/fs-long-filenames?
+ file-attributes/gid
+ file-attributes/inode-number
+ file-attributes/modes
+ file-attributes/uid
+ nt-file-mode/archive
+ nt-file-mode/compressed
+ nt-file-mode/directory
+ nt-file-mode/hidden
+ nt-file-mode/normal
+ nt-file-mode/read-only
+ nt-file-mode/system
+ nt-file-mode/temporary
+ nt-fs-flag/case-preserved-names
+ nt-fs-flag/case-sensitive-search
+ nt-fs-flag/file-compression
+ nt-fs-flag/persistent-acls
+ nt-fs-flag/unicode-on-disk
+ nt-fs-flag/volume-is-compressed
+ nt-volume-info
+ nt-volume-info/file-system-flags
+ nt-volume-info/file-system-name
+ nt-volume-info/max-component-length
+ nt-volume-info/name
+ nt-volume-info/serial-number
+ nt/hide-subprocess-windows?
+ nt/scheme-executable-pathname
+ nt/subprocess-argument-escape-char
+ nt/subprocess-argument-quote-char
+ nt/system-root-directory
+ nt/windows-type
+ set-environment-variable!
+ set-environment-variable-default!)))
+ ((os/2)
+ (extend-package (runtime os-primitives)
+ (files "os2prm")
+ (export ()
+ dos/fs-drive-type
+ dos/fs-long-filenames?
+ file-attributes/allocated-length
+ file-attributes/modes
+ os2-file-mode/archived
+ os2-file-mode/directory
+ os2-file-mode/hidden
+ os2-file-mode/read-only
+ os2-file-mode/system
+ os2/current-pid
+ os2/system-root-directory))))
+
(define-package (runtime string)
(files "string")
- (parent ())
+ (parent (runtime))
(export ()
allocate-external-string
burst-string
(define-package (runtime 1d-property)
(files "prop1d")
- (parent ())
+ (parent (runtime))
(export ()
1d-table/for-each
1d-table/alist
(define-package (runtime 2d-property)
(files "prop2d")
- (parent ())
+ (parent (runtime))
(export ()
2d-get
2d-get-alist-x
(define-package (runtime advice)
(files "advice")
- (parent ())
+ (parent (runtime))
(export ()
*args*
*proc*
(define-package (runtime apply)
(files "apply")
- (parent ())
+ (parent (runtime))
(initialization (initialize-package!)))
(define-package (runtime character)
(files "char")
- (parent ())
+ (parent (runtime))
(export ()
ascii->char
char->ascii
(define-package (runtime character-set)
(files "chrset")
- (parent ())
+ (parent (runtime))
(export ()
ascii-range->char-set
char-alphabetic?
(define-package (runtime compiler-info)
(files "infstr" "infutl")
- (parent ())
+ (parent (runtime))
(export ()
*save-uncompressed-files?*
*uncompressed-file-lifetime*
(define-package (runtime console-i/o-port)
(files "ttyio")
- (parent ())
+ (parent (runtime))
(export ()
console-i/o-port
console-input-port
(define-package (runtime continuation)
(files "contin")
- (parent ())
+ (parent (runtime))
(export ()
call-with-current-continuation
continuation/block-thread-events?
(define-package (runtime continuation-parser)
(files "conpar")
- (parent ())
+ (parent (runtime))
(export ()
continuation->stack-frame
continuation/first-subproblem
(define-package (runtime control-point)
(files "cpoint")
- (parent ())
+ (parent (runtime))
(export ()
control-point/element-stream
control-point/history
(define-package (runtime date/time)
(files "datime")
- (parent ())
+ (parent (runtime))
(export ()
ctime-string->decoded-time
ctime-string->file-time
(define-package (runtime debugger-command-loop)
(files "dbgcmd")
- (parent ())
+ (parent (runtime))
(initialization (initialize-package!)))
(define-package (runtime debugger-utilities)
(define-package (runtime debugging-info)
(files "framex")
- (parent ())
+ (parent (runtime))
(export ()
debugging-info/compiled-code?
debugging-info/evaluated-object-value
(define-package (runtime defstruct)
(files "defstr")
- (parent ())
+ (parent (runtime))
(export ()
define-structure/keyword-parser
define-structure/list-accessor
(initialization (initialize-package!)))
(define-package (runtime directory)
- (file-case os-type
- ((unix) "unxdir")
- ((os/2) "os2dir")
- ((nt) "ntdir")
- ;;(else "unkdir")
- (else))
- (parent ())
+ (parent (runtime))
(export (runtime pathname)
*expand-directory-prefixes?*)
(export ()
directory-read))
+(os-type-case
+ ((unix)
+ (extend-package (runtime directory)
+ (files "unxdir")))
+ ((nt)
+ (extend-package (runtime directory)
+ (files "ntdir")))
+ ((os/2)
+ (extend-package (runtime directory)
+ (files "os2dir"))))
+
(define-package (runtime emacs-interface)
(files "emacs")
- (parent ())
+ (parent (runtime))
(initialization (initialize-package!)))
(define-package (runtime procedure)
(files "uproc")
- (parent ())
+ (parent (runtime))
(export ()
apply-hook-extra
apply-hook-procedure
(define-package (runtime environment)
(files "uenvir")
- (parent ())
+ (parent (runtime))
(export ()
compiled-procedure/environment
environment-arguments
(define-package (runtime error-handler)
(files "error")
- (parent ())
+ (parent (runtime))
(export ()
abort
access-condition
(define-package (runtime event-distributor)
(files "events")
- (parent ())
+ (parent (runtime))
(export ()
add-event-receiver!
event-distributor/invoke!
(define-package (runtime extended-scode-eval)
(files "xeval")
- (parent ())
+ (parent (runtime))
(export ()
extended-scode-eval
hook/extended-scode-eval)
(define-package (runtime file-i/o-port)
(files "fileio")
- (parent ())
+ (parent (runtime))
(export ()
call-with-append-file
call-with-binary-append-file
(define-package (runtime transcript)
(files "tscript")
- (parent ())
+ (parent (runtime))
(export ()
transcript-off
transcript-on)
(file-case options
((load) "format")
(else))
- (parent ())
+ (parent (runtime))
(export ()
format)
(initialization (initialize-package!)))
(define-package (runtime garbage-collector)
(files "gc")
- (parent ())
+ (parent (runtime))
(export ()
constant-space/in-use
flush-purification-queue!
(define-package (runtime gc-daemons)
(files "gcdemn")
- (parent ())
+ (parent (runtime))
(export ()
add-gc-daemon!
add-gc-daemon!/no-restore
(define-package (runtime gc-finalizer)
(files "gcfinal")
- (parent ())
+ (parent (runtime))
(export ()
add-to-gc-finalizer!
gc-finalizer-elements
(define-package (runtime gc-notification)
(files "gcnote")
- (parent ())
+ (parent (runtime))
(export ()
gc-statistic->string
print-gc-statistics
(define-package (runtime gc-statistics)
(files "gcstat")
- (parent ())
+ (parent (runtime))
(export ()
gc-history-mode
gc-statistic/heap-left
(define-package (runtime generic-i/o-port)
(files "genio")
- (parent ())
+ (parent (runtime))
(export ()
make-generic-i/o-port
make-generic-input-port
(define-package (runtime gensym)
(files "gensym")
- (parent ())
+ (parent (runtime))
(export ()
generate-uninterned-symbol)
(initialization (initialize-package!)))
(define-package (runtime global-database)
(files "gdatab")
- (parent ())
+ (parent (runtime))
(export ()
add-unparser-special-object!
add-unparser-special-pair!
(define-package (runtime hash)
(files "hash")
- (parent ())
+ (parent (runtime))
(export ()
hash
hash-table/make
(file-case options
((load) "hashtb")
(else))
- (parent ())
+ (parent (runtime))
(export ()
eq-hash
eq-hash-mod
(define-package (runtime history)
(files "histry")
- (parent ())
+ (parent (runtime))
(export ()
with-new-history)
(export (runtime continuation-parser)
(file-case options
((load) "krypt")
(else))
- (parent ())
+ (parent (runtime))
(export ()
encrypt
decrypt))
(file-case options
((load) "cpress")
(else))
- (parent ())
+ (parent (runtime))
(export ()
compress
uncompress
(define-package (runtime port)
(files "port")
- (parent ())
+ (parent (runtime))
(export ()
close-input-port
close-output-port
(define-package (runtime input-port)
(files "input")
- (parent ())
+ (parent (runtime))
(export ()
char-ready?
eof-object?
(define-package (runtime output-port)
(files "output")
- (parent ())
+ (parent (runtime))
(export ()
beep
clear
(define-package (runtime interrupt-handler)
(files "intrpt")
- (parent ())
+ (parent (runtime))
(export (runtime emacs-interface)
hook/^G-interrupt
hook/clean-input/flush-typeahead)
(define-package (runtime lambda-abstraction)
(files "lambda")
- (parent ())
+ (parent (runtime))
(export ()
block-declaration?
block-declaration-text
(define-package (runtime list)
(files "list")
- (parent ())
+ (parent (runtime))
(export ()
add-member-procedure
alist-copy
(define-package (runtime load)
(files "load")
- (parent ())
+ (parent (runtime))
(export ()
argument-command-line-parser
condition-type:not-loading
(define-package (runtime macros)
(files "macros")
- (parent ())
+ (parent (runtime))
(initialization (initialize-package!)))
(define-package (runtime microcode-errors)
(define-package (runtime microcode-tables)
(files "utabs")
- (parent ())
+ (parent (runtime))
(export ()
char:newline
fixed-object/code->name
(define-package (runtime number)
(files "arith" "dragon4")
- (parent ())
+ (parent (runtime))
(export ()
*
+
(define-package (runtime number-parser)
(files "numpar")
- (parent ())
+ (parent (runtime))
(export ()
flonum-parser-fast?
string->number
(define-package (runtime options)
(files "option")
- (parent ())
+ (parent (runtime))
(export ()
*initial-options-file*
declare-shared-library
(define-package (runtime parser)
(files "parse")
- (parent ())
+ (parent (runtime))
(export ()
*parser-canonicalize-symbols?*
*parser-radix*
(define-package (runtime parser-table)
(files "partab")
- (parent ())
+ (parent (runtime))
(export ()
current-parser-table
guarantee-parser-table
(define-package (runtime pathname)
(files "pathnm")
- (parent ())
+ (parent (runtime))
(export ()
*default-pathname-defaults*
->namestring
(define-package (runtime population)
(files "poplat")
- (parent ())
+ (parent (runtime))
(export ()
add-to-population!
exists-an-inhabitant?
(define-package (runtime pretty-printer)
(files "pp")
- (parent ())
+ (parent (runtime))
(export ()
*pp-arity-dispatched-procedure-style*
*pp-auto-highlighter*
(define-package (runtime primitive-io)
(files "io")
- (parent ())
+ (parent (runtime))
(export ()
all-open-channels
channel-blocking
(define-package (runtime program-copier)
(files "prgcop")
- (parent ())
+ (parent (runtime))
(export ()
copy-program)
(initialization (initialize-package!)))
(define-package (runtime random-number)
(files "random")
- (parent ())
+ (parent (runtime))
(export ()
*random-state*
flo:random-unit
(define-package (runtime record)
(files "record")
- (parent ())
+ (parent (runtime))
(export ()
%make-record
%record
(define-package (runtime reference-trap)
(files "urtrap")
- (parent ())
+ (parent (runtime))
(export ()
cached-reference-trap-value
cached-reference-trap?
(define-package (runtime rep)
(files "rep")
- (parent ())
+ (parent (runtime))
(export ()
->environment
abort->nearest
(define-package (runtime save/restore)
(files "savres")
- (parent ())
+ (parent (runtime))
(export ()
disk-restore
disk-save
(define-package (runtime scode)
(files "scode")
- (parent ())
+ (parent (runtime))
(export ()
absolute-reference-name
absolute-reference-to?
(define-package (runtime scode-combinator)
(files "scomb")
- (parent ())
+ (parent (runtime))
(export ()
combination-components
combination-operands
(define-package (runtime scode-data)
(files "sdata")
- (parent ())
+ (parent (runtime))
(export (runtime lambda-abstraction)
&pair-car
&pair-cdr
(define-package (runtime scode-scan)
(files "scan")
- (parent ())
+ (parent (runtime))
(export ()
make-open-block
open-block-components
(define-package (runtime scode-walker)
(files "codwlk")
- (parent ())
+ (parent (runtime))
(export ()
make-scode-walker
scode-walk
(define-package (runtime socket)
(files "socket")
- (parent ())
+ (parent (runtime))
(export ()
allocate-host-address
canonical-host-name
(file-case options
((load) "process")
(else))
- (parent ())
+ (parent (runtime))
(export ()
make-subprocess
process-environment-bind
(file-case options
((load) "syncproc")
(else))
- (parent ())
+ (parent (runtime))
(export ()
condition-type:subprocess-abnormal-termination
condition-type:subprocess-signalled
(define-package (runtime graphics)
(files "graphics")
- (parent ())
+ (parent (runtime))
(export ()
enumerate-graphics-types
graphics-bind-drawing-mode
(file-case os-type
((unix) "x11graph")
(else))
- (parent ())
+ (parent (runtime))
(export ()
create-x-colormap
create-x-image
(file-case os-type
((unix) "starbase")
(else))
- (parent ())
+ (parent (runtime))
(export ()
starbase-graphics-device-type)
(initialization (initialize-package!)))
(file-case os-type
((os/2) "os2graph" "os2ctype")
(else))
- (parent ())
+ (parent (runtime))
(export ()
os2-console/color?
os2-console/get-font-metrics
(file-case os-type
((os/2) "os2winp")
(else))
- (parent ())
+ (parent (runtime))
(export (runtime os2-graphics)
bbo_and
bbo_ignore
(define-package (runtime state-space)
(files "wind")
- (parent ())
+ (parent (runtime))
(export ()
dynamic-wind
shallow-fluid-bind)
(define-package (runtime stream)
(files "stream")
- (parent ())
+ (parent (runtime))
(export ()
condition-type:illegal-stream-element
empty-stream?
(define-package (runtime string-input)
(files "strnin")
- (parent ())
+ (parent (runtime))
(export ()
string->input-port
with-input-from-string)
(define-package (runtime string-output)
(files "strout")
- (parent ())
+ (parent (runtime))
(export ()
get-output-from-accumulator
make-accumulator-output-port
(define-package (runtime syntax-table)
(files "syntab")
- (parent ())
+ (parent (runtime))
(export ()
guarantee-syntax-table
make-syntax-table
(define-package (runtime syntaxer)
(files "syntax")
- (parent ())
+ (parent (runtime))
(export ()
environment-syntax-table
hook/syntax-expression
(define-package (runtime illegal-definitions)
(files "illdef")
- (parent ())
+ (parent (runtime))
(export (runtime syntaxer)
check-for-illegal-definitions)
(initialization (initialize-package!)))
(define-package (runtime system)
(files "system")
- (parent ())
+ (parent (runtime))
(export ()
add-identification!
add-subsystem-identification!
(define-package (runtime system-clock)
(files "sysclk")
- (parent ())
+ (parent (runtime))
(export ()
internal-time/seconds->ticks
internal-time/ticks->seconds
(define-package (runtime system-macros)
(files "sysmac")
- (parent ())
+ (parent (runtime))
(export ()
syntax-table/system-internal)
(initialization (initialize-package!)))
(define-package (runtime truncated-string-output)
(files "strott")
- (parent ())
+ (parent (runtime))
(export ()
with-output-to-truncated-string)
(initialization (initialize-package!)))
(define-package (runtime unparser)
(files "unpars")
- (parent ())
+ (parent (runtime))
(export ()
*unparse-abbreviate-quotations?*
*unparse-compound-procedure-names?*
(define-package (runtime unsyntaxer)
(files "unsyn")
- (parent ())
+ (parent (runtime))
(export ()
unsyntax
unsyntax-lambda-list
(define-package (runtime working-directory)
(files "wrkdir")
- (parent ())
+ (parent (runtime))
(export ()
set-working-directory-pathname!
with-working-directory-pathname
(define-package (runtime user-interface)
(files "usrint")
- (parent ())
+ (parent (runtime))
(export ()
prompt-for-command-char
prompt-for-command-expression
(define-package (runtime thread)
(files "thread")
- (parent ())
+ (parent (runtime))
(export ()
block-thread-events
condition-type:no-current-thread
(file-case options
((load) "rbtree")
(else))
- (parent ())
+ (parent (runtime))
(export ()
alist->rb-tree
make-rb-tree
(file-case options
((load) "wttree")
(else))
- (parent ())
+ (parent (runtime))
(export ()
number-wt-type
string-wt-type
(define-package (runtime apropos)
(files "apropos")
- (parent ())
+ (parent (runtime))
(export ()
apropos
apropos-list))
(file-case options
((load) "ystep")
(else))
- (parent ())
+ (parent (runtime))
(export ()
step
step-form
(file-case options
((load) "ordvec")
(else))
- (parent ())
+ (parent (runtime))
(export ()
match-ordered-subvector
match-ordered-vector
(file-case options
((load) "gdbm")
(else))
- (parent ())
+ (parent (runtime))
(export ()
gdbm-available?
gdbm-close
\f
(define-package (runtime generic-procedure)
(files "gentag" "gencache" "generic")
- (parent ())
+ (parent (runtime))
(export ()
;; tag.scm:
dispatch-tag-contents
(define-package (runtime generic-procedure multiplexer)
(files "genmult")
- (parent ())
+ (parent (runtime))
(export ()
add-generic-procedure-generator
condition-type:extra-applicable-methods
(define-package (runtime tagged-vector)
(files "tvector")
- (parent ())
+ (parent (runtime))
(export ()
guarantee-tagged-vector
make-tagged-vector
(define-package (runtime record-slot-access)
(files "recslot")
- (parent ())
+ (parent (runtime))
(export ()
condition-type:no-such-slot
condition-type:slot-error
(define-package (runtime generic-procedure eqht)
(files "geneqht")
- (parent ())
+ (parent (runtime))
(export (runtime generic-procedure)
eqht/for-each
eqht/get
(define-package (runtime crypto)
(files "crypto")
- (parent ())
+ (parent (runtime))
(export ()
make-mhash-keygen-type
mcrypt-algorithm-name
(file-case options
((load) "regexp")
(else))
- (parent ())
+ (parent (runtime))
(export ()
char-set->regexp
guarantee-re-register
(file-case options
((load) "rgxcmp")
(else))
- (parent ())
+ (parent (runtime))
(export ()
compiled-regexp?
compiled-regexp/byte-stream
(file-case options
((load) "rexp")
(else))
- (parent ())
+ (parent (runtime))
(export ()
rexp*
rexp+
(file-case options
((load) "chrsyn")
(else))
- (parent ())
+ (parent (runtime))
(export ()
char->syntax-code
char-syntax->string
(file-case options
((load) "mime-codec")
(else))
- (parent ())
+ (parent (runtime))
(export ()
call-with-decode-base64-output-port
call-with-decode-binhex40-output-port
(define-package (runtime parser-buffer)
(files "parser-buffer")
- (parent ())
+ (parent (runtime))
(export ()
discard-parser-buffer-head!
get-parser-buffer-pointer
(define-package (runtime unicode)
(files "unicode")
- (parent ())
+ (parent (runtime))
(export ()
8-bit-alphabet?
alphabet+
#| -*-Scheme-*-
-$Id: sfile.scm,v 14.31 2001/12/17 17:40:59 cph Exp $
+$Id: sfile.scm,v 14.32 2001/12/18 18:39:55 cph Exp $
Copyright (c) 1988-2001 Massachusetts Institute of Technology
|#
;;;; Simple File Operations
-;;; package: ()
+;;; package: (runtime simple-file-ops)
(declare (usual-integrations))
\f
#| -*-Scheme-*-
-$Id: symbol.scm,v 1.5 2001/06/15 20:38:49 cph Exp $
+$Id: symbol.scm,v 1.6 2001/12/18 18:39:57 cph Exp $
Copyright (c) 1992-2001 Massachusetts Institute of Technology
|#
;;;; Symbols
-;;; package: (runtime scode)
+;;; package: (runtime symbol)
(declare (usual-integrations))
\f
#| -*-Scheme-*-
-$Id: syntax.scm,v 14.33 2001/03/21 19:15:18 cph Exp $
+$Id: syntax.scm,v 14.34 2001/12/18 18:39:59 cph Exp $
Copyright (c) 1988-2001 Massachusetts Institute of Technology
(define (syntax expression #!optional table)
(syntax-top-level 'SYNTAX syntax-expression expression
- (if (default-object? table) #f table)))
+ (if (default-object? table) 'DEFAULT table)))
(define (syntax* expressions #!optional table)
(syntax-top-level 'SYNTAX* syntax-sequence expressions
- (if (default-object? table) #f table)))
+ (if (default-object? table) 'DEFAULT table)))
(define (syntax-top-level name syntaxer expression table)
(let ((scode
(fluid-let ((*syntax-table*
- (if table
- (begin
- (if (not (syntax-table? table))
- (error:wrong-type-argument table
- "syntax table"
- name))
- table)
- (if (unassigned? *syntax-table*)
- (nearest-repl/syntax-table)
- *syntax-table*)))
+ (cond ((eq? table 'DEFAULT)
+ (if (unassigned? *syntax-table*)
+ (nearest-repl/syntax-table)
+ *syntax-table*))
+ ((environment? table)
+ (environment-syntax-table table))
+ (else
+ (if (not (syntax-table? table))
+ (error:wrong-type-argument table
+ "syntax table"
+ name))
+ table)))
(*current-keyword* #f))
(syntaxer #t expression))))
(if *disallow-illegal-definitions?*
#| -*-Scheme-*-
-$Id: udata.scm,v 14.20 1999/03/25 03:44:20 cph Exp $
+$Id: udata.scm,v 14.21 2001/12/18 18:40:02 cph Exp $
-Copyright (c) 1988-1999 Massachusetts Institute of Technology
+Copyright (c) 1988-1999, 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.
|#
;;;; Simple Microcode Data Structures
-;;; package: ()
+;;; package: (runtime microcode-data)
(declare (usual-integrations))
\f
extension
first-aux-slot
(+ first-aux-slot (object-datum (vector-ref extension 2)))))))
- (cond ((null? aux-list) '())
- ((unbound-reference-trap?
- (map-reference-trap (lambda () (cdar aux-list))))
- (filter-potentially-dangerous (cdr aux-list)))
- (else
- (cons (car aux-list)
- (filter-potentially-dangerous (cdr aux-list)))))))
+ (if (pair? aux-list)
+ (if (unbound-reference-trap?
+ (map-reference-trap
+ (lambda ()
+ (cdar aux-list))))
+ (filter-potentially-dangerous (cdr aux-list))
+ (cons (car aux-list)
+ (filter-potentially-dangerous (cdr aux-list))))
+ '())))
;;;; Promises
(object-type? (ucode-type delayed) object))
(define-integrable (promise-forced? promise)
- (eq? true (system-pair-car promise)))
+ (eq? #t (system-pair-car promise)))
(define-integrable (promise-non-expression? promise)
(eqv? 0 (system-pair-car promise)))
(system-pair-car promise))
(define (force promise)
- (cond ((not (promise? promise))
- (error:wrong-type-argument promise "promise" 'FORCE))
- ((eq? #T (system-pair-car promise))
- (system-pair-cdr promise))
- ((eqv? 0 (system-pair-car promise)) ; compiled promise
- (let ((result ((system-pair-cdr promise))))
- (system-pair-set-cdr! promise result)
- (system-pair-set-car! promise #T)
- result))
- (else ; losing old style
- ((ucode-primitive force 1) promise))))
+ (if (not (promise? promise))
+ (error:wrong-type-argument promise "promise" 'FORCE))
+ (case (system-pair-car promise)
+ ((#T)
+ (system-pair-cdr promise))
+ ((0) ;compiled promise
+ (let ((result ((system-pair-cdr promise))))
+ (system-pair-set-cdr! promise result)
+ (system-pair-set-car! promise #t)
+ result))
+ (else ;losing old style
+ ((ucode-primitive force 1) promise))))
\ No newline at end of file
#| -*-Scheme-*-
-$Id: unxprm.scm,v 1.61 2001/05/09 03:17:14 cph Exp $
+$Id: unxprm.scm,v 1.62 2001/12/18 18:40:04 cph Exp $
Copyright (c) 1988-2001 Massachusetts Institute of Technology
|#
;;;; Miscellaneous Unix Primitives
-;;; package: ()
+;;; package: (runtime os-primitives)
(declare (usual-integrations))
\f
(define-structure (file-attributes
(type vector)
- (constructor false)
+ (constructor #f)
(conc-name file-attributes/))
- (type false read-only true)
- (n-links false read-only true)
- (uid false read-only true)
- (gid false read-only true)
- (access-time false read-only true)
- (modification-time false read-only true)
- (change-time false read-only true)
- (length false read-only true)
- (mode-string false read-only true)
- (inode-number false read-only true))
+ (type #f read-only #t)
+ (n-links #f read-only #t)
+ (uid #f read-only #t)
+ (gid #f read-only #t)
+ (access-time #f read-only #t)
+ (modification-time #f read-only #t)
+ (change-time #f read-only #t)
+ (length #f read-only #t)
+ (mode-string #f read-only #t)
+ (inode-number #f read-only #t))
(define (file-length filename)
(file-attributes/length (file-attributes-direct filename)))
(define reset-environment-variables!)
(let ((environment-variables '()))
- ;; Kludge: since getenv returns false for unbound,
+ ;; Kludge: since getenv returns #f for unbound,
;; that can also be the marker for a deleted variable
- (define-integrable *variable-deleted* false)
+ (define-integrable *variable-deleted* #f)
(set! get-environment-variable
(lambda (variable)
(define (copy-file from to)
(let ((input-filename (->namestring (merge-pathnames from)))
(output-filename (->namestring (merge-pathnames to))))
- (let ((input-channel false)
- (output-channel false))
+ (let ((input-channel #f)
+ (output-channel #f))
(dynamic-wind
(lambda ()
(set! input-channel (file-open-input-channel input-filename))
(let ((registry (make-string ((ucode-primitive select-registry-size 0)))))
((ucode-primitive select-registry-clear-all 1) registry)
(do ((descriptors descriptors (cdr descriptors)))
- ((null? descriptors))
+ ((not (pair? descriptors)))
((ucode-primitive select-registry-set 2) registry (car descriptors)))
registry))
(let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
(let ((v
(let loop ((rv select-registry-result-vectors))
- (cond ((null? rv)
- (make-vector ((ucode-primitive select-registry-lub 0)) #f))
- ((car rv)
- => (lambda (v) (set-car! rv #f) v))
- (else
- (loop (cdr rv)))))))
+ (if (pair? rv)
+ (let ((v (car rv)))
+ (if v
+ (begin
+ (set-car! rv #f)
+ v)
+ (loop (cdr rv))))
+ (make-vector ((ucode-primitive select-registry-lub 0)) #f)))))
(set-interrupt-enables! interrupt-mask)
v)))
(define (deallocate-select-registry-result-vector v)
(let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
(let loop ((rv select-registry-result-vectors))
- (cond ((null? rv)
- (set! select-registry-result-vectors
- (cons v select-registry-result-vectors)))
- ((car rv)
- (loop (cdr rv)))
- (else
- (set-car! rv v))))
+ (if (pair? rv)
+ (if (car rv)
+ (loop (cdr rv))
+ (set-car! rv v))
+ (set! select-registry-result-vectors
+ (cons v select-registry-result-vectors))))
(set-interrupt-enables! interrupt-mask)))
\f
;;;; Subprocess/Shell Support
(try program))
((not default-directory)
(let loop ((path exec-path))
- (and (not (null? path))
+ (and (pair? path)
(or (and (car path)
(pathname-absolute? (car path))
(try (merge-pathnames program (car path))))
(let ((default-directory
(merge-pathnames default-directory)))
(let loop ((path exec-path))
- (and (not (null? path))
+ (and (pair? path)
(or (try (merge-pathnames
program
(if (car path)
(let ((index (substring-find-next-char string start end #\:)))
(if index
(cons (if (= index start)
- false
+ #f
(substring string start index))
(loop (+ index 1)))
(list (substring string start end))))
#| -*-Scheme-*-
-$Id: vector.scm,v 14.16 2001/08/15 02:56:30 cph Exp $
+$Id: vector.scm,v 14.17 2001/12/18 18:40:07 cph Exp $
-Copyright (c) 1988-2000 Massachusetts Institute of Technology
+Copyright (c) 1988-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.
|#
;;;; Operations on Vectors
-;;; package: ()
+;;; package: (runtime vector)
(declare (usual-integrations))
\f
(define-primitives
- vector? vector-length vector-ref vector-set!
- list->vector vector subvector->list
- subvector-move-right! subvector-move-left! subvector-fill!)
+ vector? vector-length vector-ref vector-set!
+ list->vector vector subvector->list
+ subvector-move-right! subvector-move-left! subvector-fill!)
(define-integrable (guarantee-vector object procedure)
(if (not (vector? object))
(let ((result
(make-vector
(let loop ((vectors vectors) (length 0))
- (if (null? vectors)
- length
+ (if (pair? vectors)
(begin
(guarantee-vector (car vectors) 'VECTOR-APPEND)
(loop (cdr vectors)
- (fix:+ (vector-length (car vectors)) length))))))))
+ (fix:+ (vector-length (car vectors)) length)))
+ length)))))
(let loop ((vectors vectors) (index 0))
- (if (null? vectors)
- result
+ (if (pair? vectors)
(let ((size (vector-length (car vectors))))
(subvector-move-right! (car vectors) 0 size result index)
- (loop (cdr vectors) (fix:+ index size)))))))
+ (loop (cdr vectors) (fix:+ index size)))
+ result))))
(define (vector-grow vector length #!optional value)
(guarantee-vector vector 'VECTOR-GROW)
projects / mit-scheme.git / commitdiff