ruby-dcl 1.7.1 → 1.8.2

data/GenWrapper/dcl_rb_heading

@@ -1,123 +0,0 @@
-require "narray"
-require "numru/dcl_raw"
-
-module NumRu
-    module DCL
-      init_arg($0,ARGV) if DCLVERSION >= "5.3.2"
-
-      #<<< private functions >>>
-
-      def not_nary( na )
-	if defined?(NArrayMiss)
-	  !na.is_a?(NArray) && !na.is_a?(NArrayMiss)
-	else
-	  !na.is_a?(NArray)
-	end
-      end
-      module_function :not_nary
-      private_class_method :not_nary
-
-      #<<< ??p(set|stx|get) >>>
-
-      %w!gl sl sg uc ud ue ug ui ul um uu uz!.each do |pkg|
-	 %w!set stx!.each do |set|
-	    eval <<-EOS
-	       def #{pkg}p#{set}( name, value )
-		  case name
-		  when /^l/i
-		     DCL.#{pkg}l#{set}(name,value)
-		  when /^[i-n]/i
-		     DCL.#{pkg}i#{set}(name,value)
-		  else
-		     DCL.#{pkg}r#{set}(name,value)
-		  end
-	       end
-	       module_function :#{pkg}p#{set}
-	    EOS
-	 end
-	 eval <<-EOS
-	    def #{pkg}pget( name )
-	       case name
-	       when /^l/i
-		  DCL.#{pkg}lget(name)
-	       when /^[i-n]/i
-		  DCL.#{pkg}iget(name)
-	       else
-		  DCL.#{pkg}rget(name)
-	       end
-	    end
-	    module_function :#{pkg}pget
-	 EOS
-      end
-
-      %w!us!.each do |pkg|
-	 %w!set stx!.each do |set|
-	    eval <<-EOS
-	       def #{pkg}p#{set}( name, value )
-		  case name
-		  when /^c/i
-		     DCL.#{pkg}c#{set}(name,value)
-		  when /^l/i
-		     DCL.#{pkg}l#{set}(name,value)
-		  when /^[i-n]/i
-		     DCL.#{pkg}i#{set}(name,value)
-		  else
-		     DCL.#{pkg}r#{set}(name,value)
-		  end
-	       end
-	       module_function :#{pkg}p#{set}
-	    EOS
-	 end
-	 eval <<-EOS
-	    def #{pkg}pget( name )
-	       case name
-	       when /^c/i
-		  DCL.#{pkg}cget(name)
-	       when /^l/i
-		  DCL.#{pkg}lget(name)
-	       when /^[i-n]/i
-		  DCL.#{pkg}iget(name)
-	       else
-		  DCL.#{pkg}rget(name)
-	       end
-	    end
-	    module_function :#{pkg}pget
-	 EOS
-      end
-
-      @@sw_char_params = [/^WSNAME/i,/^FONT/i,/^CL2TN$/i,/^FNAME$/i,/^TITLE$/i,
-	    /^CLRMAP$/i,/^LPR$/i]
-      %w!set stx!.each do |set|
-         eval <<-EOS
-	    def swp#{set}(name, value)
-	       case name
-	       when *@@sw_char_params
-		  DCL.swc#{set}(name,value)
-	       when /^l/i
-		  DCL.swl#{set}(name,value)
-	       when /^[i-n]/i
-		  DCL.swi#{set}(name,value)
-	       else
-		  DCL.swr#{set}(name,value)
-	       end
-	    end
-	    module_function :swp#{set}
-	 EOS
-      end
-      def swpget( name )
-	 case name
-	 when *@@sw_char_params
-	    DCL.swcget(name)
-	 when /^l/i
-	    DCL.swlget(name)
-	 when /^[i-n]/i
-	    DCL.swiget(name)
-	 else
-	    DCL.swrget(name)
-	 end
-      end
-      module_function :swpget
-
-
-      #<<< to eliminate array length arguments >>>
-

data/GenWrapper/def.rb

@@ -1,20 +0,0 @@
-# def.rb
-#   $Id: def.rb,v 1.1.1.1 2011/02/23 07:21:28 horinout Exp $
-
-OBJ2CCHARARY    = "dcl_obj2ccharary"
-OBJ2CINTEGERARY = "dcl_obj2cintegerary"
-OBJ2CREALARY    = "dcl_obj2crealary"
-OBJ2CCOMPLEXARY = "dcl_obj2ccomplexary"
-OBJ2CLOGICALARY = "dcl_obj2clogicalary"
-
-CCHARARY2OBJ    = "dcl_ccharary2obj"
-CINTEGERARY2OBJ = "dcl_cintegerary2obj"
-CREALARY2OBJ    = "dcl_crealary2obj"
-CCOMPLEXARY2OBJ = "dcl_ccomplexary2obj"
-CLOGICALARY2OBJ = "dcl_clogicalary2obj"
-
-FREECCHARARY    = "dcl_freeccharary"
-FREECINTEGERARY = "dcl_freecintegerary"
-FREECREALARY    = "dcl_freecrealary"
-FREECCOMPLEXARY = "dcl_freeccomplexary"
-FREECLOGICALARY = "dcl_freeclogicalary"

data/GenWrapper/elim_ary_size.rb

@@ -1,398 +0,0 @@
-# Eliminate array size arguments
-#  May 13, 2002   T. Horinouchi  
-#
-# Usage:
-# % ruby generate_new_rbdcl.rb proto_files
-# where files are grph2_uvpack.fp math2_fftlib.fb etc (in the proto directory)
-
-class Variable
-  def initialize(decl)
-    name, *tmp = decl.split.reverse
-    tmp.reverse!
-    attr = (tmp[-1] =~ /^[a-z]+$/ ? tmp.pop : "i")
-    ary =  (tmp[-1] =~ /^\((.*)\)/ ? (tmp.pop; $1.downcase) : false)
-    vtype = tmp.pop
-    if (/(\d+)|\*\((.*)\)/ =~ vtype)
-      charlen = ($1||$2).downcase   # may be charcter length
-      vtype = vtype.scan(/\w+/)[0]
-    else
-      charlen = nil
-    end
-    @name = name.downcase
-    @attr = attr
-    @ary = ary
-    @vtype = vtype.downcase
-  end
-
-  attr_reader(:name, :attr, :ary, :vtype)
-end
-
-def pre_filter(decl)
-  case $method_name
-  when /(^ud|^ue|^ui)/
-    # replace MX with NX
-    decl.gsub!('MX','NX')
-  when /^ug/
-    # replace MU & MV with NX
-    decl.gsub!(/(MU|MV)/,'NX')
-  end
-  decl
-end
-
-def extract_args(proto)
-  args_org = []
-  while ( decl = proto.gets )
-    break if decl =~ /^ *\)$/
-    decl = pre_filter(decl)
-    if ( decl !~ /^\s*$/ )
-      print decl if $DEBUG
-      var = Variable.new(decl)
-      p var if var.ary if $DEBUG
-      if var.attr != "o" && var.attr != "t"
-	args_org.push(var)
-      else
-      end
-    end
-  end
-  args_org
-end
-
-def has_array?( args )
-  args.each do |v|
-    return true if v.ary
-  end
-  false
-end
-
-def new_args( args_org )
-  del_argname = []
-  args_org.each do |v|
-    if ( (shape = v.ary) )
-      shape = shape.split(',')
-      shape.each do |lendef|
-	lpos = lendef.index(/([a-z]\w*)/)
-	m = $1
-	if ( lpos )
-	  lpos2 = lendef.index(/([a-z]\w*)/,lpos+m.length)
-	  if (!lpos2)
-	    # to be deleted only when unambiguous
-	    del_argname.push(m) if m && !del_argname.include?(m)
-	  end
-	end
-      end
-    end
-  end
-  args_new = args_org.clone
-  del_argname.each do |nm|
-    args_new.delete_if {|v| 
-	v.name == nm
-    }
-  end
-  print "  ORG: ", args_org.collect{|i| i.name}.join(','),"\n" if $DEBUG
-  print "  NEW: ", args_new.collect{|i| i.name}.join(','),"\n" if $DEBUG
-  print "  args deleted: ",del_argname.join(','),"\n" if $DEBUG
-  [args_new, del_argname]
-end
-
-
-def new_def( args_org, args_new, del_argname )
-  method_def = <<-EOS
-      alias __#{$method_name} #{$method_name} 
-      def #{$method_name}( #{args_new.collect{|i| i.name}.join(',')} )
-  EOS
-  method_def.concat( del_arg_deriv( args_new, del_argname ) )
-  args_org_names = args_org.collect{|arg| arg.name}
-  method_def.concat( check_array_size( args_new, args_org_names ) )
-  method_def.concat( <<-EOS
-
-        #< call the original method >
-        __#{$method_name}( #{args_org.collect{|i| i.name}.join(',')} )
-      end
-      module_function :#{$method_name}, :__#{$method_name} 
-      private_class_method :__#{$method_name}
-
-  EOS
-  )
-
-  #print '*** ',method_def
-  method_def
-end
-
-#def wrap_in_rundef_rescue(
-#        if ( #{v.name}.is_a(Float) && x == glrget("RMISS") )
-#end
-
-def del_arg_deriv( args_new, del_argname )
-  deriv = ""
-  first = true
-  del_argname.each do |nm|
-    ary = []
-    args_new.each do |v|
-      if v.ary && v.ary =~ /\W*#{nm}\W*/
-	ary.push( [ v.name, inv_deriv(nm, v.ary, v.name) ] )
-	if (!possibly_rundef?(nm, v.name))
-	  break
-	end
-      end
-    end
-    if(first)
-      deriv = <<-EOS
-
-        #< extract array size(s) (which was(were) formerly an argument(s)) >
-      EOS
-      first = false
-    end
-    deriv.concat( recursive_join( ary ) )
-  end
-  deriv
-end
-
-def possibly_rundef?(argname, varname)
-  case $method_name
-  when /(^usgrph|^usspnt)/
-    if( argname == 'n' && varname == 'x' )
-      return true
-    elsif ( argname == nil )
-      return true
-    end
-  when /(^uulin|^uumrk|^uv|^uh)/
-    if ( argname == 'n' && 
-	( varname == 'upx'  || varname == 'upy'  ||
-	  varname == 'upx1' || varname == 'upx2' || 
-	  varname == 'upy1' || varname == 'upy2' ) )
-      return true
-    elsif ( argname == nil )
-      return true
-    end
-  end
-  false
-end
-
-def recursive_join( ary )
-  first = ary.shift
-  if( ary.length > 0)
-    str = <<-EOS
-        if ! ( #{first[0]} == nil || #{first[0]}.is_a?(Float) && lreq( #{first[0]}, glrget("RUNDEF") ) )
-#{first[1].gsub(/^/,"  ").chop}
-        else
-    EOS
-    str += <<-EOS
-          #{first[0]} = glrget("RUNDEF") if ( #{first[0]} == nil )
-#{recursive_join(ary).gsub(/^/,"  ").chop}
-        end
-    EOS
-  else
-    first[1]
-  end
-end
-
-
-def inv_arithm(lendef, varname)
-  case lendef
-  when varname
-    form = "LEN"
-  when /^(\w+) *\* *#{varname}$/
-    form = "LEN / #{$1}"
-  when /^#{varname} *\/ *(\w+)$/
-    form = "LEN * #{$1}"
-  when /^#{varname} *\+ *(\w+)$/
-    form = "LEN - #{$1}"
-  when /^\(*(\w+) *\* *#{varname} *\+ *(\w+)\)*$/
-    form = "( LEN - #{$2} ) / #{$1}"
-  else
-    raise 'unsuppoerted dimension specification : '+lendef
-  end
-  form
-end
-
-def inv_deriv(argname, shape, aryname)
-  deriv = ""
-  shape = shape.split(',')
-  multiD = ( shape.length > 1 )
-  shape.each_index do |i|
-    if (lendef=shape[i]) =~ /\W*#{argname}\W*/
-      idim = i
-      form = inv_arithm( lendef, argname )
-      form.sub!('LEN',"len_#{aryname}_#{idim}")
-      if multiD
-	deriv = <<-EOS
-        if ( not_nary(#{aryname}) || (#{aryname}.rank < #{idim+1}) )
-          raise "#{aryname} must be a NArray of rank == #{shape.length}"
-        end
-        len_#{aryname}_#{idim} = #{aryname}.shape[#{idim}]
-	EOS
-      else
-	deriv = <<-EOS
-        len_#{aryname}_#{idim} = #{aryname}.length
-	EOS
-      end
-      deriv.concat( <<-EOS
-        #{argname} = #{form}
-      EOS
-      )
-      print deriv if $DEBUG
-      break
-    end
-  end
-  deriv
-end
-
-def aster2dimlen_if_possible( varname, dimlen ) 
-  if $method_name =~ /(^rvmax|^rvmin)/ && varname == 'rx'
-    dimlen.replace('(len=1; ns.each{|i| len*=i}; len)')
-    true
-  else
-    raise $!
-  end
-end
-
-def consist_of_names?(str, names)
-  ary = str.split(/\W/).uniq     
-  names.each{|str| ary.delete(str)}
-  ary.each do |str| 
-    return false if (/^\d*$/ !~ str)
-  end
-  true
-end
-
-def check_array_size( args_new, args_org_names )
-  body = <<-EOS
-
-        #< check array size(s) >
-  EOS
-  args_new.each do |v|
-    if ( v.ary )
-      shape = v.ary.split(',')
-      if ( shape.length == 1 )
-	arylen_replaced = false
-	if ( shape[0] == '*' )
-	  begin
-	    raise "Array #{v.name} is declared using *"
-	  rescue
-	    arylen_replaced = aster2dimlen_if_possible( v.name, shape[0] ) 
-	  end
-	end
-	if possibly_rundef?(nil, v.name)
-	  ins = "\\\n            #{v.name}!=nil && !( #{v.name}.is_a?(Float) && lreq(#{v.name},glrget(\"RUNDEF\")) ) && "
-	else
-	  ins = ""
-	end
-	if arylen_replaced || consist_of_names?(shape[0], args_org_names )
-	body.concat( <<-EOS
-        raise "Invalid array length: #{v.name}.length != #{shape[0]}" if #{ins}#{v.name}.length != (#{shape[0]})
-	EOS
-	)
-	end
-      else
-	shape.each_index do |i|
- 	  if ( shape[i] == '*' )
-	    raise "Array #{v.name}'s #{i}-th dim is declared using *"
-          end
-          body.concat( <<-EOS
-        raise "Invalid array shape: #{v.name}.shape[#{i}] != #{shape[i]}" if #{v.name}.shape[#{i}] != (#{shape[i]})
-	  EOS
-          )
-        end
-      end
-    end
-  end
-  body
-end
-
-def head
-  f = File.open('dcl_rb_heading')
-  heading = f .readlines
-  f.close
-  heading
-end
-
-def foot
-  f = File.open('dcl_rb_footing')
-  footing = f .readlines
-  f.close
-  footing
-end
-
-def close
-  return <<-EOS
-    end
-end
-  EOS
-end
-
-def post_filter( ndf )
-  if $method_name == 'udcntz'
-    ndf.sub!(/,nbr2/,'')
-    add = <<-EOS
-        # derivation of nbr2 is provied aditionally in the method post_filter:
-        nbr2 = (nx+2)*(ny+2)*6/32+4
-
-    EOS
-    ndf =~ /(^ *\#.*check array size.*$)/
-    ndf[$1] = add + $1
-  end
-end
-
-def delete_comment(src) # [ruby-list:32030] [ruby-list:32049]
-  src.gsub(%r@ ([\'\"])(\\.|.)*?\1
-               | (/\*.*?\*/)      
-               | (//)[^\n]*$      
-               @mx) {
-    if $3
-      s = $3.delete("^\n")
-      s = ' ' if s.empty?
-      s
-    elsif $4
-      ''
-    else
-      $&
-    end
-  }
-end
-
-#####################  (main) ###########################
-require "tempfile"
-files = ARGV
-ofilename = "../lib/dcl.rb"
-ofile = open( ofilename, "w+" )
-ofile.puts( head() )
-for f in files
-  print "processing file #{f}\n"
-  #proto = open("| cat #{f} | gcc -E -", "r+")
-  #proto.close_write
-  fl = File.open(f)
-  proto = Tempfile.new('proto', '.')
-  proto.print( delete_comment(fl.read) )
-  proto.sync
-  proto.rewind
-  fl.close
-  while ( line = proto.gets )
-    case line
-    when /^ *SUBROUTINE *(\w+)|^ *\w+ *FUNCTION *(\w+)/
-      $method_name = ( $1 || $2 ).downcase
-      print $method_name+"\n" if $DEBUG
-      args_org = extract_args(proto)
-      if ( has_array?(args_org) )
-	# redefine the method
-	args_new, del_argname = new_args( args_org )
-	ndf = new_def( args_org, args_new, del_argname )
-	post_filter( ndf )
-	ofile.puts( ndf )
-      end
-    when /^#if *DCLVER *([<=>]+) *(\d\d\d)/
-      op = $1
-      ver = "'"+$2.split(//).join('.')+"'"   # "'5.3.1'" etc
-      ver.sub!(/\.0/,'')
-      ofile.print("      if DCLVERSION #{op} #{ver}\n")
-    when /^#endif/
-      ofile.print("      end\n\n")
-    end
-  end
-  proto.close
-end
-
-ofile.puts( foot() )
-ofile.puts( close() )
-ofile.close
-
-print "generated the DCL module file #{ofilename}\n"

data/GenWrapper/etc/p_header

@@ -1,64 +0,0 @@
-/*
- * $Id: p_header,v 1.3 2015/03/18 03:27:42 horinout Exp $
- */
-
-#include <stdio.h>
-#include "ruby.h"
-#include "libtinyf2c.h"
-#include "narray.h"
-#include "cdcl.h"
-
-/* for compatibility with ruby 1.6 */
-#ifndef StringValuePtr
-#define StringValuePtr(s) STR2CSTR(s)
-#endif
-
-#define DFLT_SIZE 32
-
-extern char    *dcl_obj2ccharary(VALUE, int, int);
-extern integer *dcl_obj2cintegerary(VALUE);
-extern real    *dcl_obj2crealary(VALUE);
-extern complex *dcl_obj2ccomplexary(VALUE);
-extern logical *dcl_obj2clogicalary(VALUE);
-
-extern VALUE dcl_ccharary2obj(char *, int, int);
-extern VALUE dcl_cintegerary2obj(integer *, int, int, int *);
-extern VALUE dcl_crealary2obj(real *, int, int, int *);
-extern VALUE dcl_ccomplexary2obj(complex *, int, char *);
-extern VALUE dcl_clogicalary2obj(logical *, int, int, int *);
-
-extern void dcl_freeccharary(char *);
-extern void dcl_freecintegerary(integer *);
-extern void dcl_freecrealary(real *);
-extern void dcl_freeccomplexary(complex *);
-extern void dcl_freeclogicalary(logical *);
-
-/* for functions which return real */
-/* fnclib */
-extern real rd2r_(real *);
-extern real rr2d_(real *);
-extern real rexp_(real *, integer *, integer *);
-extern real rfpi_(void);
-extern real rmod_(real *, real *);
-/* gnmlib */
-extern real rgnlt_(real *);
-extern real rgnle_(real *);
-extern real rgngt_(real *);
-extern real rgnge_(real *);
-/* rfalib */
-extern real rmax_(real *, integer *, integer *);
-extern real rmin_(real *, integer *, integer *);
-extern real rsum_(real *, integer *, integer *);
-extern real rave_(real *, integer *, integer *);
-extern real rvar_(real *, integer *, integer *);
-extern real rstd_(real *, integer *, integer *);
-extern real rrms_(real *, integer *, integer *);
-extern real ramp_(real *, integer *, integer *);
-/* rfblib */
-extern real rprd_(real *, real *, integer *, integer *, integer *);
-extern real rcov_(real *, real *, integer *, integer *, integer *);
-extern real rcor_(real *, real *, integer *, integer *, integer *);
-
-
-extern VALUE mDCL;
-