mim/development/mim/mimc/peep.mud

   1 <PACKAGE "PEEP">
   2
   3 <ENTRY PEEP>
   4
   5 <USE "NEWSTRUC" "COMPDEC" "ADVMESS" "CHKDCL" "NPRINT" "LIST-HACKS" "MIMGEN">
   6
   7 '<DEFMAC DEBUG ("ARGS" X) <FORM PROG () !.X>>
   8
   9 <DEFMAC DEBUG ("ARGS" X) T>
  10
  11 <DEFINE PEEP (L) <PEEP-PASS1 .L> <DEBUG <PRINC "Peep pass1 done"> <CRLF>>>
  12
  13 <DEFINE PEEP-PASS1 (L "AUX" LR (EQV ()) LP LLP (OUTCHAN .OUTCHAN) LBP RETS)
  14    #DECL ((LBP RETS LP LLP L LR EQV) LIST (OUTCHAN) <SPECIAL CHANNEL>)
  15    <SETG CHANGED <>>
  16    <REPEAT (WIN BF)
  17      #DECL ((WIN) <OR ATOM FALSE> (BF) <OR FALSE LIST>)
  18      <SET LBP ()>
  19      <SET RETS ()>
  20      <SET EQV ()>
  21      <SET WIN <>>
  22      <REPEAT ((L .L) IT LN EQVP)
  23              #DECL ((LN L) LIST)
  24              <COND (<EMPTY? .L> <RETURN>)>
  25              <COND (<TYPE? <SET IT <1 .L>> ATOM>
  26                     <SET EQVP <OR <MEMQ .IT .EQV> <SET EQV (.IT () !.EQV)>>>
  27                     <SET LN <REST .L>>
  28                     <SET LBP (.IT .L () !.LBP)>
  29                     <REPEAT ()
  30                             <COND (<EMPTY? .LN> <RETURN>)>
  31                             <COND (<TYPE? <1 .LN> ATOM>
  32                                    <SET WIN T>
  33                                    <DEBUG <PRINC "Successive labels ">
  34                                           <PRIN1 <1 .LN>>
  35                                           <PRINC " ">
  36                                           <PRIN1 .IT>
  37                                           <CRLF>>
  38                                    <PUT .EQVP 2 (<1 .LN> !<2 .EQVP>)>
  39                                    <SET LN <REST .LN>>)
  40                                   (ELSE <RETURN>)>>
  41                     <PUTREST .L .LN>)
  42                    (<AND <TYPE? .IT FORM>
  43                          <NOT <EMPTY? .IT>>
  44                          <==? <1 .IT> `END>>
  45                     <RETURN>)>
  46              <SET L <REST .L>>>
  47      <SET LR
  48       <MAPR ,LIST
  49        <FUNCTION (LL "AUX" (FRM <1 .LL>) M N I LBL A)
  50           #DECL ((FRM) <OR FORM ATOM> (M) <OR FALSE LIST> (LBL) ATOM
  51                  (N) <OR FALSE LIST> (I) FORM (LL) LIST)
  52           <COND (<TYPE? .FRM ATOM> <SET BF <>> <MAPRET>)
  53                 (<==? <1 .FRM> `END> <MAPSTOP>)
  54                 (<OR <==? <1 .FRM> `OPT-DISPATCH> <==? <1 .FRM> `DISPATCH>>
  55                  <SET BF <>>
  56                  <MAPR <>
  57                        <FUNCTION (F "AUX" LBL P)
  58                                #DECL ((F) LIST)
  59                                <PUT .F 1 <SET LBL <FIND-EQV <1 .F> .EQV>>>
  60                                <BUILD-LABEL-TABLE .LBL .LBP .LL>>
  61                        <REST .FRM 3>>
  62                  <MAPRET !<REST .FRM 3>>)
  63                 (<OR <SET M <MEMQ + .FRM>>
  64                      <SET M <MEMQ - .FRM>>
  65                      <AND <==? <1 .FRM> `NTHR>
  66                           <TYPE? <SET A <NTH .FRM <LENGTH .FRM>>> LIST>
  67                           <==? <1 .A> `BRANCH-FALSE>
  68                           <SET BF <SET M <REST .A>>>>>
  69                  <COND (<SET N <MEMQ <SET LBL <FIND-EQV <2 .M> .EQV>> .L>>
  70                         <PUT .M 2 .LBL>)
  71                        (<OR <==? .LBL `COMPERR>
  72                             <==? .LBL `UNWCONT>>
  73                         <SET BF <>> <MAPRET>)
  74                        (T <COMPILE-LOSSAGE "Bad label: " .LBL .M .L>)>
  75                  <COND (<==? <1 <SET I <1 <NEXTINS .N>>>> `JUMP>
  76                         <SET BF <>>
  77                         <DEBUG <PRINC "Jump to jump ">
  78                                <PRIN1 .FRM>
  79                                <PRINC " ">
  80                                <PRIN1 .I>
  81                                <CRLF>>
  82                         <PUT .M 2 <SET LBL
  83                                        <CHTYPE <FIND-EQV <3 .I> .EQV> ATOM>>>
  84                         <SET WIN T>
  85                         <BUILD-LABEL-TABLE .LBL .LBP .LL>
  86                         <MAPRET .LBL>)
  87                        (<AND <==? <1 .FRM> `JUMP>
  88                              <MEMQ <1 .I> '[`RETURN `MRETURN `RTUPLE `AGAIN]>>
  89                         <PUT .LL 1 <FORM !.I>>
  90                         <SET WIN T>
  91                         <SET BF <>>
  92                         <DEBUG <PRINC "Jump to RETURNish thing ">
  93                                <PRIN1 .FRM>
  94                                <PRINC " ">
  95                                <PRIN1 .I>
  96                                <CRLF>>
  97                         <MAPRET>)
  98                        (<AND <N==? <1 .FRM> `JUMP>
  99                              <NOT <EMPTY? <SET LP <REST .LL>>>>
 100                              <NOT <TYPE? <1 .LP> ATOM>>
 101                              <==? <1 <SET I <1 .LP>>> `JUMP>
 102                              <NOT <EMPTY? <SET LLP <REST .LP>>>>
 103                              <TYPE? <1 .LLP> ATOM>
 104                              <==? <FIND-EQV <1 .LLP> .EQV> .LBL>
 105                              <NOT .BF>>
 106                         <DEBUG <PRINC "Conditional jump followed by JUMP ">
 107                                <PRIN1 .FRM>
 108                                <PRINC " ">
 109                                <PRIN1 .I>
 110                                <CRLF>>
 111                         <PUT .M 1 <COND (<==? <1 .M> +> -) (ELSE +)>>
 112                         <PUT .M
 113                              2
 114                              <SET LBL <CHTYPE <FIND-EQV <3 .I> .EQV> ATOM>>>
 115                         <PUT .LP 1 <FIND-EQV <1 .LLP> .EQV>>
 116                         <PATCH-LABEL-TABLE .LBP <1 .LP> .LP>
 117                         <PUTREST .LP <REST .LLP>>
 118                         <SET WIN T>
 119                         <BUILD-LABEL-TABLE .LBL .LBP .LL>
 120                         <MAPRET .LBL>)
 121                        (T
 122                         <COND (<N==? .BF .M> <SET BF <>>)>
 123                         <BUILD-LABEL-TABLE .LBL .LBP .LL>
 124                         <MAPRET .LBL>)>)
 125                 (<==? <1 .FRM> `ICALL>
 126                  <PUT .FRM 2 <SET LBL <FIND-EQV <2 .FRM> .EQV>>>
 127                  <SET BF <>>
 128                  <BUILD-LABEL-TABLE .LBL .LBP .LL>
 129                  <MAPRET .LBL>)
 130                 (T <SET BF <>> <MAPRET>)>>
 131        .L>>
 132      <REPEAT ((L .L) (OL .L) ITM TEM I TF IP TT)
 133              #DECL ((L OL) LIST (ITM) ANY)
 134              <COND (<EMPTY? .L> <RETURN>)
 135                    (<AND <TYPE? <1 .L> ATOM> <NOT <MEMQ <1 .L> .LR>>>
 136                     <PUTREST .OL <REST .L>>
 137                     <DEBUG <PRINC "Flush extra label  "> <PRIN1 <1 .L>> <CRLF>>
 138                     <SET WIN T>)
 139                    (<AND <TYPE? <SET ITM <1 .L>> FORM> <==? <1 .ITM> `END>>
 140                     <RETURN>)
 141                    (<AND <TYPE? .ITM FORM>
 142                          <SET TEM <OR <MEMQ + .ITM> <MEMQ - .ITM>>>
 143                          <NOT <LENGTH? .L 1>>
 144                          <==? <2 .L> <2 .TEM>>
 145                          <N==? <SET TEM <1 .ITM>> `SYSOP>
 146                          <N==? .TEM `SCALL>>
 147                     <DEBUG <PRINC "Jump to .+1  "> <PRINC .ITM> <CRLF>>
 148                     <REMOVE-LABEL .LBP <2 .L> .L>
 149                     <PUTREST .OL <REST .L>>
 150                     <SET WIN T>)
 151                    (<AND <TYPE? .ITM FORM>
 152                          <==? <1 .ITM> `SET>
 153                          <NOT <EMPTY? <REST .L>>>
 154                          <TYPE? <2 .L> FORM>
 155                          <==? <1 <2 .L>> `RETURN>
 156                          <==? <2 .ITM> <2 <2 .L>>>>
 157                     <PUT <2 .L> 2 <3 .ITM>>
 158                     <PUTREST .OL <REST .L>>
 159                     <DEBUG <PRINC "SET-RETURN combo"> <PRINC .ITM><CRLF>>)
 160                    (<AND <TYPE? .ITM FORM>
 161                          <OR <AND <==? <1 .ITM> `RETURN>
 162                                   <SET RETS (.L !.RETS)>>
 163                              <MEMQ <1 .ITM>
 164                                    '[`JUMP `RTUPLE `MRETURN `AGAIN]>>
 165                          <NOT <LENGTH? .L 1>>
 166                          <NOT <TYPE? <SET ITM <2 .L>> ATOM>>
 167                          <NOT <AND <TYPE? .ITM FORM>
 168                                    <G=? <LENGTH .ITM> 1>
 169                                    <MEMQ <1 .ITM> '[`END `DEAD `ENDIF]>>>>
 170                     <DEBUG <PRINC "Unreachable code after  ">
 171                            <PRIN1 <1 .L>>
 172                            <PRINC " ">
 173                            <PRIN1 .ITM>
 174                            <CRLF>>
 175                     <PUTREST .L <REST .L 2>>
 176                     <SET OL .L>
 177                     <SET WIN T>)
 178                    (<AND <TYPE? .ITM FORM>
 179                          <==? <1 .ITM> `CHTYPE>
 180                          <TYPE? <SET I <2 .L>> FORM>
 181                          <==? <1 .I> `CHTYPE>
 182                          <==? <2 .I> <5 .I>>
 183                          <==? <2 .I> <5 .ITM>>>
 184                     ;"Look for 2 CHTYPEs of same thing in a row"
 185                     <DEBUG <PRINC "Two CHTYPEs in a row  ">
 186                            <PRIN1 .ITM>
 187                            <PRINC " ">
 188                            <PRIN1 .I>
 189                            <CRLF>>
 190                     <PUT .ITM 3 <3 .I>>
 191                     <PUTREST .L <REST .L 2>>
 192                     <SET OL .L>
 193                     <SET WIN T>)
 194                    (<AND <TYPE? .ITM FORM>
 195                          <==? <1 .ITM> `SET>
 196                          <OR <==? <SET TF <3 .ITM>> <>>
 197                              <AND <TYPE? .TF FORM>
 198                                   <==? <LENGTH .TF> 2>
 199                                   <==? <1 .TF> QUOTE>
 200                                   <==? <2 .TF> T>>>
 201                          <TYPE? <SET I <2 .L>> FORM>
 202                          <==? <1 .I> `JUMP>
 203                          <TYPE? <SET TEM <2 <SET IP <DEST-INS <3 .I> .LBP>>>>
 204                                 FORM>
 205                          <==? <1 .TEM> `TYPE?>
 206                          <==? <2 .TEM> <2 .ITM>>
 207                          <TYPE? <SET TT <3 .TEM>> FORM>
 208                          <==? <1 .TT> `TYPE-CODE>
 209                          <OR <==? <2 .TT> ATOM> <==? <2 .TT> FALSE>>>
 210                      <DEBUG <PRINC "Jump to conditional with known condition" >
 211                            <PRIN1 .ITM>
 212                            <PRINC " ">
 213                            <PRIN1 .I>
 214                            <PRINC " ">
 215                            <PRIN1 .TEM>
 216                            <CRLF>>
 217                      <COND (<JUMP? .TF <2 .TT> <4 .TEM>>
 218                             <PUT .L 2 <FORM `JUMP + <5 .TEM>>>)
 219                            (ELSE
 220                             <PUT .L 2 <FORM `JUMP +
 221                                             <SET TEM <MAKE-TAG "PEEP">>>>
 222                             <SET LR (.TEM !.LR)>
 223                             <PUTREST <REST .IP> (.TEM !<REST .IP 2>)>)>
 224                      <SET OL .L>
 225                      <SET WIN T>)
 226                    (<AND <TYPE? .ITM FORM>
 227                          <==? <1 .ITM> `SET>
 228                          <OR <==? <SET TF <3 .ITM>> <>>
 229                              <AND <TYPE? .TF FORM>
 230                                   <==? <LENGTH .TF> 2>
 231                                   <==? <1 .TF> QUOTE>
 232                                   <==? <2 .TF> T>>>
 233                          <TYPE? <SET TEM <2 .L>> FORM>
 234                          <==? <1 .TEM> `TYPE?>
 235                          <==? <2 .TEM> <2 .ITM>>
 236                          <TYPE? <SET TT <3 .TEM>> FORM>
 237                          <==? <1 .TT> `TYPE-CODE>
 238                          <OR <==? <2 .TT> ATOM> <==? <2 .TT> FALSE>>>
 239                      <DEBUG <PRINC " Conditional with known condition" >
 240                            <PRIN1 .ITM>
 241                            <PRINC " ">
 242                            <PRIN1 .TEM>
 243                            <CRLF>>
 244                      <COND (<JUMP? .TF <2 .TT> <4 .TEM>>
 245                             <PUT .L 2 <FORM `JUMP + <5 .TEM>>>)
 246                            (ELSE
 247                             <PUTREST .L <REST .L 2>>)>
 248                      <SET OL .L>
 249                      <SET WIN T>)
 250                    (<AND <TYPE? .ITM FORM>
 251                          <SET ITM <MEMQ = .ITM>>
 252                          <G=? <LENGTH .ITM> 2>
 253                          <TYPE? <SET ITM <2 .ITM>> FORM>
 254                          <==? <1 .ITM> QUOTE>
 255                          <==? <2 .ITM> FLUSHED>>
 256                     <DEBUG <PRINC "Instruction result being flushed: ">
 257                            <PRIN1 <1 .L>>
 258                            <CRLF>>
 259                     <PUTREST .OL <REST .L>>
 260                     <SET WIN T>)
 261                    (T <SET OL .L>)>
 262              <SET L <REST .L>>>
 263      <COND (.WIN <SETG CHANGED T>)
 264            (<EQV-CODE .L .LBP .RETS> <SETG CHANGED T>)
 265            (ELSE <RETURN>)>>
 266    ,CHANGED>
 267
 268 <DEFINE DEST-INS (ATM:ATOM LBP:<LIST [REST ATOM LIST LIST]>)
 269         <REPEAT ()
 270                 <COND (<EMPTY? .LBP> <RETURN <>>)>
 271                 <COND (<==? <1 .LBP> .ATM> <RETURN <2 .LBP>>)>
 272                 <SET LBP <REST .LBP 3>>>>
 273
 274 <DEFINE JUMP? (TF TNAME:ATOM DIR:ATOM)
 275         <COND (.TF <SET TF ATOM>) (ELSE <SET TF FALSE>)>
 276         <COND (<==? .TF .TNAME>
 277                <==? .DIR +>)
 278               (ELSE
 279                <==? .DIR ->)>>
 280
 281 <DEFINE EQV-CODE (L LBLS RETS "AUX" (WIN <>) LB OTS OIP)
 282         #DECL ((OTS OIP L RETS) LIST (LBLS) <LIST [REST ATOM LIST LIST]>)
 283         <SET L <LREVERSE .L>>
 284         <REPEAT (RL LAB) #DECL ((RL) <LIST [REST LIST]> (LAB) LAB)
 285           <COND (<EMPTY? .LBLS> <RETURN>)>
 286           <COND
 287            (<NOT <EMPTY? <SET RL <3 .LBLS>>>>
 288             <REPEAT ((TST <REST <2 .LBLS>>)) #DECL ((TST) LIST)
 289               <COND
 290                (<NOT <EMPTY? .TST>>
 291                 <MAPF <>
 292                       <FUNCTION (INSP "AUX" (INS <1 .INSP>))
 293                          #DECL ((INSP) <LIST ANY> (INS) <FORM ATOM>)
 294                          <COND
 295                           (<==? <1 .INS> `JUMP>
 296                            <SET INSP <REST .INSP>>
 297                            <REPEAT ((IP .INSP) (TS .TST) ONE TWO)
 298                                #DECL ((IP TS) LIST)
 299                                <COND (<AND <TYPE? <SET ONE <1 .IP>> FORM>
 300                                            <TYPE? <SET TWO <1 .TS>> FORM>
 301                                            <==? <LENGTH .ONE:FORM>
 302                                                 <LENGTH .TWO:FORM>>
 303                                            <NOT <EMPTY? .ONE:FORM>>
 304                                            <N==? <1 .ONE:FORM> `ENDIF>
 305                                            <MAPF <>
 306                                                  <FUNCTION
 307                                                       (A B
 308                                                        "AUX" (TA <CALL
 309                                                                   TYPE .A>)
 310                                                              (TB <CALL
 311                                                                   TYPE .B>))
 312                                                      <COND (<==? .A .B>)
 313                                                            (<N==? .TA .TB>
 314                                                             <MAPLEAVE <>>)
 315                                                            (<N=? .A .B>
 316                                                             <MAPLEAVE <>>)>
 317                                                      T>
 318                                                  .ONE:FORM
 319                                                  .TWO:FORM>>
 320                                       <SET IP <REST <SET OIP .IP>>>
 321                                       <SET TS <REST <SET OTS .TS>>>)
 322                                      (<AND <N==? .TS .TST>
 323                                            <N==? <1 <1 .OIP>> `ENDIF>>
 324                                       <SET WIN T>
 325                                       <PUTREST .OTS
 326                                                (<SET LB <MAKE-TAG "PEEP">>
 327                                                 !<REST .OTS>)>
 328                                       <PUT .OIP 1 <FORM `JUMP + .LB>>
 329                                       <RETURN>)
 330                                      (ELSE <RETURN>)>>)>>
 331                       .RL>)>
 332               <COND (<AND <==? <1 <1 <SET TST <1 .RL>>>:FORM> `JUMP>
 333                           <NOT <EMPTY? <SET RL <REST .RL>>>>>
 334                      <SET TST <REST .TST>>)
 335                     (ELSE <RETURN>)>>)>
 336           <SET LBLS <REST .LBLS 3>>>
 337         <COND
 338          (<AND <NOT <EMPTY? .RETS>> <NOT <EMPTY? <REST .RETS>>>>
 339           <MAPR <>
 340                 <FUNCTION (RP "AUX" (RI <1 .RP>) (RRP <REST .RP>))
 341                   #DECL ((RP) <LIST LIST [REST LIST]>
 342                          (RI) <LIST FORM [REST <OR ATOM FORM>]>
 343                          (RRP) <LIST [REST LIST]>)
 344                   <COND
 345                    (<NOT <EMPTY? .RRP>>
 346                     <MAPF <>
 347                           <FUNCTION (TST "AUX" Y X)
 348                                #DECL ((TST) <LIST <FORM ANY>
 349                                                   [REST <OR ATOM FORM>]>
 350                                       (X Y) <FORM ANY ANY>)
 351                                <COND
 352                                  (<AND <==? <1 <SET X <1 .RI>>>
 353                                             <1 <SET Y <1 .TST>>>>
 354                                        <==? <2 .X> <2 .Y>>>
 355                                   <REPEAT ((IP <REST .RI>) (TS <REST .TST>)
 356                                              ONE TWO)
 357                                      #DECL ((IP TS)
 358                                             <LIST [REST <OR ATOM FORM>]>)
 359                                      <COND
 360                                       (<AND <TYPE? <SET ONE <1 .IP>> FORM>
 361                                             <TYPE? <SET TWO <1 .TS>> FORM>
 362                                             <==? <LENGTH .ONE:FORM>
 363                                                  <LENGTH .TWO:FORM>>
 364                                             <NOT <EMPTY? .ONE:FORM>>
 365                                             <N==? <1 .ONE:FORM> `ENDIF>
 366                                             <MAPF <>
 367                                                   <FUNCTION
 368                                                        (A B
 369                                                         "AUX" (TA <CALL
 370                                                                    TYPE .A>)
 371                                                         (TB <CALL
 372                                                              TYPE .B>))
 373                                                        <COND (<==? .A .B>)
 374                                                              (<N==? .TA .TB>
 375                                                               <MAPLEAVE <>>)
 376                                                              (<N=? .A .B>
 377                                                               <MAPLEAVE <>>)>
 378                                                        T>
 379                                                   .ONE:FORM
 380                                                   .TWO:FORM>>
 381                                        <SET IP <REST <SET OIP .IP>>>
 382                                        <SET TS <REST <SET OTS .TS>>>)
 383                                       (<AND <N==? .TS <REST .TST>>
 384                                             <N==? <1 <1 .OIP>> `ENDIF>>
 385                                        <SET WIN T>
 386                                        <PUTREST .OIP
 387                                                 (<SET LB <MAKE-TAG "PEEP">>
 388                                                  !<REST .OIP>)>
 389                                        <PUT .OTS 1 <FORM `JUMP + .LB>>
 390                                        <RETURN>)
 391                                       (ELSE <RETURN>)>>)>>
 392                           .RRP>)>>
 393                 .RETS>)>
 394         <SET L <LREVERSE .L>>
 395         .WIN>
 396
 397 <DEFINE BUILD-LABEL-TABLE (LBL:ATOM LBP:<LIST [REST ATOM LIST LIST]> L:LIST)
 398         <REPEAT ()
 399                 <COND (<EMPTY? .LBP> <RETURN>)>
 400                 <COND (<==? <1 .LBP> .LBL>
 401                        <3 .LBP (.L !<3 .LBP>)>
 402                        <RETURN>)>
 403                 <SET LBP <REST .LBP 3>>>>
 404
 405 <DEFINE PATCH-LABEL-TABLE (LBP:<LIST [REST ATOM LIST LIST]> ATM:ATOM L:LIST)
 406         <REPEAT ()
 407                 <COND (<EMPTY? .LBP> <RETURN>)>
 408                 <COND (<==? <1 .LBP> .ATM>
 409                        <2 .LBP .L>
 410                        <RETURN>)>
 411                 <SET LBP <REST .LBP 3>>>>
 412
 413 <DEFINE REMOVE-LABEL (LBP:<LIST [REST ATOM LIST LIST]> ATM:ATOM L:LIST)
 414         <REPEAT (A B)
 415                 <COND (<EMPTY? .LBP> <RETURN>)>
 416                 <COND (<==? <1 .LBP> .ATM>
 417                        <SET B <SET A <3 .LBP>>>
 418                        <REPEAT ()
 419                                <COND (<EMPTY? .A> <RETURN>)>
 420                                <COND (<==? <1 .A> .L>
 421                                       <COND (<==? .A .B>
 422                                              <3 .LBP <REST .A>>)
 423                                             (ELSE
 424                                              <PUTREST .B <REST .A>>)>
 425                                       <RETURN>)>
 426                                <SET B .A>
 427                                <SET A <REST .A>>>
 428                        <RETURN>)>
 429                 <SET LBP <REST .LBP 3>>>>
 430
 431 <DEFINE NEXTINS (L)
 432         #DECL ((L VALUE) LIST)
 433         <MAPR <>
 434               <FUNCTION (LL "AUX" (ITM <1 .LL>))
 435                       #DECL ((ITM) <OR ATOM FORM> (LL) <LIST <OR ATOM FORM>>)
 436                       <COND (<TYPE? .ITM FORM> <MAPLEAVE .LL>)>>
 437               <REST .L>>>
 438
 439 <DEFINE FIND-EQV (ATM EQVL)
 440         #DECL ((VALUE ATM) ATOM (EQVL) <LIST [REST ATOM <LIST [REST ATOM]>]>)
 441         <COND (<OR <==? .ATM `COMPERR> <==? .ATM `UNWCONT>> .ATM)
 442               (ELSE
 443                <REPEAT ()
 444                        <COND (<MEMQ .ATM <2 .EQVL>> <RETURN <1 .EQVL>>)>
 445                        <COND (<EMPTY? <SET EQVL <REST .EQVL 2>>>
 446                               <RETURN .ATM>)>>)>>
 447
 448 <ENDPACKAGE>