sw/adventure/src/BITSET.RA

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