home *** CD-ROM | disk | FTP | other *** search
/ Otherware / Otherware_1_SB_Development.iso / mac / developm / source / oodleutl.cpt / oodles-of-utils / NotInROM / +Files.lisp < prev    next >
Encoding:
Text File  |  1992-02-13  |  15.4 KB  |  412 lines
  1. ;; -*- package: NotInROM -*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;; +Files.Lisp
  4. ;;
  5. ;; Copyright ⌐ 1992 Northwestern University Institute for the Learning Sciences
  6. ;; All Rights Reserved
  7. ;;
  8. ;; author: Michael S. Engber
  9. ;;          based on MACL 1.32 written by Tamar Offer
  10. ;;
  11. ;; Provides the High Level "Not in ROM" File Manager Routines
  12. ;; from IM IV pp.106-115 and IM VI pp.25.34-25.37 (and TN#218)
  13. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  14.  
  15. (eval-when (:compile-toplevel :load-toplevel :execute)
  16.   (require    :NotInROM-u)
  17.   (in-package :NotInROM))
  18.  
  19. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  20. ;;; Accessing Volumes - IM IV pp. 107-108
  21.  
  22. (deftrap-NotInROM _GetVInfo :OSErr ((drvNum :signed-integer) (volName (:pointer (:string 255))) (vRefNum (:pointer :signed-integer)) (freeBytes (:pointer :signed-long)))
  23.   (rlet ((pb :HParamBlockRec 
  24.              :ioNamePtr  volName
  25.              :ioVRefNum  drvNum
  26.              :ioVolIndex 0))
  27.     (prog1
  28.       (#_PBHGetVInfo pb)
  29.       (%put-word vRefNum (pref pb :HParamBlockRec.ioVRefNum))
  30.       (%put-long freeBytes  (* (pref pb :HParamBlockRec.ioVAlBlkSiz)
  31.                                (logand #xFFFF (pref pb :HParamBlockRec.ioVFrBlk)))))))
  32.  
  33. (deftrap-NotInROM _GetVRefNum :OSErr ((fileRefNum :signed-integer) (vRefNum (:pointer :signed-integer)))
  34.   (rlet ((pb :FCBPBRec
  35.              :ioNamePtr (%null-ptr)
  36.              :ioVRefNum 0
  37.              :ioRefNum  fileRefNum
  38.              :ioFCBIndx 0))
  39.     (prog1
  40.       (#_PBGetFCBInfo pb)
  41.       (%put-word vRefNum (pref pb :FCBPBRec.ioFCBVRefNum)))))
  42.  
  43. (deftrap-NotInROM _GetVol :OSErr ((volName (:pointer (:string 255))) (vRefNum (:pointer :signed-integer)))
  44.   (rlet ((pb :ParamBlockRec
  45.              :ioNamePtr volName))
  46.     (prog1
  47.       (#_PBGetVol pb)
  48.       (%put-word vRefNum (pref pb :ParamBlockRec.ioVRefNum)))))
  49.  
  50. (deftrap-NotInROM _SetVol :OSErr ((volName (:pointer (:string 255))) (vRefNum :signed-integer))
  51.   (rlet ((pb :ParamBlockRec
  52.              :ioNamePtr volName
  53.              :ioVRefNum vRefNum))
  54.     (#_PBSetVol pb)))
  55.  
  56. (deftrap-NotInROM _FlushVol :OSErr ((volName (:pointer (:string 255))) (vRefNum :signed-integer))
  57.   (rlet ((pb :ParamBlockRec
  58.              :ioNamePtr volName
  59.              :ioVRefNum vRefNum))
  60.     (#_PBFlushVol pb)))
  61.  
  62. (deftrap-NotInROM _UnmountVol :OSErr ((volName (:pointer (:string 255))) (vRefNum :signed-integer))
  63.   (rlet ((pb :ParamBlockRec
  64.              :ioNamePtr volName
  65.              :ioVRefNum vRefNum))
  66.     (#_PBUnmountVol pb)))
  67.  
  68. (deftrap-NotInROM _OffLine :OSErr ((volName (:pointer (:string 255))) (vRefNum :signed-integer))
  69.   (rlet ((pb :ParamBlockRec
  70.              :ioNamePtr volName
  71.              :ioVRefNum vRefNum))
  72.     (#_PBOffLine pb)))
  73.  
  74. (deftrap-NotInROM _Eject :OSErr ((volName (:pointer (:string 255))) (vRefNum :signed-integer))
  75.   (rlet ((pb :ParamBlockRec
  76.              :ioNamePtr volName
  77.              :ioVRefNum vRefNum))
  78.     (#_PBEject pb)))
  79.  
  80.  
  81. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  82. ;;; Accessing Files - IM IV pp. 109-112
  83.  
  84. (deftrap-NotInROM _FSOpen :OSErr ((fileName (:string 255)) (vRefNum :signed-integer) (refNum (:pointer :signed-integer)))
  85.   (rlet ((pb :ParamBlockRec 
  86.              :ioNamePtr fileName
  87.              :ioVRefNum vRefNum
  88.              :ioVersNum 0
  89.              :ioPermssn #$fsCurPerm
  90.              :ioMisc (%null-ptr)))
  91.     (prog1
  92.       (#_PBOpen pb)
  93.       (%put-word refNum (pref pb :ParamBlockRec.ioRefNum)))))
  94.  
  95. (deftrap-NotInROM _OpenRF :OSErr ((fileName (:string 255)) (vRefNum :signed-integer) (refNum (:pointer :signed-integer)))
  96.   (rlet ((pb :ParamBlockRec 
  97.              :ioNamePtr fileName
  98.              :ioVRefNum vRefNum
  99.              :ioVersNum 0
  100.              :ioPermssn #$fsCurPerm
  101.              :ioMisc (%null-ptr)))
  102.     (prog1
  103.       (#_PBOpenRF pb)
  104.       (%put-word refNum (pref pb :ParamBlockRec.ioRefNum)))))
  105.  
  106. ;;_FSRead  defined in +Devices.lisp
  107.  
  108. ;;_FSWrite defined in +Devices.lisp
  109.  
  110. (deftrap-NotInROM _GetFPos :OSErr ((refNum :signed-integer) (filePos (:pointer :signed-long)))
  111.   (rlet ((pb :ParamBlockRec
  112.              :ioRefNum refNum))
  113.     (prog1
  114.       (#_PBGetFPos pb)
  115.       (%put-long filePos (pref pb :ParamBlockRec.ioPosOffset)))))
  116.  
  117. (deftrap-NotInROM _SetFPos :OSErr ((refNum :signed-integer) (posMode :signed-integer) (posOff :signed-long))
  118.   (rlet ((pb :ParamBlockRec
  119.              :ioRefNum    refNum
  120.              :ioPosMode   posMode
  121.              :ioPosOffset posOff))
  122.     (#_PBSetFPos pb)))
  123.  
  124. (deftrap-NotInROM _GetEOF :OSErr ((refNum :signed-integer) (logEOF (:pointer :signed-long)))
  125.   (rlet ((pb :ParamBlockRec
  126.              :ioRefNum refNum))
  127.     (prog1
  128.       (#_PBGetEOF pb)
  129.       (%put-long logEOF (%ptr-to-int (pref pb :ParamBlockRec.ioMisc))))))
  130.  
  131. (deftrap-NotInROM _SetEOF :OSErr ((refNum :signed-integer) (logEOF :signed-long))
  132.   (rlet ((pb :ParamBlockRec
  133.              :ioRefNum refNum
  134.              :ioMisc (%int-to-ptr logEOF)))
  135.     (#_PBSetEOF pb)))
  136.  
  137. (deftrap-NotInROM _Allocate :OSErr ((refNum :signed-integer) (count (:pointer :signed-long)))
  138.   (rlet ((pb :ParamBlockRec
  139.              :ioRefNum refNum
  140.              :ioReqCount (%get-signed-long count)))
  141.     (prog1
  142.       (#_PBAllocate pb)
  143.       (%put-long count (pref pb :ParamBlockRec.ioActCount)))))
  144.  
  145. (deftrap-NotInROM _FSClose :OSErr ((refNum :signed-integer))
  146.   (rlet ((pb :ParamBlockRec
  147.              :ioRefNum refNum))
  148.     (#_PBFlushFile pb)
  149.     (#_PBClose pb)))
  150.  
  151. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  152. ;;; Creating and Deleting Files - IM IV pp. 112-113
  153.  
  154. (deftrap-NotInROM _Create :OSErr ((fileName (:string 255)) (vRefNum :signed-integer) (creator :ostype) (fileType :ostype))
  155.   (rlet ((fi :FInfo
  156.              :fdType      fileType 
  157.              :fdCreator   creator
  158.              :fdFlags     0
  159.              :fdLocation  #@(0 0)
  160.              :fdFldr      0)
  161.          (pb :ParamBlockRec
  162.              :ioNamePtr   fileName
  163.              :ioVRefNum   vRefNum
  164.              :ioFVersNum  0
  165.              :ioFDirIndex 0))
  166.     (when (zerop (#_PBCreate pb))
  167.       (when (zerop (#_PBGetFInfo pb))
  168.         (setf (pref pb :ParamBlockRec.ioFlFndrInfo) fi)
  169.         (#_PBSetFInfo pb)))
  170.     (pref pb :ParamBlockRec.ioResult)))
  171.  
  172. (deftrap-NotInROM _FSDelete :OSErr ((fileName (:string 255)) (vRefNum :signed-integer))
  173.   (rlet ((pb :ParamBlockRec
  174.              :ioNamePtr  fileName
  175.              :ioVRefNum  vRefNum
  176.              :ioFVersNum 0))
  177.     (#_PBDelete pb)))
  178.  
  179. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  180. ;;; Changing Information About Files - IM IV pp. 112-113
  181.  
  182. (deftrap-NotInROM _GetFInfo :OSErr ((fileName (:string 255)) (vRefNum :signed-integer) (fndrInfo (:pointer :FInfo)))
  183.   (rlet ((pb :ParamBlockRec
  184.              :ioNamePtr   fileName
  185.              :ioVRefNum   vRefNum
  186.              :ioFVersNum  0
  187.              :ioFDirIndex 0))
  188.     (prog1
  189.       (#_PBGetFInfo pb)
  190.       (#_BlockMove (pref pb :ParamBlockRec.ioFlFndrInfo) fndrInfo #.(ccl::record-field-length :FInfo)))))
  191.  
  192. (deftrap-NotInROM _SetFInfo :OSErr ((fileName (:string 255)) (vRefNum :signed-integer) (fndrInfo :FInfo))
  193.   (rlet ((pb :ParamBlockRec
  194.              :ioNamePtr   fileName
  195.              :ioVRefNum   vRefNum
  196.              :ioFVersNum  0
  197.              :ioFDirIndex 0))
  198.     (when (zerop (#_PBGetFInfo pb))
  199.       (setf (pref pb :ParamBlockRec.ioFlFndrInfo) fndrInfo)
  200.       (#_PBSetFInfo pb))
  201.     (pref pb :ParamBlockRec.ioResult)))
  202.  
  203. (deftrap-NotInROM _SetFlock :OSErr ((fileName (:string 255)) (vRefNum :signed-integer))
  204.   (rlet ((pb :ParamBlockRec
  205.              :ioNamePtr  fileName
  206.              :ioVRefNum  vRefNum
  207.              :ioFVersNum 0))
  208.     (#_PBSetFlock pb)))
  209.  
  210. (deftrap-NotInROM _RstFlock :OSErr ((fileName (:string 255)) (vRefNum :signed-integer))
  211.   (rlet ((pb :ParamBlockRec
  212.              :ioNamePtr  fileName
  213.              :ioVRefNum  vRefNum
  214.              :ioFVersNum 0))
  215.     (#_PBRstFlock pb)))
  216.  
  217. (deftrap-NotInROM _Rename :OSErr ((oldName (:string 255)) (vRefNum :signed-integer) (newName (:string 255)))
  218.   (rlet ((pb :ParamBlockRec
  219.              :ioNamePtr  oldName
  220.              :ioVRefNum  vRefNum
  221.              :ioFVersNum 0
  222.              :ioMisc     newName))
  223.     (#_PBRename pb)))
  224.  
  225. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  226. ;; High Level HFS calls
  227. ;; from IM VI pp. 25.34-25.37 (and TN#218)
  228.  
  229. (deftrap-NotInROM _AllocContig :OSErr ((refNum :signed-integer) (count (:pointer :signed-long)))
  230.   (rlet ((pb :ParamBlockRec
  231.              :ioRefNum   refNum
  232.              :ioReqCount (%get-signed-long count)))
  233.     (prog1
  234.       (#_PBAllocContig pb)
  235.       (%put-long count (pref pb :ParamBlockRec.ioActCount)))))
  236.  
  237. (deftrap-NotInROM _DirCreate :OSErr ((vRefNum :signed-integer) (parentDirID :signed-long) (directoryName (:string 255)) (createdDirID (:pointer :signed-long)))
  238.   (rlet ((pb :HParamBlockRec 
  239.              :ioNamePtr directoryName
  240.              :ioVRefNum vRefNum
  241.              :ioDirID   parentDirID))
  242.     (prog1
  243.       (#_PBDirCreate pb)
  244.       (%put-long createdDirID (pref pb :HParamBlockRec.ioDirID)))))
  245.  
  246. (deftrap-NotInROM _CatMove :OSErr ((vRefNum :signed-integer) (dirID :signed-long) (oldName (:string 255)) (newDirID :signed-long) (newName (:string 255)))
  247.   (rlet ((pb :CMovePBRec
  248.              :ioNamePtr  oldName
  249.              :ioVRefNum  vRefNum
  250.              :ioNewName  newName
  251.              :ioNewDirId newDirID
  252.              :ioDirID    dirID))
  253.     (#_PBCatMove pb)))
  254.  
  255. (deftrap-NotInROM _OpenWD :OSErr ((vRefNum :signed-integer) (dirID :signed-long) (procID :signed-long) (wdRefNum (:pointer :signed-integer)))
  256.   (rlet ((pb :WDPBRec
  257.              :ioNamePtr  (%null-ptr)
  258.              :ioVRefNum  vRefNum
  259.              :ioWDProcID procID
  260.              :ioWDDirID  dirID))
  261.     (prog1
  262.       (#_PBOpenWD pb)
  263.       (%put-word wdRefNum (pref pb :WDPBRec.ioVRefNum)))))
  264.  
  265. (deftrap-NotInROM _CloseWD :OSErr ((wdRefNum :signed-integer))
  266.   (rlet ((pb :WDPBRec
  267.              :ioVRefNum wdRefNum))
  268.     (#_PBCloseWD pb)))
  269.  
  270. (deftrap-NotInROM _GetWDInfo :OSErr ((wdRefNum :signed-integer) (vRefNum (:pointer :signed-integer)) (dirID (:pointer :signed-long)) (procID (:pointer :signed-long)))
  271.   (rlet ((pb :WDPBRec
  272.              :ioNamePtr   (%null-ptr)
  273.              :ioVRefNum   wdRefNum
  274.              :ioWDIndex   0
  275.              :ioWDProcID  0
  276.              :ioWDVRefNum 0))
  277.     (prog1
  278.       (#_PBGetWDInfo pb)
  279.       (%put-word vRefNum (pref pb :WDPBRec.ioWDVRefNum))
  280.       (%put-long dirID   (pref pb :WDPBRec.ioWDDirID))
  281.       (%put-long procID  (pref pb :WDPBRec.ioWDProcID)))))
  282.  
  283.  
  284. (deftrap-NotInROM _HCreate :OSErr ((vRefNum :signed-integer) (dirID :signed-long) (fileName (:string 255)) (creator :ostype) (fileType :ostype))
  285.   (rlet ((fi :FInfo
  286.              :fdType      fileType 
  287.              :fdCreator   creator
  288.              :fdFlags     0
  289.              :fdLocation  0
  290.              :fdFldr      0)
  291.          (pb :HParamBlockRec
  292.              :ioNamePtr   fileName
  293.              :ioVRefNum   vRefNum
  294.              :ioFVersNum  0
  295.              :ioFDirIndex 0
  296.              :ioDirID     dirID))
  297.     (when (zerop (#_PBHCreate pb))
  298.       (when (zerop (#_PBHGetFInfo pb))
  299.         (setf (pref pb :HParamBlockRec.ioFlFndrInfo) fi)
  300.         ;PBHGetFInfo trashes the ioDirID field - so we have to reset it
  301.         (setf (pref pb :HParamBlockRec.ioDirID) dirID)
  302.         (#_PBHSetFInfo pb)))
  303.     (pref pb :HParamBlockRec.ioResult)))
  304.  
  305. (deftrap-NotInROM _HOpen :OSErr ((vRefNum :signed-integer) (dirID :signed-long) (fileName (:string 255)) (permission :signed-byte) (refNum (:pointer :signed-integer)))
  306.   (rlet ((pb :HParamBlockRec 
  307.              :ioNamePtr fileName
  308.              :ioVRefNum vRefNum
  309.              :ioPermssn permission
  310.              :ioMisc    (%null-ptr)
  311.              :ioDirID   dirID))
  312.     (prog1
  313.       (#_PBHOpen pb)
  314.       (%put-word refNum (pref pb :HParamBlockRec.ioRefNum)))))
  315.  
  316. (deftrap-NotInROM _HOpenRF :OSErr ((vRefNum :signed-integer) (dirID :signed-long) (fileName (:string 255)) (permission :signed-byte) (refNum (:pointer :signed-integer)))
  317.   (rlet ((pb :HParamBlockRec 
  318.              :ioNamePtr fileName
  319.              :ioVRefNum vRefNum
  320.              :ioPermssn permission
  321.              :ioMisc    (%null-ptr)
  322.              :ioDirID   dirID))
  323.     (prog1
  324.       (#_PBHOpenRF pb)
  325.       (%put-word refNum (pref pb :HParamBlockRec.ioRefNum)))))
  326.  
  327. (deftrap-NotInROM _HDelete :OSErr ((vRefNum :signed-integer) (dirID :signed-long) (fileName (:string 255)))
  328.   (rlet ((pb :HParamBlockRec 
  329.              :ioNamePtr fileName
  330.              :ioVRefNum vRefNum
  331.              :ioDirID   dirID))
  332.     (#_PBHDelete pb)))
  333.  
  334. (deftrap-NotInROM _HSetFlock :OSErr ((vRefNum :signed-integer) (dirID :signed-long) (fileName (:string 255)))
  335.   (rlet ((pb :HParamBlockRec
  336.              :ioNamePtr fileName
  337.              :ioVRefNum vRefNum
  338.              :ioDirID   dirID))
  339.     (#_PBHSetFlock pb)))
  340.  
  341. (deftrap-NotInROM _HRstFlock :OSErr ((vRefNum :signed-integer) (dirID :signed-long) (fileName (:string 255)))
  342.   (rlet ((pb :HParamBlockRec
  343.              :ioNamePtr fileName
  344.              :ioVRefNum vRefNum
  345.              :ioDirID   dirID))
  346.     (#_PBHRstFlock pb)))
  347.  
  348. (deftrap-NotInROM _HRename :OSErr ((vRefNum :signed-integer) (dirID :signed-long) (oldName (:string 255)) (newName (:string 255)))
  349.   (rlet ((pb :HParamBlockRec
  350.              :ioNamePtr oldName
  351.              :ioVRefNum vRefNum
  352.              :ioMisc    newName
  353.              :ioDirID   dirID))
  354.     (#_PBHRename pb)))
  355.  
  356. (deftrap-NotInROM _HGetFInfo :OSErr ((vRefNum :signed-integer) (dirID :signed-long) (fileName (:string 255)) (fndrInfo (:pointer :FInfo)))
  357.   (rlet ((pb :HParamBlockRec
  358.              :ioNamePtr   fileName
  359.              :ioVRefNum   vRefNum
  360.              :ioFDirIndex 0
  361.              :ioDirID     dirID))
  362.     (prog1
  363.       (#_PBHGetFInfo pb)
  364.       (#_BlockMove (pref pb :HParamBlockRec.ioFlFndrInfo) fndrInfo #.(ccl::record-field-length :FInfo)))))
  365.  
  366. (deftrap-NotInROM _HSetFInfo :OSErr ((vRefNum :signed-integer) (dirID :signed-long) (fileName (:string 255)) (fndrInfo :FInfo))
  367.   (rlet ((pb :HParamBlockRec
  368.              :ioNamePtr   fileName
  369.              :ioVRefNum   vRefNum
  370.              :ioFDirIndex 0
  371.              :ioDirID     dirID))
  372.     (when (zerop (#_PBHGetFInfo pb))
  373.       (setf (pref pb :HParamBlockRec.ioFlFndrInfo) fndrInfo)
  374.       ;PBHGetFInfo trashes the ioDirID field - so we have to reset it
  375.       (setf (pref pb :HParamBlockRec.ioDirID) dirID)
  376.       (#_PBHSetFInfo pb))
  377.     (pref pb :HParamBlockRec.ioResult)))
  378.  
  379. (deftrap-NotInROM _HGetVol :OSErr ((volName (:pointer (:string 255))) (vRefNum (:pointer :signed-integer)) (dirID (:pointer :signed-long)))
  380.   (rlet ((pb :WDPBRec
  381.              :ioNamePtr volName))
  382.     (prog1
  383.       (#_PBHGetVol pb)
  384.       (%put-word vRefNum (pref pb :WDPBRec.ioWDVRefNum))
  385.       (%put-long dirID   (pref pb :WDPBRec.ioWDDirID)))))
  386.  
  387. ;HSetVol - omitted from IM VI - see TN#140 & IM VI p. 25-7
  388.  
  389. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  390. ;;; High Level Data Fork Opening Routines - IM VI p. 25.34
  391.  
  392. (deftrap-NotInROM _HOpenDF :OSErr ((vRefNum :signed-integer) (dirID :signed-long) (fileName (:string 255)) (permission :signed-byte) (refNum (:pointer :signed-integer)))
  393.   (rlet ((pb :HParamBlockRec 
  394.              :ioNamePtr fileName
  395.              :ioVRefNum vRefNum
  396.              :ioPermssn permission
  397.              :ioDirID dirID))
  398.     (prog1
  399.       (#_PBHOpenDF pb)
  400.       (%put-word refNum (pref pb :HParamBlockRec.ioRefNum)))))
  401.  
  402. (deftrap-NotInROM _OpenDF :OSErr ((fileName (:string 255)) (vRefNum :signed-integer) (refNum (:pointer :signed-integer)))
  403.   (rlet ((pb :ParamBlockRec 
  404.              :ioNamePtr fileName
  405.              :ioVRefNum vRefNum
  406.              :ioPermssn #$fsCurPerm))
  407.     (prog1
  408.       (#_PBOpenDF pb)
  409.       (%put-word refNum (pref pb :ParamBlockRec.ioRefNum)))))
  410.  
  411. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  412.