src/pcsample/pcsintrp.scm

   1 #| -*-Scheme-*-
   2
   3 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
   4     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
   5     2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 Massachusetts
   6     Institute of Technology
   7
   8 This file is part of MIT/GNU Scheme.
   9
  10 MIT/GNU Scheme is free software; you can redistribute it and/or modify
  11 it under the terms of the GNU General Public License as published by
  12 the Free Software Foundation; either version 2 of the License, or (at
  13 your option) any later version.
  14
  15 MIT/GNU Scheme is distributed in the hope that it will be useful, but
  16 WITHOUT ANY WARRANTY; without even the implied warranty of
  17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 General Public License for more details.
  19
  20 You should have received a copy of the GNU General Public License
  21 along with MIT/GNU Scheme; if not, write to the Free Software
  22 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
  23 USA.
  24
  25 |#
  26
  27 ;;;; PC Sample Interrupt System
  28 ;;; package: (pc-sample interrupt-handler)
  29
  30 (declare (usual-integrations))
  31 \f
  32 (define (initialize-package!)
  33   (install))
  34
  35 (define-primitives
  36   (clear-interrupts! 1)
  37   set-fixed-objects-vector!
  38   )
  39
  40 ;; Slots 0--8 are reserved by the system (for GC and overflow et al)
  41
  42 (define-integrable IPPB-flush-slot               9) ; pc-sample
  43 (define-integrable IPPB-extend-slot             10) ; pc-sample
  44 (define-integrable PCBPB-flush-slot             11) ; pc-sample
  45 (define-integrable PCBPB-extend-slot            12) ; pc-sample
  46 (define-integrable HCBPB-flush-slot             13) ; pc-sample
  47 (define-integrable HCBPB-extend-slot            14) ; pc-sample
  48
  49 ;; Slot 15 is the dreaded illegal-interrupt-slot
  50
  51
  52 ;;;; Miscellaneous PC Sample Interrupts: buffer flush and extend requests
  53
  54 (define (IPPB-flush-request-handler interrupt-code interrupt-enables)
  55   interrupt-code interrupt-enables
  56   (interp-proc-profile-buffer/flush)
  57   (clear-interrupts! interrupt-bit/IPPB-flush))
  58
  59 (define (IPPB-extend-interrupt-handler interrupt-code interrupt-enables)
  60   interrupt-code interrupt-enables
  61   (interp-proc-profile-buffer/extend)
  62   (clear-interrupts! interrupt-bit/IPPB-extend))
  63
  64 (define (PCBPB-flush-request-handler interrupt-code interrupt-enables)
  65   interrupt-code interrupt-enables
  66   (purified-code-block-profile-buffer/flush)
  67   (clear-interrupts! interrupt-bit/PCBPB-flush))
  68
  69 (define (PCBPB-extend-interrupt-handler interrupt-code interrupt-enables)
  70   interrupt-code interrupt-enables
  71   (purified-code-block-profile-buffer/extend)
  72   (clear-interrupts! interrupt-bit/PCBPB-extend))
  73
  74 (define (HCBPB-flush-request-handler interrupt-code interrupt-enables)
  75   interrupt-code interrupt-enables
  76   (heathen-code-block-profile-buffer/flush)
  77   (clear-interrupts! interrupt-bit/HCBPB-flush))
  78
  79 (define (HCBPB-extend-interrupt-handler interrupt-code interrupt-enables)
  80   interrupt-code interrupt-enables
  81   (heathen-code-block-profile-buffer/extend)
  82   (clear-interrupts! interrupt-bit/HCBPB-extend))
  83 \f
  84 ;;;; Keyboard Interrupts
  85
  86 (define (install)
  87   (without-interrupts
  88    (lambda ()
  89      (let ((system-interrupt-vector
  90             (vector-ref (get-fixed-objects-vector) index:interrupt-vector))
  91            (interrupt-mask-vector
  92             (vector-ref (get-fixed-objects-vector)
  93                         index:interrupt-mask-vector)))
  94
  95        (vector-set! system-interrupt-vector IPPB-flush-slot ; pc-sample
  96                     IPPB-flush-request-handler)
  97        (vector-set! interrupt-mask-vector   IPPB-flush-slot ; pc-sample
  98                     interrupt-mask/gc-ok)
  99
 100        (vector-set! system-interrupt-vector IPPB-extend-slot ; pc-sample
 101                     IPPB-extend-interrupt-handler)
 102        (vector-set! interrupt-mask-vector   IPPB-extend-slot ; pc-sample
 103                     interrupt-mask/gc-ok)
 104
 105        (vector-set! system-interrupt-vector PCBPB-flush-slot ; pc-sample
 106                     PCBPB-flush-request-handler)
 107        (vector-set! interrupt-mask-vector   PCBPB-flush-slot ; pc-sample
 108                     interrupt-mask/gc-ok)
 109
 110        (vector-set! system-interrupt-vector PCBPB-extend-slot ; pc-sample
 111                     PCBPB-extend-interrupt-handler)
 112        (vector-set! interrupt-mask-vector   PCBPB-extend-slot ; pc-sample
 113                     interrupt-mask/gc-ok)
 114
 115        (vector-set! system-interrupt-vector HCBPB-flush-slot ; pc-sample
 116                     HCBPB-flush-request-handler)
 117        (vector-set! interrupt-mask-vector   HCBPB-flush-slot ; pc-sample
 118                     interrupt-mask/gc-ok)
 119
 120        (vector-set! system-interrupt-vector HCBPB-extend-slot ; pc-sample
 121                     HCBPB-extend-interrupt-handler)
 122        (vector-set! interrupt-mask-vector   HCBPB-extend-slot ; pc-sample
 123                     interrupt-mask/gc-ok)
 124
 125        #|
 126        ;; Nop
 127        (set-fixed-objects-vector! (get-fixed-objects-vector))
 128        |#
 129        ))))
 130
 131 ;;; fini