SECT	BTSET
	ENTRY	ISHFT
	ENTRY	BITSET
	ENTRY	#ANDER
	EXTERN	#RETRN
	EXTERN	#FIX
	SECT8	BITTER

#ANDER,	TAD	#XR		/Simple masking
	AND	#XR+1
	DCA	#XR
	CIF CDF
	JMP%	#XR+2		/ Return

/FPP code here; using the rest of the SECT8 page.

#RET,	SETX	#XR		/Traceback
	SETB	#BASE
	JA	.+3
SECNAM,	TEXT	+BITSET+	/For traceback
#BASE,	ORG	.+3		/Base 0
N,	ORG	.+3		/Base 1 - value
L,	ORG	.+3
#BSET,	TEXT	+BITSET+	/Base 2 - section name
#ISH,	TEXT	+ISHFT +	/Base 3

/ Now at address 23, past autoindex registers.
#XR,	FNOP		/Base 5: XR 0
	ADDR	#RETRN	/	 XR 1; XR2 return to FRTS address.
	1;2;3		/Base 6: XR3-5
TWO,	F 2.0		/Base 7

	ORG	#BASE+30
	FNOP
	JA	#RET
	FNOP
#GOBAK,	0;0
	#LBL=.
	COMMON	MISCOM
LINUSE,	ORG	.+0003
TRVS,	ORG	.+0003
CLSSES,	ORG	.+0003
OLDLOC,	ORG	.+0003
LOC,	ORG	.+0003
CVAL,	ORG	.+0044
TK,	ORG	.+0074
NEWLOC,	ORG	.+0003
KEY,	ORG	.+0702
PLAC,	ORG	.+0454
FIXD,	ORG	.+0454
ACTSPK,	ORG	.+0151
COND,	ORG	.+0702
HINTS,	ORG	.+0360
HNTMAX,	ORG	.+0003
PROP,	ORG	.+0454
TALLY,	ORG	.+0003
TALLY2,	ORG	.+0003
HINTLC,	ORG	.+0074
CHLOC,	ORG	.+0003
CHLOC2,	ORG	.+0003
DSEEN,	ORG	.+0022
DFLAG,	ORG	.+0003
DLOC,	ORG	.+0022
DALTLC,	ORG	.+0003
KEYS,	ORG	.+0003
LAMP,	ORG	.+0003
GRATE,	ORG	.+0003
CAGE,	ORG	.+0003
ROD,	ORG	.+0003
ROD2,	ORG	.+0003
STEPS,	ORG	.+0003
BIRD,	ORG	.+0003
DOOR,	ORG	.+0003
PILLOW,	ORG	.+0003
SNAKE,	ORG	.+0003
FISSUR,	ORG	.+0003
TABLET,	ORG	.+0003
CLAM,	ORG	.+0003
OYSTER,	ORG	.+0003
MAGZIN,	ORG	.+0003
DWARF,	ORG	.+0003
KNIFE,	ORG	.+0003
FOOD,	ORG	.+0003
BOTTLE,	ORG	.+0003
WATER,	ORG	.+0003
OIL,	ORG	.+0003
PLANT,	ORG	.+0003
PLANT2,	ORG	.+0003
AXE,	ORG	.+0003
MIRROR,	ORG	.+0003
DRAGON,	ORG	.+0003
CHASM,	ORG	.+0003
TROLL,	ORG	.+0003
TROLL2,	ORG	.+0003
BEAR,	ORG	.+0003
MESSAG,	ORG	.+0003
VEND,	ORG	.+0003
BATTER,	ORG	.+0003
NUGGET,	ORG	.+0003
COINS,	ORG	.+0003
CHEST,	ORG	.+0003
EGGS,	ORG	.+0003
TRIDNT,	ORG	.+0003
VASE,	ORG	.+0003
EMRALD,	ORG	.+0003
PYRAM,	ORG	.+0003
PEARL,	ORG	.+0003
RUG,	ORG	.+0003
CHAIN,	ORG	.+0003
BACK,	ORG	.+0003
LOOK,	ORG	.+0003
CAVE,	ORG	.+0003
NULL,	ORG	.+0003
ENTRNC,	ORG	.+0003
DPRSSN,	ORG	.+0003
SAY,	ORG	.+0003
LOCK,	ORG	.+0003
THROW,	ORG	.+0003
FIND,	ORG	.+0003
INVENT,	ORG	.+0003
TURNS,	ORG	.+0003
LMWARN,	ORG	.+0003
KNFLOC,	ORG	.+0003
DETAIL,	ORG	.+0003
ABBNUM,	ORG	.+0003
NUMDIE,	ORG	.+0003
MAXDIE,	ORG	.+0003
DKILL,	ORG	.+0003
FOOBAR,	ORG	.+0003
BONUS,	ORG	.+0003
CLOCK1,	ORG	.+0003
CLOCK2,	ORG	.+0003
CLOSNG,	ORG	.+0003
PANIC,	ORG	.+0003
CLOSED,	ORG	.+0003
GAVEUP,	ORG	.+0003
SCORNG,	ORG	.+0003
ODLOC,	ORG	.+0022
STREAM,	ORG	.+0003
SPICES,	ORG	.+0003
	ORG	#LBL

COUNT,	ORG	.+3
ONE,	F 1.0


/BITSET(L,N) = (COND(L).AND.ISHFT(1,N)) .NE.0
	BASE	#BASE

BITSET,	FLDA	#BSET		/Section name
	JSA	GETARG		/Common setup

	FLDA%	L		/Get array index
	ATX	7
	FLDA	COND-0003,7	/COND(L)
	FSTA	ITEST		/ COND(L)
	LDX	1,0		/Put 1 into shift value
	FLDA%	N		/Get N value
	JEQ	#1		/No shift if zero
	FNEG			/Negate
	ATX	1		/Into register
	XTA	0		/Get the "1" back
	STARTD
	ALN	1		/Do the shift
	STARTF
	ATX	0		/Put result in place
#1,	XTA	0		/Get result
	JSA	#FIX
	ATX	0		/One mask value
	FLDA	ITEST
	JSA	#FIX
	ATX	1		/The other
	TRAP3	#ANDER		/AND it
	XTA	0		/Restore value
	JEQ	#GOBAK		/Return if zero
	FLDA	ONE		/Else one
	JA	#GOBAK		/Done.
ITEST,	ORG 	.+3		/Test value

ISHFT,	FLDA	#ISH		/Section name
	JSA	GETARG		/Common setup
	FLDA%	N		/Get shift count
	JEQ	#SKIP		/No need to shift
	FNEG			/Negative shift count goes left
	ATX	1		/Into XR 1
	FLDA%	L		/Get value to shift
	ALN	0		/Align to right
	STARTD
	ALN	1		/Shift
	STARTF			/Done
	JSA	#FIX
	JA	#GOBAK		/Done
#SKIP,	FLDA%	L		/Get value back
	JA	#GOBAK		/Done

GETARG,	0;0			/Common setup routine
	FSTA	SECNAM		/AC has section name
	SETX	#XR		/Set up index registers
	STARTD
	0210			/Get caller's prolog
	FSTA	#GOBAK,0
	0200			/Get arg list
	SETB	#BASE		/Set up base page
	FSTA	#BASE		/Set up arg list
	FLDA%	#BASE,3		/Get first arg
	FSTA	L
	FLDA%	#BASE,4		/Second arg
	FSTA	N
	STARTF
	JA	GETARG		/Return
	END