home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mitsch75.zip / scheme-7_5_17-src.zip / scheme-7.5.17 / src / runtime / make.scm < prev    next >
Text File  |  2001-05-21  |  18KB  |  535 lines
  1. #| -*-Scheme-*-
  2.  
  3. $Id: make.scm,v 14.69 2001/05/22 03:09:52 cph Exp $
  4.  
  5. Copyright (c) 1988-2001 Massachusetts Institute of Technology
  6.  
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or (at
  10. your option) any later version.
  11.  
  12. This program is distributed in the hope that it will be useful, but
  13. WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with this program; if not, write to the Free Software
  19. Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
  20. USA.
  21. |#
  22.  
  23. ;;;; Make Runtime System
  24. ;;; package: ()
  25.  
  26. (declare (usual-integrations))
  27.  
  28. ((ucode-primitive set-interrupt-enables! 1) 0)
  29.  
  30. ;; This must be defined as follows so that it is no part of a multi-define
  31. ;; itself.  It must also precede any other top-level defintiions in this file
  32. ;; that are not performed directly using LOCAL-ASSIGNMENT.
  33.  
  34. ((ucode-primitive local-assignment 3)
  35.  (the-environment)
  36.  'DEFINE-MULTIPLE
  37.  (named-lambda (define-multiple env names values)
  38.    (if (or (not (vector? names))
  39.        (not (vector? values))
  40.        (not (= (vector-length names) (vector-length values))))
  41.        (error "define-multiple: Invalid arguments" names values)
  42.        (let ((len (vector-length names)))
  43.      (let loop ((i 0) (val unspecific))
  44.        (if (>= i len)
  45.            val
  46.            (loop (1+ i)
  47.              (local-assignment env
  48.                        (vector-ref names i)
  49.                        (vector-ref values i)))))))))
  50.  
  51. ;; This definition is replaced later in the boot sequence.
  52.  
  53. (define apply (ucode-primitive apply 2))
  54.  
  55. ;; This must go before the uses of the-environment later,
  56. ;; and after apply above.
  57.  
  58. (define (*make-environment parent names . values)
  59.   (apply
  60.    ((ucode-primitive scode-eval 2)
  61.     #|
  62.     (make-slambda (vector-ref names 0)
  63.           (subvector->list names 1 (vector-length names)))
  64.     |#
  65.     ((ucode-primitive system-pair-cons 3)    ; &typed-pair-cons
  66.      (ucode-type lambda)            ; slambda-type
  67.      ((ucode-primitive object-set-type 2)    ; (make-the-environment)
  68.       (ucode-type the-environment)
  69.       0)
  70.      names)
  71.     parent)
  72.    values))
  73.  
  74. (define system-global-environment (the-environment))
  75.  
  76. (define *dashed-hairy-migration-support:false-value*
  77.   #F)
  78.  
  79. (define *dashed-hairy-migration-support:system-global-environment*
  80.   system-global-environment)
  81.  
  82. (let ((environment-for-package (let () (the-environment))))
  83.  
  84. (define-primitives
  85.   (+ integer-add)
  86.   (- integer-subtract)
  87.   (< integer-less?)
  88.   binary-fasload
  89.   (channel-write 4)
  90.   environment-link-name
  91.   exit-with-value
  92.   (file-exists? 1)
  93.   garbage-collect
  94.   get-fixed-objects-vector
  95.   get-next-constant
  96.   get-primitive-address
  97.   get-primitive-name
  98.   lexical-reference
  99.   lexical-unreferenceable?
  100.   microcode-identify
  101.   scode-eval
  102.   set-fixed-objects-vector!
  103.   set-interrupt-enables!
  104.   string->symbol
  105.   string-allocate
  106.   string-length
  107.   substring=?
  108.   substring-move-right!
  109.   substring-downcase!
  110.   (tty-output-channel 0)
  111.   vector-ref
  112.   vector-set!
  113.   with-interrupt-mask)
  114.  
  115. (define microcode-identification (microcode-identify))
  116. (define os-name-string (vector-ref microcode-identification 8))
  117. (define tty-output-descriptor (tty-output-channel))
  118.  
  119. (define (tty-write-string string)
  120.   (let ((end (string-length string)))
  121.     (let loop ((start 0) (n-left end))
  122.       (let ((n (channel-write tty-output-descriptor string start end)))
  123.     (cond ((not n) (loop start n-left))
  124.           ((< n n-left) (loop (+ start n) (- n-left n))))))))
  125.  
  126. (define (fatal-error message)
  127.   (tty-write-string newline-string)
  128.   (tty-write-string message)
  129.   (tty-write-string newline-string)
  130.   (exit-with-value 1))
  131.  
  132. ;;;; GC, Interrupts, Errors
  133.  
  134. (define safety-margin 4500)
  135. (define constant-space/base (get-next-constant))
  136.  
  137. (let ((condition-handler/gc
  138.        (lambda (interrupt-code interrupt-enables)
  139.      interrupt-code interrupt-enables
  140.      (with-interrupt-mask 0
  141.        (lambda (interrupt-mask)
  142.          interrupt-mask
  143.          (garbage-collect safety-margin)))))
  144.       (condition-handler/stack-overflow
  145.        (lambda (interrupt-code interrupt-enables)
  146.      interrupt-code interrupt-enables
  147.      (fatal-error "Stack overflow!")))
  148.       (condition-handler/hardware-trap
  149.        (lambda (escape-code)
  150.      escape-code
  151.      (fatal-error "Hardware trap!")))
  152.       (fixed-objects (get-fixed-objects-vector)))
  153.   (let ((interrupt-vector (vector-ref fixed-objects 1)))
  154.     (vector-set! interrupt-vector 0 condition-handler/stack-overflow)
  155.     (vector-set! interrupt-vector 2 condition-handler/gc))
  156.   (vector-set! fixed-objects #x0C condition-handler/hardware-trap)
  157.   (set-fixed-objects-vector! fixed-objects))
  158.  
  159. (set-interrupt-enables! #x0005)
  160.  
  161. ;;;; Utilities
  162.  
  163. (define (package-initialize package-name procedure-name mandatory?)
  164.   (define (print-name string)
  165.     (tty-write-string newline-string)
  166.     (tty-write-string string)
  167.     (tty-write-string " (")
  168.     (let loop ((name package-name))
  169.       (if (not (null? name))
  170.       (begin
  171.         (if (not (eq? name package-name))
  172.         (tty-write-string " "))
  173.         (tty-write-string (system-pair-car (car name)))
  174.         (loop (cdr name)))))
  175.     (tty-write-string ")"))
  176.  
  177.   (let ((env (package-reference package-name)))
  178.     (cond ((not (lexical-unreferenceable? env procedure-name))
  179.        (print-name "initialize:")
  180.        (if (not (eq? procedure-name 'INITIALIZE-PACKAGE!))
  181.            (begin
  182.          (tty-write-string " [")
  183.          (tty-write-string (system-pair-car procedure-name))
  184.          (tty-write-string "]")))
  185.        ((lexical-reference env procedure-name)))
  186.       ((not mandatory?)
  187.        (print-name "* skipping:"))
  188.       (else
  189.        ;; Missing mandatory package! Report it and die.
  190.        (print-name "Package")
  191.        (tty-write-string " is missing initialization procedure ")
  192.        (tty-write-string (system-pair-car procedure-name))
  193.        (fatal-error "Could not initialize a required package.")))))
  194.  
  195. (define (package-reference name)
  196.   (package/environment (find-package name)))
  197.  
  198. (define (package-initialization-sequence specs)
  199.   (let loop ((specs specs))
  200.     (if (not (null? specs))
  201.     (let ((spec (car specs)))
  202.       (if (or (not (pair? spec))
  203.           (symbol? (car spec)))
  204.           (package-initialize spec 'INITIALIZE-PACKAGE! #f)
  205.           (package-initialize (car spec) (cadr spec) (caddr spec)))
  206.       (loop (cdr specs))))))
  207.  
  208. (define (remember-to-purify purify? filename value)
  209.   (if purify?
  210.       (set! fasload-purification-queue
  211.         (cons (cons filename value)
  212.           fasload-purification-queue)))
  213.   value)
  214.  
  215. (define (fasload filename purify?)
  216.   (tty-write-string newline-string)
  217.   (tty-write-string filename)
  218.   (let ((value (binary-fasload filename)))
  219.     (tty-write-string " loaded")
  220.     (remember-to-purify purify? filename value)))
  221.  
  222. (define (map-filename filename)
  223.   (let ((com-file (string-append filename ".com")))
  224.     (if (file-exists? com-file)
  225.     com-file
  226.     (let ((bin-file (string-append filename ".bin")))
  227.       (and (file-exists? bin-file)
  228.            bin-file)))))
  229.  
  230. (define (file->object filename purify? optional?)
  231.   (let* ((block-name (string-append "runtime_" filename))
  232.      (value (initialize-c-compiled-block block-name)))
  233.     (cond (value
  234.        (tty-write-string newline-string)
  235.        (tty-write-string block-name)
  236.        (tty-write-string " initialized")
  237.        (remember-to-purify purify? filename value))
  238.       ((map-filename filename)
  239.        => (lambda (mapped)
  240.         (fasload mapped purify?)))
  241.       ((not optional?)
  242.        (fatal-error (string-append "Could not find " filename)))
  243.       (else
  244.        #f))))
  245.  
  246. (define (eval object environment)
  247.   (let ((value (scode-eval object environment)))
  248.     (tty-write-string " evaluated")
  249.     value))
  250.  
  251. (define (string-append x y)
  252.   (let ((x-length (string-length x))
  253.     (y-length (string-length y)))
  254.     (let ((result (string-allocate (+ x-length y-length))))
  255.       (substring-move-right! x 0 x-length result 0)
  256.       (substring-move-right! y 0 y-length result x-length)
  257.       result)))
  258.  
  259. (define (string-downcase string)
  260.   (let ((size (string-length string)))
  261.     (let ((result (string-allocate size)))
  262.       (substring-move-right! string 0 size result 0)
  263.       (substring-downcase! result 0 size)
  264.       result)))
  265.  
  266. (define (string=? string1 string2)
  267.   (substring=? string1 0 (string-length string1)
  268.            string2 0 (string-length string2)))
  269.  
  270. (define (intern string)
  271.   (string->symbol (string-downcase string)))
  272.  
  273. (define (implemented-primitive-procedure? primitive)
  274.   (get-primitive-address (intern (get-primitive-name (object-datum primitive)))
  275.              #f))
  276.  
  277. (define fasload-purification-queue
  278.   '())
  279.  
  280. (define initialize-c-compiled-block
  281.   (let ((prim (ucode-primitive initialize-c-compiled-block 1)))
  282.     (if (implemented-primitive-procedure? prim)
  283.     prim
  284.     (lambda (name)
  285.       name                ; ignored
  286.       #f))))
  287.  
  288. (define os-name
  289.   (intern os-name-string))
  290.  
  291. (define newline-string
  292.   (if (eq? 'UNIX os-name)
  293.       "\n"
  294.       "\r\n"))
  295.  
  296. ;; Construct the package structure.
  297. ;; Lotta hair here to load the package code before its package is built.
  298. (eval (file->object "packag" #t #f) environment-for-package)
  299. ((access initialize-package! environment-for-package))
  300. (let loop ((names
  301.         '(*ALLOW-PACKAGE-REDEFINITION?*
  302.           ENVIRONMENT->PACKAGE
  303.           FIND-PACKAGE
  304.           NAME->PACKAGE
  305.           PACKAGE/ADD-CHILD!
  306.           PACKAGE/CHILD
  307.           PACKAGE/CHILDREN
  308.           PACKAGE/ENVIRONMENT
  309.           PACKAGE/NAME
  310.           PACKAGE/PARENT
  311.           PACKAGE/REFERENCE
  312.           PACKAGE/SYSTEM-LOADER
  313.           PACKAGE?
  314.           SYSTEM-GLOBAL-PACKAGE)))
  315.   (if (not (null? names))
  316.       (begin
  317.     (environment-link-name system-global-environment
  318.                    environment-for-package
  319.                    (car names))
  320.     (loop (cdr names)))))
  321. (package/add-child! system-global-package 'PACKAGE environment-for-package)
  322. (eval (fasload "runtime.bco" #f) system-global-environment)
  323.  
  324. ;;; Global databases.  Load, then initialize.
  325. (let ((files1
  326.        '(("gcdemn" . (RUNTIME GC-DAEMONS))
  327.      ("gc" . (RUNTIME GARBAGE-COLLECTOR))
  328.      ("boot" . ())
  329.      ("queue" . ())
  330.      ("equals" . ())
  331.      ("list" . (RUNTIME LIST))
  332.      ("symbol" . ())
  333.      ("uproc" . (RUNTIME PROCEDURE))
  334.      ("fixart" . ())
  335.      ("random" . (RUNTIME RANDOM-NUMBER))
  336.      ("gentag" . (RUNTIME GENERIC-PROCEDURE))
  337.      ("poplat" . (RUNTIME POPULATION))
  338.      ("record" . (RUNTIME RECORD))
  339.      ("defstr" . (RUNTIME DEFSTRUCT))))
  340.       (files2
  341.        '(("prop1d" . (RUNTIME 1D-PROPERTY))
  342.      ("events" . (RUNTIME EVENT-DISTRIBUTOR))
  343.      ("gdatab" . (RUNTIME GLOBAL-DATABASE))
  344.      ("gcfinal" . (RUNTIME GC-FINALIZER))))
  345.       (load-files
  346.        (lambda (files)
  347.      (do ((files files (cdr files)))
  348.          ((null? files))
  349.        (eval (file->object (car (car files)) #t #f)
  350.          (package-reference (cdr (car files))))))))
  351.   (load-files files1)
  352.   (package-initialize '(RUNTIME GC-DAEMONS) 'INITIALIZE-PACKAGE! #t)
  353.   (package-initialize '(RUNTIME GARBAGE-COLLECTOR) 'INITIALIZE-PACKAGE! #t)
  354.   (lexical-assignment (package-reference '(RUNTIME GARBAGE-COLLECTOR))
  355.               'CONSTANT-SPACE/BASE
  356.               constant-space/base)
  357.   (package-initialize '(RUNTIME LIST) 'INITIALIZE-PACKAGE! #t)
  358.   (package-initialize '(RUNTIME RANDOM-NUMBER) 'INITIALIZE-PACKAGE! #t)
  359.   (package-initialize '(RUNTIME GENERIC-PROCEDURE) 'INITIALIZE-TAG-CONSTANTS!
  360.               #t)
  361.   (package-initialize '(RUNTIME POPULATION) 'INITIALIZE-PACKAGE! #t)
  362.   (package-initialize '(RUNTIME RECORD) 'INITIALIZE-RECORD-TYPE-TYPE! #t)
  363.   (package-initialize '(RUNTIME DEFSTRUCT) 'INITIALIZE-STRUCTURE-TYPES! #t)
  364.   (load-files files2)
  365.   (package-initialize '(RUNTIME 1D-PROPERTY) 'INITIALIZE-PACKAGE! #t)
  366.   (package-initialize '(RUNTIME EVENT-DISTRIBUTOR) 'INITIALIZE-PACKAGE! #t)
  367.   (package-initialize '(RUNTIME GLOBAL-DATABASE) 'INITIALIZE-PACKAGE! #t)
  368.   (package-initialize '(RUNTIME POPULATION) 'INITIALIZE-UNPARSER! #t)
  369.   (package-initialize '(RUNTIME 1D-PROPERTY) 'INITIALIZE-UNPARSER! #t)
  370.   (package-initialize '(RUNTIME GC-FINALIZER) 'INITIALIZE-PACKAGE! #t)
  371.  
  372. ;; Load everything else.
  373. ;; Note: The following code needs MAP* and MEMBER-PROCEDURE
  374. ;; from runtime/list. Fortunately that file has already been loaded.
  375.  
  376.   ((eval (fasload "runtime.bld" #f) system-global-environment)
  377.    (let ((to-avoid
  378.       (cons "packag"
  379.         (map* (if (file-exists? "runtime.bad")
  380.               (fasload "runtime.bad" #f)
  381.               '())
  382.               car
  383.               (append files1 files2))))
  384.      (string-member? (member-procedure string=?)))
  385.      (lambda (filename environment)
  386.        (if (not (string-member? filename to-avoid))
  387.        (eval (file->object filename #t #f) environment))
  388.        unspecific))
  389.    `((SORT-TYPE . MERGE-SORT)
  390.      (OS-TYPE . ,os-name)
  391.      (OPTIONS . NO-LOAD))))
  392.  
  393. ;;; Funny stuff is done.  Rest of sequence is standardized.
  394. (package-initialization-sequence
  395.  '(
  396.    ;; Microcode interface
  397.    ((RUNTIME MICROCODE-TABLES) READ-MICROCODE-TABLES! #t)
  398.    (RUNTIME STATE-SPACE)
  399.    (RUNTIME APPLY)
  400.    (RUNTIME HASH)            ; First GC daemon!
  401.    (RUNTIME PRIMITIVE-IO)
  402.    (RUNTIME SAVE/RESTORE)
  403.    (RUNTIME SYSTEM-CLOCK)
  404.    ((RUNTIME GC-FINALIZER) INITIALIZE-EVENTS! #t)
  405.    ;; Basic data structures
  406.    (RUNTIME NUMBER)
  407.    (RUNTIME CHARACTER)
  408.    (RUNTIME CHARACTER-SET)
  409.    (RUNTIME GENSYM)
  410.    (RUNTIME STREAM)
  411.    (RUNTIME 2D-PROPERTY)
  412.    ;; Microcode data structures
  413.    (RUNTIME HISTORY)
  414.    (RUNTIME LAMBDA-ABSTRACTION)
  415.    (RUNTIME SCODE)
  416.    (RUNTIME SCODE-COMBINATOR)
  417.    (RUNTIME SCODE-WALKER)
  418.    (RUNTIME CONTINUATION-PARSER)
  419.    (RUNTIME PROGRAM-COPIER)
  420.    ;; Generic Procedures
  421.    ((RUNTIME GENERIC-PROCEDURE EQHT) INITIALIZE-ADDRESS-HASHING! #t)
  422.    ((RUNTIME GENERIC-PROCEDURE) INITIALIZE-GENERIC-PROCEDURES! #t)
  423.    ((RUNTIME GENERIC-PROCEDURE MULTIPLEXER) INITIALIZE-MULTIPLEXER! #t)
  424.    ((RUNTIME TAGGED-VECTOR) INITIALIZE-TAGGED-VECTOR! #t)
  425.    ((RUNTIME RECORD-SLOT-ACCESS) INITIALIZE-RECORD-SLOT-ACCESS! #t)
  426.    ((RUNTIME RECORD) INITIALIZE-RECORD-PROCEDURES! #t)
  427.    ((PACKAGE) FINALIZE-PACKAGE-RECORD-TYPE! #t)
  428.    ((RUNTIME RANDOM-NUMBER) FINALIZE-RANDOM-STATE-TYPE! #t)
  429.    ;; Condition System
  430.    (RUNTIME ERROR-HANDLER)
  431.    (RUNTIME MICROCODE-ERRORS)
  432.    ((RUNTIME GENERIC-PROCEDURE) INITIALIZE-CONDITIONS! #t)
  433.    ((RUNTIME GENERIC-PROCEDURE MULTIPLEXER) INITIALIZE-CONDITIONS! #t)
  434.    ((RUNTIME RECORD-SLOT-ACCESS) INITIALIZE-CONDITIONS! #t)
  435.    ((RUNTIME STREAM) INITIALIZE-CONDITIONS! #t)
  436.    ;; System dependent stuff
  437.    (() INITIALIZE-SYSTEM-PRIMITIVES! #f)
  438.    ;; Threads
  439.    (RUNTIME THREAD)
  440.    ;; I/O
  441.    (RUNTIME GENERIC-I/O-PORT)
  442.    (RUNTIME FILE-I/O-PORT)
  443.    (RUNTIME CONSOLE-I/O-PORT)
  444.    (RUNTIME TRANSCRIPT)
  445.    (RUNTIME STRING-INPUT)
  446.    (RUNTIME STRING-OUTPUT)
  447.    (RUNTIME TRUNCATED-STRING-OUTPUT)
  448.    ;; These MUST be done before (RUNTIME PATHNAME) 
  449.    ;; Typically only one of them is loaded.
  450.    (RUNTIME PATHNAME UNIX)
  451.    (RUNTIME PATHNAME DOS)
  452.    (RUNTIME PATHNAME)
  453.    (RUNTIME WORKING-DIRECTORY)
  454.    (RUNTIME LOAD)
  455.    ;; Syntax
  456.    (RUNTIME NUMBER-PARSER)
  457.    (RUNTIME PARSER)
  458.    (RUNTIME UNPARSER)
  459.    (RUNTIME SYNTAXER)
  460.    (RUNTIME ILLEGAL-DEFINITIONS)
  461.    (RUNTIME MACROS)
  462.    (RUNTIME SYSTEM-MACROS)
  463.    ((RUNTIME DEFSTRUCT) INITIALIZE-DEFINE-STRUCTURE-MACRO! #t)
  464.    (RUNTIME UNSYNTAXER)
  465.    (RUNTIME PRETTY-PRINTER)
  466.    (RUNTIME EXTENDED-SCODE-EVAL)
  467.    ;; REP Loops
  468.    (RUNTIME INTERRUPT-HANDLER)
  469.    (RUNTIME GC-STATISTICS)
  470.    (RUNTIME REP)
  471.    ;; Debugging
  472.    (RUNTIME COMPILER-INFO)
  473.    (RUNTIME ADVICE)
  474.    (RUNTIME DEBUGGER-COMMAND-LOOP)
  475.    (RUNTIME DEBUGGER-UTILITIES)
  476.    (RUNTIME ENVIRONMENT-INSPECTOR)
  477.    (RUNTIME DEBUGGING-INFO)
  478.    (RUNTIME DEBUGGER)
  479.    ;; Misc (e.g., version)
  480.    (RUNTIME)
  481.    (RUNTIME CRYPTO)
  482.    ;; Graphics.  The last type initialized is the default for
  483.    ;; MAKE-GRAPHICS-DEVICE, only the types that are valid for the
  484.    ;; operating system are actually loaded and initialized.
  485.    (RUNTIME STARBASE-GRAPHICS)
  486.    (RUNTIME X-GRAPHICS)
  487.    (RUNTIME OS2-GRAPHICS)
  488.    (RUNTIME STRING)
  489.    ;; Emacs -- last because it installs hooks everywhere which must be initted.
  490.    (RUNTIME EMACS-INTERFACE)
  491.    ;; More debugging
  492.    ((RUNTIME CONTINUATION-PARSER) INITIALIZE-SPECIAL-FRAMES! #f)))
  493.  
  494. (let ((obj (file->object "site" #t #t)))
  495.   (if obj
  496.       (eval obj system-global-environment)))
  497.  
  498. (environment-link-name (->environment '(RUNTIME ENVIRONMENT))
  499.                (->environment '(PACKAGE))
  500.                'PACKAGE-NAME-TAG)
  501.  
  502. (let ((roots
  503.        (list->vector
  504.     ((access with-directory-rewriting-rule
  505.          (->environment '(RUNTIME COMPILER-INFO)))
  506.      (working-directory-pathname)
  507.      (pathname-as-directory "runtime")
  508.      (lambda ()
  509.        (let ((fasload/update-debugging-info!
  510.           (access fasload/update-debugging-info!
  511.               (->environment '(RUNTIME COMPILER-INFO))))
  512.          (load/purification-root
  513.           (access load/purification-root
  514.               (->environment '(RUNTIME LOAD)))))
  515.          (map (lambda (entry)
  516.             (let ((object (cdr entry)))
  517.               (fasload/update-debugging-info! object (car entry))
  518.               (load/purification-root object)))
  519.           fasload-purification-queue)))))))
  520.   (set! (access gc-boot-loading? (->environment '(RUNTIME GARBAGE-COLLECTOR)))
  521.     #f)
  522.   (set! fasload-purification-queue)
  523.   (newline console-output-port)
  524.   (write-string "purifying..." console-output-port)
  525.   ;; First, flush whatever we can.
  526.   (gc-clean)
  527.   ;; Then, really purify the rest.
  528.   (purify roots #t #f)
  529.   (write-string "done" console-output-port))
  530.  
  531. )
  532.  
  533. (package/add-child! system-global-package 'USER user-initial-environment)
  534. (start-thread-timer)
  535. (initial-top-level-repl)