mods for new formal routine syntax

SCCS-vsn: usr.bin/pascal/src/call.c 1.8
SCCS-vsn: usr.bin/pascal/src/error.c 1.3
SCCS-vsn: usr.bin/pascal/src/flvalue.c 1.7
SCCS-vsn: usr.bin/pascal/src/pas.y 1.4
SCCS-vsn: usr.bin/pascal/src/put.c 1.12
SCCS-vsn: usr.bin/pascal/src/pimakefile 1.17
SCCS-vsn: usr.bin/pascal/src/fhdr.c 1.2
SCCS-vsn: usr.bin/pascal/src/fend.c 1.3

diff --git a/usr/src/usr.bin/pascal/src/call.c b/usr/src/usr.bin/pascal/src/call.c
index 4dd5bd3..8abc727 100644 (file)
--- a/usr/src/usr.bin/pascal/src/call.c
+++ b/usr/src/usr.bin/pascal/src/call.c
@@ -1,6 +1,6 @@
 /* Copyright (c) 1979 Regents of the University of California */
 
 /* Copyright (c) 1979 Regents of the University of California */
 

-static char sccsid[] = "@(#)call.c 1.7 %G%";
+static char sccsid[] = "@(#)call.c 1.8 %G%";

 
 #include "whoami.h"
 #include "0.h"
 
 #include "whoami.h"
 #include "0.h"


@@ -52,10 +52,7 @@ call(p, argv, porf, psbn)
        register struct nl *p1, *q;
        int *r;
        struct nl       *p_type_class = classify( p -> type );
        register struct nl *p1, *q;
        int *r;
        struct nl       *p_type_class = classify( p -> type );

-
-#      ifdef OBJ
-           int         cnt;
-#      endif OBJ
+       bool chk = TRUE;

 #      ifdef PC
            long        p_p2type = p2type( p );
            long        p_type_p2type = p2type( p -> type );
 #      ifdef PC
            long        p_p2type = p2type( p );
            long        p_type_p2type = p2type( p -> type );


@@ -161,215 +158,139 @@ call(p, argv, porf, psbn)
         * arguments to the proc/func.
         *      ... ( ... args ... ) ...
         */
         * arguments to the proc/func.
         *      ... ( ... args ... ) ...
         */

-       if ( p -> class == FUNC || p -> class == PROC ) {
-           for (p1 = p->chain; p1 != NIL; p1 = p1->chain) {
-               if (argv == NIL) {
-                       error("Not enough arguments to %s", p->symbol);
-                       return (NIL);
-               }
-               switch (p1->class) {
-                   case REF:
-                           /*
-                            * Var parameter
-                            */
-                           r = argv[1];
-                           if (r != NIL && r[0] != T_VAR) {
-                                   error("Expression given (variable required) for var parameter %s of %s", p1->symbol, p->symbol);
-                                   break;
-                           }
-                           q = lvalue( (int *) argv[1], MOD , LREQ );
-                           if (q == NIL)
-                                   break;
-                           if (q != p1->type) {
-                                   error("Parameter type not identical to type of var parameter %s of %s", p1->symbol, p->symbol);
-                                   break;
-                           }
-                           break;
-                   case VAR:
-                           /*
-                            * Value parameter
-                            */
+       for (p1 = plist(p); p1 != NIL; p1 = p1->chain) {
+           if (argv == NIL) {
+                   error("Not enough arguments to %s", p->symbol);
+                   return (NIL);
+           }
+           switch (p1->class) {
+               case REF:
+                       /*
+                        * Var parameter
+                        */
+                       r = argv[1];
+                       if (r != NIL && r[0] != T_VAR) {
+                               error("Expression given (variable required) for var parameter %s of %s", p1->symbol, p->symbol);
+                               break;
+                       }
+                       q = lvalue( (int *) argv[1], MOD , LREQ );
+                       if (q == NIL) {
+                               chk = FALSE;
+                               break;
+                       }
+                       if (q != p1->type) {
+                               error("Parameter type not identical to type of var parameter %s of %s", p1->symbol, p->symbol);
+                               break;
+                       }
+                       break;
+               case VAR:
+                       /*
+                        * Value parameter
+                        */

 #                      ifdef OBJ
 #                      ifdef OBJ

-                               q = rvalue(argv[1], p1->type , RREQ );
+                           q = rvalue(argv[1], p1->type , RREQ );

 #                      endif OBJ
 #                      ifdef PC
 #                      endif OBJ
 #                      ifdef PC

-                                   /*
-                                    * structure arguments require lvalues,
-                                    * scalars use rvalue.
-                                    */
-                               switch( classify( p1 -> type ) ) {
-                                   case TFILE:
-                                   case TARY:
-                                   case TREC:
-                                   case TSET:
-                                   case TSTR:
-                                       q = rvalue( argv[1] , p1 -> type , LREQ );
-                                       break;
-                                   case TINT:
-                                   case TSCAL:
-                                   case TBOOL:
-                                   case TCHAR:
-                                       precheck( p1 -> type , "_RANG4" , "_RSNG4" );
-                                       q = rvalue( argv[1] , p1 -> type , RREQ );
-                                       postcheck( p1 -> type );
-                                       break;
-                                   default:
-                                       q = rvalue( argv[1] , p1 -> type , RREQ );
-                                       if (  isa( p1 -> type  , "d" )
-                                          && isa( q , "i" ) ) {
-                                           putop( P2SCONV , P2DOUBLE );
-                                       }
-                                       break;
-                               }
-#                      endif PC
-                           if (q == NIL)
+                               /*
+                                * structure arguments require lvalues,
+                                * scalars use rvalue.
+                                */
+                           switch( classify( p1 -> type ) ) {
+                               case TFILE:
+                               case TARY:
+                               case TREC:
+                               case TSET:
+                               case TSTR:
+                                   q = rvalue( argv[1] , p1 -> type , LREQ );

                                    break;
                                    break;

-                           if (incompat(q, p1->type, argv[1])) {
-                                   cerror("Expression type clashed with type of value parameter %s of %s", p1->symbol, p->symbol);
+                               case TINT:
+                               case TSCAL:
+                               case TBOOL:
+                               case TCHAR:
+                                   precheck( p1 -> type , "_RANG4" , "_RSNG4" );
+                                   q = rvalue( argv[1] , p1 -> type , RREQ );
+                                   postcheck( p1 -> type );
+                                   break;
+                               default:
+                                   q = rvalue( argv[1] , p1 -> type , RREQ );
+                                   if (  isa( p1 -> type  , "d" )
+                                      && isa( q , "i" ) ) {
+                                       putop( P2SCONV , P2DOUBLE );
+                                   }

                                    break;
                            }
                                    break;
                            }

+#                      endif PC
+                       if (q == NIL) {
+                               chk = FALSE;
+                               break;
+                       }
+                       if (incompat(q, p1->type, argv[1])) {
+                               cerror("Expression type clashed with type of value parameter %s of %s", p1->symbol, p->symbol);
+                               break;
+                       }

 #                      ifdef OBJ
 #                      ifdef OBJ

-                               if (isa(p1->type, "bcsi"))
-                                       rangechk(p1->type, q);
-                               if (q->class != STR)
-                                       convert(q, p1->type);
+                           if (isa(p1->type, "bcsi"))
+                                   rangechk(p1->type, q);
+                           if (q->class != STR)
+                                   convert(q, p1->type);

 #                      endif OBJ
 #                      ifdef PC
 #                      endif OBJ
 #                      ifdef PC

-                               switch( classify( p1 -> type ) ) {
-                                   case TFILE:
-                                   case TARY:
-                                   case TREC:
-                                   case TSET:
-                                   case TSTR:
-                                           putstrop( P2STARG
-                                               , p2type( p1 -> type )
-                                               , lwidth( p1 -> type )
-                                               , align( p1 -> type ) );
-                               }
-#                      endif PC
-                           break;
-                   case FFUNC:
-                           /*
-                            * function parameter
-                            */
-                           q = flvalue( (int *) argv[1] , FFUNC );
-                           if (q == NIL)
-                                   break;
-                           if (q != p1->type) {
-                                   error("Function type not identical to type of function parameter %s of %s", p1->symbol, p->symbol);
-                                   break;
+                           switch( classify( p1 -> type ) ) {
+                               case TFILE:
+                               case TARY:
+                               case TREC:
+                               case TSET:
+                               case TSTR:
+                                       putstrop( P2STARG
+                                           , p2type( p1 -> type )
+                                           , lwidth( p1 -> type )
+                                           , align( p1 -> type ) );

                            }
                            }

-                           break;
-                   case FPROC:
-                           /*
-                            * procedure parameter
-                            */
-                           q = flvalue( (int *) argv[1] , FPROC );
-                           if (q != NIL) {
-                                   error("Procedure parameter %s of %s cannot have a type", p1->symbol, p->symbol);
-                           }
-                           break;
-                   default:
-                           panic("call");
-               }
-#          ifdef PC
-                       /*
-                        *      if this is the nth (>1) argument,
-                        *      hang it on the left linear list of arguments
-                        */
-                   if ( noarguments ) {
-                           noarguments = FALSE;
-                   } else {
-                           putop( P2LISTOP , P2INT );
-                   }
-#          endif PC
-               argv = argv[2];
-           }
-           if (argv != NIL) {
-                   error("Too many arguments to %s", p->symbol);
-                   rvlist(argv);
-                   return (NIL);
-           }
-       } else if ( p -> class == FFUNC || p -> class == FPROC ) {
-               /*
-                *      formal routines can only have by-value parameters.
-                *      this will lose for integer actuals passed to real
-                *      formals, and strings which people want blank padded.
-                */
-#          ifdef OBJ
-               cnt = 0;
-#          endif OBJ
-           for ( ; argv != NIL ; argv = argv[2] ) {
-#              ifdef OBJ
-                   q = rvalue(argv[1], NIL, RREQ );
-                   cnt += leven(lwidth(q));
-#              endif OBJ
-#              ifdef PC
+#                      endif PC
+                       break;
+               case FFUNC:

                        /*
                        /*

-                        * structure arguments require lvalues,
-                        * scalars use rvalue.
+                        * function parameter

                         */
                         */

-                   codeoff();
-                   p1 = rvalue( argv[1] , NIL , RREQ );
-                   codeon();
-                   switch( classify( p1 ) ) {
-                       case TSTR:
-                           if ( p1 -> class == STR && slenline != line ) {
-                               slenline = line;
-                               ( opt( 's' ) ? (standard()): (warning()) );
-                               error("Implementation can't construct equal length strings");
-                           }
-                           /* and fall through */
-                       case TFILE:
-                       case TARY:
-                       case TREC:
-                       case TSET:
-                           q = rvalue( argv[1] , p1 , LREQ );
-                           break;
-                       case TINT:
-                           if ( floatline != line ) {
-                               floatline = line;
-                               ( opt( 's' ) ? (standard()) : (warning()) );
-                               error("Implementation can't coerice integer to real");
-                           }
-                           /* and fall through */
-                       case TSCAL:
-                       case TBOOL:
-                       case TCHAR:
-                       default:
-                           q = rvalue( argv[1] , p1 , RREQ );
-                           break;
-                   }
-                   switch( classify( p1 ) ) {
-                       case TFILE:
-                       case TARY:
-                       case TREC:
-                       case TSET:
-                       case TSTR:
-                               putstrop( P2STARG , p2type( p1 ) ,
-                                   lwidth( p1 ) , align( p1 ) );
-                   }
+                       q = flvalue( (int *) argv[1] , p1 );
+                       chk = (chk && fcompat(q, p1));
+                       break;
+               case FPROC:

                        /*
                        /*

-                        *      if this is the nth (>1) argument,
-                        *      hang it on the left linear list of arguments
+                        * procedure parameter

                         */
                         */

-                   if ( noarguments ) {
-                           noarguments = FALSE;
-                   } else {
-                           putop( P2LISTOP , P2INT );
-                   }
-#              endif PC
+                       q = flvalue( (int *) argv[1] , p1 );
+                       chk = (chk && fcompat(q, p1));
+                       break;
+               default:
+                       panic("call");

            }
            }

-       } else {
-           panic("call class");
+#          ifdef PC
+                   /*
+                    *  if this is the nth (>1) argument,
+                    *  hang it on the left linear list of arguments
+                    */
+               if ( noarguments ) {
+                       noarguments = FALSE;
+               } else {
+                       putop( P2LISTOP , P2INT );
+               }
+#          endif PC
+           argv = argv[2];

        }
        }

+       if (argv != NIL) {
+               error("Too many arguments to %s", p->symbol);
+               rvlist(argv);
+               return (NIL);
+       }
+       if (chk == FALSE)
+               return NIL;

 #      ifdef OBJ
            if ( p -> class == FFUNC || p -> class == FPROC ) {
                put(2, PTR_RV | cbn << 8+INDX, (int)p->value[NL_OFFS]);
 #      ifdef OBJ
            if ( p -> class == FFUNC || p -> class == FPROC ) {
                put(2, PTR_RV | cbn << 8+INDX, (int)p->value[NL_OFFS]);

-               put(2, O_FCALL, (long)cnt);
+               put(1, O_FCALL);

                put(2, O_FRTN, even(width(p->type)));
            } else {
                put(2, O_FRTN, even(width(p->type)));
            } else {

-               /* put(2, O_CALL | psbn << 8+INDX, (long)p->entloc); */

                put(2, O_CALL | psbn << 8, (long)p->entloc);
            }
 #      endif OBJ
                put(2, O_CALL | psbn << 8, (long)p->entloc);
            }
 #      endif OBJ


@@ -442,3 +363,107 @@ rvlist(al)
        for (; al != NIL; al = al[2])
                rvalue( (int *) al[1], NLNIL , RREQ );
 }
        for (; al != NIL; al = al[2])
                rvalue( (int *) al[1], NLNIL , RREQ );
 }

+
+    /*
+     * check that two function/procedure namelist entries are compatible
+     */
+bool
+fcompat( formal , actual )
+    struct nl  *formal;
+    struct nl  *actual;
+{
+    register struct nl *f_chain;
+    register struct nl *a_chain;
+    bool compat = TRUE;
+
+    if ( formal == NIL || actual == NIL ) {
+       return FALSE;
+    }
+    for (a_chain = plist(actual), f_chain = plist(formal);
+         f_chain != NIL;
+        f_chain = f_chain->chain, a_chain = a_chain->chain) {
+       if (a_chain == NIL) {
+           error("%s %s declared on line %d has more arguments than",
+               parnam(formal->class), formal->symbol,
+               linenum(formal));
+           cerror("%s %s declared on line %d",
+               parnam(actual->class), actual->symbol,
+               linenum(actual));
+           return FALSE;
+       }
+       if ( a_chain -> class != f_chain -> class ) {
+           error("%s parameter %s of %s declared on line %d is not identical",
+               parnam(f_chain->class), f_chain->symbol,
+               formal->symbol, linenum(formal));
+           cerror("with %s parameter %s of %s declared on line %d",
+               parnam(a_chain->class), a_chain->symbol,
+               actual->symbol, linenum(actual));
+           compat = FALSE;
+       } else if (a_chain->class == FFUNC || a_chain->class == FPROC) {
+           compat = (compat && fcompat(f_chain, a_chain));
+       }
+       if ((a_chain->class != FPROC && f_chain->class != FPROC) &&
+           (a_chain->type != f_chain->type)) {
+           error("Type of %s parameter %s of %s declared on line %d is not identical",
+               parnam(f_chain->class), f_chain->symbol,
+               formal->symbol, linenum(formal));
+           cerror("to type of %s parameter %s of %s declared on line %d",
+               parnam(a_chain->class), a_chain->symbol,
+               actual->symbol, linenum(actual));
+           compat = FALSE;
+       }
+    }
+    if (a_chain != NIL) {
+       error("%s %s declared on line %d has fewer arguments than",
+           parnam(formal->class), formal->symbol,
+           linenum(formal));
+       cerror("%s %s declared on line %d",
+           parnam(actual->class), actual->symbol,
+           linenum(actual));
+       return FALSE;
+    }
+    return compat;
+}
+
+char *
+parnam(nltype)
+    int nltype;
+{
+    switch(nltype) {
+       case REF:
+           return "var";
+       case VAR:
+           return "value";
+       case FUNC:
+       case FFUNC:
+           return "function";
+       case PROC:
+       case FPROC:
+           return "procedure";
+       default:
+           return "SNARK";
+    }
+}
+
+plist(p)
+    struct nl *p;
+{
+    switch (p->class) {
+       case FFUNC:
+       case FPROC:
+           return p->ptr[ NL_FCHAIN ];
+       case PROC:
+       case FUNC:
+           return p->chain;
+       default:
+           panic("plist");
+    }
+}
+
+linenum(p)
+    struct nl *p;
+{
+    if (p->class == FUNC)
+       return p->ptr[NL_FVAR]->value[NL_LINENO];
+    return p->value[NL_LINENO];
+}

diff --git a/usr/src/usr.bin/pascal/src/error.c b/usr/src/usr.bin/pascal/src/error.c
index 60e6e41..55757b6 100644 (file)
--- a/usr/src/usr.bin/pascal/src/error.c
+++ b/usr/src/usr.bin/pascal/src/error.c
@@ -1,6 +1,6 @@
 /* Copyright (c) 1979 Regents of the University of California */
 
 /* Copyright (c) 1979 Regents of the University of California */
 

-static char sccsid[] = "@(#)error.c 1.2 %G%";
+static char sccsid[] = "@(#)error.c 1.3 %G%";

 
 #include "whoami.h"
 #include "0.h"
 
 #include "whoami.h"
 #include "0.h"


@@ -49,7 +49,7 @@ extern        char *errfile;
 
 /*VARARGS*/
 
 
 /*VARARGS*/
 

-error(a1, a2, a3, a4)
+error(a1, a2, a3, a4, a5)

        register char *a1;
 {
        char errbuf[256];               /* was extern. why? ...pbk */
        register char *a1;
 {
        char errbuf[256];               /* was extern. why? ...pbk */


@@ -78,7 +78,7 @@ error(a1, a2, a3, a4)
                printf("  %c - ", errpfx);
        else
                printf("%c %d - ", errpfx, line);
                printf("  %c - ", errpfx);
        else
                printf("%c %d - ", errpfx, line);

-       printf(a1, a2, a3, a4);
+       printf(a1, a2, a3, a4, a5);

        if (errpfx == 'E')
 #ifndef PI0
                eflg = TRUE, codeoff();
        if (errpfx == 'E')
 #ifndef PI0
                eflg = TRUE, codeoff();


@@ -94,24 +94,24 @@ error(a1, a2, a3, a4)
 
 /*VARAGRS*/
 
 
 /*VARAGRS*/
 

-cerror(a1, a2, a3, a4)
+cerror(a1, a2, a3, a4, a5)

 {
 
        if (Enocascade)
                return;
        setpfx(' ');
 {
 
        if (Enocascade)
                return;
        setpfx(' ');

-       error(a1, a2, a3, a4);
+       error(a1, a2, a3, a4, a5);

 }
 
 #ifdef PI1
 
 /*VARARGS*/
 
 }
 
 #ifdef PI1
 
 /*VARARGS*/
 

-derror(a1, a2, a3, a4)
+derror(a1, a2, a3, a4, a5)

 {
 
        if (!holdderr)
 {
 
        if (!holdderr)

-               error(a1, a2, a3, a4);
+               error(a1, a2, a3, a4, a5);

        errpfx = 'E';
 }
 
        errpfx = 'E';
 }
 

diff --git a/usr/src/usr.bin/pascal/src/fend.c b/usr/src/usr.bin/pascal/src/fend.c
index 91b15d3..b31d3d7 100644 (file)
--- a/usr/src/usr.bin/pascal/src/fend.c
+++ b/usr/src/usr.bin/pascal/src/fend.c
@@ -1,6 +1,6 @@
 /* Copyright (c) 1979 Regents of the University of California */
 
 /* Copyright (c) 1979 Regents of the University of California */
 

-static char sccsid[] = "@(#)fend.c 1.2 %G%";
+static char sccsid[] = "@(#)fend.c 1.3 %G%";

 
 #include "whoami.h"
 #include "0.h"
 
 #include "whoami.h"
 #include "0.h"


@@ -228,30 +228,15 @@ funcend(fp, bundle, endline)
             *  and zero them if checking is on
             *  by calling blkclr( bytes of locals , starting local address );
             */
             *  and zero them if checking is on
             *  by calling blkclr( bytes of locals , starting local address );
             */

-       if ( opt( 't' ) ) {
-           if ( ( -sizes[ cbn ].om_max ) > DPOFF1 ) {
-               putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
-                       , "_blkclr" );
-               putleaf( P2ICON ,  ( -sizes[ cbn ].om_max ) - DPOFF1
-                       , 0 , P2INT , 0 );
-               putLV( 0 , cbn , sizes[ cbn ].om_max , P2CHAR );
-               putop( P2LISTOP , P2INT );
-               putop( P2CALL , P2INT );
-               putdot( filename , line );
-           }
-               /*
-                *  check number of longs of arguments
-                *  this can only be wrong for formal calls.
-                */
-           if ( fp -> class != PROG ) {
-                   putleaf( P2ICON , 0 , 0 , ADDTYPE( P2PTR , P2FTN | P2INT ) ,
-                           "_NARGCHK" );
-                   putleaf( P2ICON ,
-                       (fp->value[NL_OFFS] - DPOFF2) / sizeof(long) ,
-                       0 , P2INT , 0 );
-                   putop( P2CALL , P2INT );
-                   putdot( filename , line );
-           }
+       if ( opt( 't' ) && ( -sizes[ cbn ].om_max ) > DPOFF1 ) {
+           putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR )
+                   , "_blkclr" );
+           putleaf( P2ICON ,  ( -sizes[ cbn ].om_max ) - DPOFF1
+                   , 0 , P2INT , 0 );
+           putLV( 0 , cbn , sizes[ cbn ].om_max , P2CHAR );
+           putop( P2LISTOP , P2INT );
+           putop( P2CALL , P2INT );
+           putdot( filename , line );

        }
 #endif PC
        if ( monflg ) {
        }
 #endif PC
        if ( monflg ) {

diff --git a/usr/src/usr.bin/pascal/src/fhdr.c b/usr/src/usr.bin/pascal/src/fhdr.c
index 2a6b666..62efe83 100644 (file)
--- a/usr/src/usr.bin/pascal/src/fhdr.c
+++ b/usr/src/usr.bin/pascal/src/fhdr.c
@@ -1,6 +1,6 @@
 /* Copyright (c) 1979 Regents of the University of California */
 
 /* Copyright (c) 1979 Regents of the University of California */
 

-static char sccsid[] = "@(#)fhdr.c 1.1 %G%";
+static char sccsid[] = "@(#)fhdr.c 1.2 %G%";

 
 #include "whoami.h"
 #include "0.h"
 
 #include "whoami.h"
 #include "0.h"

diff --git a/usr/src/usr.bin/pascal/src/flvalue.c b/usr/src/usr.bin/pascal/src/flvalue.c
index 07d7cda..ab72a24 100644 (file)
--- a/usr/src/usr.bin/pascal/src/flvalue.c
+++ b/usr/src/usr.bin/pascal/src/flvalue.c
@@ -1,6 +1,6 @@
 /* Copyright (c) 1980 Regents of the University of California */
 
 /* Copyright (c) 1980 Regents of the University of California */
 

-static char sccsid[] = "@(#)flvalue.c 1.6 %G%";
+static char sccsid[] = "@(#)flvalue.c 1.7 %G%";

 
 #include "whoami.h"
 #include "0.h"
 
 #include "whoami.h"
 #include "0.h"


@@ -63,7 +63,7 @@ flvalue( r , formalp )
                        putRV( p -> symbol , bn , p -> value[ NL_OFFS ] , 
                                p2type( p ) );
 #                  endif PC
                        putRV( p -> symbol , bn , p -> value[ NL_OFFS ] , 
                                p2type( p ) );
 #                  endif PC

-                   return p -> type;
+                   return p;

            case FUNC:
            case PROC:
                    if ( r[3] != NIL ) {
            case FUNC:
            case PROC:
                    if ( r[3] != NIL ) {


@@ -118,7 +118,7 @@ flvalue( r , formalp )
                        putop( P2LISTOP , P2INT );
                        putop( P2CALL , P2PTR | P2STRTY );
 #                  endif PC
                        putop( P2LISTOP , P2INT );
                        putop( P2CALL , P2PTR | P2STRTY );
 #                  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 );

diff --git a/usr/src/usr.bin/pascal/src/pas.y b/usr/src/usr.bin/pascal/src/pas.y
index 6795507..b3b11eb 100644 (file)
--- a/usr/src/usr.bin/pascal/src/pas.y
+++ b/usr/src/usr.bin/pascal/src/pas.y
@@ -89,7 +89,7 @@
 
 /* Copyright (c) 1979 Regents of the University of California */
 
 
 /* Copyright (c) 1979 Regents of the University of California */
 

-/* static      char sccsid[] = "@(#)pas.y 1.3 %G%"; */
+/* static      char sccsid[] = "@(#)pas.y 1.4 %G%"; */

 
 /*
  * The following line marks the end of the yacc
 
 /*
  * The following line marks the end of the yacc


@@ -99,7 +99,7 @@
 ##
 /* Copyright (c) 1979 Regents of the University of California */
 
 ##
 /* Copyright (c) 1979 Regents of the University of California */
 

-static char sccsid[] = "@(#)pas.y 1.3 %G%";
+static char sccsid[] = "@(#)pas.y 1.4 %G%";

 
 #include "whoami.h"
 #include "0.h"
 
 #include "whoami.h"
 #include "0.h"


@@ -315,11 +315,11 @@ param:
        YVAR id_list ':' type
                = $$ = tree3(T_PVAR, fixlist($2), $4);
                |
        YVAR id_list ':' type
                = $$ = tree3(T_PVAR, fixlist($2), $4);
                |

-       YFUNCTION id_list ':' type
-               = $$ = tree3(T_PFUNC, fixlist($2), $4);
+       YFUNCTION id_list params ftype
+               = $$ = tree5(T_PFUNC, fixlist($2), $4, $3, lineof($1));

                |
                |

-       YPROCEDURE id_list
-               = $$ = tree2(T_PPROC, fixlist($2));
+       YPROCEDURE id_list params ftype
+               = $$ = tree5(T_PPROC, fixlist($2), $4, $3, lineof($1));

                ;
 ftype:
        ':' type
                ;
 ftype:
        ':' type

diff --git a/usr/src/usr.bin/pascal/src/pimakefile b/usr/src/usr.bin/pascal/src/pimakefile
index 8b4eb2b..a119b1e 100644 (file)
--- a/usr/src/usr.bin/pascal/src/pimakefile
+++ b/usr/src/usr.bin/pascal/src/pimakefile
@@ -1,4 +1,4 @@
-SCCSID = "@(#)pimakefile 1.16 %G%"
+SCCSID = "@(#)pimakefile 1.17 %G%"

 WHOAMI = pi
 INSTALLNAME = ${DESTDIR}/usr/ucb/pi
 VERSION = 2.0
 WHOAMI = pi
 INSTALLNAME = ${DESTDIR}/usr/ucb/pi
 VERSION = 2.0


@@ -20,12 +20,12 @@ ERRORSTRINGS = pi2.0strings
 
 SRCS = ato.c \
        call.c case.c clas.c const.c conv.c cset.c \
 
 SRCS = ato.c \
        call.c case.c clas.c const.c conv.c cset.c \

-       error.c fdec.c flvalue.c forop.c func.c gen.c \
+       error.c fdec.c fend.c fhdr.c flvalue.c forop.c func.c gen.c \

        hash.c lab.c lookup.c lval.c stklval.c \
        main.c nl.c proc.c put.c \
        rec.c rval.c stkrval.c\
        stat.c string.c subr.c \
        hash.c lab.c lookup.c lval.c stklval.c \
        main.c nl.c proc.c put.c \
        rec.c rval.c stkrval.c\
        stat.c string.c subr.c \

-       tree.c type.c var.c \
+       tmps.c tree.c type.c var.c \

        TRdata.c \
        treen.c yycopy.c \
        yycosts.c yyerror.c yyget.c yyid.c yylex.c yymain.c yyoptions.c \
        TRdata.c \
        treen.c yycopy.c \
        yycosts.c yyerror.c yyget.c yyid.c yylex.c yymain.c yyoptions.c \


@@ -38,12 +38,12 @@ OTHERS = pas.y opc.c version.c gram pic.c
 
 OBJS = ato.o \
        call.o case.o clas.o const.o conv.o cset.o \
 
 OBJS = ato.o \
        call.o case.o clas.o const.o conv.o cset.o \

-       error.o fdec.o flvalue.o forop.o func.o gen.o \
+       error.o fdec.o fend.o fhdr.o flvalue.o forop.o func.o gen.o \

        hash.o lab.o lookup.o lval.o stklval.o \
        main.o nl.o proc.o put.o \
        rec.o rval.o stkrval.o\
        stat.o string.o subr.o \
        hash.o lab.o lookup.o lval.o stklval.o \
        main.o nl.o proc.o put.o \
        rec.o rval.o stkrval.o\
        stat.o string.o subr.o \

-       tree.o type.o var.o \
+       tmps.o tree.o type.o var.o \

        TRdata.o \
        treen.o yycopy.o \
        y.tab.o \
        TRdata.o \
        treen.o yycopy.o \
        y.tab.o \


@@ -174,6 +174,22 @@ fdec.o: objfmt.h
 fdec.o: align.h
 fdec.o: pc.h
 fdec.o: pcops.h
 fdec.o: align.h
 fdec.o: pc.h
 fdec.o: pcops.h

+fend.o: whoami.h
+fend.o: 0.h
+fend.o: tree.h
+fend.o: opcode.h
+fend.o: objfmt.h
+fend.o: align.h
+fend.o: pc.h
+fend.o: pcops.h
+fhdr.o: whoami.h
+fhdr.o: 0.h
+fhdr.o: tree.h
+fhdr.o: opcode.h
+fhdr.o: objfmt.h
+fhdr.o: align.h
+fhdr.o: pc.h
+fhdr.o: pcops.h

 flvalue.o: whoami.h
 flvalue.o: 0.h
 flvalue.o: tree.h
 flvalue.o: whoami.h
 flvalue.o: 0.h
 flvalue.o: tree.h


@@ -185,7 +201,7 @@ forop.o: whoami.h
 forop.o: 0.h
 forop.o: opcode.h
 forop.o: tree.h
 forop.o: 0.h
 forop.o: opcode.h
 forop.o: tree.h

-forop.o: opcode.h
+forop.o: objfmt.h

 forop.o: pc.h
 forop.o: pcops.h
 flvalue.o: whoami.h
 forop.o: pc.h
 forop.o: pcops.h
 flvalue.o: whoami.h


@@ -278,6 +294,8 @@ string.o: 0.h
 string.o: send.h
 subr.o: whoami.h
 subr.o: 0.h
 string.o: send.h
 subr.o: whoami.h
 subr.o: 0.h

+tmps.o: whoami.h
+tmps.o: 0.h

 tree.o: whoami.h
 tree.o: 0.h
 type.o: whoami.h
 tree.o: whoami.h
 tree.o: 0.h
 type.o: whoami.h

diff --git a/usr/src/usr.bin/pascal/src/put.c b/usr/src/usr.bin/pascal/src/put.c
index 41b2c1b..c2f16d7 100644 (file)
--- a/usr/src/usr.bin/pascal/src/put.c
+++ b/usr/src/usr.bin/pascal/src/put.c
@@ -1,6 +1,6 @@
 /* Copyright (c) 1979 Regents of the University of California */
 
 /* Copyright (c) 1979 Regents of the University of California */
 

-static char sccsid[] = "@(#)put.c 1.11 %G%";
+static char sccsid[] = "@(#)put.c 1.12 %G%";

 
 #include "whoami.h"
 #include "opcode.h"
 
 #include "whoami.h"
 #include "opcode.h"


@@ -257,11 +257,6 @@ around:
 #endif
                        word(p[1]);
                        return (oldlc);
 #endif
                        word(p[1]);
                        return (oldlc);

-               case O_FCALL:
-                       lp = (long *)&p[1];
-                       if (*lp == 0)
-                               goto longgen;
-                       /* and fall through */

                case O_PUSH:
                        lp = (long *)&p[1];
                        if (*lp == 0)
                case O_PUSH:
                        lp = (long *)&p[1];
                        if (*lp == 0)