File: BITSET.LS of Disk: V50/Source/Source-Listing-FORTRAN-2
(Source file text)
RALF V50A 24-JUL-20 PAGE 1 SECT BTSET ENTRY ISHFT ENTRY BITSET ENTRY #ANDER EXTERN #RETRN EXTERN #FIX SECT8 BITTER 00000 1235 #ANDER, TAD #XR /Simple masking 00001 0236 AND #XR+1 00002 3235 DCA #XR 00003 6203 CIF CDF 00004 5637 JMP% #XR+2 / Return /FPP code here; using the rest of the SECT8 page. 00005 1100 #RET, SETX #XR /Traceback 00006 0035 00007 1110 SETB #BASE 00010 0016 00011 1030 JA .+3 00012 0014 00013 0211 SECNAM, TEXT +BITSET+ /For traceback 00014 2423 00015 0524 #BASE, ORG .+3 /Base 0 N, ORG .+3 /Base 1 - value L, ORG .+3 00027 0211 #BSET, TEXT +BITSET+ /Base 2 - section name 00030 2423 00031 0524 00032 1123 #ISH, TEXT +ISHFT + /Base 3 00033 1006 00034 2440 / Now at address 23, past autoindex registers. 00035 0040 #XR, FNOP /Base 5: XR 0 00036 0000 ADDR #RETRN / XR 1; XR2 return to FRTS address. 00037 0000 00040 0001 1;2;3 /Base 6: XR3-5 00041 0002 00042 0003 00043 0002 TWO, F 2.0 /Base 7 00044 2000 00045 0000 ORG #BASE+30 00046 0040 FNOP 00047 1030 JA #RET 00050 0005 00051 0040 FNOP 00052 0000 #GOBAK, 0;0 00053 0000 #LBL=. COMMON MISCOM LINUSE, ORG .+0003 RALF V50A 24-JUL-20 PAGE 1-1 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 RALF V50A 24-JUL-20 PAGE 1-2 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 00057 0001 ONE, F 1.0 00060 2000 00061 0000 /BITSET(L,N) = (COND(L).AND.ISHFT(1,N)) .NE.0 BASE #BASE 00062 0203 BITSET, FLDA #BSET /Section name RALF V50A 24-JUL-20 PAGE 1-3 00063 1120 JSA GETARG /Common setup 00064 0157 00065 0602 FLDA% L /Get array index 00066 0027 ATX 7 00067 0470 FLDA COND-0003,7 /COND(L) 00070 2362 00071 6400 FSTA ITEST / COND(L) 00072 0130 00073 0100 LDX 1,0 /Put 1 into shift value 00074 0001 00075 0601 FLDA% N /Get N value 00076 1000 JEQ #1 /No shift if zero 00077 0107 00100 0003 FNEG /Negate 00101 0021 ATX 1 /Into register 00102 0030 XTA 0 /Get the "1" back 00103 0006 STARTD 00104 0011 ALN 1 /Do the shift 00105 0005 STARTF 00106 0020 ATX 0 /Put result in place 00107 0030 #1, XTA 0 /Get result 00110 1120 JSA #FIX 00111 0000 00112 0020 ATX 0 /One mask value 00113 0400 FLDA ITEST 00114 0130 00115 1120 JSA #FIX 00116 0000 00117 0021 ATX 1 /The other 00120 3000 TRAP3 #ANDER /AND it 00121 0000 00122 0030 XTA 0 /Restore value 00123 1000 JEQ #GOBAK /Return if zero 00124 0052 00125 0213 FLDA ONE /Else one 00126 1030 JA #GOBAK /Done. 00127 0052 ITEST, ORG .+3 /Test value 00133 0204 ISHFT, FLDA #ISH /Section name 00134 1120 JSA GETARG /Common setup 00135 0157 00136 0601 FLDA% N /Get shift count 00137 1000 JEQ #SKIP /No need to shift 00140 0154 00141 0003 FNEG /Negative shift count goes left 00142 0021 ATX 1 /Into XR 1 00143 0602 FLDA% L /Get value to shift 00144 0010 ALN 0 /Align to right 00145 0006 STARTD 00146 0011 ALN 1 /Shift 00147 0005 STARTF /Done 00150 1120 JSA #FIX 00151 0000 00152 1030 JA #GOBAK /Done RALF V50A 24-JUL-20 PAGE 1-4 00153 0052 00154 0602 #SKIP, FLDA% L /Get value back 00155 1030 JA #GOBAK /Done 00156 0052 00157 0000 GETARG, 0;0 /Common setup routine 00160 0000 00161 6400 FSTA SECNAM /AC has section name 00162 0013 00163 1100 SETX #XR /Set up index registers 00164 0035 00165 0006 STARTD 00166 0210 0210 /Get caller's prolog 00167 6400 FSTA #GOBAK,0 00170 0052 00171 0200 0200 /Get arg list 00172 1110 SETB #BASE /Set up base page 00173 0016 00174 6200 FSTA #BASE /Set up arg list 00175 0630 FLDA% #BASE,3 /Get first arg 00176 6202 FSTA L 00177 0640 FLDA% #BASE,4 /Second arg 00200 6201 FSTA N 00201 0005 STARTF 00202 1030 JA GETARG /Return 00203 0157 RALF V50A 24-JUL-20 PAGE 1-5 NO ERRORS 126 SYMBOLS, NO ABS REFS # C 00000 #ANDER 00000 #BASE 00016 #BSET 00027 #FIX X 00000 #GOBAK 00052 #ISH 00032 #LBL 00054 #MAIN S 00000 #RET 00005 #RETRN X 00000 #SKIP 00154 #XR 00035 #1 00107 ABBNUM 04774 ACTSPK 02214 AXE 04620 BACK 04717 BATTER 04653 BEAR 04642 BIRD 04535 BITSET 00062 BITTER 8 00204 BONUS 05013 BOTTLE 04601 BTSET S 00000 CAGE 04521 CAVE 04725 CHAIN 04714 CHASM 04631 CHEST 04664 CHLOC 04430 CHLOC2 04433 CLAM 04557 CLOCK1 05016 CLOCK2 05021 CLOSED 05032 CLOSNG 05024 CLSSES 00006 COINS 04661 COND 02365 COUNT 00054 CVAL 00017 DALTLC 04505 DETAIL 04771 DFLAG 04460 DKILL 05005 DLOC 04463 DOOR 04540 DPRSSN 04736 DRAGON 04626 DSEEN 04436 DWARF 04570 EGGS 04667 EMRALD 04700 ENTRNC 04733 FIND 04752 FISSUR 04551 FIXD 01540 FOOBAR 05010 FOOD 04576 GAVEUP 05035 GETARG 00157 GRATE 04516 HINTLC 04334 HINTS 03267 HNTMAX 03647 INVENT 04755 ISHFT 00133 ITEST 00130 KEY 00162 KEYS 04510 KNFLOC 04766 KNIFE 04573 L 00024 LAMP 04513 LINUSE 00000 LMWARN 04763 LOC 00014 LOCK 04744 LOOK 04722 MAGZIN 04565 MAXDIE 05002 MESSAG 04645 MIRROR 04623 MISCOM C 05073 N 00021 NEWLOC 00157 NUGGET 04656 NULL 04730 NUMDIE 04777 ODLOC 05043 OIL 04607 OLDLOC 00011 ONE 00057 OYSTER 04562 PANIC 05027 PEARL 04706 PILLOW 04543 PLAC 01064 PLANT 04612 PLANT2 04615 PROP 03652 PYRAM 04703 ROD 04524 ROD2 04527 RUG 04711 SAY 04741 SCORNG 05040 SECNAM 00013 SNAKE 04546 SPICES 05070 STEPS 04532 STREAM 05065 TABLET 04554 TALLY 04326 TALLY2 04331 THROW 04747 TK 00063 TRIDNT 04672 TROLL 04634 TROLL2 04637 TRVS 00003 TURNS 04760 TWO 00043 VASE 04675 VEND 04650 WATER 04604