disk8: Initial commit

[pdp8.git] / sw / adventure / BITSET.RA

	SECT	BTSET\r
	ENTRY	ISHFT\r
	ENTRY	BITSET\r
	ENTRY	#ANDER\r
	EXTERN	#RETRN\r
	EXTERN	#FIX\r
	SECT8	BITTER\r
\r
#ANDER,	TAD	#XR		/Simple masking\r
	AND	#XR+1\r
	DCA	#XR\r
	CIF CDF\r
	JMP%	#XR+2		/ Return\r
\r
/FPP code here; using the rest of the SECT8 page.\r
\r
SECNAM,	TEXT	+BITSET+	/For traceback\r
#RET,	SETX	#XR		/Return addr\r
	SETB	#BASE\r
	JA	.+3\r
#BASE,	ORG	.+3		/Base 0\r
N,	ORG	.+3		/Base 1 - value\r
L,	ORG	.+3\r
#BSET,	TEXT	+BITSET+	/Base 2 - section name\r
#ISH,	TEXT	+ISHFT +	/Base 3\r
\r
/ Now at address 23, past autoindex registers.\r
#XR,	FNOP			/XR 0\r
	ADDR	#RETRN		/XR 1; XR2 return to FRTS address.\r
	ORG	#XR+10		/ Space for our index regs\r
\r
	ORG	#BASE+30\r
	FNOP\r
	JA	#RET\r
	FNOP\r
#GOBAK,	0;0\r
	#LBL=.\r
	COMMON	MISCOM\r
LINUSE,	ORG	.+0003\r
TRVS,	ORG	.+0003\r
CLSSES,	ORG	.+0003\r
OLDLOC,	ORG	.+0003\r
LOC,	ORG	.+0003\r
CVAL,	ORG	.+0044\r
TK,	ORG	.+0074\r
NEWLOC,	ORG	.+0003\r
KEY,	ORG	.+0702\r
PLAC,	ORG	.+0454\r
FIXD,	ORG	.+0454\r
ACTSPK,	ORG	.+0151\r
COND,	ORG	.+0702\r
HINTS,	ORG	.+0360\r
HNTMAX,	ORG	.+0003\r
PROP,	ORG	.+0454\r
TALLY,	ORG	.+0003\r
TALLY2,	ORG	.+0003\r
HINTLC,	ORG	.+0074\r
CHLOC,	ORG	.+0003\r
CHLOC2,	ORG	.+0003\r
DSEEN,	ORG	.+0022\r
DFLAG,	ORG	.+0003\r
DLOC,	ORG	.+0022\r
DALTLC,	ORG	.+0003\r
KEYS,	ORG	.+0003\r
LAMP,	ORG	.+0003\r
GRATE,	ORG	.+0003\r
CAGE,	ORG	.+0003\r
ROD,	ORG	.+0003\r
ROD2,	ORG	.+0003\r
STEPS,	ORG	.+0003\r
BIRD,	ORG	.+0003\r
DOOR,	ORG	.+0003\r
PILLOW,	ORG	.+0003\r
SNAKE,	ORG	.+0003\r
FISSUR,	ORG	.+0003\r
TABLET,	ORG	.+0003\r
CLAM,	ORG	.+0003\r
OYSTER,	ORG	.+0003\r
MAGZIN,	ORG	.+0003\r
DWARF,	ORG	.+0003\r
KNIFE,	ORG	.+0003\r
FOOD,	ORG	.+0003\r
BOTTLE,	ORG	.+0003\r
WATER,	ORG	.+0003\r
OIL,	ORG	.+0003\r
PLANT,	ORG	.+0003\r
PLANT2,	ORG	.+0003\r
AXE,	ORG	.+0003\r
MIRROR,	ORG	.+0003\r
DRAGON,	ORG	.+0003\r
CHASM,	ORG	.+0003\r
TROLL,	ORG	.+0003\r
TROLL2,	ORG	.+0003\r
BEAR,	ORG	.+0003\r
MESSAG,	ORG	.+0003\r
VEND,	ORG	.+0003\r
BATTER,	ORG	.+0003\r
NUGGET,	ORG	.+0003\r
COINS,	ORG	.+0003\r
CHEST,	ORG	.+0003\r
EGGS,	ORG	.+0003\r
TRIDNT,	ORG	.+0003\r
VASE,	ORG	.+0003\r
EMRALD,	ORG	.+0003\r
PYRAM,	ORG	.+0003\r
PEARL,	ORG	.+0003\r
RUG,	ORG	.+0003\r
CHAIN,	ORG	.+0003\r
BACK,	ORG	.+0003\r
LOOK,	ORG	.+0003\r
CAVE,	ORG	.+0003\r
NULL,	ORG	.+0003\r
ENTRNC,	ORG	.+0003\r
DPRSSN,	ORG	.+0003\r
SAY,	ORG	.+0003\r
LOCK,	ORG	.+0003\r
THROW,	ORG	.+0003\r
FIND,	ORG	.+0003\r
INVENT,	ORG	.+0003\r
TURNS,	ORG	.+0003\r
LMWARN,	ORG	.+0003\r
KNFLOC,	ORG	.+0003\r
DETAIL,	ORG	.+0003\r
ABBNUM,	ORG	.+0003\r
NUMDIE,	ORG	.+0003\r
MAXDIE,	ORG	.+0003\r
DKILL,	ORG	.+0003\r
FOOBAR,	ORG	.+0003\r
BONUS,	ORG	.+0003\r
CLOCK1,	ORG	.+0003\r
CLOCK2,	ORG	.+0003\r
CLOSNG,	ORG	.+0003\r
PANIC,	ORG	.+0003\r
CLOSED,	ORG	.+0003\r
GAVEUP,	ORG	.+0003\r
SCORNG,	ORG	.+0003\r
ODLOC,	ORG	.+0022\r
STREAM,	ORG	.+0003\r
SPICES,	ORG	.+0003\r
	ORG	#LBL\r
\r
COUNT,	ORG	.+3\r
ONE,	F 1.0\r
\r
\r
/BITSET(L,N) = (COND(L).AND.ISHFT(1,N)) .NE.0\r
\r
BITSET,	FLDA	#BSET		/Section name\r
	JSA	GETARG		/Common setup\r
	BASE	#BASE\r
\r
	FLDA%	L		/Get array index\r
	ATX	1\r
	FLDA	COND-0003,1	/COND(L)\r
	FSTA	ITEST		/ COND(L)\r
	LDX	1,0		/Put 1 into shift value\r
	FLDA%	N		/Get N value\r
	JEQ	#1		/No shift if zero\r
	FNEG			/Negate\r
	ATX	1		/Into register\r
	XTA	0		/Get the "1" back\r
	ALN	0\r
	STARTD\r
	ALN	1		/Do the shift\r
	STARTF\r
	ATX	0		/Put result in place\r
#1,	XTA	0		/Get result\r
	JSA	#FIX\r
	ATX	0		/One mask value\r
	FLDA	ITEST\r
	JSA	#FIX\r
	ATX	1		/The other\r
	TRAP3	#ANDER		/AND it\r
	XTA	0		/Restore value\r
	JEQ	#GOBAK		/Return if zero\r
	FLDA	ONE		/Else one\r
	JA	#GOBAK		/Done.\r
ITEST,	ORG 	.+3		/Test value\r
\r
/\r
/ ISHFT entry point\r
/\r
	BASE	0\r
ISHFT,	FLDA	#ISH		/Section name\r
	JSA	GETARG		/Common setup\r
\r
	BASE	#BASE\r
	FLDA%	N		/Get shift count\r
	JEQ	#SKIP		/No need to shift\r
	FNEG			/Negative shift count goes left\r
	ATX	1		/Into XR 1\r
	FLDA%	L		/Get value to shift\r
	ALN	0		/Align to right\r
	STARTD\r
	ALN	1		/Shift\r
	STARTF			/Done\r
	JSA	#FIX\r
	JA	#GOBAK		/Done\r
#SKIP,	FLDA%	L		/Get value back\r
	JA	#GOBAK		/Done\r
\r
GETARG,	0;0			/Common setup routine\r
	FSTA	SECNAM		/AC has section name\r
	STARTD\r
	0210			/Get caller's return\r
	FSTA	#GOBAK,0\r
	0200			/Get arg list\r
	SETX	#XR		/Set up index registers\r
	SETB	#BASE		/Set up base page\r
	FSTA	#BASE		/Set up arg list\r
	LDX	0,1		/Zero to XR #1\r
	FLDA%	#BASE,1+	/Get first arg\r
	FSTA	L\r
	FLDA%	#BASE,1+	/Second arg\r
	FSTA	N\r
	STARTF\r
	JA	GETARG		/Return\r
	END\r