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