--- a/index.ind	Wed Oct 14 18:50:31 2020 +0900
+++ b/index.ind	Wed Oct 14 20:33:17 2020 +0900
@@ -1,7 +1,12 @@
 -title: TL/1
 
-<a href="tl1j.html"> TL/1 言語仕様書 </a>l
-<a href="t1.tl1"> 例題 t1.tl1 </a>
-<a href="t2.tl1"> 例題 t2.tl1 </a>
-<a href="t3.tl1"> 例題 t3.tl1 </a>
-<a href="t4.tl1"> 例題 t4.tl1 </a>
+<a href="tl1j.html"> TL/1 言語仕様書 </a><br>
+<a href="t1.tl1"> 例題 t1.tl1 </a><br>
+<a href="t2.tl1"> 例題 t2.tl1 </a><br>
+<a href="t3.tl1"> 例題 t3.tl1 </a><br>
+<a href="t4.tl1"> 例題 t4.tl1 </a><br>
+
+<a href=tl1trans/tl1trans.pl"> translater to C</a><br>
+
+
+

--- a/tl1trans/tl1trans.pl	Wed Oct 14 18:50:31 2020 +0900
+++ b/tl1trans/tl1trans.pl	Wed Oct 14 20:33:17 2020 +0900
@@ -37,10 +37,22 @@
 
 my @procs;
 my @funcs;
+my @array;
 my @gvar;
+my %args;
+my $proc = "";
+
+sub isfunc {
+    foreach my $key (@funcs) {
+        return 1 if ($key eq $proc) ;
+    }
+    return 0;
+}
 
 &getDecl;
 &procs;
+&proto;
+my $nest = 0;
 
 # get line without comment
 sub getline {
@@ -63,6 +75,11 @@
             # print "func @func\n";
             next;
         }
+        if (/^ARRAY (.*)/) {
+            @array = split(/,/,$1);
+            # print "func @func\n";
+            next;
+        }
         if (/^VAR (.*)/) {
             @gvar = split(/,/,$1);
             # print "gvar @gvar\n";
@@ -73,26 +90,30 @@
             for my $var (@gvar) {
                 $gvar .= "unsigned char $var;\n";
             }
-            my $procs =  "";
-            for my $var (@procs) {
-                $procs .= "void $var();\n";
+            my $array = "";
+            for my $var (@array) {
+                $array .= "unsigned char $var;\n";
             }
-            my $funcs =  "";
-            for my $var (@funcs) {
-                $procs .= "int $var();\n";
-            }
+            my $procs =  "";
+            #            for my $var (@procs) {
+            #    $procs .= "void $var();\n";
+            #}
+            #my $funcs =  "";
+            #for my $var (@funcs) {
+            #    $procs .= "int $var();\n";
+            #}
             print <<"EOFEOF";
 #include <stdio.h>
 #include <string.h>
 #include <unistd.h>
+#include "proto.h"
 
 $gvar;
-$procs;
-$funcs;
+$array;
 
 int main(int ac, char *av[]) {
 EOFEOF
-            &statement;
+            $nest = 1 ; &statement(0);
             print <<"EOFEOF";
    return 0;
 }
@@ -102,10 +123,15 @@
     }
 }
 
+our $cnest = 0;
 sub statement {
-    my $nest = 1 ;
+    my ($skip) = @_;
     statement : while(1) {
-        &getline; chop;
+        if ($skip) {
+            $skip = 0;
+        } else {
+            &getline; chop;
+        }
         while($_ ne "") {
             if (s/^WRITE\((\d+)://)  {
                 my $d = $1;
@@ -137,20 +163,56 @@
                     }
                 }
             } elsif (s/^[[({]//) {
-                &output("{"); next;
+                &output("{"); $nest++; next;
             } elsif (s/^[])}]//) {
-                &output("}"); next;
+                &output("}"); $nest--; next;
             #     FOR I:=1 TO 10 DO [
             } elsif (s/^FOR\s+(\w+):=(\w+)\s+TO\s+(\w+)\s+DO\s*//) { 
                 &output("for($1=$2;$1<$3;$1++)");
+            } elsif (s/^FOR\s+(\w+):=(\w+)\s+DOWNTO\s+(\w+)\s+DO\s*//) { 
+                &output("for($1=$2;$1>$3;$1--)");
+            } elsif (s/^CASE\s+(\w+)\s+OF\s+(\w+)//) { 
+                local $cnest;
+                &output("switch ($1) { \n case $1 : ");
+                while (1) {
+                  $cnest = $nest ; $nest = 0; &statement(1);
+                  if (s/\s+ELSE\s+(\w+)\s+//) {
+                      &output("\ndefault:\n");
+                      &statement(1) ;
+                      &output("}\n");
+                      last;
+                  } elsif (s/\s+(\w+)\s+//) {
+                      &output("\ncase $1:\n");
+                  }
+                }
+                $nest = $cnest ;
+            } elsif (s/^IF//) { 
+                &output("if (");
+            } elsif (s/^THEN//) { 
+                &output(") ");
+            } elsif (s/^ELSE//) { 
+                &output(" else ");
+            } elsif (s/^REPEAT//) { 
+                &output("do { ");
+            } elsif (s/^WHILE\s+(.*)\s+DO\s+//) { 
+                &output("while ($1) "); 
+            } elsif (s/^UNTIL\s+(.*)//) { 
+                &output("} while ($1 == 0);"); 
             } elsif (s/^BEGIN//)  {
+                &output("{"); 
                 $nest++;
             } elsif (s/^END//)  {
+                &output("}"); 
                 $nest--;
                 last statement if ($nest==0) ;
             } elsif (s/^(\w+)//)  {
                 &output(" $1();");
+            } elsif (s/^RETURN\s*(\w*)//) {
+                &output("return $1;");
+            } elsif (s/^:=//) {
+                &output("=");
             } elsif (s/^.//) {
+                &output($&);
             }
         }
         print "\n  ";
@@ -163,7 +225,6 @@
 
 sub procs {
     my @lvar;
-    my $proc = "";
     while(1) {
         &getline;
         if (/^VAR (.*)/) {
@@ -180,16 +241,37 @@
 $lvar;
 EOFEOF
         } elsif (/^BEGIN/) {
-            &statement;
+            $nest = 1;
+            &statement(0);
             print <<"EOFEOF";
 } // end $proc
 EOFEOF
+        } elsif (/^(\w+)\([\w,]+\)/) {
+            $proc = $1;
+            $args{$proc} = $2; #  split(/,/,$2);
         } elsif (/^(\w+)/) {
             $proc = $1;
         }
     }
 }
 
+sub proto {
+    open my $fd, ">","proto.h";
+    foreach my $key ( keys %args ) {
+        if (&isfunc($key)) {
+           print $fd "int ";
+        } else {
+           print $fd "void ";
+        }
+        print $fd $key,"(";
+        if ($args{$key}) {
+           print $fd "unsigned char ",join(",unsigned char ",split(/,/,$args{$key}));
+        }
+        print $fd ");\n";
+    }
+    close $fd;
+}
+
 sub output { 
     my ($o) = @_;
     print $o;