ldislin/processh.lua

   1 --[[ processh.lua
   2 *  Lua pre-processor for DISLIN header file
   3 *  created October 17, 2006 by e
   4 *
   5 * Copyright (c) 2006 Doug Currie, Londonderry, NH
   6 * All rights reserved.
   7 *
   8 Permission is hereby granted, free of charge, to any person obtaining a
   9 copy of this software and associated documentation files (the
  10 "Software"), to deal in the Software without restriction, including
  11 without limitation the rights to use, copy, modify, merge, publish,
  12 distribute, and/or sell copies of the Software, and to permit persons
  13 to whom the Software is furnished to do so, provided that the above
  14 copyright notice(s) and this permission notice appear in all copies of
  15 the Software and that both the above copyright notice(s) and this
  16 permission notice appear in supporting documentation.
  17
  18 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
  19 OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  20 MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT
  21 OF THIRD PARTY RIGHTS. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR
  22 HOLDERS INCLUDED IN THIS NOTICE BE LIABLE FOR ANY CLAIM, OR ANY SPECIAL
  23 INDIRECT OR CONSEQUENTIAL DAMAGES, OR ANY DAMAGES WHATSOEVER RESULTING
  24 FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
  25 NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION
  26 WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  27 ************************************************************************
  28 ]]--
  29 --[[
  30 TODO
  31
  32 finish with quesimpl functions
  33
  34 document all the handimpl functions
  35
  36 README
  37
  38 Most Lua functions match the signature of the DISLIN function. There are a
  39 few exceptions, listed here...
  40
  41 LEGINI - since Lua strings are not mutable, LEGINI omits the first (string)
  42 argument, and returns a Lua userdata l_legend_t. This userdata is used as
  43 the first (char *cbuf) argument to the legend functions. So:
  44 cbuf = legini (nlin, nmaxln)
  45 legend (cbuf, ncor)
  46 leglin (cbuf, cstr, ilin);
  47 piegrf (cbuf, nlin, xray, nseg)
  48 x = nxlegn (cbuf)
  49 y = nyegn (cbuf)
  50
  51 ITMCAT - is not implemented since it mutates a string; the Lua .. operator
  52 provides the same capability, so there is no need for itmcat.
  53
  54 Other functions that mutate strings, or have Lua implementations already,
  55 are: fcha, intcha, and upstr.
  56
  57 Binary I/O - DISLIN provides several binary I/O functions for FORTRAN. The
  58 Lua file functions work with full 8-bit data, so these functions are not
  59 needed and not implemented: closfl, openfl, posifl, readfl, skipfl, tellfl,
  60 writfl.
  61
  62 The following functions were in earlier versions of DISLIN, but are now
  63 obsolete: dattim, digits (use LABDIG), lsechk, moment, scale (use AXSSCL),
  64 swgcb, swgmod, winini.
  65
  66 UNIT is an old DISLIN routine for suppressing error messages. It should be
  67 replaced by the newer routines ERRMOD, ERRDEV and ERRFIL. Nevertheless, we
  68 implement UNIT(0) to accommodate the old idiom. GETUNI is not implemented.
  69
  70 --]]
  71 local fn = arg[2] or "/usr/lib/dislin/dislin.h"
  72 local fo = arg[3] or "ldislin.txt.c"
  73 local fd = arg[4] or "ldislin.txt.pod"
  74 local fe = arg[5] or "ldislin.tx2.pod"
  75
  76 local li32 = true -- longs and ints are both 32 bits in the Lua implementation
  77
  78 local gsub = string.gsub
  79 local fmt = string.format
  80
  81 --[[----------------------------------
  82
  83 function orderedtable(t)
  84   local currentIndex = 1
  85   local metaTable = {}
  86
  87   function metaTable:__newindex(key,value)
  88     rawset(self, key, value)
  89     rawset(self, currentIndex, key)
  90     currentIndex = currentIndex + 1
  91   end
  92   return setmetatable(t or {}, metaTable)
  93 end
  94
  95 function ordered(t)
  96   local currentIndex = 0
  97   local function iter(t)
  98     currentIndex = currentIndex + 1
  99     local key = t[currentIndex]
 100     if key then return key, t[key] end
 101   end
 102   return iter, t
 103 end
 104
 105 --]]----------------------------------
 106
 107 local o = io.open (fo,"w")
 108
 109 local rtncmalloc = {}
 110 -- these return (char *) malloc()'d by DISLIN (per Helmut), free()'d by ldislin
 111 rtncmalloc["itmstr"] = true
 112 rtncmalloc["dwgfil"] = true
 113 rtncmalloc["dwgtxt"] = true
 114
 115 local hand = {} -- hand implemented
 116 local function handimpl (n,g) hand[n]=g end
 117
 118 handimpl("bars",  "v_EEEi")   -- has in/out rays - sometimes!
 119 handimpl("bezier","v_DDiEEi") -- has out rays
 120 handimpl("colray","v_DNi")    -- has out iray
 121 handimpl("conpts","v_DiDiDdEEiNiJ") -- has out irays
 122 handimpl("disini","v_v")      -- must keep track of spline size
 123 handimpl("getlab","v_CCC")    -- has out crays
 124 handimpl("getmat","v_DDDiEiidNE") -- has out rays
 125 handimpl("gwgfil","v_iC")     -- has out cray[256]
 126 handimpl("gwgtxt","v_iC")     -- has out cray[256]
 127 handimpl("histog","v_DiEEJ")  -- has out irays
 128 handimpl("legend","v_Ci")     -- needs legini
 129 handimpl("legini","v_Cii")    -- makes userdata
 130 handimpl("leglin","v_CKi")    -- needs legini
 131 handimpl("piegrf","v_CiDi")   -- needs legini
 132 handimpl("nxlegn","i_C")      -- needs legini
 133 handimpl("nylegn","i_C")      -- needs legini
 134 handimpl("pdfbuf","i_Ci")     -- big out buffer
 135 handimpl("rbfpng","i_Ci")     -- big out buffer
 136 handimpl("setcbk","v_ZK")     -- callback for user defined projection function
 137 handimpl("sortr1","v_EiK")    -- has in/out ray
 138 handimpl("sortr2","v_EEiK")   -- has in/out rays
 139 handimpl("spline","v_DDiEEJ") -- has out rays; output array size coordinated with SPLMOD and DISINI
 140 handimpl("spline","v_DDiEEJ") -- has out rays; output array size coordinated with SPLMOD and DISINI
 141 handimpl("splmod","v_ii")     -- must keep track of spline size
 142 handimpl("surfun","v_Zidid")  -- callback
 143 handimpl("surfcp","v_Zdddddd")-- callback
 144 handimpl("swgcbk","v_iZ")     -- widget callback
 145 handimpl("trfco1","v_EiKK")   -- has in/out ray
 146 handimpl("trfco2","v_EEiKK")  -- has in/out rays
 147 handimpl("trfco3","v_EEEiKK") -- has in/out rays
 148 handimpl("trfmat","v_DiiEii") -- has out mat
 149 handimpl("trfrel","v_EEi")    -- has in/out rays
 150 handimpl("triang","i_DDiNNNi")-- has out rays -- userdata candidate TRIANG
 151 handimpl("tripts","v_DDDiIIIidEEiNiJ") -- yow
 152 handimpl("unit","v_V")        -- suppress error messages; legacy
 153
 154 -- "confll" -- const rays, uses TRIANG
 155 -- "contri" -- const rays, uses TRIANG
 156 -- "crvtri" -- const rays, uses TRIANG
 157 -- "surtri" -- const rays, uses TRIANG
 158
 159 local cast = {} -- hand checked type (e.g., scalar output type R or J)
 160 local function castimpl (n,g) cast[n]=g end
 161
 162 castimpl("abs3pt","v_dddRR")
 163 castimpl("circ3p","v_ddddddRRR")
 164 castimpl("csrpos","i_JJ")
 165 castimpl("csrpt1","v_JJ")
 166 castimpl("getclp","v_JJJJ")
 167 castimpl("getdig","v_JJJ")
 168 castimpl("getgrf","v_RRRRK")
 169 castimpl("getind","v_iRRR")
 170 castimpl("getlen","v_JJJ")
 171 castimpl("getor","v_JJ")
 172 castimpl("getpag","v_JJ")
 173 castimpl("getpos","v_JJ")
 174 castimpl("getran","v_JJ")
 175 castimpl("getres","v_JJ")
 176 castimpl("getrgb","v_RRR")
 177 castimpl("getscl","v_JJJ")
 178 castimpl("getscr","v_JJ")
 179 castimpl("getsp1","v_JJJ")
 180 castimpl("getsp2","v_JJJ")
 181 castimpl("getsym","v_JJ")
 182 castimpl("gettcl","v_JJ")
 183 castimpl("gettic","v_JJJ")
 184 castimpl("getvk" ,"v_JJJ")
 185 castimpl("getwin","v_JJJJ")
 186 castimpl("gmxalf","i_KAA")
 187 castimpl("hsvrgb","v_dddRRR")
 188 castimpl("pos2pt","v_ddRR")
 189 castimpl("pos3pt","v_dddRRR")
 190 castimpl("rel3pt","v_dddRR")
 191 castimpl("rgbhsv","v_dddRRR")
 192 castimpl("rpixel","v_iiJ")
 193 castimpl("trfdat","v_iJJJ") -- (date calc)
 194
 195 local noti = {} -- not implemented
 196 local function notbimpl (n) noti[n]=true end
 197 notbimpl "closfl" -- FORTRAN
 198 notbimpl "dattim" -- Obsolete per Helmut
 199 notbimpl "digits" -- Obsolete per Helmut -- use LABDIG
 200 notbimpl "fcha"   -- has out cray (dtoa) -- use Lua
 201 notbimpl "getuni" -- returns (FILE *)
 202 notbimpl "intcha" -- has out cray (itoa) -- use Lua
 203 notbimpl "itmcat" -- side affects 1st arg (per Helmut) -- use Lua
 204 notbimpl "lsechk" -- Obsolete per Helmut
 205 notbimpl "moment" -- Obsolete per Helmut
 206 notbimpl "openfl" -- FORTRAN
 207 notbimpl "posifl" -- FORTRAN
 208 notbimpl "readfl" -- FORTRAN; and has out cray
 209 notbimpl "scale"  -- Obsolete per Helmut -- use AXSSCL
 210 notbimpl "skipfl" -- FORTRAN
 211 notbimpl "swapi2" -- has in/out sray; rarely used per Helmut (not in Python wrapper)
 212 notbimpl "swapi4" -- has in/out iray; rarely used per Helmut (not in Python wrapper)
 213 notbimpl "swgcb"  -- Obsolete per Helmut
 214 notbimpl "swgmod" -- Obsolete per Helmut
 215 notbimpl "tellfl" -- FORTRAN
 216 notbimpl "upstr"  -- has in/out cray -- use Lua
 217 notbimpl "winini" -- Obsolete per Helmut
 218 notbimpl "writfl" -- FORTRAN
 219
 220 local ques = {} -- not implemented
 221 local function quesimpl (n) ques[n]=true end
 222
 223 quesimpl "csrmov" -- has out irays
 224 quesimpl "csrpos" -- has optional args
 225 quesimpl "csrpts" -- has out irays
 226 quesimpl "getind" -- has optional args
 227 quesimpl "rpixls" -- has out iray or cray?
 228 quesimpl "rpxrow" -- has out iray or cray?
 229
 230 --[[
 231 =head2 C<dislin.csrpos>
 232
 233   dislin.csrpos ()
 234
 235 i_JJ -- this needs custom implementation for optional arguments!
 236
 237 =head2 C<dislin.getind>
 238
 239   dislin.getind (i)
 240
 241 Returns the corresponding RGB coordinates stored in the current color table
 242
 243 v_iRRR -- this needs custom implementation for optional arguments!
 244 ]]
 245
 246 local ty =
 247 {
 248     ["const float *"] = "F ",
 249     ["float *"] = "G ",
 250     ["const double *"] = "D ",
 251     ["double *"] = "E ",
 252     ["const unsigned char *"] = "K ", -- only 3 funs; all take raw pixels
 253     ["unsigned char *"] = "U ",
 254     ["const char *"] = "K ",
 255     ["char *"] = "C ",
 256     ["const int *"] = "I ",
 257     ["int *"] = "N ",
 258     ["const long *"] = "L ", -- li32 and "I " or "L ", -- results in warning
 259     ["long *"] = "M ", -- li32 and "I " or "L ", -- results in warning
 260     ["short *"] = "S ",
 261     ["void *"] = "V ",
 262     ["double"] = "d ",
 263     ["float"] = "f ",
 264     ["long"] = li32 and "i " or "l ",
 265     ["int"] = "i ",
 266     ["short"] = "s ",
 267     ["void"] = "v "
 268 }
 269
 270 --[[-- derived/pseudo types
 271 K -- constant char *
 272 Z -- function pointer
 273 J -- out (scalar result) int *
 274 A -- out (scalar result) char *
 275 R -- out (scalar result) double *
 276 --]]
 277
 278 local sigcompat =
 279 {
 280     ["Z"] = {},
 281     -- double
 282     ["R"] = {["D"]=true,["E"]=true},
 283     ["D"] = {["R"]=true,["E"]=true},
 284     ["E"] = {["R"]=true,["D"]=true},
 285     -- long
 286     ["L"] = {           ["M"]=true,["I"]=li32,["J"]=li32,["N"]=li32},
 287     ["M"] = {["L"]=true,           ["I"]=li32,["J"]=li32,["N"]=li32},
 288     -- int
 289     ["I"] = {["J"]=true,           ["N"]=true,["L"]=li32,["M"]=li32},
 290     ["N"] = {["J"]=true,["I"]=true,           ["L"]=li32,["M"]=li32},
 291     ["J"] = {           ["I"]=true,["N"]=true,["L"]=li32,["M"]=li32},
 292     --
 293     ["S"] = {},
 294 --    ["U"] = {},
 295     ["K"] = {["C"]=true},
 296     ["A"] = {["C"]=true},
 297     ["C"] = {["K"]=true,["A"]=true},
 298     ["V"] = {},
 299     ["d"] = {},
 300     ["f"] = {},
 301     ["l"] = {["i"]=li32},
 302     ["i"] = {["l"]=li32},
 303     ["s"] = {},
 304     ["v"] = {},
 305 }
 306 local function sigmatch (g1,g2)
 307     local n = string.len(g1)
 308     if n ~= string.len(g2) then return false end
 309     for i = 1,n do
 310         local c1 = string.sub (g1,i,i)
 311         local c2 = string.sub (g2,i,i)
 312         if c1 ~= c2 and not (sigcompat[c1])[c2] then
 313             return false
 314         end
 315     end
 316     return true
 317 end
 318
 319 local funs = {}
 320 local sigs = {}
 321 local nope = {}
 322 local punt = {}
 323 local cust = {}
 324 local docs = {}
 325 local docn = {}
 326
 327 local function line (str)
 328     --for k,v in pairs(ty) do s = gsub (s, k, v) end -- must be ordered
 329     --
 330     local s = str
 331     if s == "" then return end
 332     s = gsub (s, "([%w_]* [%w_]* [%w_]* %*)", ty)
 333     s = gsub (s, "([%w_]* [%w_]* %*)", ty)
 334     s = gsub (s, "([%w_]* %*)", ty)
 335     s = gsub (s, "([%w_]*)", ty)
 336     -- function arg
 337     -- (double (*zfun)(double x, double y, int i
 338     -- (void (*callbck) (double *x, double *y)
 339     s = gsub (s, "[%w_]*%s*%(%*[%w_]*%)%s*%([%w%s_,]*%)", "Z z")
 340     local ds = s
 341     --
 342     for i = 1,15 do
 343         s = gsub (s, "%(%s*([ZDELMINSUKCVAdflisv])%s*[%w_]*[,]?", "%1(")
 344     end
 345     s = gsub (s, "%(%)%;%s*", "")
 346     if string.find (s,"%(") then
 347         print ("what is "..s)
 348         table.insert (punt, str)
 349         return
 350     end
 351     --print (s)
 352     s = gsub (s, "^%s*([%w_]*)%s*([%w_]*)%s*([%w_]*)%s*$", --([.]*) --%s*
 353             function (r,n,a)
 354                 if n == nil or n == "" or a == nil or a == "" then
 355                     print ("#### "..s.." # "..r.." # "..n.." # "..a)
 356                 else
 357                     --if ischarsafe[n] then a = gsub (a,"C","K") end
 358                     if r == "C" then if rtncmalloc[n] then r = "C" else r = "K" end end
 359                     g = r.."_"..a
 360                     if hand[n] then
 361                         if not sigmatch(g,hand[n]) then
 362                             print ("WARNING, signature mismatch:", n, g, hand[n])
 363                         end
 364                         funs[n] = "CUSTOM"
 365                         table.insert (cust, str)
 366                         docn[n] = ds
 367                     elseif cast[n] then
 368                         if sigmatch(g,cast[n]) then
 369                             funs[n] = cast[n]
 370                             sigs[cast[n]] = true
 371                         else
 372                             print ("mismatch:", n, g, cast[n])
 373                             table.insert (punt, str)
 374                         end
 375                     elseif noti[n] or ques[n] then
 376                         -- funs[n] = "notimp"
 377                         table.insert (nope, str)
 378                     elseif string.find (a, "[GEUCNMS]") then
 379                         print ("non-const array in: "..str)
 380                         table.insert (punt, str)
 381                     elseif string.find (a, "Z") then
 382                         print ("callback in: "..str)
 383                         table.insert (punt, str)
 384                     else
 385                         funs[n] = g
 386                         sigs[g] = true
 387                         docs[n] = ds -- doc string
 388                     end
 389                 end
 390             end)
 391 end
 392
 393 -- for s in io.lines(fn) do line (s) end
 394
 395 local fa = io.open(fn):read("*a")
 396 -- remove the conditional code; all is C++ related
 397 fa = gsub (fa, "#ifdef", "<")
 398 fa = gsub (fa, "#endif", ">")
 399 fa = gsub (fa, "%b<>", "")
 400 -- remove comments
 401 fa = gsub (fa, "/%*", "<")
 402 fa = gsub (fa, "%*/", ">")
 403 fa = gsub (fa, "%b<>", "")
 404 -- -- debug
 405 -- -- od = io.open("pldebug.txt","w")
 406 -- remove spaces at starts of lines
 407 fa = gsub (fa, "[\n\r]%s*", "\n")
 408 -- -- od:write(fa)
 409 -- -- od:write("\n#############\n")
 410 -- remove newlines
 411 fa = gsub (fa, "[\n\r]", "")
 412 -- process what's left
 413 for s in string.gmatch (fa, "(%w[%s%w%(%),%*]*;)") do line (s) end
 414 -- -- od:close()
 415
 416 -----------------------------------------------
 417
 418 function __genOrderedIndex( t )
 419     local orderedIndex = {}
 420     for key,_ in pairs(t) do
 421         table.insert( orderedIndex, key )
 422     end
 423     table.sort( orderedIndex )
 424     return orderedIndex
 425 end
 426
 427 function orderednext(t, state)
 428     if state == nil then
 429         -- the first time, generate the index
 430         t.__orderedIndex = __genOrderedIndex( t )
 431         key = t.__orderedIndex[1]
 432         return key, t[key]
 433     end
 434     -- fetch the next value
 435     key = nil
 436     for i = 1,#(t.__orderedIndex) do
 437         if t.__orderedIndex[i] == state then
 438             key = t.__orderedIndex[i+1]
 439         end
 440     end
 441     if key then
 442         return key, t[key]
 443     end
 444     -- no more value to return, cleanup
 445     t.__orderedIndex = nil
 446     return
 447 end
 448
 449 function orderedpairs (t)
 450     -- equivalent to pairs(), but in order
 451     return orderednext, t, nil
 452 end
 453
 454 ---------------------------------------------------------
 455
 456 -- for k,_ in pairs(sigs) do print (k) end
 457
 458 for k,_ in orderedpairs(sigs) do
 459     local qresults = 0
 460     local results = {}
 461     local as = ""
 462     o:write (fmt ("#define %s(nm) \\\n", k))
 463     o:write (fmt ("static int l_ ## nm (lua_State *L) { \\\n"))
 464     if string.sub (k,3,-1) == "v" then
 465         -- no args, nothing to do
 466     else for i = 3,#k do
 467         local a = "a"..(i-2)
 468         local c = string.sub (k,i,i) -- DLISUCVdflisv
 469         if     c == "D" then
 470             o:write (fmt ("  double *%s = magic_doublestar_function (L, %d); \\\n", a, i-2))
 471         elseif c == "L" then
 472             o:write (fmt ("  long *%s = magic_longstar_function (L, %d); \\\n", a, i-2))
 473         elseif c == "I" then
 474             o:write (fmt ("  int *%s = magic_intstar_function (L, %d); \\\n", a, i-2))
 475         elseif c == "S" then
 476             o:write (fmt ("  short *%s = magic_shortstar_function (L, %d); \\\n", a, i-2))
 477         elseif c == "U" then
 478             o:write (fmt ("  const unsigned char *%s = luaL_checkstring(L, %d); \\\n", a, i-2))
 479         elseif c == "C" or c == "K" then
 480             o:write (fmt ("  const char *%s = luaL_checkstring(L, %d); \\\n", a, i-2))
 481             if c == "K" then a = "(char *)"..a end
 482         elseif c == "V" then
 483             o:write (fmt ("  void *%s = magic_voidstar_function (L, %d); \\\n", a, i-2))
 484         elseif c == "d" or c == "f" then
 485             o:write (fmt ("  lua_Number %s = luaL_checknumber (L, %d); \\\n", a, i-2))
 486         elseif c == "l" or c == "i" or c == "s" then
 487             o:write (fmt ("  lua_Integer %s = luaL_checkinteger (L, %d); \\\n", a, i-2))
 488         elseif c == "J" then
 489             o:write (fmt ("  lua_Integer %s; \\\n", a))
 490             results[a] = "J"
 491             a = "&"..a
 492             qresults = qresults + 1
 493         elseif c == "R" then
 494             o:write (fmt ("  double %s; \\\n", a))
 495             results[a] = "R"
 496             a = "&"..a
 497             qresults = qresults + 1
 498         elseif c == "A" then
 499             o:write (fmt ("  char %s[4] = {0,0,0,0}; \\\n", a))
 500             results[a] = "A"
 501             qresults = qresults + 1
 502         elseif c == "v" then
 503             error (fmt("sig format has void arg"))
 504         else
 505             error (fmt("unknown sig format char %s",c))
 506         end
 507         as = as..","..a
 508     end end -- else for
 509     as = string.sub (as,2)
 510     c = string.sub (k,1,1)
 511         if     c == "D" then
 512             o:write (fmt ("  double *r = nm (%s);  \\\n", as))
 513             o:write (fmt ("  magic_push_doublestar(L, r);  \\\n", as))
 514         elseif c == "L" then
 515             o:write (fmt ("  long *r = nm (%s);  \\\n", as))
 516             o:write (fmt ("  magic_push_longstar(L, r);  \\\n", as))
 517         elseif c == "I" then
 518             o:write (fmt ("  int *r = nm (%s);  \\\n", as))
 519             o:write (fmt ("  magic_push_intstar(L, r);  \\\n", as))
 520         elseif c == "S" then
 521             o:write (fmt ("  short *r = nm (%s);  \\\n", as))
 522             o:write (fmt ("  magic_push_shortstar(L, r);  \\\n", as))
 523         elseif c == "K" or c == "C" or c == "U" then
 524             o:write (fmt ("  char *r = nm (%s);  \\\n", as))
 525             o:write (fmt ("  lua_pushstring (L, r);  \\\n", as))
 526             if c ~= "K" then
 527                 o:write (fmt ("  free (r);  \\\n"))
 528             end
 529         elseif c == "V" then
 530             o:write (fmt ("  void *r = nm (%s);  \\\n", as))
 531             o:write (fmt ("  magic_push_voidstar(L, r);  \\\n", as))
 532         elseif c == "d" then
 533             o:write (fmt ("  double r = nm (%s);  \\\n", as))
 534             o:write (fmt ("  lua_pushnumber (L, r);  \\\n", as))
 535         elseif c == "f" then
 536             o:write (fmt ("  float r = nm (%s);  \\\n", as))
 537             o:write (fmt ("  lua_pushnumber (L, r);  \\\n", as))
 538         elseif c == "l" then
 539             o:write (fmt ("  long r = nm (%s);  \\\n", as))
 540             o:write (fmt ("  lua_pushnumber (L, r);  \\\n", as))
 541         elseif c == "i" or c == "s" then
 542             o:write (fmt ("  int r = nm (%s);  \\\n", as))
 543             o:write (fmt ("  lua_pushinteger (L, r);  \\\n", as))
 544         elseif c == "v" then
 545             o:write (fmt ("  nm (%s);  \\\n", as))
 546             -- nothing to push
 547         else
 548             error (fmt("unknown sig format char %s",c))
 549         end
 550     for r,c in orderedpairs(results) do
 551         if     c == "J" then
 552             o:write (fmt ("  lua_pushinteger (L, %s);  \\\n", r))
 553         elseif c == "R" then
 554             o:write (fmt ("  lua_pushnumber (L, %s);  \\\n", r))
 555         elseif c == "A" then
 556             o:write (fmt ("  lua_pushstring (L, %s);  \\\n", r))
 557         else
 558             error (fmt("unknown res format char %s",c))
 559         end
 560     end
 561     if c ~= "v" then qresults = qresults + 1 end
 562     o:write (fmt ("  return %d; \\\n", qresults))
 563     o:write (fmt ("}\n"))
 564 end
 565
 566 o:write "\n#define CUSTOM(nm) static int l_ ## nm (lua_State *L); /* custom impl */\n\n"
 567
 568 for n,g in orderedpairs(funs) do
 569     o:write (fmt ("%s(%s)\n", g, n))
 570 end
 571
 572 o:write "\nstatic const luaL_reg ldislin_lib[] =\n{\n"
 573
 574 local function ss (n)
 575     if 0 <= n and n <= 8 then
 576         return (({""," ","  ","   ","    ","     ","      ","       ","        "})[n+1])
 577     else
 578         return " "
 579     end
 580 end
 581
 582 for n,_ in orderedpairs(funs) do
 583     o:write (fmt ("  {\"%s\",%s l_%s},\n", n, ss(7 - #n), n))
 584 end
 585
 586 o:write "  {NULL, NULL}\n};\n"
 587
 588 o:write "\n"
 589
 590 if #nope ~= 0 then
 591     o:write (fmt ("/* **** %d excluded functions ****\n", #nope))
 592     for _,v in ipairs(nope) do
 593         o:write (fmt ("** **** %s\n", v))
 594     end
 595     o:write (fmt ("** **** ******************* ****\n*/\n\n"))
 596 end
 597
 598 if #punt ~= 0 then
 599     o:write (fmt ("/* **** %d punted functions ****\n", #punt))
 600     for _,v in ipairs(punt) do
 601         o:write (fmt ("** **** %s\n", v))
 602     end
 603     o:write (fmt ("** **** ******************* ****\n*/\n\n"))
 604 end
 605
 606 if #cust ~= 0 then
 607     o:write (fmt ("/* **** %d custom functions ****\n", #cust))
 608     for _,v in ipairs(cust) do
 609         o:write (fmt ("** **** %s\n", v))
 610     end
 611     o:write (fmt ("** **** ******************* ****\n*/\n\n"))
 612 end
 613
 614 local function doco (fn, tbl, ps)
 615     local q = 0
 616     local t2tn = {["d"]="number", ["i"]="integer", ["s"]="integer", ["C"]="string"}
 617     local o = io.open (fn,"w")
 618     for n,s in orderedpairs(tbl) do
 619         local t
 620         s = gsub (s,";","")
 621         s = gsub (s,"([ZDELMINSUKCVAdflisv])%s*([%w_]*)%s*%(",
 622                     function (ty,nm)
 623                         if n ~= nm then print ("OOPS ", n, nm) end
 624                         t = ty
 625                         return fmt("dislin.%s (", n)
 626                     end)
 627         s = gsub (s, "%(%s*[ZDELMINSUKCVAdflisv]%s*", "(")
 628         s = gsub (s, "%,%s*[ZDELMINSUKCVAdflisv]%s*", ", ")
 629         o:write (fmt("=head2 C<dislin.%s>\n\n  %s\n\n",n,s))
 630         if t ~= "v" then
 631             tn = t2tn[t]
 632             if tn == nil then print ("need", t); tn = t end
 633             o:write (fmt("Returns %s C<%s>.\n\n",tn,n))
 634         end
 635         q = q + 1
 636     end
 637     print ("making docs for", q, ps)
 638     o:close()
 639 end
 640
 641 if fd ~= nil then
 642     doco (fd, docs, "simple functions")
 643 end
 644
 645 if fe ~= nil then
 646     doco (fe, docn, "custom functions")
 647 end
 648
 649 local function sz (t) local n = 0; for _,_ in pairs(t) do n = n + 1 end return n end
 650 print ("Nope",#nope,"Punt",#punt,"Cust",#cust,"Cast",sz(cast),"Simp",sz(docs),"Funs",sz(funs))