X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;ds=sidebyside;f=sw%2Fadventure%2Fsrc%2FBITSET.RA-web;fp=sw%2Fadventure%2Fsrc%2FBITSET.RA-web;h=ee1ee8a6b7fc978bcef79ec485cf1f8037d68f56;hb=81e70d488b71bf995c459ca3a02c025993460ffa;hp=0000000000000000000000000000000000000000;hpb=07ec0278333ed187ac242dedcff13c56cf1b0b91;p=pdp8.git

diff --git a/sw/adventure/src/BITSET.RA-web b/sw/adventure/src/BITSET.RA-web
new file mode 100644
index 0000000..ee1ee8a
--- /dev/null
+++ b/sw/adventure/src/BITSET.RA-web
@@ -0,0 +1,218 @@
+	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.
+
+SECNAM,	TEXT	+BITSET+	/For traceback
+#RET,	SETX	#XR		/Return addr
+	SETB	#BASE
+	JA	.+3
+#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			/XR 0
+	ADDR	#RETRN		/XR 1; XR2 return to FRTS address.
+	ORG	#XR+10		/ Space for our index regs
+
+	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
+
+BITSET,	FLDA	#BSET		/Section name
+	JSA	GETARG		/Common setup
+	BASE	#BASE
+
+	FLDA%	L		/Get array index
+	ATX	1
+	FLDA	COND-0003,1	/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
+	ALN	0
+	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 entry point
+/
+	BASE	0
+ISHFT,	FLDA	#ISH		/Section name
+	JSA	GETARG		/Common setup
+
+	BASE	#BASE
+	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
+	STARTD
+	0210			/Get caller's return
+	FSTA	#GOBAK,0
+	0200			/Get arg list
+	SETX	#XR		/Set up index registers
+	SETB	#BASE		/Set up base page
+	FSTA	#BASE		/Set up arg list
+	LDX	0,1		/Zero to XR #1
+	FLDA%	#BASE,1+	/Get first arg
+	FSTA	L
+	FLDA%	#BASE,1+	/Second arg
+	FSTA	N
+	STARTF
+	JA	GETARG		/Return
+	END