<mdl.comp>/bitsge.mud.2

   1 <PACKAGE "BITSGEN">
   2
   3 <ENTRY BITLOG-GEN GETBITS-GEN PUTBITS-GEN BITS-GEN>
   4
   5 <USE "CACS" "CODGEN" "COMCOD" "COMPDEC" "CHKDCL">
   6
   7 <DEFINE BITLOG-GEN (N W
   8                     "AUX" (K <KIDS .N>) (REG <UPDATE-WHERE .N .W>) (FST <1 .K>)
   9                           (INS <LGINS <NODE-SUBR .N>>))
  10         #DECL ((FST N) NODE (K) <LIST [REST NODE]> (REG) DATUM)
  11         <COND (<==? <NODE-TYPE .FST> ,QUOTE-CODE>
  12                <PUT .K 1 <2 .K>>
  13                <PUT .K 2 .FST>)>
  14         <SET REG <GEN <1 .K> .REG>>
  15         <RET-TMP-AC <DATTYP .REG> .REG>
  16         <PUT .REG
  17              ,DATTYP
  18              <COND (<ISTYPE? <RESULT-TYPE .N>>) (ELSE WORD)>>
  19         <MAPF <>
  20               <FUNCTION (NN "AUX" (NXT <GEN .NN DONT-CARE>) TT)
  21                       #DECL ((NN) NODE (NXT) DATUM)
  22                       <COND (<TYPE? <DATVAL .REG> AC>)
  23                             (<TYPE? <SET TT <DATVAL .NXT>> AC>
  24                              <PUT .NXT ,DATVAL <DATVAL .REG>>
  25                              <PUT .REG ,DATVAL .TT>
  26                              <FIX-ACLINK .TT .REG .NXT>)
  27                             (ELSE <TOACV .REG>)>
  28                       <PUT <SET TT <DATVAL .REG>> ,ACPROT T>
  29                       <MUNG-AC .TT .REG>
  30                       <IMCHK .INS <ACSYM .TT> <DATVAL .NXT> T>
  31                       <PUT .TT ,ACPROT <>>
  32                       <RET-TMP-AC .NXT>>
  33               <REST .K>>
  34         <MOVE:ARG .REG .W>>
  35
  36 <DEFINE LGINS (SUBR)
  37         <NTH '![(`AND  `ANDI `ANDCMI )
  38                 (`IOR  `IORI `ORCMI )
  39                 (`XOR  `XORI )
  40                 (`EQV  `EQVI )!]
  41              <LENGTH <MEMQ .SUBR ,LSUBRS>>>>
  42
  43 <SETG LSUBRS ![,EQVB ,XORB ,ORB ,ANDB!]>
  44
  45 <DEFINE GETBITS-GEN (N W
  46                      "AUX" (WRDN <1 <KIDS .N>>) (BP <2 <KIDS .N>>) REG POS WDTH
  47                            BAC AC BPW WRD BPD TEM)
  48    #DECL ((WRDN N BP) NODE (POS WDTH) FIX (WRD REG BPD) DATUM (AC BAC) AC
  49           (BPW) <PRIMTYPE WORD>)
  50    <COND
  51     (<==? <NODE-TYPE .BP> ,QUOTE-CODE>
  52      <SET WRD <GEN .WRDN DONT-CARE>>
  53      <SET BPW <NODE-NAME .BP>>
  54      <SET POS <CHTYPE <GETBITS .BPW #BITS *360600000000*> FIX>>
  55      <SET WDTH <CHTYPE <GETBITS .BPW #BITS *300600000000*> FIX>>
  56      <COND
  57       (<AND <==? <+ .POS .WDTH> 36>
  58             <N==? .WDTH 18>
  59             <TYPE? <DATVAL .WRD> AC>
  60             <NOT <ACRESIDUE <SET AC <DATVAL .WRD>>>>
  61             <OR <==? .W DONT-CARE>
  62                 <AND <TYPE? .W DATUM> <==? .AC <DATVAL .WRD>>>>>
  63        <MUNG-AC .AC <SET REG .WRD>>
  64        <EMIT <INSTRUCTION `LSH  <ACSYM .AC> <- .POS>>>)
  65       (ELSE
  66        <PUT <SGETREG <SET AC <DATVAL <SET REG <REG? WORD .W T>>>> .REG>
  67             ,ACPROT
  68             T>
  69        <COND (<AND <==? .WDTH 18>                    ;"Could be half word hack."
  70                    <COND (<0? .POS>
  71                           <EMIT <INSTRUCTION `HRRZ
  72                                              <ACSYM .AC>
  73                                              !<ADDR:VALUE .WRD>>>
  74                           T)
  75                          (<==? .POS 18>
  76                           <EMIT <INSTRUCTION `HLRZ
  77                                              <ACSYM .AC>
  78                                              !<ADDR:VALUE .WRD>>>
  79                           T)>>)
  80              (ELSE
  81               <EMIT <INSTRUCTION `LDB
  82                                  <ACSYM .AC>
  83                                  [<FORM <CHTYPE .BPW OPCODE!-OP!-PACKAGE>
  84                                         !<ADDR:VALUE .WRD>>]>>)>
  85        <PUT .AC ,ACPROT <>>
  86        <RET-TMP-AC .WRD>)>)
  87     (<==? <NODE-TYPE .BP> ,BITS-CODE>
  88      <SET WRD
  89           <GEN .WRDN
  90                <COND (<SIDE-EFFECTS .BP> <DATUM WORD ANY-AC>)
  91                      (ELSE DONT-CARE)>>>
  92      <SET BPD
  93           <1 <SET TEM <RBITS-GEN .BP <DATUM BITS ANY-AC> .WRD>>>>
  94      <PUT <SGETREG <SET AC <DATVAL <SET REG <REG? WORD .W T>>>> .REG>
  95           ,ACPROT
  96           T>
  97      <TOACV .BPD>
  98      <PUT <SET BAC <DATVAL .BPD>> ,ACPROT T>
  99      <SET TEM <2 .TEM>>
 100      <PUT .TEM 1 <1 <ADDR:VALUE .WRD>>>
 101      <PUTREST .TEM <REST <ADDR:VALUE .WRD>>>
 102      <EMIT <INSTRUCTION `LDB  <ACSYM .AC> <ADDRSYM .BAC>>>
 103      <PUT .BAC ,ACPROT <>>
 104      <PUT .AC ,ACPROT <>>
 105      <RET-TMP-AC .WRD>
 106      <RET-TMP-AC .BPD>)
 107     (ELSE                                          ;"Non constant byte pointer."
 108      <SET WRD
 109           <GEN .WRDN
 110                <COND (<SIDE-EFFECTS .BP> <DATUM WORD ANY-AC>)
 111                      (ELSE DONT-CARE)>>>
 112      <SET BPD <GEN .BP DONT-CARE>>
 113      <PUT <SGETREG <SET AC <DATVAL <SET REG <REG? WORD .W T>>>> .REG>
 114           ,ACPROT
 115           T>
 116      <SET BPD <MOVE:ARG .BPD <DATUM BITS ANY-AC>>>
 117      <PUT <SET BAC <DATVAL .BPD>> ,ACPROT T>
 118      <MUNG-AC .BAC .BPD>
 119      <EMIT <INSTRUCTION `HRRI  <ACSYM .BAC> !<ADDR:VALUE .WRD>>>
 120      <EMIT <INSTRUCTION `LDB  <ACSYM .AC> <ADDRSYM .BAC>>>
 121      <PUT .BAC ,ACPROT <>>
 122      <PUT .AC ,ACPROT <>>
 123      <RET-TMP-AC .WRD>
 124      <RET-TMP-AC .BPD>)>
 125    <MOVE:ARG .REG .W>>
 126
 127 <DEFINE PUTBITS-GEN (N W
 128                      "AUX" (K <KIDS .N>) (SWRD <1 .K>) (BP <2 .K>) BAC POS WDTH
 129                            FLD BPW BPD SWRDD (FLG T) TEM NUM)
 130    #DECL ((N SWRD BP) NODE (FLD BPD REG SWRDD) DATUM (AC BAC PAC) AC
 131           (POS WDTH) FIX (BPW) <PRIMTYPE WORD> (NUM) <OR FALSE FIX>)
 132    <COND
 133     (<==? <NODE-TYPE .BP> ,QUOTE-CODE>
 134      <SET POS
 135           <CHTYPE <GETBITS <SET BPW <NODE-NAME .BP>> #BITS *360600000000*> FIX>>
 136      <SET WDTH <CHTYPE <GETBITS .BPW #BITS *300600000000*> FIX>>
 137      <COND
 138       (<AND <==? <NODE-TYPE .SWRD> ,QUOTE-CODE>
 139             <0? <CHTYPE <NODE-NAME .SWRD> FIX>>>
 140        <SET SWRDD <GEN <3 .K> <REG? <RESULT-TYPE .SWRD> .W>>>
 141        <MUNG-AC <DATVAL .SWRDD> .SWRDD>
 142        <COND (<L? <+ .POS .WDTH> 36>
 143               <IMCHK '(`AND  `ANDI )
 144                      <ACSYM <DATVAL .SWRDD>>
 145                      <REFERENCE:ADR <GETBITS -1 <BITS .WDTH>>>>)>
 146        <EMIT <INSTRUCTION `LSH  <ACSYM <DATVAL .SWRDD>> .POS>>)
 147       (ELSE
 148        <SET SWRDD
 149             <GEN .SWRD
 150                  <REG? <COND (<ISTYPE? <RESULT-TYPE .SWRD>>) (ELSE TUPLE)> .W>>>
 151        <MUNG-AC <DATVAL .SWRDD> .SWRDD>
 152        <COND
 153         (<AND
 154           <==? .WDTH 18>
 155           <COND
 156            (<0? .POS>
 157             <COND (<AND <SET NUM <ZERQ .K>> <OR <L=? .NUM 0> <G=? .NUM 262143>>>
 158                    <EMIT <INSTRUCTION <COND (<0? .NUM> `HLLZS ) (ELSE `HLLOS )>
 159                                       <ADDRSYM <DATVAL .SWRDD>>>>)
 160                   (ELSE <PCLOB .SWRDD '(`HRR  `HRRI ) <3 .K>>)>)
 161            (<==? .POS 18>
 162             <COND (<AND <SET NUM <ZERQ .K>> <OR <L=? .NUM 0> <G=? .NUM 262143>>>
 163                    <EMIT <INSTRUCTION <COND (<0? .NUM> `HRRZS ) (ELSE `HRROS )>
 164                                       <ADDRSYM <DATVAL .SWRDD>>>>)
 165                   (ELSE <PCLOB .SWRDD '(`HRL  `HRLI ) <3 .K>>)>
 166             T)>>)
 167         (<AND <OR <AND <L? .POS 18> <L=? <+ .POS .WDTH> 18>> <G? .POS 18>>
 168               <SET NUM <ZERQ .K>>
 169               <OR <0? .NUM> <L? .WDTH <POPWR2 <+ .NUM 1>>>>>
 170          <EMIT <INSTRUCTION <COND (<0? .NUM>
 171                                    <COND (<L? .POS 18> `ANDCMI ) (ELSE `TLZ )>)
 172                                   (ELSE
 173                                    <COND (<L? .POS 18> `IORI ) (ELSE `TLO )>)>
 174                             <ACSYM <DATVAL .SWRDD>>
 175                             <LSH <LSH -1 <- .WDTH 36>>
 176                                  <COND (<L? .POS 18> .POS)
 177                                        (ELSE <- .POS 18>)>>>>)
 178         (ELSE
 179          <SET FLD <GEN <3 .K> <DATUM WORD ANY-AC>>>
 180          <PUT <DATVAL .FLD> ,ACPROT T>
 181          <TOACV .SWRDD>
 182          <PUT <DATVAL .SWRDD> ,ACPROT T>
 183          <EMIT <INSTRUCTION `DPB
 184                             <ACSYM <DATVAL .FLD>>
 185                             [<FORM <CHTYPE .BPW OPCODE!-OP!-PACKAGE>
 186                                    <ADDRSYM <DATVAL .SWRDD>>>]>>
 187          <PUT <DATVAL .FLD> ,ACPROT <>>
 188          <PUT <DATVAL .SWRDD> ,ACPROT <>>
 189          <RET-TMP-AC .FLD>)>)>)
 190     (ELSE
 191      <COND (<NOT <AND <NOT <SIDE-EFFECTS .N>> <MEMQ <NODE-TYPE .SWRD> ,SNODES>>>
 192             <SET SWRDD
 193                  <GEN .SWRD
 194                       <REG? <COND (<ISTYPE? <RESULT-TYPE .SWRD>>) (ELSE TUPLE)>
 195                             .W>>>)>
 196      <PREFER-DATUM .W>
 197      <SET BPD
 198           <COND (<==? <NODE-TYPE .BP> ,BITS-CODE>
 199                  <SET FLG <>>
 200                  <1 <SET TEM
 201                          <RBITS-GEN .BP
 202                                     <DATUM BITS ANY-AC>
 203                                     <COND (<ASSIGNED? SWRDD> .SWRDD)
 204                                           (ELSE ,NO-DATUM)>>>>)
 205                 (ELSE <GEN .BP DONT-CARE>)>>
 206      <PREFER-DATUM .W>
 207      <COND (<SET NUM <ZERQ .K>>
 208             <SET FLD <MOVE:ARG <REFERENCE .NUM> <DATUM WORD ANY-AC>>>)
 209            (ELSE <SET FLD <GEN <3 .K> <DATUM WORD ANY-AC>>>)>
 210      <DATTYP-FLUSH .FLD>
 211      <PUT .FLD ,DATTYP WORD>
 212      <COND (<NOT <ASSIGNED? SWRDD>>
 213             <SET SWRDD
 214                  <GEN .SWRD
 215                       <REG? <COND (<ISTYPE? <RESULT-TYPE .SWRD>>) (ELSE TUPLE)>
 216                             .W>>>)>
 217      <COND (<NOT <TYPE? <DATVAL .SWRDD> AC>>
 218             <SET SWRDD
 219                  <MOVE:ARG
 220                   .SWRDD
 221                   <REG? <COND (<ISTYPE? <RESULT-TYPE .SWRD>>) (ELSE TUPLE)>
 222                         .W>>>)>
 223      <PUT <DATVAL .SWRDD> ,ACPROT T>
 224      <TOACV .FLD>
 225      <PUT <DATVAL .FLD> ,ACPROT T>
 226      <TOACV .BPD>
 227      <PUT <SET BAC <DATVAL .BPD>> ,ACPROT T>
 228      <COND (<NOT .FLG>
 229             <PUT <2 .TEM> 1 <ADDRSYM <DATVAL .SWRDD>>>
 230             <PUTREST <2 .TEM> ()>)>
 231      <MUNG-AC <DATVAL .SWRDD> .SWRDD>
 232      <COND (.FLG
 233             <MUNG-AC .BAC .BPD>
 234             <EMIT <INSTRUCTION `HRRI  <ACSYM .BAC> <ADDRSYM <DATVAL .SWRDD>>>>)>
 235      <EMIT <INSTRUCTION `DPB  <ACSYM <DATVAL .FLD>> <ADDRSYM .BAC>>>
 236      <PUT .BAC ,ACPROT <>>
 237      <PUT <DATVAL .SWRDD> ,ACPROT <>>
 238      <PUT <DATVAL .FLD> ,ACPROT <>>
 239      <RET-TMP-AC .BPD>
 240      <RET-TMP-AC .FLD>)>
 241    <MOVE:ARG .SWRDD .W>>
 242
 243 <DEFINE ZERQ (L "AUX" NUM)
 244         #DECL ((L) <LIST [REST NODE]>)
 245         <COND (<==? <LENGTH .L> 2>)
 246               (<AND <==? <NODE-TYPE <SET NUM <3 .L>>> ,QUOTE-CODE>
 247                     <==? <PRIMTYPE <SET NUM <NODE-NAME .NUM>>> WORD>
 248                     <OR <AND <0? <SET NUM <CHTYPE .NUM FIX>>> 0>
 249                         <AND <POPWR2 <+ .NUM 1>> .NUM>>>)>>
 250
 251 <DEFINE PCLOB (DEST INS SRC "AUX" SRCD)
 252         #DECL ((DEST SRCD) DATUM (SRC) NODE)
 253         <SET SRCD <GEN .SRC DONT-CARE>>
 254         <TOACV .DEST>
 255         <PUT <DATVAL .DEST> ,ACPROT T>
 256         <IMCHK .INS <ACSYM <DATVAL .DEST>> <DATVAL .SRCD>>
 257         <PUT <DATVAL .DEST> ,ACPROT <>>
 258         <RET-TMP-AC .SRCD>>
 259
 260 <DEFINE BITS-GEN (N W) <1 <RBITS-GEN .N .W DONT-CARE>>>
 261
 262 <DEFINE RBITS-GEN (N W ADDR
 263                    "AUX" (K <KIDS .N>) (WDTHN <1 .K>) WDTH POS TEM
 264                          (REG <REG? WORD .W>) POSD (FLG T))
 265         #DECL ((POS N WDTHN) NODE (REG WDTH POSD) DATUM (K) <LIST [REST NODE]>)
 266         <COND (<==? <LENGTH .K> 2> <SET POS <2 .K>>)>
 267         <COND
 268          (<==? <NODE-TYPE .WDTHN> ,QUOTE-CODE>
 269           <SET TEM <MAKE-PTR .ADDR T <NODE-NAME .WDTHN>>>)
 270          (<OR <NOT <ASSIGNED? POS>>
 271               <==? <NODE-TYPE .POS> ,QUOTE-CODE>>
 272           <SET TEM
 273                <MAKE-PTR .ADDR
 274                          <>
 275                          <COND (<ASSIGNED? POS> <NODE-NAME .POS>) (ELSE 0)>>>
 276           <SET POS .WDTHN>
 277           <SET FLG <>>)
 278          (ELSE
 279           <SET WDTH <GEN .WDTHN .REG>>
 280           <MUNG-AC <DATVAL .REG> .REG>
 281           <EMIT <INSTRUCTION `LSH  <ACSYM <DATVAL .REG>> 24>>
 282           <COND (<TYPE? .ADDR DATUM>
 283                  <EMIT <SET TEM <INSTRUCTION `HRRI  <ACSYM <DATVAL .REG>> 0>>>
 284                  <SET TEM <REST .TEM 2>>)
 285                 (ELSE <SET TEM '(0)>)>)>
 286         <SET POSD <GEN .POS <DATUM WORD ANY-AC>>>
 287         <PUT <DATVAL .POSD> ,ACPROT T>
 288         <COND (<NOT <ASSIGNED? WDTH>>
 289                <SET WDTH <DATUM WORD ANY-AC>>
 290                <PUT .WDTH ,DATVAL <GETREG .WDTH>>
 291                <EMIT <INSTRUCTION `MOVE  <ACSYM <DATVAL .WDTH>> .TEM>>
 292                <SET TEM <REST <1 .TEM>>>)
 293               (ELSE <TOACV .WDTH>)>
 294         <PUT <DATVAL .WDTH> ,ACPROT T>
 295         <EMIT <INSTRUCTION `DPB
 296                            <ACSYM <DATVAL .POSD>>
 297                            [<FORM (<COND (.FLG 123264) (ELSE 98688)>)
 298                                   <ADDRSYM <DATVAL .WDTH>>>]>>
 299         <PUT <DATVAL .WDTH> ,ACPROT <>>
 300         <PUT <DATVAL .POSD> ,ACPROT <>>
 301         <RET-TMP-AC .POSD>
 302         <COND (<TYPE? <DATTYP .WDTH> AC>
 303                <RET-TMP-AC <DATTYP .WDTH> .WDTH>)>
 304         <PUT .WDTH ,DATTYP BITS>
 305         [<MOVE:ARG .WDTH .W> .TEM]>
 306
 307 <DEFINE MAKE-PTR (AD W-P CNST "AUX" (BP <BITS 6 <COND (.W-P 24) (ELSE 30)>>))
 308         #DECL ((CNST) FIX)
 309         <COND (<TYPE? .AD DATUM>
 310                [<FORM (<GETBITS <PUTBITS 0 .BP .CNST> <BITS 18 18>>) HERE>])
 311               (ELSE
 312                [<FORM (<GETBITS <PUTBITS 0 .BP .CNST> <BITS 18 18>>) 0>])>>
 313 \f
 314 <ENDPACKAGE>