home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / bt_2k033.zip / BINTOOL.CMD next >
OS/2 REXX Batch file  |  2000-02-02  |  78KB  |  2,800 lines
  1. /*
  2.  * Generator   : PPWIZARD version 2K.033
  3.  *             : FREE tool for OS/2, Windows, DOS and UNIX by Dennis Bareis (dbareis@labyrinth.net.au)
  4.  *             : http://www.labyrinth.net.au/~dbareis/ppwizard.htm
  5.  * Time        : Wednesday, 2 Feb 2000 7:18:22pm
  6.  * Input File  : E:\DB\PROJECTS\OS2\bintool\BINTOOL.x
  7.  * Output File : .\OUT\BINTOOL.CMD
  8.  */
  9.  
  10. if arg(1)="!CheckSyntax!" then exit(21924)
  11.  
  12. /*
  13. * $Header:   E:/DB/PVCS.IT/OS2/BINTOOL/BINTOOL.X_V   1.10   11 Jun 1998 19:04:46   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.4   07 Nov 1997 15:40:04   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.3   07 Nov 1997 15:18:38   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.2   07 Nov 1997 10:57:22   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.5   11 Oct 1996 16:40:40   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.4   11 Oct 1996 16:26:28   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.3   17 Sep 1996 10:51:38   Dennis_Bareis  $
  14. */
  15. PGM_VERSION     = '2K.033'
  16. OneBeep         = ''
  17. TwoBeep         = OneBeep || OneBeep
  18. Indent          = "        * "
  19. ExitRc          = 0
  20. Dying           = 'N'
  21. Tab             = d2c(9)
  22. ColonColon      = ';' || ';'
  23. LowerCase       = "abcdefghijklmnopqrstuvwxyz"
  24. UpperCase       = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  25. AllLetters      = LowerCase || UpperCase
  26. trace off
  27. /*
  28. * ADDCOMMA.XH Version 98.090 by Dennis Bareis
  29. *            http://www.labyrinth.net.au/~dbareis/index.htm (db0@anz.com)
  30. */
  31. signal EndOfADDCOMMACode
  32.  
  33. AddCommasToDecimalNumber: procedure
  34. NoComma = strip( arg(1) )
  35. if  pos(',', NoComma) <> 0 then
  36. return(NoComma)
  37. DotPos = pos('.', NoComma)
  38. if  DotPos = 0 then
  39. AfterDecimal = ''
  40. else
  41. do
  42. if  DotPos = 1 then
  43. return("0" || NoComma)
  44. AfterDecimal = substr(NoComma, DotPos+1)
  45. NoComma      = left(NoComma, DotPos-1)
  46. end
  47. NoComma = reverse(NoComma)
  48. ResultWithCommas = ""
  49. do  while length(NoComma) > 3
  50. ResultWithCommas = ResultWithCommas || left(NoComma, 3) || ','
  51. NoComma          = substr(NoComma, 4)
  52. end
  53. ResultWithCommas = ResultWithCommas || NoComma
  54. ResultWithCommas = reverse(ResultWithCommas)
  55. if  AfterDecimal <> '' then
  56. ResultWithCommas = ResultWithCommas || '.' || AfterDecimal
  57. return(ResultWithCommas)
  58.  
  59. EndOfADDCOMMACode:
  60. /*
  61. * REXXTRAP.XH Version 99.287 by Dennis Bareis
  62. *             http://www.labyrinth.net.au/~dbareis/index.htm (db0@anz.com)
  63. */
  64. signal on NOVALUE name _RexxTrapUninitializedVariable
  65. signal on SYNTAX  name _RexxTrapSyntaxError
  66. /*
  67. * DUMPVAR.XH Version 99.339 by Dennis Bareis
  68. *            http://www.labyrinth.net.au/~dbareis/index.htm (db0@anz.com)
  69. */
  70. /*
  71. * BIN2REXP.XH Version 99.134 by Dennis Bareis
  72. *            http://www.labyrinth.net.au/~dbareis/index.htm (db0@anz.com)
  73. */
  74. b2rNewSingleQuote = "' || " || '"' || "'" || '" || ' || "'"
  75. b2rAllHexCodes    = ''
  76. b2rAllAsciiCodes  = ''
  77. do b2rCharCode = 0 to 31
  78. b2rAllHexCodes = b2rAllHexCodes || d2c(b2rCharCode)
  79. end
  80. do b2rCharCode = 32 to 126
  81. b2rAllAsciiCodes = b2rAllAsciiCodes || d2c(b2rCharCode)
  82. end
  83. do b2rCharCode = 127 to 255
  84. b2rAllHexCodes = b2rAllHexCodes || d2c(b2rCharCode)
  85. end
  86. signal  EndBIN2REXPXh
  87.  
  88. _QuoteAscii:
  89. b2rAscii2Quote = arg(1)
  90. if  pos("'", b2rAscii2Quote) = 0 then
  91. return("'" || b2rAscii2Quote || "'")
  92. else
  93. do
  94. if  pos('"', b2rAscii2Quote) = 0 then
  95. return('"' || b2rAscii2Quote || '"')
  96. else
  97. do
  98. return("'" || ReplaceString(b2rAscii2Quote, "'", b2rNewSingleQuote) || "'")
  99. end
  100. end
  101.  
  102. _FormatHex:
  103. b2rHexString    = arg(1)
  104. b2rLengthHex    = length(b2rHexString)
  105. b2rFormattedHex = "'"
  106. if  b2rLengthHex > 7 then
  107. do
  108. b2rLeft1     = left(b2rHexString, 1)
  109. b2rLeft1Pos  = verify(b2rHexString, b2rLeft1)
  110. if  b2rLeft1Pos = 0 then
  111. return( "copies('" || c2x(b2rLeft1) || "'x, " || b2rLengthHex || ")" )
  112. else
  113. do
  114. if  b2rLeft1Pos > 7 then
  115. do
  116. b2rFormattedHex = "copies('" || c2x(b2rLeft1) || "'x, " || b2rLeft1Pos-1 || ") || '"
  117. b2rHexString    = substr(b2rHexString, b2rLeft1Pos)
  118. b2rLengthHex    = b2rLengthHex - (b2rLeft1Pos-1)
  119. end
  120. end
  121. end
  122. do  b2rCharPosn = 1 to b2rLengthHex
  123. if  (b2rCharPosn // 8) = 1 then
  124. do
  125. if  b2rCharPosn <> 1 then
  126. b2rFormattedHex = b2rFormattedHex || ' '
  127. end
  128. b2rFormattedHex = b2rFormattedHex || c2x(substr(b2rHexString, b2rCharPosn, 1))
  129. end
  130. b2rFormattedHex = b2rFormattedHex || "'x"
  131. return(b2rFormattedHex)
  132.  
  133. _QuoteAsciiBreakIfRequired:
  134. qabAscii  = arg(1)
  135. qabLength = length(qabAscii)
  136. qabReturn = ''
  137. do  while qabLength > 256
  138. qabLeft   = left(qabAscii, 256)
  139. qabAscii  = substr(qabAscii, 256+1)
  140. qabLength = qabLength - 256
  141. if  qabReturn = '' then
  142. qabReturn = _QuoteAscii(qabLeft)
  143. else
  144. qabReturn = qabReturn || " || " || _QuoteAscii(qabLeft)
  145. end
  146. if  qabLength = 0 then
  147. return(qabReturn)
  148. else
  149. do
  150. if  qabReturn = '' then
  151. return( _QuoteAscii(qabAscii) )
  152. else
  153. return( qabReturn || " || " || _QuoteAscii(qabAscii) )
  154. end
  155.  
  156. _FormatHexBreakIfRequired:
  157. fhbHex    = arg(1)
  158. fhbLength = length(fhbHex)
  159. fhbReturn = ''
  160. do  while fhbLength > 80
  161. fhbLeft   = left(fhbHex, 80)
  162. fhbHex    = substr(fhbHex, 80+1)
  163. fhbLength = fhbLength - 80
  164. if  fhbReturn = '' then
  165. fhbReturn = _FormatHex(fhbLeft)
  166. else
  167. fhbReturn = fhbReturn || " || " || _FormatHex(fhbLeft)
  168. end
  169. if  fhbLength = 0 then
  170. return(fhbReturn)
  171. else
  172. do
  173. if  fhbReturn = '' then
  174. return( _FormatHex(fhbHex) )
  175. else
  176. return( fhbReturn || " || " || _FormatHex(fhbHex) )
  177. end
  178.  
  179. BIN2REXP:
  180. call BIN2REXP_START
  181. b2rValue       = arg(1)
  182. b2rValueLength = length(b2rValue)
  183. if  b2rValueLength = 0 then
  184. call BIN2REXP_ONEBIT  '""'
  185. else
  186. do
  187. do  while b2rValue \== ''
  188. b2rEndAsciiPos = verify(b2rValue, b2rAllAsciiCodes)
  189. if  b2rEndAsciiPos = 0 then
  190. do
  191. call BIN2REXP_ONEBIT _QuoteAsciiBreakIfRequired(b2rValue)
  192. b2rValue = ''
  193. end
  194. else
  195. do
  196. if  b2rEndAsciiPos <> 1 then
  197. do
  198. call BIN2REXP_ONEBIT _QuoteAsciiBreakIfRequired(left(b2rValue, b2rEndAsciiPos-1))
  199. b2rValue = substr(b2rValue, b2rEndAsciiPos)
  200. end
  201. else
  202. do
  203. b2rEndBinaryPos = verify(b2rValue, b2rAllHexCodes)
  204. if  b2rEndBinaryPos = 0 then
  205. do
  206. call BIN2REXP_ONEBIT _FormatHexBreakIfRequired(b2rValue)
  207. b2rValue = ''
  208. end
  209. else
  210. do
  211. call BIN2REXP_ONEBIT _FormatHexBreakIfRequired(left(b2rValue, b2rEndBinaryPos-1))
  212. b2rValue = substr(b2rValue, b2rEndBinaryPos)
  213. end
  214. end
  215. end
  216. end
  217. end
  218. call BIN2REXP_END
  219. return
  220.  
  221. EndBIN2REXPXh:
  222. signal  EndDUMPVARXh
  223.  
  224. DumpVarsInExpression:
  225. dv_RexxExp     = arg(1)
  226. dv_Stem        = translate(arg(2))
  227. dv_VarHeading  = arg(3)
  228. dv_LineRoutine = arg(4)
  229. if  dv_Stem <> '' then
  230. do
  231. dv_AutoDump = 'N'
  232. dv_StemDot  = dv_Stem || '.'
  233. if  symbol(dv_StemDot || '0') = 'VAR' then
  234. dv_VarCount = value(dv_StemDot || '0')
  235. else
  236. do
  237. call _DumpVarsLineOutput 'DumpVar: Could not find "' || dv_StemDot || '0' || '"'
  238. return(0)
  239. end
  240. end
  241. else
  242. do
  243. dv_AutoDump = 'Y'
  244. dv_Stem     = 'DV_VARLIST'
  245. dv_StemDot  = dv_Stem || '.'
  246. dv_VarCount = 0
  247. end
  248. if  dv_VarCount = 0 then
  249. dv_MaxVarLng = 0
  250. do  while dv_RexxExp <> ''
  251. parse value strip(dv_RexxExp, 'L') with dv_1stChar +1 dv_RexxExp
  252. select
  253. when    datatype(dv_1stChar, 'S') then
  254. do
  255. dv_OneVar = dv_1stChar
  256. do  while dv_RexxExp <> ''
  257. parse var dv_RexxExp dv_1stChar +1 dv_RexxExp
  258. if  datatype(dv_1stChar, 'S') then
  259. dv_OneVar = dv_OneVar || dv_1stChar
  260. else
  261. do
  262. dv_RexxExp = dv_1stChar || dv_RexxExp
  263. leave
  264. end
  265. end
  266. call _RememberDumpedVar dv_OneVar
  267. if  pos('.', dv_OneVar) <> 0 then
  268. do
  269. do  while dv_OneVar <> ''
  270. parse var dv_OneVar dv_ThisBit '.' dv_OneVar
  271. call _RememberDumpedVar dv_ThisBit
  272. end
  273. end
  274. end
  275. when    dv_1stChar = '"' | dv_1stChar = "'" then
  276. do
  277. dv_EndQuotePos = pos(dv_1stChar, dv_RexxExp)
  278. if  dv_EndQuotePos = 0 then
  279. dv_RexxExp = ''
  280. else
  281. dv_RexxExp = substr(dv_RexxExp, dv_EndQuotePos+1)
  282. end
  283. otherwise
  284. nop
  285. end
  286. end
  287. call value dv_StemDot || '0', dv_VarCount
  288. if  dv_AutoDump = 'Y' then
  289. call DumpVarsInExpressionNow dv_Stem, dv_VarHeading, dv_LineRoutine
  290. return(dv_VarCount)
  291.  
  292. DumpVarsInExpressionNow:
  293. dv_StemDot     = arg(1) || '.'
  294. dv_VarHeading  = arg(2)
  295. dv_LineRoutine = arg(3)
  296. if  symbol(dv_StemDot || '0') = 'VAR' then
  297. dv_VarCount    = value(dv_StemDot || '0')
  298. else
  299. do
  300. call _DumpVarsLineOutput 'DumpVar: could not find "' || dv_StemDot || '0' || '"'
  301. return(0)
  302. end
  303. if  dv_VarCount <> 0 & dv_VarHeading <> '' then
  304. do
  305. call _DumpVarsLineOutput ''
  306. call _DumpVarsLineOutput dv_VarHeading
  307. call _DumpVarsLineOutput copies('~', length(dv_VarHeading))
  308. end
  309. dv_ShowVarLng = dv_MaxVarLng
  310. if  dv_MaxVarLng > 30 then
  311. dv_ShowVarLng = 30
  312. do  dv_Index = 1 to dv_VarCount
  313. dv_OneVar = value(dv_StemDot || dv_Index)
  314. if  length(dv_OneVar) >= dv_ShowVarLng then
  315. ShowVar = dv_OneVar
  316. else
  317. ShowVar = right(dv_OneVar, dv_ShowVarLng)
  318. dv_OneVarValue = value(translate(dv_OneVar))
  319. if  datatype(dv_OneVarValue, 'N') = 0 then
  320. do
  321. call BIN2REXP dv_OneVarValue
  322. dv_OneVarValue = dv_Value
  323. end
  324. call _DumpVarsLineOutput ShowVar || ' = ' || dv_OneVarValue
  325. end
  326. return
  327.  
  328. _RememberDumpedVar:
  329. dv_ThisVar = arg(1)
  330. if  symbol(dv_ThisVar) = 'VAR' then
  331. do
  332. dv_AlreadyHave  = 'N'
  333. dv_ThisVarUpper = translate(dv_ThisVar)
  334. do  dv_Index = 1 to dv_VarCount
  335. if  dv_ThisVarUpper = translate(value(dv_StemDot || dv_Index)) then
  336. do
  337. dv_AlreadyHave = 'Y'
  338. leave
  339. end
  340. end
  341. if  dv_AlreadyHave = 'N' then
  342. do
  343. dv_VarCount = dv_VarCount + 1
  344. call value dv_StemDot || dv_VarCount, dv_ThisVar
  345. if  length(dv_ThisVar) > dv_MaxVarLng then
  346. dv_MaxVarLng = length(dv_ThisVar)
  347. end
  348. end
  349. return
  350.  
  351. _DumpVarsLineOutput:
  352. if  dv_LineRoutine = '' then
  353. say arg(1)
  354. else
  355. interpret 'call ' || dv_LineRoutine || ' arg(1)'
  356. return
  357.  
  358. BIN2REXP_START:
  359. dv_Value = ''
  360. return
  361.  
  362. BIN2REXP_ONEBIT:
  363. if  dv_Value <> '' then
  364. dv_Value = dv_Value || ' || '
  365. dv_Value = dv_Value || arg(1)
  366. return
  367.  
  368. BIN2REXP_END:
  369. return
  370.  
  371. EndDUMPVARXh:
  372. signal RexxTrap_1
  373.  
  374. _FindLastLabel:
  375. FailedOnLine = arg(1)
  376. TryLine = FailedOnLine
  377. do  while TryLine > 1
  378. TryLine = TryLine - 1
  379. TheLine  = sourceline(TryLine)
  380. ColonPos = pos(':', TheLine)
  381. if  ColonPos <> 0 then
  382. do
  383. MaybeLabel = strip(left(TheLine, ColonPos-1))
  384. if  symbol(MaybeLabel) <> 'BAD' then
  385. do
  386. FoundLabelOnLine = TryLine
  387. return(MaybeLabel || ':  (line #' || AddCommasToDecimalNumber(TryLine) || ')')
  388. end
  389. end
  390. end
  391. FoundLabelOnLine = 0
  392. return('')
  393.  
  394. TrapHeadingColonData:
  395. if  arg(1) = '' then
  396. TrapMiddle = '  '
  397. else
  398. TrapMiddle = ': '
  399. call ToStderr left(arg(1), 16) || TrapMiddle || arg(2), '$S'
  400. return
  401.  
  402. _CommonTrapHandler:
  403. FailingLine     = arg(1)
  404. TrapHeading     = 'BUG: ' || arg(2)
  405. TextDescription = arg(3)
  406. Text            = arg(4)
  407. FailingLineText = AddCommasToDecimalNumber(FailingLine)
  408. call ToStderr copies('=+', 39), '$+'
  409. parse source . . SourceFileName
  410. call ToStderr TrapHeading, '$S'
  411. call ToStderr copies('~', length(TrapHeading)), '$S'
  412. call TrapHeadingColonData TextDescription, Text
  413. BettaOnRegina = condition('D')
  414. if  BettaOnRegina <> '' & BettaOnRegina <> Text then
  415. call TrapHeadingColonData '', BettaOnRegina
  416. parse version TheRexVer
  417. parse source  TheOpSys .
  418. call TrapHeadingColonData "Environment", TheOpSys || ' using ' || TheRexVer
  419. if pos('REGINA', translate(TheRexVer)) <> 0 then
  420. do
  421. call TrapHeadingColonData '', uname()
  422. end
  423. call TrapHeadingColonData "Failing Module", SourceFileName
  424. call TrapHeadingColonData "Failing Line #", FailingLineText
  425. InRoutine = _FindLastLabel(FailingLine)
  426. StartAt   = (FailingLine - 5) + 1
  427. if  FoundLabelOnLine <> 0 then
  428. do
  429. if  FoundLabelOnLine > StartAt then
  430. StartAt = FoundLabelOnLine
  431. else
  432. do
  433. if  FoundLabelOnLine <> 0 then
  434. do
  435. if  (FailingLine-FoundLabelOnLine) < 10 then
  436. StartAt = FoundLabelOnLine
  437. else
  438. call TrapHeadingColonData "After label", InRoutine
  439. end
  440. end
  441. end
  442. if  StartAt < 1 then
  443. StartAt = 1
  444. call ToStderr '',       '$SH'
  445. call ToStderr 'SOURCE', '$SH'
  446. call ToStderr '~~~~~~', '$SH'
  447. vlist.0 = 0
  448. do  ShowLine = StartAt to FailingLine
  449. FailingSrcLineTxt = strip(SourceLine(ShowLine))
  450. call ToStderr left(AddCommasToDecimalNumber(ShowLine), length(FailingLineText)) || ' : ' || FailingSrcLineTxt, '$SC'
  451. call DumpVarsInExpression FailingSrcLineTxt, 'vlist'
  452. end
  453. call DumpVarsInExpressionNow 'vlist', 'VARIABLE LIST', 'ToStderr'
  454. call ToStderr copies('=+', 39), '$+'
  455. call PgmExit FailingLine
  456.  
  457. _RexxTrapSyntaxError:
  458. ReginaBug = SIGL
  459. call _CommonTrapHandler ReginaBug, 'SYNTAX ERROR!', 'Reason', errortext(Rc)
  460.  
  461. _RexxTrapUninitializedVariable:
  462. ReginaBug = SIGL
  463. call _CommonTrapHandler ReginaBug, 'UNKNOWN VARIABLE!', 'Unknown Variable', condition('D')
  464.  
  465. RexxTrap_1:
  466. signal on HALT    name RexxCtrlC
  467. if translate(strip(arg(1))) = 'DEBUG' then
  468. call DisplayCopyright
  469. /*
  470. * REXSYSTM.XH Version 00.019 By Dennis Bareis
  471. *            http://www.labyrinth.net.au/~dbareis/index.htm (db0@anz.com)
  472. */
  473. parse version RexVersionInfo
  474. if pos('REGINA', translate(RexVersionInfo)) <> 0 then
  475. do
  476. RexWhich = 'REGINA'
  477. parse value translate(RexVersionInfo) with . 'REGINA_' RexVerRegina ' '
  478. RexVerRegina = translate(RexVerRegina, '.', '_')
  479. end
  480. else
  481. do
  482. RexVerRegina = ''
  483. RexWhich = 'STANDARD_OS/2'
  484. end
  485. parse source RexSystemOpSys .
  486. if RexSystemOpSys = "WIN32" then
  487. do
  488. parse value uname() with RexSystemOpSys .
  489. if  RexSystemOpSys <> "WIN95" & RexSystemOpSys <> "WIN98" & RexSystemOpSys <> "WINNT" then
  490. do
  491. call CommandFailure 'Regina uname() returned "' || uname() || '" (expected WIN95, WIN98 or WINNT)'
  492. end
  493. end
  494. RexSystmRexxPgmName = '?'; RexSystmRexxPgmName = RexGetFullSourceName()
  495. if  arg(2) <> '' then
  496. call CommandFailure 'ARG(2) contains unexpected data of ' || arg(2) || '.'
  497. if translate(strip(arg(1))) = 'DEBUG' then
  498. do
  499. call RexDumpSystemInfo
  500. exit(0)
  501. end
  502. if RexWhich = 'STANDARD_OS/2' then
  503. do
  504. call RxFuncAdd  'SysSleep',        'RexxUtil', 'SysSleep'
  505. call RxFuncAdd  'SysFileDelete',   'RexxUtil', 'SysFileDelete'
  506. call RxFuncAdd  'SysSearchPath',   'RexxUtil', 'SysSearchPath'
  507. call RxFuncAdd  'SysFileTree',     'RexxUtil', 'SysFileTree'
  508. call RxFuncAdd  'SysTempFileName', 'RexxUtil', 'SysTempFileName'
  509. call SetLocal
  510. RexEnvVarPool = 'OS2ENVIRONMENT'
  511. RexStdoutStream = 'STDOUT'
  512. RexStderrStream = 'STDERR'
  513. RexTmpFileCntr = random(90000)
  514. end
  515. else
  516. do
  517. OPTIONS 'NOEXT_COMMANDS_AS_FUNCS'
  518. numeric digits 11
  519. RexEnvVarPool = 'SYSTEM'
  520. RexStdoutStream = '<stdout>'
  521. RexStderrStream = '<stderr>'
  522. end
  523. if RexSystemOpSys <> "UNIX" then
  524. do
  525. RexDirChar    = '\'
  526. RexOptionChar = '/'
  527. end
  528. else
  529. do
  530. RexDirChar    = '/'
  531. RexOptionChar = '-'
  532. end
  533. signal REXSYSTM_2
  534.  
  535. RexDumpSystemInfo: 
  536. say 'Program Name  : ' || RexSystmRexxPgmName
  537. say 'Op System     : ' || RexSystemOpSys
  538. say 'Rexx Ver      : ' || RexVersionInfo
  539. say 'Which System  : ' || RexWhich
  540. if RexWhich = 'REGINA' then
  541. say 'regina uname(): ' || uname()
  542. return
  543.  
  544. RexNeedReginaWorkAround:
  545. if  RexWhich = 'STANDARD_OS/2' then
  546. return('N')
  547. else
  548. return('Y')
  549.  
  550. RexGetFullSourceName: 
  551. parse source . . TmpRexxSrc
  552. if RexWhich = 'REGINA' then
  553. TmpRexxSrc = stream(strip(TmpRexxSrc), 'c', 'query exists')
  554. if   TmpRexxSrc = '' then
  555. call CommandFailure 'Could not determine the name of the rexx program!'
  556. return(TmpRexxSrc)
  557.  
  558. RexQueryExists: 
  559. if  arg(1) = '' then
  560. return('')
  561. else
  562. return( stream(arg(1), 'c', 'query exists') )
  563.  
  564. RexGetNameOfTmpDir: 
  565. TmpDir = strip(GetEnv('TMP'))
  566. if  TmpDir = '' then
  567. TmpDir = strip(GetEnv('TEMP'))
  568. if  TmpDir = '' then
  569. do
  570. if RexSystemOpSys = "UNIX" then
  571. TmpDir = '/tmp'
  572. end
  573. if  right(TmpDir, 1) == RexDirChar then
  574. TmpDir = left(TmpDir, length(TmpDir)-1)
  575. return(TmpDir)
  576.  
  577. RedirectStdOutAndErr2:
  578. if  RexSystemOpSys = "DOS" | RexSystemOpSys = "WIN95" | RexSystemOpSys = "WIN98" then
  579. do
  580. return(' >' || arg(1))
  581. end
  582. else
  583. do
  584. return(' >' || arg(1) || ' 2>&1')
  585. end
  586.  
  587. NameOfNulDevice:
  588. if  RexSystemOpSys = "UNIX" then
  589. return('/dev/null')
  590. else
  591. return('nul')
  592.  
  593. AllCmdOutput2Nul:
  594. return( RedirectStdOutAndErr2(NameOfNulDevice()) )
  595.  
  596. AddressCmd: 
  597. SysCmd2Exec = arg(1)
  598. if  RexWhich = 'STANDARD_OS/2' then
  599. SysCmd2Exec = '@' || SysCmd2Exec
  600. SysCmd2Exec
  601. SysCmdRc = Rc
  602. Rc = SysCmdRc
  603. return(SysCmdRc)
  604.  
  605. StderrLine: 
  606. return( lineout(RexStderrStream, arg(1)) )
  607.  
  608. _filespec: 
  609. fsCmd = translate( arg(1) )
  610. select
  611. when fsCmd = 'D' | fsCmd = 'DRIVE' then
  612. do
  613. if RexSystemOpSys = "UNIX" then
  614. return('')
  615. fsPos = pos(':', arg(2))
  616. if  fsPos = 0 then
  617. return('')
  618. else
  619. return( left(arg(2), fsPos) )
  620. end
  621. when fsCmd = 'P' | fsCmd = 'PATH' then
  622. do
  623. fsStartWith = substr(arg(2), length(_filespec('D', arg(2)))+1)
  624. fsPos = lastpos(RexDirChar, fsStartWith)
  625. if  fsPos = 0 then
  626. return('')
  627. else
  628. return(left(fsStartWith, fsPos))
  629. end
  630. when fsCmd = 'N' | fsCmd = 'NAME' then
  631. do
  632. return( substr(arg(2), length(_filespec('L', arg(2)))+1) )
  633. end
  634. when fsCmd = 'L' | fsCmd = 'LOCATION' then
  635. do
  636. return( _filespec('D', arg(2)) || _filespec('P', arg(2)) )
  637. end
  638. when fsCmd = 'E' | fsCmd = 'EXTN' then
  639. do
  640. fsDotPos = lastpos('.', arg(2))
  641. if fsDotPos = 0 then
  642. return('')
  643. else
  644. return(substr(arg(2), fsDotPos+1))
  645. end
  646. when fsCmd = 'W' | fsCmd = 'WITHOUTEXTN' then
  647. do
  648. fsDotPos = lastpos('.', arg(2))
  649. if fsDotPos = 0 then
  650. return(arg(2))
  651. else
  652. return(left(arg(2), fsDotPos-1))
  653. end
  654. otherwise
  655. call CommandFailure 'Unknown _filespec() command of "' || arg(1) || '"'
  656. end
  657. return
  658.  
  659. _SysFileDelete: 
  660. if  RexWhich = 'STANDARD_OS/2' then
  661. return( SysFileDelete(arg(1)) )
  662. if RexSystemOpSys = "DOS" | RexSystemOpSys = "WIN95" | RexSystemOpSys = "WIN98" then
  663. return( AddressCmd('if exist ' || arg(1) || ' del ' || arg(1) || AllCmdOutput2Nul()) )
  664. else
  665. do
  666. if  RexSystemOpSys = "UNIX" then
  667. return( AddressCmd('rm -f '  || arg(1) || AllCmdOutput2Nul()) )
  668. else
  669. return( AddressCmd('del '    || arg(1) || AllCmdOutput2Nul()) )
  670. end
  671.  
  672. GetEnv: 
  673. rsGetEnv = value(arg(1),, RexEnvVarPool)
  674. if  rsGetEnv == '' & arg(2) = 'Y' then
  675. call CommandFailure 'Could not find the environment variable "' || arg(1) || '"'
  676. return(rsGetEnv)
  677.  
  678. REXSYSTM_2:
  679. ThisProgramName = RexSystmRexxPgmName
  680. ThisProgramDir  = _filespec('drive', ThisProgramName) || _filespec('path', ThisProgramName)
  681. if RexSystemOpSys = "OS/2" then
  682. call SetColorCodes
  683. else
  684. call RemoveColorCodes
  685. /*
  686. * REPLSTR.XH Version 99.134 By Dennis Bareis
  687. *            http://www.labyrinth.net.au/~dbareis/index.htm (db0@anz.com)
  688. */
  689. ReplaceCount = 0
  690. signal EndREPLSTR
  691.  
  692. ReplaceString: 
  693. parse arg rs?TheString, rs?ChangeFrom
  694. rs?FoundPosn = pos(rs?ChangeFrom, rs?TheString)
  695. if  rs?FoundPosn = 0 then
  696. return(rs?TheString)
  697. rs?ChangeTo = arg(3)
  698. rs?ChangeFromLength = length(rs?ChangeFrom)
  699. rs?LeftPart         = ''
  700. do  until rs?FoundPosn = 0
  701. rs?LeftPart      = rs?LeftPart || left(rs?TheString, rs?FoundPosn-1) || rs?ChangeTo
  702. rs?TheString     = substr(rs?TheString, rs?FoundPosn+rs?ChangeFromLength)
  703. ReplaceCount = ReplaceCount + 1
  704. rs?FoundPosn = pos(rs?ChangeFrom, rs?TheString)
  705. end
  706. return(rs?LeftPart || rs?TheString)
  707.  
  708. EndREPLSTR:
  709. /*
  710. * $Header:   E:/DB/PVCS.IT/OS2/BINTOOL/OPENCLOS.XHV   1.2   11 Jun 1998 18:48:10   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.4   07 Nov 1997 15:40:04   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.3   07 Nov 1997 15:18:38   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.2   07 Nov 1997 10:57:22   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.5   11 Oct 1996 16:40:40   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.4   11 Oct 1996 16:26:28   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.3   17 Sep 1996 10:51:38   Dennis_Bareis  $
  711. */
  712. signal EndOpenClosXh
  713.  
  714. ProcessCmdOpenFile:
  715. OpenMode      = arg(1)
  716. NameOfNewFile = RemoveAnyQuotesAroundFilename(arg(2))
  717. CloseRc       = stream(NameOfNewFile, 'c', 'close')
  718. call ProcessCmdCloseFile
  719. if  OpenMode = "OPENNEW" then
  720. do
  721. if  CommandNeedsFileDeleted(NameOfNewFile) <> 0 then
  722. return
  723. end
  724. if  OpenMode = "OPENREAD" then
  725. OpenMode = 'open read'
  726. else
  727. OpenMode = 'open'
  728. CurrentFile = NameOfNewFile
  729. OpenRc      = stream(CurrentFile, 'c', OpenMode)
  730. if  left(OpenRc, 6) = 'READY:' then
  731. do
  732. FileLength = stream(CurrentFile, 'c', 'seek <0')
  733. SeekRc     = stream(CurrentFile, 'c', 'seek =1')
  734. call UpdateDumpAddress 0
  735. if  FileLength = '' then
  736. call ProgressMsg 'File Opened'
  737. else
  738. call ProgressMsg 'File Opened, ' || AddCommasToDecimalNumber(FileLength-1) || ' byte(s) in file.'
  739. end
  740. else
  741. do
  742. CloseRc     = stream(CurrentFile, 'c', 'close')
  743. FailFile    = CurrentFile
  744. CurrentFile = ''
  745. call CommandFailure 'Open of "' || FailFile || '" failed (' || OpenRc || ')'
  746. end
  747. return
  748.  
  749. ProcessCmdCloseFile:
  750. if  CurrentFile <> '' then
  751. do
  752. if  Dying = 'N' then
  753. call IoError CurrentFile
  754. CloseRc     = stream(CurrentFile, 'c', 'close')
  755. CurrentFile = ''
  756. end
  757. return
  758.  
  759. EndOpenClosXh:
  760. /*
  761. * $Header:   E:/DB/PVCS.IT/OS2/BINTOOL/WRITE.XHV   1.2   02 Jun 1998 19:05:04   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.4   07 Nov 1997 15:40:04   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.3   07 Nov 1997 15:18:38   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.2   07 Nov 1997 10:57:22   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.5   11 Oct 1996 16:40:40   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.4   11 Oct 1996 16:26:28   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.3   17 Sep 1996 10:51:38   Dennis_Bareis  $
  762. */
  763. signal EndWriteXh
  764.  
  765. WriteToFile:
  766. if  ExpectToHaveCurrentFile() = '!' then
  767. return
  768. ToWrite = InterpretCommand(arg(1))
  769. if  ToWrite = "!@#$DB$FAILED%$#" then
  770. return
  771. call charout CurrentFile, ToWrite
  772. call UpdateDumpAddress
  773. call IoError CurrentFile
  774. return
  775.  
  776. InterpretCommand:
  777. ExecuteTheCommand = 'NewValue = ' || arg(1)
  778. signal ON SYNTAX   name InvalidRexxCommand
  779. signal ON NOVALUE  name InvalidRexxCommand
  780. interpret ExecuteTheCommand
  781. return(NewValue)
  782.  
  783. InterpretExactCommand:
  784. signal ON SYNTAX   name InvalidRexxCommand
  785. signal ON NOVALUE  name InvalidRexxCommand
  786. interpret arg(1)
  787. return("OK")
  788.  
  789. InvalidRexxCommand:
  790. if  condition('C') = 'NOVALUE' then
  791. call CommandFailure 'Incorrectly quoted string? (variable ' || condition('D') || ' is unknown)!'
  792. else
  793. call CommandFailure 'REXX Syntax error (' || errortext(Rc) || ')!'
  794. if  Interactive = 'Y' then
  795. return("!@#$DB$FAILED%$#")
  796. else
  797. PgmExit(ThisLineNumber())
  798.  
  799. EndWriteXh:
  800. /*
  801. * $Header:   E:/DB/PVCS.IT/OS2/BINTOOL/VERIFY.XHV   1.1   02 Jun 1998 19:05:04   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.4   07 Nov 1997 15:40:04   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.3   07 Nov 1997 15:18:38   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.2   07 Nov 1997 10:57:22   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.5   11 Oct 1996 16:40:40   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.4   11 Oct 1996 16:26:28   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.3   17 Sep 1996 10:51:38   Dennis_Bareis  $
  802. */
  803. signal EndVerifyXh
  804.  
  805. VerifyBytesInFile:
  806. if  ExpectToHaveCurrentFile() = '!' then
  807. return
  808. dStartAddress = GetCurrentSeekPositionInFile()
  809. if  dStartAddress = '!' then
  810. return
  811. ToVerify = InterpretCommand(arg(1))
  812. if  ToVerify = "!@#$DB$FAILED%$#" then
  813. return
  814. FromFile = charin(CurrentFile,, length(ToVerify))
  815. Dummy = GotoSpecificSeekPositionInFile(dStartAddress)
  816. CompareRc = compare(ToVerify, FromFile)
  817. if  CompareRc <> 0 then
  818. do
  819. call DumpValue  dStartAddress-1, FromFile
  820. call CommandFailure 'Verification Failed (difference starts at byte ' || CompareRc || ')'
  821. end
  822. call IoError CurrentFile
  823. return
  824.  
  825. EndVerifyXh:
  826. /*
  827. * $Header:   E:/DB/PVCS.IT/OS2/BINTOOL/VERIFYF.XHV   1.1   11 Jun 1998 18:48:16   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.4   07 Nov 1997 15:40:04   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.3   07 Nov 1997 15:18:38   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.2   07 Nov 1997 10:57:22   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.5   11 Oct 1996 16:40:40   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.4   11 Oct 1996 16:26:28   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.3   17 Sep 1996 10:51:38   Dennis_Bareis  $
  828. */
  829. signal EndVerifyfXh
  830.  
  831. VerifyFileContents:
  832. if  MustNotHaveFileOpen() = '!' then
  833. return
  834. parse value arg(1) with '"'WhichFile'"' FileSize FileCrcInHex .
  835. if  WhichFile = '' then
  836. do
  837. call CommandFailure 'Could not determine file name (it must be in double quotes)!'
  838. return
  839. end
  840. if  stream(WhichFile, 'c', 'query exists') = '' then
  841. do
  842. call CommandFailure 'The file "' || WhichFile || '" does not exist!'
  843. return
  844. end
  845. call ProgressMsg 'File exists'
  846. if  FileSize = '' then
  847. return
  848. CloseRc    = stream(WhichFile, 'c', 'close')
  849. RealLength = stream(WhichFile, 'c', 'query size')
  850. call ProgressMsg 'File is ' || AddCommasToDecimalNumber(RealLength) || ' byte(s) long'
  851. if  RealLength <> FileSize then
  852. do
  853. call CommandFailure 'The file "' || WhichFile || '" is ' || AddCommasToDecimalNumber(RealLength) || ' bytes long.  We expected ' || AddCommasToDecimalNumber(FileSize) || ' bytes!'
  854. return
  855. end
  856. if  FileCrcInHex = '' then
  857. return
  858. FileCrcInHex = translate(FileCrcInHex)
  859. if  length(FileCrcInHex) <> 8 then
  860. do
  861. call CommandFailure 'Expected a full 8 character hexadecimal CRC (got "' || FileCrcInHex || '")'
  862. return
  863. end
  864. BytesToRead = FileSize
  865. Crc32       = Crc32PrePostConditioning()
  866. do  while BytesToRead > 0
  867. FromFile    = charin(WhichFile,, 4096)
  868. BytesToRead = BytesToRead - 4096
  869. Crc32 = UpdateCrc32(Crc32, FromFile)
  870. end
  871. Crc32 = Crc32PrePostConditioning(Crc32)
  872. Crc32 = Crc32InDisplayableForm(Crc32)
  873. call ProgressMsg 'Calculated a CRC of ' || Crc32
  874. IoRc    = IoError(WhichFile)
  875. CloseRc = stream(WhichFile, 'c', 'close')
  876. if  IoRc = 'Y' then
  877. return
  878. if  Crc32 <> FileCrcInHex then
  879. do
  880. call CommandFailure 'CRC of "' || Crc32 || '" does not match! We expected "' || FileCrcInHex || '"'
  881. return
  882. end
  883. return
  884.  
  885. EndVerifyfXh:
  886. /*
  887. * $Header:   E:/DB/PVCS.IT/OS2/BINTOOL/MOVETO.XHV   1.2   02 Jun 1998 19:05:02   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.4   07 Nov 1997 15:40:04   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.3   07 Nov 1997 15:18:38   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.2   07 Nov 1997 10:57:22   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.5   11 Oct 1996 16:40:40   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.4   11 Oct 1996 16:26:28   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.3   17 Sep 1996 10:51:38   Dennis_Bareis  $
  888. */
  889. signal EndMoveToXh
  890.  
  891. ProcessCmdMoveTo:
  892. if  ExpectToHaveCurrentFile() = '!' then
  893. return
  894. parse value arg(1) with SeekCmd SeekParms
  895. SeekCmd = translate(SeekCmd)
  896. BeforeMoveTo = GetCurrentSeekPositionInFile()
  897. if  BeforeMoveTo = '!' then
  898. return
  899. select
  900. when SeekCmd = 'START' then
  901. SeekParms = '=1'
  902. when SeekCmd = 'END' then
  903. SeekParms = '<0'
  904. when SeekCmd = '+' | SeekCmd = 'FORWARDS' then
  905. do
  906. if  SeekParms = '' then
  907. SeekParms = '1'
  908. MoveToValue = GetInteger(SeekParms)
  909. if  MoveToValue = '!' then
  910. do
  911. call CommandFailure 'Invalid value of "' || SeekParms || '" specified.'
  912. return
  913. end
  914. SeekParms = '=' || BeforeMoveTo + MoveToValue
  915. end
  916. when SeekCmd = '-' | SeekCmd = 'BACKWARDS' then
  917. do
  918. if  SeekParms = '' then
  919. SeekParms = '1'
  920. MoveToValue = GetInteger(SeekParms)
  921. if  MoveToValue = '!' then
  922. do
  923. call CommandFailure 'Invalid value of "' || SeekParms || '" specified.'
  924. return
  925. end
  926. NewLocation = BeforeMoveTo - MoveToValue
  927. if  NewLocation < 1 then
  928. do
  929. call CommandFailure "You can't move back " || SeekParms || ' from ' || GetDisplayableCurrentOffset() || '!'
  930. return
  931. end
  932. SeekParms = '=' || NewLocation
  933. end
  934. otherwise
  935. do
  936. if  SeekCmd = '' then
  937. do
  938. call CommandFailure 'Invalid MoveTo command of "' || SeekCmd || '" specified.'
  939. return
  940. end
  941. MoveToValue = GetInteger(SeekCmd)
  942. if  MoveToValue = '!' then
  943. do
  944. call CommandFailure 'Invalid value of "' || SeekCmd || '" specified.'
  945. return
  946. end
  947. MoveToValue = MoveToValue + 1
  948. SeekParms = '=' || MoveToValue
  949. end
  950. end
  951. CloseRc = stream(CurrentFile, 'c', 'close')
  952. OpenRc = stream(CurrentFile, 'c', OpenMode)
  953. if  left(OpenRc, 6) <> 'READY:' then
  954. do
  955. CurrentFile = ''
  956. call CommandFailure "Can't reopen file!"
  957. return
  958. end
  959. SeekRc = stream(CurrentFile, 'c', 'seek ' || SeekParms)
  960. if  datatype(SeekRc, 'Whole Number') = 0 then
  961. do
  962. if  SeekRc <> '' then
  963. SeekRc = ' (Reason=' || SeekRc || ')'
  964. call CommandFailure 'Seek failed' || SeekRc
  965. return
  966. end
  967. call IoError CurrentFile
  968. call UpdateDumpAddress
  969. return
  970.  
  971. EndMoveToXh:
  972. /*
  973. * $Header:   E:/DB/PVCS.IT/OS2/BINTOOL/REBUILD.XHV   1.2   02 Jun 1998 19:05:02   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.4   07 Nov 1997 15:40:04   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.3   07 Nov 1997 15:18:38   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.2   07 Nov 1997 10:57:22   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.5   11 Oct 1996 16:40:40   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.4   11 Oct 1996 16:26:28   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.3   17 Sep 1996 10:51:38   Dennis_Bareis  $
  974. */
  975. signal EndRebuildXh
  976.  
  977. BIN2REXP_START:
  978. return
  979.  
  980. BIN2REXP_ONEBIT:
  981. if  pos(ColonColon, arg(1)) = 0 then
  982. call lineout RebuildCmdFile, "WRITE   " || arg(1)
  983. else
  984. call lineout RebuildCmdFile, "WRITE   " || arg(1) || '    ;' || ";Warning Leave this!"
  985. return
  986.  
  987. BIN2REXP_END:
  988. call IoError RebuildCmdFile
  989. CloseRc = stream(RebuildCmdFile, 'c', 'close')
  990. return
  991.  
  992. ProcessCmdRebuild:
  993. if  ExpectToHaveCurrentFile() = '!' then
  994. return
  995. RebuildCmdFile = RemoveAnyQuotesAroundFilename(arg(1))
  996. if  CommandNeedsFileDeleted(RebuildCmdFile) <> 0 then
  997. return
  998. call lineout RebuildCmdFile, ';' || copies('-', 78)
  999. call lineout RebuildCmdFile, '; Automatically Generated (' || date('Normal') || ' at ' || GetAmPmTime() || ' by BINTOOL version ' || PGM_VERSION || ')'
  1000. call lineout RebuildCmdFile, ';' || copies('-', 78)
  1001. call lineout RebuildCmdFile, ''
  1002. call lineout RebuildCmdFile, ';Source Details'
  1003. call lineout RebuildCmdFile, ';~~~~~~~~~~~~~~~'
  1004. call lineout RebuildCmdFile, ';Source File : ' || stream(CurrentFile, 'c', 'query exists')
  1005. call lineout RebuildCmdFile, ';Source Size : ' || AddCommasToDecimalNumber( stream(CurrentFile, 'c', 'query size') )
  1006. call lineout RebuildCmdFile, ';Source Time : ' || stream(CurrentFile, 'c', 'query datetime')
  1007. call lineout RebuildCmdFile, ';Start Offset: ' || GetDisplayableCurrentOffset()
  1008. call lineout RebuildCmdFile, ''
  1009. call lineout RebuildCmdFile, ''
  1010. call lineout RebuildCmdFile, "OpenNew " || CurrentFile
  1011. DumpWhat = charin(CurrentFile,, 99999999)
  1012. call BIN2REXP DumpWhat
  1013. call UpdateDumpAddress 0
  1014. call lineout RebuildCmdFile, "Close"
  1015. call IoError RebuildCmdFile
  1016. CloseRc = stream(RebuildCmdFile, 'c', 'close')
  1017. return
  1018.  
  1019. EndRebuildXh:
  1020. /*
  1021. * $Header:   E:/DB/PVCS.IT/OS2/BINTOOL/DUMP.XHV   1.3   11 Jun 1998 18:48:10   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.4   07 Nov 1997 15:40:04   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.3   07 Nov 1997 15:18:38   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.2   07 Nov 1997 10:57:22   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.5   11 Oct 1996 16:40:40   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.4   11 Oct 1996 16:26:28   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.3   17 Sep 1996 10:51:38   Dennis_Bareis  $
  1022. */
  1023. DumpFrom = 0
  1024. call SetDumpCharToDefault
  1025. signal EndDumpXh
  1026.  
  1027. UpdateDumpAddress:
  1028. DumpFrom = arg(1)
  1029. if  DumpFrom = '' then
  1030. do
  1031. NewDumpFrom = GetCurrentSeekPositionInFile()
  1032. if  NewDumpFrom = '!' then
  1033. return
  1034. DumpFrom = NewDumpFrom - 1
  1035. end
  1036. return
  1037.  
  1038. SetDumpCharToDefault:
  1039. do Char = 0 to 31
  1040. DumpArray.Char = '.'
  1041. end
  1042. do Char = 32 to 126
  1043. DumpArray.Char = d2c(Char)
  1044. end
  1045. do Char = 127 to 255
  1046. DumpArray.Char = '.'
  1047. end
  1048. return
  1049.  
  1050. ProcessDumpChar:
  1051. NewSetFile = RemoveAnyQuotesAroundFilename(arg(1))
  1052. if  NewSetFile = '' then
  1053. do
  1054. call SetDumpCharToDefault
  1055. call ProgressMsg 'Restored default dump character set.'
  1056. return
  1057. end
  1058. DotPos = pos('.', _filespec('name', NewSetFile))
  1059. if  DotPos = 0 then
  1060. NewSetFile = NewSetFile || '.TBL'
  1061. FullName = stream(NewSetFile, 'c', 'query exists')
  1062. if  FullName = '' then
  1063. do
  1064. SlashPos = pos('\', NewSetFile)
  1065. if  SlashPos = 0 then
  1066. do
  1067. FullName = ThisProgramDir || NewSetFile
  1068. FullName = stream(FullName, 'c', 'query exists')
  1069. end
  1070. if  FullName = '' then
  1071. do
  1072. call CommandFailure 'The file "' || NewSetFile || '" does not exist.'
  1073. return
  1074. end
  1075. end
  1076. CloseRc  = stream(FullName, 'c', 'close')
  1077. FromFile = charin(FullName,, 9)
  1078. if  FromFile <> "DUMPCHAR|" then
  1079. do
  1080. CloseRc  = stream(FullName, 'c', 'close')
  1081. call CommandFailure 'The specified file does not have a valid header.'
  1082. return
  1083. end
  1084. FromFile = charin(FullName,, 9999)
  1085. IoRc    = IoError(FullName)
  1086. CloseRc = stream(FullName, 'c', 'close')
  1087. if  IoRc = 'Y' then
  1088. return
  1089. parse var FromFile Description'|'CharSet
  1090. if  length(CharSet) <> 256 then
  1091. do
  1092. call CommandFailure 'A dump character set must be 256 bytes long (not ' || AddCommasToDecimalNumber(length(CharSet)) || ')'
  1093. return
  1094. end
  1095. do  Char = 0 to 255
  1096. DumpArray.Char = substr(CharSet, Char+1, 1)
  1097. end
  1098. call ProgressMsg 'Dump character set updated (' || strip(Description) || ')'
  1099. return
  1100.  
  1101. ProcessCmdDump:
  1102. if  ExpectToHaveCurrentFile() = '!' then
  1103. return
  1104. StartAddress = GetCurrentSeekPositionInFile()
  1105. if  StartAddress = '!' then
  1106. return
  1107. if  arg(1) = '' then
  1108. DumpLength = 16 * 6
  1109. else
  1110. do
  1111. DumpLength = GetInteger(arg(1))
  1112. if  DumpLength = '!' then
  1113. do
  1114. call CommandFailure 'Invalid value of "' || arg(1) || '" specified.'
  1115. return
  1116. end
  1117. end
  1118. SeekRc = GotoSpecificSeekPositionInFile(DumpFrom+1)
  1119. if  SeekRc = '!' then
  1120. return
  1121. DumpWhat = charin(CurrentFile,, DumpLength)
  1122. if  IoError(CurrentFile) = 'Y' then
  1123. return
  1124. call DumpValue  DumpFrom, DumpWhat
  1125. DumpFrom = DumpFrom + DumpLength
  1126. Dummy = GotoSpecificSeekPositionInFile(StartAddress)
  1127. return
  1128.  
  1129. _ShowDebugLine:
  1130. sdLine = dvAddressBit || left(dvHexStr, 41) || '  | ' || dvAsciiStr || ' |'
  1131. say sdLine
  1132. if  RecordFile <> '' then
  1133. call RecordLine ';' || Indent || sdLine
  1134. return
  1135.  
  1136. DumpValue:
  1137. dvAddress  = arg(1)
  1138. dvValue    = arg(2)
  1139. dvValueLng = length(dvValue)
  1140. dvMaxAddress = dvAddress + dvValueLng
  1141. if  InHexMode = 'N' then
  1142. dvAddressWidth = length(dvMaxAddress)
  1143. else
  1144. dvAddressWidth = length(d2x(dvMaxAddress))
  1145. dvAsciiStr   = ""
  1146. dvHexStr     = ""
  1147. dvWantSpace  = 'Y'
  1148. dvAddressBit = ''
  1149. do dvCharPosn = 1 to dvValueLng
  1150. if dvCharPosn // 16 = 1 then
  1151. do
  1152. if  dvAsciiStr \== "" then
  1153. do
  1154. call _ShowDebugLine
  1155. dvAsciiStr  = ""
  1156. dvHexStr    = ""
  1157. dvWantSpace = 'Y'
  1158. end
  1159. if  InHexMode = 'N' then
  1160. dvThisAddress = dvAddress
  1161. else
  1162. dvThisAddress = d2x(dvAddress)
  1163. dvAddressBit = right(dvThisAddress, dvAddressWidth) || ':'
  1164. dvAddress = dvAddress + 16
  1165. end
  1166. dvCharacter  = substr(dvValue, dvCharPosn, 1)
  1167. CharHexValue = c2x(dvCharacter)
  1168. if  dvWantSpace = 'Y' then
  1169. do
  1170. dvHexStr    = dvHexStr || ' ' || CharHexValue
  1171. dvWantSpace = 'N'
  1172. end
  1173. else
  1174. do
  1175. dvHexStr    = dvHexStr || CharHexValue
  1176. dvWantSpace = 'Y'
  1177. end
  1178. CharValue    = c2d(dvCharacter)
  1179. dvAsciiStr     = dvAsciiStr || DumpArray.CharValue
  1180. end
  1181. if  dvAsciiStr \== "" then
  1182. call _ShowDebugLine
  1183. return
  1184.  
  1185. EndDumpXh:
  1186. /*
  1187. * $Header:   E:/DB/PVCS.IT/OS2/BINTOOL/RECORD.XHV   1.1   11 Jun 1998 18:48:12   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.4   07 Nov 1997 15:40:04   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.3   07 Nov 1997 15:18:38   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.2   07 Nov 1997 10:57:22   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.5   11 Oct 1996 16:40:40   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.4   11 Oct 1996 16:26:28   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.3   17 Sep 1996 10:51:38   Dennis_Bareis  $
  1188. */
  1189. RecordFile  = ''
  1190. signal EndRecordfXh
  1191.  
  1192. RecordLine:
  1193. if  RecordFile <> '' then
  1194. do
  1195. call lineout RecordFile, arg(1)
  1196. IoRc = IoError(RecordFile)
  1197. end
  1198. return
  1199.  
  1200. CloseRecordFile:
  1201. if  RecordFile <> '' then
  1202. do
  1203. CloseRc = stream(RecordFile, 'c', 'close')
  1204. RecordFile = ''
  1205. end
  1206. return
  1207.  
  1208. ProcessRecordCommand:
  1209. if  OnlyAllowedInInteractiveMode() = '!' then
  1210. return
  1211. NewRecordFile = RemoveAnyQuotesAroundFilename(arg(1))
  1212. if  NewRecordFile = '' then
  1213. do
  1214. if  RecordFile = '' then
  1215. call ProgressMsg 'Recording was already off!'
  1216. else
  1217. call ProgressMsg 'Recording now turned off!'
  1218. call CloseRecordFile
  1219. end
  1220. else
  1221. do
  1222. call CloseRecordFile
  1223. call CommandNeedsFileDeleted NewRecordFile
  1224. RecordFile = NewRecordFile
  1225. call RecordLine ';' || copies('-', 78)
  1226. call RecordLine '; Automatically Generated (' || date('Normal') || ' at ' || GetAmPmTime() || ' by BINTOOL version ' || PGM_VERSION || ')'
  1227. call RecordLine ';' || copies('-', 78)
  1228. call RecordLine ''
  1229. end
  1230. return
  1231.  
  1232. EndRecordfXh:
  1233. /*
  1234. * $Header:   E:/DB/PVCS.IT/OS2/BINTOOL/FIND.XHV   1.0   11 Jun 1998 18:48:10   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.4   07 Nov 1997 15:40:04   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.3   07 Nov 1997 15:18:38   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.2   07 Nov 1997 10:57:22   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.5   11 Oct 1996 16:40:40   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.4   11 Oct 1996 16:26:28   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.3   17 Sep 1996 10:51:38   Dennis_Bareis  $
  1235. */
  1236. signal EndFindXh
  1237.  
  1238. ProcessFindCommand:
  1239. if  ExpectToHaveCurrentFile() = '!' then
  1240. return
  1241. ToFind          = arg(1)
  1242. CaseInsensitive = arg(2)
  1243. FindRestoreToRel1 = GetCurrentSeekPositionInFile()
  1244. if  FindRestoreToRel1 = '!' then
  1245. return
  1246. ToFind = InterpretCommand(arg(1))
  1247. if  ToFind = "!@#$DB$FAILED%$#" then
  1248. return
  1249. if  CaseInsensitive = 'N' then
  1250. call ProgressMsg 'Case sensitive search.'
  1251. else
  1252. do
  1253. if  verify(ToFind, AllLetters, 'M') <> 0 then
  1254. call ProgressMsg 'Case insensitive search.'
  1255. else
  1256. do
  1257. call ProgressMsg 'Case insensitive search requested (doing faster sensitive search).'
  1258. CaseInsensitive = 'N'
  1259. end
  1260. end
  1261. ToFindLng = length(ToFind)
  1262. call ProgressMsg 'Looking for ' || ToFindLng || ' bytes starting from current location.'
  1263. if  CaseInsensitive = 'Y' then
  1264. ToFind = translate(ToFind)
  1265. StartingAddressRel1 = FindRestoreToRel1
  1266. SearchIn            = ''
  1267. Found               = 'N'
  1268. do  while chars(CurrentFile) <> 0
  1269. if  CaseInsensitive = 'Y' then
  1270. FromFile = translate( charin(CurrentFile,, 40960) )
  1271. else
  1272. FromFile = charin(CurrentFile,, 40960)
  1273. FromFileLng = length(FromFile)
  1274. SearchIn    = SearchIn || FromFile
  1275. FoundPos = pos(ToFind, SearchIn)
  1276. if  FoundPos <> 0 then
  1277. do
  1278. FindRestoreToRel1 = StartingAddressRel1 + (FoundPos - 1)
  1279. call UpdateDumpAddress FindRestoreToRel1-1
  1280. call ProgressMsg 'Found match at ' || ConvertDecimalToCurrentBase(FindRestoreToRel1-1)
  1281. Found = 'Y'
  1282. leave
  1283. end
  1284. DropLeftNum         = length(SearchIn) - ToFindLng
  1285. SearchIn            = right(SearchIn, ToFindLng)
  1286. StartingAddressRel1 = StartingAddressRel1 + DropLeftNum
  1287. end
  1288. Dummy = GotoSpecificSeekPositionInFile(FindRestoreToRel1)
  1289. if  Found = 'N' then
  1290. do
  1291. call CommandFailure 'The search string was not found!'
  1292. return
  1293. end
  1294. call IoError CurrentFile
  1295. return
  1296.  
  1297. EndFindXh:
  1298. /*
  1299. * $Header:   E:/DB/PVCS.IT/OS2/BINTOOL/LOCATE.XHV   1.0   11 Jun 1998 18:48:10   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.4   07 Nov 1997 15:40:04   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.3   07 Nov 1997 15:18:38   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.2   07 Nov 1997 10:57:22   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.5   11 Oct 1996 16:40:40   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.4   11 Oct 1996 16:26:28   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.3   17 Sep 1996 10:51:38   Dennis_Bareis  $
  1300. */
  1301. signal EndLocateXh
  1302.  
  1303. ProcessLocateCommand:
  1304. if  ExpectToHaveCurrentFile() = '!' then
  1305. return
  1306. ToLocate   = arg(1)
  1307. VerifyType = arg(2)
  1308. LocateRestoreToRel1 = GetCurrentSeekPositionInFile()
  1309. if  LocateRestoreToRel1 = '!' then
  1310. return
  1311. ToLocate = InterpretCommand(arg(1))
  1312. if  ToLocate = "!@#$DB$FAILED%$#" then
  1313. return
  1314. if  VerifyType = 'M' then
  1315. call ProgressMsg 'Locating first byte that is in the supplied list.'
  1316. else
  1317. call ProgressMsg 'Locating first byte that is NOT in the supplied list.'
  1318. StartingAddressRel1 = LocateRestoreToRel1
  1319. Found               = 'N'
  1320. do  while chars(CurrentFile) <> 0
  1321. FromFile    = charin(CurrentFile,, 40960)
  1322. FromFileLng = length(FromFile)
  1323. FoundPos = verify(FromFile, ToLocate, VerifyType)
  1324. if  FoundPos <> 0 then
  1325. do
  1326. LocateRestoreToRel1 = StartingAddressRel1 + (FoundPos - 1)
  1327. call UpdateDumpAddress LocateRestoreToRel1-1
  1328. call ProgressMsg 'Found match at ' || ConvertDecimalToCurrentBase(LocateRestoreToRel1-1)
  1329. Found = 'Y'
  1330. leave
  1331. end
  1332. StartingAddressRel1 = StartingAddressRel1 + FromFileLng
  1333. end
  1334. Dummy = GotoSpecificSeekPositionInFile(LocateRestoreToRel1)
  1335. if  Found = 'N' then
  1336. do
  1337. call CommandFailure 'The locate failed to find what you were after!'
  1338. return
  1339. end
  1340. call IoError CurrentFile
  1341. return
  1342.  
  1343. EndLocateXh:
  1344. /*
  1345. * $Header:   E:/DB/PVCS.IT/OS2/BINTOOL/LABELS.XHV   1.0   11 Jun 1998 18:48:10   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.4   07 Nov 1997 15:40:04   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.3   07 Nov 1997 15:18:38   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.2   07 Nov 1997 10:57:22   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.5   11 Oct 1996 16:40:40   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.4   11 Oct 1996 16:26:28   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.3   17 Sep 1996 10:51:38   Dennis_Bareis  $
  1346. */
  1347. LabelsToLine = 0
  1348. signal EndLabelsXh
  1349.  
  1350. SaveLabel:
  1351. if  CurrentLineNumber <= LabelsToLine then
  1352. return
  1353. LabelsToLine = CurrentLineNumber
  1354. if  symbol("LabelCL." || arg(1)) = 'VAR' then
  1355. do
  1356. call CommandFailure 'Label "' || arg(1) || '" has been reused on line ' || CurrentLineNumber
  1357. return
  1358. end
  1359. interpret "LabelCL." || arg(1) || '= CurrentLineNumber'
  1360. slSeekAddress = stream(ScriptFile, 'c', 'seek')
  1361. if  datatype(slSeekAddress, 'Whole Number') = 0 then
  1362. do
  1363. call CommandFailure "Can't determine current seek address of the script" || ' "' || ScriptFile || '"'
  1364. return
  1365. end
  1366. interpret "LabelSP." || arg(1) || '= slSeekAddress'
  1367. return
  1368.  
  1369. GotoLabel:
  1370. glLabelName = translate( strip(arg(1)) )
  1371. glLineNumSym = "LabelCL." || glLabelName
  1372. if  symbol(glLineNumSym) = 'VAR' then
  1373. do
  1374. interpret 'CurrentLineNumber = '         || glLineNumSym
  1375. interpret 'SeekTo            = LabelSP.' || glLabelName
  1376. SeekRc = stream(ScriptFile, 'c', 'seek =' || SeekTo)
  1377. if  datatype(SeekRc, 'Whole Number') = 0 then
  1378. do
  1379. if  SeekRc <> '' then
  1380. SeekRc = ' (Reason=' || SeekRc || ')'
  1381. call CommandFailure 'Seek to label "' || glLabelName || '" failed' || SeekRc
  1382. return('!')
  1383. end
  1384. return('')
  1385. end
  1386. else
  1387. do
  1388. StartedLookingAtLine  = CurrentLineNumber
  1389. do  while lines(ScriptFile) <> 0
  1390. CurrentLine       = HandleWhitespaceInCommand( linein(ScriptFile) )
  1391. CurrentLineNumber = CurrentLineNumber + 1
  1392. if  left(CurrentLine, 1) = ':' then
  1393. do
  1394. ThisLabel = translate( substr(CurrentLine, 2) )
  1395. call SaveLabel ThisLabel
  1396. if  ThisLabel = glLabelName then
  1397. return('')
  1398. end
  1399. end
  1400. call IoError ScriptFile
  1401. CloseRc = stream(ScriptFile, 'c', 'close')
  1402. CurrentLineNumber = StartedLookingAtLine
  1403. call CommandFailure 'The label "' || glLabelName || '" could not be located.'
  1404. return('!')
  1405. end
  1406.  
  1407. EndLabelsXh:
  1408. /*
  1409. * $Header:   E:/DB/PVCS.IT/OS2/BINTOOL/USEFUL.XHV   1.2   11 Jun 1998 18:48:16   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.4   07 Nov 1997 15:40:04   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.3   07 Nov 1997 15:18:38   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.2   07 Nov 1997 10:57:22   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.5   11 Oct 1996 16:40:40   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.4   11 Oct 1996 16:26:28   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.3   17 Sep 1996 10:51:38   Dennis_Bareis  $
  1410. */
  1411. signal EndUsefulXh
  1412.  
  1413. B2C:
  1414.  
  1415. Binary:
  1416. return( x2c(b2x(arg(1))) )
  1417.  
  1418. EOL:
  1419. return('0D0A'x)
  1420.  
  1421. CurrentOffset:
  1422. if  ExpectToHaveCurrentFile() = '!' then
  1423. return('!')
  1424. coOffset = GetCurrentSeekPositionInFile()
  1425. if  coOffset <> '!' then
  1426. coOffset = coOffset - 1
  1427. return(coOffset)
  1428.  
  1429. AddCommasToDecimalNumber: procedure
  1430. NoComma = strip( arg(1) )
  1431. if  pos(',', NoComma) <> 0 then
  1432. return(NoComma)
  1433. DotPos = pos('.', NoComma)
  1434. if  DotPos = 0 then
  1435. AfterDecimal = ''
  1436. else
  1437. do
  1438. if  DotPos = 1 then
  1439. return("0" || NoComma)
  1440. AfterDecimal = substr(NoComma, DotPos+1)
  1441. NoComma      = left(NoComma, DotPos-1)
  1442. end
  1443. NoComma = reverse(NoComma)
  1444. ResultWithCommas = ""
  1445. do  while length(NoComma) > 3
  1446. ResultWithCommas = ResultWithCommas || left(NoComma, 3) || ','
  1447. NoComma          = substr(NoComma, 4)
  1448. end
  1449. ResultWithCommas = ResultWithCommas || NoComma
  1450. ResultWithCommas = reverse(ResultWithCommas)
  1451. if  AfterDecimal <> '' then
  1452. ResultWithCommas = ResultWithCommas || '.' || AfterDecimal
  1453. return(ResultWithCommas)
  1454.  
  1455. EndUsefulXh:
  1456. /*
  1457. * $Header:   E:/DB/PVCS.IT/OS2/BINTOOL/OPTIONS.XHV   1.0   11 Jun 1998 18:48:10   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.4   07 Nov 1997 15:40:04   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.3   07 Nov 1997 15:18:38   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.2   07 Nov 1997 10:57:22   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.5   11 Oct 1996 16:40:40   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.4   11 Oct 1996 16:26:28   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.3   17 Sep 1996 10:51:38   Dennis_Bareis  $
  1458. */
  1459. signal EndOptionsXh
  1460.  
  1461. SwitchMustNotHaveOptions:
  1462. TheCmd     = arg(1)
  1463. TheOptions = arg(2)
  1464. Value2Set  = arg(3)
  1465. if  TheOptions <> '' then
  1466. UserSyntaxError('No parameters are expected for the "' || TheCmd || '" command!')
  1467. return(Value2Set)
  1468.  
  1469. SwitchOptionsValidateAgainstList:
  1470. TheCmd    = arg(1)
  1471. TheOption = translate(arg(2))
  1472. ValidList = ',' || translate(arg(3)) || ','
  1473. if  pos(',' || TheOption || ',', ValidList) <> 0 then
  1474. return(TheOption)
  1475. UserSyntaxError('An invalid parameter of "' || TheOption || '" was specified on the "' || TheCmd || '" command!')
  1476.  
  1477. SwitchWantsYesOrNo:
  1478. TheCmd    = arg(1)
  1479. TheOption = translate(arg(2))
  1480. Default   = arg(3)
  1481. if  TheOption = '' then
  1482. return(Default)
  1483. else
  1484. return( left(SwitchOptionsValidateAgainstList(TheCmd, TheOption, "Y,N,YES,NO"), 1) )
  1485.  
  1486. NotAvailableUnderNtYet:
  1487. TheCmd = arg(1)
  1488. if  RexWhich = 'REGINA' then
  1489. UserSyntaxError('"' || TheCmd || '" can not be performed under NT (or regina).... Yet...')
  1490. return
  1491.  
  1492. EndOptionsXh:
  1493. /*
  1494. * $Header:   E:/DB/PVCS.IT/OS2/REXXHDR/GETRESP.XHV   1.1   01 Jun 1998 17:57:56   Dennis_Bareis  $
  1495. */
  1496. GetRespVer = "98.152"
  1497. call RxFuncAdd  'SysCurPos', 'RexxUtil', 'SysCurPos'
  1498. call RxFuncAdd  'SysGetKey', 'RexxUtil', 'SysGetKey'
  1499. CursorTAvailable  = 'Y'
  1500. trace off
  1501. CurrentCursorMode = -1
  1502. signal SkipOver_GETRESP
  1503.  
  1504. GetKeyFromUser:
  1505. if  CursorTAvailable = 'Y' then
  1506. do
  1507. WantedCursorMode = !CmdLine.History.insert
  1508. if  WantedCursorMode <> CurrentCursorMode then
  1509. do
  1510. if  WantedCursorMode = "0" then
  1511. CursorSize = "0 15"
  1512. else
  1513. CursorSize = "13 15"
  1514. address cmd '@CursorT.EXE ' || CursorSize || ' >nul 2>&1'
  1515. if  Rc = 0 then
  1516. CurrentCursorMode = WantedCursorMode
  1517. else
  1518. CursorTAvailable = 'N'
  1519. end
  1520. end
  1521. return( SysGetKey("NoEcho") )
  1522.  
  1523. GetRespErrorBeep:
  1524. call beep 400, 50
  1525. return
  1526.  
  1527. CmdLineProcedure: procedure expose !history. CurrentCursorMode
  1528.  
  1529. CmdLine:
  1530. CmdLine.Hidden=0
  1531. CmdLine.History=1
  1532. CmdLine.Keep=1
  1533. CmdLine.SameLine=0
  1534. CmdLine.Required=0
  1535. CmdLine.Reset=0
  1536. CmdLine.Valid=xrange()
  1537. CmdLine.Upper=0
  1538. CmdLine.Lower=0
  1539. CmdLine.Width=0
  1540. CmdLine.AutoSkip=0
  1541. /* DB$ */ EscapeCancels = 0; InitialValue = ""
  1542. parse value SysCurPos() with x y
  1543. do i=1 to arg()
  1544. cmd=translate(left(arg(i),1))
  1545. parm=""
  1546. if pos("=",arg(i))\=0 then
  1547. parse value arg(i) with ."="parm
  1548. select
  1549. when arg(i)="~Esc~" then
  1550. EscapeCancels=1
  1551. when cmd="B" then
  1552. do
  1553. parse value SysCurPos() with x y
  1554. if parm="" then
  1555. do
  1556. i = i + 1
  1557. parm=arg(i)
  1558. end
  1559. InitialValue = parm
  1560. end
  1561. when cmd="X" then
  1562. do
  1563. parse value SysCurPos() with x y
  1564. if parm="" then
  1565. do;i=i+1;parm=arg(i);end
  1566. if datatype(parm,"W") then
  1567. Call SysCurPos parm,y
  1568. end
  1569. when cmd="Y" then
  1570. do
  1571. parse value SysCurPos() with x y
  1572. if parm="" then
  1573. do;i=i+1;parm=arg(i);end
  1574. if datatype(parm,"W") then
  1575. Call SysCurPos x,parm
  1576. end
  1577. when cmd="T" then
  1578. do
  1579. if parm="" then
  1580. do;i=i+1;parm=arg(i);end
  1581. call charout, parm
  1582. end
  1583. when cmd="H" then
  1584. do
  1585. CmdLine.Hidden=1
  1586. CmdLine.Keep=0
  1587. CmdLine.History=0
  1588. end
  1589. when cmd="C" then
  1590. CmdLine.Reset=1
  1591. when cmd="O" then
  1592. !CmdLine.History.insert = 0
  1593. when cmd="I" then
  1594. !CmdLine.History.insert = 1
  1595. when cmd="F" then
  1596. CmdLine.Keep=0
  1597. when cmd="S" then
  1598. CmdLine.SameLine=1
  1599. when cmd="R" then
  1600. CmdLine.Required=1
  1601. when cmd="V" then
  1602. do
  1603. if parm="" then
  1604. do;i=i+1;parm=arg(i);end
  1605. CmdLine.Valid=parm
  1606. CmdLine.History=0
  1607. CmdLine.Keep=0
  1608. end
  1609. when cmd="U" then
  1610. do; CmdLine.Upper=1; CmdLine.Lower=0; CmdLine.History=0; CmdLine.Keep=0; end
  1611. when cmd="L" then
  1612. do; CmdLine.Upper=0; CmdLine.Lower=1; CmdLine.History=0; CmdLine.Keep=0; end
  1613. when cmd="A" then
  1614. CmdLine.AutoSkip=1
  1615. when cmd="W" then
  1616. do
  1617. if parm="" then
  1618. do;i=i+1;parm=arg(i);end
  1619. CmdLine.Width=parm
  1620. if \datatype(CmdLine.Width,"Whole") then CmdLine.Width=0
  1621. if CmdLine.Width<0 then CmdLine.Width=0
  1622. CmdLine.History=0
  1623. CmdLine.Keep=0
  1624. end
  1625. otherwise nop
  1626. end
  1627. end
  1628. if CmdLine.Width=0 then CmdLine.AutoSkip=0
  1629. if CmdLine.Reset then
  1630. do
  1631. drop !CmdLine.History.
  1632. return ""
  1633. end
  1634. if symbol("!CmdLine.History.0")="LIT" then
  1635. !CmdLine.History.0=0
  1636. if symbol("!CmdLine.History.insert")="LIT" then
  1637. !CmdLine.History.insert = 1
  1638. word = InitialValue
  1639. if word <> "" then
  1640. call charout, word
  1641. pos = length(word)
  1642. historical=-1
  1643. TheKey = GetKeyFromUser()
  1644. do forever
  1645. if TheKey=d2c(13) then
  1646. if CmdLine.Required & word="" then
  1647. call GetRespErrorBeep
  1648. else
  1649. leave
  1650. else if (TheKey=d2c(8)) then
  1651. do
  1652. if  pos = 0 then
  1653. call GetRespErrorBeep
  1654. else
  1655. do
  1656. word=delstr(word,pos,1)
  1657. call rubout 1
  1658. pos=pos-1
  1659. if pos<length(word) then
  1660. do
  1661. if  \CmdLine.Hidden then
  1662. call charout, substr(word,pos+1)||" "
  1663. else
  1664. call charout, copies("*",length(substr(word,pos+1)))||" "
  1665. call charout, copies(d2c(8),length(word)-pos+1)
  1666. end
  1667. end
  1668. end
  1669. else if TheKey=d2c(27) then
  1670. do
  1671. if   EscapeCancels then
  1672. do
  1673. if  word == '' then
  1674. do
  1675. word="~Esc~"
  1676. pos=0
  1677. leave
  1678. end
  1679. end
  1680. historical=-1
  1681. if pos<length(word) then
  1682. do
  1683. if \CmdLine.Hidden then
  1684. call charout, substr(word,pos+1)
  1685. else
  1686. call charout, copies("*",length(substr(word,pos+1)))
  1687. end
  1688. call rubout length(word)
  1689. word=""
  1690. pos=0
  1691. /*
  1692. *if pos<length(word) then
  1693. *    if \CmdLine.Hidden then call charout, substr(word,pos+1)
  1694. *    else call charout, copies("*",length(substr(word,pos+1)))
  1695. * call rubout length(word)
  1696. * word=""
  1697. * pos=0
  1698. */
  1699. end
  1700. else if TheKey=d2c(10) | TheKey=d2c(9) then
  1701. nop
  1702. else if TheKey=d2c(224) | TheKey=d2c(0) then
  1703. do
  1704. key2 = GetKeyFromUser()
  1705. select
  1706. when key2=d2c(59) then
  1707. if (CmdLine.History) & (!CmdLine.History.0<>0) then
  1708. do
  1709. if  symbol('search')='LIT' then
  1710. search=word
  1711. if  symbol('LastFind')='LIT' then
  1712. search=word
  1713. else
  1714. do
  1715. if  LastFind\=word then
  1716. search=word
  1717. end
  1718. if  historical=-1 then
  1719. start=!CmdLine.History.0
  1720. else
  1721. start=historical-1
  1722. if  start=0 then
  1723. start=!CmdLine.History.0
  1724. found=0
  1725. do i=start to 1 by -1
  1726. if abbrev(!CmdLine.History.i,search) then
  1727. do
  1728. found=1
  1729. historical=i
  1730. LastFind=!CmdLine.History.i
  1731. leave
  1732. end
  1733. end
  1734. if found then
  1735. do
  1736. if pos<length(word) then
  1737. do
  1738. if  \CmdLine.Hidden then
  1739. call charout, substr(word,pos+1)
  1740. else
  1741. call charout, copies("*",length(substr(word,pos+1)))
  1742. end
  1743. call rubout length(word)
  1744. word=!CmdLine.History.historical
  1745. pos=length(word)
  1746. if   \CmdLine.Hidden then
  1747. call charout, word
  1748. else
  1749. call charout, copies("*",length(word))
  1750. end
  1751. end
  1752. when key2=d2c(72) then
  1753. if (CmdLine.History) & (!CmdLine.History.0<>0) then
  1754. do
  1755. if historical=-1 then
  1756. historical=!CmdLine.History.0
  1757. else historical=historical-1
  1758. if historical=0 then
  1759. historical=!CmdLine.History.0
  1760. if pos<length(word) then
  1761. if \CmdLine.Hidden then call charout, substr(word,pos+1)
  1762. else call charout, copies("*",length(substr(word,pos+1)))
  1763. call rubout length(word)
  1764. word=!CmdLine.History.historical
  1765. pos=length(word)
  1766. if \CmdLine.Hidden then call charout, word
  1767. else call charout, copies("*",length(word))
  1768. end
  1769. when key2=d2c(80) then
  1770. if (CmdLine.History) & (!CmdLine.History.0<>0) then
  1771. do
  1772. if historical=-1 then
  1773. historical=1
  1774. else historical=historical+1
  1775. if historical>!CmdLine.History.0 then
  1776. historical=1
  1777. if pos<length(word) then
  1778. if \CmdLine.Hidden then call charout, substr(word,pos+1)
  1779. else call charout, copies("*",length(substr(word,pos+1)))
  1780. call rubout length(word)
  1781. word=!CmdLine.History.historical
  1782. pos=length(word)
  1783. if \CmdLine.Hidden then call charout, word
  1784. else call charout, copies("*",length(word))
  1785. end
  1786. when key2=d2c(75) then
  1787. if pos>0 then
  1788. do
  1789. call Charout, d2c(8)
  1790. pos=pos-1
  1791. end
  1792. when key2=d2c(77) then
  1793. if pos<length(word) then
  1794. do
  1795. if \CmdLine.Hidden then call Charout, substr(word,pos+1,1)
  1796. else call charout, "*"
  1797. pos=pos+1
  1798. end
  1799. when key2=d2c(115) then
  1800. if pos>0 then
  1801. do
  1802. call charout, d2c(8)
  1803. pos=pos-1
  1804. do forever
  1805. if pos=0 then leave
  1806. if substr(word,pos+1,1)\==" " & substr(word,pos,1)==" " then
  1807. leave
  1808. else
  1809. do
  1810. call charout, d2c(8)
  1811. pos=pos-1
  1812. end
  1813. end
  1814. end
  1815. when key2=d2c(116) then
  1816. if pos<length(word) then
  1817. do
  1818. if \CmdLine.Hidden then call Charout, substr(word,pos+1,1)
  1819. else call charout, "*"
  1820. pos=pos+1
  1821. do forever
  1822. if pos=length(word) then
  1823. leave
  1824. if substr(word,pos,1)==" " & substr(word,pos+1,1)\==" " then
  1825. leave
  1826. else
  1827. do
  1828. if \CmdLine.Hidden then call Charout, substr(word,pos+1,1)
  1829. else call charout, "*"
  1830. pos=pos+1
  1831. end
  1832. end
  1833. end
  1834. when key2=d2c(83) then
  1835. if pos<length(word) then
  1836. do
  1837. word=delstr(word,pos+1,1)
  1838. if \CmdLine.Hidden then call Charout, substr(word,pos+1)||" "
  1839. else call Charout, copies("*",length(substr(word,pos+1)))||" "
  1840. call charout, copies(d2c(8),length(word)-pos+1)
  1841. end
  1842. when key2=d2c(82) then
  1843. !CmdLine.History.insert = \!CmdLine.History.insert
  1844. when key2=d2c(79) then
  1845. if pos<length(word) then
  1846. do
  1847. if \CmdLine.Hidden then call Charout, substr(word,pos+1)
  1848. else call Charout, copies("*",length(substr(word,pos+1)))
  1849. pos=length(word)
  1850. end
  1851. when key2=d2c(71) then
  1852. if pos\=0 then
  1853. do
  1854. call Charout, copies(d2c(8),pos)
  1855. pos=0
  1856. end
  1857. when key2=d2c(117) then
  1858. if pos<length(word) then
  1859. do
  1860. call Charout, copies(" ",length(word)-pos)
  1861. call Charout, copies(d2c(8),length(word)-pos)
  1862. word=left(word,pos)
  1863. end
  1864. when key2=d2c(119) then
  1865. if pos>0 then
  1866. do
  1867. if pos<length(word) then
  1868. if \CmdLine.Hidden then call charout, substr(word,pos+1)
  1869. else call charout, copies("*",length(substr(word,pos+1)))
  1870. call rubout length(word)
  1871. word=substr(word,pos+1)
  1872. if \CmdLine.Hidden then call Charout, word
  1873. else call Charout, copies("*",length(word))
  1874. call Charout, copies(d2c(8),length(word))
  1875. pos=0
  1876. end
  1877. otherwise
  1878. if CmdLine.History & symbol('!CmdLine.History.key.'||c2d(key2))\='LIT' then
  1879. do
  1880. if pos<length(word) then
  1881. if \CmdLine.Hidden then call charout, substr(word,pos+1)
  1882. else call charout, copies("*",length(substr(word,pos+1)))
  1883. call rubout length(word)
  1884. i=c2d(key2)
  1885. word=!CmdLine.History.key.i
  1886. pos=length(word)
  1887. if \CmdLine.Hidden then call charout, word
  1888. else call charout, copies("*",length(word))
  1889. end
  1890. end
  1891. end
  1892. else
  1893. if CmdLine.Width=0 | (length(word)<CmdLine.Width | (pos<CmdLine.Width & !CmdLine.History.insert = 0)) then
  1894. do
  1895. if CmdLine.Upper then TheKey=translate(TheKey)
  1896. if CmdLine.Lower then TheKey=translate(TheKey,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1897. if pos(TheKey,CmdLine.Valid)\=0 then
  1898. do
  1899. if \CmdLine.Hidden then
  1900. call Charout, TheKey
  1901. else
  1902. call charout, "*"
  1903. if !CmdLine.History.insert then
  1904. word=insert(TheKey,word,pos)
  1905. else
  1906. word=overlay(TheKey,word,pos+1)
  1907. pos=pos+1
  1908. if pos<length(word) then
  1909. do
  1910. if \CmdLine.Hidden then
  1911. call Charout, substr(word,pos+1)
  1912. else
  1913. call Charout, copies("*", length(substr(word,pos+1)))
  1914. call Charout, copies(d2c(8),length(word)-pos)
  1915. end
  1916. end
  1917. else
  1918. call GetRespErrorBeep
  1919. end
  1920. else
  1921. call GetRespErrorBeep
  1922. if CmdLine.AutoSkip & length(word)=CmdLine.Width then leave
  1923. TheKey = GetKeyFromUser()
  1924. end
  1925. if \CmdLine.SameLine then say
  1926. if (CmdLine.Keep) & (word\=="") then
  1927. do
  1928. historical=!CmdLine.History.0
  1929. if word\=!CmdLine.History.historical then
  1930. do
  1931. !CmdLine.History.0=!CmdLine.History.0+1
  1932. historical=!CmdLine.History.0
  1933. !CmdLine.History.historical=word
  1934. end
  1935. end
  1936. return word
  1937.  
  1938. rubout: procedure
  1939. arg n
  1940. do i=1 to n
  1941. call Charout, d2c(8)||" "||d2c(8)
  1942. end
  1943. return
  1944.  
  1945. SkipOver_GETRESP:
  1946. /*
  1947. * $Header:   E:/DB/PVCS.IT/OS2/BINTOOL/VERIFY.XHV   1.1   02 Jun 1998 19:05:04   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.4   07 Nov 1997 15:40:04   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.3   07 Nov 1997 15:18:38   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.2   07 Nov 1997 10:57:22   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.5   11 Oct 1996 16:40:40   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.4   11 Oct 1996 16:26:28   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.3   17 Sep 1996 10:51:38   Dennis_Bareis  $
  1948. */
  1949. StartsReplacement = '<' || '@'
  1950. EndsReplacement   = '>'
  1951. signal EndRexxVarXh
  1952.  
  1953. ReplaceRexxVariables:
  1954. RightBit      = arg(1)
  1955. ChangeVarName = arg(2)
  1956. LeftBit     = ''
  1957. ChangesMade = 'N'
  1958. VarPos      = pos(StartsReplacement, RightBit)
  1959. do while VarPos <> 0
  1960. LeftBit  = LeftBit || left(RightBit, VarPos-1)
  1961. RightBit = substr(RightBit, VarPos+2)
  1962. RightBitT    = translate(RightBit, ' ', EndsReplacement)
  1963. VariableName = word(RightBitT, 1)
  1964. RightBit     = strip( substr(RightBit, length(VariableName)+1) )
  1965. if  symbol(VariableName) <> 'VAR' then
  1966. call CommandFailure 'The rexx variable "' || VariableName || '" has not been set!'
  1967. else
  1968. VariableCont = value(VariableName)
  1969. RightBit = substr(RightBit ,2)
  1970. LeftBit     = LeftBit || VariableCont
  1971. ChangesMade = 'Y'
  1972. VarPos = pos(StartsReplacement, RightBit)
  1973. end
  1974. TheString = LeftBit || RightBit
  1975. if  ChangeVarName <> '' then
  1976. call value ChangeVarName, ChangesMade
  1977. return(TheString)
  1978.  
  1979. EndRexxVarXh:
  1980. /*
  1981. * $Header:   E:/DB/PVCS.IT/OS2/BINTOOL/SUNDRY.XHV   1.5   11 Jun 1998 18:48:16   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.4   07 Nov 1997 15:40:04   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.3   07 Nov 1997 15:18:38   Dennis_Bareis  $/htmlpp/HtmlPP.cmv   1.2   07 Nov 1997 10:57:22   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.5   11 Oct 1996 16:40:40   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.4   11 Oct 1996 16:26:28   Dennis_Bareis  $/PLATFORM/PLATFRM.X_V   1.3   17 Sep 1996 10:51:38   Dennis_Bareis  $
  1982. */
  1983. signal EndSundryXh
  1984.  
  1985. GetCurrentSeekPositionInFile:
  1986. gcsSeekAddress = stream(CurrentFile, 'c', 'seek')
  1987. if  datatype(gcsSeekAddress, 'Whole Number') = 0 then
  1988. do
  1989. call CommandFailure "Can't determine current seek address"
  1990. return('!')
  1991. end
  1992. return(gcsSeekAddress)
  1993.  
  1994. GotoSpecificSeekPositionInFile:
  1995. SeekRc = stream(CurrentFile, 'c', 'seek =' || arg(1))
  1996. if  datatype(SeekRc, 'Whole Number') = 0 then
  1997. do
  1998. if  SeekRc <> '' then
  1999. SeekRc = ' (Reason=' || SeekRc || ')'
  2000. call CommandFailure 'Seek to ' || arg(1) || ' failed' || SeekRc
  2001. return('!')
  2002. end
  2003. return(SeekRc)
  2004.  
  2005. GetInteger:
  2006. giString = strip( arg(1) )
  2007. select
  2008. when left(giString, 1) = '$' then
  2009. do
  2010. giHex    = 'N'
  2011. giString = substr(giString, 2)
  2012. end
  2013. when translate(left(giString, 1)) = 'X' then
  2014. do
  2015. giHex    = 'Y'
  2016. giString = substr(giString, 2)
  2017. end
  2018. otherwise
  2019. giHex = InHexMode
  2020. end
  2021. if  giHex = 'Y' then
  2022. do
  2023. if  datatype(giString, 'X') = 0 then
  2024. return('!')
  2025. return( x2d(giString) )
  2026. end
  2027. else
  2028. do
  2029. if  datatype(giString, 'W') = 0 then
  2030. return('!')
  2031. return( giString )
  2032. end
  2033.  
  2034. RemoveAnyQuotesAroundFilename:
  2035. rqaFileName = arg(1)
  2036. rqaLq = left(rqaFileName, 1)
  2037. if  rqaLq <> '"' & rqaLq <> "'" then
  2038. return(rqaFileName)
  2039. else
  2040. do
  2041. rqaRq = right(rqaFileName, 1)
  2042. if  rqaLq <> rqaRq then
  2043. return(rqaFileName)
  2044. else
  2045. return( substr(rqaFileName, 2, length(rqaFileName)-2) )
  2046. end
  2047.  
  2048. ExpectToHaveCurrentFile:
  2049. if  CurrentFile <> '' then
  2050. return('')
  2051. else
  2052. do
  2053. call CommandFailure 'There is no file open!'
  2054. return('!')
  2055. end
  2056.  
  2057. OnlyAllowedInInteractiveMode:
  2058. if  Interactive = 'Y' then
  2059. return('')
  2060. else
  2061. do
  2062. call CommandFailure 'This command can only be used in interactive mode!'
  2063. return('!')
  2064. end
  2065.  
  2066. NotAllowedInInteractiveMode:
  2067. if  Interactive = 'N' then
  2068. return('')
  2069. else
  2070. do
  2071. call CommandFailure 'This command is not allowed in interactive mode!'
  2072. return('!')
  2073. end
  2074.  
  2075. MustNotHaveFileOpen:
  2076. if  CurrentFile = '' then
  2077. return('')
  2078. else
  2079. do
  2080. call CommandFailure 'You should not have a file open when executing this command!'
  2081. return('!')
  2082. end
  2083.  
  2084. CommandNeedsFileDeleted:
  2085. CloseRc = stream(arg(1), 'c', 'close')
  2086. if  stream(arg(1), 'c', 'query exists') <> '' then
  2087. do
  2088. DosDelRc   = _SysFileDelete(arg(1))
  2089. if  stream(arg(1), 'c', 'query exists') <> '' then
  2090. do
  2091. call CommandFailure 'Could not delete "' || arg(1) || '" (DosRc=' || DosDelRc || ')'
  2092. return(ThisLineNumber())
  2093. end
  2094. end
  2095. return(0)
  2096.  
  2097. ConvertDecimalToCurrentBase:
  2098. cdDecimal   = arg(1)
  2099. cdMinDigits = arg(2)
  2100. if  InHexMode = 'N' then
  2101. do
  2102. cdReturn = cdDecimal
  2103. cdSymbol = '$'
  2104. if  cdMinDigits = '' then
  2105. cdMinDigits = 1
  2106. end
  2107. else
  2108. do
  2109. cdReturn = d2x(cdDecimal)
  2110. cdSymbol = 'x'
  2111. if  cdMinDigits = '' then
  2112. cdMinDigits = 4
  2113. end
  2114. if  length(cdReturn) < cdMinDigits then
  2115. cdReturn = right(cdReturn, cdMinDigits, '0')
  2116. return(cdSymbol || cdReturn)
  2117.  
  2118. GetDisplayableCurrentOffset:
  2119. if  CurrentFile = '' then
  2120. dcoAddress = '?'
  2121. else
  2122. do
  2123. dcoAddress = stream(CurrentFile, 'c', 'seek')
  2124. if  datatype(dcoAddress, 'Whole Number') = 0 then
  2125. dcoAddress = '??'
  2126. else
  2127. do
  2128. dcoAddress = ConvertDecimalToCurrentBase(dcoAddress - 1)
  2129. end
  2130. end
  2131. if  arg(1) <> '' then
  2132. do
  2133. if  length(dcoAddress) < arg(1) then
  2134. dcoAddress = left(dcoAddress, arg(1), ' ')
  2135. end
  2136. return(dcoAddress)
  2137.  
  2138. GetAmPmTime:  procedure
  2139. CivilTime  = time('C');  if length(CivilTime)  = 6 then CivilTime=' 'CivilTime
  2140. TheTime    = time();     NumSeconds = ':'substr(TheTime, 7, 2)
  2141. return( insert(NumSeconds, CivilTime, 5) )
  2142.  
  2143. RexxCtrlC:
  2144. LineCtrlC = SIGL
  2145. call ToStderr ''
  2146. call ToStderr ColorError || copies('=+', 39)
  2147. call ToStderr "Come on, you pressed Ctrl+C or Break didn't you!"
  2148. call ToStderr copies('=+', 39) || Reset
  2149. PgmExit(LineCtrlC)
  2150.  
  2151. UserSyntaxError:
  2152. call ToStderr ColorError || "SYNTAX ERROR"
  2153. call ToStderr "~~~~~~~~~~~~"
  2154. call ToStderr '    ' || arg(1)
  2155. call ToStderr ''
  2156. call ToStderr 'CORRECT SYNTAX'
  2157. call ToStderr '~~~~~~~~~~~~~~'
  2158. call ToStderr '    BINTOOL[.CMD] ScriptFile   OR'
  2159. call ToStderr '    BINTOOL[.CMD] ?'
  2160. call ToStderr ''
  2161. call ToStderr ''
  2162. call ToStderr 'If "?" is used the program works interactively.  If you use the "RECORD"'
  2163. call ToStderr 'command you can keep a record of the commands you use so you can replay them.'
  2164. call ToStderr TwoBeep || Reset
  2165. PgmExit(ThisLineNumber())
  2166.  
  2167. ThisLineNumber:
  2168. return(SIGL)
  2169.  
  2170. IoError:
  2171. FileState = stream(arg(1), 'State')
  2172. if  FileState = 'READY' then
  2173. return('N')
  2174. IoReason = stream(arg(1), 'Description')
  2175. if  IoReason == 'NOTREADY:EOF' then
  2176. return('N')
  2177. call CommandFailure 'I/O failure on "' || arg(1) || '" (' || IoReason || ').'
  2178. return('Y')
  2179.  
  2180. ProgressMsg:
  2181. IntMsg = arg(1)
  2182. if  OptionSeeProgress = 'Y' then
  2183. do
  2184. IntMsgColor = arg(2)
  2185. if  IntMsgColor = '' then
  2186. IntMsgColor = ColorProgress
  2187. say IntMsgColor || Indent || IntMsg || Reset
  2188. end
  2189. call RecordLine ';' || Indent || IntMsg
  2190. return
  2191.  
  2192. CommandFailure:
  2193. CallersLine = SIGL
  2194. if  Interactive = 'Y' then
  2195. do
  2196. call ProgressMsg arg(1), ColorError
  2197. return
  2198. end
  2199. FailHeader  = "Failure on line " || CurrentLineNumber
  2200. if  OnError <> '' then
  2201. do
  2202. call ProgressMsg FailHeader
  2203. call ProgressMsg copies('~', length(FailHeader))
  2204. call ProgressMsg arg(1)
  2205. ErrorHandler = OnError
  2206. OnError      = ''
  2207. if  GotoLabel(ErrorHandler) <> '!' then
  2208. return
  2209. end
  2210. else
  2211. do
  2212. call ToStderr ColorError || FailHeader
  2213. call ToStderr copies('~', length(FailHeader))
  2214. call ToStderr arg(1) || Reset
  2215. PgmExit(CallersLine)
  2216. end
  2217.  
  2218. ToStderr:
  2219. call StderrLine arg(1)
  2220. call RecordLine ';' || arg(1)
  2221. return
  2222.  
  2223. DisplayLine:
  2224. call charout, arg(1)
  2225. say arg(2)
  2226. call charout, Reset
  2227. return
  2228.  
  2229. EndSundryXh:
  2230. /*
  2231. * CRC32REX.XH Version 98.153 by Dennis Bareis
  2232. *            http://www.labyrinth.net.au/~dbareis/index.htm (db0@anz.com)
  2233. */
  2234. _Crc32.0  = '00000000'x
  2235. _Crc32.1  = '77073096'x
  2236. _Crc32.2  = 'EE0E612C'x
  2237. _Crc32.3  = '990951BA'x
  2238. _Crc32.4  = '076DC419'x
  2239. _Crc32.5  = '706AF48F'x
  2240. _Crc32.6  = 'E963A535'x
  2241. _Crc32.7  = '9E6495A3'x
  2242. _Crc32.8  = '0EDB8832'x
  2243. _Crc32.9  = '79DCB8A4'x
  2244. _Crc32.10 = 'E0D5E91E'x
  2245. _Crc32.11 = '97D2D988'x
  2246. _Crc32.12 = '09B64C2B'x
  2247. _Crc32.13 = '7EB17CBD'x
  2248. _Crc32.14 = 'E7B82D07'x
  2249. _Crc32.15 = '90BF1D91'x
  2250. _Crc32.16 = '1DB71064'x
  2251. _Crc32.17 = '6AB020F2'x
  2252. _Crc32.18 = 'F3B97148'x
  2253. _Crc32.19 = '84BE41DE'x
  2254. _Crc32.20 = '1ADAD47D'x
  2255. _Crc32.21 = '6DDDE4EB'x
  2256. _Crc32.22 = 'F4D4B551'x
  2257. _Crc32.23 = '83D385C7'x
  2258. _Crc32.24 = '136C9856'x
  2259. _Crc32.25 = '646BA8C0'x
  2260. _Crc32.26 = 'FD62F97A'x
  2261. _Crc32.27 = '8A65C9EC'x
  2262. _Crc32.28 = '14015C4F'x
  2263. _Crc32.29 = '63066CD9'x
  2264. _Crc32.30 = 'FA0F3D63'x
  2265. _Crc32.31 = '8D080DF5'x
  2266. _Crc32.32 = '3B6E20C8'x
  2267. _Crc32.33 = '4C69105E'x
  2268. _Crc32.34 = 'D56041E4'x
  2269. _Crc32.35 = 'A2677172'x
  2270. _Crc32.36 = '3C03E4D1'x
  2271. _Crc32.37 = '4B04D447'x
  2272. _Crc32.38 = 'D20D85FD'x
  2273. _Crc32.39 = 'A50AB56B'x
  2274. _Crc32.40 = '35B5A8FA'x
  2275. _Crc32.41 = '42B2986C'x
  2276. _Crc32.42 = 'DBBBC9D6'x
  2277. _Crc32.43 = 'ACBCF940'x
  2278. _Crc32.44 = '32D86CE3'x
  2279. _Crc32.45 = '45DF5C75'x
  2280. _Crc32.46 = 'DCD60DCF'x
  2281. _Crc32.47 = 'ABD13D59'x
  2282. _Crc32.48 = '26D930AC'x
  2283. _Crc32.49 = '51DE003A'x
  2284. _Crc32.50 = 'C8D75180'x
  2285. _Crc32.51 = 'BFD06116'x
  2286. _Crc32.52 = '21B4F4B5'x
  2287. _Crc32.53 = '56B3C423'x
  2288. _Crc32.54 = 'CFBA9599'x
  2289. _Crc32.55 = 'B8BDA50F'x
  2290. _Crc32.56 = '2802B89E'x
  2291. _Crc32.57 = '5F058808'x
  2292. _Crc32.58 = 'C60CD9B2'x
  2293. _Crc32.59 = 'B10BE924'x
  2294. _Crc32.60 = '2F6F7C87'x
  2295. _Crc32.61 = '58684C11'x
  2296. _Crc32.62 = 'C1611DAB'x
  2297. _Crc32.63 = 'B6662D3D'x
  2298. _Crc32.64 = '76DC4190'x
  2299. _Crc32.65 = '01DB7106'x
  2300. _Crc32.66 = '98D220BC'x
  2301. _Crc32.67 = 'EFD5102A'x
  2302. _Crc32.68 = '71B18589'x
  2303. _Crc32.69 = '06B6B51F'x
  2304. _Crc32.70 = '9FBFE4A5'x
  2305. _Crc32.71 = 'E8B8D433'x
  2306. _Crc32.72 = '7807C9A2'x
  2307. _Crc32.73 = '0F00F934'x
  2308. _Crc32.74 = '9609A88E'x
  2309. _Crc32.75 = 'E10E9818'x
  2310. _Crc32.76 = '7F6A0DBB'x
  2311. _Crc32.77 = '086D3D2D'x
  2312. _Crc32.78 = '91646C97'x
  2313. _Crc32.79 = 'E6635C01'x
  2314. _Crc32.80 = '6B6B51F4'x
  2315. _Crc32.81 = '1C6C6162'x
  2316. _Crc32.82 = '856530D8'x
  2317. _Crc32.83 = 'F262004E'x
  2318. _Crc32.84 = '6C0695ED'x
  2319. _Crc32.85 = '1B01A57B'x
  2320. _Crc32.86 = '8208F4C1'x
  2321. _Crc32.87 = 'F50FC457'x
  2322. _Crc32.88 = '65B0D9C6'x
  2323. _Crc32.89 = '12B7E950'x
  2324. _Crc32.90 = '8BBEB8EA'x
  2325. _Crc32.91 = 'FCB9887C'x
  2326. _Crc32.92 = '62DD1DDF'x
  2327. _Crc32.93 = '15DA2D49'x
  2328. _Crc32.94 = '8CD37CF3'x
  2329. _Crc32.95 = 'FBD44C65'x
  2330. _Crc32.96 = '4DB26158'x
  2331. _Crc32.97 = '3AB551CE'x
  2332. _Crc32.98 = 'A3BC0074'x
  2333. _Crc32.99 = 'D4BB30E2'x
  2334. _Crc32.100 = '4ADFA541'x
  2335. _Crc32.101 = '3DD895D7'x
  2336. _Crc32.102 = 'A4D1C46D'x
  2337. _Crc32.103 = 'D3D6F4FB'x
  2338. _Crc32.104 = '4369E96A'x
  2339. _Crc32.105 = '346ED9FC'x
  2340. _Crc32.106 = 'AD678846'x
  2341. _Crc32.107 = 'DA60B8D0'x
  2342. _Crc32.108 = '44042D73'x
  2343. _Crc32.109 = '33031DE5'x
  2344. _Crc32.110 = 'AA0A4C5F'x
  2345. _Crc32.111 = 'DD0D7CC9'x
  2346. _Crc32.112 = '5005713C'x
  2347. _Crc32.113 = '270241AA'x
  2348. _Crc32.114 = 'BE0B1010'x
  2349. _Crc32.115 = 'C90C2086'x
  2350. _Crc32.116 = '5768B525'x
  2351. _Crc32.117 = '206F85B3'x
  2352. _Crc32.118 = 'B966D409'x
  2353. _Crc32.119 = 'CE61E49F'x
  2354. _Crc32.120 = '5EDEF90E'x
  2355. _Crc32.121 = '29D9C998'x
  2356. _Crc32.122 = 'B0D09822'x
  2357. _Crc32.123 = 'C7D7A8B4'x
  2358. _Crc32.124 = '59B33D17'x
  2359. _Crc32.125 = '2EB40D81'x
  2360. _Crc32.126 = 'B7BD5C3B'x
  2361. _Crc32.127 = 'C0BA6CAD'x
  2362. _Crc32.128 = 'EDB88320'x
  2363. _Crc32.129 = '9ABFB3B6'x
  2364. _Crc32.130 = '03B6E20C'x
  2365. _Crc32.131 = '74B1D29A'x
  2366. _Crc32.132 = 'EAD54739'x
  2367. _Crc32.133 = '9DD277AF'x
  2368. _Crc32.134 = '04DB2615'x
  2369. _Crc32.135 = '73DC1683'x
  2370. _Crc32.136 = 'E3630B12'x
  2371. _Crc32.137 = '94643B84'x
  2372. _Crc32.138 = '0D6D6A3E'x
  2373. _Crc32.139 = '7A6A5AA8'x
  2374. _Crc32.140 = 'E40ECF0B'x
  2375. _Crc32.141 = '9309FF9D'x
  2376. _Crc32.142 = '0A00AE27'x
  2377. _Crc32.143 = '7D079EB1'x
  2378. _Crc32.144 = 'F00F9344'x
  2379. _Crc32.145 = '8708A3D2'x
  2380. _Crc32.146 = '1E01F268'x
  2381. _Crc32.147 = '6906C2FE'x
  2382. _Crc32.148 = 'F762575D'x
  2383. _Crc32.149 = '806567CB'x
  2384. _Crc32.150 = '196C3671'x
  2385. _Crc32.151 = '6E6B06E7'x
  2386. _Crc32.152 = 'FED41B76'x
  2387. _Crc32.153 = '89D32BE0'x
  2388. _Crc32.154 = '10DA7A5A'x
  2389. _Crc32.155 = '67DD4ACC'x
  2390. _Crc32.156 = 'F9B9DF6F'x
  2391. _Crc32.157 = '8EBEEFF9'x
  2392. _Crc32.158 = '17B7BE43'x
  2393. _Crc32.159 = '60B08ED5'x
  2394. _Crc32.160 = 'D6D6A3E8'x
  2395. _Crc32.161 = 'A1D1937E'x
  2396. _Crc32.162 = '38D8C2C4'x
  2397. _Crc32.163 = '4FDFF252'x
  2398. _Crc32.164 = 'D1BB67F1'x
  2399. _Crc32.165 = 'A6BC5767'x
  2400. _Crc32.166 = '3FB506DD'x
  2401. _Crc32.167 = '48B2364B'x
  2402. _Crc32.168 = 'D80D2BDA'x
  2403. _Crc32.169 = 'AF0A1B4C'x
  2404. _Crc32.170 = '36034AF6'x
  2405. _Crc32.171 = '41047A60'x
  2406. _Crc32.172 = 'DF60EFC3'x
  2407. _Crc32.173 = 'A867DF55'x
  2408. _Crc32.174 = '316E8EEF'x
  2409. _Crc32.175 = '4669BE79'x
  2410. _Crc32.176 = 'CB61B38C'x
  2411. _Crc32.177 = 'BC66831A'x
  2412. _Crc32.178 = '256FD2A0'x
  2413. _Crc32.179 = '5268E236'x
  2414. _Crc32.180 = 'CC0C7795'x
  2415. _Crc32.181 = 'BB0B4703'x
  2416. _Crc32.182 = '220216B9'x
  2417. _Crc32.183 = '5505262F'x
  2418. _Crc32.184 = 'C5BA3BBE'x
  2419. _Crc32.185 = 'B2BD0B28'x
  2420. _Crc32.186 = '2BB45A92'x
  2421. _Crc32.187 = '5CB36A04'x
  2422. _Crc32.188 = 'C2D7FFA7'x
  2423. _Crc32.189 = 'B5D0CF31'x
  2424. _Crc32.190 = '2CD99E8B'x
  2425. _Crc32.191 = '5BDEAE1D'x
  2426. _Crc32.192 = '9B64C2B0'x
  2427. _Crc32.193 = 'EC63F226'x
  2428. _Crc32.194 = '756AA39C'x
  2429. _Crc32.195 = '026D930A'x
  2430. _Crc32.196 = '9C0906A9'x
  2431. _Crc32.197 = 'EB0E363F'x
  2432. _Crc32.198 = '72076785'x
  2433. _Crc32.199 = '05005713'x
  2434. _Crc32.200 = '95BF4A82'x
  2435. _Crc32.201 = 'E2B87A14'x
  2436. _Crc32.202 = '7BB12BAE'x
  2437. _Crc32.203 = '0CB61B38'x
  2438. _Crc32.204 = '92D28E9B'x
  2439. _Crc32.205 = 'E5D5BE0D'x
  2440. _Crc32.206 = '7CDCEFB7'x
  2441. _Crc32.207 = '0BDBDF21'x
  2442. _Crc32.208 = '86D3D2D4'x
  2443. _Crc32.209 = 'F1D4E242'x
  2444. _Crc32.210 = '68DDB3F8'x
  2445. _Crc32.211 = '1FDA836E'x
  2446. _Crc32.212 = '81BE16CD'x
  2447. _Crc32.213 = 'F6B9265B'x
  2448. _Crc32.214 = '6FB077E1'x
  2449. _Crc32.215 = '18B74777'x
  2450. _Crc32.216 = '88085AE6'x
  2451. _Crc32.217 = 'FF0F6A70'x
  2452. _Crc32.218 = '66063BCA'x
  2453. _Crc32.219 = '11010B5C'x
  2454. _Crc32.220 = '8F659EFF'x
  2455. _Crc32.221 = 'F862AE69'x
  2456. _Crc32.222 = '616BFFD3'x
  2457. _Crc32.223 = '166CCF45'x
  2458. _Crc32.224 = 'A00AE278'x
  2459. _Crc32.225 = 'D70DD2EE'x
  2460. _Crc32.226 = '4E048354'x
  2461. _Crc32.227 = '3903B3C2'x
  2462. _Crc32.228 = 'A7672661'x
  2463. _Crc32.229 = 'D06016F7'x
  2464. _Crc32.230 = '4969474D'x
  2465. _Crc32.231 = '3E6E77DB'x
  2466. _Crc32.232 = 'AED16A4A'x
  2467. _Crc32.233 = 'D9D65ADC'x
  2468. _Crc32.234 = '40DF0B66'x
  2469. _Crc32.235 = '37D83BF0'x
  2470. _Crc32.236 = 'A9BCAE53'x
  2471. _Crc32.237 = 'DEBB9EC5'x
  2472. _Crc32.238 = '47B2CF7F'x
  2473. _Crc32.239 = '30B5FFE9'x
  2474. _Crc32.240 = 'BDBDF21C'x
  2475. _Crc32.241 = 'CABAC28A'x
  2476. _Crc32.242 = '53B39330'x
  2477. _Crc32.243 = '24B4A3A6'x
  2478. _Crc32.244 = 'BAD03605'x
  2479. _Crc32.245 = 'CDD70693'x
  2480. _Crc32.246 = '54DE5729'x
  2481. _Crc32.247 = '23D967BF'x
  2482. _Crc32.248 = 'B3667A2E'x
  2483. _Crc32.249 = 'C4614AB8'x
  2484. _Crc32.250 = '5D681B02'x
  2485. _Crc32.251 = '2A6F2B94'x
  2486. _Crc32.252 = 'B40BBE37'x
  2487. _Crc32.253 = 'C30C8EA1'x
  2488. _Crc32.254 = '5A05DF1B'x
  2489. _Crc32.255 = '2D02EF8D'x
  2490. signal EndCrc32rexXh
  2491.  
  2492. Crc32PrePostConditioning:
  2493. if  arg(1) = '' then
  2494. return('FFFFFFFF'x)
  2495. else
  2496. return( bitxor(arg(1), 'FFFFFFFF'x) )
  2497.  
  2498. UpdateCrc32:
  2499. ucCrc       = arg(1)
  2500. ucBuffer    = arg(2)
  2501. ucBufferLng = length(ucBuffer)
  2502. do  ucThisByte = 1 to ucBufferLng
  2503. ucCrcDiv256 = '00'x || left(ucCrc, 3)
  2504. ucPart1     = bitand(ucCrcDiv256, '00FFFFFF'x)
  2505. ucPart2     = bitxor(ucCrc, '000000'x || substr(ucBuffer, ucThisByte, 1))
  2506. ucArrayEl   = c2d(right(bitand(ucPart2, '000000FF'x), 1))
  2507. ucCrc       = Bitxor(ucPart1, _Crc32.ucArrayEl)
  2508. end
  2509. return(ucCrc)
  2510.  
  2511. Crc32InDisplayableForm:
  2512. return( c2x(arg(1)) )
  2513.  
  2514. EndCRC32REXXh:
  2515. CurrentFile = ''
  2516. InHexMode   = 'Y'
  2517. OnError     = ''
  2518. call DisplayCopyright
  2519. parse value arg(1) with ScriptFile OptionsCmdLine
  2520. if ScriptFile = '' then
  2521. UserSyntaxError("Expected the name of a Script File")
  2522. OptionDebugOn     = 'N'
  2523. OptionSeeCmds     = 'N'
  2524. OptionSeeProgress = 'N'
  2525. OptionsEnvironment = GetEnv('BINTOOL_OPTIONS')
  2526. Options            = OptionsEnvironment || ' ' || OptionsCmdLine
  2527. do while  Options <> ''
  2528. parse var Options ThisParm Options
  2529. parse var ThisParm ThisCmd':'ThisCmdOptions
  2530. ThisCmd = translate(ThisCmd)
  2531. select
  2532. when ThisCmd = '/SEECMDS' then
  2533. OptionSeeCmds    = SwitchWantsYesOrNo(ThisCmd, ThisCmdOptions, 'Y')
  2534. when ThisCmd = '/SEEPROGRESS' then
  2535. OptionSeeProgress = SwitchWantsYesOrNo(ThisCmd, ThisCmdOptions, 'Y')
  2536. when ThisCmd = '/DEBUG' then
  2537. do
  2538. call SwitchMustNotHaveOptions ThisCmd, ThisCmdOptions
  2539. OptionDebugOn     = 'Y'
  2540. OptionSeeCmds     = 'Y'
  2541. OptionSeeProgress = 'Y'
  2542. end
  2543. when ThisCmd = '/COLOR' | ThisCmd = '/COLOUR' then
  2544. do
  2545. call NotAvailableUnderNtYet ThisCmd
  2546. WantColor = SwitchWantsYesOrNo(ThisCmd, ThisCmdOptions, 'Y')
  2547. if  WantColor = 'N' then
  2548. call RemoveColorCodes
  2549. else
  2550. call SetColorCodes
  2551. end
  2552. otherwise
  2553. UserSyntaxError('Unknown command of "' || ThisCmd || '" specified')
  2554. end
  2555. end
  2556. if ScriptFile <> '?' then
  2557. Interactive = 'N'
  2558. else
  2559. do
  2560. Interactive       = 'Y'
  2561. OptionSeeCmds     = 'N'
  2562. OptionSeeProgress = 'Y'
  2563. end
  2564. if Interactive = 'Y' then
  2565. call ProcessInteractiveCommands
  2566. else
  2567. call ProcessWholeFile
  2568. PgmExit(ExitRc)
  2569.  
  2570. DisplayCopyright:
  2571. call DisplayLine ColorStartupMsg, '[]-------------------------------------------------------------------------[]'
  2572. call DisplayLine ColorStartupMsg, '| BINTOOL.CMD: Version ' || PGM_VERSION || ' (C)opyright Dennis Bareis 1998                |'
  2573. call DisplayLine ColorStartupMsg, '| http://www.labyrinth.net.au/~dbareis/index.htm (dbareis@labyrinth.net.au) |'
  2574. call DisplayLine ColorStartupMsg, '[]-------------------------------------------------------------------------[]'
  2575. say ''
  2576. return
  2577.  
  2578. HandleWhitespaceInCommand:
  2579. TheCmdLine = strip( translate(arg(1), ' ', Tab) )
  2580. TheCmdLine = strip( arg(1) )
  2581. if  TheCmdLine = '' then
  2582. return('')
  2583. if  left(TheCmdLine, 1) = ';' then
  2584. return('')
  2585. ColonColonPos = lastpos(ColonColon, TheCmdLine)
  2586. if  ColonColonPos <> 0 then
  2587. do
  2588. TheCmdLine = strip( left(TheCmdLine, ColonColonPos-1) )
  2589. end
  2590. return(TheCmdLine)
  2591.  
  2592. ProcessInteractiveCommands:
  2593. do while Interactive = 'Y'
  2594. if  CurrentFile = '' then
  2595. Prompt = '> '
  2596. else
  2597. Prompt = _filespec('name', CurrentFile) || ' @ ' || GetDisplayableCurrentOffset() || '> '
  2598. call charout , ColorPrompt || Prompt || ColorExecutingCommand
  2599. if  RexWhich = 'STANDARD_OS/2' then
  2600. UsersCmd = CmdLine("Insert", "Required")
  2601. else
  2602. UsersCmd = linein()
  2603. call charout , Reset
  2604. UsersCmd = HandleWhitespaceInCommand(UsersCmd)
  2605. if  UsersCmd = '' then
  2606. iterate
  2607. call RecordLine ''
  2608. call RecordLine UsersCmd
  2609. call ProcessOneCmd UsersCmd
  2610. end
  2611. return
  2612.  
  2613. ProcessWholeFile:
  2614. if  stream(ScriptFile, 'c', 'query exists') = '' then
  2615. UserSyntaxError('The script file "' || ScriptFile || '" does not exist')
  2616. CloseRc = stream(ScriptFile, 'c', 'close')
  2617. CloseRc = stream(ScriptFile, 'c', 'open Read')
  2618. CurrentLineNumber = 0
  2619. do  while lines(ScriptFile) <> 0
  2620. CurrentLine       = HandleWhitespaceInCommand( linein(ScriptFile) )
  2621. CurrentLineNumber = CurrentLineNumber + 1
  2622. if  CurrentLine = '' then
  2623. iterate
  2624. if  left(CurrentLine, 1) = ':' then
  2625. call SaveLabel     translate(substr(CurrentLine, 2))
  2626. else
  2627. call ProcessOneCmd CurrentLine
  2628. end
  2629. call IoError ScriptFile
  2630. CloseRc = stream(ScriptFile, 'c', 'close')
  2631. return
  2632.  
  2633. IsCommand:
  2634. FullCmd = arg(1)
  2635. Subset  = arg(2)
  2636. MinLng  = arg(3)
  2637. if  Interactive = 'Y' then
  2638. do
  2639. if  MinLng = '' then
  2640. MinLng = 0
  2641. if  abbrev(FullCmd, Subset, MinLng) = 1 then
  2642. return('Y')
  2643. else
  2644. return('N')
  2645. end
  2646. else
  2647. do
  2648. if  FullCmd == Subset then
  2649. return('Y')
  2650. else
  2651. return('N')
  2652. end
  2653.  
  2654. ProcessOneCmd:
  2655. TheLine = strip( ReplaceRexxVariables(arg(1)) )
  2656. parse var TheLine TheCmd ItsParameters
  2657. TheCmd        = translate(TheCmd)
  2658. ItsParameters = strip(ItsParameters)
  2659. if  OptionSeeCmds = 'Y' then
  2660. call DisplayLine ColorExecutingCommand, GetDisplayableCurrentOffset(6) || ' : ' || TheCmd || ' ' || ItsParameters
  2661. select
  2662. when IsCommand('WRITE', TheCmd) = 'Y' then
  2663. call WriteToFile ItsParameters
  2664. when IsCommand('VERIFY', TheCmd) = 'Y' then
  2665. call VerifyBytesInFile ItsParameters
  2666. when IsCommand('MOVETO', TheCmd) = 'Y' then
  2667. call ProcessCmdMoveTo ItsParameters
  2668. when IsCommand('GOTO', TheCmd) = 'Y' then
  2669. do
  2670. if  NotAllowedInInteractiveMode() <> '!' then
  2671. call GotoLabel ItsParameters
  2672. end
  2673. when TheCmd = 'OPENNEW' | TheCmd = 'OPENREAD' | TheCmd = 'OPEN' then
  2674. call ProcessCmdOpenFile TheCmd, ItsParameters
  2675. when IsCommand('CLOSE', TheCmd) = 'Y' then
  2676. call ProcessCmdCloseFile
  2677. when IsCommand('HEXADECIMAL', TheCmd) = 'Y' then
  2678. InHexMode = 'Y'
  2679. when IsCommand('DECIMAL', TheCmd, 2) = 'Y' then
  2680. InHexMode = 'N'
  2681. when IsCommand('VERIFYFILE', TheCmd, 7) = 'Y' then
  2682. call VerifyFileContents ItsParameters
  2683. when IsCommand('RECORD', TheCmd, 3) = 'Y' then
  2684. call ProcessRecordCommand ItsParameters
  2685. when IsCommand('FIND', TheCmd) = 'Y' then
  2686. call ProcessFindCommand ItsParameters, 'Y'
  2687. when IsCommand('FINDCS', TheCmd, 5) = 'Y' then
  2688. call ProcessFindCommand ItsParameters, 'N'
  2689. when IsCommand('LOCATE', TheCmd) = 'Y' then
  2690. call ProcessLocateCommand ItsParameters, 'M'
  2691. when IsCommand('LOCATE!', TheCmd, 7) = 'Y' then
  2692. call ProcessLocateCommand ItsParameters, 'N'
  2693. when IsCommand('REXX', TheCmd) = 'Y' then
  2694. do
  2695. if ItsParameters = '' then
  2696. call CommandFailure 'No parameters supplied on "REXX" command'
  2697. else
  2698. Dummy = InterpretExactCommand(ItsParameters)
  2699. end
  2700. when IsCommand('SYSTEM', TheCmd) = 'Y' then
  2701. do
  2702. if  ItsParameters = '' then
  2703. do
  2704. call AddressCmd '@CMD.EXE /K "cls & prompt BINTOOL $p$g$s'
  2705. SystemRc = Rc
  2706. end
  2707. else
  2708. do
  2709. call AddressCmd '@CMD.EXE /C ' || ItsParameters
  2710. SystemRc = Rc
  2711. call ProgressMsg 'Rc = ' || SystemRc
  2712. end
  2713. end
  2714. when IsCommand('DUMP', TheCmd) = 'Y' then
  2715. call ProcessCmdDump ItsParameters
  2716. when IsCommand('DUMPCHAR', TheCmd, 5) = 'Y' then
  2717. call ProcessDumpChar ItsParameters
  2718. when IsCommand('REBUILD', TheCmd, 3) = 'Y' then
  2719. call ProcessCmdRebuild ItsParameters
  2720. when IsCommand('ONERROR', TheCmd, 3) = 'Y' then
  2721. do
  2722. if  NotAllowedInInteractiveMode() <> '!' then
  2723. do
  2724. OnError = translate(ItsParameters)
  2725. return
  2726. end
  2727. end
  2728. when IsCommand('QUIT', TheCmd) = 'Y' | IsCommand('EXIT', TheCmd) = 'Y' | TheCmd = 'X' then
  2729. do
  2730. call OnlyAllowedInInteractiveMode
  2731. Interactive = 'N'
  2732. end
  2733. when TheCmd = '?' then
  2734. do
  2735. if  OnlyAllowedInInteractiveMode() <> '!' then
  2736. do
  2737. if  ItsParameters <> '' then
  2738. call ViewInf ItsParameters
  2739. else
  2740. call DisplayCommandSummary
  2741. end
  2742. end
  2743. when TheCmd = '??' | TheCmd = 'HELP' then
  2744. do
  2745. if  OnlyAllowedInInteractiveMode() <> '!' then
  2746. call ViewInf ItsParameters
  2747. end
  2748. otherwise
  2749. call CommandFailure 'Unknown Command of "' || TheCmd || '" specified.'
  2750. end
  2751. OnError = ''
  2752. return
  2753.  
  2754. DisplayCommandSummary:
  2755. say 'CLOSE            QUIT'
  2756. say 'DECIMAL          REBUILD'
  2757. say 'DUMP             RECORD'
  2758. say 'DUMPCHAR         REXX'
  2759. say 'GOTO             SYSTEM'
  2760. say 'FIND[CS]         VERIFY'
  2761. say 'HEXADECIMAL      VERIFYFILE'
  2762. say 'LOCATE[!]        WRITE'
  2763. say 'MOVETO           HELP'
  2764. say 'OPEN'
  2765. say 'OPENNEW'
  2766. say 'OPENREAD'
  2767. return
  2768.  
  2769. ViewInf:
  2770. call AddressCmd '@view.exe ' || ThisProgramDir || 'BINTOOL.INF ' || arg(1)
  2771. return
  2772.  
  2773. SetColorCodes:
  2774. EscapeChar             = d2c(27)
  2775. Reset                  = EscapeChar || '[0m'
  2776. ColorStartupMsg        = EscapeChar || '[1;33m'
  2777. ColorError             = EscapeChar || '[1;31m'
  2778. ColorProgress          = EscapeChar || '[32m'
  2779. ColorPrompt            = EscapeChar || '[1;33m'
  2780. ColorExecutingCommand  = EscapeChar || '[1;35m'
  2781. return
  2782.  
  2783. RemoveColorCodes:
  2784. Reset                  = ''
  2785. ColorStartupMsg        = ''
  2786. ColorError             = ''
  2787. ColorProgress          = ''
  2788. ColorPrompt            = ''
  2789. ColorExecutingCommand  = ''
  2790. return
  2791.  
  2792. PgmExit:
  2793. call CloseRecordFile
  2794. if  Dying = 'N' then
  2795. do
  2796. Dying = 'Y'
  2797. call ProcessCmdCloseFile
  2798. end
  2799. exit( arg(1) )
  2800.