mim/development/mim/vax/mimlib/expose.mud

   1 <PACKAGE "EXPOSE">
   2
   3 <INCLUDE-WHEN <COMPILING? "EXPOSE"> "EXPOSE-DEFS">
   4
   5 <INCLUDE "EXPOSE-DATA">
   6
   7 <ENTRY EXPOSE VAX-NOVICE>
   8
   9 <GDECL (KERNEL-TABLE) <<PRIMTYPE VECTOR> [REST LIST]>>
  10
  11 <GDECL (REGISTER-NAMES) <VECTOR STRING>>
  12
  13 <DEFINE EXPOSE (MSB "OPT" (OUTCHAN .OUTCHAN))
  14    #DECL ((MSB) MSUBR (OUTCHAN) <SPECIAL CHANNEL>)
  15    <PRINTSTRING "Exposing ">
  16    <PRINTSTRING <SPNAME <2 .MSB>>>
  17    <CRLF> <CRLF>
  18    <BIND ((IMSB-ATM <1 .MSB>)
  19           (IMSB ,.IMSB-ATM)
  20           (START <4 .MSB>)
  21           (END <FIND-END .MSB>)
  22           (LABEL-TABLE <STACK <IVECTOR ,LABEL-TABLE-LENGTH ()>>))
  23       <PARSE-CODE .IMSB .START .END .LABEL-TABLE>
  24       <PRINT-CODE .IMSB .START .END .LABEL-TABLE>>
  25    <CRLF>
  26    T>
  27
  28 <SETG VAX-NOVICE %<>>
  29
  30 <DEFINE PARSE-CODE (IMSB START END LABEL-TABLE "AUX" (CODE <1 .IMSB>))
  31    #DECL ((START END) FIX (IMSB) IMSUBR
  32           (LABEL-TABLE) <<PRIMTYPE VECTOR> [REST LIST]>
  33           (CODE) <<PRIMTYPE UVECTOR> [REST FIX]>)
  34    <SETG TAG-COUNT 0>
  35    <SETG LOOP-COUNT 0>
  36    <REPEAT ((I .START) NUM OP)
  37       #DECL ((NUM I) FIX (OP) <OR FALSE VECTOR OPCODE-TABLE>)
  38       <COND (<G=? .I .END> <RETURN>)>
  39       <REPEAT ()
  40          <SET NUM <GET-BYTE .CODE .I>>
  41          <SET I <+ .I 1>>
  42          <SET OP <NTH ,OPCODE-TABLE <+ .NUM 1>>>
  43          <COND (<NOT <TYPE? .OP OPCODE-TABLE>> <RETURN>)>>
  44       <COND (.OP
  45              <MAPF %<>
  46                    <FUNCTION (LEN)
  47                       <SET I <PARSE-OPERAND .CODE .I .LEN .LABEL-TABLE
  48                                             .START .END>>>
  49                    <2 .OP>:<VECTOR [REST FIX]>>)>>>
  50
  51 <DEFINE PRINT-CODE (IMSB START END LABEL-TABLE "AUX" NUM
  52                     (CODE <1 .IMSB>)
  53                     (COMMENTS <STACK <IVECTOR 10>>))
  54    #DECL ((IMSB) IMSUBR (START END NUM) FIX
  55           (LABEL-TABLE) <<PRIMTYPE VECTOR> [REST LIST]>)
  56    <REPEAT ((I .START) FIRST OP)
  57       #DECL ((I) FIX (OP) <OR FALSE OPCODE-TABLE VECTOR>)
  58       <COND (<G=? .I .END> <RETURN>)>
  59       <1 .COMMENTS 1>   ;"reset number of comments to 'zero'"
  60       <COND (<PRINT-LABEL .LABEL-TABLE .I> <PRINTSTRING ":">)>
  61       <REPEAT ()
  62          <SET NUM <GET-BYTE .CODE .I>>
  63          <SET I <+ .I 1>>
  64          <SET OP <NTH ,OPCODE-TABLE <+ .NUM 1>>>
  65          <COND (<NOT <TYPE? .OP OPCODE-TABLE>>
  66                 <RETURN>)>>
  67       <INDENT-TO ,OP-COLUMN>
  68       <COND (.OP
  69              <PRINTSTRING <1 .OP>>
  70              <INDENT-TO ,ARG-COLUMN>
  71              <SET FIRST T>
  72              <MAPF %<>
  73                    <FUNCTION (LEN)
  74                       <COND (.FIRST <SET FIRST %<>>)
  75                             (ELSE <PRINTSTRING ",">)>
  76                       <SET I <PRINT-OPERAND .IMSB .I .LEN .LABEL-TABLE
  77                                             .COMMENTS>>>
  78                    <2 .OP>:<VECTOR [REST FIX]>>
  79              <COND (,VAX-NOVICE
  80                     <INDENT-TO ,COMMENT-COLUMN>
  81                     <PRINTSTRING ";">
  82                     <PRINTSTRING <3 .OP>>)>
  83              <PRINT-COMMENTS .COMMENTS ,VAX-NOVICE>)
  84             (ELSE
  85              <PRINTSTRING ".byte">
  86              <INDENT-TO ,ARG-COLUMN>
  87              <PRINT-BYTE .NUM>)>
  88       <CRLF>>>
  89
  90 <DEFINE PARSE-OPERAND (MCODE I ORIGINAL-LEN LABEL-TABLE START END
  91                        "AUX" (LEN <ANDB .ORIGINAL-LEN ,LENGTH-MASK>)
  92                        ONE REG NUM VAL)
  93    #DECL ((MCODE) <<PRIMTYPE UVECTOR> [REST FIX]> (I ORIGINAL-LEN ONE REG) FIX)
  94    <COND (<BRANCH? .ORIGINAL-LEN>
  95           <SET NUM <SIGN-EXT <GET-N-BYTES .MCODE .I .LEN> .LEN>>
  96           <SET I <+ .I .LEN>>
  97           <ADD-LABEL .LABEL-TABLE .I .NUM .START .END>)
  98          (<CASE? .ORIGINAL-LEN>
  99           <SET ONE <GET-BYTE .MCODE .I>>
 100           <SET I <+ .I 1>>
 101           <SET VAL <+ <ANDB .ONE 63> 1>>
 102           <PARSE-WORDS .MCODE .I .VAL .LABEL-TABLE .START .END>
 103           <SET I <+ .I <* 2 .VAL>>>)
 104          (ELSE
 105           <SET ONE <GET-BYTE .MCODE .I>>
 106           <SET I <+ .I 1>>
 107           <SET REG <ANDB .ONE 15>>
 108           <CASE ,==? <LSH .ONE -4>
 109                 (4
 110                  <SET I
 111                       <PARSE-OPERAND .MCODE .I .LEN .LABEL-TABLE .START .END>>)
 112                 (8
 113                  <COND (<==? .REG 15>
 114                         <SET I <+ .I .LEN>>)>)
 115                 (9
 116                  <COND (<==? .REG 15>
 117                         <SET I <+ .I 4>>)>)
 118                 (10
 119                  <SET I <+ .I 1>>)
 120                 (11
 121                  <SET I <+ .I 1>>)
 122                 (12
 123                  <SET I <+ .I 2>>)
 124                 (13
 125                  <SET I <+ .I 2>>)
 126                 (14
 127                  <SET I <+ .I 4>>)
 128                 (15
 129                  <SET I <+ .I 4>>)>)>
 130    .I>
 131
 132 <DEFINE PRINT-OPERAND (IMSB I LEN-CODE LABEL-TABLE COMMENTS
 133                        "AUX"
 134                        (LEN <ANDB .LEN-CODE ,LENGTH-MASK>)
 135                        (CODE <1 .IMSB>)
 136                        ONE REG NUM VAL)
 137    #DECL ((CODE) <<PRIMTYPE UVECTOR> [REST FIX]> (IMSB) IMSUBR
 138           (I LEN-CODE ONE REG NUM VAL) FIX)
 139    <COND (<BRANCH? .LEN-CODE>
 140           <SET NUM <SIGN-EXT <GET-N-BYTES .CODE .I .LEN> .LEN>>
 141           <SET I <+ .I .LEN>>
 142           <COND (<NOT <PRINT-LABEL .LABEL-TABLE <+ .I .NUM>>>
 143                  <PRINTSTRING "#">
 144                  <PRINT-HEX .NUM .LEN>)>)
 145          (<CASE? .LEN-CODE>
 146           <SET ONE <GET-BYTE .CODE .I>>
 147           <SET I <+ .I 1>>
 148           <SET VAL <+ <ANDB .ONE 63> 1>>
 149           <PRINTSTRING "S^#">
 150           <PRINT-BYTE .VAL>
 151           <PRINT-WORDS .CODE .I .VAL .LABEL-TABLE>
 152           <SET I <+ .I <* 2 .VAL>>>)
 153          (ELSE
 154           <SET ONE <GET-BYTE .CODE .I>>
 155           <SET I <+ .I 1>>
 156           <SET REG <ANDB .ONE 15>>
 157           <CASE ,==? <LSH .ONE -4>
 158                 (4
 159                  <SET I <PRINT-OPERAND .IMSB .I .LEN .LABEL-TABLE
 160                                        .COMMENTS>>
 161                  <PRINTSTRING "[">
 162                  <PRINT-REGISTER .REG>
 163                  <PRINTSTRING "]">)
 164                 (5
 165                  <PRINT-REGISTER .REG>)
 166                 (6
 167                  <PRINTSTRING "(">
 168                  <PRINT-REGISTER .REG>
 169                  <PRINTSTRING ")">)
 170                 (7
 171                  <PRINTSTRING "-(">
 172                  <PRINT-REGISTER .REG>
 173                  <PRINTSTRING ")">)
 174                 (8
 175                  <COND (<==? .REG 15>
 176                         <SET NUM <GET-N-BYTES .CODE .I .LEN>>
 177                         <SET I <+ .I .LEN>>
 178                         <PRINTSTRING "#">
 179                         <PRINT-HEX .NUM .LEN>)
 180                        (ELSE
 181                         <PRINTSTRING "(">
 182                         <PRINT-REGISTER .REG>
 183                         <PRINTSTRING ")+">)>)
 184                 (9
 185                  <COND (<==? .REG 15>
 186                         <PRINTSTRING "@">
 187                         <SET VAL <GET-LONG .CODE .I>>
 188                         <SET I <+ .I 4>>
 189                         <COND (<NOT <PRINT-KERNEL-LOCATION .VAL>>
 190                                <PRINTSTRING "#">
 191                                <PRINT-LONG .VAL>)>)
 192                        (ELSE
 193                         <PRINTSTRING "@(">
 194                         <PRINT-REGISTER .REG>
 195                         <PRINTSTRING ")+">)>)
 196                 (10
 197                  <SET VAL <SIGN-EXT-BYTE <GET-BYTE .CODE .I>>>
 198                  <PRINT-BYTE .VAL>
 199                  <SET I <+ .I 1>>
 200                  <COND (<N==? .REG 15>
 201                         <PRINTSTRING "(">
 202                         <PRINT-REGISTER .REG>
 203                         <PRINTSTRING ")">)>
 204                  <COND (<==? .REG 11>
 205                         <ADD-COMMENT .COMMENTS
 206                                      <NTH .IMSB <+ </ .VAL 8> 1>>>)>)
 207                 (11
 208                  <SET VAL <SIGN-EXT-BYTE <GET-BYTE .CODE .I>>>
 209                  <SET I <+ .I 1>>
 210                  <PRINTSTRING "@">
 211                  <PRINT-BYTE .VAL>
 212                  <COND (<N==? .REG 15>
 213                         <PRINTSTRING "(">
 214                         <PRINT-REGISTER .REG>
 215                         <PRINTSTRING ")">)>
 216                  <COND (<==? .REG 11>
 217                         <ADD-COMMENT .COMMENTS
 218                                      <NTH .IMSB <+ </ .VAL 8> 1>>>)>)
 219                 (12
 220                  <SET VAL <SIGN-EXT-WORD <GET-WORD .CODE .I>>>
 221                  <SET I <+ .I 2>>
 222                  <PRINT-WORD .VAL>
 223                  <COND (<N==? .REG 15>
 224                         <PRINTSTRING "(">
 225                         <PRINT-REGISTER .REG>
 226                         <PRINTSTRING ")">)>
 227                  <COND (<==? .REG 11>
 228                         <ADD-COMMENT .COMMENTS
 229                                      <NTH .IMSB <+ </ .VAL 8> 1>>>)>)
 230                 (13
 231                  <SET VAL <SIGN-EXT-WORD <GET-WORD .CODE .I>>>
 232                  <SET I <+ .I 2>>
 233                  <PRINTSTRING "@">
 234                  <PRINT-WORD .VAL>
 235                  <COND (<N==? .REG 15>
 236                         <PRINTSTRING "(">
 237                         <PRINT-REGISTER .REG>
 238                         <PRINTSTRING ")">)>
 239                  <COND (<==? .REG 11>
 240                         <ADD-COMMENT .COMMENTS
 241                                      <NTH .IMSB <+ </ .VAL 8> 1>>>)>)
 242                 (14
 243                  <SET VAL <GET-LONG .CODE .I>>
 244                  <SET I <+ .I 4>>
 245                  <PRINT-LONG .VAL>
 246                  <COND (<N==? .REG 15>
 247                         <PRINTSTRING "(">
 248                         <PRINT-REGISTER .REG>
 249                         <PRINTSTRING ")">)>
 250                  <COND (<==? .REG 11>
 251                         <ADD-COMMENT .COMMENTS
 252                                      <NTH .IMSB <+ </ .VAL 8> 1>>>)>)
 253                 (15
 254                  <SET VAL <GET-LONG .CODE .I>>
 255                  <PRINTSTRING "@">
 256                  <SET I <+ .I 4>>
 257                  <PRINT-LONG .VAL>
 258                  <COND (<N==? .REG 15>
 259                         <PRINTSTRING "(">
 260                         <PRINT-REGISTER .REG>
 261                         <PRINTSTRING ")">)>
 262                  <COND (<==? .REG 11>
 263                         <ADD-COMMENT .COMMENTS
 264                                      <NTH .IMSB <+ </ .VAL 8> 1>>>)>)
 265                 DEFAULT
 266                 (<PRINTSTRING "S^#">
 267                  <PRINT-BYTE <ANDB .ONE 63>>)>)>
 268    .I>
 269
 270 <DEFINE PARSE-WORDS (CODE ORIGINAL-I N LABEL-TABLE START END
 271                      "AUX" (I .ORIGINAL-I) NUM)
 272    #DECL ((CODE) <<PRIMTYPE UVECTOR> [REST FIX]> (I N NUM) FIX)
 273    <REPEAT ()
 274       <COND (<0? .N> <RETURN>)>
 275       <SET NUM <SIGN-EXT-WORD <GET-WORD .CODE .I>>>
 276       <SET I <+ .I 2>>
 277       <ADD-LABEL .LABEL-TABLE .ORIGINAL-I .NUM .START .END>
 278       <SET N <- .N 1>>>
 279    .I>
 280
 281 <DEFINE PRINT-WORDS (CODE ORIGINAL-I N LABEL-TABLE "AUX" (I .ORIGINAL-I)
 282                      NUM (OUTCHAN .OUTCHAN))
 283    #DECL ((CODE) <<PRIMTYPE UVECTOR> [REST FIX]> (I N NUM) FIX)
 284    <REPEAT ()
 285       <COND (<0? .N> <RETURN>)>
 286       <CRLF>
 287       <INDENT-TO ,OP-COLUMN>
 288       <PRINTSTRING ".word">
 289       <INDENT-TO ,ARG-COLUMN>
 290       <SET NUM <SIGN-EXT-WORD <GET-WORD .CODE .I>>>
 291       <SET I <+ .I 2>>
 292       <COND (<NOT <PRINT-LABEL .LABEL-TABLE <+ .ORIGINAL-I .NUM>>>
 293              <PRINT-WORD .NUM>)>
 294       <SET N <- .N 1>>>
 295    .I>
 296
 297 <DEFINE PRINT-BYTE (NUM "AUX" (ANUM <ABS .NUM>) (STR <STACK <ISTRING 3 !\->>))
 298    #DECL ((NUM) FIX (STR) STRING)
 299    <2 .STR <HEX-CHAR <LSH .ANUM -4>>>
 300    <3 .STR <HEX-CHAR .ANUM>>
 301    <COND (<L? .NUM 0> <PRINTSTRING .STR>)
 302          (ELSE <PRINTSTRING <REST .STR>>)>>
 303
 304 <DEFINE PRINT-WORD (NUM "AUX" (ANUM <ABS .NUM>) (STR <STACK <ISTRING 5 !\->>))
 305    #DECL ((NUM) FIX (STR) STRING)
 306    <2 .STR <HEX-CHAR <LSH .ANUM -12>>>
 307    <3 .STR <HEX-CHAR <LSH .ANUM -8>>>
 308    <4 .STR <HEX-CHAR <LSH .ANUM -4>>>
 309    <5 .STR <HEX-CHAR .ANUM>>
 310    <COND (<L? .NUM 0> <PRINTSTRING .STR>)
 311          (ELSE <PRINTSTRING <REST .STR>>)>>
 312
 313 <DEFINE PRINT-TRIBYTE (NUM "AUX" (ANUM <ABS .NUM>)
 314                          (STR <STACK <ISTRING 7 !\->>))
 315    #DECL ((NUM) FIX (STR) STRING)
 316    <2 .STR <HEX-CHAR <LSH .ANUM -20>>>
 317    <3 .STR <HEX-CHAR <LSH .ANUM -16>>>
 318    <4 .STR <HEX-CHAR <LSH .ANUM -12>>>
 319    <5 .STR <HEX-CHAR <LSH .ANUM -8>>>
 320    <6 .STR <HEX-CHAR <LSH .ANUM -4>>>
 321    <7 .STR <HEX-CHAR .ANUM>>
 322    <COND (<L? .NUM 0> <PRINTSTRING .STR>)
 323          (ELSE <PRINTSTRING <REST .STR>>)>>
 324
 325 <DEFINE PRINT-LONG (NUM "AUX" (ANUM <ABS .NUM>) (STR <ISTRING 9 !\->))
 326    #DECL ((NUM) FIX (STR) STRING)
 327    <2 .STR <HEX-CHAR <LSH .ANUM -28>>>
 328    <3 .STR <HEX-CHAR <LSH .ANUM -24>>>
 329    <4 .STR <HEX-CHAR <LSH .ANUM -20>>>
 330    <5 .STR <HEX-CHAR <LSH .ANUM -16>>>
 331    <6 .STR <HEX-CHAR <LSH .ANUM -12>>>
 332    <7 .STR <HEX-CHAR <LSH .ANUM -8>>>
 333    <8 .STR <HEX-CHAR <LSH .ANUM -4>>>
 334    <9 .STR <HEX-CHAR .ANUM>>
 335    <COND (<L? .NUM 0> <PRINTSTRING .STR>)
 336          (ELSE <PRINTSTRING <REST .STR>>)>>
 337
 338 <DEFINE SIGN-EXT (NUM LEN)
 339    <COND (<==? .LEN 1> <SIGN-EXT-BYTE .NUM>)
 340          (<==? .LEN 2> <SIGN-EXT-WORD .NUM>)
 341          (<==? .LEN 4> .NUM)
 342          (ELSE <ERROR BAD-LENGTH!-ERRORS .LEN SIGN-EXT>)>>
 343
 344 <DEFINE PRINT-HEX (NUM LEN)
 345    <CASE ,==? .LEN
 346          (1 <PRINT-BYTE .NUM>)
 347          (2 <PRINT-WORD .NUM>)
 348          (3 <PRINT-TRIBYTE .NUM>)
 349          (4 <PRINT-LONG .NUM>)
 350          DEFAULT
 351          (<ERROR BAD-LENGTH!-ERRORS .LEN PRINT-HEX>)>>
 352
 353 <DEFINE GET-BYTE (MCODE I)
 354    #DECL ((MCODE) <<PRIMTYPE UVECTOR> [REST FIX]> (I) FIX)
 355    <GETBITS <NTH .MCODE <+ </ .I 4> 1>>
 356             <BITS 8 <* <MOD .I 4> 8>>>>
 357
 358 <DEFINE GET-WORD (MCODE I)
 359    #DECL ((MCODE) <<PRIMTYPE UVECTOR> [REST FIX]> (I) FIX)
 360    <ORB <GET-BYTE .MCODE .I>
 361         <LSH <GET-BYTE .MCODE <+ .I 1>> 8>>>
 362
 363 <DEFINE GET-LONG (MCODE I)
 364    #DECL ((MCODE) <<PRIMTYPE UVECTOR> [REST FIX]> (I) FIX)
 365    <ORB <GET-WORD .MCODE .I>
 366         <LSH <GET-WORD .MCODE <+ .I 2>> 16>>>
 367
 368 <DEFINE GET-N-BYTES (MCODE I N)
 369    #DECL ((MCODE) <<PRIMTYPE UVECTOR> [REST FIX]> (I N) FIX)
 370    <REPEAT ((RES 0) (LSH-AMT 0))
 371       <COND (<==? .N 0> <RETURN .RES>)>
 372       <SET RES <ORB .RES <LSH <GET-BYTE .MCODE .I> .LSH-AMT>>>
 373       <SET I <+ .I 1>>
 374       <SET N <- .N 1>>
 375       <SET LSH-AMT <+ .LSH-AMT 8>>>>
 376
 377 <DEFINE SIGN-EXT-BYTE (NUM)
 378    <COND (<0? <ANDB .NUM %<LSH 1 7>>>
 379           .NUM)
 380          (ELSE
 381           <- <ANDB .NUM %<LSH -1 <- 7 32>>> %<LSH 1 7>>)>>
 382
 383 <DEFINE SIGN-EXT-WORD (NUM)
 384    <COND (<0? <ANDB .NUM %<LSH 1 15>>>
 385           .NUM)
 386          (ELSE
 387           <- <ANDB .NUM %<LSH -1 <- 15 32>>> %<LSH 1 15>>)>>
 388
 389 <DEFINE ADD-COMMENT (COMMENTS OBJ "AUX" PLACE)
 390    #DECL ((COMMENTS) <<PRIMTYPE VECTOR> FIX> (PLACE) FIX)
 391    <1 .COMMENTS <SET PLACE <+ <1 .COMMENTS> 1>>>
 392    <PUT .COMMENTS .PLACE .OBJ>>
 393
 394 <DEFINE PRINT-COMMENTS (COMMENTS ALREADY-ONE "AUX" (PLACE <1 .COMMENTS>)
 395                         (OUTCHAN .OUTCHAN))
 396    #DECL ((COMMENTS) <<PRIMTYPE VECTOR> FIX> (PLACE) FIX)
 397    <REPEAT ((N 2))
 398       #DECL ((N) FIX)
 399       <COND (<G? .N .PLACE> <RETURN>)>
 400       <COND (.ALREADY-ONE <CRLF>)>
 401       <INDENT-TO ,COMMENT-COLUMN>
 402       <PRINTSTRING ";">
 403       <&1 <NTH .COMMENTS .N>>
 404       <SET ALREADY-ONE T>
 405       <SET N <+ .N 1>>>>
 406
 407 ;"These numbers keep track of the last label used.  TAG-COUNT counts up."
 408 ;"LOOP-COUNT counts down."
 409
 410 <SETG TAG-COUNT 0>
 411 <SETG LOOP-COUNT 0>
 412 <GDECL (TAG-COUNT LOOP-COUNT) FIX>
 413
 414 <DEFINE FIND-LABEL (LABEL-TABLE I "AUX" BKTNUM)
 415    #DECL ((LABEL-TABLE) <<PRIMTYPE VECTOR> [REST LIST]> (I BKTNUM) FIX)
 416    <SET BKTNUM <+ <MOD .I ,LABEL-TABLE-LENGTH> 1>>
 417    <REPEAT ((BKT <NTH .LABEL-TABLE .BKTNUM>))
 418       #DECL ((BKT) <LIST [REST FIX]>)
 419       <COND (<EMPTY? .BKT> <RETURN %<>>)>
 420       <COND (<==? .I <1 .BKT>> <RETURN <2 .BKT>>)>
 421       <SET BKT <REST .BKT 2>>>>
 422
 423 <DEFINE ADD-LABEL (LABEL-TABLE:<<PRIMTYPE VECTOR> [REST LIST]>
 424                    I:FIX NUM:FIX START:FIX END:FIX
 425                    "AUX" BKTNUM BKT (SUM <+ .I .NUM>))
 426    #DECL ((BKTNUM SUM) FIX (BKT) <LIST [REST FIX]>)
 427    <COND (<G=? .NUM 0>
 428           <COND (<L? .SUM .END>
 429                  <SET BKTNUM <+ <MOD .SUM ,LABEL-TABLE-LENGTH> 1>>
 430                  <SET BKT <NTH .LABEL-TABLE .BKTNUM>>
 431                  <REPEAT ((B .BKT))
 432                     <COND (<EMPTY? .B>
 433                            <PUT .LABEL-TABLE .BKTNUM
 434                                 (.SUM
 435                                  <SETG TAG-COUNT <+ ,TAG-COUNT 1>>
 436                                  !.BKT)>
 437                            <RETURN>)>
 438                     <COND (<==? .SUM <1 .B>> <RETURN>)>
 439                     <SET B <REST .B 2>>>)>)
 440          (ELSE
 441           <COND (<G=? .SUM .START>
 442                  <SET BKTNUM <+ <MOD .SUM ,LABEL-TABLE-LENGTH> 1>>
 443                  <SET BKT <NTH .LABEL-TABLE .BKTNUM>>
 444                  <REPEAT ((B .BKT))
 445                     <COND (<EMPTY? .B>
 446                            <PUT .LABEL-TABLE .BKTNUM
 447                                 (.SUM
 448                                  <SETG LOOP-COUNT <- ,LOOP-COUNT 1>>
 449                                  !.BKT)>
 450                            <RETURN>)>
 451                     <COND (<==? .SUM <1 .B>>
 452                            <COND (<G? <2 .B> 0>
 453                                   <2 .B <SETG LOOP-COUNT <- ,LOOP-COUNT 1>>>)>
 454                            <RETURN>)>
 455                     <SET B <REST .B 2>>>)>)>>
 456
 457 <DEFINE PRINT-LABEL (LABEL-TABLE I "AUX" LAB (OUTCHAN .OUTCHAN))
 458    #DECL ((LAB) <OR FIX FALSE>)
 459    <SET LAB <FIND-LABEL .LABEL-TABLE .I>>
 460    <COND (.LAB
 461           <COND (<G? .LAB 0>
 462                  <PRINTSTRING "tag">
 463                  <PRIN1 .LAB>)
 464                 (ELSE
 465                  <PRINTSTRING "loop">
 466                  <PRIN1 <- .LAB>>)>)>>
 467
 468 <DEFINE FIND-END (MSBR:MSUBR "AUX"
 469                   (START <4 .MSBR>)
 470                   (IMSB-ATM <1 .MSBR>)
 471                   (END <* 4
 472                           <LENGTH
 473                            <1 ,.IMSB-ATM:IMSUBR>:<PRIMTYPE UVECTOR>>>))
 474    #DECL ((START) FIX (END) FIX)
 475    <MAPF %<>
 476          <FUNCTION (BKT:LIST)
 477             <MAPF %<>
 478                   <FUNCTION (ATM "AUX" VAL STRT)
 479                      #DECL ((STRT) FIX)
 480                      <COND (<AND <TYPE? .ATM ATOM>
 481                                  <GASSIGNED? .ATM>
 482                                  <TYPE? <SET VAL ,.ATM> MSUBR>
 483                                  <==? <1 .VAL> .IMSB-ATM>
 484                                  <G? <SET STRT <4 .VAL>> .START>
 485                                  <L? .STRT .END>>
 486                             <SET END .STRT>)>>
 487                   .BKT>>
 488          ,ATOM-TABLE:VECTOR>
 489    .END>
 490
 491 ;"Stuff to handle the horrendous opcode table.  There is a slot for each"
 492 ;"possible opcode byte.  An entry of %<> means that the opcode is undefined."
 493 ;"An entry of type OPCODE-TABLE means that the next byte must also be"
 494 ;"inspected.  An entry of type vector specifies an instruction in the form:"
 495 ;"[short-name:string operands:vector long-name:string]."
 496
 497 <GDECL (OPCODE-TABLE) OPCODE-TABLE>
 498
 499 ;"Stuff to handle register names"
 500
 501 <DEFINE PRINT-REGISTER (REG)
 502    <PRINTSTRING <NTH ,REGISTER-NAMES <+ <ANDB .REG 15> 1>>>>
 503
 504 ;"Stuff to handle references to the kernel.  This is used whenever EXPOSE"
 505 ;"encounters the '@#address' construct.  A hash table is used.  Each bucket"
 506 ;"is a list of the form (loc1 name1 loc2 name2 ...)."
 507
 508 ;"PRINT-KERNEL-LOCATION is defined to return %<> if it couldn't find"
 509 ;"an appropriate symbolic name."
 510
 511 <DEFINE PRINT-KERNEL-LOCATION (LOC "AUX" BKTNUM BKT MEM)
 512    #DECL ((LOC BKTNUM) FIX (BKT) LIST (MEM) <OR FALSE <LIST FIX STRING>>)
 513    <SET BKTNUM <+ <MOD .LOC ,KERNEL-TABLE-LENGTH> 1>>
 514    <SET BKT <NTH ,KERNEL-TABLE .BKTNUM>>
 515    <SET MEM <MEMQ .LOC .BKT>>
 516    <COND (.MEM <PRINTSTRING <2 .MEM>>)>>
 517
 518 <ENDPACKAGE>