home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / bt_98162.zip / BINTOOL.CMD next >
OS/2 REXX Batch file  |  1998-06-11  |  64KB  |  2,177 lines
  1. /*
  2.  * Pgm Name    : E:\DB\BATCH\CMD\PPWIZARD.CMD
  3.  * Pgm Version : 98.150
  4.  * Time        : Thursday, 11 Jun 1998  7:04:55pm
  5.  * Input File  : E:\DB\PROJECTS\OS2\bintool\BINTOOL.X
  6.  * Output File : .\OUT\BINTOOL.CMD
  7.  */
  8.  
  9. /*
  10. * $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  $
  11. */
  12. PGM_VERSION            = '98.162'
  13. OneBeep                = ''
  14. TwoBeep                = OneBeep || OneBeep
  15. call RxFuncAdd  'SysFileDelete', 'RexxUtil', 'SysFileDelete'
  16. Indent          = "        * "
  17. ExitRc          = 0
  18. Dying           = 'N'
  19. Tab             = d2c(9)
  20. ColonColon      = ';' || ';'
  21. LowerCase       = "abcdefghijklmnopqrstuvwxyz"
  22. UpperCase       = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
  23. AllLetters      = LowerCase || UpperCase
  24. trace off
  25. WhichRexx = 'STANDARD_OS/2'
  26. if WhichRexx = 'STANDARD_OS/2' then
  27. call SetColorCodes
  28. else
  29. call RemoveColorCodes
  30. /*
  31. * $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  $
  32. */
  33. signal EndOpenClosXh
  34. ProcessCmdOpenFile:
  35. OpenMode      = arg(1)
  36. NameOfNewFile = RemoveAnyQuotesAroundFilename(arg(2))
  37. CloseRc       = stream(NameOfNewFile, 'c', 'close')
  38. call ProcessCmdCloseFile
  39. if  OpenMode = "OPENNEW" then
  40. do
  41. if  CommandNeedsFileDeleted(NameOfNewFile) <> 0 then
  42. return
  43. end
  44. if  OpenMode = "OPENREAD" then
  45. OpenMode = 'open read'
  46. else
  47. OpenMode = 'open'
  48. CurrentFile = NameOfNewFile
  49. OpenRc      = stream(CurrentFile, 'c', OpenMode)
  50. if  left(OpenRc, 6) = 'READY:' then
  51. do
  52. FileLength = stream(CurrentFile, 'c', 'seek <0')
  53. SeekRc     = stream(CurrentFile, 'c', 'seek =1')
  54. call UpdateDumpAddress 0
  55. if  FileLength = '' then
  56. call ProgressMsg 'File Opened'
  57. else
  58. call ProgressMsg 'File Opened, ' || AddCommasToDecimalNumber(FileLength-1) || ' byte(s) in file.'
  59. end
  60. else
  61. do
  62. CloseRc     = stream(CurrentFile, 'c', 'close')
  63. call ProgressMsg 'Open failed (' || OpenRc || ')', ColorError
  64. CurrentFile = ''
  65. end
  66. return
  67. ProcessCmdCloseFile:
  68. if  CurrentFile <> '' then
  69. do
  70. if  Dying = 'N' then
  71. call IoError CurrentFile
  72. CloseRc     = stream(CurrentFile, 'c', 'close')
  73. CurrentFile = ''
  74. end
  75. return
  76. EndOpenClosXh:
  77. /*
  78. * $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  $
  79. */
  80. signal EndWriteXh
  81. WriteToFile:
  82. if  ExpectToHaveCurrentFile() = '!' then
  83. return
  84. ToWrite = InterpretCommand(arg(1))
  85. if  ToWrite = "!@#$DB$FAILED%$#" then
  86. return
  87. call charout CurrentFile, ToWrite
  88. call UpdateDumpAddress
  89. call IoError CurrentFile
  90. return
  91. InterpretCommand:
  92. ExecuteTheCommand = 'NewValue = ' || arg(1)
  93. signal ON SYNTAX   name InvalidRexxCommand
  94. signal ON NOVALUE  name InvalidRexxCommand
  95. interpret ExecuteTheCommand
  96. return(NewValue)
  97. InterpretExactCommand:
  98. signal ON SYNTAX   name InvalidRexxCommand
  99. signal ON NOVALUE  name InvalidRexxCommand
  100. interpret arg(1)
  101. return("OK")
  102. InvalidRexxCommand:
  103. if  condition('C') = 'NOVALUE' then
  104. call CommandFailure 'Incorrectly quoted string? (variable ' || condition('D') || ' is unknown)!'
  105. else
  106. call CommandFailure 'REXX Syntax error (' || errortext(Rc) || ')!'
  107. if  Interactive = 'Y' then
  108. return("!@#$DB$FAILED%$#")
  109. else
  110. PgmExit(ThisLineNumber())
  111. EndWriteXh:
  112. /*
  113. * $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  $
  114. */
  115. signal EndVerifyXh
  116. VerifyBytesInFile:
  117. if  ExpectToHaveCurrentFile() = '!' then
  118. return
  119. dStartAddress = GetCurrentSeekPositionInFile()
  120. if  dStartAddress = '!' then
  121. return
  122. ToVerify = InterpretCommand(arg(1))
  123. if  ToVerify = "!@#$DB$FAILED%$#" then
  124. return
  125. FromFile = charin(CurrentFile,, length(ToVerify))
  126. Dummy = GotoSpecificSeekPositionInFile(dStartAddress)
  127. CompareRc = compare(ToVerify, FromFile)
  128. if  CompareRc <> 0 then
  129. do
  130. call DumpValue  dStartAddress-1, FromFile
  131. call CommandFailure 'Verification Failed (difference starts at byte ' || CompareRc || ')'
  132. end
  133. call IoError CurrentFile
  134. return
  135. EndVerifyXh:
  136. /*
  137. * $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  $
  138. */
  139. signal EndVerifyfXh
  140. VerifyFileContents:
  141. if  MustNotHaveFileOpen() = '!' then
  142. return
  143. parse value arg(1) with '"'WhichFile'"' FileSize FileCrcInHex .
  144. if  WhichFile = '' then
  145. do
  146. call CommandFailure 'Could not determine file name (it must be in double quotes)!'
  147. return
  148. end
  149. if  stream(WhichFile, 'c', 'query exists') = '' then
  150. do
  151. call CommandFailure 'The file "' || WhichFile || '" does not exist!'
  152. return
  153. end
  154. call ProgressMsg 'File exists'
  155. if  FileSize = '' then
  156. return
  157. CloseRc    = stream(WhichFile, 'c', 'close')
  158. RealLength = stream(WhichFile, 'c', 'query size')
  159. call ProgressMsg 'File is ' || AddCommasToDecimalNumber(RealLength) || ' byte(s) long'
  160. if  RealLength <> FileSize then
  161. do
  162. call CommandFailure 'The file "' || WhichFile || '" is ' || AddCommasToDecimalNumber(RealLength) || ' bytes long.  We expected ' || AddCommasToDecimalNumber(FileSize) || ' bytes!'
  163. return
  164. end
  165. if  FileCrcInHex = '' then
  166. return
  167. FileCrcInHex = translate(FileCrcInHex)
  168. if  length(FileCrcInHex) <> 8 then
  169. do
  170. call CommandFailure 'Expected a full 8 character hexadecimal CRC (got "' || FileCrcInHex || '")'
  171. return
  172. end
  173. BytesToRead = FileSize
  174. Crc32       = Crc32PrePostConditioning()
  175. do  while BytesToRead > 0
  176. FromFile    = charin(WhichFile,, 4096)
  177. BytesToRead = BytesToRead - 4096
  178. Crc32 = UpdateCrc32(Crc32, FromFile)
  179. end
  180. Crc32 = Crc32PrePostConditioning(Crc32)
  181. Crc32 = Crc32InDisplayableForm(Crc32)
  182. call ProgressMsg 'Calculated a CRC of ' || Crc32
  183. IoRc    = IoError(WhichFile)
  184. CloseRc = stream(WhichFile, 'c', 'close')
  185. if  IoRc = 'Y' then
  186. return
  187. if  Crc32 <> FileCrcInHex then
  188. do
  189. call CommandFailure 'CRC of "' || Crc32 || '" does not match! We expected "' || FileCrcInHex || '"'
  190. return
  191. end
  192. return
  193. EndVerifyfXh:
  194. /*
  195. * $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  $
  196. */
  197. signal EndMoveToXh
  198. ProcessCmdMoveTo:
  199. if  ExpectToHaveCurrentFile() = '!' then
  200. return
  201. parse value arg(1) with SeekCmd SeekParms
  202. SeekCmd = translate(SeekCmd)
  203. BeforeMoveTo = GetCurrentSeekPositionInFile()
  204. if  BeforeMoveTo = '!' then
  205. return
  206. select
  207. when SeekCmd = 'START' then
  208. SeekParms = '=1'
  209. when SeekCmd = 'END' then
  210. SeekParms = '<0'
  211. when SeekCmd = '+' | SeekCmd = 'FORWARDS' then
  212. do
  213. if  SeekParms = '' then
  214. SeekParms = '1'
  215. MoveToValue = GetInteger(SeekParms)
  216. if  MoveToValue = '!' then
  217. do
  218. call CommandFailure 'Invalid value of "' || SeekParms || '" specified.'
  219. return
  220. end
  221. SeekParms = '=' || BeforeMoveTo + MoveToValue
  222. end
  223. when SeekCmd = '-' | SeekCmd = 'BACKWARDS' then
  224. do
  225. if  SeekParms = '' then
  226. SeekParms = '1'
  227. MoveToValue = GetInteger(SeekParms)
  228. if  MoveToValue = '!' then
  229. do
  230. call CommandFailure 'Invalid value of "' || SeekParms || '" specified.'
  231. return
  232. end
  233. NewLocation = BeforeMoveTo - MoveToValue
  234. if  NewLocation < 1 then
  235. do
  236. call CommandFailure "You can't move back " || SeekParms || ' from ' || GetDisplayableCurrentOffset() || '!'
  237. return
  238. end
  239. SeekParms = '=' || NewLocation
  240. end
  241. otherwise
  242. do
  243. if  SeekCmd = '' then
  244. do
  245. call CommandFailure 'Invalid MoveTo command of "' || SeekCmd || '" specified.'
  246. return
  247. end
  248. MoveToValue = GetInteger(SeekCmd)
  249. if  MoveToValue = '!' then
  250. do
  251. call CommandFailure 'Invalid value of "' || SeekCmd || '" specified.'
  252. return
  253. end
  254. MoveToValue = MoveToValue + 1
  255. SeekParms = '=' || MoveToValue
  256. end
  257. end
  258. CloseRc = stream(CurrentFile, 'c', 'close')
  259. OpenRc = stream(CurrentFile, 'c', OpenMode)
  260. if  left(OpenRc, 6) <> 'READY:' then
  261. do
  262. CurrentFile = ''
  263. call CommandFailure "Can't reopen file!"
  264. return
  265. end
  266. SeekRc = stream(CurrentFile, 'c', 'seek ' || SeekParms)
  267. if  datatype(SeekRc, 'Whole Number') = 0 then
  268. do
  269. if  SeekRc <> '' then
  270. SeekRc = ' (Reason=' || SeekRc || ')'
  271. call CommandFailure 'Seek failed' || SeekRc
  272. return
  273. end
  274. call IoError CurrentFile
  275. call UpdateDumpAddress
  276. return
  277. EndMoveToXh:
  278. /*
  279. * $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  $
  280. */
  281. /*
  282. * BIN2REXP.XH Version 98.149 by Dennis Bareis
  283. *            http://www.ozemail.com.au/~dbareis (db0@anz.com)
  284. */
  285. b2rNewSingleQuote = "' || " || '"' || "'" || '" || ' || "'"
  286. b2rAllHexCodes    = ''
  287. b2rAllAsciiCodes  = ''
  288. do b2rCharCode = 0 to 31
  289. b2rAllHexCodes = b2rAllHexCodes || d2c(b2rCharCode)
  290. end
  291. do b2rCharCode = 32 to 126
  292. b2rAllAsciiCodes = b2rAllAsciiCodes || d2c(b2rCharCode)
  293. end
  294. do b2rCharCode = 127 to 255
  295. b2rAllHexCodes = b2rAllHexCodes || d2c(b2rCharCode)
  296. end
  297. signal  EndBIN2REXPXh
  298. _QuoteAscii:
  299. b2rAscii2Quote = arg(1)
  300. if  pos("'", b2rAscii2Quote) = 0 then
  301. return("'" || b2rAscii2Quote || "'")
  302. else
  303. do
  304. if  pos('"', b2rAscii2Quote) = 0 then
  305. return('"' || b2rAscii2Quote || '"')
  306. else
  307. do
  308. return("'" || ReplaceString(b2rAscii2Quote, "'", b2rNewSingleQuote) || "'")
  309. end
  310. end
  311. _FormatHex:
  312. b2rHexString    = arg(1)
  313. b2rLengthHex    = length(b2rHexString)
  314. b2rFormattedHex = "'"
  315. if  b2rLengthHex > 7 then
  316. do
  317. b2rLeft1     = left(b2rHexString, 1)
  318. b2rLeft1Pos  = verify(b2rHexString, b2rLeft1)
  319. if  b2rLeft1Pos = 0 then
  320. return( "copies('" || c2x(b2rLeft1) || "'x, " || b2rLengthHex || ")" )
  321. else
  322. do
  323. if  b2rLeft1Pos > 7 then
  324. do
  325. b2rFormattedHex = "copies('" || c2x(b2rLeft1) || "'x, " || b2rLeft1Pos-1 || ") || '"
  326. b2rHexString    = substr(b2rHexString, b2rLeft1Pos)
  327. b2rLengthHex    = b2rLengthHex - (b2rLeft1Pos-1)
  328. end
  329. end
  330. end
  331. do  b2rCharPosn = 1 to b2rLengthHex
  332. if  (b2rCharPosn // 8) = 1 then
  333. do
  334. if  b2rCharPosn <> 1 then
  335. b2rFormattedHex = b2rFormattedHex || ' '
  336. end
  337. b2rFormattedHex = b2rFormattedHex || c2x(substr(b2rHexString, b2rCharPosn, 1))
  338. end
  339. b2rFormattedHex = b2rFormattedHex || "'x"
  340. return(b2rFormattedHex)
  341. _QuoteAsciiBreakIfRequired:
  342. qabAscii  = arg(1)
  343. qabLength = length(qabAscii)
  344. qabReturn = ''
  345. do  while qabLength > 256
  346. qabLeft   = left(qabAscii, 256)
  347. qabAscii  = substr(qabAscii, 256+1)
  348. qabLength = qabLength - 256
  349. if  qabReturn = '' then
  350. qabReturn = _QuoteAscii(qabLeft)
  351. else
  352. qabReturn = qabReturn || " || " || _QuoteAscii(qabLeft)
  353. end
  354. if  qabLength = 0 then
  355. return(qabReturn)
  356. else
  357. do
  358. if  qabReturn = '' then
  359. return( _QuoteAscii(qabAscii) )
  360. else
  361. return( qabReturn || " || " || _QuoteAscii(qabAscii) )
  362. end
  363. _FormatHexBreakIfRequired:
  364. fhbHex    = arg(1)
  365. fhbLength = length(fhbHex)
  366. fhbReturn = ''
  367. do  while fhbLength > 80
  368. fhbLeft   = left(fhbHex, 80)
  369. fhbHex    = substr(fhbHex, 80+1)
  370. fhbLength = fhbLength - 80
  371. if  fhbReturn = '' then
  372. fhbReturn = _FormatHex(fhbLeft)
  373. else
  374. fhbReturn = fhbReturn || " || " || _FormatHex(fhbLeft)
  375. end
  376. if  fhbLength = 0 then
  377. return(fhbReturn)
  378. else
  379. do
  380. if  fhbReturn = '' then
  381. return( _FormatHex(fhbHex) )
  382. else
  383. return( fhbReturn || " || " || _FormatHex(fhbHex) )
  384. end
  385. BIN2REXP:
  386. call BIN2REXP_START
  387. b2rValue       = arg(1)
  388. b2rValueLength = length(b2rValue)
  389. if  b2rValueLength = 0 then
  390. call BIN2REXP_ONEBIT  '""'
  391. else
  392. do
  393. do  while b2rValue \== ''
  394. b2rEndAsciiPos = verify(b2rValue, b2rAllAsciiCodes)
  395. if  b2rEndAsciiPos = 0 then
  396. do
  397. call BIN2REXP_ONEBIT _QuoteAsciiBreakIfRequired(b2rValue)
  398. b2rValue = ''
  399. end
  400. else
  401. do
  402. if  b2rEndAsciiPos <> 1 then
  403. do
  404. call BIN2REXP_ONEBIT _QuoteAsciiBreakIfRequired(left(b2rValue, b2rEndAsciiPos-1))
  405. b2rValue = substr(b2rValue, b2rEndAsciiPos)
  406. end
  407. else
  408. do
  409. b2rEndBinaryPos = verify(b2rValue, b2rAllHexCodes)
  410. if  b2rEndBinaryPos = 0 then
  411. do
  412. call BIN2REXP_ONEBIT _FormatHexBreakIfRequired(b2rValue)
  413. b2rValue = ''
  414. end
  415. else
  416. do
  417. call BIN2REXP_ONEBIT _FormatHexBreakIfRequired(left(b2rValue, b2rEndBinaryPos-1))
  418. b2rValue = substr(b2rValue, b2rEndBinaryPos)
  419. end
  420. end
  421. end
  422. end
  423. end
  424. call BIN2REXP_END
  425. return
  426. EndBIN2REXPXh:
  427. signal EndRebuildXh
  428. BIN2REXP_START:
  429. return
  430. BIN2REXP_ONEBIT:
  431. if  pos(ColonColon, arg(1)) = 0 then
  432. call lineout RebuildCmdFile, "WRITE   " || arg(1)
  433. else
  434. call lineout RebuildCmdFile, "WRITE   " || arg(1) || '    ;' || ";Warning Leave this!"
  435. return
  436. BIN2REXP_END:
  437. call IoError RebuildCmdFile
  438. CloseRc = stream(RebuildCmdFile, 'c', 'close')
  439. return
  440. ProcessCmdRebuild:
  441. if  ExpectToHaveCurrentFile() = '!' then
  442. return
  443. RebuildCmdFile = RemoveAnyQuotesAroundFilename(arg(1))
  444. if  CommandNeedsFileDeleted(RebuildCmdFile) <> 0 then
  445. return
  446. call lineout RebuildCmdFile, ';' || copies('-', 78)
  447. call lineout RebuildCmdFile, '; Automatically Generated (' || date('Normal') || ' at ' || GetAmPmTime() || ' by BINTOOL version ' || PGM_VERSION || ')'
  448. call lineout RebuildCmdFile, ';' || copies('-', 78)
  449. call lineout RebuildCmdFile, ''
  450. call lineout RebuildCmdFile, ';Source Details'
  451. call lineout RebuildCmdFile, ';~~~~~~~~~~~~~~~'
  452. call lineout RebuildCmdFile, ';Source File : ' || stream(CurrentFile, 'c', 'query exists')
  453. call lineout RebuildCmdFile, ';Source Size : ' || AddCommasToDecimalNumber( stream(CurrentFile, 'c', 'query size') )
  454. call lineout RebuildCmdFile, ';Source Time : ' || stream(CurrentFile, 'c', 'query datetime')
  455. call lineout RebuildCmdFile, ';Start Offset: ' || GetDisplayableCurrentOffset()
  456. call lineout RebuildCmdFile, ''
  457. call lineout RebuildCmdFile, ''
  458. call lineout RebuildCmdFile, "OpenNew " || CurrentFile
  459. DumpWhat = charin(CurrentFile,, 99999999)
  460. call BIN2REXP DumpWhat
  461. call UpdateDumpAddress 0
  462. call lineout RebuildCmdFile, "Close"
  463. call IoError RebuildCmdFile
  464. CloseRc = stream(RebuildCmdFile, 'c', 'close')
  465. return
  466. EndRebuildXh:
  467. /*
  468. * $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  $
  469. */
  470. DumpFrom = 0
  471. call SetDumpCharToDefault
  472. signal EndDumpXh
  473. UpdateDumpAddress:
  474. DumpFrom = arg(1)
  475. if  DumpFrom = '' then
  476. do
  477. NewDumpFrom = GetCurrentSeekPositionInFile()
  478. if  NewDumpFrom = '!' then
  479. return
  480. DumpFrom = NewDumpFrom - 1
  481. end
  482. return
  483. SetDumpCharToDefault:
  484. do Char = 0 to 31
  485. DumpArray.Char = '.'
  486. end
  487. do Char = 32 to 126
  488. DumpArray.Char = d2c(Char)
  489. end
  490. do Char = 127 to 255
  491. DumpArray.Char = '.'
  492. end
  493. return
  494. ProcessDumpChar:
  495. NewSetFile = RemoveAnyQuotesAroundFilename(arg(1))
  496. if  NewSetFile = '' then
  497. do
  498. call SetDumpCharToDefault
  499. call ProgressMsg 'Restored default dump character set.'
  500. return
  501. end
  502. DotPos = pos('.', filespec('name', NewSetFile))
  503. if  DotPos = 0 then
  504. NewSetFile = NewSetFile || '.TBL'
  505. FullName = stream(NewSetFile, 'c', 'query exists')
  506. if  FullName = '' then
  507. do
  508. SlashPos = pos('\', NewSetFile)
  509. if  SlashPos = 0 then
  510. do
  511. FullName = ThisProgramDir || NewSetFile
  512. FullName = stream(FullName, 'c', 'query exists')
  513. end
  514. if  FullName = '' then
  515. do
  516. call CommandFailure 'The file "' || NewSetFile || '" does not exist.'
  517. return
  518. end
  519. end
  520. CloseRc  = stream(FullName, 'c', 'close')
  521. FromFile = charin(FullName,, 9)
  522. if  FromFile <> "DUMPCHAR|" then
  523. do
  524. CloseRc  = stream(FullName, 'c', 'close')
  525. call CommandFailure 'The specified file does not have a valid header.'
  526. return
  527. end
  528. FromFile = charin(FullName,, 9999)
  529. IoRc    = IoError(FullName)
  530. CloseRc = stream(FullName, 'c', 'close')
  531. if  IoRc = 'Y' then
  532. return
  533. parse var FromFile Description'|'CharSet
  534. if  length(CharSet) <> 256 then
  535. do
  536. call CommandFailure 'A dump character set must be 256 bytes long (not ' || AddCommasToDecimalNumber(length(CharSet)) || ')'
  537. return
  538. end
  539. do  Char = 0 to 255
  540. DumpArray.Char = substr(CharSet, Char+1, 1)
  541. end
  542. call ProgressMsg 'Dump character set updated (' || strip(Description) || ')'
  543. return
  544. ProcessCmdDump:
  545. if  ExpectToHaveCurrentFile() = '!' then
  546. return
  547. StartAddress = GetCurrentSeekPositionInFile()
  548. if  StartAddress = '!' then
  549. return
  550. if  arg(1) = '' then
  551. DumpLength = 16 * 6
  552. else
  553. do
  554. DumpLength = GetInteger(arg(1))
  555. if  DumpLength = '!' then
  556. do
  557. call CommandFailure 'Invalid value of "' || arg(1) || '" specified.'
  558. return
  559. end
  560. end
  561. SeekRc = GotoSpecificSeekPositionInFile(DumpFrom+1)
  562. if  SeekRc = '!' then
  563. return
  564. DumpWhat = charin(CurrentFile,, DumpLength)
  565. if  IoError(CurrentFile) = 'Y' then
  566. return
  567. call DumpValue  DumpFrom, DumpWhat
  568. DumpFrom = DumpFrom + DumpLength
  569. Dummy = GotoSpecificSeekPositionInFile(StartAddress)
  570. return
  571. _ShowDebugLine:
  572. sdLine = dvAddressBit || left(dvHexStr, 41) || '  | ' || dvAsciiStr || ' |'
  573. say sdLine
  574. if  RecordFile <> '' then
  575. call RecordLine ';' || Indent || sdLine
  576. return
  577. DumpValue:
  578. dvAddress  = arg(1)
  579. dvValue    = arg(2)
  580. dvValueLng = length(dvValue)
  581. dvMaxAddress = dvAddress + dvValueLng
  582. if  InHexMode = 'N' then
  583. dvAddressWidth = length(dvMaxAddress)
  584. else
  585. dvAddressWidth = length(d2x(dvMaxAddress))
  586. dvAsciiStr   = ""
  587. dvHexStr     = ""
  588. dvWantSpace  = 'Y'
  589. dvAddressBit = ''
  590. do dvCharPosn = 1 to dvValueLng
  591. if dvCharPosn // 16 = 1 then
  592. do
  593. if  dvAsciiStr \== "" then
  594. do
  595. call _ShowDebugLine
  596. dvAsciiStr  = ""
  597. dvHexStr    = ""
  598. dvWantSpace = 'Y'
  599. end
  600. if  InHexMode = 'N' then
  601. dvThisAddress = dvAddress
  602. else
  603. dvThisAddress = d2x(dvAddress)
  604. dvAddressBit = right(dvThisAddress, dvAddressWidth) || ':'
  605. dvAddress = dvAddress + 16
  606. end
  607. dvCharacter  = substr(dvValue, dvCharPosn, 1)
  608. CharHexValue = c2x(dvCharacter)
  609. if  dvWantSpace = 'Y' then
  610. do
  611. dvHexStr    = dvHexStr || ' ' || CharHexValue
  612. dvWantSpace = 'N'
  613. end
  614. else
  615. do
  616. dvHexStr    = dvHexStr || CharHexValue
  617. dvWantSpace = 'Y'
  618. end
  619. CharValue    = c2d(dvCharacter)
  620. dvAsciiStr     = dvAsciiStr || DumpArray.CharValue
  621. end
  622. if  dvAsciiStr \== "" then
  623. call _ShowDebugLine
  624. return
  625. EndDumpXh:
  626. /*
  627. * $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  $
  628. */
  629. RecordFile  = ''
  630. signal EndRecordfXh
  631. RecordLine:
  632. if  RecordFile <> '' then
  633. do
  634. call lineout RecordFile, arg(1)
  635. IoRc = IoError(RecordFile)
  636. end
  637. return
  638. CloseRecordFile:
  639. if  RecordFile <> '' then
  640. do
  641. CloseRc = stream(RecordFile, 'c', 'close')
  642. RecordFile = ''
  643. end
  644. return
  645. ProcessRecordCommand:
  646. if  OnlyAllowedInInteractiveMode() = '!' then
  647. return
  648. NewRecordFile = RemoveAnyQuotesAroundFilename(arg(1))
  649. if  NewRecordFile = '' then
  650. do
  651. if  RecordFile = '' then
  652. call ProgressMsg 'Recording was already off!'
  653. else
  654. call ProgressMsg 'Recording now turned off!'
  655. call CloseRecordFile
  656. end
  657. else
  658. do
  659. call CloseRecordFile
  660. call CommandNeedsFileDeleted NewRecordFile
  661. RecordFile = NewRecordFile
  662. call RecordLine ';' || copies('-', 78)
  663. call RecordLine '; Automatically Generated (' || date('Normal') || ' at ' || GetAmPmTime() || ' by BINTOOL version ' || PGM_VERSION || ')'
  664. call RecordLine ';' || copies('-', 78)
  665. call RecordLine ''
  666. end
  667. return
  668. EndRecordfXh:
  669. /*
  670. * $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  $
  671. */
  672. signal EndFindXh
  673. ProcessFindCommand:
  674. if  ExpectToHaveCurrentFile() = '!' then
  675. return
  676. ToFind          = arg(1)
  677. CaseInsensitive = arg(2)
  678. FindRestoreToRel1 = GetCurrentSeekPositionInFile()
  679. if  FindRestoreToRel1 = '!' then
  680. return
  681. ToFind = InterpretCommand(arg(1))
  682. if  ToFind = "!@#$DB$FAILED%$#" then
  683. return
  684. if  CaseInsensitive = 'N' then
  685. call ProgressMsg 'Case sensitive search.'
  686. else
  687. do
  688. if  verify(ToFind, AllLetters, 'M') <> 0 then
  689. call ProgressMsg 'Case insensitive search.'
  690. else
  691. do
  692. call ProgressMsg 'Case insensitive search requested (doing faster sensitive search).'
  693. CaseInsensitive = 'N'
  694. end
  695. end
  696. ToFindLng = length(ToFind)
  697. call ProgressMsg 'Looking for ' || ToFindLng || ' bytes starting from current location.'
  698. if  CaseInsensitive = 'Y' then
  699. ToFind = translate(ToFind)
  700. StartingAddressRel1 = FindRestoreToRel1
  701. SearchIn            = ''
  702. Found               = 'N'
  703. do  while chars(CurrentFile) <> 0
  704. if  CaseInsensitive = 'Y' then
  705. FromFile = translate( charin(CurrentFile,, 40960) )
  706. else
  707. FromFile = charin(CurrentFile,, 40960)
  708. FromFileLng = length(FromFile)
  709. SearchIn    = SearchIn || FromFile
  710. FoundPos = pos(ToFind, SearchIn)
  711. if  FoundPos <> 0 then
  712. do
  713. FindRestoreToRel1 = StartingAddressRel1 + (FoundPos - 1)
  714. call UpdateDumpAddress FindRestoreToRel1-1
  715. call ProgressMsg 'Found match at ' || ConvertDecimalToCurrentBase(FindRestoreToRel1-1)
  716. Found = 'Y'
  717. leave
  718. end
  719. DropLeftNum         = length(SearchIn) - ToFindLng
  720. SearchIn            = right(SearchIn, ToFindLng)
  721. StartingAddressRel1 = StartingAddressRel1 + DropLeftNum
  722. end
  723. Dummy = GotoSpecificSeekPositionInFile(FindRestoreToRel1)
  724. if  Found = 'N' then
  725. do
  726. call CommandFailure 'The search string was not found!'
  727. return
  728. end
  729. call IoError CurrentFile
  730. return
  731. EndFindXh:
  732. /*
  733. * $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  $
  734. */
  735. signal EndLocateXh
  736. ProcessLocateCommand:
  737. if  ExpectToHaveCurrentFile() = '!' then
  738. return
  739. ToLocate   = arg(1)
  740. VerifyType = arg(2)
  741. LocateRestoreToRel1 = GetCurrentSeekPositionInFile()
  742. if  LocateRestoreToRel1 = '!' then
  743. return
  744. ToLocate = InterpretCommand(arg(1))
  745. if  ToLocate = "!@#$DB$FAILED%$#" then
  746. return
  747. if  VerifyType = 'M' then
  748. call ProgressMsg 'Locating first byte that is in the supplied list.'
  749. else
  750. call ProgressMsg 'Locating first byte that is NOT in the supplied list.'
  751. StartingAddressRel1 = LocateRestoreToRel1
  752. Found               = 'N'
  753. do  while chars(CurrentFile) <> 0
  754. FromFile    = charin(CurrentFile,, 40960)
  755. FromFileLng = length(FromFile)
  756. FoundPos = verify(FromFile, ToLocate, VerifyType)
  757. if  FoundPos <> 0 then
  758. do
  759. LocateRestoreToRel1 = StartingAddressRel1 + (FoundPos - 1)
  760. call UpdateDumpAddress LocateRestoreToRel1-1
  761. call ProgressMsg 'Found match at ' || ConvertDecimalToCurrentBase(LocateRestoreToRel1-1)
  762. Found = 'Y'
  763. leave
  764. end
  765. StartingAddressRel1 = StartingAddressRel1 + FromFileLng
  766. end
  767. Dummy = GotoSpecificSeekPositionInFile(LocateRestoreToRel1)
  768. if  Found = 'N' then
  769. do
  770. call CommandFailure 'The locate failed to find what you were after!'
  771. return
  772. end
  773. call IoError CurrentFile
  774. return
  775. EndLocateXh:
  776. /*
  777. * $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  $
  778. */
  779. LabelsToLine = 0
  780. signal EndLabelsXh
  781. SaveLabel:
  782. if  CurrentLineNumber <= LabelsToLine then
  783. return
  784. LabelsToLine = CurrentLineNumber
  785. if  symbol("LabelCL." || arg(1)) = 'VAR' then
  786. do
  787. call CommandFailure 'Label "' || arg(1) || '" has been reused on line ' || CurrentLineNumber
  788. return
  789. end
  790. interpret "LabelCL." || arg(1) || '= CurrentLineNumber'
  791. slSeekAddress = stream(ScriptFile, 'c', 'seek')
  792. if  datatype(slSeekAddress, 'Whole Number') = 0 then
  793. do
  794. call CommandFailure "Can't determine current seek address of the script" || ' "' || ScriptFile || '"'
  795. return
  796. end
  797. interpret "LabelSP." || arg(1) || '= slSeekAddress'
  798. return
  799. GotoLabel:
  800. glLabelName = translate( strip(arg(1)) )
  801. glLineNumSym = "LabelCL." || glLabelName
  802. if  symbol(glLineNumSym) = 'VAR' then
  803. do
  804. interpret 'CurrentLineNumber = '         || glLineNumSym
  805. interpret 'SeekTo            = LabelSP.' || glLabelName
  806. SeekRc = stream(ScriptFile, 'c', 'seek =' || SeekTo)
  807. if  datatype(SeekRc, 'Whole Number') = 0 then
  808. do
  809. if  SeekRc <> '' then
  810. SeekRc = ' (Reason=' || SeekRc || ')'
  811. call CommandFailure 'Seek to label "' || glLabelName || '" failed' || SeekRc
  812. return('!')
  813. end
  814. return('')
  815. end
  816. else
  817. do
  818. StartedLookingAtLine  = CurrentLineNumber
  819. do  while lines(ScriptFile) <> 0
  820. CurrentLine       = HandleWhitespaceInCommand( linein(ScriptFile) )
  821. CurrentLineNumber = CurrentLineNumber + 1
  822. if  left(CurrentLine, 1) = ':' then
  823. do
  824. ThisLabel = translate( substr(CurrentLine, 2) )
  825. call SaveLabel ThisLabel
  826. if  ThisLabel = glLabelName then
  827. return('')
  828. end
  829. end
  830. call IoError ScriptFile
  831. CloseRc = stream(ScriptFile, 'c', 'close')
  832. CurrentLineNumber = StartedLookingAtLine
  833. call CommandFailure 'The label "' || glLabelName || '" could not be located.'
  834. return('!')
  835. end
  836. EndLabelsXh:
  837. /*
  838. * $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  $
  839. */
  840. signal EndUsefulXh
  841. B2C:
  842. Binary:
  843. return( x2c(b2x(arg(1))) )
  844. EOL:
  845. return('0D0A'x)
  846. CurrentOffset:
  847. if  ExpectToHaveCurrentFile() = '!' then
  848. return('!')
  849. coOffset = GetCurrentSeekPositionInFile()
  850. if  coOffset <> '!' then
  851. coOffset = coOffset - 1
  852. return(coOffset)
  853. GetEnv:
  854. return( value(arg(1),,'OS2ENVIRONMENT') )
  855. ReplaceString:
  856. TheString    = arg(1)
  857. ChangeFrom   = arg(2)
  858. ChangeTo     = arg(3)
  859. ChangeCntVar = arg(4)
  860. ChangeFromLength = length(ChangeFrom)
  861. ChangeToLength   = length(ChangeTo)
  862. FoundPosn = pos(ChangeFrom, TheString)
  863. ReplaceStringCounter = 0
  864. do  while FoundPosn <> 0
  865. TheString = left(TheString, FoundPosn-1) || ChangeTo || substr(TheString, FoundPosn+ChangeFromLength)
  866. FoundPosn = pos(ChangeFrom, TheString, FoundPosn+ChangeToLength)
  867. ReplaceStringCounter = ReplaceStringCounter + 1
  868. end
  869. if  ChangeCntVar <> "" then
  870. interpret ChangeCntVar || " = ReplaceStringCounter + " || ChangeCntVar
  871. return(TheString)
  872. AddCommasToDecimalNumber: procedure
  873. NoComma = strip( arg(1) )
  874. if  pos(',', NoComma) <> 0 then
  875. return(NoComma)
  876. DotPos = pos('.', NoComma)
  877. if  DotPos = 0 then
  878. AfterDecimal = ''
  879. else
  880. do
  881. if  DotPos = 1 then
  882. return("0" || NoComma)
  883. AfterDecimal = substr(NoComma, DotPos+1)
  884. NoComma      = left(NoComma, DotPos-1)
  885. end
  886. NoComma = reverse(NoComma)
  887. ResultWithCommas = ""
  888. do  while length(NoComma) > 3
  889. ResultWithCommas = ResultWithCommas || left(NoComma, 3) || ','
  890. NoComma          = substr(NoComma, 4)
  891. end
  892. ResultWithCommas = ResultWithCommas || NoComma
  893. ResultWithCommas = reverse(ResultWithCommas)
  894. if  AfterDecimal <> '' then
  895. ResultWithCommas = ResultWithCommas || '.' || AfterDecimal
  896. return(ResultWithCommas)
  897. EndUsefulXh:
  898. /*
  899. * $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  $
  900. */
  901. signal EndOptionsXh
  902. SwitchMustNotHaveOptions:
  903. TheCmd     = arg(1)
  904. TheOptions = arg(2)
  905. Value2Set  = arg(3)
  906. if  TheOptions <> '' then
  907. UserSyntaxError('No parameters are expected for the "' || TheCmd || '" command!')
  908. return(Value2Set)
  909. SwitchOptionsValidateAgainstList:
  910. TheCmd    = arg(1)
  911. TheOption = translate(arg(2))
  912. ValidList = ',' || translate(arg(3)) || ','
  913. if  pos(',' || TheOption || ',', ValidList) <> 0 then
  914. return(TheOption)
  915. UserSyntaxError('An invalid parameter of "' || TheOption || '" was specified on the "' || TheCmd || '" command!')
  916. SwitchWantsYesOrNo:
  917. TheCmd    = arg(1)
  918. TheOption = translate(arg(2))
  919. Default   = arg(3)
  920. if  TheOption = '' then
  921. return(Default)
  922. else
  923. return( left(SwitchOptionsValidateAgainstList(TheCmd, TheOption, "Y,N,YES,NO"), 1) )
  924. NotAvailableUnderNtYet:
  925. TheCmd = arg(1)
  926. if  WhichRexx = 'REGINA' then
  927. UserSyntaxError('"' || TheCmd || '" can not be performed under NT (or regina).... Yet...')
  928. return
  929. EndOptionsXh:
  930. /*
  931. * $Header:   E:/DB/PVCS.IT/OS2/REXXHDR/GETRESP.XHV   1.1   01 Jun 1998 17:57:56   Dennis_Bareis  $
  932. */
  933. GetRespVer = "98.152"
  934. call RxFuncAdd  'SysCurPos', 'RexxUtil', 'SysCurPos'
  935. call RxFuncAdd  'SysGetKey', 'RexxUtil', 'SysGetKey'
  936. CursorTAvailable  = 'Y'
  937. trace off
  938. CurrentCursorMode = -1
  939. signal SkipOver_GETRESP
  940. GetKeyFromUser:
  941. if  CursorTAvailable = 'Y' then
  942. do
  943. WantedCursorMode = !CmdLine.History.insert
  944. if  WantedCursorMode <> CurrentCursorMode then
  945. do
  946. if  WantedCursorMode = "0" then
  947. CursorSize = "0 15"
  948. else
  949. CursorSize = "13 15"
  950. address cmd '@CursorT.EXE ' || CursorSize || ' >nul 2>&1'
  951. if  Rc = 0 then
  952. CurrentCursorMode = WantedCursorMode
  953. else
  954. CursorTAvailable = 'N'
  955. end
  956. end
  957. return( SysGetKey("NoEcho") )
  958. GetRespErrorBeep:
  959. call beep 400, 50
  960. return
  961. CmdLineProcedure: procedure expose !history. CurrentCursorMode
  962. CmdLine:
  963. CmdLine.Hidden=0
  964. CmdLine.History=1
  965. CmdLine.Keep=1
  966. CmdLine.SameLine=0
  967. CmdLine.Required=0
  968. CmdLine.Reset=0
  969. CmdLine.Valid=xrange()
  970. CmdLine.Upper=0
  971. CmdLine.Lower=0
  972. CmdLine.Width=0
  973. CmdLine.AutoSkip=0
  974. /* DB$ */ EscapeCancels = 0; InitialValue = ""
  975. parse value SysCurPos() with x y
  976. do i=1 to arg()
  977. cmd=translate(left(arg(i),1))
  978. parm=""
  979. if pos("=",arg(i))\=0 then
  980. parse value arg(i) with ."="parm
  981. select
  982. when arg(i)="~Esc~" then
  983. EscapeCancels=1
  984. when cmd="B" then
  985. do
  986. parse value SysCurPos() with x y
  987. if parm="" then
  988. do
  989. i = i + 1
  990. parm=arg(i)
  991. end
  992. InitialValue = parm
  993. end
  994. when cmd="X" then
  995. do
  996. parse value SysCurPos() with x y
  997. if parm="" then
  998. do;i=i+1;parm=arg(i);end
  999. if datatype(parm,"W") then
  1000. Call SysCurPos parm,y
  1001. end
  1002. when cmd="Y" then
  1003. do
  1004. parse value SysCurPos() with x y
  1005. if parm="" then
  1006. do;i=i+1;parm=arg(i);end
  1007. if datatype(parm,"W") then
  1008. Call SysCurPos x,parm
  1009. end
  1010. when cmd="T" then
  1011. do
  1012. if parm="" then
  1013. do;i=i+1;parm=arg(i);end
  1014. call charout, parm
  1015. end
  1016. when cmd="H" then
  1017. do
  1018. CmdLine.Hidden=1
  1019. CmdLine.Keep=0
  1020. CmdLine.History=0
  1021. end
  1022. when cmd="C" then
  1023. CmdLine.Reset=1
  1024. when cmd="O" then
  1025. !CmdLine.History.insert = 0
  1026. when cmd="I" then
  1027. !CmdLine.History.insert = 1
  1028. when cmd="F" then
  1029. CmdLine.Keep=0
  1030. when cmd="S" then
  1031. CmdLine.SameLine=1
  1032. when cmd="R" then
  1033. CmdLine.Required=1
  1034. when cmd="V" then
  1035. do
  1036. if parm="" then
  1037. do;i=i+1;parm=arg(i);end
  1038. CmdLine.Valid=parm
  1039. CmdLine.History=0
  1040. CmdLine.Keep=0
  1041. end
  1042. when cmd="U" then
  1043. do; CmdLine.Upper=1; CmdLine.Lower=0; CmdLine.History=0; CmdLine.Keep=0; end
  1044. when cmd="L" then
  1045. do; CmdLine.Upper=0; CmdLine.Lower=1; CmdLine.History=0; CmdLine.Keep=0; end
  1046. when cmd="A" then
  1047. CmdLine.AutoSkip=1
  1048. when cmd="W" then
  1049. do
  1050. if parm="" then
  1051. do;i=i+1;parm=arg(i);end
  1052. CmdLine.Width=parm
  1053. if \datatype(CmdLine.Width,"Whole") then CmdLine.Width=0
  1054. if CmdLine.Width<0 then CmdLine.Width=0
  1055. CmdLine.History=0
  1056. CmdLine.Keep=0
  1057. end
  1058. otherwise nop
  1059. end
  1060. end
  1061. if CmdLine.Width=0 then CmdLine.AutoSkip=0
  1062. if CmdLine.Reset then
  1063. do
  1064. drop !CmdLine.History.
  1065. return ""
  1066. end
  1067. if symbol("!CmdLine.History.0")="LIT" then
  1068. !CmdLine.History.0=0
  1069. if symbol("!CmdLine.History.insert")="LIT" then
  1070. !CmdLine.History.insert = 1
  1071. word = InitialValue
  1072. if word <> "" then
  1073. call charout, word
  1074. pos = length(word)
  1075. historical=-1
  1076. TheKey = GetKeyFromUser()
  1077. do forever
  1078. if TheKey=d2c(13) then
  1079. if CmdLine.Required & word="" then
  1080. call GetRespErrorBeep
  1081. else
  1082. leave
  1083. else if (TheKey=d2c(8)) then
  1084. do
  1085. if  pos = 0 then
  1086. call GetRespErrorBeep
  1087. else
  1088. do
  1089. word=delstr(word,pos,1)
  1090. call rubout 1
  1091. pos=pos-1
  1092. if pos<length(word) then
  1093. do
  1094. if  \CmdLine.Hidden then
  1095. call charout, substr(word,pos+1)||" "
  1096. else
  1097. call charout, copies("*",length(substr(word,pos+1)))||" "
  1098. call charout, copies(d2c(8),length(word)-pos+1)
  1099. end
  1100. end
  1101. end
  1102. else if TheKey=d2c(27) then
  1103. do
  1104. if   EscapeCancels then
  1105. do
  1106. if  word == '' then
  1107. do
  1108. word="~Esc~"
  1109. pos=0
  1110. leave
  1111. end
  1112. end
  1113. historical=-1
  1114. if pos<length(word) then
  1115. do
  1116. if \CmdLine.Hidden then
  1117. call charout, substr(word,pos+1)
  1118. else
  1119. call charout, copies("*",length(substr(word,pos+1)))
  1120. end
  1121. call rubout length(word)
  1122. word=""
  1123. pos=0
  1124. /*
  1125. *if pos<length(word) then
  1126. *    if \CmdLine.Hidden then call charout, substr(word,pos+1)
  1127. *    else call charout, copies("*",length(substr(word,pos+1)))
  1128. * call rubout length(word)
  1129. * word=""
  1130. * pos=0
  1131. */
  1132. end
  1133. else if TheKey=d2c(10) | TheKey=d2c(9) then
  1134. nop
  1135. else if TheKey=d2c(224) | TheKey=d2c(0) then
  1136. do
  1137. key2 = GetKeyFromUser()
  1138. select
  1139. when key2=d2c(59) then
  1140. if (CmdLine.History) & (!CmdLine.History.0<>0) then
  1141. do
  1142. if  symbol('search')='LIT' then
  1143. search=word
  1144. if  symbol('LastFind')='LIT' then
  1145. search=word
  1146. else
  1147. do
  1148. if  LastFind\=word then
  1149. search=word
  1150. end
  1151. if  historical=-1 then
  1152. start=!CmdLine.History.0
  1153. else
  1154. start=historical-1
  1155. if  start=0 then
  1156. start=!CmdLine.History.0
  1157. found=0
  1158. do i=start to 1 by -1
  1159. if abbrev(!CmdLine.History.i,search) then
  1160. do
  1161. found=1
  1162. historical=i
  1163. LastFind=!CmdLine.History.i
  1164. leave
  1165. end
  1166. end
  1167. if found then
  1168. do
  1169. if pos<length(word) then
  1170. do
  1171. if  \CmdLine.Hidden then
  1172. call charout, substr(word,pos+1)
  1173. else
  1174. call charout, copies("*",length(substr(word,pos+1)))
  1175. end
  1176. call rubout length(word)
  1177. word=!CmdLine.History.historical
  1178. pos=length(word)
  1179. if   \CmdLine.Hidden then
  1180. call charout, word
  1181. else
  1182. call charout, copies("*",length(word))
  1183. end
  1184. end
  1185. when key2=d2c(72) then
  1186. if (CmdLine.History) & (!CmdLine.History.0<>0) then
  1187. do
  1188. if historical=-1 then
  1189. historical=!CmdLine.History.0
  1190. else historical=historical-1
  1191. if historical=0 then
  1192. historical=!CmdLine.History.0
  1193. if pos<length(word) then
  1194. if \CmdLine.Hidden then call charout, substr(word,pos+1)
  1195. else call charout, copies("*",length(substr(word,pos+1)))
  1196. call rubout length(word)
  1197. word=!CmdLine.History.historical
  1198. pos=length(word)
  1199. if \CmdLine.Hidden then call charout, word
  1200. else call charout, copies("*",length(word))
  1201. end
  1202. when key2=d2c(80) then
  1203. if (CmdLine.History) & (!CmdLine.History.0<>0) then
  1204. do
  1205. if historical=-1 then
  1206. historical=1
  1207. else historical=historical+1
  1208. if historical>!CmdLine.History.0 then
  1209. historical=1
  1210. if pos<length(word) then
  1211. if \CmdLine.Hidden then call charout, substr(word,pos+1)
  1212. else call charout, copies("*",length(substr(word,pos+1)))
  1213. call rubout length(word)
  1214. word=!CmdLine.History.historical
  1215. pos=length(word)
  1216. if \CmdLine.Hidden then call charout, word
  1217. else call charout, copies("*",length(word))
  1218. end
  1219. when key2=d2c(75) then
  1220. if pos>0 then
  1221. do
  1222. call Charout, d2c(8)
  1223. pos=pos-1
  1224. end
  1225. when key2=d2c(77) then
  1226. if pos<length(word) then
  1227. do
  1228. if \CmdLine.Hidden then call Charout, substr(word,pos+1,1)
  1229. else call charout, "*"
  1230. pos=pos+1
  1231. end
  1232. when key2=d2c(115) then
  1233. if pos>0 then
  1234. do
  1235. call charout, d2c(8)
  1236. pos=pos-1
  1237. do forever
  1238. if pos=0 then leave
  1239. if substr(word,pos+1,1)\==" " & substr(word,pos,1)==" " then
  1240. leave
  1241. else
  1242. do
  1243. call charout, d2c(8)
  1244. pos=pos-1
  1245. end
  1246. end
  1247. end
  1248. when key2=d2c(116) then
  1249. if pos<length(word) then
  1250. do
  1251. if \CmdLine.Hidden then call Charout, substr(word,pos+1,1)
  1252. else call charout, "*"
  1253. pos=pos+1
  1254. do forever
  1255. if pos=length(word) then
  1256. leave
  1257. if substr(word,pos,1)==" " & substr(word,pos+1,1)\==" " then
  1258. leave
  1259. else
  1260. do
  1261. if \CmdLine.Hidden then call Charout, substr(word,pos+1,1)
  1262. else call charout, "*"
  1263. pos=pos+1
  1264. end
  1265. end
  1266. end
  1267. when key2=d2c(83) then
  1268. if pos<length(word) then
  1269. do
  1270. word=delstr(word,pos+1,1)
  1271. if \CmdLine.Hidden then call Charout, substr(word,pos+1)||" "
  1272. else call Charout, copies("*",length(substr(word,pos+1)))||" "
  1273. call charout, copies(d2c(8),length(word)-pos+1)
  1274. end
  1275. when key2=d2c(82) then
  1276. !CmdLine.History.insert = \!CmdLine.History.insert
  1277. when key2=d2c(79) then
  1278. if pos<length(word) then
  1279. do
  1280. if \CmdLine.Hidden then call Charout, substr(word,pos+1)
  1281. else call Charout, copies("*",length(substr(word,pos+1)))
  1282. pos=length(word)
  1283. end
  1284. when key2=d2c(71) then
  1285. if pos\=0 then
  1286. do
  1287. call Charout, copies(d2c(8),pos)
  1288. pos=0
  1289. end
  1290. when key2=d2c(117) then
  1291. if pos<length(word) then
  1292. do
  1293. call Charout, copies(" ",length(word)-pos)
  1294. call Charout, copies(d2c(8),length(word)-pos)
  1295. word=left(word,pos)
  1296. end
  1297. when key2=d2c(119) then
  1298. if pos>0 then
  1299. do
  1300. if pos<length(word) then
  1301. if \CmdLine.Hidden then call charout, substr(word,pos+1)
  1302. else call charout, copies("*",length(substr(word,pos+1)))
  1303. call rubout length(word)
  1304. word=substr(word,pos+1)
  1305. if \CmdLine.Hidden then call Charout, word
  1306. else call Charout, copies("*",length(word))
  1307. call Charout, copies(d2c(8),length(word))
  1308. pos=0
  1309. end
  1310. otherwise
  1311. if CmdLine.History & symbol('!CmdLine.History.key.'||c2d(key2))\='LIT' then
  1312. do
  1313. if pos<length(word) then
  1314. if \CmdLine.Hidden then call charout, substr(word,pos+1)
  1315. else call charout, copies("*",length(substr(word,pos+1)))
  1316. call rubout length(word)
  1317. i=c2d(key2)
  1318. word=!CmdLine.History.key.i
  1319. pos=length(word)
  1320. if \CmdLine.Hidden then call charout, word
  1321. else call charout, copies("*",length(word))
  1322. end
  1323. end
  1324. end
  1325. else
  1326. if CmdLine.Width=0 | (length(word)<CmdLine.Width | (pos<CmdLine.Width & !CmdLine.History.insert = 0)) then
  1327. do
  1328. if CmdLine.Upper then TheKey=translate(TheKey)
  1329. if CmdLine.Lower then TheKey=translate(TheKey,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
  1330. if pos(TheKey,CmdLine.Valid)\=0 then
  1331. do
  1332. if \CmdLine.Hidden then
  1333. call Charout, TheKey
  1334. else
  1335. call charout, "*"
  1336. if !CmdLine.History.insert then
  1337. word=insert(TheKey,word,pos)
  1338. else
  1339. word=overlay(TheKey,word,pos+1)
  1340. pos=pos+1
  1341. if pos<length(word) then
  1342. do
  1343. if \CmdLine.Hidden then
  1344. call Charout, substr(word,pos+1)
  1345. else
  1346. call Charout, copies("*", length(substr(word,pos+1)))
  1347. call Charout, copies(d2c(8),length(word)-pos)
  1348. end
  1349. end
  1350. else
  1351. call GetRespErrorBeep
  1352. end
  1353. else
  1354. call GetRespErrorBeep
  1355. if CmdLine.AutoSkip & length(word)=CmdLine.Width then leave
  1356. TheKey = GetKeyFromUser()
  1357. end
  1358. if \CmdLine.SameLine then say
  1359. if (CmdLine.Keep) & (word\=="") then
  1360. do
  1361. historical=!CmdLine.History.0
  1362. if word\=!CmdLine.History.historical then
  1363. do
  1364. !CmdLine.History.0=!CmdLine.History.0+1
  1365. historical=!CmdLine.History.0
  1366. !CmdLine.History.historical=word
  1367. end
  1368. end
  1369. return word
  1370. rubout: procedure
  1371. arg n
  1372. do i=1 to n
  1373. call Charout, d2c(8)||" "||d2c(8)
  1374. end
  1375. return
  1376. SkipOver_GETRESP:
  1377. /*
  1378. * $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  $
  1379. */
  1380. signal EndSundryXh
  1381. GetCurrentSeekPositionInFile:
  1382. gcsSeekAddress = stream(CurrentFile, 'c', 'seek')
  1383. if  datatype(gcsSeekAddress, 'Whole Number') = 0 then
  1384. do
  1385. call CommandFailure "Can't determine current seek address"
  1386. return('!');                               //Error
  1387. end
  1388. return(gcsSeekAddress)
  1389. GotoSpecificSeekPositionInFile:
  1390. SeekRc = stream(CurrentFile, 'c', 'seek =' || arg(1))
  1391. if  datatype(SeekRc, 'Whole Number') = 0 then
  1392. do
  1393. if  SeekRc <> '' then
  1394. SeekRc = ' (Reason=' || SeekRc || ')'
  1395. call CommandFailure 'Seek to ' || arg(1) || ' failed' || SeekRc
  1396. return('!')
  1397. end
  1398. return(SeekRc)
  1399. GetInteger:
  1400. giString = strip( arg(1) )
  1401. select
  1402. when left(giString, 1) = '$' then
  1403. do
  1404. giHex    = 'N'
  1405. giString = substr(giString, 2)
  1406. end
  1407. when translate(left(giString, 1)) = 'X' then
  1408. do
  1409. giHex    = 'Y'
  1410. giString = substr(giString, 2)
  1411. end
  1412. otherwise
  1413. giHex = InHexMode
  1414. end
  1415. if  giHex = 'Y' then
  1416. do
  1417. if  datatype(giString, 'X') = 0 then
  1418. return('!')
  1419. return( x2d(giString) )
  1420. end
  1421. else
  1422. do
  1423. if  datatype(giString, 'W') = 0 then
  1424. return('!')
  1425. return( giString )
  1426. end
  1427. RemoveAnyQuotesAroundFilename:
  1428. rqaFileName = arg(1)
  1429. rqaLq = left(rqaFileName, 1)
  1430. if  rqaLq <> '"' & rqaLq <> "'" then
  1431. return(rqaFileName)
  1432. else
  1433. do
  1434. rqaRq = right(rqaFileName, 1)
  1435. if  rqaLq <> rqaRq then
  1436. return(rqaFileName)
  1437. else
  1438. return( substr(rqaFileName, 2, length(rqaFileName)-2) )
  1439. end
  1440. ExpectToHaveCurrentFile:
  1441. if  CurrentFile <> '' then
  1442. return('')
  1443. else
  1444. do
  1445. call CommandFailure 'There is no file open!'
  1446. return('!')
  1447. end
  1448. OnlyAllowedInInteractiveMode:
  1449. if  Interactive = 'Y' then
  1450. return('')
  1451. else
  1452. do
  1453. call CommandFailure 'This command can only be used in interactive mode!'
  1454. return('!')
  1455. end
  1456. NotAllowedInInteractiveMode:
  1457. if  Interactive = 'N' then
  1458. return('')
  1459. else
  1460. do
  1461. call CommandFailure 'This command is not allowed in interactive mode!'
  1462. return('!')
  1463. end
  1464. MustNotHaveFileOpen:
  1465. if  CurrentFile = '' then
  1466. return('')
  1467. else
  1468. do
  1469. call CommandFailure 'You should not have a file open when executing this command!'
  1470. return('!')
  1471. end
  1472. CommandNeedsFileDeleted:
  1473. CloseRc = stream(arg(1), 'c', 'close')
  1474. if  stream(arg(1), 'c', 'query exists') <> '' then
  1475. do
  1476. DosDelRc   = SysFileDelete(arg(1))
  1477. if  stream(arg(1), 'c', 'query exists') <> '' then
  1478. do
  1479. call CommandFailure 'Could not delete "' || arg(1) || '" (DosRc=' || DosDelRc || ')'
  1480. return(ThisLineNumber())
  1481. end
  1482. end
  1483. return(0)
  1484. ConvertDecimalToCurrentBase:
  1485. cdDecimal   = arg(1)
  1486. cdMinDigits = arg(2)
  1487. if  InHexMode = 'N' then
  1488. do
  1489. cdReturn = cdDecimal
  1490. cdSymbol = '$'
  1491. if  cdMinDigits = '' then
  1492. cdMinDigits = 1
  1493. end
  1494. else
  1495. do
  1496. cdReturn = d2x(cdDecimal)
  1497. cdSymbol = 'x'
  1498. if  cdMinDigits = '' then
  1499. cdMinDigits = 4
  1500. end
  1501. if  length(cdReturn) < cdMinDigits then
  1502. cdReturn = right(cdReturn, cdMinDigits, '0')
  1503. return(cdSymbol || cdReturn)
  1504. GetDisplayableCurrentOffset:
  1505. if  CurrentFile = '' then
  1506. dcoAddress = '?'
  1507. else
  1508. do
  1509. dcoAddress = stream(CurrentFile, 'c', 'seek')
  1510. if  datatype(dcoAddress, 'Whole Number') = 0 then
  1511. dcoAddress = '??'
  1512. else
  1513. do
  1514. dcoAddress = ConvertDecimalToCurrentBase(dcoAddress - 1)
  1515. end
  1516. end
  1517. if  arg(1) <> '' then
  1518. do
  1519. if  length(dcoAddress) < arg(1) then
  1520. dcoAddress = left(dcoAddress, arg(1), ' ')
  1521. end
  1522. return(dcoAddress)
  1523. GetAmPmTime:  procedure
  1524. CivilTime  = time('C');  if length(CivilTime)  = 6 then CivilTime=' 'CivilTime
  1525. TheTime    = time();     NumSeconds = ':'substr(TheTime, 7, 2)
  1526. return( insert(NumSeconds, CivilTime, 5) )
  1527. CommonTrapHandler:
  1528. FailingLine     = arg(1)
  1529. TrapHeading     = 'BUG: ' || arg(2)
  1530. TextDescription = arg(3)
  1531. Text            = arg(4)
  1532. parse source . . SourceFileName
  1533. call ToStderr ColorError || copies('=+', 39)
  1534. call ToStderr TrapHeading
  1535. call ToStderr copies('~', length(TrapHeading))
  1536. call ToStderr substr(TextDescription, 1 , 16) || ': ' || Text
  1537. call ToStderr 'Failing Module  : ' || SourceFileName
  1538. call ToStderr 'Failing Line #  : ' || FailingLine
  1539. call ToStderr 'Failing Command : ' || strip(SourceLine(FailingLine))
  1540. call ToStderr copies('=+', 39) || Reset
  1541. PgmExit(FailingLine)
  1542. RexxTrapUninitializedVariable:
  1543. call CommonTrapHandler SIGL, 'NoValue Abort!', 'Unknown Variable', condition('D')
  1544. RexxTrapSyntaxError:
  1545. call CommonTrapHandler SIGL, 'Syntax Error!', 'Reason', errortext(Rc)
  1546. RexxCtrlC:
  1547. LineCtrlC = SIGL
  1548. call ToStderr ''
  1549. call ToStderr ColorError || copies('=+', 39)
  1550. call ToStderr "Come on, you pressed Ctrl+C or Break didn't you!"
  1551. call ToStderr copies('=+', 39) || Reset
  1552. PgmExit(LineCtrlC)
  1553. UserSyntaxError:
  1554. call ToStderr ColorError || "SYNTAX ERROR"
  1555. call ToStderr "~~~~~~~~~~~~"
  1556. call ToStderr '    ' || arg(1)
  1557. call ToStderr ''
  1558. call ToStderr 'CORRECT SYNTAX'
  1559. call ToStderr '~~~~~~~~~~~~~~'
  1560. call ToStderr '    BINTOOL[.CMD] ScriptFile'
  1561. call ToStderr ''
  1562. call ToStderr TwoBeep || Reset
  1563. PgmExit(ThisLineNumber())
  1564. ThisLineNumber:
  1565. return(SIGL)
  1566. IoError:
  1567. FileState = stream(arg(1), 'State')
  1568. if  FileState = 'READY' then
  1569. return('N')
  1570. IoReason = stream(arg(1), 'Description')
  1571. if  IoReason == 'NOTREADY:EOF' then
  1572. return('N')
  1573. call CommandFailure 'I/O failure on "' || arg(1) || '" (' || IoReason || ').'
  1574. return('Y')
  1575. ProgressMsg:
  1576. IntMsg = arg(1)
  1577. if  OptionSeeProgress = 'Y' then
  1578. do
  1579. IntMsgColor = arg(2)
  1580. if  IntMsgColor = '' then
  1581. IntMsgColor = ColorProgress
  1582. say IntMsgColor || Indent || IntMsg || Reset
  1583. end
  1584. call RecordLine ';' || Indent || IntMsg
  1585. return
  1586. CommandFailure:
  1587. CallersLine = SIGL
  1588. if  Interactive = 'Y' then
  1589. do
  1590. call ProgressMsg arg(1), ColorError
  1591. return
  1592. end
  1593. FailHeader  = "Failure on line " || CurrentLineNumber
  1594. if  OnError <> '' then
  1595. do
  1596. call ProgressMsg FailHeader
  1597. call ProgressMsg copies('~', length(FailHeader))
  1598. call ProgressMsg arg(1)
  1599. ErrorHandler = OnError
  1600. OnError      = ''
  1601. if  GotoLabel(ErrorHandler) <> '!' then
  1602. return
  1603. end
  1604. else
  1605. do
  1606. call ToStderr ColorError || FailHeader
  1607. call ToStderr copies('~', length(FailHeader))
  1608. call ToStderr arg(1) || Reset
  1609. PgmExit(CallersLine)
  1610. end
  1611. ToStderr:
  1612. call lineout 'STDERR',  arg(1)
  1613. call RecordLine ';' || arg(1)
  1614. return
  1615. DisplayLine:
  1616. call charout, arg(1)
  1617. say arg(2)
  1618. call charout, Reset
  1619. return
  1620. EndSundryXh:
  1621. /*
  1622. * CRC32REX.XH Version 98.153 by Dennis Bareis
  1623. *            http://www.ozemail.com.au/~dbareis (db0@anz.com)
  1624. */
  1625. _Crc32.0  = '00000000'x
  1626. _Crc32.1  = '77073096'x
  1627. _Crc32.2  = 'EE0E612C'x
  1628. _Crc32.3  = '990951BA'x
  1629. _Crc32.4  = '076DC419'x
  1630. _Crc32.5  = '706AF48F'x
  1631. _Crc32.6  = 'E963A535'x
  1632. _Crc32.7  = '9E6495A3'x
  1633. _Crc32.8  = '0EDB8832'x
  1634. _Crc32.9  = '79DCB8A4'x
  1635. _Crc32.10 = 'E0D5E91E'x
  1636. _Crc32.11 = '97D2D988'x
  1637. _Crc32.12 = '09B64C2B'x
  1638. _Crc32.13 = '7EB17CBD'x
  1639. _Crc32.14 = 'E7B82D07'x
  1640. _Crc32.15 = '90BF1D91'x
  1641. _Crc32.16 = '1DB71064'x
  1642. _Crc32.17 = '6AB020F2'x
  1643. _Crc32.18 = 'F3B97148'x
  1644. _Crc32.19 = '84BE41DE'x
  1645. _Crc32.20 = '1ADAD47D'x
  1646. _Crc32.21 = '6DDDE4EB'x
  1647. _Crc32.22 = 'F4D4B551'x
  1648. _Crc32.23 = '83D385C7'x
  1649. _Crc32.24 = '136C9856'x
  1650. _Crc32.25 = '646BA8C0'x
  1651. _Crc32.26 = 'FD62F97A'x
  1652. _Crc32.27 = '8A65C9EC'x
  1653. _Crc32.28 = '14015C4F'x
  1654. _Crc32.29 = '63066CD9'x
  1655. _Crc32.30 = 'FA0F3D63'x
  1656. _Crc32.31 = '8D080DF5'x
  1657. _Crc32.32 = '3B6E20C8'x
  1658. _Crc32.33 = '4C69105E'x
  1659. _Crc32.34 = 'D56041E4'x
  1660. _Crc32.35 = 'A2677172'x
  1661. _Crc32.36 = '3C03E4D1'x
  1662. _Crc32.37 = '4B04D447'x
  1663. _Crc32.38 = 'D20D85FD'x
  1664. _Crc32.39 = 'A50AB56B'x
  1665. _Crc32.40 = '35B5A8FA'x
  1666. _Crc32.41 = '42B2986C'x
  1667. _Crc32.42 = 'DBBBC9D6'x
  1668. _Crc32.43 = 'ACBCF940'x
  1669. _Crc32.44 = '32D86CE3'x
  1670. _Crc32.45 = '45DF5C75'x
  1671. _Crc32.46 = 'DCD60DCF'x
  1672. _Crc32.47 = 'ABD13D59'x
  1673. _Crc32.48 = '26D930AC'x
  1674. _Crc32.49 = '51DE003A'x
  1675. _Crc32.50 = 'C8D75180'x
  1676. _Crc32.51 = 'BFD06116'x
  1677. _Crc32.52 = '21B4F4B5'x
  1678. _Crc32.53 = '56B3C423'x
  1679. _Crc32.54 = 'CFBA9599'x
  1680. _Crc32.55 = 'B8BDA50F'x
  1681. _Crc32.56 = '2802B89E'x
  1682. _Crc32.57 = '5F058808'x
  1683. _Crc32.58 = 'C60CD9B2'x
  1684. _Crc32.59 = 'B10BE924'x
  1685. _Crc32.60 = '2F6F7C87'x
  1686. _Crc32.61 = '58684C11'x
  1687. _Crc32.62 = 'C1611DAB'x
  1688. _Crc32.63 = 'B6662D3D'x
  1689. _Crc32.64 = '76DC4190'x
  1690. _Crc32.65 = '01DB7106'x
  1691. _Crc32.66 = '98D220BC'x
  1692. _Crc32.67 = 'EFD5102A'x
  1693. _Crc32.68 = '71B18589'x
  1694. _Crc32.69 = '06B6B51F'x
  1695. _Crc32.70 = '9FBFE4A5'x
  1696. _Crc32.71 = 'E8B8D433'x
  1697. _Crc32.72 = '7807C9A2'x
  1698. _Crc32.73 = '0F00F934'x
  1699. _Crc32.74 = '9609A88E'x
  1700. _Crc32.75 = 'E10E9818'x
  1701. _Crc32.76 = '7F6A0DBB'x
  1702. _Crc32.77 = '086D3D2D'x
  1703. _Crc32.78 = '91646C97'x
  1704. _Crc32.79 = 'E6635C01'x
  1705. _Crc32.80 = '6B6B51F4'x
  1706. _Crc32.81 = '1C6C6162'x
  1707. _Crc32.82 = '856530D8'x
  1708. _Crc32.83 = 'F262004E'x
  1709. _Crc32.84 = '6C0695ED'x
  1710. _Crc32.85 = '1B01A57B'x
  1711. _Crc32.86 = '8208F4C1'x
  1712. _Crc32.87 = 'F50FC457'x
  1713. _Crc32.88 = '65B0D9C6'x
  1714. _Crc32.89 = '12B7E950'x
  1715. _Crc32.90 = '8BBEB8EA'x
  1716. _Crc32.91 = 'FCB9887C'x
  1717. _Crc32.92 = '62DD1DDF'x
  1718. _Crc32.93 = '15DA2D49'x
  1719. _Crc32.94 = '8CD37CF3'x
  1720. _Crc32.95 = 'FBD44C65'x
  1721. _Crc32.96 = '4DB26158'x
  1722. _Crc32.97 = '3AB551CE'x
  1723. _Crc32.98 = 'A3BC0074'x
  1724. _Crc32.99 = 'D4BB30E2'x
  1725. _Crc32.100 = '4ADFA541'x
  1726. _Crc32.101 = '3DD895D7'x
  1727. _Crc32.102 = 'A4D1C46D'x
  1728. _Crc32.103 = 'D3D6F4FB'x
  1729. _Crc32.104 = '4369E96A'x
  1730. _Crc32.105 = '346ED9FC'x
  1731. _Crc32.106 = 'AD678846'x
  1732. _Crc32.107 = 'DA60B8D0'x
  1733. _Crc32.108 = '44042D73'x
  1734. _Crc32.109 = '33031DE5'x
  1735. _Crc32.110 = 'AA0A4C5F'x
  1736. _Crc32.111 = 'DD0D7CC9'x
  1737. _Crc32.112 = '5005713C'x
  1738. _Crc32.113 = '270241AA'x
  1739. _Crc32.114 = 'BE0B1010'x
  1740. _Crc32.115 = 'C90C2086'x
  1741. _Crc32.116 = '5768B525'x
  1742. _Crc32.117 = '206F85B3'x
  1743. _Crc32.118 = 'B966D409'x
  1744. _Crc32.119 = 'CE61E49F'x
  1745. _Crc32.120 = '5EDEF90E'x
  1746. _Crc32.121 = '29D9C998'x
  1747. _Crc32.122 = 'B0D09822'x
  1748. _Crc32.123 = 'C7D7A8B4'x
  1749. _Crc32.124 = '59B33D17'x
  1750. _Crc32.125 = '2EB40D81'x
  1751. _Crc32.126 = 'B7BD5C3B'x
  1752. _Crc32.127 = 'C0BA6CAD'x
  1753. _Crc32.128 = 'EDB88320'x
  1754. _Crc32.129 = '9ABFB3B6'x
  1755. _Crc32.130 = '03B6E20C'x
  1756. _Crc32.131 = '74B1D29A'x
  1757. _Crc32.132 = 'EAD54739'x
  1758. _Crc32.133 = '9DD277AF'x
  1759. _Crc32.134 = '04DB2615'x
  1760. _Crc32.135 = '73DC1683'x
  1761. _Crc32.136 = 'E3630B12'x
  1762. _Crc32.137 = '94643B84'x
  1763. _Crc32.138 = '0D6D6A3E'x
  1764. _Crc32.139 = '7A6A5AA8'x
  1765. _Crc32.140 = 'E40ECF0B'x
  1766. _Crc32.141 = '9309FF9D'x
  1767. _Crc32.142 = '0A00AE27'x
  1768. _Crc32.143 = '7D079EB1'x
  1769. _Crc32.144 = 'F00F9344'x
  1770. _Crc32.145 = '8708A3D2'x
  1771. _Crc32.146 = '1E01F268'x
  1772. _Crc32.147 = '6906C2FE'x
  1773. _Crc32.148 = 'F762575D'x
  1774. _Crc32.149 = '806567CB'x
  1775. _Crc32.150 = '196C3671'x
  1776. _Crc32.151 = '6E6B06E7'x
  1777. _Crc32.152 = 'FED41B76'x
  1778. _Crc32.153 = '89D32BE0'x
  1779. _Crc32.154 = '10DA7A5A'x
  1780. _Crc32.155 = '67DD4ACC'x
  1781. _Crc32.156 = 'F9B9DF6F'x
  1782. _Crc32.157 = '8EBEEFF9'x
  1783. _Crc32.158 = '17B7BE43'x
  1784. _Crc32.159 = '60B08ED5'x
  1785. _Crc32.160 = 'D6D6A3E8'x
  1786. _Crc32.161 = 'A1D1937E'x
  1787. _Crc32.162 = '38D8C2C4'x
  1788. _Crc32.163 = '4FDFF252'x
  1789. _Crc32.164 = 'D1BB67F1'x
  1790. _Crc32.165 = 'A6BC5767'x
  1791. _Crc32.166 = '3FB506DD'x
  1792. _Crc32.167 = '48B2364B'x
  1793. _Crc32.168 = 'D80D2BDA'x
  1794. _Crc32.169 = 'AF0A1B4C'x
  1795. _Crc32.170 = '36034AF6'x
  1796. _Crc32.171 = '41047A60'x
  1797. _Crc32.172 = 'DF60EFC3'x
  1798. _Crc32.173 = 'A867DF55'x
  1799. _Crc32.174 = '316E8EEF'x
  1800. _Crc32.175 = '4669BE79'x
  1801. _Crc32.176 = 'CB61B38C'x
  1802. _Crc32.177 = 'BC66831A'x
  1803. _Crc32.178 = '256FD2A0'x
  1804. _Crc32.179 = '5268E236'x
  1805. _Crc32.180 = 'CC0C7795'x
  1806. _Crc32.181 = 'BB0B4703'x
  1807. _Crc32.182 = '220216B9'x
  1808. _Crc32.183 = '5505262F'x
  1809. _Crc32.184 = 'C5BA3BBE'x
  1810. _Crc32.185 = 'B2BD0B28'x
  1811. _Crc32.186 = '2BB45A92'x
  1812. _Crc32.187 = '5CB36A04'x
  1813. _Crc32.188 = 'C2D7FFA7'x
  1814. _Crc32.189 = 'B5D0CF31'x
  1815. _Crc32.190 = '2CD99E8B'x
  1816. _Crc32.191 = '5BDEAE1D'x
  1817. _Crc32.192 = '9B64C2B0'x
  1818. _Crc32.193 = 'EC63F226'x
  1819. _Crc32.194 = '756AA39C'x
  1820. _Crc32.195 = '026D930A'x
  1821. _Crc32.196 = '9C0906A9'x
  1822. _Crc32.197 = 'EB0E363F'x
  1823. _Crc32.198 = '72076785'x
  1824. _Crc32.199 = '05005713'x
  1825. _Crc32.200 = '95BF4A82'x
  1826. _Crc32.201 = 'E2B87A14'x
  1827. _Crc32.202 = '7BB12BAE'x
  1828. _Crc32.203 = '0CB61B38'x
  1829. _Crc32.204 = '92D28E9B'x
  1830. _Crc32.205 = 'E5D5BE0D'x
  1831. _Crc32.206 = '7CDCEFB7'x
  1832. _Crc32.207 = '0BDBDF21'x
  1833. _Crc32.208 = '86D3D2D4'x
  1834. _Crc32.209 = 'F1D4E242'x
  1835. _Crc32.210 = '68DDB3F8'x
  1836. _Crc32.211 = '1FDA836E'x
  1837. _Crc32.212 = '81BE16CD'x
  1838. _Crc32.213 = 'F6B9265B'x
  1839. _Crc32.214 = '6FB077E1'x
  1840. _Crc32.215 = '18B74777'x
  1841. _Crc32.216 = '88085AE6'x
  1842. _Crc32.217 = 'FF0F6A70'x
  1843. _Crc32.218 = '66063BCA'x
  1844. _Crc32.219 = '11010B5C'x
  1845. _Crc32.220 = '8F659EFF'x
  1846. _Crc32.221 = 'F862AE69'x
  1847. _Crc32.222 = '616BFFD3'x
  1848. _Crc32.223 = '166CCF45'x
  1849. _Crc32.224 = 'A00AE278'x
  1850. _Crc32.225 = 'D70DD2EE'x
  1851. _Crc32.226 = '4E048354'x
  1852. _Crc32.227 = '3903B3C2'x
  1853. _Crc32.228 = 'A7672661'x
  1854. _Crc32.229 = 'D06016F7'x
  1855. _Crc32.230 = '4969474D'x
  1856. _Crc32.231 = '3E6E77DB'x
  1857. _Crc32.232 = 'AED16A4A'x
  1858. _Crc32.233 = 'D9D65ADC'x
  1859. _Crc32.234 = '40DF0B66'x
  1860. _Crc32.235 = '37D83BF0'x
  1861. _Crc32.236 = 'A9BCAE53'x
  1862. _Crc32.237 = 'DEBB9EC5'x
  1863. _Crc32.238 = '47B2CF7F'x
  1864. _Crc32.239 = '30B5FFE9'x
  1865. _Crc32.240 = 'BDBDF21C'x
  1866. _Crc32.241 = 'CABAC28A'x
  1867. _Crc32.242 = '53B39330'x
  1868. _Crc32.243 = '24B4A3A6'x
  1869. _Crc32.244 = 'BAD03605'x
  1870. _Crc32.245 = 'CDD70693'x
  1871. _Crc32.246 = '54DE5729'x
  1872. _Crc32.247 = '23D967BF'x
  1873. _Crc32.248 = 'B3667A2E'x
  1874. _Crc32.249 = 'C4614AB8'x
  1875. _Crc32.250 = '5D681B02'x
  1876. _Crc32.251 = '2A6F2B94'x
  1877. _Crc32.252 = 'B40BBE37'x
  1878. _Crc32.253 = 'C30C8EA1'x
  1879. _Crc32.254 = '5A05DF1B'x
  1880. _Crc32.255 = '2D02EF8D'x
  1881. signal EndCrc32rexXh
  1882. Crc32PrePostConditioning:
  1883. if  arg(1) = '' then
  1884. return('FFFFFFFF'x)
  1885. else
  1886. return( bitxor(arg(1), 'FFFFFFFF'x) )
  1887. UpdateCrc32:
  1888. ucCrc       = arg(1)
  1889. ucBuffer    = arg(2)
  1890. ucBufferLng = length(ucBuffer)
  1891. do  ucThisByte = 1 to ucBufferLng
  1892. ucCrcDiv256 = '00'x || left(ucCrc, 3)
  1893. ucPart1     = bitand(ucCrcDiv256, '00FFFFFF'x)
  1894. ucPart2     = bitxor(ucCrc, '000000'x || substr(ucBuffer, ucThisByte, 1))
  1895. ucArrayEl   = c2d(right(bitand(ucPart2, '000000FF'x), 1))
  1896. ucCrc       = Bitxor(ucPart1, _Crc32.ucArrayEl)
  1897. end
  1898. return(ucCrc)
  1899. Crc32InDisplayableForm:
  1900. return( c2x(arg(1)) )
  1901. EndCRC32REXXh:
  1902. CurrentFile = ''
  1903. InHexMode   = 'Y'
  1904. OnError     = ''
  1905. signal on HALT    name RexxCtrlC
  1906. signal on NOVALUE name RexxTrapUninitializedVariable
  1907. signal on SYNTAX  name RexxTrapSyntaxError
  1908. call DisplayLine ColorStartupMsg, '[]-------------------------------------------------------------[]'
  1909. call DisplayLine ColorStartupMsg, '| BINTOOL.CMD: Version ' || PGM_VERSION || ' (C)opyright Dennis Bareis 1998    |'
  1910. call DisplayLine ColorStartupMsg, '|              http://www.ozemail.com.au/~dbareis (db0@anz.com) |'
  1911. call DisplayLine ColorStartupMsg, '[]-------------------------------------------------------------[]'
  1912. say ''
  1913. parse value arg(1) with ScriptFile OptionsCmdLine
  1914. if ScriptFile = '' then
  1915. UserSyntaxError("Expected the name of a Script File")
  1916. parse source . . ThisProgramName . 
  1917. ThisProgramDir = filespec('drive', ThisProgramName) || filespec('path', ThisProgramName)
  1918. OptionDebugOn     = 'N'
  1919. OptionSeeCmds     = 'N'
  1920. OptionSeeProgress = 'N'
  1921. OptionsEnvironment = GetEnv('BINTOOL_OPTIONS')
  1922. Options            = OptionsEnvironment || ' ' || OptionsCmdLine
  1923. do while  Options <> ''
  1924. parse var Options ThisParm Options
  1925. parse var ThisParm ThisCmd':'ThisCmdOptions
  1926. ThisCmd = translate(ThisCmd)
  1927. select
  1928. when ThisCmd = '/SEECMDS' then
  1929. OptionSeeCmds    = SwitchWantsYesOrNo(ThisCmd, ThisCmdOptions, 'Y')
  1930. when ThisCmd = '/SEEPROGRESS' then
  1931. OptionSeeProgress = SwitchWantsYesOrNo(ThisCmd, ThisCmdOptions, 'Y')
  1932. when ThisCmd = '/DEBUG' then
  1933. do
  1934. call SwitchMustNotHaveOptions ThisCmd, ThisCmdOptions
  1935. OptionDebugOn     = 'Y'
  1936. OptionSeeCmds     = 'Y'
  1937. OptionSeeProgress = 'Y'
  1938. end
  1939. when ThisCmd = '/COLOR' | ThisCmd = '/COLOUR' then
  1940. do
  1941. call NotAvailableUnderNtYet ThisCmd
  1942. WantColor = SwitchWantsYesOrNo(ThisCmd, ThisCmdOptions, 'Y')
  1943. if  WantColor = 'N' then
  1944. call RemoveColorCodes
  1945. else
  1946. call SetColorCodes
  1947. end
  1948. otherwise
  1949. UserSyntaxError('Unknown command of "' || ThisCmd || '" specified')
  1950. end
  1951. end
  1952. if ScriptFile <> '?' then
  1953. Interactive = 'N'
  1954. else
  1955. do
  1956. Interactive       = 'Y'
  1957. OptionSeeCmds     = 'N'
  1958. OptionSeeProgress = 'Y'
  1959. end
  1960. if Interactive = 'Y' then
  1961. call ProcessInteractiveCommands
  1962. else
  1963. call ProcessWholeFile
  1964. PgmExit(ExitRc)
  1965. HandleWhitespaceInCommand:
  1966. TheCmdLine = strip( translate(arg(1), ' ', Tab) )
  1967. TheCmdLine = strip( arg(1) )
  1968. if  TheCmdLine = '' then
  1969. return('')
  1970. if  left(TheCmdLine, 1) = ';' then
  1971. return('')
  1972. ColonColonPos = lastpos(ColonColon, TheCmdLine)
  1973. if  ColonColonPos <> 0 then
  1974. do
  1975. TheCmdLine = strip( left(TheCmdLine, ColonColonPos-1) )
  1976. end
  1977. return(TheCmdLine)
  1978. ProcessInteractiveCommands:
  1979. do while Interactive = 'Y'
  1980. if  CurrentFile = '' then
  1981. Prompt = '> '
  1982. else
  1983. Prompt = filespec('name', CurrentFile) || ' @ ' || GetDisplayableCurrentOffset() || '> '
  1984. call charout , ColorPrompt || Prompt || ColorExecutingCommand
  1985. if  WhichRexx = 'STANDARD_OS/2' then
  1986. UsersCmd = CmdLine("Insert", "Required")
  1987. else
  1988. UsersCmd = linein()
  1989. call charout , Reset
  1990. UsersCmd = HandleWhitespaceInCommand(UsersCmd)
  1991. if  UsersCmd = '' then
  1992. iterate
  1993. call RecordLine ''
  1994. call RecordLine UsersCmd
  1995. call ProcessOneCmd UsersCmd
  1996. end
  1997. return
  1998. ProcessWholeFile:
  1999. if  stream(ScriptFile, 'c', 'query exists') = '' then
  2000. UserSyntaxError('The script file "' || ScriptFile || '" does not exist')
  2001. CloseRc = stream(ScriptFile, 'c', 'close')
  2002. CloseRc = stream(ScriptFile, 'c', 'open Read')
  2003. CurrentLineNumber = 0
  2004. do  while lines(ScriptFile) <> 0
  2005. CurrentLine       = HandleWhitespaceInCommand( linein(ScriptFile) )
  2006. CurrentLineNumber = CurrentLineNumber + 1
  2007. if  CurrentLine = '' then
  2008. iterate
  2009. if  left(CurrentLine, 1) = ':' then
  2010. call SaveLabel     translate(substr(CurrentLine, 2))
  2011. else
  2012. call ProcessOneCmd CurrentLine
  2013. end
  2014. call IoError ScriptFile
  2015. CloseRc = stream(ScriptFile, 'c', 'close')
  2016. return
  2017. IsCommand:
  2018. FullCmd = arg(1)
  2019. Subset  = arg(2)
  2020. MinLng  = arg(3)
  2021. if  Interactive = 'Y' then
  2022. do
  2023. if  MinLng = '' then
  2024. MinLng = 0
  2025. if  abbrev(FullCmd, Subset, MinLng) = 1 then
  2026. return('Y')
  2027. else
  2028. return('N')
  2029. end
  2030. else
  2031. do
  2032. if  FullCmd == Subset then
  2033. return('Y')
  2034. else
  2035. return('N')
  2036. end
  2037. ProcessOneCmd:
  2038. parse value arg(1) with TheCmd ItsParameters
  2039. TheCmd        = translate(TheCmd)
  2040. ItsParameters = strip(ItsParameters)
  2041. if  OptionSeeCmds = 'Y' then
  2042. call DisplayLine ColorExecutingCommand, GetDisplayableCurrentOffset(6) || ' : ' || TheCmd || ' ' || ItsParameters
  2043. select
  2044. when IsCommand('WRITE', TheCmd) = 'Y' then
  2045. call WriteToFile ItsParameters
  2046. when IsCommand('VERIFY', TheCmd) = 'Y' then
  2047. call VerifyBytesInFile ItsParameters
  2048. when IsCommand('MOVETO', TheCmd) = 'Y' then
  2049. call ProcessCmdMoveTo ItsParameters
  2050. when IsCommand('GOTO', TheCmd) = 'Y' then
  2051. do
  2052. if  NotAllowedInInteractiveMode() <> '!' then
  2053. call GotoLabel ItsParameters
  2054. end
  2055. when TheCmd = 'OPENNEW' | TheCmd = 'OPENREAD' | TheCmd = 'OPEN' then
  2056. call ProcessCmdOpenFile TheCmd, ItsParameters
  2057. when IsCommand('CLOSE', TheCmd) = 'Y' then
  2058. call ProcessCmdCloseFile
  2059. when IsCommand('HEXADECIMAL', TheCmd) = 'Y' then
  2060. InHexMode = 'Y'
  2061. when IsCommand('DECIMAL', TheCmd, 2) = 'Y' then
  2062. InHexMode = 'N'
  2063. when IsCommand('VERIFYFILE', TheCmd, 7) = 'Y' then
  2064. call VerifyFileContents ItsParameters
  2065. when IsCommand('RECORD', TheCmd, 3) = 'Y' then
  2066. call ProcessRecordCommand ItsParameters
  2067. when IsCommand('FIND', TheCmd) = 'Y' then
  2068. call ProcessFindCommand ItsParameters, 'Y'
  2069. when IsCommand('FINDCS', TheCmd, 5) = 'Y' then
  2070. call ProcessFindCommand ItsParameters, 'N'
  2071. when IsCommand('LOCATE', TheCmd) = 'Y' then
  2072. call ProcessLocateCommand ItsParameters, 'M'
  2073. when IsCommand('LOCATE!', TheCmd, 7) = 'Y' then
  2074. call ProcessLocateCommand ItsParameters, 'N'
  2075. when IsCommand('REXX', TheCmd) = 'Y' then
  2076. do
  2077. if ItsParameters = '' then
  2078. call CommandFailure 'No parameters supplied on "REXX" command'
  2079. else
  2080. Dummy = InterpretExactCommand(ItsParameters)
  2081. end
  2082. when IsCommand('SYSTEM', TheCmd) = 'Y' then
  2083. do
  2084. if  ItsParameters = '' then
  2085. do
  2086. address cmd '@CMD.EXE /K "cls & prompt BINTOOL $p$g$s'
  2087. SystemRc = Rc
  2088. end
  2089. else
  2090. do
  2091. address cmd '@CMD.EXE /C ' || ItsParameters
  2092. SystemRc = Rc
  2093. call ProgressMsg 'Rc = ' || SystemRc
  2094. end
  2095. end
  2096. when IsCommand('DUMP', TheCmd) = 'Y' then
  2097. call ProcessCmdDump ItsParameters
  2098. when IsCommand('DUMPCHAR', TheCmd, 5) = 'Y' then
  2099. call ProcessDumpChar ItsParameters
  2100. when IsCommand('REBUILD', TheCmd, 3) = 'Y' then
  2101. call ProcessCmdRebuild ItsParameters
  2102. when IsCommand('ONERROR', TheCmd, 3) = 'Y' then
  2103. do
  2104. if  NotAllowedInInteractiveMode() <> '!' then
  2105. do
  2106. OnError = translate(ItsParameters)
  2107. return
  2108. end
  2109. end
  2110. when IsCommand('QUIT', TheCmd) = 'Y' | IsCommand('EXIT', TheCmd) = 'Y' | TheCmd = 'X' then
  2111. do
  2112. call OnlyAllowedInInteractiveMode
  2113. Interactive = 'N'
  2114. end
  2115. when TheCmd = '?' then
  2116. do
  2117. if  OnlyAllowedInInteractiveMode() <> '!' then
  2118. do
  2119. if  ItsParameters <> '' then
  2120. call ViewInf ItsParameters
  2121. else
  2122. call DisplayCommandSummary
  2123. end
  2124. end
  2125. when TheCmd = '??' | TheCmd = 'HELP' then
  2126. do
  2127. if  OnlyAllowedInInteractiveMode() <> '!' then
  2128. call ViewInf ItsParameters
  2129. end
  2130. otherwise
  2131. call CommandFailure 'Unknown Command of "' || TheCmd || '" specified.'
  2132. end
  2133. OnError = ''
  2134. return
  2135. DisplayCommandSummary:
  2136. say 'CLOSE            QUIT'
  2137. say 'DECIMAL          REBUILD'
  2138. say 'DUMP             RECORD'
  2139. say 'DUMPCHAR         REXX'
  2140. say 'GOTO             SYSTEM'
  2141. say 'FIND[CS]         VERIFY'
  2142. say 'HEXADECIMAL      VERIFYFILE'
  2143. say 'LOCATE[!]        WRITE'
  2144. say 'MOVETO           HELP'
  2145. say 'OPEN'
  2146. say 'OPENNEW'
  2147. say 'OPENREAD'
  2148. return
  2149. ViewInf:
  2150. address cmd '@view.exe ' || ThisProgramDir || 'BINTOOL.INF ' || arg(1)
  2151. return
  2152. SetColorCodes:
  2153. EscapeChar             = d2c(27)
  2154. Reset                  = EscapeChar || '[0m'
  2155. ColorStartupMsg        = EscapeChar || '[1;33m'
  2156. ColorError             = EscapeChar || '[1;31m'
  2157. ColorProgress          = EscapeChar || '[32m'
  2158. ColorPrompt            = EscapeChar || '[1;33m'
  2159. ColorExecutingCommand  = EscapeChar || '[1;35m'
  2160. return
  2161. RemoveColorCodes:
  2162. Reset                  = ''
  2163. ColorStartupMsg        = ''
  2164. ColorError             = ''
  2165. ColorProgress          = ''
  2166. ColorPrompt            = ''
  2167. ColorExecutingCommand  = ''
  2168. return
  2169. PgmExit:
  2170. call CloseRecordFile
  2171. if  Dying = 'N' then
  2172. do
  2173. Dying = 'Y'
  2174. call ProcessCmdCloseFile
  2175. end
  2176. exit( arg(1) )
  2177.