regina/gcimh.rexx

   1 /*
   2  * This is an example for using GCI. Enjoy, copy and paste!
   3  * We have three different execution paths for Unix, Win32 and OS/2.
   4  * For some interpreters, most notable the builtin interpreter of OS/2, you
   5  * have to rename this file to gci-try.cmd
   6  */
   7 parse version version
   8 say "Your REXX interpreter is" version
   9
  10 /******************************************************************************
  11  * Try to detect the system to show several things.
  12  */
  13 parse var version "REXX-"ipret"_".
  14 IsRegina = 0
  15 if ipret = "Regina" then do
  16    IsRegina = 1
  17    uname = uname('S')
  18    options NOEXT_COMMANDS_AS_FUNCS
  19    end
  20
  21 parse source system . source
  22
  23 system = translate(system)
  24 if left(system, 3) = "WIN" then do
  25    library = "GCI.DLL"
  26    CLib = "MSVCRT"
  27    system = "WIN"
  28    end
  29 else if system = "OS/2" then do
  30    library = "GCI.DLL"
  31    system = "OS/2"
  32    end
  33 else do
  34    library = "libgci.so"
  35    tr = trace()
  36    trace o
  37    "test `uname -s` = 'SunOS'"
  38    if RC = 0 then do
  39       CLib = "libc.so.1"
  40       MathLib = "m"
  41       end
  42    else do
  43       if IsRegina & Left(uname, 6) = 'CYGWIN' then do
  44          CLib = "cygwin1.dll"
  45          MathLib = "cygwin1.dll"
  46          end
  47       else do
  48          CLib = "libc.so.6"
  49          MathLib = "m"
  50          end
  51       end
  52    trace value tr
  53    end
  54
  55 /*
  56  * Check for a builtin RxFuncDefine. Call it with errorneous arguments and
  57  * expect a simple error if installed and a syntax signal if unknown.
  58  */
  59 InternalGCI = 0
  60 signal on syntax name NotInstalled
  61 x = "X"
  62 x. = "X"
  63 h = RxFuncDefine(x,x,x,x)
  64 if h \= 0 & h \= 10005 & DataType(h, "NUM") then
  65    InternalGCI = 1
  66 NotInstalled:
  67 drop GCI_RC
  68
  69 signal on syntax
  70 if \InternalGCI then do
  71    /*
  72     * The DLL may have been loaded already. Prevent bugs at this stage.
  73     */
  74    call RxFuncDrop RxFuncDefine
  75    call RxFuncDrop GciPrefixChar
  76    call RxFuncDrop GciFuncDrop
  77    if RxFuncadd(RxFuncDefine, "gci", "RxFuncDefine") \= 0 then do
  78       msg = "Can't load RxFuncDefine of" library
  79       if IsRegina then
  80          msg = msg || ":" RxFuncErrMsg()
  81       say msg
  82       return 1
  83       end
  84    if RxFuncadd(GciFuncDrop, "gci", "GciFuncDrop") \= 0 then do
  85       msg = "Can't load GciFuncDrop of" library
  86       if IsRegina then
  87          msg = msg || ":" RxFuncErrMsg()
  88       say msg
  89       return 1
  90       end
  91    call RxFuncadd GciPrefixChar, "gci", "GciPrefixChar"
  92    say "Your interpreter has no internal support of GCI"
  93    end
  94 else
  95    say "Your interpreter has internal support of GCI"
  96
  97 say ""
  98
  99 /******************************************************************************
 100  * After the prelimnaries try to use the GCI.
 101  */
 102 if system = "OS/2" then signal useOS2
 103
 104 say "Trying to copy string 'hello' to a string 'world' using the C library"
 105 stem.calltype = cdecl
 106 stem.0 = 2
 107 stem.1.name = "Target"
 108 stem.1.type = indirect string80
 109 stem.2.name = "Source"
 110 stem.2.type = indirect string80
 111 stem.return.type = ""           /* We are not interested in the return value */
 112
 113 call funcDefine strcpy, CLib, "strcpy", stem
 114
 115 stem.1.name = "Target"
 116 stem.1.value = "world"
 117 stem.2.name = "Source"
 118 stem.2.value = "hello"
 119 call strcpy stem
 120 say stem.1.name"="stem.1.value stem.2.name"="stem.2.value
 121
 122 call funcDrop strcpy
 123 say ""
 124 /******************************************************************************
 125  * Check if v1.1 GciPrefixChar works.
 126  */
 127
 128 version = 1.0
 129 signal on syntax name v1.0
 130 say "Trying to detect and use v1.1 features (same result as above expected)"
 131 oldChar = GciPrefixChar('!')
 132 signal on syntax
 133 stem.!calltype = cdecl
 134 stem.0 = 2
 135 stem.1.!name = "Target"
 136 stem.1.!type = indirect string80
 137 stem.2.!name = "Source"
 138 stem.2.!type = indirect string80
 139 stem.!return.!type = ""
 140
 141 call funcDefine strcpy, CLib, "strcpy", stem
 142
 143 stem.1.!name = "Target"
 144 stem.1.!value = "world"
 145 stem.2.!name = "Source"
 146 stem.2.!value = "hello"
 147 call strcpy stem
 148 say stem.1.!name"="stem.1.!value stem.2.name"="stem.2.!value
 149
 150 call funcDrop strcpy
 151 say ""
 152 call GciPrefixChar oldChar
 153 drop oldChar c1 c2
 154 version = 1.1
 155 v1.0:
 156 /******************************************************************************
 157  * Use the "as function" feature
 158  */
 159 say "Trying to find the last occurcance of '.' in 'James F. Cooper' using the C"
 160 say "library using the 'as function' feature"
 161 stem.calltype = cdecl as function
 162 stem.0 = 2
 163 stem.1.name = "String"
 164 stem.1.type = indirect string80
 165 stem.2.name = "Character"
 166 stem.2.type = char
 167 stem.return.type = indirect string80
 168
 169 call funcDefine strrchr, CLib, "strrchr", stem
 170
 171 stem.1.name = "Target"
 172 stem.1.value = "James F. Cooper"
 173 stem.2.name = "Character"
 174 stem.2.value = .
 175 say "The last dot starts at '" || strrchr( stem ) || "'"
 176 say ""
 177 say "Trying to find the last occurcance of '.' in 'James Cooper' using the C lib"
 178 say "We expect a NULL pointer which leads to a dropped value which becomes ''"
 179 say "for a return value."
 180
 181 stem.1.name = "Target"
 182 stem.1.value = "James Cooper"
 183 say "The last dot starts at '" || strrchr( stem ) || "'"
 184
 185 call funcDrop strrchr
 186 say ""
 187 /******************************************************************************
 188  * Use the "with parameters as function" feature.
 189  * Note that you must omit "as function" if the return value doesn't exist.
 190  * We use separate functions for Windows and unix.
 191  */
 192 if system = "WIN" then signal useWindows
 193
 194 say "Trying to use the math library to compute sqrt"
 195 stem.calltype = cdecl with parameters as function
 196 stem.0 = 1
 197 stem.1.name = "X"
 198 stem.1.type = float64
 199 stem.return.type = float64
 200 call RxFuncDefine sqrt, MathLib, "sqrt", stem
 201 if RESULT \= 0 then do
 202    if IsRegina & InternalGCI then
 203       say "Error, code" RESULT || ":" RxFuncErrMsg()
 204    else
 205       say "Error, code" RESULT || ":" GCI_RC
 206    return 1
 207    end
 208
 209 do i = 1 to 10
 210    x = i
 211    y = i / 2
 212    x2 = x*x
 213    y2 = y*y
 214    num = x2 - y2
 215    say 'Length:' i 'Height:' sqrt( num )
 216 end
 217 call funcDrop sqrt
 218 say ""
 219 /*******************************/
 220 say "Using a structure and checking the file system's size."
 221 say "You may look into the source."
 222 /*
 223  * This examples has removed all unnecessary stuff.
 224  */
 225 stem.calltype = cdecl as function
 226 stem.0 = 2
 227 stem.1.type = indirect string256
 228 stem.2.type = indirect container
 229 stem.2.0 = 10                                /* statvfs64 */
 230 stem.2.1.type    = unsigned                  /* bsize */
 231 stem.2.2.type    = unsigned                  /* frsize */
 232 stem.2.3.type    = unsigned64                /* blocks */
 233 stem.2.4.type    = unsigned64                /* bfree */
 234 stem.2.5.type    = unsigned64                /* bavail */
 235 stem.2.6.type    = unsigned64                /* files */
 236 stem.2.7.type    = unsigned64                /* ffree */
 237 stem.2.8.type    = unsigned64                /* favail */
 238 stem.2.9.type    = unsigned                  /* fsid */
 239 stem.2.10.type   = string256                /* indifferent between unices */
 240 stem.return.type = integer
 241
 242 call funcDefine statvfs, CLib, "statvfs64", stem
 243
 244 args. = 0
 245 args.1.value = source
 246 args.2.value = 10    /* otherwise the argument becomes NULL */
 247 if statvfs( args ) \= -1 then do
 248    say "statvfs-info of" source
 249    say "block size =" args.2.1.value "byte"
 250    size = trunc(args.2.3.value * args.2.1.value / (1024 * 1024))
 251    avail = trunc(args.2.5.value * args.2.1.value / (1024 * 1024))
 252    say "file system size =" size"MB, available =" avail"MB"
 253    say "file nodes =" args.2.6.value "available =" args.2.8.value
 254    say "sid =" args.2.9.value
 255    end
 256 else
 257    say "Sorry, '"source"' not found."
 258
 259 call funcDrop statvfs
 260 say ""
 261 /*******************************/
 262
 263 say "We use qsort of the C library for sorting some strings using arrays."
 264 /*
 265  * This examples has removed all unnecessary stuff.
 266  * We need a sorting routine. Without callbacks we have to use one of a
 267  * library. "strcmp" is a good example. We have to play with the dynamic
 268  * link loader.
 269  * The strategy is:
 270  * Load the loader functions (dlopen, dlsym, dlclose)
 271  * Load the compare routine (strcmp) using the loader functions
 272  * Load the sorting routine (qsort) and do the sort
 273  * Additional sort operations may have to redefine qsort only.
 274  */
 275 stem.calltype = cdecl with parameters as function
 276 stem.0 = 2
 277 stem.1.type = indirect string256
 278 stem.2.type = integer
 279 stem.return.type = integer       /* handle, but who cares? */
 280 call funcDefine dlopen, "dl", "dlopen", stem
 281
 282 stem.calltype = cdecl with parameters as function
 283 stem.0 = 2
 284 stem.1.type = integer            /* handle */
 285 stem.2.type = indirect string256
 286 stem.return.type = integer       /* entry point address, but who cares? */
 287 call funcDefine dlsym, "dl", "dlsym", stem
 288
 289 stem.calltype = cdecl with parameters as function
 290 stem.0 = 1
 291 stem.1.type = integer            /* handle */
 292 stem.return.type = integer
 293 call funcDefine dlclose, "dl", "dlclose", stem
 294
 295 CLibHandle = dlopen( CLib, 1 /* RTLD_LAZY */ )
 296 if CLibHandle = 0 then do
 297    say "dlopen() can't load" CLib
 298    return 1
 299    end
 300
 301 strcmp = dlsym( CLibHandle, "strcmp" )
 302 if strcmp = 0 then do
 303    say "dlsym() can't relocate strcmp()"
 304    return 1
 305    end
 306
 307 stem.calltype = cdecl
 308 stem.0 = 4
 309 stem.1.type = indirect array
 310 stem.1.0 = 3
 311 stem.1.1.type = string95
 312 stem.2.type = integer
 313 stem.3.type = integer
 314 stem.4.type = integer
 315 stem.return.type = ""
 316 call funcDefine qsort10, CLib, "qsort", stem
 317
 318 args.0 = 4
 319 args.1.value = 3
 320 args.1.1.value = "Ann"
 321 args.1.2.value = "Charles"
 322 args.1.3.value = "Betty"
 323 args.2.value = 3
 324 args.3.value = 96
 325 args.4.value = strcmp
 326 say "Sorting (" args.1.1.value args.1.2.value args.1.3.value ") ..."
 327 call qsort10 args
 328 say "Sorted values are (" args.1.1.value args.1.2.value args.1.3.value ")"
 329
 330 call dlclose CLibHandle
 331 call funcDrop qsort
 332 call funcDrop dlclose
 333 call funcDrop dlsym
 334 call funcDrop dlopen
 335 say ""
 336 call accessStructTm
 337 return 0
 338
 339
 340 /***************************************************/
 341 useWindows:
 342 stem.calltype = stdcall with parameters as function
 343 stem.0 = 4
 344 stem.1.name = "HWND"
 345 stem.1.type = unsigned
 346 stem.2.name = "Text"
 347 stem.2.type = indirect string1024
 348 stem.3.name = "Caption"
 349 stem.3.type = indirect string1024
 350 stem.4.name = "Type"
 351 stem.4.type = unsigned
 352 stem.return.type = integer
 353
 354 call funcDefine messagebox, "user32", "MessageBoxA", stem
 355
 356 MB_YESNO_INFO = x2d(44)
 357 if messagebox( 0, "Do you love this rocking GCI?", "GCI", MB_YESNO_INFO ) = 6 then
 358    say "Yes, you're right, GCI is cool."
 359 else
 360    say "No, you're kidding! GCI is cool."
 361
 362 call funcDrop messagebox
 363 say ""
 364 /*******************************/
 365 say "We operate on containers and check this file's date."
 366 say "You may look into the source."
 367 /*
 368  * This examples has removed all unnecessary stuff.
 369  */
 370 stem.calltype = stdcall as function
 371 stem.0 = 2
 372 stem.1.type = indirect string256
 373 stem.2.type = indirect container
 374 stem.2.0 = 8                                 /* WIN32_FIND_DATA */
 375 stem.2.1.type = unsigned                     /* FileAttributes */
 376 stem.2.2.type = unsigned64                   /* Creation */
 377 stem.2.3.type = unsigned64                   /* Access */
 378 stem.2.4.type = unsigned64                   /* Write */
 379 stem.2.5.type = unsigned64                   /* Size */
 380 stem.2.6.type = unsigned64                   /* Reserved */
 381 stem.2.7.type = string259                    /* FileName */
 382 stem.2.8.type = string13                     /* AlternateFileName */
 383 stem.return.type = integer
 384
 385 stem2.calltype = stdcall with parameters
 386 stem2.0 = 1
 387 stem2.1.type = integer
 388 stem2.return.type = ""
 389
 390 call funcDefine findfirstfile, "kernel32", "FindFirstFileA", stem
 391
 392 call funcDefine findclose, "kernel32", "FindClose", stem2
 393
 394 args. = 0
 395 args.1.value = source
 396 args.2.value = 8    /* otherwise the argument becomes NULL */
 397 handle = findfirstfile( args )
 398 if handle \= -1 then do
 399    say "argument's name="source
 400    say "filename="args.2.7.value
 401    say "8.3-name="args.2.8.value
 402    numeric digits 40
 403    filetime = args.2.4.value
 404    d = /*second*/ 1000*1000*10   *   /*seconds per day*/ 60*60*24
 405    daypart = trunc(filetime / d)
 406    date = date( 'N', daypart + date('B', 16010101, 'S'), 'B')
 407    ns = filetime - daypart * d
 408    secs = ns % (10*1000*1000)
 409    fract = ns // (10*1000*1000)
 410    time = time('N', secs, 'S') || "." || right(fract, 7, '0')
 411    say "ns from 1.1.1601="filetime "= GMT," date || "," time
 412    numeric digits 9
 413    call findclose handle
 414    end
 415 else
 416    say "Sorry, '"source"' not found."
 417
 418 call funcDrop findfirstfile
 419 call funcDrop findclose
 420 say ""
 421 call accessStructTm
 422
 423 return 0
 424
 425 /***************************************************/
 426 accessStructTm: procedure expose IsRegina InternalGCI CLib version
 427 if version < 1.1 then
 428    return
 429 say "Finally, we use the LIKE keyword and check the number of the week."
 430 say "You may look into the source, we use a PROCEDURE and v1.1 specific code."
 431 /*
 432  * This examples has removed all unnecessary stuff.
 433  */
 434 tm.0 = 10
 435 tm.1.type = integer /* tm_sec */
 436 tm.2.type = integer /* tm_min */
 437 tm.3.type = integer /* tm_hour */
 438 tm.4.type = integer /* tm_mday */
 439 tm.5.type = integer /* tm_mon */
 440 tm.6.type = integer /* tm_year */
 441 tm.7.type = integer /* tm_wday */
 442 tm.8.type = integer /* tm_yday */
 443 tm.9.type = integer /* tm_isdst */
 444 tm.10.type = string 32 /* reserved stuff sometimes used by the OS */
 445
 446 time_t.0 = 1
 447 time_t.1.type = integer64 /* SURPRISE! some systems may use 64 bit data types
 448                            * already. We don't have problems with this,
 449                            * because we use double buffering.
 450                            */
 451
 452 stem.calltype = cdecl
 453 stem.0 = 1
 454 stem.1.type = indirect container like time_t
 455 stem.return.type = ""
 456 call funcDefine _time, CLib, "time", stem
 457
 458 stem.calltype = cdecl
 459 stem.0 = 1
 460 stem.1.type = indirect container like time_t
 461 stem.return.type = indirect container like tm
 462 call funcDefine localtime, CLib, "localtime", stem
 463
 464 stem.calltype = cdecl
 465 stem.0 = 4
 466 stem.1.type = indirect string256  /* dest */
 467 stem.2.type = unsigned            /* size(dest) */
 468 stem.3.type = indirect string256  /* template */
 469 stem.4.type = indirect container like tm
 470 stem.return.type = unsigned
 471 call funcDefine strftime, CLib, "strftime", stem
 472
 473 time_val.1.value = 1
 474 time_val.1.1.value = 1
 475 call _time time_val
 476
 477 lct.1.value = 1
 478 lct.1.1.value = time_val.1.1.value
 479 call localtime lct
 480
 481 strf.1.value = ""
 482 strf.2.value = 256
 483 strf.3.value = "%A"
 484 strf.4.value = lct.return.value
 485 do i = 1 to 10
 486    strf.4.i.value = lct.return.i.value
 487    end
 488 call strftime strf
 489 dayname = strf.1.value
 490
 491 strf.3.value = "%B"
 492 call strftime strf
 493 monthname = strf.1.value
 494
 495 strf.3.value = "%U"
 496 call strftime strf
 497 week!Sun = strf.1.value
 498
 499 strf.3.value = "%W"
 500 call strftime strf
 501 week!Mon = strf.1.value
 502
 503 if week!Mon = week!Sun then
 504    add = "."
 505 else
 506    add = " if you count Monday as the first day of the week. Otherwise it " ||,
 507          "is the" week!Sun || ". week."
 508 say "Today is a" dayname "in" monthname || ". We have the" week!Mon || ". week" || add
 509 say
 510 call funcDrop strftime
 511 call funcDrop localtime
 512 call funcDrop _time
 513
 514 return
 515
 516 /***************************************************/
 517 useOS2:
 518 say "Checking the high precision system timer."
 519 stem.calltype = stdcall
 520 stem.0 = 1
 521 stem.1.name = "Frequency"
 522 stem.1.type = indirect unsigned
 523 stem.return.type = "unsigned"
 524
 525 call funcDefine DosTmrQueryFreq, "doscalls", "#362", stem
 526
 527 stem.1.name = "Frequency"
 528 stem.1.value = 0        /* don't raise NOVALUE */
 529
 530 call DosTmrQueryFreq stem
 531 if stem.return.value \= 0 then
 532    say "Error" stem.return.value "while using DosTmrQueryFreq."
 533 else
 534    say "The timer has a frequency of" stem.1.value "Hz"
 535
 536 call funcDrop DosTmrQueryFreq
 537 say ""
 538 /*******************************/
 539 say "You should hear your beeper."
 540 /*
 541  * Use the "with parameters" feature.
 542  */
 543 stem.calltype = stdcall with parameters
 544 stem.0 = 2
 545 stem.1.name = "Frequency"
 546 stem.1.type = unsigned
 547 stem.2.name = "Duration"
 548 stem.2.type = unsigned
 549 stem.return.type = ""           /* We are not interested in the return value */
 550
 551 call funcDefine DosBeep, "doscalls", "#286", stem
 552
 553 do i = 500 to 3000 by 100
 554    call DosBeep i, 10
 555    end
 556
 557 call funcDrop DosBeep
 558 say ""
 559 /*******************************/
 560 say "Checking the installed codepages."
 561 /*
 562  * Use the "as function" feature.
 563  */
 564 stem.calltype = stdcall as function
 565 stem.0 = 3
 566 stem.1.name = "cb"
 567 stem.1.type = unsigned
 568 stem.2.name = "arCP"
 569 stem.2.type = indirect array
 570 stem.2.0 = 25
 571 stem.2.1.type = unsigned
 572 stem.3.name = "pcCP"
 573 stem.3.type = indirect unsigned
 574 stem.return.type = "unsigned"
 575
 576 call funcDefine DosQueryCp, "doscalls", "#291", stem
 577
 578 drop stem.
 579 stem. = 0 /* NOVALUE should not happen */
 580 stem.0 = 3
 581 stem.1.name = "cb"
 582 stem.1.value = 100
 583 stem.2.name = "arCP"
 584 stem.2.value = 25
 585 stem.3.name = "pcCP"
 586 if DosQueryCp( stem ) = 0 then do
 587    say "current codepage:" stem.2.1.value
 588    do i = 2 to stem.3.value / 4
 589       say "prepared codepage:" stem.2.i.value
 590       end
 591    end
 592 else
 593    say "Error calling DosQueryCp."
 594
 595 call funcDrop DosQueryCp
 596 say ""
 597 /*******************************/
 598 say "Examining the file system on" left( source, 2 )
 599 /*
 600  * Use the "as function" feature.
 601  */
 602 stem.calltype = stdcall as function
 603 stem.0 = 4
 604 stem.1.name = "disknum"
 605 stem.1.type = unsigned
 606 stem.2.name = "infolevel"
 607 stem.2.type = unsigned
 608 stem.3.name = "pBuf"
 609 stem.3.type = indirect container
 610 stem.3.0 = 5
 611 stem.3.1.name = "idFileSystem"
 612 stem.3.1.type = unsigned
 613 stem.3.2.name = "cSectorUnit"
 614 stem.3.2.type = unsigned
 615 stem.3.3.name = "cUnit"
 616 stem.3.3.type = unsigned
 617 stem.3.4.name = "cUnitAvail"
 618 stem.3.4.type = unsigned
 619 stem.3.5.name = "cbSector"
 620 stem.3.5.type = unsigned16
 621 stem.4.name = "cbBuf"
 622 stem.4.type = unsigned
 623 stem.return.type = "unsigned"
 624
 625 call funcDefine DosQueryFSInfo, "doscalls", "#278", stem
 626
 627 drop stem.
 628 stem. = 0 /* NOVALUE should not happen */
 629 stem.0 = 3
 630 stem.1.name = "disknum"
 631 stem.1.value = c2d( translate( left( source, 1 ) ) ) - c2d( 'A' ) + 1
 632 stem.2.name = "infolevel"
 633 stem.2.value = 1
 634 stem.3.name = "pBuf"
 635 stem.3.value = 5
 636 stem.4.name = "cbBuf"
 637 stem.4.value = 18
 638 if DosQueryFSInfo( stem ) = 0 then do
 639    cluster = stem.3.2.value * stem.3.5.value
 640    say "Total size:" showFileSize( cluster*stem.3.3.value )
 641    say "Free  size:" showFileSize( cluster*stem.3.4.value )
 642    end
 643 else
 644    say "Error calling DosQueryFSInfo."
 645
 646 call funcDrop DosQueryFSInfo
 647 say ""
 648 return 0
 649
 650 /*****/
 651 showFileSize: procedure
 652    suffix = "byte"
 653    size = arg(1)
 654    suffixes = "KB MB GB TB"
 655    do i = 1 to words( suffixes )
 656       if size < 1024 then
 657          leave
 658       suffix = word( suffixes, i )
 659       size = size / 1024
 660       end
 661    if size >= 100 then
 662       size = format( size, , 0 )
 663    else if size >= 10 then
 664       size = format( size, , 1 )
 665    else
 666       size = format( size, , 2 )
 667    return size suffix
 668
 669 /*****************************************************************************/
 670 syntax:
 671    /*
 672     * Not all interpreters are ANSI compatible.
 673     */
 674    code = .MN
 675    if code = '.MN' then
 676       code = RC
 677    if datatype( SIGL_FUNCDEFINE, "W" ) then
 678       SIGL = SIGL_FUNCDEFINE
 679    say "Error" code "in line" SIGL || ":" condition('D')
 680    say "GCI_RC=" || GCI_RC
 681    exit 0
 682
 683 /*****************************************************************************/
 684 funcDrop:
 685    /*
 686     * Drops one defined function depending on whether is is defined in the
 687     * lightweight library or in the interpreter's kernel.
 688     */
 689    if InternalGCI then
 690       call RxFuncDrop arg(1)
 691    else
 692       call GciFuncDrop arg(1)
 693    return
 694
 695 /*****************************************************************************/
 696 funcDefine:
 697    /*
 698     * Defines a new subroutine as RxFuncDefine does, additionally it undefines
 699     * (drops) the subroutine in front and it shows the error messages.
 700     * Finally it terminates the process is an error occurs.
 701     */
 702    _SIGL_FUNCDEFINE = SIGL
 703    call funcDrop arg(1)
 704    drop GCI_RC
 705    SIGL_FUNCDEFINE = _SIGL_FUNCDEFINE
 706    call RxFuncDefine arg(1), arg(2), arg(3), arg(4)
 707    drop SIGL_FUNCDEFINE _SIGL_FUNCDEFINE
 708    if RESULT = 0 then
 709       return
 710    if IsRegina & InternalGCI then
 711       errAdd = ":" RxFuncErrMsg()
 712    else do
 713       if GCI_RC \= "GCI_RC" then
 714          errAdd = ":" GCI_RC
 715       else
 716          errAdd = ""
 717       end
 718    say "Error defining '" || arg(1) || "', code" RESULT || errAdd
 719
 720    exit 1
 721