;
;	X_Heap.aii	- Heap v6 glue routines for backward compatability
;
;	Copyright © 1989, Claris Corporation
;
;	1-10-89	Kevin A. Watts
;

;--------------------------------------------------------------
; Heap Routines:
;
; X_NewHeap(HeapIncSize:l,IndexIncSize:l): Heap:l
; X_DisposeHeap(Heap:l)
; X_NeedSpace(Heap:l,FreeSpace:l)
; X_NewBlock( Heap:l,Size:l): Index:l
; X_DisposeBlock(Heap:l,Index:l)
; X_GetBlockSize(Heap:l,Index:l): Size:l
; X_GetBlockPtr(Heap:l,Index:l): Ptr:l
; X_ResizeBlock(Heap:l,Index:l,Size:l)
; X_ReadHeap(): Heap:l
; X_WriteHeap(Heap:l)
; X_TruncHeap(Heap:l)
; X_CopyIndex(Heap:l,Index:l): Copy:l
;
;--------------------------------------------------------------

	PRINT	PUSH
	PRINT	OFF

CheckHeap	equ	0

	LOAD	'Macros.Dump'

	include	'Heap.aii.i'
	include	'Driver.equ'

	IMPORT	D_AlertBox

	PRINT	POP

;¦;-------------------------------------------------------------------------;
; X_NewHeap ( HeapIncSize:l,IndexIncSize:l): Heap:l
;
X_NewHeap	PROC	EXPORT

	input	HeapIncSize:l,IndexIncSize:l
	output	Heap:l
	error	ErrorFlag
	BEGIN
	
	stz	ErrorFlag

;	jsl	H_SegLoaded

	H_NewHeap	Heap,err=ErrorFlag

	RETURN
	ENDP

;¦;-------------------------------------------------------------------------;
; X_DisposeHeap ( Heap:l )
;
X_DisposeHeap	PROC	EXPORT

	input	Heap:l
	BEGIN

  IF CheckHeap THEN
	jsl	H_CurrentHeap
	CmpLong	ax,Heap
	beq	ok
	
	Call	D_AlertBox,in=(#OkBox:w,#ErrorMesg:l),out=(a:w)
	bra	exit

ErrorMesg	str	'X_DisposeHeap: mismatched heap!!'
ok
  ENDIF
	H_DisposeHeap

;	jsl	H_SegUnloaded

exit	RETURN
	ENDP

;¦;-------------------------------------------------------------------------;
; X_NeedSpace ( Heap:l, FreeSpace:l )
;
X_NeedSpace	PROC	EXPORT 

	input	Heap:l,FreeSpace:l
	BEGIN

 	RETURN	#0
	ENDP

;¦;-------------------------------------------------------------------------;
; X_NewBlock ( Heap:l,Size:l ): Index:l
;
X_NewBlock	PROC	EXPORT

	input	Heap:l,Size:l
	output	Index:l
	error	ErrorFlag
	BEGIN
	
  IF CheckHeap THEN
	jsl	H_CurrentHeap
	CmpLong	ax,Heap
	beq	ok
	
	Call	D_AlertBox,in=(#OkBox:w,#ErrorMesg:l),out=(a:w)
	bra	exit

ErrorMesg	str	'X_NewBlock: mismatched heap!!'
ok
  ENDIF
	H_NewBlock	Size,Index,err=ErrorFlag

exit	RETURN
	ENDP

;¦;-------------------------------------------------------------------------;
; X_DisposeBlock ( Heap:l,Index:l )
;
X_DisposeBlock	PROC	EXPORT
 
	input	Heap:l,Index:l
	BEGIN

  IF CheckHeap THEN
	jsl	H_CurrentHeap
	CmpLong	ax,Heap
	beq	ok
	
	Call	D_AlertBox,in=(#OkBox:w,#ErrorMesg:l),out=(a:w)
	bra	exit

ErrorMesg	str	'X_DisposeBlock: mismatched heap!!'
ok
  ENDIF
	H_DisposeBlock	Index

exit	RETURN
	ENDP

;¦;-------------------------------------------------------------------------;
; X_GetBlockSize ( Heap:l,Index:l ): Size:l
;
X_GetBlockSize	PROC	EXPORT

	input	Heap:l,Index:l
	output	Size:l
	BEGIN

  IF CheckHeap THEN
	jsl	H_CurrentHeap
	CmpLong	ax,Heap
	beq	ok
	
	Call	D_AlertBox,in=(#OkBox:w,#ErrorMesg:l),out=(a:w)
	bra	exit

ErrorMesg	str	'X_GetBlockSize: mismatched heap!!'
ok
  ENDIF
	H_GetBlockSize	Index,Size

exit	RETURN
	ENDP

;¦;-------------------------------------------------------------------------;
; X_GetBlockPtr ( Heap:l,Index:l ): Ptr:l
;
X_GetBlockPtr	PROC	EXPORT

	input	Heap:l,Index:l
	output	Ptr:l
	BEGIN

  IF CheckHeap THEN
	jsl	H_CurrentHeap
	CmpLong	ax,Heap
	beq	ok
	
	Call	D_AlertBox,in=(#OkBox:w,#ErrorMesg:l),out=(a:w)
	bra	exit

ErrorMesg	str	'X_GetBlockPtr: mismatched heap!!'
ok
  ENDIF
	H_GetBlockPtr	Index,Ptr

exit	RETURN
	ENDP

;¦;-------------------------------------------------------------------------;
; X_ResizeBlock ( Heap:l,Index:l,NewSize:l )
;
X_ResizeBlock	PROC	EXPORT

	input	Heap:l,Index:l,NewSize:l
	local	NewPtr:l
	error	ErrorFlag
	BEGIN

  IF CheckHeap THEN
	jsl	H_CurrentHeap
	CmpLong	ax,Heap
	beq	ok
	
	Call	D_AlertBox,in=(#OkBox:w,#ErrorMesg:l),out=(a:w)
	bra	exit

ErrorMesg	str	'X_ResizeBlock: mismatched heap!!'
ok
  ENDIF
	H_ResizeBlock	Index,NewSize,err=ErrorFlag

exit	RETURN
	ENDP

;¦;-------------------------------------------------------------------------;
; X_WriteHeap ( Heap:long )
;
X_WriteHeap	PROC	EXPORT

	input	Heap:l
	error	ErrorFlag
	BEGIN

  IF CheckHeap THEN
	jsl	H_CurrentHeap
	CmpLong	ax,Heap
	beq	ok
	
	Call	D_AlertBox,in=(#OkBox:w,#ErrorMesg:l),out=(a:w)
	bra	exit

ErrorMesg	str	'X_WriteHeap: mismatched heap!!'
ok
  ENDIF
	H_WriteHeap	err=ErrorFlag

exit	RETURN
	ENDP

;-------------------------------------------------------------------------;
; X_ReadHeap ( ):Heap:long
;
X_ReadHeap	PROC	EXPORT

	output	Heap:l
	error	ErrorFlag
	BEGIN

	H_ReadHeap	Heap,err=ErrorFlag

exit	RETURN
	ENDP

;-------------------------------------------------------------------------;
; X_TruncHeap ( Heap:l )
;
X_TruncHeap	PROC	EXPORT

	input	Heap:l
	BEGIN

  IF CheckHeap THEN
	jsl	H_CurrentHeap
	CmpLong	ax,Heap
	beq	ok
	
	Call	D_AlertBox,in=(#OkBox:w,#ErrorMesg:l),out=(a:w)
	bra	exit

ErrorMesg	str	'X_TruncBlock: mismatched heap!!'
ok
  ENDIF
	H_TruncHeap

exit	RETURN
	ENDP

;¦;--------------------------------------------------------------------------;
; X_CopyIndex ( Heap:l, Index:l ):CopyIndex:l
;
X_CopyIndex	PROC	EXPORT

	input	Heap:l,Index:l
	output	CopyIndex:l
	local	NewPtr:l
	error	ErrorFlag
 	BEGIN

  IF CheckHeap THEN
	jsl	H_CurrentHeap
	CmpLong	ax,Heap
	beq	ok
	
	Call	D_AlertBox,in=(#OkBox:w,#ErrorMesg:l),out=(a:w)
	bra	exit

ErrorMesg	str	'X_CopyIndex: mismatched heap!!'
ok
  ENDIF
	H_CopyBlock	Index,CopyIndex,err=ErrorFlag

exit	RETURN
	ENDP


	END