[pdp8.git] / sw / src / 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
Commit	Line	Data
84b5715c PH	1	SECT BTSET\r
	2	ENTRY ISHFT\r
	3	ENTRY BITSET\r
	4	ENTRY #ANDER\r
	5	EXTERN #RETRN\r
	6	EXTERN #FIX\r
	7	SECT8 BITTER\r
	8	\r
	9	#ANDER, TAD #XR /Simple masking\r
	10	AND #XR+1\r
	11	DCA #XR\r
	12	CIF CDF\r
	13	JMP% #XR+2 / Return\r
	14	\r
	15	/FPP code here; using the rest of the SECT8 page.\r
	16	\r
	17	SECNAM, TEXT +BITSET+ /For traceback\r
	18	#RET, SETX #XR /Return addr\r
	19	SETB #BASE\r
	20	JA .+3\r
	21	#BASE, ORG .+3 /Base 0\r
	22	N, ORG .+3 /Base 1 - value\r
	23	L, ORG .+3\r
	24	#BSET, TEXT +BITSET+ /Base 2 - section name\r
	25	#ISH, TEXT +ISHFT + /Base 3\r
	26	\r
	27	/ Now at address 23, past autoindex registers.\r
	28	#XR, FNOP /XR 0\r
	29	ADDR #RETRN /XR 1; XR2 return to FRTS address.\r
	30	ORG #XR+10 / Space for our index regs\r
	31	\r
	32	ORG #BASE+30\r
	33	FNOP\r
	34	JA #RET\r
	35	FNOP\r
	36	#GOBAK, 0;0\r
	37	#LBL=.\r
	38	COMMON MISCOM\r
	39	LINUSE, ORG .+0003\r
	40	TRVS, ORG .+0003\r
	41	CLSSES, ORG .+0003\r
	42	OLDLOC, ORG .+0003\r
	43	LOC, ORG .+0003\r
	44	CVAL, ORG .+0044\r
	45	TK, ORG .+0074\r
	46	NEWLOC, ORG .+0003\r
	47	KEY, ORG .+0702\r
	48	PLAC, ORG .+0454\r
	49	FIXD, ORG .+0454\r
	50	ACTSPK, ORG .+0151\r
	51	COND, ORG .+0702\r
	52	HINTS, ORG .+0360\r
	53	HNTMAX, ORG .+0003\r
	54	PROP, ORG .+0454\r
	55	TALLY, ORG .+0003\r
	56	TALLY2, ORG .+0003\r
	57	HINTLC, ORG .+0074\r
	58	CHLOC, ORG .+0003\r
	59	CHLOC2, ORG .+0003\r
	60	DSEEN, ORG .+0022\r
	61	DFLAG, ORG .+0003\r
	62	DLOC, ORG .+0022\r
	63	DALTLC, ORG .+0003\r
	64	KEYS, ORG .+0003\r
65	LAMP, ORG .+0003\r
66	GRATE, ORG .+0003\r
67	CAGE, ORG .+0003\r
68	ROD, ORG .+0003\r
69	ROD2, ORG .+0003\r
70	STEPS, ORG .+0003\r
71	BIRD, ORG .+0003\r
72	DOOR, ORG .+0003\r
73	PILLOW, ORG .+0003\r
74	SNAKE, ORG .+0003\r
75	FISSUR, ORG .+0003\r
76	TABLET, ORG .+0003\r
77	CLAM, ORG .+0003\r
78	OYSTER, ORG .+0003\r
79	MAGZIN, ORG .+0003\r
80	DWARF, ORG .+0003\r
81	KNIFE, ORG .+0003\r
82	FOOD, ORG .+0003\r
83	BOTTLE, ORG .+0003\r
84	WATER, ORG .+0003\r
85	OIL, ORG .+0003\r
86	PLANT, ORG .+0003\r
87	PLANT2, ORG .+0003\r
88	AXE, ORG .+0003\r
89	MIRROR, ORG .+0003\r
90	DRAGON, ORG .+0003\r
91	CHASM, ORG .+0003\r
92	TROLL, ORG .+0003\r
93	TROLL2, ORG .+0003\r
94	BEAR, ORG .+0003\r
95	MESSAG, ORG .+0003\r
96	VEND, ORG .+0003\r
97	BATTER, ORG .+0003\r
98	NUGGET, ORG .+0003\r
99	COINS, ORG .+0003\r
100	CHEST, ORG .+0003\r
101	EGGS, ORG .+0003\r
102	TRIDNT, ORG .+0003\r
103	VASE, ORG .+0003\r
104	EMRALD, ORG .+0003\r
105	PYRAM, ORG .+0003\r
106	PEARL, ORG .+0003\r
107	RUG, ORG .+0003\r
108	CHAIN, ORG .+0003\r
109	BACK, ORG .+0003\r
110	LOOK, ORG .+0003\r
111	CAVE, ORG .+0003\r
112	NULL, ORG .+0003\r
113	ENTRNC, ORG .+0003\r
114	DPRSSN, ORG .+0003\r
115	SAY, ORG .+0003\r
116	LOCK, ORG .+0003\r
117	THROW, ORG .+0003\r
118	FIND, ORG .+0003\r
119	INVENT, ORG .+0003\r
120	TURNS, ORG .+0003\r
121	LMWARN, ORG .+0003\r
122	KNFLOC, ORG .+0003\r
123	DETAIL, ORG .+0003\r
124	ABBNUM, ORG .+0003\r
125	NUMDIE, ORG .+0003\r
126	MAXDIE, ORG .+0003\r
127	DKILL, ORG .+0003\r
128	FOOBAR, ORG .+0003\r
129	BONUS, ORG .+0003\r
130	CLOCK1, ORG .+0003\r
131	CLOCK2, ORG .+0003\r
132	CLOSNG, ORG .+0003\r
133	PANIC, ORG .+0003\r
134	CLOSED, ORG .+0003\r
135	GAVEUP, ORG .+0003\r
136	SCORNG, ORG .+0003\r
137	ODLOC, ORG .+0022\r
138	STREAM, ORG .+0003\r
139	SPICES, ORG .+0003\r
140	ORG #LBL\r
141	\r
142	COUNT, ORG .+3\r
143	ONE, F 1.0\r
144	\r
145	\r
146	/BITSET(L,N) = (COND(L).AND.ISHFT(1,N)) .NE.0\r
147	\r
148	BITSET, FLDA #BSET /Section name\r
149	JSA GETARG /Common setup\r
150	BASE #BASE\r
151	\r
152	FLDA% L /Get array index\r
153	ATX 1\r
154	FLDA COND-0003,1 /COND(L)\r
155	FSTA ITEST / COND(L)\r
156	LDX 1,0 /Put 1 into shift value\r
157	FLDA% N /Get N value\r
158	JEQ #1 /No shift if zero\r
159	FNEG /Negate\r
160	ATX 1 /Into register\r
161	XTA 0 /Get the "1" back\r
162	ALN 0\r
163	STARTD\r
164	ALN 1 /Do the shift\r
165	STARTF\r
166	ATX 0 /Put result in place\r
167	#1, XTA 0 /Get result\r
168	JSA #FIX\r
169	ATX 0 /One mask value\r
170	FLDA ITEST\r
171	JSA #FIX\r
172	ATX 1 /The other\r
173	TRAP3 #ANDER /AND it\r
174	XTA 0 /Restore value\r
175	JEQ #GOBAK /Return if zero\r
176	FLDA ONE /Else one\r
177	JA #GOBAK /Done.\r
178	ITEST, ORG .+3 /Test value\r
179	\r
180	/\r
181	/ ISHFT entry point\r
182	/\r
183	BASE 0\r
184	ISHFT, FLDA #ISH /Section name\r
185	JSA GETARG /Common setup\r
186	\r
187	BASE #BASE\r
188	FLDA% N /Get shift count\r
189	JEQ #SKIP /No need to shift\r
190	FNEG /Negative shift count goes left\r
191	ATX 1 /Into XR 1\r
192	FLDA% L /Get value to shift\r
193	ALN 0 /Align to right\r
194	STARTD\r
195	ALN 1 /Shift\r
196	STARTF /Done\r
197	JSA #FIX\r
198	JA #GOBAK /Done\r
199	#SKIP, FLDA% L /Get value back\r
200	JA #GOBAK /Done\r
201	\r
202	GETARG, 0;0 /Common setup routine\r
203	FSTA SECNAM /AC has section name\r
204	STARTD\r
205	0210 /Get caller's return\r
206	FSTA #GOBAK,0\r
207	0200 /Get arg list\r
208	SETX #XR /Set up index registers\r
209	SETB #BASE /Set up base page\r
210	FSTA #BASE /Set up arg list\r
211	LDX 0,1 /Zero to XR #1\r
212	FLDA% #BASE,1+ /Get first arg\r
213	FSTA L\r
214	FLDA% #BASE,1+ /Second arg\r
215	FSTA N\r
216	STARTF\r
217	JA GETARG /Return\r
218	END\r