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 / pcsample / pcsintrp.scm < prev    next >
Text File  |  1999-01-02  |  5KB  |  127 lines
  1. #| -*-Scheme-*-
  2.  
  3. $Id: pcsintrp.scm,v 1.2 1999/01/02 06:11:34 cph Exp $
  4.  
  5. Copyright (c) 1988-1999 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., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. |#
  21.  
  22. ;;;; PC Sample Interrupt System
  23. ;;; package: (pc-sample interrupt-handler)
  24.  
  25. (declare (usual-integrations))
  26.  
  27. (define (initialize-package!)
  28.   (install))
  29.  
  30. (define-primitives
  31.   (clear-interrupts! 1)
  32.   set-fixed-objects-vector!
  33.   )
  34.  
  35. ;; Slots 0--8 are reserved by the system (for GC and overflow et al)
  36.  
  37. (define-integrable IPPB-flush-slot             9) ; pc-sample
  38. (define-integrable IPPB-extend-slot           10) ; pc-sample
  39. (define-integrable PCBPB-flush-slot            11) ; pc-sample
  40. (define-integrable PCBPB-extend-slot           12) ; pc-sample
  41. (define-integrable HCBPB-flush-slot            13) ; pc-sample
  42. (define-integrable HCBPB-extend-slot           14) ; pc-sample
  43.  
  44. ;; Slot 15 is the dreaded illegal-interrupt-slot
  45.  
  46.  
  47. ;;;; Miscellaneous PC Sample Interrupts: buffer flush and extend requests
  48.  
  49. (define (IPPB-flush-request-handler interrupt-code interrupt-enables)
  50.   interrupt-code interrupt-enables
  51.   (interp-proc-profile-buffer/flush)
  52.   (clear-interrupts! interrupt-bit/IPPB-flush))
  53.  
  54. (define (IPPB-extend-interrupt-handler interrupt-code interrupt-enables)
  55.   interrupt-code interrupt-enables
  56.   (interp-proc-profile-buffer/extend)
  57.   (clear-interrupts! interrupt-bit/IPPB-extend))
  58.  
  59. (define (PCBPB-flush-request-handler interrupt-code interrupt-enables)
  60.   interrupt-code interrupt-enables
  61.   (purified-code-block-profile-buffer/flush)
  62.   (clear-interrupts! interrupt-bit/PCBPB-flush))
  63.  
  64. (define (PCBPB-extend-interrupt-handler interrupt-code interrupt-enables)
  65.   interrupt-code interrupt-enables
  66.   (purified-code-block-profile-buffer/extend)
  67.   (clear-interrupts! interrupt-bit/PCBPB-extend))
  68.  
  69. (define (HCBPB-flush-request-handler interrupt-code interrupt-enables)
  70.   interrupt-code interrupt-enables
  71.   (heathen-code-block-profile-buffer/flush)
  72.   (clear-interrupts! interrupt-bit/HCBPB-flush))
  73.  
  74. (define (HCBPB-extend-interrupt-handler interrupt-code interrupt-enables)
  75.   interrupt-code interrupt-enables
  76.   (heathen-code-block-profile-buffer/extend)
  77.   (clear-interrupts! interrupt-bit/HCBPB-extend))
  78.  
  79. ;;;; Keyboard Interrupts
  80.  
  81. (define (install)
  82.   (without-interrupts
  83.    (lambda ()
  84.      (let ((system-interrupt-vector
  85.         (vector-ref (get-fixed-objects-vector) index:interrupt-vector))
  86.        (interrupt-mask-vector
  87.         (vector-ref (get-fixed-objects-vector)
  88.             index:interrupt-mask-vector)))
  89.  
  90.        (vector-set! system-interrupt-vector IPPB-flush-slot ; pc-sample
  91.             IPPB-flush-request-handler)
  92.        (vector-set! interrupt-mask-vector   IPPB-flush-slot ; pc-sample
  93.             interrupt-mask/gc-ok)
  94.  
  95.        (vector-set! system-interrupt-vector IPPB-extend-slot ; pc-sample
  96.             IPPB-extend-interrupt-handler)
  97.        (vector-set! interrupt-mask-vector   IPPB-extend-slot ; pc-sample
  98.             interrupt-mask/gc-ok)
  99.  
  100.        (vector-set! system-interrupt-vector PCBPB-flush-slot ; pc-sample
  101.             PCBPB-flush-request-handler)
  102.        (vector-set! interrupt-mask-vector   PCBPB-flush-slot ; pc-sample
  103.             interrupt-mask/gc-ok)
  104.  
  105.        (vector-set! system-interrupt-vector PCBPB-extend-slot ; pc-sample
  106.             PCBPB-extend-interrupt-handler)
  107.        (vector-set! interrupt-mask-vector   PCBPB-extend-slot ; pc-sample
  108.             interrupt-mask/gc-ok)
  109.  
  110.        (vector-set! system-interrupt-vector HCBPB-flush-slot ; pc-sample
  111.             HCBPB-flush-request-handler)
  112.        (vector-set! interrupt-mask-vector   HCBPB-flush-slot ; pc-sample
  113.             interrupt-mask/gc-ok)
  114.  
  115.        (vector-set! system-interrupt-vector HCBPB-extend-slot ; pc-sample
  116.             HCBPB-extend-interrupt-handler)
  117.        (vector-set! interrupt-mask-vector   HCBPB-extend-slot ; pc-sample
  118.             interrupt-mask/gc-ok)
  119.  
  120.        #|
  121.        ;; Nop
  122.        (set-fixed-objects-vector! (get-fixed-objects-vector))
  123.        |#
  124.        ))))
  125.  
  126. ;;; fini
  127.