;****************************************************************************
;*                                                                          *
;*                        MEDA Macro Lirary                                 *
;*                                                                          *
;****************************************************************************
;
; Edition History:
;Number   Date   Description                                              By
;------ -------- -------------------------------------------------------- ---
;
; [100] 07/05/88 Started with XCMEM                                       jeh
;----------------------------------------------------------------------------
;
;TEST
	UNIVERSAL

	ASECT
	NOSYM

	RADIX	10
;
; Equate Definition Area
;
; XCALL Variable Type Codes
;
X.Unf	=	0			; unformatted
X.Str	=	2			; string
X.Flt	=	4			; floating point
X.Bin	=	6			; binary
X.Int	=	8			; integer
X.Iee	=      10			; IEE floats

X.Arg	=	0
X.Typ	= 	2			;parameter string (type)
X.Adr	=	4			;parameter string (addr)
X.Siz	=	8			;parameter string (size)
X.Off	=      10
;
; General Macros
;
; ALKSTK - Allocates a data area on the stack. 
;	MEMSIZ - Number of bytes to allocate. (Must be an even number)
;       REGTR - Address register A0 - A6
;
DEFINE	ALKSTK	MEMSIZ, REGTR
	link	REGTR,#-MEMSIZ
	push	REGTR
	lea	REGTR,-MEMSIZ(REGTR)
	ENDM

; RELSTK - Releases the memory allocated on the stack by ALKSTK.
;
DEFINE	RELSTK	REGTR
	pop	REGTR
	unlnk	REGTR
	ENDM

; XCMEM - Determines if there is enough memory to run an XCALL. If there is
;         insufficient memory, the program is aborted.
; Note: D7 is destroyed
;
DEFINE	XCMEM	XCSIZE
	mov	A5,D7			; D7: base of top of free memory
	sub	A4,D7			; D7: number of bytes for XCALL work area
	cmp	D7,#XCSIZE		; is there enough memory?
	bhi	10$$			; yes
	TTYI				; no...output message and exit program
	ASCIZ	/Insufficient memory for XCALL/
	EVEN
	CRLF
	EXIT
10$$:
	ENDM

DEFINE	DSPBIN		;display a binary representation of reg D2
	PUSH	D0
	MOV	#32,D0
1$$:	ROL	D2,#1	
	BTST	#0,D2
	BEQ	2$$	
	TYPE	1	
	BR	4$$
2$$:	TYPE	0
4$$:	DEC	D0
	TSTW	D0
	BNE	1$$
	POP	D0
	ENDM

DEFINE	ICVT	bytes,length,flags
	;routine to put ascii rep of int in memory
	;A2 has memory location
	;D2 has integer
	;D7 destroyed
	PUSH	D2		;int to display
	PUSH	D6
	MOV	bytes,D7
	MOV	#1,D6
1$$:	MUL	D6,#256
	DEC	D7
	TST	D7
	BNE	1$$
	MOV	bytes,D7	
	MUL	D7,#8
	DEC	D7
	BTST	D7,D2
	BEQ	8$$
	SUB	D2,D6
	MOV	D6,D2
	MOV	#FLAGS,D0
	BTST	#1,D0
	BEQ	5$$
	TYPE	-
	BR	8$$
5$$:	BTST	#3,D0
	BEQ	9$$
	MOVB	#'-,(A2)+
8$$:	DCVT	length,flags
9$$:	POP	D6
	POP	D2
	ENDM

DEFINE	GTINT	bytes
	PUSH	D6
	CMPB	@A2,#'-		;is this a neg integer?
	BNE	6$$		; no
	MOV	bytes,D7	;yes
	MOV	#1,D6
1$$:	MUL	D6,#256
	DEC	D7
	TST	D7
	BNE	1$$
	INC	A2
	GTDEC
	XCH	D2,D6
	SUB	D6,D2
	BR	10$$
6$$:	GTDEC
10$$:	POP	D6
	ENDM

DEFINE	DDPMSK	dspsiz, fldsiz, stradr, mskadr
	;assumes curs has been positioned at start of display area
	;dspsiz-number if bytes to display
	;FLDSIZ-max field size
	;stradr-adr of string to print
	;mskadr-adr of mask to use
	;data reg containing col and row for display
	LCC	#0		;clear Z flag for error
	CMP	fldsiz,#0	;is there a size of display
	JLOS	40$$		; no. error
	SAVE	A0,A1,D0,D1,D2
	CMP	dspsiz,fldsiz
	BLOS	1$$
	MOV	fldsiz,dspsiz
1$$:	MOV	dspsiz,D0
	MOV	stradr,A0	;adr of string to display to A0
	MOV	fldsiz,D2
	MOV	mskadr,A1
	MOVB	#32.,D1		;space to D1
	PUSH	D2		;store field size
2$$:	;clear field and position curs at end of field
	CMPW	D2,#1		;at last char?
	BLOS	3$$		;yes	
	TTY			;clear char
	DECW	D2
	BR	2$$		;go do it again
3$$:	POP	D2
4$$:	;cursor is at last char position
	TSTB	@A1		;end of mask?
	BEQ	30$$		;yes	
	TSTW	D2		;end of field?
	BEQ	30$$		;yes	
	MOVB	#'0,D1		;preset 0 for display
	CMPB	(A1)+,#'#	;print char?
	BEQ	10$$		; yes
	MOVB	-1(A1),D1
	TTY
	CMPB	D1,#'.
	BNE	8$$
	MOV	D0,D2
8$$:	MOV	#-1_8+5,D1	;curs left
	TCRT
	TCRT	
	BR	4$$
10$$:	TSTW	D0		;end of display string?
	BEQ	20$$		;yes
	MOVB	-1(A0)[D0],D1
	DECW	D0
	BR	20$$
20$$:	TTY			;out char
	MOV	#-1_8+5,D1	;curs left
	TCRT
	TCRT	
	DECW	D2
	BR	4$$
30$$:	CMPB	@A1,#'(		;phone mask?
	BNE	34$$		;no
	MOVB	#'(,D1		;yes
	TTY
34$$:	REST	A0,A1,D0,D1,D2
	LCC	#4		;every thing ok, set Z flag
40$$:
	ENDM

DEFINE  XCVALU	argoff
	; used to return in D1 the value of a bin, int, or flt arg
	; A3	points to begining of XCALL arg list
	; D1	returns with value
	; D6	returns with type
	SAVE	A0,D0
	CLR	D1
	CLR	D6
	MOV	argoff,D0
	MOVW	X.Typ(A3)[D0],D6
	ANDW	#^H000F,D6		;mask off all but last 4 bits
	CMPW	D6,#X.Flt
	BEQ	6$$
	CMPW	D6,#X.Iee
	BEQ	6$$
	CMPW	D6,#X.Bin
	BEQ	2$$
	CMPW	D6,#X.Int
	BEQ	2$$
	LCC	#0		;clear z flag for error
	JMP	22$$
2$$:	MOV	X.Siz(A3)[D0],D7
	MOV	X.Adr(A3)[D0],A6
	ADD	D7,A6
4$$:	ROL	D1,#8	
	MOVB	-(A6),D1
	DECW	D7
	TSTW	D7
	BNE	4$$
	CMP	X.Siz(A3)[D0],#3
	BLO	18$$
	CMPW	D6,#X.Int
	BNE	18$$
	SWAP	D1
	BR	18$$
6$$:	;get a float of some kind
	PUSH
	PUSH			;get storage
	MOV	X.Adr(A3)[D0],A0
	CMP	X.Siz(A3)[D0],#6
	BEQ	12$$
	CMP	X.Siz(A3)[D0],#4
	BEQ	10$$
8$$:	MOV	@A0,@SP	
	MOV	4(A0),4(SP)
	MOV	SP,A0
	FIDTOA	@A0
	BR	12$$
10$$:	MOV	@A0,@SP	
	MOV	SP,A0
	FISTOA	@A0
12$$:	FFTOL	@A0,D1
	POP
	POP
18$$:	LCC	#4		;set z flag for success
22$$:	REST	A0,D0
	ENDM

DEFINE	DJMP	index
	LEA	A6,1$$
	MUL	index,#2
	SUBW	#2,index
	ADDW	index,A6
	ADDW	@A6,A6
	JMP	@A6
1$$:
	ENDM

	SYM
	PSECT






.