<mdl.comp>/varana.mud.43

   1 <PACKAGE "VARANA">
   2
   3 <ENTRY VARS>
   4
   5 <USE "COMPDEC" "CHKDCL" "ADVMESS" "SUBRTY">
   6
   7
   8 <SETG TEMPSTRT #TEMPV ()>
   9
  10 <DEFINE VARS REVAR (FCN
  11                     "AUX" GFRMID NOA ACC LARG (BPRE <>) (UNPRE <>) (NOACT T)
  12                           (OV .VERBOSE) (NNEW T))
  13         #DECL ((FCN) <SPECIAL NODE>
  14                (GFRMID NOA ACC LARG REVAR BPRE UNPRE NOACT NNEW) <SPECIAL ANY>)
  15         <COND (.VERBOSE <PUTREST <SET VERBOSE .OV> ()>)>
  16         <SET NOA <ACS .FCN>>
  17         <SET ACC <AND .NOA <N=? .NOA '(STACK)> <N=? .NOA '(FUNNY-STACK)>>>
  18         <SET LARG <>>
  19         <SET GFRMID 0>
  20         <COND (<AND .VERBOSE <NOT .NOA>>
  21                <ADDVMESS .FCN ("Frame being generated.")>)>
  22         <FUNC-VAR .FCN>>
  23
  24 <DEFINE FUNC-VAR (BASEF
  25                   "AUX" (PRE <>) (BST <BINDING-STRUCTURE .BASEF>)
  26                         (FRMID <SET GFRMID <+ .GFRMID 1>>) (SVIOFF 0) TA
  27                         (IOFF
  28                          <+
  29                           <COND (<OR <ACTIV? .BST .NOACT> <ACTIVATED .BASEF>>
  30                                  <PUT .BASEF ,ACTIVATED T>
  31                                  2)
  32                                 (ELSE 0)>
  33                           <COND
  34                            (<=? .NOA '(STACK)>
  35                             <* 2
  36                                <COND (<L? <SET TA <TOTARGS .BASEF>> 0> 0)
  37                                      (ELSE .TA)>>)
  38                            (ELSE 0)>>) (USOFF 0) (FUZZ <>) (HSLOT 0))
  39         #DECL ((BASEF) <SPECIAL NODE> (BST) <LIST [REST SYMTAB]>
  40                (FRMID GFRMID SVIOFF IOFF USOFF HSLOT) <SPECIAL FIX>
  41                (PRE FUZZ) <SPECIAL ANY>)
  42         <COND (<AND .NOACT <ACTIVATED .BASEF>>
  43                <SET NOACT <>>
  44                <AGAIN .REVAR>)>
  45         <AND <==? .FCN .BASEF>
  46              .NOA
  47              <ACTIVATED .BASEF>
  48              .NNEW
  49              <PUT .BASEF ,ACS <CHTYPE (<ACS .FCN>) FALSE>>
  50              <AGAIN .REVAR>>
  51         <PUT .BASEF ,BINDING-STRUCTURE <DOREG .BST>>
  52         <SET PRE <OR .PRE .BPRE>>
  53         <AND .ACC <NOT .LARG> <SET LARG T>>
  54         <AND .PRE <G? .USOFF .HSLOT> <SET HSLOT .USOFF>>
  55         <SET SVIOFF .IOFF>
  56         <MAPF <> ,VAR-ANA <KIDS .BASEF>>
  57         <AND .PRE <PUT .BASEF ,SSLOTS <COND (<0? .HSLOT> -1)(ELSE .HSLOT)>>>>
  58
  59 <DEFINE VAR-ANA (N)
  60         #DECL ((N FCN) NODE)
  61         <COND (<AND .FUZZ <ACS .FCN> .NNEW <NOT <=? <ACS .FCN> '(FUNNY-STACK)>>>
  62                <COND (<G=? <TOTARGS .FCN> 0> <PUT .FCN ,ACS '(FUNNY-STACK)>)
  63                      (<PUT .FCN ,ACS <CHTYPE (<ACS .FCN>) FALSE>>)>
  64                <AGAIN .REVAR>)>
  65         <COND (<VAR-ANA1 .N .FUZZ> <SET FUZZ T>)>>
  66
  67 <DEFINE VAR-ANA1 (N OFUZZ
  68                   "AUX" (FUZZ .OFUZZ) (SIOFF .IOFF) (COD <NODE-TYPE .N>) FL K RN
  69                         ACST)
  70    #DECL ((N RN) NODE (FUZZ) <SPECIAL ANY> (SIOFF) FIX (IOFF COD) FIX
  71           (K) <LIST [REST NODE]>)
  72    <COND
  73     (<==? .COD ,MAP-CODE>
  74      <PROG ((GMF ,NUMACS))
  75        #DECL ((GMF) <SPECIAL ANY>)
  76        <VAR-ANA <1 <SET K <KIDS .N>>>>
  77        <SET COD <NODE-TYPE <1 .K>>>
  78        <SET FL <==? <NODE-TYPE <2 .K>> ,MFCN-CODE>>
  79        <COND
  80         (<AND
  81           <OR
  82            <EMPTY? <REST .K 2>>
  83            <MAPF <>
  84             <FUNCTION (N)
  85                     #DECL ((N) NODE)
  86                     <COND (<AND <SET TEM <STRUCTYP <RESULT-TYPE .N>>>
  87                                 <N==? .TEM TEMPLATE>>
  88                            <SET GMF
  89                                 <- .GMF
  90                                    <COND (<OR <==? .TEM STRING>
  91                                               <==? .TEM BYTES>>
  92                                           2)
  93                                          (ELSE 1)>>>)
  94                           (ELSE <MAPLEAVE <>>)>>
  95             <REST .K 2>>>
  96           <OR <==? <ISTYPE? <RESULT-TYPE <1 .K>>> FALSE>
  97               <AND <AP? <1 .K>> <N==? <NODE-SUBR <1 .K>> 5>>>
  98           .FL>)
  99         (ELSE <SET GMF <>>)>
 100        <COND (<AND .FL
 101                    <NOT <EMPTY? <BINDING-STRUCTURE <2 .K>>>>
 102                    <==? <NAME-SYM <1 <BINDING-STRUCTURE <2 .K>>>> DUMMY-MAPF>>
 103               <REPEAT ((B <REST <BINDING-STRUCTURE <2 .K>> <- <LENGTH .K> 1>>)
 104                        (N <- <LENGTH .K> 2>))
 105                       <COND (<L? <SET N <- .N 1>> 0> <RETURN>)>
 106                       <PUT <1 .B> ,CODE-SYM 3>>)>
 107        <COND (<AND .FL
 108                    <NOT .GMF>
 109                    <NOT <EMPTY? <BINDING-STRUCTURE <2 .K>>>>
 110                    <==? <NAME-SYM <1 <BINDING-STRUCTURE <2 .K>>>> DUMMY-MAPF>>
 111               <PUT <2 .K>
 112                    ,BINDING-STRUCTURE
 113                    <REST <BINDING-STRUCTURE <2 .K>> <- <LENGTH .K> 1>>>)>
 114        <COND (<NOT <OR .GMF .FUZZ .PRE>>
 115               <COND (<==? .COD ,MFIRST-CODE>
 116                      <COND (<==? <NODE-SUBR <1 .K>> 5> <SET IOFF <+ .IOFF 4>>)
 117                            (ELSE <SET IOFF <+ .IOFF 2>>)>)
 118                     (<NOT <NODE-NAME <1 .K>>> <SET IOFF <+ .IOFF 2>>)>
 119               <COND (<AND <NOT .FL>
 120                           <N==? <NODE-TYPE <2 .K>> ,MPSBR-CODE>
 121                           <NOT <AP? <2 .K>>>>
 122                      <SET IOFF <+ .IOFF 2>>)>)
 123              (<AND <NOT <OR .FUZZ .PRE>>
 124                    <==? .COD ,MFIRST-CODE>
 125                    <==? <NODE-SUBR <1 .K>> 5>>
 126               <SET IOFF <+ .IOFF 4>>)>
 127        <AND .FL <VARMAP .K <OR .GMF .OFUZZ>>>
 128        <SET FUZZ <OR .FUZZ <AND <NODE-NAME <1 .K>> <N==? .COD ,MFIRST-CODE>>>>
 129        <VAR-ANA <2 .K>>
 130        <SET FUZZ .OFUZZ>
 131        <OR .FL <VARMAP .K .OFUZZ>>>)
 132     (<==? .COD ,STACKFORM-CODE>
 133      <VAR-ANA <1 <SET K <KIDS .N>>>>
 134      <SET OFUZZ .FUZZ>
 135      <SET FUZZ T>
 136      <VAR-ANA <2 .K>>
 137      <VAR-ANA <3 .K>>
 138      <SET FUZZ .OFUZZ>)
 139     (<OR <==? .COD ,PROG-CODE> <==? .COD ,MFCN-CODE>> <PROG-REP-VAR .N .OFUZZ>)
 140     (<OR <==? .COD ,SUBR-CODE>
 141          <==? .COD ,COPY-CODE>
 142          <AND <==? .COD ,ISUBR-CODE> <==? <4 <GET-TMP <NODE-SUBR .N>>> STACK>>
 143          <AND <==? .COD ,RSUBR-CODE>
 144               <OR <AND <TYPE? <NODE-SUBR .N> FUNCTION>
 145                        <SET ACST <ACS <SET RN <GET <NODE-NAME .N> .IND>>>>
 146                        <OR <ASSIGNED? GROUP-NAME> <==? .FCN .RN>>
 147                        <=? .ACST '(STACK)>>
 148                   <TYPE? <NODE-SUBR .N> RSUBR RSUBR-ENTRY>>>>
 149      <MAPF <>
 150            <FUNCTION (N)
 151                    #DECL ((N) NODE (IOFF) FIX)
 152                    <OR <VAR-ANA .N> .OFUZZ .PRE <SET IOFF <+ .IOFF 2>>>>
 153            <KIDS .N>>)
 154     (<OR <==? .COD ,ISTRUC-CODE> <==? .COD ,ISTRUC2-CODE>>
 155      <VAR-ANA <1 <KIDS .N>>>
 156      <OR .PRE
 157          .OFUZZ
 158          <SET IOFF <+ .IOFF <COND (<==? <NODE-SUBR .N> ,ISTRING> 2) (ELSE 4)>>>>
 159      <MAPF <> ,VAR-ANA <REST <KIDS .N>>>)
 160     (<==? .COD ,UNWIND-CODE>
 161      <OR .PRE .OFUZZ <SET IOFF <+ .IOFF 10>>>
 162      <VAR-ANA <1 <KIDS .N>>>
 163      <VAR-ANA <2 <KIDS .N>>>)
 164     (ELSE
 165      <AND <==? <NODE-TYPE .N> ,BRANCH-CODE> <VAR-ANA <PREDIC .N>>>
 166      <MAPF <> ,VAR-ANA <KIDS .N>>)>
 167    <SET IOFF .SIOFF>
 168    <==? <NODE-TYPE .N> ,SEGMENT-CODE>>
 169
 170 <DEFINE VARMAP (K OFUZZ)
 171         #DECL ((K) <LIST [REST NODE]> (OFUZZ) ANY)
 172         <MAPF <>
 173               <FUNCTION (N)
 174                       #DECL ((N) NODE (IOFF) FIX)
 175                       <VAR-ANA .N>
 176                       <OR .PRE .OFUZZ <SET IOFF <+ .IOFF 2>>>>
 177               <REST .K 2>>>
 178
 179 <DEFINE PROG-REP-VAR (PNOD FUZZ
 180                       "AUX" (BST <BINDING-STRUCTURE .PNOD>) (SVIOFF .SVIOFF)
 181                             (USOFF .USOFF) (IOFF .IOFF) (NOA <>)
 182                             (PROG-REP
 183                              <OR <==? <NODE-SUBR .PNOD> ,PROG>
 184                                  <==? <NODE-SUBR .PNOD> ,REPEAT>>))
 185         #DECL ((PNOD) <SPECIAL NODE> (FUZZ NOA) <SPECIAL ANY>
 186                (BST) <LIST [REST SYMTAB]> (SVIOFF USOFF IOFF) <SPECIAL FIX>)
 187         <COND (<OR <ACTIV? .BST .NOACT> <ACTIVATED .PNOD>>
 188                <AND .NOACT <PROG ()
 189                                  <SET NOACT <>>
 190                                  <AGAIN .REVAR>>>
 191                <PUT .PNOD ,ACTIVATED T>
 192                <AND .FUZZ
 193                     <NOT .PRE>
 194                     <SET PRE T>
 195                     <OR <ASSIGNED? INARG> .UNPRE>
 196                     <NOT .BPRE>
 197                     <SET BPRE T>
 198                     <NOT <SET UNPRE <>>>
 199                     <AGAIN .REVAR>>
 200                <AND .PRE
 201                     .NOA
 202                     .NNEW
 203                     <PUT .BASEF ,ACS (FUNNY-STACK)>
 204                     <AGAIN .REVAR>>
 205                <PROG REVAR ((BPRE <>) (UNPRE <>) (OG .GFRMID) (OV .VERBOSE)
 206                             (NNEW <>))
 207                      #DECL ((REVAR BPRE NNEW UNPRE) <SPECIAL ANY>)
 208                      <COND (.VERBOSE <PUTREST <SET VERBOSE .OV> ()>)>
 209                      <SET GFRMID .OG>
 210                      <SET NOA <>>
 211                      <COND (.VERBOSE
 212                             <ADDVMESS .PNOD ("Internal FRAME generated.")>)>
 213                      <FUNC-VAR .PNOD>>)
 214               (ELSE
 215                <COND (<OR .PRE .FUZZ>
 216                       <AND <NOT .PRE>
 217                            <OR <ASSIGNED? INARG> .UNPRE>
 218                            <NOT .BPRE>
 219                            <SET BPRE T>
 220                            <NOT <SET UNPRE <>>>
 221                            <AGAIN .REVAR>>
 222                       <SET PRE T>
 223                       <OR <ASSIGNED? INARG> <SET IOFF .SVIOFF>>
 224                       <PUT .PNOD ,SPECS-START <+ .IOFF .USOFF>>
 225                       <PUT .PNOD ,USLOTS <+ .IOFF .USOFF>>
 226                       <PUT .PNOD ,BINDING-STRUCTURE <DOUNREG .BST .BST .BST T>>
 227                       <MAPF <> ,VAR-ANA <KIDS .PNOD>>
 228                       <AND <ASSIGNED? INARG> <SET IOFF .SVIOFF>>
 229                       <AND <G? .USOFF .HSLOT> <SET HSLOT .USOFF>>)
 230                      (ELSE
 231                       <PROG ((BASEF .PNOD) (HSLOT 0) (PRE <>))
 232                             #DECL ((BASEF) <SPECIAL NODE> (PRE) <SPECIAL ANY>
 233                                    (HSLOT) <SPECIAL FIX>)
 234                             <PUT .BASEF ,BINDING-STRUCTURE <DOREG .BST T>>
 235                             <SET SVIOFF .IOFF>
 236                             <AND .PRE <G? .USOFF .HSLOT> <SET HSLOT .USOFF>>
 237                             <MAPF <> ,VAR-ANA <KIDS .BASEF>>
 238                             <COND (<AND .PRE .UNPRE>
 239                                    <SET BPRE T>
 240                                    <SET UNPRE <>>
 241                                    <AGAIN .REVAR>)
 242                                   (<NOT .BPRE> <SET UNPRE T>)>
 243                             <COND (.PRE
 244                                    <AND <G? .USOFF .HSLOT> <SET HSLOT .USOFF>>
 245                                    <PUT .BASEF
 246                                         ,SSLOTS
 247                                         <COND (<0? .HSLOT> -1)
 248                                               (ELSE .HSLOT)>>)>>)>)>>
 249
 250 <DEFINE ARG? (SYM) #DECL ((SYM) SYMTAB) <1? <NTH ,ARGTBL <CODE-SYM .SYM>>>>
 251
 252 <SETG ARGTBL ![0 0 0 0 1 0 0 0 0 1 0 1 1!]>
 253
 254 <DEFINE ACTIV? (BST NOACT)
 255         #DECL ((BST) <LIST [REST SYMTAB]>)
 256         <REPEAT ()
 257                 <AND <EMPTY? .BST> <RETURN <>>>
 258                 <AND <==? <CODE-SYM <1 .BST>> 1>
 259                      <OR <NOT .NOACT>
 260                          <NOT <RET-AGAIN-ONLY <1 .BST>>>
 261                          <SPEC-SYM <1 .BST>>>
 262                      <RETURN T>>
 263                 <SET BST <REST .BST>>>>
 264
 265 <DEFINE INITV? (SYM)
 266         #DECL ((SYM) SYMTAB)
 267         <1? <NTH '![0 1 0 0 0 1 1 0 0 0 0 0 0!] <CODE-SYM .SYM>>>>
 268
 269 <DEFINE NONARG (SYM)
 270         #DECL ((SYM) SYMTAB)
 271         <1? <NTH '![1 1 1 0 0 0 0 0 0 0 1 0 0!] <CODE-SYM .SYM>>>>
 272
 273 <DEFINE TUPLE? (TUP-NOD)
 274         <AND .TUP-NOD
 275              <OR <==? <NODE-NAME .TUP-NOD> ITUPLE>
 276                  <==? <NODE-NAME .TUP-NOD> TUPLE>>>>
 277
 278 <DEFINE GOOD-TUPLE (TUP "AUX" (K <KIDS .TUP>) NT (WD 0))
 279         #DECL ((NT) FIX (TUP) NODE (K) <LIST [REST NODE]>)
 280         <AND <NOT <==? <NODE-TYPE .TUP> ,ISTRUC-CODE>>
 281              <COND (<==? <NODE-SUBR .TUP> ,ITUPLE>
 282                     <AND <==? <NODE-TYPE <1 .K>> ,QUOTE-CODE>
 283                          <OR <==? <SET NT <NODE-TYPE <2 .K>>> ,QUOTE-CODE>
 284                              <==? .NT ,FLVAL-CODE>
 285                              <==? .NT ,FGVAL-CODE>
 286                              <==? .NT ,GVAL-CODE>
 287                              <==? .NT ,LVAL-CODE>>
 288                          <* <NODE-NAME <1 .K>> 2>>)
 289                    (ELSE
 290                     <MAPF <>
 291                           <FUNCTION (K)
 292                                   <COND (<==? <NODE-TYPE .K> ,SEGMENT-CODE>
 293                                          <MAPLEAVE <>>)
 294                                         (ELSE <SET WD <+ .WD 2>>)>>
 295                           .K>)>>>
 296
 297 <DEFINE DOREG (BST
 298                "OPTIONAL" (HACK-INITS <>)
 299                "AUX" TUP SYM COD (RQRG 0) (TRG 0) (COOL <AND .NOA <NOT .ACC>>)
 300                      (INARG T) INIT-LIST)
 301    #DECL ((BST) <LIST [REST SYMTAB]> (SYM) SYMTAB (COD IOFF RQRG TRG) FIX
 302           (BASEF) NODE (INARG) <SPECIAL ANY> (INIT-LIST) LIST)
 303    <COND (<AND <ASSIGNED? GMF> .GMF <L=? .GMF 0>> <SET HACK-INITS <>>)>
 304    <COND (<==? <NODE-TYPE .BASEF> ,FUNCTION-CODE>
 305           <SET RQRG <REQARGS .BASEF>>
 306           <SET TRG <TOTARGS .BASEF>>)>
 307    <COND
 308     (.HACK-INITS
 309      <SET INIT-LIST
 310       <MAPF ,LIST
 311        <FUNCTION (SYM)
 312           #DECL ((SYM) SYMTAB)
 313           <COND
 314            (<OR
 315              <AND <ASSIGNED? GMF> .GMF <==? <NAME-SYM .SYM> DUMMY-MAPF>>
 316              <AND
 317               <OR <INIT-SYM .SYM> <==? <CODE-SYM .SYM> 13>>
 318               <NOT <ASS? .SYM>>
 319               <NOT <SPEC-SYM .SYM>>
 320               <ISTYPE-GOOD?
 321                <COND (<COMPOSIT-TYPE .SYM>
 322                       <TYPE-AND <1 <DECL-SYM .SYM>> <COMPOSIT-TYPE .SYM>>)
 323                      (<1 <DECL-SYM .SYM>>)>>
 324               <USAGE-SYM .SYM>
 325               <NOT <0? <USAGE-SYM .SYM>>>>>
 326             <MAPRET .SYM>)
 327            (<MAPRET>)>>
 328        .BST>>
 329      <REPEAT ((L <LENGTH .INIT-LIST>) (REMPTR .INIT-LIST)
 330               (NA <COND (<AND <ASSIGNED? GMF> .GMF> .GMF) (ELSE ,NUMACS)>))
 331              #DECL ((L NA) FIX (REMPTR) LIST)
 332              <COND (<L? .L .NA> <RETURN>)>
 333              <REPEAT ((PTR .INIT-LIST) (MIN-CNT <CHTYPE <MIN> FIX>) SYM)
 334                      <SET SYM <1 .PTR>>
 335                      <COND (<L? <USAGE-SYM .SYM> .MIN-CNT>
 336                             <SET MIN-CNT <USAGE-SYM .SYM>>
 337                             <RETURN>)>
 338                      <SET REMPTR <SET PTR <REST .PTR>>>>
 339              <SET L <- .L 1>>
 340              <COND (<==? .REMPTR .INIT-LIST> <SET INIT-LIST <REST .INIT-LIST>>)
 341                    (<PUTREST .REMPTR <REST .REMPTR 2>>)>>)>
 342    <REPEAT ((FB .BST) (PB .BST))
 343      <AND <EMPTY? .BST> <RETURN .FB>>
 344      <PUT <SET SYM <1 .BST>> ,CODE-SYM <SET COD <ABS <CODE-SYM .SYM>>>>
 345      <COND
 346       (<AND <COMPOSIT-TYPE .SYM> <N==? <COMPOSIT-TYPE .SYM> T>>
 347        <COND
 348         (<NOT <SPEC-SYM .SYM>>
 349          <COND (<NOT <ASS? .SYM>>
 350                 <PUT .SYM
 351                      ,COMPOSIT-TYPE
 352                      <TYPE-AND '<NOT UNBOUND> <COMPOSIT-TYPE .SYM>>>)>
 353          <SET DC <1 <DECL-SYM .SYM>>>
 354          <PUT .SYM ,DECL-SYM (<TYPE-AND <COMPOSIT-TYPE .SYM> .DC>)>
 355          <COND (<AND .VERBOSE
 356                      <N==? <COMPOSIT-TYPE .SYM> T>
 357                      <N==? <COMPOSIT-TYPE .SYM> NO-RETURN>
 358                      <NOT <SAME-DECL?
 359                            <TYPE-AND .DC <COMPOSIT-TYPE .SYM>> .DC>>>
 360                 <VMESS "Computed decl of variable:  "
 361                        <NAME-SYM .SYM>
 362                        " is:  "
 363                        <COMPOSIT-TYPE .SYM>>)>)>
 364        <PUT .SYM ,COMPOSIT-TYPE T>)>
 365      <PUT .SYM ,CURRENT-TYPE <>>
 366      <COND
 367       (<NOT <OR <AND <1? <CODE-SYM .SYM>>
 368                      <NOT <SPEC-SYM .SYM>>
 369                      <RET-AGAIN-ONLY .SYM>
 370                      <NOT <ACTIVATED .BASEF>>>
 371                 <AND <NOT <USED-AT-ALL .SYM>>
 372                      <PROG ()
 373                            <PUT .SYM ,USED-AT-ALL T>
 374                            <COND (<SPEC-SYM .SYM>
 375                                   <MESSAGE NOTE
 376                                            "Special variable never used: "
 377                                            <NAME-SYM .SYM>>)
 378                                  (ELSE
 379                                   <MESSAGE WARNING
 380                                            "VARIABLE NEVER USED: "
 381                                            <NAME-SYM .SYM>>)>
 382                            T>
 383                      <NONARG .SYM>
 384                      <NOT <SPEC-SYM .SYM>>
 385                      <NOT <INIT-SYM .SYM>>
 386                      <PURE-SYM .SYM>
 387                      <SET FB <FLUSH-SYM .BST <SET BST .PB> .FB>>>>>
 388        <COND (<SPEC-SYM .SYM>
 389               <PUT .SYM ,ADDR-SYM <+ .USOFF .IOFF 2>>
 390               <AND <OR <NONARG .SYM> <ASSIGNED? PNOD>>
 391                    <PUT .SYM ,ARGNUM-SYM <TMPLS .BASEF>>>
 392               <SET USOFF <+ .USOFF 6>>)>
 393        <COND (<INITV? .SYM>
 394               <COND (<TUPLE? <INIT-SYM .SYM>>
 395                      <COND (<AND <NOT <OR <==? <CODE-SYM .SYM> 7>
 396                                           <==? <CODE-SYM .SYM> 8>
 397                                           <==? <CODE-SYM .SYM> 9>
 398                                           <SPEC-SYM .SYM>>>
 399                                  <SET TUP <GOOD-TUPLE <INIT-SYM .SYM>>>>
 400                             <SET IOFF <+ .IOFF .TUP 2>>)
 401                            (ELSE
 402                             <SET PRE T>
 403                             <COND (<ACS .FCN>
 404                                    <PUT .FCN ,ACS <CHTYPE (<ACS .FCN>) FALSE>>
 405                                    <AGAIN .REVAR>)>
 406                             <RETURN <DOUNREG .BST .FB .PB .HACK-INITS>>)>)>
 407               <COND (<SPEC-SYM .SYM>
 408                      <SET IOFF <+ .IOFF 2>>
 409                      <VAR-ANA <INIT-SYM .SYM>>
 410                      <SET IOFF <- .IOFF 2>>)
 411                     (ELSE <VAR-ANA <INIT-SYM .SYM>>)>
 412               <COND (.PRE
 413                      <OR <SPEC-SYM .SYM> <SET USOFF <+ .USOFF 2>>>
 414                      <SET COD <- .COD>>)>)>
 415        <COND (<AND .ACC <NOT .LARG> <NONARG .SYM>> <SET LARG T>)>
 416        <COND (<AND <NOT .NOA>
 417                    <ARG? .SYM>
 418                    <NOT <SPEC-SYM .SYM>>
 419                    <PURE-SYM .SYM>>
 420               <PUT .SYM ,ADDR-SYM <REFERENCE:ARG <ARGNUM-SYM .SYM>>>)
 421              (<AND .COOL <NOT <NONARG .SYM>> <NOT <SPEC-SYM .SYM>>>
 422               <PUT .SYM ,FRMNO .FRMID>
 423               <PUT .SYM
 424                    ,ADDR-SYM
 425                    <COND (<=? .NOA '(FUNNY-STACK)>
 426                           <- -2 <* <- <TOTARGS .FCN> <ARGNUM-SYM .SYM>> 2>>)
 427                          (ELSE <* 2 <- <ARGNUM-SYM .SYM> 1>>)>>)
 428              (<AND <TUPLE? <INIT-SYM .SYM>> <NOT .TUP>>
 429               <SET PRE T>
 430               <COND (<ACS .FCN>
 431                      <PUT .FCN ,ACS <CHTYPE (<ACS .FCN>) FALSE>>
 432                      <AGAIN .REVAR>)>
 433               <RETURN <DOUNREG .BST .FB .PB .HACK-INITS>>)
 434              (ELSE
 435               <PUT .SYM ,FRMNO .FRMID>
 436               <COND (<AND <OR <==? <CODE-SYM .SYM> 2>
 437                               <==? <CODE-SYM .SYM> 3>
 438                               <==? <CODE-SYM .SYM> 13>>
 439                           <NOT <SPEC-SYM .SYM>>
 440                           <NOT <ASS? .SYM>>
 441                           <OR <==? <CODE-SYM .SYM> 3>
 442                               <AND .HACK-INITS <MEMQ .SYM .INIT-LIST>>>>
 443                      <PUT .SYM ,ADDR-SYM ,TEMPSTRT>)
 444                     (ELSE
 445                      <PUT .SYM
 446                           ,ADDR-SYM
 447                           <+ .IOFF <COND (<SPEC-SYM .SYM> 2) (ELSE 0)>>>
 448                      <AND <OR <NONARG .SYM> <ASSIGNED? PNOD>>
 449                           <PUT .SYM ,ARGNUM-SYM <TMPLS .BASEF>>>
 450                      <OR .PRE
 451                          <SET IOFF
 452                               <+ .IOFF
 453                                  <COND (<SPEC-SYM .SYM> 6) (ELSE 2)>>>>)>)>)>
 454      <SET BST <REST <SET PB .BST>>>
 455      <PUT .SYM ,CODE-SYM .COD>
 456      <COND (.PRE <RETURN <DOUNREG .BST .FB .PB .HACK-INITS>>)>>>
 457
 458 <DEFINE DOUNREG (BST FB PB
 459                  "OPTIONAL" (HACK-INITS <>)
 460                  "AUX" SYM (INARG T) INIT-LIST)
 461    #DECL ((BST) <LIST [REST SYMTAB]> (SYM) SYMTAB (USOFF IOFF) FIX
 462           (INARG) <SPECIAL ANY> (INIT-LIST) LIST)
 463    <COND (<AND <ASSIGNED? GMF> .GMF <L=? .GMF 0>> <SET HACK-INITS <>>)>
 464    <COND
 465     (.HACK-INITS
 466      <SET INIT-LIST
 467       <MAPF ,LIST
 468        <FUNCTION (SYM)
 469           #DECL ((SYM) SYMTAB)
 470           <COND
 471            (<AND <INIT-SYM .SYM>
 472                  <NOT <ASS? .SYM>>
 473                  <NOT <SPEC-SYM .SYM>>
 474                  <ISTYPE-GOOD?
 475                   <COND (<COMPOSIT-TYPE .SYM>
 476                          <TYPE-AND <1 <DECL-SYM .SYM>> <COMPOSIT-TYPE .SYM>>)
 477                         (<1 <DECL-SYM .SYM>>)>>
 478                  <USAGE-SYM .SYM>
 479                  <NOT <0? <USAGE-SYM .SYM>>>>
 480             <MAPRET .SYM>)
 481            (<MAPRET>)>>
 482        .BST>>
 483      <REPEAT ((L <LENGTH .INIT-LIST>) (REMPTR .INIT-LIST)
 484               (NA <COND (<AND <ASSIGNED? GMF> .GMF> .GMF) (ELSE 5)>))
 485              #DECL ((L NA) FIX (REMPTR) LIST)
 486              <COND (<L? .L .NA> <RETURN>)>
 487              <REPEAT ((PTR .INIT-LIST) (MIN-CNT <CHTYPE <MIN> FIX>) SYM)
 488                      <SET SYM <1 .PTR>>
 489                      <COND (<L? <USAGE-SYM .SYM> .MIN-CNT>
 490                             <SET MIN-CNT <USAGE-SYM .SYM>>
 491                             <RETURN>)>
 492                      <SET REMPTR <SET PTR <REST .PTR>>>>
 493              <SET L <- .L 1>>
 494              <COND (<==? .REMPTR .INIT-LIST> <SET INIT-LIST <REST .INIT-LIST>>)
 495                    (<PUTREST .REMPTR <REST .REMPTR 2>>)>>)>
 496    <PROG ()
 497      <AND <EMPTY? .BST> <RETURN .FB>>
 498      <REPEAT ((BST .BST))
 499        <COND
 500         (<AND <COMPOSIT-TYPE <SET SYM <1 .BST>>> <N==? <COMPOSIT-TYPE .SYM> T>>
 501          <COND
 502           (<NOT <SPEC-SYM .SYM>>
 503            <COND (<NOT <ASS? .SYM>>
 504                   <PUT .SYM
 505                        ,COMPOSIT-TYPE
 506                        <TYPE-AND '<NOT UNBOUND> <COMPOSIT-TYPE .SYM>>>)>
 507            <SET DC <1 <DECL-SYM .SYM>>>
 508            <PUT .SYM ,DECL-SYM (<TYPE-AND <COMPOSIT-TYPE .SYM> .DC>)>
 509            <COND
 510             (<AND .VERBOSE
 511                   <N==? <COMPOSIT-TYPE .SYM> T>
 512                   <N==? <COMPOSIT-TYPE .SYM> NO-RETURN>
 513                   <NOT <SAME-DECL? <TYPE-AND .DC <COMPOSIT-TYPE .SYM>> .DC>>>
 514              <VMESS "Computed decl of variable:  "
 515                     <NAME-SYM .SYM>
 516                     " is:  "
 517                     <COMPOSIT-TYPE .SYM>>)>)>
 518          <PUT .SYM ,COMPOSIT-TYPE T>)>
 519        <PUT .SYM ,CURRENT-TYPE <>>
 520        <PUT .SYM ,FRMNO .FRMID>
 521        <COND (<NOT <OR <AND <1? <CODE-SYM .SYM>>
 522                             <NOT <SPEC-SYM .SYM>>
 523                             <RET-AGAIN-ONLY .SYM>
 524                             <NOT <ACTIVATED .BASEF>>>
 525                        <AND <NOT <USED-AT-ALL .SYM>>
 526                             <PROG ()
 527                                   <PUT .SYM ,USED-AT-ALL T>
 528                                   <COND (<SPEC-SYM .SYM>
 529                                          <MESSAGE NOTE
 530
 531 "Special variable never used: "
 532                                                   <NAME-SYM .SYM>>)
 533                                         (ELSE
 534                                          <MESSAGE WARNING
 535                                                   "VARIABLE NEVER USED: "
 536                                                   <NAME-SYM .SYM>>)>
 537                                   T>
 538                             <NONARG .SYM>
 539                             <NOT <SPEC-SYM .SYM>>
 540                             <NOT <INIT-SYM .SYM>>
 541                             <PURE-SYM .SYM>
 542                             <SET FB <FLUSH-SYM .BST <SET BST .PB> .FB>>>>>
 543               <AND <INITV? .SYM> <VAR-ANA <INIT-SYM .SYM>>>
 544               <COND (<OR <AND <ASSIGNED? GMF>
 545                               .GMF
 546                               <==? <NAME-SYM .SYM> DUMMY-MAPF>>
 547                          <AND .NOACT
 548                               <OR <==? <CODE-SYM .SYM> 3>
 549                                   <==? <CODE-SYM .SYM> 2>
 550                                   <==? <CODE-SYM .SYM> 13>>
 551                               <NOT <SPEC-SYM .SYM>>
 552                               <NOT <ASS? .SYM>>
 553                               <OR <==? <CODE-SYM .SYM> 3>
 554                                   <AND .HACK-INITS <MEMQ .SYM .INIT-LIST>>>>>
 555                      <PUT .SYM ,ADDR-SYM ,TEMPSTRT>)
 556                     (ELSE
 557                      <PUT .SYM
 558                           ,ADDR-SYM
 559                           <+ .IOFF .USOFF <COND (<SPEC-SYM .SYM> 2) (ELSE 0)>>>
 560                      <AND <OR <NONARG .SYM> <ASSIGNED? PNOD>>
 561                           <PUT .SYM ,ARGNUM-SYM <TMPLS .BASEF>>>
 562                      <SET USOFF
 563                           <+ .USOFF <COND (<SPEC-SYM .SYM> 6) (ELSE 2)>>>)>)>
 564        <AND <EMPTY? <SET BST <REST <SET PB .BST>>>> <RETURN .FB>>>>>
 565
 566 <DEFINE FLUSH-SYM (B P F)
 567         #DECL ((B P F) <LIST [REST SYMTAB]>)
 568         <COND (<==? .B .F> <REST .B>)
 569               (ELSE <PUTREST .P <REST .B>> .F)>>
 570
 571 <DEFINE AP? (N "AUX" AT)
 572         #DECL ((N) NODE)
 573         <AND <==? <NODE-TYPE .N> ,GVAL-CODE>
 574              <==? <NODE-TYPE <SET N <1 <KIDS .N>>>> ,QUOTE-CODE>
 575              <SET AT <NODE-NAME .N>>
 576              <OR .REASONABLE
 577                  <AND <GASSIGNED? .AT> <TYPE? ,.AT SUBR RSUBR RSUBR-ENTRY>>
 578                  <AND <GASSIGNED? .AT>
 579                       <TYPE? ,.AT FUNCTION>
 580                       <OR <==? .AT .FCNS>
 581                           <AND <TYPE? .FCNS LIST> <MEMQ .AT .FCNS>>>>>
 582              .AT>>
 583
 584
 585 <DEFINE REFERENCE:ARG (NUMBER "AUX" TEM)
 586         #DECL ((VALUE) <DATUM ADDRESS:C ADDRESS:C> (NUMBER) FIX)
 587         <SET TEM <ADDRESS:C `(AB)  <* 2 <- .NUMBER 1>>>>
 588         <DATUM .TEM .TEM>>
 589 \f
 590
 591 <DEFINE GET-TMP (SUB "AUX" (LS <MEMQ .SUB ,SUBRS>))
 592         #DECL ((VALUE) <LIST ANY ANY>)
 593         <COND (.LS <NTH ,TEMPLATES <LENGTH .LS>>)
 594               (ELSE '(ANY ANY))>>
 595
 596 <DEFINE SAME-DECL? (D1 D2) <OR <=? .D1 .D2> <NOT <TYPE-OK? .D2 <NOTIFY .D1>>>>>
 597
 598 <DEFINE NOTIFY (D)
 599         <COND (<AND <TYPE? .D FORM> <==? <LENGTH .D> 2> <==? <1 .D> NOT>>
 600                <2 .D>)
 601               (ELSE <FORM NOT .D>)>>
 602
 603 <ENDPACKAGE>