<mdl.comp>/buildl.mud.19

   1 <PACKAGE "BUILDL">
   2
   3 <ENTRY LIST-BUILD>
   4
   5 <USE "CACS" "CODGEN" "COMCOD" "COMPDEC" "CHKDCL">
   6
   7 <DEFINE LIST-BUILD (NOD W
   8                     "AUX" (K <KIDS .NOD>) (KK ()) N TEM TT T1 D1 D2 D3
   9                           (OOPSF <>))
  10    #DECL ((K KK) <LIST [REST NODE]> (N NOD) NODE)
  11    <COND
  12     (<MAPF <>
  13            <FUNCTION (N)
  14                    #DECL ((N) NODE)
  15                    <COND (<AND <G=? <LENGTH .N> <CHTYPE <INDEX ,SIDE-EFFECTS>
  16                                                          FIX>>
  17                                <SIDE-EFFECTS .N>>
  18                           <MAPLEAVE <>>)
  19                          (ELSE <SET KK (.N !.KK)> T)>>
  20            .K>
  21      <COND (<AND <==? <NODE-TYPE <SET N <1 .KK>>> ,SEG-CODE>
  22                  <==? <STRUCTYP <RESULT-TYPE <SET N <1 <KIDS .N>>>>> LIST>>
  23             <SET TEM
  24                  <GEN .N
  25                       <COND (<EMPTY? <REST .KK>> .W)
  26                             (ELSE <DATUM LIST ,AC-E>)>>>
  27             <SET KK <REST .KK>>)
  28            (ELSE <SET TEM <REFERENCE ()>>)>
  29      <MAPF <>
  30            <FUNCTION (N "AUX" (COD <DEFERN <RESULT-TYPE .N>>))
  31                    #DECL ((N) NODE (COD) FIX)
  32                    <COND (<==? <NODE-TYPE .N> ,SEG-CODE>
  33                           <SET TEM
  34                                <SEG-BUILD-LIST <1 <KIDS .N>> .TEM <> <> <>>>)
  35                          (ELSE
  36                           <SET T1 <GEN .N <DATUM ,AC-C ,AC-D>>>
  37                           <SET TEM <MOVE:ARG .TEM <DATUM LIST ,AC-E>>>
  38                           <RET-TMP-AC .TEM>
  39                           <RET-TMP-AC .T1>
  40                           <REGSTO T>
  41                           <EMIT <INSTRUCTION `PUSHJ
  42                                              `P*
  43                                              <COND (<0? .COD> |C1CONS )
  44                                                    (ELSE |CICONS )>>>
  45                           <SET TEM <FUNCTION:VALUE T>>)>>
  46            .KK>
  47      <MOVE:ARG .TEM .W>)
  48     (ELSE
  49      <COND (<==? <NODE-TYPE <SET N <1 .K>>> ,SEG-CODE>
  50             <SET TEM <SEG-BUILD-LIST <1 <KIDS .N>> <REFERENCE ()> T T <>>>
  51             <SET D3 <2 .TEM>>
  52             <SET D2 <1 .TEM>>
  53             <SET OOPSF <3 .TEM>>)
  54            (ELSE
  55             <SET D1 <GEN .N <DATUM ,AC-C ,AC-D>>>
  56             <SGETREG ,AC-E <>>
  57             <MUNG-AC ,AC-E>
  58             <EMIT <INSTRUCTION `MOVEI  `E*  0>>
  59             <RET-TMP-AC .D1>
  60             <REGSTO T>
  61             <EMIT <INSTRUCTION
  62                    `PUSHJ
  63                    `P*
  64                    <COND (<0? <DEFERN <RESULT-TYPE .N>>> |C1CONS )
  65                          (ELSE |CICONS )>>>
  66             <SET D2 <DATUM LIST ,AC-B>>
  67             <SET D3 <DATUM LIST ,AC-B>>
  68             <PUT ,AC-B ,ACLINK (.D2)>
  69             <REGSTO T>
  70             <PUT ,AC-B ,ACLINK (.D3)>)>
  71      <MAPR <>
  72       <FUNCTION (L "AUX" (N <1 .L>))
  73          #DECL ((N) NODE)
  74          <COND
  75           (<==? <NODE-TYPE .N> ,SEG-CODE>
  76            <COND
  77             (<AND <==? <STRUCTYP <RESULT-TYPE <SET N <1 <KIDS .N>>>>> LIST>
  78                   <EMPTY? <REST .L>>>
  79              <SET D1 <GEN .N <DATUM LIST ANY-AC>>>
  80              <COND (.OOPSF
  81                     <TOACV .D1>
  82                     <PUT <DATVAL .D1> ,ACPROT T>
  83                     <EMIT <INSTRUCTION `SKIPE
  84                                        <ACSYM <SET TEM <GETREG <>>>>
  85                                        !<ADDR:VALUE .D3>>>
  86                     <PUT <DATVAL .D1> ,ACPROT <>>)>
  87              <EMIT <INSTRUCTION `HRRM
  88                                 <ACSYM <DATVAL .D1>>
  89                                 `@
  90                                 !<ADDR:VALUE .D3>>>
  91              <COND (.OOPSF
  92                     <EMIT <INSTRUCTION `SKIPN  <ADDRSYM .TEM>>>
  93                     <COND (<TYPE? <DATVAL .D2> AC>
  94                            <EMIT <INSTRUCTION
  95                                   `MOVE
  96                                   <ACSYM <DATVAL .D2>>
  97                                   !<ADDR:VALUE .D1>>>)
  98                           (ELSE
  99                            <EMIT <INSTRUCTION
 100                                   `MOVEM
 101                                   <ACSYM <DATVAL .D1>>
 102                                   !<ADDR:VALUE .D2>>>)>)>
 103              <RET-TMP-AC .D1>)
 104             (ELSE <SET D3 <SEG-BUILD-LIST .N .D3 T <> <COND (.OOPSF .D2)>>>)>)
 105           (ELSE
 106            <SET D1 <GEN .N <DATUM ,AC-C ,AC-D>>>
 107            <SGETREG ,AC-E <>>
 108            <SET D1 <MOVE:ARG .D1 <DATUM ,AC-C ,AC-D>>>
 109            <EMIT '<`MOVEI  `E* >>
 110            <RET-TMP-AC .D1>
 111            <REGSTO T>
 112            <EMIT <INSTRUCTION
 113                   `PUSHJ
 114                   `P*
 115                   <COND (<0? <DEFERN <RESULT-TYPE .N>>> |C1CONS )
 116                         (ELSE |CICONS )>>>
 117            <COND (.OOPSF <EMIT <INSTRUCTION `SKIPE  `C*  !<ADDR:VALUE .D3>>>)>
 118            <EMIT <INSTRUCTION `HRRM  `B*  `@  !<ADDR:VALUE .D3>>>
 119            <EMIT <INSTRUCTION `MOVEM  `B*  !<ADDR:VALUE .D3>>>
 120            <COND (.OOPSF
 121                   <EMIT '<`SKIPN  `C >>
 122                   <EMIT <INSTRUCTION `MOVEM  `B*  !<ADDR:VALUE .D2>>>)>)>>
 123       <REST .K>>
 124      <RET-TMP-AC .D3>
 125      <MOVE:ARG .D2 .W>)>>
 126
 127 <DEFINE SEG-BUILD-LIST (NOD DAT FLG FST SMQ
 128                         "AUX" (TYP <RESULT-TYPE .NOD>) (TG2 <MAKE:TAG>)
 129                               (ITYP <ISTYPE? .TYP>) (TPS <STRUCTYP .TYP>)
 130                               (ET <GET-ELE-TYPE .TYP ALL>) (DF <DEFERN .ET>)
 131                               (ML <MINL .TYP>) (TG1 <MAKE:TAG>) TEM D1 D3 FDAT
 132                               D4)
 133         #DECL ((NOD) NODE (DAT D1 D2 FDAT) DATUM (SMQ) <OR DATUM FALSE>)
 134         <SET ET <ISTYPE-GOOD? .ET>>
 135         <SET D1
 136              <GEN .NOD
 137                   <DATUM <COND (<ISTYPE-GOOD? .ITYP> .ITYP)
 138                                (<ISTYPE-GOOD? .TPS> .TPS)
 139                                (ELSE ANY-AC)>
 140                          ANY-AC>>>
 141         <COND (<ISTYPE-GOOD? .TPS> <DATTYP-FLUSH .D1> <PUT .D1 ,DATTYP .TPS>)>
 142         <COND (<OR .FST <NOT .FLG>>
 143                <COND (<0? .ML>
 144                       <SET DAT
 145                            <MOVE:ARG .DAT
 146                                      <DATUM LIST
 147                                             <COND (.FST ,AC-B) (ELSE ,AC-E)>>>>
 148                       <COND (.FST
 149                              <RET-TMP-AC .D1>
 150                              <SET FDAT <DATUM LIST <DATVAL .DAT>>>
 151                              <REGSTO T>
 152                              <PUT ,AC-B ,ACLINK (.FDAT)>
 153                              <PUT <DATVAL .D1> ,ACLINK (.D1)>
 154                              <COND (<TYPE? <DATTYP .D1> AC>
 155                                     <PUT <DATTYP .D1> ,ACLINK (.D1)>)>)>
 156                       <MT-TEST .D1 .TG1 .TPS>)>
 157                <SET TEM
 158                     <OFFPTR <COND (<==? .TPS UVECTOR> -1) (ELSE 0)> .D1 .TPS>>
 159                <SET D3 <DATUM <COND (.ET) (ELSE .TEM)> .TEM>>
 160                <SET D3 <MOVE:ARG .D3 <DATUM ,AC-C ,AC-D> T>>
 161                <COND (<AND .FLG .FST> <RET-TMP-AC .FDAT>)
 162                      (<NOT .FLG>
 163                       <SET DAT <MOVE:ARG .DAT <DATUM LIST ,AC-E>>>
 164                       <RET-TMP-AC .DAT>)>
 165                <RET-TMP-AC .D3>
 166                <REGSTO T>
 167                <AND .FST <EMIT '<`MOVEI  `E* >>>
 168                <EMIT <INSTRUCTION `PUSHJ
 169                                   `P*
 170                                   <COND (<0? .DF> |C1CONS ) (ELSE |CICONS )>>>
 171                <COND (<AND .FST <0? .ML>>
 172                       <EMIT <INSTRUCTION `MOVEM  `B*  !<ADDR:VALUE .DAT>>>)>)>
 173         <COND (<OR <NOT .FST> <NOT <0? .ML>>>
 174                <SET FDAT <DATUM LIST ,AC-B>>
 175                <PUT ,AC-B ,ACLINK (.FDAT)>)>
 176         <COND (<OR .FST <NOT .FLG>> <SET D1 <1REST .D1 .TPS>>)>
 177         <COND (<OR <NOT .FST> <NOT <0? .ML>>>
 178                <SET DAT <MOVE:ARG .FDAT <DATUM LIST ,AC-E> T>>)>
 179         <RET-TMP-AC .D1>
 180         <RET-TMP-AC .FDAT>
 181         <REGSTO T>
 182         <PUT <DATVAL .D1> ,ACLINK (.D1)>
 183         <COND (<TYPE? <DATTYP .D1> AC> <PUT <DATTYP .D1> ,ACLINK (.D1)>)>
 184         <PUT ,AC-B ,ACLINK (.FDAT)>
 185         <COND (<L=? .ML 1> <MT-TEST .D1 .TG1 .TPS>)>
 186         <SET D4 <DATUM !.D1>>
 187         <LABEL:TAG .TG2>
 188         <SET TEM <OFFPTR <COND (<==? .TPS UVECTOR> -1) (ELSE 0)> .D1 .TPS>>
 189         <SET D3
 190              <MOVE:ARG <DATUM <COND (.ET) (ELSE .TEM)> .TEM>
 191                        <DATUM ,AC-C ,AC-D>
 192                        T>>
 193         <SGETREG ,AC-E <>>
 194         <RET-TMP-AC .D3>
 195         <COND (.FLG <EMIT '<`MOVEI  `E* >>)
 196               (ELSE <EMIT <INSTRUCTION `HRRZ  `E*  `@  !<ADDR:VALUE .FDAT>>>)>
 197         <REGSTO T>
 198         <EMIT <INSTRUCTION `PUSHJ
 199                            `P*
 200                            <COND (<0? .DF> |C1CONS ) (ELSE |CICONS )>>>
 201         <COND (.SMQ <EMIT <INSTRUCTION `SKIPE  `C*  !<ADDR:VALUE .FDAT>>>)>
 202         <EMIT <INSTRUCTION `HRRM  `B*  `@  !<ADDR:VALUE .FDAT>>>
 203         '<EMIT <INSTRUCTION `MOVEM  `B*  !<ADDR:VALUE .FDAT>>>
 204         <COND (.SMQ
 205                <EMIT '<`SKIPN  `C >>
 206                <EMIT <INSTRUCTION `MOVEM  `B*  !<ADDR:VALUE .SMQ>>>)>
 207         <REST-N-JMP .D1 .TPS .TG2 .D4>
 208         <COND (.FLG <SET FDAT <DATUM LIST ,AC-B>> <PUT ,AC-B ,ACLINK (.FDAT)>)
 209               (ELSE <SET DAT <MOVE:ARG .DAT <DATUM LIST ,AC-E>>>)>
 210         <LABEL:TAG .TG1>
 211         <COND (<AND .FLG .FST> (.DAT .FDAT <0? .ML>)) (.FLG .FDAT) (ELSE .DAT)>>
 212
 213 <DEFINE MT-TEST (D TG TP) #DECL ((TP) ATOM (D) DATUM)
 214         <SET D <TOACV .D>>
 215         <COND (<==? .TP LIST> <EMIT <INSTRUCTION `JUMPE <ACSYM <DATVAL .D>> .TG>>)
 216               (ELSE <EMIT <INSTRUCTION `JUMPGE <ACSYM <DATVAL .D>> .TG>>)>>
 217
 218 <DEFINE 1REST (D TP
 219                "AUX" (DD
 220                       <DATUM <COND (<ISTYPE-GOOD? .TP> .TP) (ELSE ANY-AC)>
 221                              ANY-AC>) AC)
 222         #DECL ((TP) ATOM (D DD) DATUM (AC) AC)
 223         <COND (<==? .TP LIST>
 224                <PUT .DD ,DATVAL <SET AC <GETREG .DD>>>
 225                <EMIT <INSTRUCTION `HRRZ  <ACSYM .AC> `@  !<ADDR:VALUE .D>>>
 226                <RET-TMP-AC .D>)
 227               (ELSE
 228                <SET DD <MOVE:ARG .D .DD>>
 229                <EMIT <INSTRUCTION `ADD
 230                                   <ACSYM <DATVAL .DD>>
 231                                   <COND (<==? .TP UVECTOR> '[<1 (1)>])
 232                                         (ELSE '[<2 (2)>])>>>)>
 233         .DD>
 234
 235 <DEFINE REST-N-JMP (D TP TG D1 "AUX" (AC <DATVAL .D1>))
 236         #DECL ((D D1) DATUM (TP) ATOM (AC) AC)
 237         <COND (<==? .TP LIST>
 238                <EMIT <INSTRUCTION `HRRZ  <ACSYM .AC> `@  !<ADDR:VALUE .D>>>
 239                <EMIT <INSTRUCTION `JUMPN  <ACSYM .AC> .TG>>
 240                <RET-TMP-AC .D>
 241                <PUT .AC ,ACLINK (.D1 !<ACLINK .AC>)>)
 242               (ELSE
 243                <EMIT <INSTRUCTION `MOVE  <ACSYM .AC> !<ADDR:VALUE .D>>>
 244                <COND (<TYPE? <DATTYP .D1> AC>
 245                       <EMIT <INSTRUCTION `MOVE
 246                                          <ACSYM <DATTYP .D1>>
 247                                          !<ADDR:TYPE .D>>>
 248                       <PUT <DATTYP .D1> ,ACLINK (.D1 !<ACLINK
 249                                                        <DATTYP .D1>>)>)>
 250                <RET-TMP-AC .D>
 251                <PUT .AC ,ACLINK (.D1 !<ACLINK .AC>)>
 252                <COND (<==? .TP UVECTOR>
 253                       <EMIT <INSTRUCTION `AOBJN  <ACSYM .AC> .TG>>)
 254                      (ELSE
 255                       <EMIT <INSTRUCTION `ADD  <ACSYM .AC> '[<2 (2)>]>>
 256                       <EMIT <INSTRUCTION `JUMPL  <ACSYM .AC> .TG>>)>)>
 257         T>
 258
 259
 260 <ENDPACKAGE>\ 3\ 3