From 11762fe13538d4bf0ea7f185760db40953a7972c Mon Sep 17 00:00:00 2001
From: CSRG <csrg@ucbvax.Berkeley.EDU>
Date: Wed, 18 May 1983 22:10:24 -0800
Subject: [PATCH] BSD 4_2 development Work on file
 usr/src/usr.bin/f77/src/f77pass1/fio.h Work on file
 usr/src/usr.bin/f77/src/f77pass1/ftypes.h Work on file
 usr/src/usr.bin/f77/src/f77pass1/gram.exec Work on file
 usr/src/usr.bin/f77/src/f77pass1/gram.expr Work on file
 usr/src/usr.bin/f77/src/f77pass1/gram.io Work on file
 usr/src/usr.bin/f77/src/f77pass1/io.h

Synthesized-from: CSRG/cd1/4.2
---
 usr/src/usr.bin/f77/src/f77pass1/fio.h     | 101 ++++++++++++
 usr/src/usr.bin/f77/src/f77pass1/ftypes.h  |  29 ++++
 usr/src/usr.bin/f77/src/f77pass1/gram.exec | 136 ++++++++++++++++
 usr/src/usr.bin/f77/src/f77pass1/gram.expr | 129 +++++++++++++++
 usr/src/usr.bin/f77/src/f77pass1/gram.io   | 176 +++++++++++++++++++++
 usr/src/usr.bin/f77/src/f77pass1/io.h      |  58 +++++++
 6 files changed, 629 insertions(+)
 create mode 100644 usr/src/usr.bin/f77/src/f77pass1/fio.h
 create mode 100644 usr/src/usr.bin/f77/src/f77pass1/ftypes.h
 create mode 100644 usr/src/usr.bin/f77/src/f77pass1/gram.exec
 create mode 100644 usr/src/usr.bin/f77/src/f77pass1/gram.expr
 create mode 100644 usr/src/usr.bin/f77/src/f77pass1/gram.io
 create mode 100644 usr/src/usr.bin/f77/src/f77pass1/io.h

diff --git a/usr/src/usr.bin/f77/src/f77pass1/fio.h b/usr/src/usr.bin/f77/src/f77pass1/fio.h
new file mode 100644
index 0000000000..1ebe1f44bc
--- /dev/null
+++ b/usr/src/usr.bin/f77/src/f77pass1/fio.h
@@ -0,0 +1,101 @@
+#include <stdio.h>
+typedef long ftnint;
+typedef ftnint flag;
+typedef long ftnlen;
+/*external read, write*/
+typedef struct
+{	flag cierr;
+	ftnint ciunit;
+	flag ciend;
+	char *cifmt;
+	ftnint cirec;
+} cilist;
+/*internal read, write*/
+typedef struct
+{	flag icierr;
+	char *iciunit;
+	flag iciend;
+	char *icifmt;
+	ftnint icirlen;
+	ftnint icirnum;
+} icilist;
+/*open*/
+typedef struct
+{	flag oerr;
+	ftnint ounit;
+	char *ofnm;
+	ftnlen ofnmlen;
+	char *osta;
+	char *oacc;
+	char *ofm;
+	ftnint orl;
+	char *oblnk;
+} olist;
+/*close*/
+typedef struct
+{	flag cerr;
+	ftnint cunit;
+	char *csta;
+} cllist;
+/*rewind, backspace, endfile*/
+typedef struct
+{	flag aerr;
+	ftnint aunit;
+} alist;
+/*units*/
+typedef struct
+{	FILE *ufd;	/*0=unconnected*/
+	char *ufnm;
+	long uinode;
+	int url;	/*0=sequential*/
+	flag useek;	/*true=can backspace, use dir, ...*/
+	flag ufmt;
+	flag uprnt;
+	flag ublnk;
+	flag uend;
+	flag uwrt;	/*last io was write*/
+	flag uscrtch;
+} unit;
+typedef struct
+{	flag inerr;
+	ftnint inunit;
+	char *infile;
+	ftnlen infilen;
+	ftnint	*inex;	/*parameters in standard's order*/
+	ftnint	*inopen;
+	ftnint	*innum;
+	ftnint	*innamed;
+	char	*inname;
+	ftnlen	innamlen;
+	char	*inacc;
+	ftnlen	inacclen;
+	char	*inseq;
+	ftnlen	inseqlen;
+	char 	*indir;
+	ftnlen	indirlen;
+	char	*infmt;
+	ftnlen	infmtlen;
+	char	*inform;
+	ftnint	informlen;
+	char	*inunf;
+	ftnlen	inunflen;
+	ftnint	*inrecl;
+	ftnint	*innrec;
+	char	*inblank;
+	ftnlen	inblanklen;
+} inlist;
+
+extern int errno;
+extern flag init;
+extern cilist *elist;	/*active external io list*/
+extern flag reading,external,sequential,formatted;
+extern int (*getn)(),(*putn)();	/*for formatted io*/
+extern FILE *cf;	/*current file*/
+extern unit *curunit;	/*current unit*/
+extern unit units[];
+#define err(f,n,s) {if(f) errno= n; else fatal(n,s); return(n);}
+
+/*Table sizes*/
+#define MXUNIT 10
+
+extern int recpos;	/*position in current record*/
diff --git a/usr/src/usr.bin/f77/src/f77pass1/ftypes.h b/usr/src/usr.bin/f77/src/f77pass1/ftypes.h
new file mode 100644
index 0000000000..1400036868
--- /dev/null
+++ b/usr/src/usr.bin/f77/src/f77pass1/ftypes.h
@@ -0,0 +1,29 @@
+
+/* variable types
+ * numeric assumptions:
+ *	int < reals < complexes
+ *	TYDREAL-TYREAL = TYDCOMPLEX-TYCOMPLEX
+ */
+
+#define TYUNKNOWN 0
+#define TYADDR 1
+#define TYSHORT 2
+#define TYLONG 3
+#define TYREAL 4
+#define TYDREAL 5
+#define TYCOMPLEX 6
+#define TYDCOMPLEX 7
+#define TYLOGICAL 8
+#define TYCHAR 9
+#define TYSUBR 10
+#define TYERROR 11
+
+#define NTYPES (TYERROR+1)
+#define TYBLANK TYSUBR
+
+/* special defines for constants
+*/
+
+#define	TYBITSTR TYUNKNOWN
+#define	TYHOLLERITH TYSUBR
+
diff --git a/usr/src/usr.bin/f77/src/f77pass1/gram.exec b/usr/src/usr.bin/f77/src/f77pass1/gram.exec
new file mode 100644
index 0000000000..95078d1086
--- /dev/null
+++ b/usr/src/usr.bin/f77/src/f77pass1/gram.exec
@@ -0,0 +1,136 @@
+exec:	  iffable
+	| SDO end_spec intonlyon label intonlyoff opt_comma dospec
+		{
+		if($4->labdefined)
+			execerr("no backward DO loops", CNULL);
+		$4->blklevel = blklevel+1;
+		exdo($4->labelno, $7);
+		}
+	| logif iffable
+		{ exendif();  thiswasbranch = NO; }
+	| logif STHEN
+	| SELSEIF end_spec SLPAR expr SRPAR STHEN
+		{ exelif($4); lastwasbranch = NO; }
+	| SELSE end_spec
+		{ exelse(); lastwasbranch = NO; }
+	| SENDIF end_spec
+		{ exendif(); lastwasbranch = NO; }
+	;
+
+logif:	  SLOGIF end_spec SLPAR expr SRPAR
+		{ exif($4); }
+	;
+
+dospec:	  name SEQUALS exprlist
+		{ $$ = mkchain($1, $3); }
+	;
+
+iffable:  let lhs SEQUALS expr
+		{ exequals($2, $4); }
+	| SASSIGN end_spec assignlabel STO name
+		{ exassign($5, $3); }
+	| SCONTINUE end_spec
+	| goto
+	| io
+		{ inioctl = NO; }
+	| SARITHIF end_spec SLPAR expr SRPAR label SCOMMA label SCOMMA label
+		{ exarif($4, $6, $8, $10);  thiswasbranch = YES; }
+	| call
+		{ excall($1, PNULL, 0, labarray); }
+	| call SLPAR SRPAR
+		{ excall($1, PNULL, 0, labarray); }
+	| call SLPAR callarglist SRPAR
+		{ if(nstars < MAXLABLIST)
+			excall($1, mklist($3), nstars, labarray);
+		  else
+			err("too many alternate returns");
+		}
+	| SRETURN end_spec opt_expr
+		{ exreturn($3);  thiswasbranch = YES; }
+	| stop end_spec opt_expr
+		{ exstop($1, $3);  thiswasbranch = $1; }
+	;
+
+assignlabel:   SICON
+		{ $$ = mklabel( convci(toklen, token) ); }
+	;
+
+let:	  SLET
+		{ if(parstate == OUTSIDE)
+			{
+			newproc();
+			startproc(PNULL, CLMAIN);
+			}
+		}
+	;
+
+goto:	  SGOTO end_spec label
+		{ exgoto($3);  thiswasbranch = YES; }
+	| SASGOTO end_spec name
+		{ exasgoto($3);  thiswasbranch = YES; }
+	| SASGOTO end_spec name opt_comma SLPAR labellist SRPAR
+		{ exasgoto($3);  thiswasbranch = YES; }
+	| SCOMPGOTO end_spec SLPAR labellist SRPAR opt_comma expr
+		{ if(nstars < MAXLABLIST)
+			if (optimflag)
+			    optbuff (SKCMGOTO, fixtype($7), nstars, labarray);
+			else
+			    putcmgo (fixtype($7), nstars, labarray);
+		  else
+			err("computed GOTO list too long");
+		}
+	;
+
+opt_comma:
+	| SCOMMA
+	;
+
+call:	  SCALL end_spec name
+		{ nstars = 0; $$ = $3; }
+	;
+
+callarglist:  callarg
+		{ $$ = ($1 ? mkchain($1,CHNULL) : CHNULL); }
+	| callarglist SCOMMA callarg
+		{ if($3)
+			if($1) $$ = hookup($1, mkchain($3,CHNULL));
+			else $$ = mkchain($3,CHNULL);
+		  else
+			$$ = $1;
+		}
+	;
+
+callarg:  expr
+	| SSTAR label
+		{ if(nstars<MAXLABLIST) labarray[nstars++] = $2; $$ = 0; }
+	;
+
+stop:	  SPAUSE
+		{ $$ = 0; }
+	| SSTOP
+		{ $$ = 1; }
+	;
+
+exprlist:  expr
+		{ $$ = mkchain($1, CHNULL); }
+	| exprlist SCOMMA expr
+		{ $$ = hookup($1, mkchain($3,CHNULL) ); }
+	;
+
+end_spec:
+		{ if(parstate == OUTSIDE)
+			{
+			newproc();
+			startproc(PNULL, CLMAIN);
+			}
+		  if(parstate < INDATA) enddcl();
+		}
+	;
+
+intonlyon:
+		{ intonly = YES; }
+	;
+
+intonlyoff:
+		{ intonly = NO; }
+	;
diff --git a/usr/src/usr.bin/f77/src/f77pass1/gram.expr b/usr/src/usr.bin/f77/src/f77pass1/gram.expr
new file mode 100644
index 0000000000..5f40133cc8
--- /dev/null
+++ b/usr/src/usr.bin/f77/src/f77pass1/gram.expr
@@ -0,0 +1,129 @@
+funarglist:
+		{ $$ = 0; }
+	| funargs
+	;
+
+funargs:  expr
+		{ $$ = mkchain($1, CHNULL); }
+	| funargs SCOMMA expr
+		{ $$ = hookup($1, mkchain($3,CHNULL) ); }
+	;
+
+
+expr:	  uexpr
+	| SLPAR expr SRPAR
+		{ if (optimflag)
+			$$ = mkexpr(OPPAREN, $2, ENULL);
+		  else $$ = $2;
+		}
+	| complex_const
+	;
+
+uexpr:	  lhs
+	| simple_const
+	| expr addop expr   %prec SPLUS
+		{ $$ = mkexpr($2, $1, $3); }
+	| expr SSTAR expr
+		{ $$ = mkexpr(OPSTAR, $1, $3); }
+	| expr SSLASH expr
+		{ $$ = mkexpr(OPSLASH, $1, $3); }
+	| expr SPOWER expr
+		{ $$ = mkexpr(OPPOWER, $1, $3); }
+	| addop expr  %prec SSTAR
+		{ if($1 == OPMINUS)
+			$$ = mkexpr(OPNEG, $2, ENULL);
+		  else 	$$ = $2;
+		}
+	| expr relop expr  %prec SEQ
+		{ $$ = mkexpr($2, $1, $3); }
+	| expr SEQV expr
+		{ NO66(".EQV. operator");
+		  $$ = mkexpr(OPEQV, $1,$3); }
+	| expr SNEQV expr
+		{ NO66(".NEQV. operator");
+		  $$ = mkexpr(OPNEQV, $1, $3); }
+	| expr SOR expr
+		{ $$ = mkexpr(OPOR, $1, $3); }
+	| expr SAND expr
+		{ $$ = mkexpr(OPAND, $1, $3); }
+	| SNOT expr
+		{ $$ = mkexpr(OPNOT, $2, ENULL); }
+	| expr SCONCAT expr
+		{ NO66("concatenation operator //");
+		  $$ = mkexpr(OPCONCAT, $1, $3); }
+	;
+
+addop:	  SPLUS		{ $$ = OPPLUS; }
+	| SMINUS	{ $$ = OPMINUS; }
+	;
+
+relop:	  SEQ	{ $$ = OPEQ; }
+	| SGT	{ $$ = OPGT; }
+	| SLT	{ $$ = OPLT; }
+	| SGE	{ $$ = OPGE; }
+	| SLE	{ $$ = OPLE; }
+	| SNE	{ $$ = OPNE; }
+	;
+
+lhs:	 name
+		{ $$ = mkprim($1, PNULL, CHNULL); }
+	| name substring
+		{ NO66("substring operator :");
+		  $$ = mkprim($1, PNULL, $2); }
+	| name SLPAR funarglist SRPAR
+		{ $$ = mkprim($1, mklist($3), CHNULL); }
+	| name SLPAR funarglist SRPAR substring
+		{ NO66("substring operator :");
+		  $$ = mkprim($1, mklist($3), $5); }
+	;
+
+substring:  SLPAR opt_expr SCOLON opt_expr SRPAR
+		{ $$ = mkchain($2, mkchain($4,CHNULL)); }
+	;
+
+opt_expr:
+		{ $$ = 0; }
+	| expr
+	;
+
+
+simple_const:   STRUE	{ $$ = mklogcon(1); }
+	| SFALSE	{ $$ = mklogcon(0); }
+	| SHOLLERITH  { $$ = mkstrcon(toklen, token); }
+	| SICON	= { $$ = mkintcon( convci(toklen, token) ); }
+	| SRCON	= { $$ = mkrealcon(TYREAL, convcd(toklen, token)); }
+	| SDCON	= { $$ = mkrealcon(TYDREAL, convcd(toklen, token)); }
+	;
+
+complex_const:  SLPAR uexpr SCOMMA uexpr SRPAR
+		{ $$ = mkcxcon($2,$4); }
+	;
+
+
+fexpr:	  unpar_fexpr
+	| SLPAR fexpr SRPAR
+		{ if (optimflag)
+			$$ = mkexpr(OPPAREN, $2, ENULL);
+		  else $$ = $2;
+		}
+	;
+
+unpar_fexpr:	  lhs
+	| simple_const
+	| fexpr addop fexpr   %prec SPLUS
+		{ $$ = mkexpr($2, $1, $3); }
+	| fexpr SSTAR fexpr
+		{ $$ = mkexpr(OPSTAR, $1, $3); }
+	| fexpr SSLASH fexpr
+		{ $$ = mkexpr(OPSLASH, $1, $3); }
+	| fexpr SPOWER fexpr
+		{ $$ = mkexpr(OPPOWER, $1, $3); }
+	| addop fexpr  %prec SSTAR
+		{ if($1 == OPMINUS)
+			$$ = mkexpr(OPNEG, $2, ENULL);
+		  else	$$ = $2;
+		}
+	| fexpr SCONCAT fexpr
+		{ NO66("concatenation operator //");
+		  $$ = mkexpr(OPCONCAT, $1, $3); }
+	;
diff --git a/usr/src/usr.bin/f77/src/f77pass1/gram.io b/usr/src/usr.bin/f77/src/f77pass1/gram.io
new file mode 100644
index 0000000000..1911431faf
--- /dev/null
+++ b/usr/src/usr.bin/f77/src/f77pass1/gram.io
@@ -0,0 +1,176 @@
+  /*  Input/Output Statements */
+
+io:	  io1
+		{ endio(); }
+	;
+
+io1:	  iofmove ioctl
+	| iofmove unpar_fexpr
+		{ ioclause(IOSUNIT, $2); endioctl(); }
+	| iofmove SSTAR
+		{ ioclause(IOSUNIT, PNULL); endioctl(); }
+	| iofmove SPOWER
+		{ ioclause(IOSUNIT, IOSTDERR); endioctl(); }
+	| iofctl ioctl
+	| read ioctl
+		{ doio(PNULL); }
+	| read infmt
+		{ doio(PNULL); }
+	| read ioctl inlist
+		{ doio($3); }
+	| read infmt SCOMMA inlist
+		{ doio($4); }
+	| read ioctl SCOMMA inlist
+		{ doio($4); }
+	| write ioctl
+		{ doio(PNULL); }
+	| write ioctl outlist
+		{ doio($3); }
+	| print
+		{ doio(PNULL); }
+	| print SCOMMA outlist
+		{ doio($3); }
+	;
+
+iofmove:   fmkwd end_spec in_ioctl
+	;
+
+fmkwd:	  SBACKSPACE
+		{ iostmt = IOBACKSPACE; }
+	| SREWIND
+		{ iostmt = IOREWIND; }
+	| SENDFILE
+		{ iostmt = IOENDFILE; }
+	;
+
+iofctl:  ctlkwd end_spec in_ioctl
+	;
+
+ctlkwd:	  SINQUIRE
+		{ iostmt = IOINQUIRE; }
+	| SOPEN
+		{ iostmt = IOOPEN; }
+	| SCLOSE
+		{ iostmt = IOCLOSE; }
+	;
+
+infmt:	  unpar_fexpr
+		{
+		ioclause(IOSUNIT, PNULL);
+		ioclause(IOSFMT, $1);
+		endioctl();
+		}
+	| SSTAR
+		{
+		ioclause(IOSUNIT, PNULL);
+		ioclause(IOSFMT, PNULL);
+		endioctl();
+		}
+	;
+
+ioctl:	  SLPAR fexpr SRPAR
+		{ if($2->headblock.vtype == TYCHAR)
+			{
+			ioclause(IOSUNIT, PNULL);
+			ioclause(IOSFMT, $2);
+			}
+		  else
+			ioclause(IOSUNIT, $2);
+		  endioctl();
+		}
+	| SLPAR ctllist SRPAR
+		{ endioctl(); }
+	;
+
+ctllist:  ioclause
+	| ctllist SCOMMA ioclause
+	;
+
+ioclause:  fexpr
+		{ ioclause(IOSPOSITIONAL, $1); }
+	| SSTAR
+		{ ioclause(IOSPOSITIONAL, PNULL); }
+	| SPOWER
+		{ ioclause(IOSPOSITIONAL, IOSTDERR); }
+	| nameeq expr
+		{ ioclause($1, $2); }
+	| nameeq SSTAR
+		{ ioclause($1, PNULL); }
+	| nameeq SPOWER
+		{ ioclause($1, IOSTDERR); }
+	;
+
+nameeq:  SNAMEEQ
+		{ $$ = iocname(); }
+	;
+
+read:	  SREAD end_spec in_ioctl
+		{ iostmt = IOREAD; }
+	;
+
+write:	  SWRITE end_spec in_ioctl
+		{ iostmt = IOWRITE; }
+	;
+
+print:	  SPRINT end_spec fexpr in_ioctl
+		{
+		iostmt = IOWRITE;
+		ioclause(IOSUNIT, PNULL);
+		ioclause(IOSFMT, $3);
+		endioctl();
+		}
+	| SPRINT end_spec SSTAR in_ioctl
+		{
+		iostmt = IOWRITE;
+		ioclause(IOSUNIT, PNULL);
+		ioclause(IOSFMT, PNULL);
+		endioctl();
+		}
+	;
+
+inlist:	  inelt
+		{ $$ = mkchain($1, CHNULL); }
+	| inlist SCOMMA inelt
+		{ $$ = hookup($1, mkchain($3, CHNULL)); }
+	;
+
+inelt:	  lhs
+		{ $$ = (tagptr) $1; }
+	| SLPAR inlist SCOMMA dospec SRPAR
+		{ $$ = (tagptr) mkiodo($4,$2); }
+	;
+
+outlist:  uexpr
+		{ $$ = mkchain($1, CHNULL); }
+	| other
+		{ $$ = mkchain($1, CHNULL); }
+	| out2
+	;
+
+out2:	  uexpr SCOMMA uexpr
+		{ $$ = mkchain($1, mkchain($3, CHNULL) ); }
+	| uexpr SCOMMA other
+		{ $$ = mkchain($1, mkchain($3, CHNULL) ); }
+	| other SCOMMA uexpr
+		{ $$ = mkchain($1, mkchain($3, CHNULL) ); }
+	| other SCOMMA other
+		{ $$ = mkchain($1, mkchain($3, CHNULL) ); }
+	| out2  SCOMMA uexpr
+		{ $$ = hookup($1, mkchain($3, CHNULL) ); }
+	| out2  SCOMMA other
+		{ $$ = hookup($1, mkchain($3, CHNULL) ); }
+	;
+
+other:	  complex_const
+		{ $$ = (tagptr) $1; }
+	| SLPAR uexpr SCOMMA dospec SRPAR
+		{ $$ = (tagptr) mkiodo($4, mkchain($2, CHNULL) ); }
+	| SLPAR other SCOMMA dospec SRPAR
+		{ $$ = (tagptr) mkiodo($4, mkchain($2, CHNULL) ); }
+	| SLPAR out2  SCOMMA dospec SRPAR
+		{ $$ = (tagptr) mkiodo($4, $2); }
+	;
+
+in_ioctl:
+		{ startioctl(); }
+	;
diff --git a/usr/src/usr.bin/f77/src/f77pass1/io.h b/usr/src/usr.bin/f77/src/f77pass1/io.h
new file mode 100644
index 0000000000..7fb12cb528
--- /dev/null
+++ b/usr/src/usr.bin/f77/src/f77pass1/io.h
@@ -0,0 +1,58 @@
+
+#define NDDATA	1
+#define NDLABEL	2
+#define NDADDR	3
+#define NDNULL	4
+
+
+
+
+typedef
+  struct IoAddr
+    {
+      int stg;
+      int memno;
+      ftnint offset;
+    }
+  ioaddr;
+
+
+
+typedef
+  union IoValue
+    {
+      Constp cp;
+      ftnint label;
+      struct IoAddr addr;
+    }
+  iovalue;
+
+
+
+typedef
+  struct IoBlock
+    {
+      struct IoBlock *next;
+      int blkno;
+      ftnint len;
+      struct OffsetList *olist;
+    }
+  ioblock;
+
+
+
+typedef
+  struct OffsetList
+    {
+      struct OffsetList *next;
+      ftnint offset;
+      int tag;
+      union IoValue val;
+    }
+  offsetlist;
+
+
+
+
+extern ioblock *iodata;
+
-- 
2.20.1