home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 2: PC / frozenfish_august_1995.bin / bbs / d01xx / d0181.lha / AMXLISP / lsp / allocate.lsp next >
Lisp/Scheme  |  1989-02-25  |  1KB  |  36 lines
  1. ; Basis for memory-management of C heap from AMXLisp
  2. ; Of course we could have used AllocRemember...
  3.  
  4. (unless (boundp 'heap-c-alloc) (defvar heap-c-alloc ()))
  5. (defamiga 'AllocMem 'exec)
  6. (defamiga 'FreeMem 'exec)
  7.  
  8. ; chip = t for Chip memory
  9. (defun newamiga (struct &optional chip)
  10.    (let* ((tmpstruct (send struct :new 0))
  11.           (size (send tmpstruct :size-of))
  12.           (adrs (callamiga 'AllocMem exec size (if chip #x10003 #x10005))))
  13.          (if (eq adrs 0)
  14.              (error "Can't allocate :" size)
  15.              (progn (send tmpstruct :isnew adrs)
  16.                     (setq heap-c-alloc (cons (cons adrs size) heap-c-alloc))
  17.                     tmpstruct))))
  18.  
  19.  
  20. (defun freeamiga (struct)
  21.    (if (objectp struct)
  22.        (let ((x (assoc (send struct :ptr) heap-c-alloc)))
  23.            (when x
  24.                (callamiga 'FreeMem exec (send struct :ptr) (cdr x))
  25.                (setq heap-c-alloc (delete x heap-c-alloc :test 'equal))))))
  26.  
  27.  
  28.  
  29. ; (free-heap) function for cleanup
  30. (defun free-heap ()
  31.    (mapc '(lambda (x)
  32.             (callamiga 'FreeMem exec (car x) (cdr x)))
  33.          heap-c-alloc)
  34.    (setq heap-c-alloc ()))
  35.  
  36.