ruby-dcl 1.6.2

data/GenWrapper/proto/misc1_fmtlib.fp

@@ -0,0 +1,19 @@
+/*
+ * misc1_fmtlib.fp
+ *
+ * $Id: misc1_fmtlib.fp,v 1.1.1.1 2011-02-23 07:21:28 horinout Exp $
+ */
+
+/*****************************************************
+ * misc1/fmtlib/chval.f
+ ****************************************************/
+/* 
+ *      SUBROUTINE CHVAL(CFMT,VAL,CVAL)
+ *      CHARACTER CFMT*(*),CVAL*(*)
+ */
+      SUBROUTINE CHVAL(
+          CHARACTER*(*) CFMT
+          REAL VAL
+          CHARACTER*(*) o CVAL
+      )
+

data/GenWrapper/proto/misc1_misclib.fp

@@ -0,0 +1,26 @@
+/*
+ * misc1_misclib.fp
+ *
+ * $Id: misc1_misclib.fp,v 1.1.1.1 2011-02-23 07:21:28 horinout Exp $
+ */
+
+/*****************************************************
+ * misc1/misclib/cns.f
+ ****************************************************/
+/* 
+ *      CHARACTER*1 FUNCTION CNS(INS)
+ */
+      CHARACTER*1 FUNCTION CNS(
+          INTEGER INS
+      )
+
+/*****************************************************
+ * misc1/misclib/cdblk.f
+ ****************************************************/
+/* 
+ *      SUBROUTINE CDBLK(CHR)
+ *      CHARACTER CHR*(*)
+ */
+      SUBROUTINE CDBLK(
+          CHARACTER*(*) io CHR
+      )

data/GenWrapper/proto/misc1_randlib.fp

@@ -0,0 +1,36 @@
+/*
+ * misc1_randlib.fp
+ *
+ * $Id: misc1_randlib.fp,v 1.1.1.1 2011-02-23 07:21:28 horinout Exp $
+ */
+
+/*****************************************************
+ * misc1/randlib/rngu1.f
+ ****************************************************/
+/* 
+ *      REAL FUNCTION RNGU1(ISEED)
+ */
+      REAL FUNCTION RNGU1(
+          INTEGER io ISEED
+      )
+
+/*****************************************************
+ * misc1/randlib/rngu2.f
+ ****************************************************/
+/* 
+ *      REAL FUNCTION RNGU2(ISEED)
+ */
+      REAL FUNCTION RNGU2(
+          INTEGER io ISEED
+      )
+
+/*****************************************************
+ * misc1/randlib/rngu3.f
+ ****************************************************/
+/* 
+ *      REAL FUNCTION RNGU3(ISEED)
+ */
+      REAL FUNCTION RNGU3(
+          INTEGER io ISEED
+      )
+

data/GenWrapper/proto/misc1_timelib.fp

@@ -0,0 +1,151 @@
+/*
+ * misc1_timelib.fp
+ *
+ * $Id: misc1_timelib.fp,v 1.1.1.1 2011-02-23 07:21:28 horinout Exp $
+ */
+
+/*****************************************************
+ * misc1/timelib/time12.f
+ ****************************************************/
+/* 
+ *      SUBROUTINE TIME12(ITIME,ITT)
+ */
+      SUBROUTINE TIME12(
+          INTEGER ITIME
+          INTEGER o ITT
+      )
+
+/*****************************************************
+ * misc1/timelib/time13.f
+ ****************************************************/
+/* 
+ *      SUBROUTINE TIME13(ITIME,IH,IM,IS)
+ */
+      SUBROUTINE TIME13(
+          INTEGER ITIME
+          INTEGER o IH
+          INTEGER o IM
+          INTEGER o IS
+      )
+
+/*****************************************************
+ * misc1/timelib/time21.f
+ ****************************************************/
+/* 
+ *      SUBROUTINE TIME21(ITIME,ITT)
+ */
+      SUBROUTINE TIME21(
+          INTEGER o ITIME
+          INTEGER ITT
+      )
+
+/*****************************************************
+ * misc1/timelib/time23.f
+ ****************************************************/
+/* 
+ *      SUBROUTINE TIME23(IH,IM,IS,ITT)
+ */
+      SUBROUTINE TIME23(
+          INTEGER o IH
+          INTEGER o IM
+          INTEGER o IS
+          INTEGER ITT
+      )
+
+/*****************************************************
+ * misc1/timelib/time31.f
+ ****************************************************/
+/* 
+ *      SUBROUTINE TIME31(ITIME,IH,IM,IS)
+ */
+      SUBROUTINE TIME31(
+          INTEGER o ITIME
+          INTEGER IH
+          INTEGER IM
+          INTEGER IS
+      )
+
+/*****************************************************
+ * misc1/timelib/time32.f
+ ****************************************************/
+/* 
+ *      SUBROUTINE TIME32(IH,IM,IS,ITT)
+ */
+      SUBROUTINE TIME32(
+          INTEGER IH
+          INTEGER IM
+          INTEGER IS
+          INTEGER o ITT
+      )
+
+/*****************************************************
+ * misc1/timelib/timec1.f
+ ****************************************************/
+/* 
+ *      SUBROUTINE TIMEC1(CFORM,ITIME)
+ *      CHARACTER CFORM*(*)
+ */
+      SUBROUTINE TIMEC1(
+          CHARACTER*(*) io CFORM
+          INTEGER ITIME
+      )
+
+/*****************************************************
+ * misc1/timelib/timec2.f
+ ****************************************************/
+/* 
+ *      SUBROUTINE TIMEC2(CFORM,ITT)
+ *      CHARACTER CFORM*(*)
+ */
+      SUBROUTINE TIMEC2(
+          CHARACTER*(*) io CFORM
+          INTEGER ITT
+      )
+
+/*****************************************************
+ * misc1/timelib/timec3.f
+ ****************************************************/
+/* 
+ *      SUBROUTINE TIMEC3(CFORM,IH,IM,IS)
+ *      CHARACTER CFORM*(*)
+ */
+      SUBROUTINE TIMEC3(
+          CHARACTER*(*) io CFORM
+          INTEGER IH
+          INTEGER IM
+          INTEGER IS
+      )
+
+/*****************************************************
+ * misc1/timelib/timeq1.f
+ ****************************************************/
+/* 
+ *      SUBROUTINE TIMEQ1(ITIME)
+ */
+      SUBROUTINE TIMEQ1(
+          INTEGER o ITIME
+      )
+
+/*****************************************************
+ * misc1/timelib/timeq2.f
+ ****************************************************/
+/* 
+ *      SUBROUTINE TIMEQ2(ITT)
+ */
+      SUBROUTINE TIMEQ2(
+          INTEGER o ITT
+      )
+
+/*****************************************************
+ * misc1/timelib/timeq3.c
+ ****************************************************/
+/* 
+ *      void timeq3_(ih, im, is)
+ */
+/*
+      SUBROUTINE TIMEQ3(
+          INTEGER o IH
+          INTEGER o IM
+          INTEGER o IS
+      )
+*/

data/GenWrapper/proto2c.rb

@@ -0,0 +1,13 @@
+# proto2c.rb
+#   $Id: proto2c.rb,v 1.1.1.1 2011-02-23 07:21:28 horinout Exp $
+
+require "./pparse"
+
+ARGV.each do |f|
+  i = 0
+  PrototypeParser.new(f).parse do |x|
+    print "\n" if i > 0
+    i += 1
+    print x
+  end
+end

data/GenWrapper/prototype.rb

@@ -0,0 +1,209 @@
+# prototype.rb
+#   $Id: prototype.rb,v 1.1.1.1 2011-02-23 07:21:28 horinout Exp $
+
+require "./util"
+require "./variable"
+
+class Prototype
+  INDENT = " "*4
+
+  def indent(n=1)
+    INDENT*n
+  end
+
+  def initialize(type_or_module, name, args, rtn)
+    @vtype = (type_or_module == :module ? nil : type_or_module)
+    @name = name
+    @args = args
+    @rtnval = rtn
+    @lenvar = []
+    @rtnlenvar =[]
+
+    # check output array size
+    chk = @rtnval.find_all{|o| o.ary}
+    chk += @args.find_all{|o| (o.ary && !o.output?)}
+    chk.each{|o|
+      size = []
+      o.ary.split(",").each do |i|
+        case i
+        when "*"
+          size.push "DFLT_SIZE"
+          next
+        when /^\d+$/
+          size.push i
+          next
+        when /^(\d+):(\d+)$/
+          size.push($2.to_i - $1.to_i + 1)
+          next
+        end
+
+        wk = i.gsub(/[a-z]+[a-z0-9]*/){|j|
+          sz = @args.find{|x| x.name == j}
+          if sz
+            sz.localvariable[1]
+          else
+            "DFLT_SIZE"
+          end
+        }
+
+        case wk
+        when /(.+):(.+)/
+          ed = ($2 == "*" ? "DFLT_SIZE" : $2)
+          size.push( "(" + (ed + "-" + $1 + "+1").
+                     gsub("--", "+").gsub("-0","").
+                     gsub("[-]1[+]1", "").gsub("[+]1[+]1", "+2") +
+                     ")" )
+        else
+          size.push wk
+        end
+      end
+      o.setarysize(size)
+      p ["Prototype:1", @name, o.ary, size, o.arysize] if $DEBUG
+    }
+
+    # set @lenvar
+    @args.each{|i|
+      j = i.ftnlen
+      @lenvar.push j if j
+    }
+
+    # set @rtnlenvar
+    if @vtype
+      @rtnval.each{|i|
+        j = i.ftnlen
+        @rtnlenvar.push j if j
+      }
+    end
+
+  end
+
+  def to_s
+    buf = head
+    defvar = defvar()
+    buf << defvar
+    buf << initialization
+    buf << call
+    buf << result
+    buf << tail
+  end
+
+  def head
+    vstr = @args.find_all{|i| i.input?}.
+      collect{|i| i.name}.unshift("obj").join(", ")
+    buf = "static VALUE\n"
+    buf << format("dcl_%s(%s)\n", @name, vstr)
+    buf << format("%sVALUE %s;\n{\n", indent, vstr)
+  end
+
+  def defvar
+    buf = ""
+    vars = @args + (@vtype ? @rtnval : [])
+    vars.each{|i|
+      t, n = i.localvariable
+      if /\*$/ =~ t
+        buf << format("%s%s%s;\n", indent, t, n)
+      else
+        buf << format("%s%s %s;\n", indent, t, n)
+      end
+    }
+
+    @rtnval.each{|i|
+      buf << format("%s%s %s;\n", indent, "VALUE", i.name) if !i.input?
+    }
+    buf << "\n" unless buf.empty?
+    buf
+  end
+
+  def initialization
+    buf = ""
+    @args.find_all{|i| i.input?}.each{|i|
+      j = i.checktype
+      buf << j.gsub(/^/, indent) if j
+    }
+    buf << "\n" unless buf.empty?
+
+    @args.find_all{|i| i.input? && !i.ary}.each{|i|
+      j = i.initialization
+      buf << j.gsub(/^/, indent) if j
+    }
+    @args.find_all{|i| i.input? && i.ary}.each{|i|
+      j = i.initialization
+      buf << j.gsub(/^/, indent) if j
+    }
+    buf << "\n" unless buf.empty?
+
+    wk = @rtnval.find_all{|i| !i.input?} +
+         @args.find_all{|i| i.work?}
+    wk.each{|i|
+      j = i.allocworkingarea
+      buf << j.gsub(/^/, indent) if j
+    }
+    buf << "\n" unless buf.empty?
+
+    buf
+  end
+
+  def call
+    buf = ""
+    buf << indent
+    if @vtype
+      if ( @vtype =~ /CHARACTER|COMPLEX/)
+        wk = [@rtnval[0].arg_name] + @rtnlenvar +
+	  @args.collect{|i| i.arg_name} + @lenvar
+      else
+        buf << (@rtnval[0].prefix + @rtnval[0].name + " = ")
+        wk = @args.collect{|i| i.arg_name} + @lenvar
+      end
+    else
+      wk = @args.collect{|i| i.arg_name} + @lenvar
+    end
+    buf << format("%s_(%s);\n", @name, wk.join(", "))
+    buf << "\n" unless buf.empty?
+    buf
+  end
+
+  def result
+    buf = ""
+    if @vtype
+      buf << indent + @rtnval[0].getresult
+    else
+      @rtnval.each{|i|
+        buf << (indent + i.getresult)
+      }
+    end
+    buf << "\n" unless buf.empty?
+
+    # free area allocated at initialization
+    @args.find_all{|i| i.input?}.each{|i|
+      j = i.freecary
+      buf << j.gsub(/^/, indent) if j
+    }
+
+    # free area allocated at allocworkingarea
+    wk = @rtnval.find_all{|i| !i.input?} +
+         @args.find_all{|i| i.work?}
+    wk.each{|i|
+      j = i.freeworkingarea
+      buf << j.gsub(/^/, indent) if j
+    }
+    buf << "\n" unless buf.empty?
+
+    if (@vtype || (@rtnval.size == 1))
+      buf << indent +
+             format("return %s;\n", @rtnval[0].name)
+    elsif ( @rtnval.size == 0 )
+      buf << indent + "return Qnil;\n"
+    else
+      vars = @rtnval.collect{|i| i.name}
+      buf << indent +
+             format("return rb_ary_new3(%d, %s);\n",
+                    vars.size, vars.join(", "))
+    end
+    buf << "\n" unless buf.empty?
+    buf
+  end
+
+  def tail
+    "}\n"
+  end
+end