;***************************************************************************;
;									    ;
;				    BASE				    ;
;	 AlphaBASIC subroutine - returns the base of a memory module	    ;
;									    ;
;***************************************************************************;
;Donated to AMUS on 19-Apr-86 by UltraSoft.  All Rights Reserved.
;
;Written by: David Pallmann
;
;Edit History:
;1.0 19-Apr-86 created. /DFP
;
;Calling Format:
;
;	XCALL BASE, module$, base
;
;Where:		module$ - is a string variable or constant containing the
;			  name of the module to locate.  The string must
;			  be in the format "{name}.{extension}".
;
;		base    - is a floating point variable, which receives the
;			  base address of the module.  If the module is not
;			  in memory, a zero is returned.  If the module
;			  specification is invalid, a zero is returned as
;			  well.
;
;Example:
;
;	XCALL "MTSTAT.SYS", X

	VMAJOR=1
	VMINOR=0

	OBJNAM	.SBR

	SEARCH	SYS
	SEARCH	SYSSYM

	;XCALL argument list set up by BASIC and indexed by A3

	.OFINI
	.OFDEF	COUNT,2
	.OFDEF	TYPE1,2
	.OFDEF	ADDR1,4
	.OFDEF	SIZE1,4
	.OFDEF	TYPE2,2
	.OFDEF	ADDR2,4
	.OFDEF	SIZE2,4
	.OFSIZ	XCSIZE

	;XCALL argument list - variable type codes

        STRING=2
        FLOAT=4

ENTRY:	PHDR	-1,PV$RSM,PH$REE!PH$REU	; program header

;check for correct number of arguments and for proper argument data types

CHECK:	CMMW	COUNT(A3),#2		; 2 arguments specified?
	JNE	ARGERR			;  no - error
	CMMW	TYPE1(A3),#STRING	; 1st argument string?
	JNE	TYPERR			;  no - error
	CMMW	TYPE2(A3),#FLOAT	; 2nd argument string?
	JNE	TYPERR			;  no - error

;translate the ASCII module name to RAD50 using the free memory set up
;basic and indexed by register A4.

XLATE:	MOV	ADDR1(A3),A2		; point A2 to module name
	ALF				; is module name valid?
	BEQ	10$			;  yes
	NUM				; is module name valid?
	JNE	NOTFND			;  no
10$:	FILNAM	@A4,DAT			; convert ASCII @A2 to RAD50 @A4

;look for the module in system and user memory

LOOK:	SRCH	@A4,A0			; look for module, A0 gets addres
	JEQ	RETURN			;  found - branch

;clear out return code - module not found

NOTFND:	SUB	A0,A0			;  not found - clear A0 

;convert module address A0 to floating point return codej

RETURN:	MOV	A0,D0
	MOV	ADDR2(A3),A1
	FLTOF	D0,@A1

;return to BASIC program

	RTN

;error handling

ARGERR:	TYPESP	?Incorrect number of arguments
	BR	ERROR

TYPERR:	TYPESP	?Incorrect argument type

ERROR:	TYPECR	in BASE.SBR
	RTN

	END