BSD 4_4 release
[unix-history] / usr / src / usr.bin / pascal / src / flvalue.c
index 2b1e49a..9705a8e 100644 (file)
@@ -1,25 +1,51 @@
-/* Copyright (c) 1980 Regents of the University of California */
+/*-
+ * Copyright (c) 1980, 1993
+ *     The Regents of the University of California.  All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in the
+ *    documentation and/or other materials provided with the distribution.
+ * 3. All advertising materials mentioning features or use of this software
+ *    must display the following acknowledgement:
+ *     This product includes software developed by the University of
+ *     California, Berkeley and its contributors.
+ * 4. Neither the name of the University nor the names of its contributors
+ *    may be used to endorse or promote products derived from this software
+ *    without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
 
 
-static char sccsid[] = "@(#)flvalue.c 1.2 %G%";
+#ifndef lint
+static char sccsid[] = "@(#)flvalue.c  8.1 (Berkeley) 6/6/93";
+#endif /* not lint */
 
 #include "whoami.h"
 #include "0.h"
 #include "tree.h"
 #include "opcode.h"
 #include "objfmt.h"
 
 #include "whoami.h"
 #include "0.h"
 #include "tree.h"
 #include "opcode.h"
 #include "objfmt.h"
+#include "tree_ty.h"
 #ifdef PC
 #   include "pc.h"
 #ifdef PC
 #   include "pc.h"
-#   include "pcops.h"
+#   include <pcc.h>
 #endif PC
 #endif PC
-#ifdef OBJ
-/*
- * define the display structure for purposes of allocating
- * a temporary
- */
-struct dispsave {
-       char    *ptr;
-};
-#endif OBJ
+#include "tmps.h"
 
     /*
      * flvalue generates the code to either pass on a formal routine,
 
     /*
      * flvalue generates the code to either pass on a formal routine,
@@ -28,106 +54,86 @@ struct dispsave {
      */
 struct nl *
 flvalue( r , formalp )
      */
 struct nl *
 flvalue( r , formalp )
-    int                *r;
+    struct tnode *r;   /* T_VAR */
     struct nl  *formalp;
     {
        struct nl       *p;
     struct nl  *formalp;
     {
        struct nl       *p;
-       long            tempoff;
+       struct nl       *tempnlp;
        char            *typename;
        char            *typename;
+#ifdef PC
+       char            extname[ BUFSIZ ];
+#endif PC
 
 
-       if ( r == NIL ) {
-           return NIL;
+       if ( r == TR_NIL ) {
+           return NLNIL;
        }
        typename = formalp -> class == FFUNC ? "function":"procedure";
        }
        typename = formalp -> class == FFUNC ? "function":"procedure";
-       if ( r[0] != T_VAR ) {
+       if ( r->tag != T_VAR ) {
            error("Expression given, %s required for %s parameter %s" ,
                    typename , typename , formalp -> symbol );
            error("Expression given, %s required for %s parameter %s" ,
                    typename , typename , formalp -> symbol );
-           return NIL;
+           return NLNIL;
        }
        }
-       p = lookup(r[2]);
-       if (p == NIL) {
-           return NIL;
+       p = lookup(r->var_node.cptr);
+       if (p == NLNIL) {
+           return NLNIL;
        }
        switch ( p -> class ) {
            case FFUNC:
            case FPROC:
        }
        switch ( p -> class ) {
            case FFUNC:
            case FPROC:
-                   if ( r[3] != NIL ) {
+                   if ( r->var_node.qual != TR_NIL ) {
                        error("Formal %s %s cannot be qualified" ,
                                typename , p -> symbol );
                        error("Formal %s %s cannot be qualified" ,
                                typename , p -> symbol );
-                       return NIL;
+                       return NLNIL;
                    }
 #                  ifdef OBJ
                    }
 #                  ifdef OBJ
-                       put( 2 , PTR_RV | bn << 8+INDX , p -> value[NL_OFFS] );
+                       (void) put(2, PTR_RV | bn << 8+INDX, (int)p->value[NL_OFFS]);
 #                  endif OBJ
 #                  ifdef PC
                        putRV( p -> symbol , bn , p -> value[ NL_OFFS ] , 
 #                  endif OBJ
 #                  ifdef PC
                        putRV( p -> symbol , bn , p -> value[ NL_OFFS ] , 
+                               p -> extra_flags ,
                                p2type( p ) );
 #                  endif PC
                                p2type( p ) );
 #                  endif PC
-                   return p -> type;
+                   return p;
            case FUNC:
            case PROC:
            case FUNC:
            case PROC:
-                   if ( r[3] != NIL ) {
+                   if ( r->var_node.qual != TR_NIL ) {
                        error("%s %s cannot be qualified" , typename ,
                                p -> symbol );
                        error("%s %s cannot be qualified" , typename ,
                                p -> symbol );
-                       return NIL;
+                       return NLNIL;
                    }
                    if (bn == 0) {
                        error("Built-in %s %s cannot be passed as a parameter" ,
                                typename , p -> symbol );
                    }
                    if (bn == 0) {
                        error("Built-in %s %s cannot be passed as a parameter" ,
                                typename , p -> symbol );
-                       return NIL;
+                       return NLNIL;
                    }
                        /*
                    }
                        /*
-                        *      formal routine structure:
-                        *
-                        *      struct formalrtn {
-                        *              long            (*entryaddr)();
-                        *              long            cbn;
-                        *              struct dispsave disp[2*MAXLVL];
-                        *      };
+                        *      allocate space for the thunk
                         */
                         */
-                   sizes[ cbn ].om_off -=        sizeof (long (*)())
-                                               + sizeof (long)
-                                               + 2*bn*sizeof (struct dispsave);
-                   tempoff = sizes[ cbn ].om_off;
-                   if ( sizes[ cbn ].om_off < sizes[ cbn ].om_max ) {
-                       sizes[ cbn ].om_max = tempoff;
-                   }
+                   tempnlp = tmpalloc((long) (sizeof(struct formalrtn)), NLNIL, NOREG);
 #                  ifdef OBJ
 #                  ifdef OBJ
-                       put( 2 , O_LV | cbn << 8 + INDX , tempoff );
-                       put( 2 , O_FSAV | bn << 8 + INDX , p -> entloc );
+                       (void) put(2 , O_LV | cbn << 8 + INDX ,
+                               (int)tempnlp -> value[ NL_OFFS ] );
+                       (void) put(2, O_FSAV | bn << 8, (long)p->value[NL_ENTLOC]);
 #                  endif OBJ
 #                  ifdef PC
 #                  endif OBJ
 #                  ifdef PC
-                       putlbracket( ftnno , -tempoff );
-                       putleaf( P2ICON , 0 , 0 ,
-                           ADDTYPE( P2PTR , ADDTYPE( P2FTN , P2PTR|P2STRTY ) ) ,
+                       putleaf( PCC_ICON , 0 , 0 ,
+                           PCCM_ADDTYPE( PCCTM_PTR , PCCM_ADDTYPE( PCCTM_FTN , PCCTM_PTR|PCCT_STRTY ) ) ,
                            "_FSAV" );
                            "_FSAV" );
-                       {
-                           char        extname[ BUFSIZ ];
-                           char        *starthere;
-                           int         i;
-
-                           starthere = &extname[0];
-                           for ( i = 1 ; i < bn ; i++ ) {
-                               sprintf( starthere , EXTFORMAT , enclosing[ i ] );
-                               starthere += strlen( enclosing[ i ] ) + 1;
-                           }
-                           sprintf( starthere , EXTFORMAT , p -> symbol );
-                           starthere += strlen( p -> symbol ) + 1;
-                           if ( starthere >= &extname[ BUFSIZ ] ) {
-                               panic( "flvalue namelength" );
-                           }
-                           putleaf( P2ICON , 0 , 0 , p2type( p ) , extname );
-                       }
-                       putleaf( P2ICON , bn , 0 , P2INT , 0 );
-                       putop( P2LISTOP , P2INT );
-                       putLV( 0 , cbn , tempoff , P2STRTY );
-                       putop( P2LISTOP , P2INT );
-                       putop( P2CALL , P2PTR | P2STRTY );
+                       sprintf( extname , "%s" , FORMALPREFIX );
+                       sextname( &extname[ strlen( extname ) ] ,
+                                   p -> symbol , bn );
+                       putleaf( PCC_ICON , 0 , 0 , p2type( p ) , extname );
+                       putleaf( PCC_ICON , bn , 0 , PCCT_INT , (char *) 0 );
+                       putop( PCC_CM , PCCT_INT );
+                       putLV( (char *) 0 , cbn , tempnlp -> value[NL_OFFS] ,
+                               tempnlp -> extra_flags , PCCT_STRTY );
+                       putop( PCC_CM , PCCT_INT );
+                       putop( PCC_CALL , PCCTM_PTR | PCCT_STRTY );
 #                  endif PC
 #                  endif PC
-                   return p -> type;
+                   return p;
            default:
                    error("Variable given, %s required for %s parameter %s" ,
                            typename , typename , formalp -> symbol );
            default:
                    error("Variable given, %s required for %s parameter %s" ,
                            typename , typename , formalp -> symbol );
-                   return NIL;
+                   return NLNIL;
        }
     }
        }
     }