1{ 2 Copyright (c) 1989, 1991 IBM Corporation 3 Copyright (c) 2003 by Yuri Prokushev (prokushev@freemail.ru). 4 5 REXX SAA Interface 6 7 This program is free software; you can redistribute it and/or modify it 8 under the terms of the GNU Library General Public License (LGPL) as 9 published by the Free Software Foundation; either version 2 of the 10 License, or (at your option) any later version. This program is 11 distributed in the hope that it will be useful, but WITHOUT ANY 12 WARRANTY; without even the implied warranty of MERCHANTABILITY or 13 FITNESS FOR A PARTICULAR PURPOSE. 14 15 See the GNU Library General Public License for more details. You should 16 have received a copy of the GNU Library General Public License along 17 with this program; if not, write to the Free Software Foundation, Inc., 18 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. 19 20 **********************************************************************} 21 22{ 23@abstract(REXX SAA interface) 24@author(Yuri Prokushev (prokushev@freemail.ru)) 25@created(01 Feb 2003) 26@lastmod(13 Feb 2003) 27REXX SAA Interface 28Warning: This code is alfa. Future versions of this unit will propably 29not be compatible. 30} 31(********************************************************************* 32* 33* REXX SAA Interface 34* 35*********************************************************************) 36Unit RexxSAA; 37 38Interface 39 40{$Mode ObjFpc} 41 42Const 43{$IFDEF OS2} 44 REXX='REXX'; 45 REXXAPI='REXXAPI'; 46{$ELSE} 47 {$IFDEF UNIX} 48 REXX='libregina'; 49 REXXAPI='libregina'; 50 {$ELSE} 51 REXX='REGINA'; 52 REXXAPI='REGINA'; 53 {$ENDIF} 54{$ENDIF} 55//******************************************************************** 56// * 57// Common * 58// * 59//******************************************************************** 60 61//* This section defines return codes and constants that are the */ 62//* same for both 16-bit and 32-bit REXX calls. */ 63 64//Structure for external interface string (RXSTRING) 65 66Type 67 RxString=record 68 StrLength: Cardinal; // Length of string 69 StrPtr: PChar; // Pointer to a string 70 end; 71 PRxString=^RxString; // pointer to a RXSTRING 72 73Const 74 RxAutoBufLen=256; 75 76Type 77 PFN=Pointer; 78 79//Structure for system exit block (RXSYSEXIT) 32-bit 80 81Type 82 RxSysExit=record 83 sysexit_name: PChar; // subcom enviro for sysexit 84 sysexit_code: Longint; // sysexit function code 85 end; 86 PRxSysExit=^RxSysExit; // pointer to a RXSYSEXIT 87 88// Macros for RXSTRING manipulation 89Function RXNULLSTRING(CONST r:RXSTRING):BOOLEAN; 90Function RXZEROLENSTRING(CONST r:RXSTRING):BOOLEAN; 91Function RXVALIDSTRING(CONST r:RXSTRING):BOOLEAN; 92Function RXSTRLEN(CONST r:RXSTRING):LONGINT; 93Function RXSTRPTR(CONST r:RXSTRING):PChar; 94Procedure MAKERXSTRING(VAR r:RXSTRING;p:PChar;l:LONGINT); 95 96//Call type codes for use on interpreter startup 97Const 98 RxCommand=0; // Program called as Command 99 RxSubroutine=1; // Program called as Subroutin 100 RxFunction=2; // Program called as Function 101 102// Subcommand Interface defines 103 104 105// Drop Authority for RXSUBCOM interface 106 107Const 108 RxSubCom_Droppable=$00; // handler to be dropped by all 109 RxSubCom_Nondrop=$01; // process with same PID as the 110 // registrant may drop environ 111 112// Return Codes from RXSUBCOM interface 113Const 114 RXSUBCOM_ISREG = $01; // Subcommand is registered 115 RXSUBCOM_ERROR = $01; // Subcommand Ended in Error 116 RXSUBCOM_FAILURE = $02; // Subcommand Ended in Failure 117 RXSUBCOM_BADENTRY = 1001; // Invalid Entry Conditions 118 RXSUBCOM_NOEMEM = 1002; // Insuff stor to complete req 119 RXSUBCOM_BADTYPE = 1003; // Bad registration type. 120 RXSUBCOM_NOTINIT = 1004; // API system not initialized. 121 RXSUBCOM_OK = 0; // Function Complete 122 RXSUBCOM_DUP = 10; // Duplicate Environment Name- 123 // but Registration Completed 124 RXSUBCOM_MAXREG = 20; // Cannot register more 125 // handlers 126 RXSUBCOM_NOTREG = 30; // Name Not Registered 127 RXSUBCOM_NOCANDROP = 40; // Name not droppable 128 RXSUBCOM_LOADERR = 50; // Could not load function 129 RXSUBCOM_NOPROC =127; // RXSUBCOM routine - not found 130 131// Shared Variable Pool Interface defines 132 133// Function Codes for Variable Pool Interface (shvcode) 134Const 135 RXSHV_SET = $00; // Set var from given value 136 RXSHV_FETCH = $01; // Copy value of var to buffer 137 RXSHV_DROPV = $02; // Drop variable 138 RXSHV_SYSET = $03; // Symbolic name Set variable 139 RXSHV_SYFET = $04; // Symbolic name Fetch variable 140 RXSHV_SYDRO = $05; // Symbolic name Drop variable 141 RXSHV_NEXTV = $06; // Fetch "next" variable 142 RXSHV_PRIV = $07; // Fetch private information 143 RXSHV_EXIT = $08; // Set function exit value 144 145// Return Codes for Variable Pool Interface 146 147Const 148 RXSHV_NOAVL = 144; // Interface not available 149 150// Return Code Flags for Variable Pool Interface (shvret) 151 152Const 153 RXSHV_OK = $00; // Execution was OK 154 RXSHV_NEWV = $01; // Variable did not exist 155 RXSHV_LVAR = $02; // Last var trans via SHVNEXTV 156 RXSHV_TRUNC = $04; // Truncation occurred-Fetch 157 RXSHV_BADN = $08; // Invalid variable name 158 RXSHV_MEMFL = $10; // Out of memory failure 159 RXSHV_BADF = $80; // Invalid funct code (shvcode) 160 161// Structure of Shared Variable Request Block (SHVBLOCK) 162Type 163 PSHVBLOCK=^SHVBLOCK; 164 SHVBLOCK=record 165 shvnext: PSHVBLOCK; // pointer to the next block 166 shvname: RxString; // Pointer to the name buffer 167 shvvalue: RxString; // Pointer to the value buffer 168 shvnamelen: Cardinal; // Length of the name value 169 shvvaluelen: Cardinal; // Length of the fetch value 170 shvcode: Byte; // Function code for this block 171 shvret: Byte; // Individual Return Code Flags 172 end; 173 174// External Function Interface 175 176// Registration Type Identifiers for Available Function Table 177Const 178 RXFUNC_DYNALINK=1; // Function Available in DLL 179 RXFUNC_CALLENTRY=2; // Registered as mem entry pt. 180 181// Return Codes from RxFunction interface 182Const 183 RXFUNC_OK = 0; // REXX-API Call Successful 184 RXFUNC_DEFINED = 10; // Function Defined in AFT 185 RXFUNC_NOMEM = 20; // Not Enough Mem to Add 186 RXFUNC_NOTREG = 30; // Funct Not Registered in AFT 187 RXFUNC_MODNOTFND = 40; // Funct Dll Module Not Found 188 RXFUNC_ENTNOTFND = 50; // Funct Entry Point Not Found 189 RXFUNC_NOTINIT = 60; // API not initialized 190 RXFUNC_BADTYPE = 70; // Bad function type 191 192// System Exits defines 193 194// Drop Authority for Rexx Exit interface 195Const 196 RXEXIT_DROPPABLE = $00; // handler to be dropped by all 197 RXEXIT_NONDROP = $01; // process with same PID as the 198 // registrant may drop environ 199// Exit return actions 200Const 201 RXEXIT_HANDLED = 0; // Exit handled exit event 202 RXEXIT_NOT_HANDLED = 1; // Exit passes on exit event 203 RXEXIT_RAISE_ERROR =-1; // Exit handler error occurred 204 205// Return Codes from RXEXIT interface 206Const 207 RXEXIT_ISREG = $01; // Exit is registered 208 RXEXIT_ERROR = $01; // Exit Ended in Error 209 RXEXIT_FAILURE = $02; // Exit Ended in Failure 210 RXEXIT_BADENTRY = 1001; // Invalid Entry Conditions 211 RXEXIT_NOEMEM = 1002; // Insuff stor to complete req 212 RXEXIT_BADTYPE = 1003; // Bad registration type. 213 RXEXIT_NOTINIT = 1004; // API system not initialized. 214 RXEXIT_OK = 0; // Function Complete 215 RXEXIT_DUP = 10; // Duplicate Exit Name- 216 // but Registration Completed 217 RXEXIT_MAXREG = 20; // Cannot register more 218 // handlers 219 RXEXIT_NOTREG = 30; // Name Not Registered 220 RXEXIT_NOCANDROP = 40; // Name not droppable 221 RXEXIT_LOADERR = 50; // Could not load function 222 RXEXIT_NOPROC = 127; // RXEXIT routine - not found 223 224// System Exit function and sub-function definitions 225Const 226 RXENDLST = 0; // End of exit list. 227 RXFNC = 2; // Process external functions. 228 RXFNCCAL = 1; // subcode value. 229 RXCMD = 3; // Process host commands. 230 RXCMDHST = 1; // subcode value. 231 RXMSQ = 4; // Manipulate queue. 232 RXMSQPLL = 1; // Pull a line from queue 233 RXMSQPSH = 2; // Place a line on queue 234 RXMSQSIZ = 3; // Return num of lines on queue 235 RXMSQNAM = 20; // Set active queue name 236 RXSIO = 5; // Session I/O. 237 RXSIOSAY = 1; // SAY a line to STDOUT 238 RXSIOTRC = 2; // Trace output 239 RXSIOTRD = 3; // Read from char stream 240 RXSIODTR = 4; // DEBUG read from char stream 241 RXSIOTLL = 5; // Return linelength(N/A OS/2) 242 RXHLT = 7; // Halt processing. 243 RXHLTCLR = 1; // Clear HALT indicator 244 RXHLTTST = 2; // Test HALT indicator 245 RXTRC = 8; // Test ext trace indicator. 246 RXTRCTST = 1; // subcode value. 247 RXINI = 9; // Initialization processing. 248 RXINIEXT = 1; // subcode value. 249 RXTER = 10; // Termination processing. 250 RXTEREXT = 1; // subcode value. 251 RXNOOFEXITS = 11; // 1 + largest exit number. 252 253Type 254 PEXIT=^Byte; // ptr to exit parameter block 255 256// Asynchronous Request Interface defines 257 258// Return Codes from Asynchronous Request interface 259Const 260 RXARI_OK = 0; // Interface completed 261 RXARI_NOT_FOUND = 1; // Target program not found 262 RXARI_PROCESSING_ERROR = 2; // Error processing request 263 264// Macro Space Interface defines 265 266// Registration Search Order Flags 267Const 268 RXMACRO_SEARCH_BEFORE = 1; // Beginning of search order 269 RXMACRO_SEARCH_AFTER = 2; // End of search order 270 271// Return Codes from RxMacroSpace interface 272Const 273 RXMACRO_OK = 0; // Macro interface completed 274 RXMACRO_NO_STORAGE = 1; // Not Enough Storage Available 275 RXMACRO_NOT_FOUND = 2; // Requested function not found 276 RXMACRO_EXTENSION_REQUIRED= 3; // File ext required for save 277 RXMACRO_ALREADY_EXISTS = 4; // Macro functions exist 278 RXMACRO_FILE_ERROR = 5; // File I/O error in save/load 279 RXMACRO_SIGNATURE_ERROR = 6; // Incorrect format for load 280 RXMACRO_SOURCE_NOT_FOUND = 7; // Requested cannot be found 281 RXMACRO_INVALID_POSITION = 8; // Invalid search order pos 282 RXMACRO_NOT_INIT = 9; // API not initialized 283 284//*********************************************************************/ 285//* */ 286//* 32-bit */ 287//* */ 288//*********************************************************************/ 289 290// Main Entry Point to the REXXSAA Interpreter 291 292Function RexxStart(ArgC: Longint; // Num of args passed to rexx 293 ArgV: PRXSTRING; // Array of args passed to rex 294 Filename: PChar; // [d:][path] filename[.ext] 295 Proc: PRXSTRING; // Loc of rexx proc in memory 296 Env: PChar; // ASCIIZ initial environment. 297 rType: Longint; // type (command,subrtn,funct) 298 Exit_: PRXSYSEXIT; // SysExit env. names & codes 299 Ret: PInteger; // Ret code from if numeric 300 RetVal: PRXSTRING): Longint; cdecl; // Retvalue from the rexx proc 301 302Function RexxStart(ArgC: Longint; // Num of args passed to rexx 303 ArgV: PRXSTRING; // Array of args passed to rex 304 Filename: PChar; // [d:][path] filename[.ext] 305 Proc: PRXSTRING; // Loc of rexx proc in memory 306 Env: PChar; // ASCIIZ initial environment. 307 rType: Longint; // type (command,subrtn,funct) 308 Exit_: PRXSYSEXIT; // SysExit env. names & codes 309 var Ret: Integer; // Ret code from if numeric 310 var RetVal: RXSTRING): Longint; cdecl; // Retvalue from the rexx proc 311 312// Subcommand Interface 313 314// This type simplifies coding of a Subcommand handler. 315Type 316 RexxSubcomHandler=function(a: PRXSTRING; b: PWord; c: PRXSTRING): Cardinal; cdecl; 317 318// RexxRegisterSubcomDll -- Register a DLL entry point 319// as a Subcommand handler 320 321Function RexxRegisterSubcomDll( 322 HName: PChar; // Name of subcom handler 323 DllName: PChar; // Name of DLL 324 ProcName: PChar; // Name of procedure in DLL 325 UserArea: PWord; // User area 326 Drop: Cardinal): Cardinal; cdecl; // Drop authority. 327 328// RexxRegisterSubcomExe -- Register an EXE entry point 329// as a Subcommand handler 330 331Function RexxRegisterSubcomExe( 332 HName: PChar; // Name of subcom handler 333 HandlerAddr: PFn; // address of handler in EXE 334 UserArea: PWord): Cardinal; cdecl; // User area 335 336// RexxQuerySubcom - Query an environment for Existance 337 338Function RexxQuerySubcom( 339 EnvName: PChar; // Name of the Environment 340 DllName: PChar; // DLL Module Name 341 ExCode: PWord; // Stor for existance code 342 User: PWord): Cardinal; cdecl; // Stor for user word 343 344Function RexxQuerySubcom( 345 EnvName: PChar; // Name of the Environment 346 DllName: PChar; // DLL Module Name 347 var ExCode: Word; // Stor for existance code 348 var User: Word): Cardinal; cdecl; // Stor for user word 349 350// RexxDeregisterSubcom - Drop registration of a Subcommand 351// environment 352 353Function RexxDeregisterSubcom( 354 EnvName: PChar; // Name of the Environment 355 DllName: PChar): Cardinal; cdecl; // DLL Module Name 356 357// Shared Variable Pool Interface 358 359// RexxVariablePool - Request Variable Pool Service 360 361Function RexxVariablePool(Pool: PShvBlock): Cardinal; cdecl; 362Function RexxVariablePool(var Pool: ShvBlock): Cardinal; cdecl; // Pointer to list of SHVBLOCKs 363 364// External Function Interface 365 366// This typedef simplifies coding of an External Function. 367Type 368 RexxFunctionHandler=Function(a: PByte; 369 b: Cardinal; 370 var c: RXSTRING; 371 d: PChar; 372 var e: RXSTRING): Cardinal; cdecl; 373 374// RexxRegisterFunctionDll - Register a function in the AFT 375 376Function RexxRegisterFunctionDll( 377 FnName: PChar; // Name of function to add 378 DllName: PChar; // Dll file name (if in dll) 379 Entry: PChar): Cardinal; cdecl; // Entry in dll 380 381// RexxRegisterFunctionExe - Register a function in the AFT 382 383Function RexxRegisterFunctionExe( 384 FnName: PChar; // Name of function to add 385 Entry: PFn): Cardinal; cdecl; // Entry point in EXE 386 387// RexxDeregisterFunction - Delete a function from the AFT 388 389Function RexxDeregisterFunction(FnName: PChar): Cardinal; cdecl; // Name of function to remove 390 391// RexxQueryFunction - Scan the AFT for a function 392 393Function RexxQueryFunction(FnName: PChar): Cardinal; cdecl; // Name of function to find 394 395// System Exits 396 397// Subfunction RXFNCCAL - External Function Calls 398 399//rxfnc_flags flags 400const 401 rxfferr = $01; // Invalid call to routine. 402 rxffnfnd = $02; // Function not found. 403 rxffsub = $04; // Called as a subroutine 404 405type 406 RxFnCCal_Parm = record 407 rxfnc_flags: Byte; // function flags 408 rxfnc_name: PChar; // Pointer to function name. 409 rxfnc_namel: Word; // Length of function name. 410 rxfnc_que: PChar; // Current queue name. 411 rxfnc_quel: Word; // Length of queue name. 412 rxfnc_argc: Word; // Number of args in list. 413 rxfnc_argv: PRxString; // Pointer to argument list. 414 rxfnc_retc: RxString; // Return value. 415 end; 416 417// Subfunction RXCMDHST -- Process Host Commands 418 419// rxcmd_flags flags 420const 421 rxfcfail = $01; // Command failed. 422 rxfcerr = $02; // Command ERROR occurred. 423 424type 425 RxCmdHst_Parm = record 426 rxcmd_flags: Byte; // error/failure flags 427 rxcmd_address: PChar; // Pointer to address name. 428 rxcmd_addressl: Word; // Length of address name. 429 rxcmd_dll: PChar; // dll name for command. 430 rxcmd_dll_len: Word; // Length of dll name. 431 rxcmd_command: RxString; // The command string. 432 rxcmd_retc: RxString; // Pointer to return buffer 433 end; 434 435 436// Subfunction RXMSQPLL -- Pull Entry from Queue 437 438 RxMsqPll_Parm = record 439 rxmsq_retc: RxString; // Pointer to dequeued entry 440 end; // buffer. User allocated. 441 442 443// Subfunction RXMSQPSH -- Push Entry on Queue 444 445// rxmsq_flags flags 446const 447 rxfmlifo = $01; // Stack entry LIFO if set 448 449type 450 RxMsqPsh_Parm = record 451 rxmsq_flags: Byte; // LIFO/FIFO flag 452 rxmsq_value: RxString // The entry to be pushed. 453 end; 454 455// Subfunction RXMSQSIZ -- Return the Current Queue Size 456Type 457 RxMsqSiz_Parm = record 458 rxmsq_size: Cardinal; // Number of Lines in Queue 459 end; 460 461 462// Subfunction RXMSQNAM -- Set Current Queue Name 463Type 464 RxMsqNam_Parm = record 465 rxmsq_name: RxString; // RxString containing 466 end; // queue name. 467 468 469// Subfunction RXSIOSAY -- Perform SAY Clause 470 471Type 472 RxSioSay_Parm = record 473 rxsio_string: RxString; // String to display. 474 end; 475 476 477// Subfunction RXSIOTRC -- Write Trace Output 478Type 479 RxSioTrc_Parm = record 480 rxsio_string: RxString; // Trace line to display. 481 end; 482 483// Subfunction RXSIOTRD -- Read Input from the Terminal 484Type 485 RxSioTrd_Parm = record 486 rxsiotrd_retc: RxString; // RxString for output. 487 end; 488 489// Subfunction RXSIODTR -- Read Debug Input from the Terminal 490Type 491 RxSioDtr_Parm = record 492 rxsiodtr_retc: RxString; // RxString for output. 493 end; 494 495// Subfunction RXHSTTST -- Test for HALT Condition 496 497// rxhlt_flags flags 498const 499 rxfhhalt = $01; // Set if HALT occurred. 500 501type 502 RxHltTst_Parm = record 503 rxhlt_flags: Byte; // Set if HALT occurred 504 end; 505 506 507// Subfunction RXTRCTST -- Test for TRACE Condition 508 509// rxtrc_flags flags 510const 511 rxftrace = $01; // Set to run external trace. 512type 513 RxTrcTst_Parm = record 514 rxtrc_flags: Byte; // Set to run external trace 515 end; 516 517// This typedef simplifies coding of an Exit handler. 518Type 519 RexxExitHandler=function(A: Longint; 520 B: Longint; 521 C: PEXIT): Cardinal; cdecl; 522 523// RexxRegisterExitDll - Register a system exit. 524 525Function RexxRegisterExitDll( 526 HExit: PChar; // Name of the exit handler 527 DllName: PChar; // Name of the DLL 528 ProcName: PChar; // Name of the procedure 529 UserArea: PByte; // User area 530 Drop: Cardinal): Cardinal; cdecl; // Drop authority 531 532 533// RexxRegisterExitExe - Register a system exit. 534 535Function RexxRegisterExitExe( 536 HExit: PChar; // Name of the exit handler 537 HandlerAddr: PFn; // Address of exit handler 538 UserArea: PByte): Cardinal; cdecl; // User area 539 540// RexxDeregisterExit - Drop registration of a system exit. 541 542Function RexxDeregisterExit( 543 ExitName: PChar; // Exit name 544 DllName: PChar): Cardinal; cdecl; // DLL module name 545 546// RexxQueryExit - Query an exit for existance. 547 548Function RexxQueryExit( 549 ExitName: PChar; // Exit name 550 DllName: PChar; // DLL Module name. 551 var ExFlag: Word; // Existance flag. 552 UserArea: Pointer): Cardinal; cdecl; // User data. 553 554Function RexxQueryExit( 555 ExitName: PChar; // Exit name 556 DllName: PChar; // DLL Module name. 557 var ExFlag: Word; // Existance flag. 558 UserArea: PByte): Cardinal; cdecl; // User data. 559 560Function RexxQueryExit( 561 ExitName: PChar; // Exit name 562 DllName: PChar; // DLL Module name. 563 ExFlag: PWord; // Existance flag. 564 UserArea: PByte): Cardinal; cdecl; // User data. 565 566Function RexxQueryExit( 567 ExitName: PChar; // Exit name 568 DllName: PChar; // DLL Module name. 569 ExFlag: PWord; // Existance flag. 570 UserArea: Pointer): Cardinal; cdecl; // User data. 571 572// Asynchronous Request Interface 573 574// RexxSetHalt - Request Program Halt 575 576Function RexxSetHalt( 577 Pid: Longint; // Process Id 578 Tid: Longint): Cardinal; cdecl; // Thread Id 579 580// RexxSetTrace - Request Program Trace 581 582Function RexxSetTrace( 583 Pid: Longint; // Process Id 584 Tid: Longint): Cardinal; cdecl; // Thread Id 585 586// RexxResetTrace - Turn Off Program Trace 587 588Function RexxResetTrace( 589 Pid: Longint; // Process Id 590 Tid: Longint): Cardinal; cdecl; // Thread Id 591 592// Macro Space Interface 593 594// RexxAddMacro - Register a function in the Macro Space 595 596Function RexxAddMacro( 597 FnName: PChar; // Function to add or change 598 FileName: PChar; // Name of file to get function 599 SrchPos: Cardinal): Cardinal; cdecl; // Flag indicating search pos 600 601// RexxDropMacro - Remove a function from the Macro Space 602 603Function RexxDropMacro(FnName: PChar): Cardinal; cdecl; // Name of function to remove 604 605// RexxSaveMacroSpace - Save Macro Space functions to a file 606 607Function RexxSaveMacroSpace( 608 ArgC: Cardinal; // Argument count (0==save all) 609 var NameLst: PChar; // List of funct names to save 610 FileName: PChar): Cardinal; cdecl; // File to save functions in 611 612// RexxLoadMacroSpace - Load Macro Space functions from a file 613 614Function RexxLoadMacroSpace( 615 ArgC: Cardinal; // Argument count (0==load all) 616 var NameLst: PChar; // List of funct names to load 617 FileName: PChar): Cardinal; cdecl; // File to load functions from 618 619// RexxQueryMacro - Find a function's search-order position 620 621Function RexxQueryMacro( 622 FnName: PChar; // Function to search for 623 var PtrPos: Word): Cardinal; cdecl; // Ptr for position flag return 624 625// RexxReorderMacro - Change a function's search-order 626// position 627 628Function RexxReorderMacro( 629 FnName: PChar; // Name of funct change order 630 NewPos: Cardinal): Cardinal; cdecl; // New position for function 631 632// RexxClearMacroSpace - Remove all functions from a MacroSpace 633 634Function RexxClearMacroSpace: Cardinal; cdecl; // No Arguments. 635 636(* Not supported yet!! 637/* REGINA EXTENSIONS *********************************************************/ 638/* The following function is an extension to the standard. Never try to 639 * address the function directly. Use the dynamic linking machanism of 640 * your operating system instead. This function was introduced in version 641 * 2.0. 642 * Returns: ULONG, in lower byte the two-digit fraction part of the version. 643 * The higher bytes will hold the integer part of the version. 644 * Examples: 0x10A codes the Version "1.10". 645 * VersionString will be filled if VersionString is non-NULL. 646 * If VersionString is non-NULL then there are two possibilities: 647 * a) VersionString->strlength == 0: VersionString is filled with the 648 * appropriate values. VersionString->strptr 649 * is always created. 650 * b) VersionString->strlength != 0: VersionString->strptr is filled up to 651 * this value. VersionString->strlength will 652 * hold the copied bytes. 653 * Note: A terminating ASCII-zero is appended if there is enough space 654 * although it is never counted in VersionString.strlength. 655 * RexxAllocateMemory is used if needed. 656 */ 657*) 658{ 659Type 660 ReginaVersion=Function(var VersionString: RxString); 661} 662 663Implementation 664 665Function RexxStart(ArgC: Longint; // Num of args passed to rexx 666 ArgV: PRXSTRING; // Array of args passed to rex 667 Filename: PChar; // [d:][path] filename[.ext] 668 Proc: PRXSTRING; // Loc of rexx proc in memory 669 Env: PChar; // ASCIIZ initial environment. 670 rType: Longint; // type (command,subrtn,funct) 671 Exit_: PRXSYSEXIT; // SysExit env. names & codes 672 Ret: PInteger; // Ret code from if numeric 673 RetVal: PRXSTRING): Longint; cdecl; // Retvalue from the rexx proc 674 external REXX name 'RexxStart'; 675 676Function RexxStart(ArgC: Longint; // Num of args passed to rexx 677 ArgV: PRXSTRING; // Array of args passed to rex 678 Filename: PChar; // [d:][path] filename[.ext] 679 Proc: PRXSTRING; // Loc of rexx proc in memory 680 Env: PChar; // ASCIIZ initial environment. 681 rType: Longint; // type (command,subrtn,funct) 682 Exit_: PRXSYSEXIT; // SysExit env. names & codes 683 var Ret: integer; // Ret code from if numeric 684 var RetVal: RXSTRING): Longint; cdecl; // Retvalue from the rexx proc 685 external REXX name 'RexxStart'; 686 687Function RexxRegisterSubcomDll( 688 HName: PChar; // Name of subcom handler 689 DllName: PChar; // Name of DLL 690 ProcName: PChar; // Name of procedure in DLL 691 UserArea: PWord; // User area 692 Drop: Cardinal): Cardinal; cdecl; // Drop authority. 693 external REXXAPI name 'RexxRegisterSubcomDll'; 694 695Function RexxRegisterSubcomExe( 696 HName: PChar; // Name of subcom handler 697 HandlerAddr: PFn; // address of handler in EXE 698 UserArea: PWord): Cardinal; cdecl; // User area 699 external REXXAPI name 'RexxRegisterSubcomExe'; 700 701Function RexxQuerySubcom( 702 EnvName: PChar; // Name of the Environment 703 DllName: PChar; // DLL Module Name 704 ExCode: PWord; // Stor for existance code 705 User: PWord): Cardinal; cdecl; // Stor for user word 706 external REXXAPI name 'RexxQuerySubcom'; 707 708Function RexxQuerySubcom( 709 EnvName: PChar; // Name of the Environment 710 DllName: PChar; // DLL Module Name 711 var ExCode: Word; // Stor for existance code 712 var User: Word): Cardinal; cdecl; // Stor for user word 713 external REXXAPI name 'RexxQuerySubcom'; 714 715Function RexxDeregisterSubcom( 716 EnvName: PChar; // Name of the Environment 717 DllName: PChar): Cardinal; cdecl; // DLL Module Name 718 external REXXAPI name 'RexxDeregisterSubcom'; 719 720Function RexxVariablePool(Pool: PShvBlock): Cardinal; cdecl; 721 external REXX name 'RexxVariablePool'; 722Function RexxVariablePool(var Pool: ShvBlock): Cardinal; cdecl; // Pointer to list of SHVBLOCKs 723 external REXX name 'RexxVariablePool'; 724 725Function RexxRegisterFunctionDll( 726 FnName: PChar; // Name of function to add 727 DllName: PChar; // Dll file name (if in dll) 728 Entry: PChar): Cardinal; cdecl; // Entry in dll 729 external REXXAPI name 'RexxRegisterFunctionDll'; 730 731Function RexxRegisterFunctionExe( 732 FnName: PChar; // Name of function to add 733 Entry: PFn): Cardinal; cdecl; // Entry point in EXE 734 external REXXAPI name 'RexxRegisterFunctionExe'; 735 736Function RexxDeregisterFunction(FnName: PChar): Cardinal; cdecl; // Name of function to remove 737 external REXXAPI name 'RexxDeregisterFunction'; 738 739Function RexxQueryFunction(FnName: PChar): Cardinal; cdecl; // Name of function to find 740 external REXXAPI name 'RexxQueryFunction'; 741 742Function RexxRegisterExitDll( 743 HExit: PChar; // Name of the exit handler 744 DllName: PChar; // Name of the DLL 745 ProcName: PChar; // Name of the procedure 746 UserArea: PByte; // User area 747 Drop: Cardinal): Cardinal; cdecl; // Drop authority 748 external REXXAPI name 'RexxRegisterExitDll'; 749 750Function RexxRegisterExitExe( 751 HExit: PChar; // Name of the exit handler 752 HandlerAddr: PFn; // Address of exit handler 753 UserArea: PByte): Cardinal; cdecl; // User area 754 external REXXAPI name 'RexxRegisterExitExe'; 755 756Function RexxDeregisterExit( 757 ExitName: PChar; // Exit name 758 DllName: PChar): Cardinal; cdecl; // DLL module name 759 external REXXAPI name 'RexxDeregisterExit'; 760 761Function RexxQueryExit( 762 ExitName: PChar; // Exit name 763 DllName: PChar; // DLL Module name. 764 var ExFlag: Word; // Existance flag. 765 UserArea: Pointer): Cardinal; cdecl; // User data. 766 external REXXAPI name 'RexxQueryExit'; 767 768Function RexxQueryExit( 769 ExitName: PChar; // Exit name 770 DllName: PChar; // DLL Module name. 771 var ExFlag: Word; // Existance flag. 772 UserArea: PByte): Cardinal; cdecl; // User data. 773 external REXXAPI name 'RexxQueryExit'; 774 775Function RexxQueryExit( 776 ExitName: PChar; // Exit name 777 DllName: PChar; // DLL Module name. 778 ExFlag: PWord; // Existance flag. 779 UserArea: PByte): Cardinal; cdecl; // User data. 780 external REXXAPI name 'RexxQueryExit'; 781 782Function RexxQueryExit( 783 ExitName: PChar; // Exit name 784 DllName: PChar; // DLL Module name. 785 ExFlag: PWord; // Existance flag. 786 UserArea: Pointer): Cardinal; cdecl; // User data. 787 external REXXAPI name 'RexxQueryExit'; 788 789Function RexxSetHalt( 790 Pid: Longint; // Process Id 791 Tid: Longint): Cardinal; cdecl; // Thread Id 792 external REXX name 'RexxSetHalt'; 793 794Function RexxSetTrace( 795 Pid: Longint; // Process Id 796 Tid: Longint): Cardinal; cdecl; // Thread Id 797 external REXX name 'RexxSetTrace'; 798 799Function RexxResetTrace( 800 Pid: Longint; // Process Id 801 Tid: Longint): Cardinal; cdecl; // Thread Id 802 external REXX name 'RexxResetTrace'; 803 804Function RexxAddMacro( 805 FnName: PChar; // Function to add or change 806 FileName: PChar; // Name of file to get function 807 SrchPos: Cardinal): Cardinal; cdecl; // Flag indicating search pos 808 external REXXAPI name 'RexxAddMacro'; 809 810Function RexxDropMacro(FnName: PChar): Cardinal; cdecl; // Name of function to remove 811 external REXXAPI name 'RexxDropMacro'; 812 813Function RexxSaveMacroSpace( 814 ArgC: Cardinal; // Argument count (0==save all) 815 var NameLst: PChar; // List of funct names to save 816 FileName: PChar): Cardinal; cdecl; // File to save functions in 817 external REXXAPI name 'RexxSaveMacroSpace'; 818 819Function RexxLoadMacroSpace( 820 ArgC: Cardinal; // Argument count (0==load all) 821 var NameLst: PChar; // List of funct names to load 822 FileName: PChar): Cardinal; cdecl; // File to load functions from 823 external REXXAPI name 'RexxLoadMacroSpace'; 824 825Function RexxQueryMacro( 826 FnName: PChar; // Function to search for 827 var PtrPos: Word): Cardinal; cdecl; // Ptr for position flag return 828 external REXXAPI name 'RexxQueryLoadMacro'; 829 830Function RexxReorderMacro( 831 FnName: PChar; // Name of funct change order 832 NewPos: Cardinal): Cardinal; cdecl; // New position for function 833 external REXXAPI name 'RexxReorderMacro'; 834 835Function RexxClearMacroSpace: Cardinal; cdecl; // No Arguments. 836 external REXXAPI name 'RexxClearMacroSpace'; 837 838Function RxNullString(const r: RxString): Boolean; 839Begin 840 RxNullString:=r.strptr=nil; 841End; 842 843Function RxZeroLenString(const r: RxString): Boolean; 844Begin 845 RxZeroLenString:=((r.strptr<>nil) and (r.strlength=0)); 846End; 847 848Function RxValidString(const r: RxString): Boolean; 849Begin 850 RxValidString:=((r.strptr<>nil) and (r.strlength>0)); 851End; 852 853Function RxStrLen(const r: RxString): Longint; 854Begin 855 If RxNullString(r) then 856 RxStrLen:=0 857 else 858 RxStrLen:=r.strlength; 859End; 860 861Function RxStrPtr(Const r: RxString): PChar; 862Begin 863 RxStrPtr:=r.strptr; 864End; 865 866Procedure MakeRxString(Var r: RxString; p: PChar; l: Longint); 867Begin 868 r.strptr:=p; 869 r.strlength:=l; 870End; 871 872End. 873