#| -*-Scheme-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/site.scm.dos,v 1.7 1992/05/28 23:40:07 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/site.scm.dos,v 1.8 1992/05/28 23:46:53 jinx Exp $
Copyright (c) 1988-1992 Massachusetts Institute of Technology
(warn "call/cc: Invoking the C compiler:" args)
(warn "Segmentation fault (core dumped)"))
+;;; Dos specific:
+;;; Timer hook to get interrupt keys
+
+(in-package (->environment '(runtime interrupt-handler))
+
+ (define (typeahead-timer-interrupt a b)
+ ((ucode-primitive consume-typeahead))
+ (timer-interrupt-handler a b))
+
+ (let ((sv (vector-ref
+ (get-fixed-objects-vector)
+ (fixed-objects-vector-slot 'SYSTEM-INTERRUPT-VECTOR))))
+ (vector-set! sv timer-slot typeahead-timer-interrupt))
+
;;; Normalization of various directory structures.
(let ((add-directory-rewriting-rule!
(let ((set-default-inf-directory!
(lambda ()
- (if (not (get-environment-variable "mitscheme_inf_directory"))
+ (if (not (get-environment-variable "MITSCHEME_INF_DIRECTORY"))
(set-environment-variable! "MITSCHEME_INF_DIRECTORY"
"c:/scheme")))))
(set-default-inf-directory!)
(add-event-receiver! event:after-restart set-default-inf-directory!))
-;;; Dos specific:
-;;; Timer hook to get interrupt keys
-
-(in-package (->environment '(runtime interrupt-handler))
-
- (define (typeahead-timer-interrupt a b)
- ((ucode-primitive consume-typeahead))
- (timer-interrupt-handler a b))
-
- (let ((sv (vector-ref
- (get-fixed-objects-vector)
- (fixed-objects-vector-slot 'SYSTEM-INTERRUPT-VECTOR))))
- (vector-set! sv timer-slot typeahead-timer-interrupt))
) ; End IN-PACKAGE