******************************************************************************
 *			  FREXX PROGRAMMING LANGUAGE			      *
 ******************************************************************************
 
 * liballoc.a
 
 * Stack allocation/checking/expanding routines.

 * Authors: Kjell Ericson and Daniel Stenberg
 
 ******************************************************************************/

 ************************************************************************
 *                                                                      *
 * fpl.library - A run time library interpreting script langauge.       *
 * Copyright (C) 1992, 1993 FrexxWare                                   *
 * Author: Daniel Stenberg                                              *
 *                                                                      *
 * This program is free software; you can redistribute it and/or modify *
 * it under the terms of the GNU General Public License as published by *
 * the Free Software Foundation; either version 2, or (at your option)  *
 * any later version.                                                   *
 *                                                                      *
 * This program is distributed in the hope that it will be useful,      *
 * but WITHOUT ANY WARRANTY; without even the implied warranty of       *
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the        *
 * GNU General Public License for more details.                         *
 *                                                                      *
 * You should have received a copy of the GNU General Public License    *
 * along with this program; if not, write to the Free Software          *
 * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.            *
 *                                                                      *
 * Daniel Stenberg                                                      *
 * Birger Jarlsgatan 93b 3tr                                            *
 * 113 56 Stockholm                                                     *
 * Sweden                                                               *
 *                                                                      *
 * FidoNet 2:201/328                                                    *
 *                                                                      *
 ************************************************************************
	; LibAlloc.a
	;
	; Allocate and expands the stack at need. a6 is always the FPLBase
	; pointer when any of these routine are called!

	CSECT	LibAlloc

	xdef	_GetStackSize	; long GetStackSize(struct Data *);
	xdef	_GetStackUsed	; long GetStackUsed(struct Data *);
	xdef	_InitStack	; void InitStack(struct Data *)
	xdef	_EndStack	; void EndStack(struct Data *, long maxstack)
	xdef	_CheckStack	; long OK= CheckStack(struct Data *,
				;		      long maxstack,
				;		      long minstack);
	xdef	_InterfaceCall	; long InterfaceCall(struct Data *,
				;		     void **);
				;		     func pointer);
	xdef	_StoreRegisters ; void StoreRegisters(stuct Data *);
	xref	_Script		; call this function!

	xref	_Malloc		; malloc routine
	xref	_Free		; free routine

	IFD	LOCKFUNTIONS_WANTED

	xdef	_Locker		; void Locker(long *data, char bit);
	xdef	_Unlocker	; void Unlocker(long *data, char bit);

	ENDC

	include "exec/memory.i"
	include "liballoc.i"

asALLOCSTACK equ 5000	; Number of bytes added to current size when reallocing
asINITCOPY equ 100	; Amout of memory copied from stack (even 4)
MALLOC_STATIC equ 1	; Static allocation type specifier

_InitStack: ; ( a lot of data is puched on the stack )
	movem.l	d0/d1/a0/a1,-(a7)
	move.l	20(a7),a1	; struct Data *
	move.l	(a1),a0		; new stack address

	move.l	16(a7),8(a0)
	move.l	a7,4(a0)		; Store old stackpointer
	add.l	(a0),a0			; Copy the last part of the stack
	sub.l	#asINITCOPY+20,a0
	move.l	#asINITCOPY,d1
aslo1:	move.l	0(a7,d1),d0
	move.l	d0,0(a0,d1)
	sub.l	#4,d1
	bpl.s	aslo1

	move.l	a0,a7
	movem.l	(a7)+,d0/d1/a0/a1

	jmp	_Script


_EndStack: ; (struct Data * - A0; max stack left - D0)
	movem.l	d2/d1/a3/a4,-(a7)

	move.l	a0,a3			; move struct Data * to A3
	move.l	DATA_STACKBASE(a3),a4	; get stack base
	move.l	4(a4),a1		; Get the old stack pointer
	; subq.l	#4,a1 ; ????????????????

	; copy #asINITCOPY number of bytes from the FPL stack, back
	; to the previous stack to bring back the changes.

	move.l	#asINITCOPY,d1
aslo2:	move.l	0(a7,d1),d2
	move.l	d2,0(a1,d1)
	subq.l	#4,d1
	bpl.s	aslo2
	move.l	a1,a7
	cmp.l	(a4),d0
	bhi.s	esend

	move.l	d0,-(sp)		; push max stack left
	move.l	a4,a1			; memory address
	move.b	#MALLOC_STATIC,d0	; type
	move.l	a3,a0			; struct Data *
	jsr	_Free

	move.l	(sp),d0			; new size
	move.b	#MALLOC_STATIC,d1 	; type
	move.l	a3,a0			; struct Data *
	jsr	_Malloc

	move.l	(sp)+,d2		; new size
	move.l	d0,a0			; get stack pointer
	move.l	d2,(a0)			; set size
	move.l	d0,DATA_STACKBASE(a3)	; store stack base
esend:
	movem.l	(a7)+,d2/d1/a3/a4
	rts

_GetStackSize: ;(struct Data * - A0)
	move.l	a1,-(sp)		; backup A1
	move.l	DATA_STACKBASE(a0),a1	; stack base address
	move.l	(a1),d0			; stack size to D0
	move.l	(sp)+,a1		; restore A1
	rts

_GetStackUsed: ;(struct Data * - A0)
	move.l	a1,-(sp)		; backup A1
	move.l	DATA_STACKBASE(a0),a1	; stack base address
	move.l	sp,d0			; get stack pointer to d0
	sub.l	a1,d0			; subtract stack base pointer
	move.l	(sp)+,a1		; restore A1
	rts

_CheckStack: ;(struct Data * - A3; stack limit - D2 ; stack margin - D3)
	movem.l	d1/a0/a1/a2,-(sp)

	move.l	DATA_STACKBASE(a3),a0	; stack base address

	move.l	sp,d0
	sub.l	a0,d0
	cmp.l	d3,d0 ; have the stack usage crossed the margin?
	bpl	csend ; no? return!
	move.l	(a0),d0	; get current stack size in D0
	cmp.l	d0,d2	; compare with stack limit in D2
	beq	csend3	; already using max size, go csend3!
	add.l	d3,d0			; add margin size D3 to stack size
	add.l	#asALLOCSTACK,d0	; add default stack adding space size
	cmp.l	d0,d2			; Compare with the stack limit
	bpl	csla1
	move.l	d2,d0			; Use stack limit!
csla1:
	movem.l	d0/a0,-(sp)		; size in D0
	move.b	#MALLOC_STATIC,d1	; type
	move.l	a3,a0			; struct Data *
	jsr	_Malloc
	movem.l	(sp)+,d1/a0
	tst.l	d0			; Did we get memory?
	beq.s	csend2
	move.l	d0,a2
	move.l	d1,(a2)
	move.l	4(a0),4(a2)
	move.l	8(a0),8(a2)

	movem.l	a2/a3,-(sp)
	move.l	a0,a1
	sub.l	(a0),a2
	add.l	d1,a2
	move.l	(a0),d0
	sub.l	#4,d0
cslo1:	move.l	(a1)+,(a2)+
	sub.l	#4,d0
	bpl.s	cslo1

	movem.l	(sp)+,a2/a3
	sub.l	a0,sp			; Get stack use
	add.l	a2,sp			; add stack address
	add.l	d3,sp			; add margin
	add.l	#asALLOCSTACK,sp	; add stack realloc size
	movem.l	a2/a3,-(sp)

			; Deallocate old stack

	move.l	a0,a1			; memory pointer
	move.l	a3,a0			; struct Data *
	move.b	#MALLOC_STATIC,d0	; type
	jsr	_Free
	movem.l	(sp)+,a2/a3

	move.l	a2,DATA_STACKBASE(a3)	; Store the new value
csend:			; OK
	moveq.l	#0,d0
	movem.l	(sp)+,d1/a0/a1/a2
	rts
csend2:			; OUT OF MEM
	moveq.l	#1,d0
	movem.l	(sp)+,d1/a0/a1/a2
	rts
csend3:			; MAX STACK REACHED
	moveq.l	#2,d0
	movem.l	(sp)+,d1/a0/a1/a2
	rts


_InterfaceCall: ; struct Data * in A1
		; void * in A0
		; function pointer in A2

	move.l	a3,-(sp)			; backup A3
	lea	DATA_REGISTERSTORAGE(a1),a3	; get register buffer
	move.l	a2,a1				; function pointer to A1
	movem.l	d2-d7/a2/a4-a6,-(sp)		; store registers
	movem.l	(a3),d2-d7/a2-a6		; get registers from buffer
	jsr	(a1)				; call interface function
	movem.l	(sp)+,d2-d7/a2/a4-a6		; restore old registers
	move.l	(sp)+,a3			; restore A3
	rts

_StoreRegisters: ; struct Data * in A0
	lea	DATA_REGISTERSTORAGE(a0),a0	; get register buffer address
	movem.l	d2-d7/a2-a6,(a0)		; store registers in buffer
	rts

	IFD	LOCKFUNCTIONS_WANTED

_Locker: ; long *data in A0
	 ; char bit in D0

	bset	d0,(a0)
	bne.s	_Locker
	rts

_Unlocker: ; long *data in A0
	   ; char bit in D0

	bclr	d0,(a0)
	rts

	ENDC

 END