From: Keith Bostic <bostic@ucbvax.Berkeley.EDU>
Date: Wed, 17 Apr 1991 05:58:54 +0000 (-0800)
Subject: date and time created 91/04/16 14:58:54 by bostic
X-Git-Tag: BSD-4_3_Net_2-Snapshot-Development~30
X-Git-Url: https://git.subgeniuskitty.com/unix-history/.git/commitdiff_plain/4e64cc4d512813b5643f08a1b78435c1d828bb41

date and time created 91/04/16 14:58:54 by bostic

SCCS-vsn: usr.bin/pascal/pdx/test/fproc.p 5.1
---

diff --git a/usr/src/usr.bin/pascal/pdx/test/fproc.p b/usr/src/usr.bin/pascal/pdx/test/fproc.p
new file mode 100644
index 0000000000..9084de1653
--- /dev/null
+++ b/usr/src/usr.bin/pascal/pdx/test/fproc.p
@@ -0,0 +1,56 @@
+(*
+ * Copyright (c) 1980 The Regents of the University of California.
+ * All rights reserved.
+ *
+ * %sccs.include.redist.c%
+ *
+ *	@(#)fproc.p	5.1 (Berkeley) %G%
+ *)
+
+program fproc(output);
+    var
+    i :integer;
+
+    procedure print(function frtn :integer);
+	begin
+	    write(frtn:3,'   formal routine =');
+	end;
+
+    procedure lvl1(function form: integer);
+	label	1;
+	var
+	loc :integer;
+
+	function eval :integer;
+	    begin
+		if loc = 8 then begin
+			writeln(' non-local jump');
+			goto 1;
+		end;
+		eval := loc;
+	    end;
+
+    begin
+	loc := i;
+	i := i - 1;
+	if (loc = 4) or (loc = 8) then
+		lvl1(eval)
+	else if loc > 0 then
+		lvl1(form);
+1:	write('Stack frame:',loc:3,'   formal print =');
+	print(form);
+	writeln(form:3);
+    end;
+
+    function geval :integer;
+	begin
+	    geval := i;
+	end;
+
+    begin
+	writeln('This should print levels 0-3, with formal values of 4.');
+	writeln('Level 4 should jump to level 8.');
+	writeln('Finally levels 8-10 should print with formal values of -1.');
+	i := 10;
+	lvl1(geval);
+    end.