regina/demo/gci-try.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 some natural logarithms"
 195 stem.calltype = cdecl with parameters as function
 196 stem.0 = 1
 197 stem.1.name = "X"
 198 stem.1.type = float128
 199 stem.return.type = float128
 200 call RxFuncDefine logl, MathLib, "logl", stem
 201 if RESULT \= 0 then do
 202    stem.1.type = float96
 203    stem.return.type = float96
 204    call RxFuncDefine logl, MathLib, "logl", stem
 205    end
 206 if RESULT \= 0 then do
 207    stem.1.type = float64
 208    stem.return.type = float64
 209    call RxFuncDefine logl, MathLib, "log", stem
 210    end
 211 if RESULT \= 0 then do
 212    if IsRegina & InternalGCI then
 213       say "Error, code" RESULT || ":" RxFuncErrMsg()
 214    else
 215       say "Error, code" RESULT || ":" GCI_RC
 216    return 1
 217    end
 218
 219 say "some logarithms"
 220 do i = 1 to 5
 221    say "log("i")="logl(i)
 222    end
 223
 224 call funcDrop logl
 225 say ""
 226 /*******************************/
 227 say "Using a structure and checking the file system's size."
 228 say "You may look into the source."
 229 /*
 230  * This examples has removed all unnecessary stuff.
 231  */
 232 stem.calltype = cdecl as function
 233 stem.0 = 2
 234 stem.1.type = indirect string256
 235 stem.2.type = indirect container
 236 stem.2.0 = 10                                /* statvfs64 */
 237 stem.2.1.type    = unsigned                  /* bsize */
 238 stem.2.2.type    = unsigned                  /* frsize */
 239 stem.2.3.type    = unsigned64                /* blocks */
 240 stem.2.4.type    = unsigned64                /* bfree */
 241 stem.2.5.type    = unsigned64                /* bavail */
 242 stem.2.6.type    = unsigned64                /* files */
 243 stem.2.7.type    = unsigned64                /* ffree */
 244 stem.2.8.type    = unsigned64                /* favail */
 245 stem.2.9.type    = unsigned                  /* fsid */
 246 stem.2.10.type   = string256                /* indifferent between unices */
 247 stem.return.type = integer
 248
 249 call funcDefine statvfs, CLib, "statvfs64", stem
 250
 251 args. = 0
 252 args.1.value = source
 253 args.2.value = 10    /* otherwise the argument becomes NULL */
 254 if statvfs( args ) \= -1 then do
 255    say "statvfs-info of" source
 256    say "block size =" args.2.1.value "byte"
 257    size = trunc(args.2.3.value * args.2.1.value / (1024 * 1024))
 258    avail = trunc(args.2.5.value * args.2.1.value / (1024 * 1024))
 259    say "file system size =" size"MB, available =" avail"MB"
 260    say "file nodes =" args.2.6.value "available =" args.2.8.value
 261    say "sid =" args.2.9.value
 262    end
 263 else
 264    say "Sorry, '"source"' not found."
 265
 266 call funcDrop statvfs
 267 say ""
 268 /*******************************/
 269
 270 say "We use qsort of the C library for sorting some strings using arrays."
 271 /*
 272  * This examples has removed all unnecessary stuff.
 273  * We need a sorting routine. Without callbacks we have to use one of a
 274  * library. "strcmp" is a good example. We have to play with the dynamic
 275  * link loader.
 276  * The strategy is:
 277  * Load the loader functions (dlopen, dlsym, dlclose)
 278  * Load the compare routine (strcmp) using the loader functions
 279  * Load the sorting routine (qsort) and do the sort
 280  * Additional sort operations may have to redefine qsort only.
 281  */
 282 stem.calltype = cdecl with parameters as function
 283 stem.0 = 2
 284 stem.1.type = indirect string256
 285 stem.2.type = integer
 286 stem.return.type = integer       /* handle, but who cares? */
 287 call funcDefine dlopen, "dl", "dlopen", stem
 288
 289 stem.calltype = cdecl with parameters as function
 290 stem.0 = 2
 291 stem.1.type = integer            /* handle */
 292 stem.2.type = indirect string256
 293 stem.return.type = integer       /* entry point address, but who cares? */
 294 call funcDefine dlsym, "dl", "dlsym", stem
 295
 296 stem.calltype = cdecl with parameters as function
 297 stem.0 = 1
 298 stem.1.type = integer            /* handle */
 299 stem.return.type = integer
 300 call funcDefine dlclose, "dl", "dlclose", stem
 301
 302 CLibHandle = dlopen( CLib, 1 /* RTLD_LAZY */ )
 303 if CLibHandle = 0 then do
 304    say "dlopen() can't load" CLib
 305    return 1
 306    end
 307
 308 strcmp = dlsym( CLibHandle, "strcmp" )
 309 if strcmp = 0 then do
 310    say "dlsym() can't relocate strcmp()"
 311    return 1
 312    end
 313
 314 stem.calltype = cdecl
 315 stem.0 = 4
 316 stem.1.type = indirect array
 317 stem.1.0 = 3
 318 stem.1.1.type = string95
 319 stem.2.type = integer
 320 stem.3.type = integer
 321 stem.4.type = integer
 322 stem.return.type = ""
 323 call funcDefine qsort10, CLib, "qsort", stem
 324
 325 args.0 = 4
 326 args.1.value = 3
 327 args.1.1.value = "Ann"
 328 args.1.2.value = "Charles"
 329 args.1.3.value = "Betty"
 330 args.2.value = 3
 331 args.3.value = 96
 332 args.4.value = strcmp
 333 say "Sorting (" args.1.1.value args.1.2.value args.1.3.value ") ..."
 334 call qsort10 args
 335 say "Sorted values are (" args.1.1.value args.1.2.value args.1.3.value ")"
 336
 337 call dlclose CLibHandle
 338 call funcDrop qsort
 339 call funcDrop dlclose
 340 call funcDrop dlsym
 341 call funcDrop dlopen
 342 say ""
 343 call accessStructTm
 344 return 0
 345
 346
 347 /***************************************************/
 348 useWindows:
 349 stem.calltype = stdcall with parameters as function
 350 stem.0 = 4
 351 stem.1.name = "HWND"
 352 stem.1.type = unsigned
 353 stem.2.name = "Text"
 354 stem.2.type = indirect string1024
 355 stem.3.name = "Caption"
 356 stem.3.type = indirect string1024
 357 stem.4.name = "Type"
 358 stem.4.type = unsigned
 359 stem.return.type = integer
 360
 361 call funcDefine messagebox, "user32", "MessageBoxA", stem
 362
 363 MB_YESNO_INFO = x2d(44)
 364 if messagebox( 0, "Do you love this rocking GCI?", "GCI", MB_YESNO_INFO ) = 6 then
 365    say "Yes, you're right, GCI is cool."
 366 else
 367    say "No, you're kidding! GCI is cool."
 368
 369 call funcDrop messagebox
 370 say ""
 371 /*******************************/
 372 say "We operate on containers and check this file's date."
 373 say "You may look into the source."
 374 /*
 375  * This examples has removed all unnecessary stuff.
 376  */
 377 stem.calltype = stdcall as function
 378 stem.0 = 2
 379 stem.1.type = indirect string256
 380 stem.2.type = indirect container
 381 stem.2.0 = 8                                 /* WIN32_FIND_DATA */
 382 stem.2.1.type = unsigned                     /* FileAttributes */
 383 stem.2.2.type = unsigned64                   /* Creation */
 384 stem.2.3.type = unsigned64                   /* Access */
 385 stem.2.4.type = unsigned64                   /* Write */
 386 stem.2.5.type = unsigned64                   /* Size */
 387 stem.2.6.type = unsigned64                   /* Reserved */
 388 stem.2.7.type = string259                    /* FileName */
 389 stem.2.8.type = string13                     /* AlternateFileName */
 390 stem.return.type = integer
 391
 392 stem2.calltype = stdcall with parameters
 393 stem2.0 = 1
 394 stem2.1.type = integer
 395 stem2.return.type = ""
 396
 397 call funcDefine findfirstfile, "kernel32", "FindFirstFileA", stem
 398
 399 call funcDefine findclose, "kernel32", "FindClose", stem2
 400
 401 args. = 0
 402 args.1.value = source
 403 args.2.value = 8    /* otherwise the argument becomes NULL */
 404 handle = findfirstfile( args )
 405 if handle \= -1 then do
 406    say "argument's name="source
 407    say "filename="args.2.7.value
 408    say "8.3-name="args.2.8.value
 409    numeric digits 40
 410    filetime = args.2.4.value
 411    d = /*second*/ 1000*1000*10   *   /*seconds per day*/ 60*60*24
 412    daypart = trunc(filetime / d)
 413    date = date( 'N', daypart + date('B', 16010101, 'S'), 'B')
 414    ns = filetime - daypart * d
 415    secs = ns % (10*1000*1000)
 416    fract = ns // (10*1000*1000)
 417    time = time('N', secs, 'S') || "." || right(fract, 7, '0')
 418    say "ns from 1.1.1601="filetime "= GMT," date || "," time
 419    numeric digits 9
 420    call findclose handle
 421    end
 422 else
 423    say "Sorry, '"source"' not found."
 424
 425 call funcDrop findfirstfile
 426 call funcDrop findclose
 427 say ""
 428 call accessStructTm
 429
 430 return 0
 431
 432 /***************************************************/
 433 accessStructTm: procedure expose IsRegina InternalGCI CLib version
 434 if version < 1.1 then
 435    return
 436 say "Finally, we use the LIKE keyword and check the number of the week."
 437 say "You may look into the source, we use a PROCEDURE and v1.1 specific code."
 438 /*
 439  * This examples has removed all unnecessary stuff.
 440  */
 441 tm.0 = 10
 442 tm.1.type = integer /* tm_sec */
 443 tm.2.type = integer /* tm_min */
 444 tm.3.type = integer /* tm_hour */
 445 tm.4.type = integer /* tm_mday */
 446 tm.5.type = integer /* tm_mon */
 447 tm.6.type = integer /* tm_year */
 448 tm.7.type = integer /* tm_wday */
 449 tm.8.type = integer /* tm_yday */
 450 tm.9.type = integer /* tm_isdst */
 451 tm.10.type = string 32 /* reserved stuff sometimes used by the OS */
 452
 453 time_t.0 = 1
 454 time_t.1.type = integer64 /* SURPRISE! some systems may use 64 bit data types
 455                            * already. We don't have problems with this,
 456                            * because we use double buffering.
 457                            */
 458
 459 stem.calltype = cdecl
 460 stem.0 = 1
 461 stem.1.type = indirect container like time_t
 462 stem.return.type = ""
 463 call funcDefine _time, CLib, "time", stem
 464
 465 stem.calltype = cdecl
 466 stem.0 = 1
 467 stem.1.type = indirect container like time_t
 468 stem.return.type = indirect container like tm
 469 call funcDefine localtime, CLib, "localtime", stem
 470
 471 stem.calltype = cdecl
 472 stem.0 = 4
 473 stem.1.type = indirect string256  /* dest */
 474 stem.2.type = unsigned            /* size(dest) */
 475 stem.3.type = indirect string256  /* template */
 476 stem.4.type = indirect container like tm
 477 stem.return.type = unsigned
 478 call funcDefine strftime, CLib, "strftime", stem
 479
 480 time_val.1.value = 1
 481 time_val.1.1.value = 1
 482 call _time time_val
 483
 484 lct.1.value = 1
 485 lct.1.1.value = time_val.1.1.value
 486 call localtime lct
 487
 488 strf.1.value = ""
 489 strf.2.value = 256
 490 strf.3.value = "%A"
 491 strf.4.value = lct.return.value
 492 do i = 1 to 10
 493    strf.4.i.value = lct.return.i.value
 494    end
 495 call strftime strf
 496 dayname = strf.1.value
 497
 498 strf.3.value = "%B"
 499 call strftime strf
 500 monthname = strf.1.value
 501
 502 strf.3.value = "%U"
 503 call strftime strf
 504 week!Sun = strf.1.value
 505
 506 strf.3.value = "%W"
 507 call strftime strf
 508 week!Mon = strf.1.value
 509
 510 if week!Mon = week!Sun then
 511    add = "."
 512 else
 513    add = " if you count Monday as the first day of the week. Otherwise it " ||,
 514          "is the" week!Sun || ". week."
 515 say "Today is a" dayname "in" monthname || ". We have the" week!Mon || ". week" || add
 516 say
 517 call funcDrop strftime
 518 call funcDrop localtime
 519 call funcDrop _time
 520
 521 return
 522
 523 /***************************************************/
 524 useOS2:
 525 say "Checking the high precision system timer."
 526 stem.calltype = stdcall
 527 stem.0 = 1
 528 stem.1.name = "Frequency"
 529 stem.1.type = indirect unsigned
 530 stem.return.type = "unsigned"
 531
 532 call funcDefine DosTmrQueryFreq, "doscalls", "#362", stem
 533
 534 stem.1.name = "Frequency"
 535 stem.1.value = 0        /* don't raise NOVALUE */
 536
 537 call DosTmrQueryFreq stem
 538 if stem.return.value \= 0 then
 539    say "Error" stem.return.value "while using DosTmrQueryFreq."
 540 else
 541    say "The timer has a frequency of" stem.1.value "Hz"
 542
 543 call funcDrop DosTmrQueryFreq
 544 say ""
 545 /*******************************/
 546 say "You should hear your beeper."
 547 /*
 548  * Use the "with parameters" feature.
 549  */
 550 stem.calltype = stdcall with parameters
 551 stem.0 = 2
 552 stem.1.name = "Frequency"
 553 stem.1.type = unsigned
 554 stem.2.name = "Duration"
 555 stem.2.type = unsigned
 556 stem.return.type = ""           /* We are not interested in the return value */
 557
 558 call funcDefine DosBeep, "doscalls", "#286", stem
 559
 560 do i = 500 to 3000 by 100
 561    call DosBeep i, 10
 562    end
 563
 564 call funcDrop DosBeep
 565 say ""
 566 /*******************************/
 567 say "Checking the installed codepages."
 568 /*
 569  * Use the "as function" feature.
 570  */
 571 stem.calltype = stdcall as function
 572 stem.0 = 3
 573 stem.1.name = "cb"
 574 stem.1.type = unsigned
 575 stem.2.name = "arCP"
 576 stem.2.type = indirect array
 577 stem.2.0 = 25
 578 stem.2.1.type = unsigned
 579 stem.3.name = "pcCP"
 580 stem.3.type = indirect unsigned
 581 stem.return.type = "unsigned"
 582
 583 call funcDefine DosQueryCp, "doscalls", "#291", stem
 584
 585 drop stem.
 586 stem. = 0 /* NOVALUE should not happen */
 587 stem.0 = 3
 588 stem.1.name = "cb"
 589 stem.1.value = 100
 590 stem.2.name = "arCP"
 591 stem.2.value = 25
 592 stem.3.name = "pcCP"
 593 if DosQueryCp( stem ) = 0 then do
 594    say "current codepage:" stem.2.1.value
 595    do i = 2 to stem.3.value / 4
 596       say "prepared codepage:" stem.2.i.value
 597       end
 598    end
 599 else
 600    say "Error calling DosQueryCp."
 601
 602 call funcDrop DosQueryCp
 603 say ""
 604 /*******************************/
 605 say "Examining the file system on" left( source, 2 )
 606 /*
 607  * Use the "as function" feature.
 608  */
 609 stem.calltype = stdcall as function
 610 stem.0 = 4
 611 stem.1.name = "disknum"
 612 stem.1.type = unsigned
 613 stem.2.name = "infolevel"
 614 stem.2.type = unsigned
 615 stem.3.name = "pBuf"
 616 stem.3.type = indirect container
 617 stem.3.0 = 5
 618 stem.3.1.name = "idFileSystem"
 619 stem.3.1.type = unsigned
 620 stem.3.2.name = "cSectorUnit"
 621 stem.3.2.type = unsigned
 622 stem.3.3.name = "cUnit"
 623 stem.3.3.type = unsigned
 624 stem.3.4.name = "cUnitAvail"
 625 stem.3.4.type = unsigned
 626 stem.3.5.name = "cbSector"
 627 stem.3.5.type = unsigned16
 628 stem.4.name = "cbBuf"
 629 stem.4.type = unsigned
 630 stem.return.type = "unsigned"
 631
 632 call funcDefine DosQueryFSInfo, "doscalls", "#278", stem
 633
 634 drop stem.
 635 stem. = 0 /* NOVALUE should not happen */
 636 stem.0 = 3
 637 stem.1.name = "disknum"
 638 stem.1.value = c2d( translate( left( source, 1 ) ) ) - c2d( 'A' ) + 1
 639 stem.2.name = "infolevel"
 640 stem.2.value = 1
 641 stem.3.name = "pBuf"
 642 stem.3.value = 5
 643 stem.4.name = "cbBuf"
 644 stem.4.value = 18
 645 if DosQueryFSInfo( stem ) = 0 then do
 646    cluster = stem.3.2.value * stem.3.5.value
 647    say "Total size:" showFileSize( cluster*stem.3.3.value )
 648    say "Free  size:" showFileSize( cluster*stem.3.4.value )
 649    end
 650 else
 651    say "Error calling DosQueryFSInfo."
 652
 653 call funcDrop DosQueryFSInfo
 654 say ""
 655 return 0
 656
 657 /*****/
 658 showFileSize: procedure
 659    suffix = "byte"
 660    size = arg(1)
 661    suffixes = "KB MB GB TB"
 662    do i = 1 to words( suffixes )
 663       if size < 1024 then
 664          leave
 665       suffix = word( suffixes, i )
 666       size = size / 1024
 667       end
 668    if size >= 100 then
 669       size = format( size, , 0 )
 670    else if size >= 10 then
 671       size = format( size, , 1 )
 672    else
 673       size = format( size, , 2 )
 674    return size suffix
 675
 676 /*****************************************************************************/
 677 syntax:
 678    /*
 679     * Not all interpreters are ANSI compatible.
 680     */
 681    code = .MN
 682    if code = '.MN' then
 683       code = RC
 684    if datatype( SIGL_FUNCDEFINE, "W" ) then
 685       SIGL = SIGL_FUNCDEFINE
 686    say "Error" code "in line" SIGL || ":" condition('D')
 687    say "GCI_RC=" || GCI_RC
 688    exit 0
 689
 690 /*****************************************************************************/
 691 funcDrop:
 692    /*
 693     * Drops one defined function depending on whether is is defined in the
 694     * lightweight library or in the interpreter's kernel.
 695     */
 696    if InternalGCI then
 697       call RxFuncDrop arg(1)
 698    else
 699       call GciFuncDrop arg(1)
 700    return
 701
 702 /*****************************************************************************/
 703 funcDefine:
 704    /*
 705     * Defines a new subroutine as RxFuncDefine does, additionally it undefines
 706     * (drops) the subroutine in front and it shows the error messages.
 707     * Finally it terminates the process is an error occurs.
 708     */
 709    _SIGL_FUNCDEFINE = SIGL
 710    call funcDrop arg(1)
 711    drop GCI_RC
 712    SIGL_FUNCDEFINE = _SIGL_FUNCDEFINE
 713    call RxFuncDefine arg(1), arg(2), arg(3), arg(4)
 714    drop SIGL_FUNCDEFINE _SIGL_FUNCDEFINE
 715    if RESULT = 0 then
 716       return
 717    if IsRegina & InternalGCI then
 718       errAdd = ":" RxFuncErrMsg()
 719    else do
 720       if GCI_RC \= "GCI_RC" then
 721          errAdd = ":" GCI_RC
 722       else
 723          errAdd = ""
 724       end
 725    say "Error defining '" || arg(1) || "', code" RESULT || errAdd
 726
 727    exit 1
 728