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