Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap2_198111 - decus/20-0057/sddlib.mac
There are 2 other files named sddlib.mac in the archive. Click here to see a list.
	TITLE	S$$LIB FASBOL USER FUNCTION LIBRARY
	COMMENT/
	THESE FUNCTIONS ARE AVAILABLE TO FASBOL USER PROGRAMS PRO-
VIDED THE APPROPRIATE 'EXTERNAL.FUNCTION' DECLARATIONS ARE MADE, SINCE
THESE FUNCTIONS ARE NOT KNOWN TO THE COMPILER. THESE FUNCTIONS ARE
OTHERWISE QUITE SIMILAR TO THE PREDEFINED PRIMITIVES.

	THE FUNCTIONS ARE:
MEMBER(TABLE,ELEMENT) 'NRETURN'S THE NAME OF THE ELEMENT'S VALUE OR
	FAILS IF THE ELEMENT IS NOT IN THE TABLE. USED AS A SUBSTITUTE
	FOR TABLE REFERENCES WHEN IT IS DESIRABLE NOT TO CREATE NEW
	TABLE ENTRIES.

/
	SUBTTL	MEMBER(TABLE,ELEMENT) TABLE LOOKUP WITHOUT INSERTION

	ENTRY	MEMBER
	EXTERN	S$$PGL,S$$FLR,S$$SY1
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	EXTERNAL FUNCTION CALL. FIRST ARGUMENT MUST BE A 'TABLE' DATA-
TYPE, SECOND ARGUMENT MAY BE OF ANY TYPE. USES SECOND ARG AS KEY FOR
TABLE LOOKUP, BUT DOES NOT CREATE A NEW ENTRY WITH NULL VALUE IF NOT
FOUND, AND FAILS (FRETURN) IF NOT FOUND. DOES NRETURN OF NAME OF ENTRY
VALUE IF FOUND.

	EXAMPLES:

	T	= TABLE(20,5);	T<'ELEMENT'>	= 'VALUE'
*
	X	= T<'ELEMENT'>	;* SETS X = 'VALUE'
	X	= MEMBER(T,'ELEMENT')	;* SAME EFFECT
	X	= T<'ELT1'>	;* SETS X = NULL, CREATES ENTRY
	X	= MEMBER(T,'ELT2')	;* FAILS, X NOT SET, NO NEW ENTRY
*
	T<'ELEMENT'>	= 'OTHER'	;* RESETS VALUE OF ENTRY TO 'OTHER'
	MEMBER(T,'ELEMENT')	= 'OTHER'	;* SAME EFFECT
	T<'ELT3'>	= 'OTHER'	;* CREATES NEW ENTRY WITH VALUE 'OTHER'
	MEMBER(T,'ELT4')	= 'OTHER'	;* FAILS, NO NEW ENTRY
	/

FUNLOC:	POP	ES,R1	; GET KEY DESCRIPTOR (SECOND ARG)
	POP	ES,R0	; GET TABLE DESCRIPTOR (FIRST ARG)
	TLC	R0,^B01011B22	; IS IT A TABLE?
	TLNE	R0,^B11111B22	; (AND ZERO UPPER 5 BITS)
	CFERR	10,S$$PGL	; NO, BAD ARGUMENT
	JSP	R7,S$$SY1	; YES, GO DO LOOKUP
	SKIPA	R1,R2	; FOUND, GET VALUE PTR, SKIP
	JRST	S$$FLR	; NOT FOUND, FAIL
	HRLI	R1,1B19	; FORM NAME DESCRIPTOR
	JRST	1(R12)	; NRETURN WITH NAME AS VALUE
; FUNCTION DEFINITION WORD - TWO ARGUMENTS EXPECTED
MEMBER:	BYTE	(4)4(5)0(4)2(5)0(18)FUNLOC
	END