home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / source / oodleutl.cpt / oodles-of-utils / NotInROM / +SegLoader.lisp < prev    next >
Encoding:
Text File  |  1992-02-13  |  3.4 KB  |  84 lines
  1. ;; -*- package: NotInROM -*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;; +SegLoad.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 missing Segment Loader Routines
  11. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  12.  
  13. (eval-when (:compile-toplevel :load-toplevel :execute)
  14.   (require    :NotInROM-u)
  15.   (in-package :NotInROM))
  16.  
  17. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  18.  
  19. (eval-when (:compile-toplevel :load-toplevel :execute)
  20.   
  21.   (defconstant traps::$AppParmHandle #xAEC)
  22.   
  23.   (defrecord (IAppFile :pointer)
  24.     (vRefNum :signed-integer)
  25.     (fType   :OSType)
  26.     (versNum :byte)
  27.     (unused  :byte)
  28.     (fnLen   :unsigned-byte))
  29.   
  30.   (defrecord (AppParm :pointer)
  31.     (message :signed-integer)
  32.     (count   :signed-integer)
  33.     (doclist (:array :IAppFile 0)))
  34.  
  35.   )
  36.  
  37. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  38.  
  39. (deftrap-NotInROM _CountAppFiles :none ((message (:pointer :signed-integer)) (count (:pointer :signed-integer)))
  40.   (with-macptrs ((appParm_h (%get-ptr (%int-to-ptr #$AppParmHandle))))
  41.     (if (plusp (#_GetHandleSize appParm_h))
  42.       (progn
  43.         (%put-word message (href appParm_h :AppParm.message))
  44.         (%put-word count   (href appParm_h :AppParm.count)))
  45.       (progn
  46.         (%put-word message 0)
  47.         (%put-word count   0)))))
  48.  
  49. (defun app-file-offset (index appParm_p)
  50.   (let ((appFile-offset #.(ccl::record-field-length :AppParm)))
  51.     (with-macptrs ((appFile (%inc-ptr appParm_p appFile-offset)))
  52.       (dotimes (i (1- index) appFile-offset)
  53.         (declare (fixnum i))
  54.         (let ((appFile-size  (+ #.(ccl::record-field-length :IAppFile) (pref appFile :IAppFile.fnLen))))
  55.           (when (oddp appFile-size) (incf appFile-size))
  56.           (incf appFile-offset appFile-size)
  57.           (%incf-ptr appFile appFile-size))))))
  58.  
  59. (deftrap-NotInROM _GetAppFiles :none ((index :signed-integer) (theFile :AppFile))
  60.   (with-macptrs ((appParm_h (%get-ptr (%int-to-ptr #$AppParmHandle))))
  61.     (when (and (plusp (#_GetHandleSize appParm_h))
  62.                (<= index (href appParm_h :AppParm.count)))
  63.       (with-dereferenced-handles ((appParm_p appParm_h))
  64.         (let ((offset (app-file-offset index appParm_p)))
  65.           (with-macptrs ((appFile (%inc-ptr appParm_p offset)))
  66.             (setf (pref theFile :AppFile.vRefNum) (pref appFile :IAppFile.vRefNum))
  67.             (setf (pref theFile :AppFile.fType)   (pref appFile :IAppFile.fType))
  68.             (setf (pref theFile :AppFile.versNum) (pref appFile :IAppFile.versNum))
  69.             (#_BlockMove
  70.              (%inc-ptr appFile #.(nth-value 0 (field-info :IAppFile :fnLen)))
  71.              (%inc-ptr theFile #.(nth-value 0 (field-info :AppFile  :fName)))
  72.              (1+ (pref appFile :IAppFile.fnLen)))))))))
  73.  
  74. (deftrap-NotInROM _ClrAppFiles :none ((index :signed-integer))
  75.   (with-macptrs ((appParm_h (%get-ptr (%int-to-ptr #$AppParmHandle))))
  76.     (when (and (plusp (#_GetHandleSize appParm_h))
  77.                (<= index (href appParm_h :AppParm.count)))
  78.       (with-dereferenced-handles ((appParm_p appParm_h))
  79.         (let ((offset (app-file-offset index appParm_p)))
  80.           (with-macptrs ((appFile (%inc-ptr appParm_p offset)))
  81.             (setf (pref appFile :IAppFile.fType) 0)))))))
  82.  
  83. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  84.