1 line
5.3 KiB
Plaintext
Executable File
1 line
5.3 KiB
Plaintext
Executable File
;
|
|
; 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 |