home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / source / oodleutl.cpt / oodles-of-utils / NotInROM / +Devices.lisp < prev    next >
Encoding:
Text File  |  1992-02-07  |  3.4 KB  |  97 lines
  1. ;; -*- package: NotInROM -*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;; +Devices.Lisp
  4. ;;
  5. ;; Copyright ⌐ 1992 Northwestern University Institute for the Learning Sciences
  6. ;; All Rights Reserved
  7. ;;
  8. ;; author: Michael S. Engber
  9. ;;
  10. ;; Provides the High Level "Not in ROM" Device Manager Routines
  11. ;; from IM II pp.178-179 & p. 190
  12. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13.  
  14. (eval-when (:compile-toplevel :load-toplevel :execute)
  15.   (require    :NotInROM-u)
  16.   (in-package :NotInROM))
  17.  
  18. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  19.  
  20. (deftrap-NotInROM _OpenDriver :OSErr ((name (:string 255)) (refNum (:pointer :signed-integer)))
  21.   (rlet ((pb :ParamBlockRec
  22.              :ioNamePtr name
  23.              :ioPermssn #$fsCurPerm))
  24.     (prog1
  25.       (#_PBOpen pb)
  26.       (%put-word refNum (pref pb :ParamBlockRec.ioRefNum)))))
  27.  
  28. (deftrap-NotInROM _CloseDriver :OSErr ((refNum :signed-integer))
  29.   (rlet ((pb :ParamBlockRec
  30.              :ioRefNum     refNum))
  31.     (#_PBClose pb)))
  32.  
  33. (deftrap-NotInROM _FSRead :OSErr ((refNum :signed-integer) (count (:pointer :signed-long)) (buffPtr :pointer))
  34.   (rlet ((pb :ParamBlockRec
  35.              :ioVRefNum   0
  36.              :ioRefNum    refNum
  37.              :ioBuffer    buffPtr
  38.              :ioReqCount  (%get-signed-long count)
  39.              :ioPosMode   #$fsAtMark
  40.              :ioPosOffset 0))
  41.     (prog1
  42.       (#_PBRead pb)
  43.       (%put-long count (pref pb :ParamBlockRec.ioActCount)))))
  44.  
  45. (deftrap-NotInROM _FSWrite :OSErr ((refNum :signed-integer) (count (:pointer :signed-long)) (buffPtr :pointer))
  46.   (rlet ((pb :ParamBlockRec
  47.              :ioVRefNum   0
  48.              :ioRefNum    refNum
  49.              :ioBuffer    buffPtr
  50.              :ioReqCount  (%get-signed-long count)
  51.              :ioPosMode   #$fsAtMark
  52.              :ioPosOffset 0))
  53.     (prog1
  54.       (#_PBWrite pb)
  55.       (%put-long count (pref pb :ParamBlockRec.ioActCount)))))
  56.  
  57. (deftrap-NotInROM _Control :OSErr ((refNum :signed-integer) (csCode :signed-integer) (csParamPtr :pointer))
  58.   (rlet ((pb :ParamBlockRec
  59.              :ioVRefNum 0
  60.              :ioRefNum  refNum
  61.              :csCode    csCode))
  62.     (#_BlockMove csParamPtr (pref pb :ParamBlockRec.csParam) 22)
  63.     (#_PBControl pb)))
  64.  
  65. (deftrap-NotInROM _Status :OSErr ((refNum :signed-integer) (csCode :signed-integer) (csParamPtr :pointer))
  66.   (rlet ((pb :ParamBlockRec
  67.              :ioVRefNum 0
  68.              :ioRefNum  refNum
  69.              :csCode    csCode))
  70.     (prog2
  71.      ;Status actually needs to fill in csParam - see TN#262
  72.      (#_BlockMove csParamPtr (pref pb :ParamBlockRec.csParam) 22)
  73.      (#_PBStatus pb)
  74.      (#_BlockMove (pref pb :ParamBlockRec.csParam) csParamPtr 22))))
  75.  
  76. (deftrap-NotInROM _KillIO :OSErr ((refNum :signed-integer))
  77.   (rlet ((pb :ParamBlockRec
  78.              :ioRefNum refNum))
  79.     (#_PBKillIO pb)))
  80.  
  81. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  82.  
  83. (deftrap-NotInROM _GetDCtlEntry :handle ((refNum :signed-integer))
  84.   (let ((UTable-index (- -1 refNum)))
  85.     (if (< UTable-index (%get-signed-word (%int-to-ptr #$UnitNtryCnt)))
  86.       (%get-ptr (%get-ptr (%int-to-ptr #$UTableBase)) (* 4 UTable-index))
  87.       (%null-ptr))))
  88.  
  89. ;;doesn't seem to work - coded as per IM V p. 431
  90. (deftrap-NotInROM _SetChooserAlert :Boolean ((f :Boolean))
  91.   (with-macptrs ((hiliteMode (%int-to-ptr #$hiliteMode)))
  92.     (prog1
  93.       (#_BitTst hiliteMode 1)
  94.       (if f (#_BitSet hiliteMode 1) (#_BitClr hiliteMode 1)))))
  95.  
  96. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  97.