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