Distinguish logical and logical*2 types, and print both types correctly;

print dummy procedures and parameter variables more-or-less correctly.

SCCS-vsn: old/dbx/fortran.c 5.3

diff --git a/usr/src/old/dbx/fortran.c b/usr/src/old/dbx/fortran.c
index 8ebb052..9ef270b 100644 (file)
--- a/usr/src/old/dbx/fortran.c
+++ b/usr/src/old/dbx/fortran.c
@@ -5,7 +5,7 @@
  */
 
 #ifndef lint
  */
 
 #ifndef lint

-static char sccsid[] = "@(#)fortran.c  5.2 (Berkeley) %G%";
+static char sccsid[] = "@(#)fortran.c  5.3 (Berkeley) %G%";

 #endif not lint
 
 static char rcsid[] = "$Header: fortran.c,v 1.5 84/12/26 10:39:37 linton Exp $";
 #endif not lint
 
 static char rcsid[] = "$Header: fortran.c,v 1.5 84/12/26 10:39:37 linton Exp $";


@@ -27,7 +27,7 @@ static char rcsid[] = "$Header: fortran.c,v 1.5 84/12/26 10:39:37 linton Exp $";
 #include "runtime.h"
 #include "machine.h"
 
 #include "runtime.h"
 #include "machine.h"
 

-#define isfloat(range) ( \
+#define isspecial(range) ( \

     range->symvalue.rangev.upper == 0 and range->symvalue.rangev.lower > 0 \
 )
 
     range->symvalue.rangev.upper == 0 and range->symvalue.rangev.lower > 0 \
 )
 


@@ -180,6 +180,7 @@ Symbol eltype;
        case CONST:
            
            printf("parameter %s = ", symname(s));
        case CONST:
            
            printf("parameter %s = ", symname(s));

+           eval(s->symvalue.constval);

             printval(s);
            break;
 
             printval(s);
            break;
 


@@ -290,14 +291,24 @@ Symbol s;
            break;
 
        case RANGE:
            break;
 
        case RANGE:

-            if (isfloat(s)) {
+           if (isspecial(s)) {

                switch (s->symvalue.rangev.lower) {
                switch (s->symvalue.rangev.lower) {

+                   case sizeof(short):
+                       if (istypename(s->type, "logical*2")) {
+                           printlogical(pop(short));
+                       }
+                       break;
+

                    case sizeof(float):
                    case sizeof(float):

-                       prtreal(pop(float));
+                       if (istypename(s->type, "logical")) {
+                           printlogical(pop(long));
+                       } else {
+                           prtreal(pop(float));
+                       }

                        break;
 
                    case sizeof(double):
                        break;
 
                    case sizeof(double):

-                       if (istypename(s->type,"complex")) {
+                       if (istypename(s->type, "complex")) {

                            d2 = pop(float);
                            d1 = pop(float);
                            printf("(");
                            d2 = pop(float);
                            d1 = pop(float);
                            printf("(");


@@ -321,7 +332,7 @@ Symbol s;
                        break;
                
                    default:
                        break;
                
                    default:

-                       panic("bad size \"%d\" for real",
+                       panic("bad size \"%d\" for special",

                                   s->symvalue.rangev.lower);
                        break;
                }
                                   s->symvalue.rangev.lower);
                        break;
                }


@@ -339,6 +350,20 @@ Symbol s;
     }
 }
 
     }
 }
 

+/*
+ * Print out a logical
+ */
+
+private printlogical(i)
+Integer i;
+{
+    if (i == 0) {
+       printf(".false.");
+    } else {
+       printf(".true.");
+    }
+}
+

 /*
  * Print out an int 
  */
 /*
  * Print out an int 
  */


@@ -347,14 +372,13 @@ private printint(i, t)
 Integer i;
 register Symbol t;
 {
 Integer i;
 register Symbol t;
 {

-    if (istypename(t->type, "logical")) {
-       printf(((Boolean) i) == true ? "true" : "false");
-    }
-    else if ( (t->type == t_int) or istypename(t->type, "integer") or
+    if ( (t->type == t_int) or istypename(t->type, "integer") or

                   istypename(t->type,"integer*2") ) {
        printf("%ld", i);
                   istypename(t->type,"integer*2") ) {
        printf("%ld", i);

+    } else if (istypename(t->type, "addr")) {
+       printf("0x%lx", i);

     } else {
     } else {

-      error("unkown type in fortran printint");
+       error("unknown type in fortran printint");

     }
 }
 
     }
 }