PageRenderTime 148ms CodeModel.GetById 32ms RepoModel.GetById 1ms app.codeStats 0ms

/macros/ebcdic-t.vdm

https://bitbucket.org/chriz/z_vedit
Unknown | 3417 lines | 3324 code | 93 blank | 0 comment | 0 complexity | 279dd5af47de3d772dc7346120caacec MD5 | raw file

Large files files are truncated, but you can click here to view the full file

  1. // EBCDIC-T.VDM -- EBCDIC Level-2 Trial version - Limited to 5000 fields.
  2. // Convert EBCDIC with packed fields into ASCII.
  3. // Supports EBCDIC text, packed-decimal, packed-binary, zoned,
  4. // packed-no-zone, floating point, hexadecimal, ignored and
  5. // custom fields. (Floating point data whose magnitudes are
  6. // greater than 10E18 are blanked.)
  7. //
  8. // Converts COBOL picture specifications into commands
  9. // recognized by the rest of this macro. The picture
  10. // specifications may be edited to include new Greenview codes
  11. // for more flexibility in the translation. See COBOL2V.VDM.
  12. //
  13. // Note: comments out "REDEFINES" statements which are
  14. // otherwise unsupported.
  15. //
  16. //
  17. // Output Options:
  18. // Append newline char(s) at the end of each record.
  19. // Emit an explicit decimal point for packed and zoned fields.
  20. // Quote and comma delimit each field.
  21. // Optionally emit specified delimiter(s) after each field.
  22. // Write error messages to ebcdic.err (default).
  23. //
  24. // Now, optionally outputs records into DBASE .dbf files,
  25. // including creating and updating the DBASE header record.
  26. // Also, optionally includes a field-names record at the start
  27. // of each output file. The initial field names can be generated
  28. // from a COBOL copy-book. See COBOL2V.VDM.
  29. //
  30. // Originally by: Theodore Green, Greenview Data, Inc.
  31. // Generalized by: Thomas C. Burt, Greenview Data, Inc.
  32. // Last change: 09/26/2003
  33. //
  34. // Requires: VEDIT PLUS 6.10 dated 03-05-2003 or later.
  35. // EBCDIC.LAY or alias (see below).
  36. // REGPREP.VDM
  37. //
  38. // Optional: COBOL2V.VDM (for preprocessing COBOL copybooks).
  39. // RELAY.VDM for generating output column #'s.
  40. // EBCDIC-2.VCM (customization submacro library).
  41. // EBCDIC.CUS (q.v.)
  42. //
  43. // From OS: VPW [-N[mask]] [-Y] -X EBCDIC-2 fname [-A oname] [lname] [-u options]
  44. //
  45. // When done, saves the output file as fname.X, where 'X' is
  46. // "ASC", normally, or "DBF" for DBASE output, or as specified
  47. // by "-A oname" and displays it on the screen.
  48. //
  49. // Use {FILE, Exit} to exit.
  50. //
  51. // Unless an explicit data layout filename is specified via
  52. // optional parameter 'lname', the data layout file EBCDIC.LAY
  53. // (or "fname.LAY when option "-N" is specified) must exist
  54. // in the current directory or in Vedit's "Home" directory.
  55. // EBCDIC.LAY is described below.
  56. //
  57. // -Y exits Vedit automatically after saving the translated file.
  58. //
  59. // -A specifies the name of the output file, including optional
  60. // drive and path.
  61. //
  62. // -N[mask] with no parameter or when (mask&1) is true, uses
  63. // "fname.LAY" as its record description file.
  64. // Alternatively, to always use "fname.LAY", edit this macro
  65. // setting numeric variable #64 = 1 as described, below.
  66. //
  67. // When (mask&2) is true, this macro terminates after
  68. // COBOL preprocessing.
  69. //
  70. // When (mask&256) is true, this macro terminates after
  71. // all preprocessing has finished. (However, any "v="
  72. // commands are not executed).
  73. //
  74. // -U leadin to options for this macro. If used, must occur after
  75. // all filenames have been specified.
  76. //
  77. // Unique ID options (auto-generated record# [run_no] run_date)
  78. // run_no 0 <= n < 9; default == 1.
  79. // UID=val val={off,auto,on or all}={0,1,2};
  80. // default == 1.
  81. // d=run_date mm/dd/yyyy
  82. //
  83. // To include .nam at start of each output file:
  84. // i[nclude][=val] val={off,on}={0,1}; default == 0.
  85. //
  86. // NOD to prevent decimal points from being output
  87. //
  88. // E.g., -u 2 specifies that "2" is to be inserted into the
  89. // run_no bytes of any unique ID.
  90. //
  91. // ##### NOTE: WIN95 batch processing strips "="; so, in .BAT files
  92. // using the "-u" options, substitute "-" for the equals
  93. // signs in the above-mentioned options.
  94. //
  95. // Note: blank-fills, by default, invalid zoned/packed decimal fields (see
  96. // bc=, below). Also, writes error message to EBCDIC.ERR (see "e=" below).
  97. //
  98. //////////////////////////////////////////////////////////////////////////////
  99. //
  100. // EBCDIC-2.LAY - Describes the file being translated.
  101. // Lines specify optional header size, record size,
  102. // comment lines, Vedit command lines and data descriptions.
  103. // Columns must be specified in ascending order. Undescribed
  104. // columns may be optionally ignored (copied from input to
  105. // output as is); else are converted from EBCDIC to ASCII.
  106. // Cobol copybook statements may also be used.
  107. //
  108. // Data description (layout) lines:
  109. //
  110. // [code col_siz [sop] [#r] [: cusops]] [// comment]
  111. //
  112. // code is a string of letters followed by a space describing the
  113. // field to be translated. E.g., "e " describes EBCDIC text.
  114. // The codes are listed, below.
  115. //
  116. // col_siz specifies the columns to be decoded; this may be done in
  117. // two ways:
  118. //
  119. // a) begin_col<sep>end_col
  120. //
  121. // The separator is typically a comma or a hyphen.
  122. // Columns begin counting from one.
  123. // The end column is inclusive.
  124. //
  125. // The begin_col need not immediately follow any
  126. // preceding end_col since any unspecified columns are
  127. // processed according to the default type which is 'e'
  128. // unless changed with the "u=type" command (see below).
  129. //
  130. // E.g., e 1-4 // specifies that columns one through
  131. // // four are simple EBCDIC text.
  132. //
  133. // b) +size
  134. //
  135. // Specifies the length of the field; assumes this item
  136. // is adjacent to the preceding item, although a column
  137. // number can be specified by preceding this item with
  138. // a "c=col" line.
  139. //
  140. // Note the '+' prefix.
  141. //
  142. // E.g., e +4 // the next four colums are EBCDIC text
  143. //
  144. // sop (standard options):
  145. //
  146. // [,[-|=]padlen;] [numops] [[pc=]'padch'] [[bc=]'badch']
  147. //
  148. //
  149. // padlen = # padchars to insert behind the output field;
  150. // default "padch" is a blank space; changeable
  151. // by the "pc=" specification.
  152. //
  153. // -padlen = # padchars to insert before the output field.
  154. //
  155. // =padlen = # digits to be output for 'b', 'd', 'l',
  156. // 'n' & 'u' commands.
  157. //
  158. // = # bytes for 'pb', 'pd', 'pn' and 'pz' commands.
  159. //
  160. // Note: the leading comma is required; the semicolon
  161. // should be used to prevent misinterpretations.
  162. // (Memento Murphi)!
  163. //
  164. // numops: [+][b][z][u] [r[aw]] [v[n]]
  165. // [-][e][p][s]
  166. //
  167. // + to force plus sign for positive numbers, including
  168. // unsigned packed decimal data that are not specified
  169. // as unsigned; else, a blank is output. (Does not
  170. // affect negative numbers for which a minus sign is
  171. // always output).
  172. // - to override '+' specified on 'o=' (options) command.
  173. //
  174. // b to display sign at the beginning of the number.
  175. // e to override 'b' specified on 'o=' (options) command.
  176. //
  177. // s for signed numeric output. This is the default.
  178. // u for unsigned numeric output. No sign is expressed.
  179. //
  180. // z to display leading zeros.
  181. // p to override 'z' specified on 'o=' (options) command.
  182. //
  183. // r or raw to force non-compliant binaries to be evaluated.
  184. // I.e., those whose magnitude is > normal maximum value.
  185. // e.g., 0xc757 = 51031 which is larger than 4 digits which
  186. // is the normal maximum for a 2-byte binary described
  187. // as PIC 9(4) COMP. The previous example requires the ",=5;"
  188. // parameter as well.
  189. //
  190. // v[n] to output a decimal point 'n' digits from the
  191. // right for numeric fields. If 'n' is zero or omitted,
  192. // no fractional digits are output.
  193. //
  194. // [pc=]'padch': specify the padding character for the current
  195. // field; default is space; used with "[-]padlen";
  196. // when "pc=" is not specified, sets "badchar" as
  197. // well as "padchar". Also, used for the 'f' (fill
  198. // or replace) specification.
  199. //
  200. // [bc=]'badch': specify the "erase" character for the current
  201. // field when invalid zoned/packed fields are
  202. // encountered. Default is space. When "bc=" is not
  203. // specified, sets padchar" as well as "badchar".
  204. //
  205. // The specified padchar or badchar may be an ASCII char in the
  206. // range 0x20 to 0x7e ('a', e.g.) or null ('') or it may be
  207. // specified as a hex number 0xhh. (This is probably necessary
  208. // when translating from ASCII to EBCDIC).
  209. //
  210. // Note: the apostrophes are still required: '0x99', e.g.
  211. //
  212. // #r Specify the register that contains the custom macro
  213. // to execute for the current custom field (code='c').
  214. //
  215. // : cusops - The ":" indicates the presence of custom parameters
  216. // for the custom macro (code='c').
  217. //
  218. // // starts a comment field.
  219. //
  220. // Note: as indicated by the syntax above, blank lines and comment lines
  221. // are valid. All comments and blank lines are stripped during
  222. // preprocessing.
  223. //
  224. // Note: Not described above is the "code=arg" form. Such lines are
  225. // acted upon during preprocessing and then stripped from the
  226. // working layout file. These codes are listed below.
  227. //
  228. // Current codes are:
  229. // h= (header size)
  230. // r= (input record size/type[,output record type])
  231. // e= (max error report count, error filename)
  232. // i= (1 to include field-names header files *.nam)
  233. // o= (Set default output options: '+buz[,b2z]'; '-esp' is standard)
  234. //
  235. // c= (Set field beginning column; COBOL cut & paste)
  236. // p= (Start of COBOL record description)
  237. // q= (End of COBOL record description)
  238. //
  239. // u= (e[bcdic] (default) or i[gnore]) for unspecified cols
  240. // v= (Vedit commands - executed immediately)
  241. // x= (Vedit post-processing commands)
  242. //
  243. // a= (Additional offset for unique ID calculation)
  244. // b= (Base_date for unique ID calculation)
  245. // d= (Run_date for unique ID calculation)
  246. // n= (# digits displayed for unique ID's)
  247. //
  248. // bc=(badchar)
  249. // pc=(padchar)
  250. // xrf= (use DBASE cross reference file)
  251. //
  252. // b (binary)
  253. // c (customized processing)
  254. // d (packed decimal)
  255. // e (EBCDIC)
  256. // f (fill) i.e., replace with pad char, default = Space
  257. // h (hex)
  258. // i (ignore) i.e., copy to output
  259. // l (float/double) Upto 10E18.
  260. // n (packed_no_zone)
  261. // out [fname]
  262. // q or qcd: quote and comma delimit each output field (no parms)
  263. // s (signed ASCII decimal)
  264. // u (unsigned EBCDIC numeric)
  265. // x (delete)
  266. // z (zoned decimal)
  267. //
  268. // Details for some of the above commands:
  269. //
  270. // c Customized processing:
  271. // Initialization:
  272. // v=Reg_Set(r,'macro commands') or
  273. // v=Reg_Load(r,'macfile.vdm')
  274. //
  275. // Field specification:
  276. // c col_siz [sop] [#r] [: custom parameters] [// comment]
  277. //
  278. // col_siz, and [sop] are described above.
  279. // 'r' is the number of the T-Reg containing the
  280. // customized translation commands (default=12) aka
  281. // EBC_Settings(CustomMacro).
  282. // 'custom parameters' must be parsed by the
  283. // customizing macro. E.g.,
  284. // Buf_Switch(XLayBufNum)
  285. // processing code
  286. // Buf_Switch(XDataBufNum)
  287. // '//' starts a comment field. This field is stripped
  288. // during preprocessing, so any custom parameter
  289. // cracking need not be concerned about it.
  290. //
  291. // The custom macro must entirely process its source data
  292. // from CurPos upto but not including CurPos+XInpFieldSize;
  293. // i.e., replace, delete or skip over (ignore). On exit,
  294. // CurPos must be at the byte that was located, on entry,
  295. // at CurPos + XInpFieldSize.
  296. //
  297. // Note: on entry, the current buffer is the source input
  298. // data buffer XDataBufNum; i.e., (bn==xdata).
  299. //
  300. // f Fill (overwrite) with "padchar" (default=space) or specified char. E.g.,
  301. // f cb-ce '*' // Fill columns cb through ce with asterisks.
  302. //
  303. // Useful for cleaning "filler" areas containing garbage.
  304. // Especially needed if this garbage gets translated into
  305. // weird control characters.
  306. //
  307. // h Hex - Output each byte as two hex digits '0' - '9', 'A' - 'F'.
  308. //
  309. // l Floating point (IBM 360 style).
  310. // l bc,ec[,=ndigs;] [sop] [v[n]] [// comment]
  311. //
  312. // Fixed format only, right justified; short floats (single precision)
  313. // can express seven significant digits; long floats (double precision)
  314. // can express sixteen. Values upto 10E18 can be processed; least
  315. // significant digits beyond the seventh or sixteenth are always 0.
  316. // Floating point values > 10E18 are BAD-CHAR erased. Fractions smaller
  317. // than 10E-18 are output as zeros.
  318. //
  319. // Optional 'ndigs' specifies total # digit-output columns. The
  320. // decimal point, if any, is not counted nor is the sign.
  321. //
  322. // "sop" are standard options "+bz-esp".
  323. //
  324. // 'n' specifies the number of fractional digits to display.
  325. //
  326. // "v0" or "v" outputs a decimal point with no fractional digits
  327. // displayed.
  328. //
  329. // If "v[n]" is omitted, no decimal point is output.
  330. //
  331. // q[cd] Quote and comma delimit each output field (no parms).
  332. // Each field must be specified. Since only the first letter
  333. // is examined, this may be specified as "qcd" or "quote and
  334. // comma delimit".
  335. //
  336. // s Signed ASCII field being converted to ASCII. Analagous to
  337. // signed (zoned) EBCDIC field. Presumes the final signed
  338. // byte of the field is one of (ASCII) '{', 'A' - 'R', '}'.
  339. //
  340. // u Unsigned numeric field. Needed only if an explicit decimal
  341. // point is to be output or if leading zeros are desired or
  342. // if an entirely blank/null field is to be expressed as text
  343. // zero(s).
  344. //
  345. // x Delete the field. When quoting and comma delimiting or
  346. // outputting a user defined delimiter after each field,
  347. // nothing is output, including the delimiters.
  348. //
  349. // a=n Additional offset for calculating unique ID's.
  350. // Use when processing more than one file with extracted
  351. // fields on a given day. Set greater than or equal to last
  352. // record # processed by the previous run. Not very useful.
  353. // Use the "-u n" invocation option with the "n=,,1"
  354. // layout specification as described below.
  355. //
  356. // b=date Base date for calculating unique ID's. Default is 1-1-2000.
  357. // Date must be expressed in mm/dd/yyyy format. The separator
  358. // can be one of "/\._:-". The year must be completely expressed.
  359. //
  360. // d=date Run date for calculating unique ID's. Default is current date.
  361. //
  362. // n=l,m,n Control # digits displayed for each part of the unique ID.
  363. // 'l' is the number of digits for the days-elapsed count;
  364. // 'm' is the number of digits for the record count;
  365. // 'n' is the number of digits for "run_number".
  366. // Default is "n=5,6,1". Use "n=,,0" to remove the position
  367. // reserved for the run #, if so desired. Setting the run #
  368. // requires the use of the "-u run_number" invocation option.
  369. //
  370. // c=col Set field beginning column (actually, preceding field's
  371. // ending column) for use with 'code +len' style specs
  372. // that are not contiguous with the last specified field.
  373. // Particularly useful for cut-&-pasting COBOL specs.
  374. //
  375. // e=n[,f] Control writing of error messages to error file.
  376. // Default is to write all errors to EBCDIC.ERR, including
  377. // upto 1000 occurrences of invalid compressed data items.
  378. // This command allows changing the limit for reporting invalid
  379. // compressed data items; changing the default error filename;
  380. // and disabling error writing completely.
  381. //
  382. // 'n' is the maximum # of invalid data messages.
  383. // 'f' is the name of the error file, including optional
  384. // drive and path.
  385. // Disable error messages by including "e=" by itself.
  386. // e.g., "e= // Disable writing errors to file"
  387. //
  388. // The form "e=n" reports upto 'n' errors in "ebcdic.err".
  389. // The form "e=,errfname" reports upto 1000 errors in errfname.
  390. // Alternatively, use "e=errfname".
  391. //
  392. // Note: The file ebcdic.err is always deleted at startup.
  393. // Any explicitly named error file is emptied when the
  394. // "e=" line is processed.
  395. //
  396. // Note: Errors that occur during preprocessing generally
  397. // cause processing to stop immediately.
  398. //
  399. // N.B., Errors that occur before this command is processed
  400. // are written to EBCDIC.ERR.
  401. //
  402. // i=val Flag to include header files "*.nam" at the start of each
  403. // output file that contains data. These files are expected to
  404. // consist of quoted and comma delimited field-names. "val"
  405. // is one of {0,1,off,on}, default == "off". The filename
  406. // proper of each ".nam" file must be the same as that of the
  407. // output file into which it is to be included. This option
  408. // may also be turned on with the "-u include=1" invocation
  409. // option.
  410. //
  411. // h= Size of header. Used to pass over (copy to output)
  412. // header information. Ordinarily not used.
  413. //
  414. // o=nops[,b2z]
  415. //
  416. // Examples: o=+bz // explicit '+'; leading sign; leading zeros
  417. // o=uz // Unsigned numeric values; leading zeros
  418. // Default: o=-eps// blanked positive sign; trailing sign;
  419. // // blank padding; numbers are signed values
  420. //
  421. // Options are:
  422. // + for explicit plus sign for positive/unsigned numbers.
  423. // - to output a space instead of '+' (default).
  424. //
  425. // b to output the sign at the beginning of the number.
  426. // e to output the sign at the end of the number (default).
  427. //
  428. // s (signed) to express the sign at all. (Default).
  429. // u (unsigned) to suppress the sign.
  430. //
  431. // z to output leading zeros.
  432. // p for blank padding (default).
  433. //
  434. // ,b2z specifies that packed decimals, binaries and unsigned
  435. // numeric fields that are entirely blank or null will be
  436. // output as zero(s) formatted according to the other
  437. // options.
  438. //
  439. // This sets default output actions for 'b', 'd', 'l', 'n',
  440. // 'u' & 'z' fields. The defaults may be overriden by the
  441. // individual field specifications. E.g., d 5,12 +bz
  442. //
  443. // At most only one 'o=' line is needed. If more are used, the
  444. // effect is cumulative. Since these lines are preprocessed and
  445. // then stripped, there is little reason to use more than one
  446. // line.
  447. //
  448. // p=[x] Specifies start of COBOL picture specifications block;
  449. // 'x' to output explicit decimal point for 9...v99... formats.
  450. // Otherwise, no decimal point is output. (If initial field is
  451. // not contiguous with last specified field, follow with
  452. // "c=colm1" where colm1 is the starting column less one).
  453. //
  454. // q= Specifies end of COBOL specifications block. Multiple
  455. // blocks may be specified within the data description file.
  456. //
  457. // r= Record size 'r= input_size_or_type[,output_type]', where
  458. // type may be 0, 1, 2 or "f" (output only). If no output
  459. // record type is specified, the input type is used.
  460. //
  461. // When input/output records are/will be terminated by Carriage-
  462. // Return and/or Line-Feed, use record type:
  463. // 0 for <cr><lf> (DOS)
  464. // 1 for <lf> (UNIX)
  465. // 2 for <cr> (MAC)
  466. //
  467. // Record terminators are stripped from the input record.
  468. // They will then be appended to the output if output_type
  469. // (explicit or default) is one of the above three types.
  470. //
  471. // Record terminators are not normally used with EBCDIC data
  472. // files. They cannot be used when the data file contains
  473. // binary fields.
  474. //
  475. // When records are unterminated, specify the input record
  476. // length upto but not including the variable portion of
  477. // variable length records; i.e., fields occurring after a 'rf'
  478. // specification (OCCURS .... DEPENDING ON ... clause in COBOL).
  479. //
  480. // When unterminated multiple record types differing in length
  481. // are being processed, setting input_record_size_or_type to the
  482. // size of the largest record is probably appropriate.
  483. //
  484. // The input record size must be specified for unterminated
  485. // records; it may also be specified for fixed length records
  486. // even when they have terminating character(s). Be sure to
  487. // include the terminators in the record length and process
  488. // them in the .LAY file.
  489. //
  490. // Normally, no length is specified for the output record since
  491. // it is determined dynamically. Thus, for fixed length input
  492. // and output records, just specify the input record size:
  493. // "r=100", e.g.
  494. //
  495. // If the output is to be unterminated but the input is
  496. // terminated, use 'f' for the output_type. Thus, "r=0,f"
  497. // inputs records terminated by Carriage-Return and Line-Feed
  498. // but strips them from the output ("f" stands for "fixed").
  499. //
  500. // Examples: r=100,0 //Input record size = 100
  501. // //append <cr><lf> on output
  502. //
  503. // r=100 //Input record size = 100
  504. // //Output records are unterminated
  505. //
  506. // r=0 //Both input and output records
  507. // //terminated by <cr><lf>
  508. //
  509. // r=0,1 //Input records terminated by <cr><lf>
  510. // //Output records terminated by <lf>
  511. //
  512. // u=arg Specify action for non-specified fields.
  513. // arg=ebcdic to translate from EBCDIC to ASCII;
  514. // arg=ignore to simply copy the input columns to output.
  515. // Only the initial letter need be specified.
  516. // E.g, u=i // Copy unspecified columns to output.
  517. //
  518. // v= Vedit commands are executed as soon as they are encountered
  519. // and are then stripped from the layout file. The commands must
  520. // fit on one line but as many "v=" lines may be used as needed.
  521. // One line is sufficient for executing a macro file via a text
  522. // register.
  523. //
  524. // May be used to put a user-defined output field delimiter
  525. // (string) into T-Reg[XDREG]: e.g., v=Reg_Set(XDREG,"|"); or
  526. // v=rs(XDREG,' ^ '). Unlike quoted and comma delimited fields,
  527. // not all fields need be specified; a group of unspecified
  528. // fields will have just one instance of the delimiter string
  529. // appended to the end of the group.
  530. //
  531. // x= Vedit commands are stored into T-Reg[14]. They are then
  532. // executed in a post processing pass after all other commands
  533. // have been applied to the entire file. These commands must
  534. // fit on one line. Use Call_File() if more lines are needed.
  535. //
  536. // xrf=arg Use DBASE cross reference file fname.XRF for generating the DBASE
  537. // header record. "arg" = "1" or "on" to use; "0" or "off" may be
  538. // used to generate the names automatically or the "xrf" line may
  539. // be omitted to achieve the same result. If the file fname.XRF is
  540. // empty, the field names will be automatically generated.
  541. //
  542. // example EBCDIC-2.LAY file:
  543. //
  544. // // Each input record is 256 bytes long.
  545. // // Output records have <cr><lf> appended.
  546. // // The first 3 fields are packed decimal.
  547. // // Columns 42-45 and 50-53 are binary.
  548. // // Columns 54-57 are zoned decimal.
  549. // //
  550. // r=256,0 //Size of input records
  551. // //<cr><lf> appended to output
  552. // d 7-10 //Packed decimal
  553. // d 20-24 //Also packed decimal, (default = previous)
  554. // d 32-38
  555. // b 42-45 //Binary
  556. // b 50-53
  557. // z 54-57 //Zoned decimal
  558. // //
  559. // // The final fields contain leading zeros that are
  560. // // to be converted to blanks with 1 leading blank inserted.
  561. // //
  562. // v=RegLoad(EBC_Settings(CustomMacro),"nolzero.cus")
  563. // c 60-69 #12 // Field size remains contstant
  564. // c 70-75 // Uses T-Reg 12 for custom processing
  565. //
  566. //////////////////////////////////////////////////////////////////////////////
  567. //
  568. // Numeric register usage:
  569. //
  570. // #0 - #5 Temp
  571. // #3 Preprocessing: field counter
  572. // #4 Preprocessing: max # fields in any record
  573. // #8 Reserved for levels 3 & 4
  574. // #10-#13 Temp; used as such by customizing macros
  575. // Note: #10 - #74 are used implicitly by UNPAKDEC.VDM.
  576. // #14-#19 Reserved for customizing macros
  577. // #15 Preprocessing: temp
  578. // #16 Preprocessing: buffer ID of extraction file
  579. // #17 Preprocessing: 'out' counter
  580. // #18 Preprocessing: flag that .VCM customization submacros have been loaded
  581. // #26 DBASE field counter
  582. // #27 Preprocessing: DBASE output record counter
  583. // #28 DBASE flag
  584. // #31-#39 Statistics
  585. // #40 Run # size in unique ID
  586. // #41 Data "segment" count. Normally set by "-u count".
  587. // #42 Unique ID control: {0,1,2} for {off,auto,all}; set by UID=on,off,auto
  588. // or "-u uid=n"
  589. // #43 Flag to include ".nam" header file at start of each output file
  590. // #44 Explicit decimal point flag (default = 1)
  591. // #50 Run date for unique ID's (preprocessing); # digits to display (processing)
  592. // #51 Preprocessing: statistics
  593. // #52 Reserved for level 4
  594. // #54 Flag that extraction file(s) present.
  595. // #55 Julian base date for unique ID generation (default = 1-1-2000)
  596. // #56 Reserved for level 4
  597. // #57 Default input record type or length ("r={type|length}");
  598. // Config(F_F_TYPE) when no "r="
  599. // #58 Preprocessing: statistics
  600. // #59 Preprocessing: record-types counter (= 1, always)
  601. // #61 Additional offset for unique ID calculation
  602. // #62 # digits displayed for unique ID (3 parts)
  603. // #63 Buffer ID of .xrf file for obtaining DBASE field names or zero
  604. // #64 Flag variable (hex values)
  605. // 01 to use "fname.LAY" instead of EBCDIC.LAY
  606. // 02 to stop after COBOL preprocessing
  607. // 04 to force explicit decimal point when translating
  608. // COBOL picture lines of type 9...v9...
  609. // 08 to call T-Reg[14] for post processing ('x=').
  610. // 40 when explicit data layout file "lname"
  611. // 100 stops after preprocessing (doesn't execute v=)
  612. // 200 Flag to COBOL2V.VDM to run as submacro.
  613. // 800 to prevent generating unique ID's; archaic; use uid=off
  614. // #65 T-Reg offset for running under WILDFILE.VDM
  615. // #66 Save WILDFILE's Locked-in-Macro ID.
  616. // #67 Input record type (r=type): 0,1,2,3,6=fixed (see #87)
  617. // Determined from Config(F_F_TYPE) if no "r="
  618. // #68 Output record type: 0,1,2,6=fixed,7=DBASE (see #88)
  619. // #69 Zero 1st time; else 1
  620. // #73 Reserved for levels 3 & 4
  621. // #74 Reserved for level 4
  622. // #75 Main output buffer #
  623. // #76 Approx record size
  624. // #77 Current output buffer # for 'out' extractions
  625. // Temporary for initial statistics
  626. // #78 Temporary for stacking/popping XLASTCOLPROC with #77
  627. // #79 Reserved for level 4
  628. // #81 Preprocessing: temporary
  629. // #82 Reserved for levels 3 & 4
  630. // #85 Current data type (b,c,d,e,f,i,l,n,s,u,x,z)
  631. // #86 File header size (h=size) or -1
  632. // #87 Current input record size (r=size) or zero (see #67)
  633. // #88 Output record size or zero (see #68)
  634. // #90 Preprocessing: source data buffer
  635. // #91 Wildfile running flag
  636. // #92 Preprocessing: data layout buffer
  637. // #93 1st line number to convert
  638. // #99 ID flag, possibly set by WILDFILE macro
  639. //
  640. //////////////////////////////////////////////////////////////////////////////
  641. //
  642. // Text register usage:
  643. // Registers 10 - 19 are offset by Num_Reg(65) for running under WILDFILE.
  644. //
  645. // Note: cannot push COBOL preprocessing text register.
  646. // This register is loaded at startup before text registers are pushed.
  647. // This is partly due to the comment stripping processor and partly
  648. // due to WILDFILE interaction.
  649. //
  650. // 2 table of "raw" binary sizes
  651. // 3 DBASE preprocessing: record name
  652. // 4 table of "cooked" binary sizes
  653. // 5 Temporary layout output pathname for editing purposes
  654. // 6 Temporary data output pathame for editing purposes
  655. // 7 Full path to output subdirectory
  656. // 8 Full pathname of .xrf file (DBASE only)
  657. // 9 .lay input pathname.
  658. // 10 Data output pathname.
  659. // 11 Used to execute Vedit commands ('v=') from EBCDIC.LAY
  660. // Used initially in constructing output filenames
  661. // 12 Default T-Reg for custom decoding ('c').
  662. // 13 Default T-Reg for custom record determination ('tc').
  663. // 14 Optional post-processing macro ('x=')
  664. // 15 Source data file's full pathname.
  665. // "NEXT_PEER_CLAUSE" sub-macro (COBOL preprocessing).
  666. // 16 Explicit decimal point handling.
  667. // OCCURS clause sub-macro (COBOL preprocessing).
  668. // 17 Optional delimiter string output after each field.
  669. // REDEFINES clause commenting-out (COBOL preprocessing).
  670. // 18 Holds (path)name of error file. None when empty.
  671. // 19 Main COBOL preprocessing macro. Must not be pushed!
  672. // 46 - 54 Submacros
  673. // 55 - 56 Reserved for COBOL preprocessing.
  674. // 57 - 63 Submacros
  675. // 'A' - 'Z' Code to process each data type (T-Regs 65 - 90).
  676. // 101 Data error processing. Comment stripping, initially.
  677. // 102 Unexpected error breakout trapping macro.
  678. //
  679. //////////////////////////////////////////////////////////////////////////////
  680. // //
  681. // Execution starts here. //
  682. // //
  683. //////////////////////////////////////////////////////////////////////////////
  684. //
  685. // Speed optimize the EBCDIC-2 macro itself.
  686. //
  687. if (File_Exist(VEDIT_TEMP)==0) { //Create vedit/temp dir if needed
  688. File_Mkdir(VEDIT_TEMP)
  689. }
  690. if (#99==0x57495C44&&#91){goto noprep} // No prep for 2nd and later WILDFILE pass
  691. Reg_Prep() // Can't be nested when self-prepping
  692. :NOPREP:
  693. //
  694. // Initialize optional delimiter(s) to be output after each field.
  695. // Overriden by any "v=rs(XDREG,'delimiter string')" in the layout file.
  696. //
  697. #103 = Macro_Num // #103 = T-Reg # this macro is in
  698. if (#99==0x57495C44) { // When WILDFILE is running...
  699. if (!#91){ // Set == 0 by Wildfile
  700. #65 = Reg_Free // #65 = 1st available T-Reg
  701. #69 = 0 // 1st time in
  702. }
  703. } else {
  704. #65 = #69 = 0 // For backwards compatibility
  705. }
  706. #91++ // Update Wildfile pass counter
  707. if (!#69){ // 1st time in
  708. //
  709. // Check version #.
  710. //
  711. #0 = 520
  712. if (Version_Num<#0) {
  713. Reg_Set(1,"EBCDIC translation package requires VEDIT PLUS version ")
  714. #1 = #0/100
  715. #2 = Remainder
  716. ITOA(#1,1,LEFT+NOCR+APPEND)
  717. Reg_Set(1,".",APPEND)
  718. ITOA(#2,1,LEFT+NOCR+APPEND)
  719. Reg_Set(1," or later.",APPEND)
  720. Alert()
  721. Dialog_Input_1(0,`"Error","|@(1)"`)
  722. if (Is_Quiet) {
  723. XALL(1)
  724. } else {
  725. Reg_Empty(0)
  726. Reg_Empty(1)
  727. Break_Out(EXTRA)
  728. }
  729. }
  730. //
  731. // Load T-Reg[19] with COBOL preprocessor and speed optimize the code.
  732. //
  733. Reg_Empty(#65+19) // In case COBOL2V can't be found
  734. Reg_Load(#65+19,"COBOL2V.VDM",EXTRA+NOERR)
  735. Reg_Prep(#65+19)
  736. //
  737. // Use T-Reg[1] to load and speed optimize submacros.
  738. // Then distribute the code to their proper T-Regs.
  739. //
  740. Reg_Set(1,$
  741. //////////////////////////////////////////////////////////////////////////
  742. // //
  743. // Submacros for EBCDIC-2.VDM //
  744. // Last change: 07/24/2003 //
  745. // //
  746. // Note: most named submacros are now contained in EBCDIC-2.VCM //
  747. // for use by custom macros. They are reserved for this //
  748. // purpose. These are: a-f, h, i, s, u, x & z. //
  749. // //
  750. // Note: Named submacros 'a' - 'z' are actually stored into //
  751. // T-Reg['A'] - T-Reg['Z']. To invoke a given named macro, //
  752. // convert its name to upper case; e.g., call('r'-32). //
  753. // //
  754. //////////////////////////////////////////////////////////////////////////
  755. //
  756. // T-Reg[l] - Floating Point.
  757. //
  758. Reg_Set(l,`
  759. //
  760. // "NULL" for undefined?
  761. // Go figure!
  762. //
  763. if ((match("|{|HD5|HE4|HD3|HD3,|H80|H00|H00|H00}")==0)||CC==0){
  764. #7 = 0
  765. #9 = EBC_Settings(Field_Size)
  766. if (XFSIZ>4){ // DOUBLE
  767. if (#9==0){
  768. #7 = 16
  769. }
  770. } else { // FLOAT
  771. if (#9==0){
  772. #7 = 7
  773. }
  774. }
  775. if (#9==0){
  776. #9=#7
  777. }
  778. if (EBC_Settings(Out_Point) & 0xff){
  779. #9++
  780. }
  781. if (!EBC_Settings(Unsigned)){
  782. #9++
  783. }
  784. DC(XFSIZ)
  785. IC(' ',COUNT,#9)
  786. }else{
  787. #1=upf('l',XFSIZ)
  788. if (#1) {if (#38){call(101,"DATERR")}}
  789. }
  790. `) // [l]
  791. //
  792. // T-Reg[48] - Unique ID Processing.
  793. //
  794. Reg_Set(48,`
  795. //
  796. // UID - Generate unique ID at end of fixed portion of variable length record.
  797. // Similar to 'rb' & 're' processing, above.
  798. // Enter: #40 = # digits to display segment count of unique ID.
  799. // #50 = # digits to display elapsed days count of unique ID.
  800. // #62 = # digits to display record count of unique ID.
  801. // #41 = data segment/section/run #.
  802. // #55 = days elapsed since base date.
  803. // XRecNum = record #.
  804. // #61 = additional offset when more than 1 run per day.
  805. //
  806. :UID:
  807. if (XQCD){ // If Quoting & comma delimiting...
  808. IT(',"') // Output comma and quote mark
  809. NI(#55,SIMPLE+FILL+COUNT,#50) // Output JDate
  810. if (#40>0){
  811. NI(#41,SIMPLE+FILL+COUNT,#40) // Output the segment #
  812. }
  813. NI(XRecNum+#61,SIMPLE+FILL+COUNT,#62) // Output the record #
  814. IC('"') // Output quote mark
  815. } else { // Else...
  816. IC(' ') // Space for separation
  817. NI(#55,SIMPLE+FILL+COUNT,#50) // Output JDate
  818. if (#40>0){
  819. NI(#41,SIMPLE+FILL+COUNT,#40) // Output the segment #
  820. }
  821. NI(XRecNum+#61,SIMPLE+FILL+COUNT,#62) // Output the record #
  822. }
  823. `) // [48]
  824. //
  825. // T-Reg[49] - DBASE preprocessing.
  826. //
  827. Reg_Set(49,`
  828. //
  829. // DBINIT0 - Zero-out DBASE header's 1st 32-byte structure; insert '3' for
  830. // signature and current date in YMD (binary) format where
  831. // 'y' = year -1900.
  832. // Initialize record length (pos 10,11) = 1 for the initial blank
  833. // column, the deleted-record field.
  834. // Set 0x0d byte at end of header.
  835. //
  836. // Enter: #16 = ID of extraction buffer
  837. // #28 > 0 (DBASE flag)
  838. //
  839. :DBINIT0:
  840. Num_Push(0,5)
  841. Buf_Switch(#16) // DBASE output file
  842. Del_Block(0,FileSize)
  843. //
  844. // Zero-out initial header structure.
  845. // Set 0x0d byte at end.
  846. //
  847. Ins_Char(0,COUNT,32)
  848. Ins_Char(0x0d) // End of header byte
  849. Config(F_REC_HEAD,FSize,LOCAL)
  850. //
  851. // Set record-length to 1 to account for initial "deleted-record" field.
  852. //
  853. GP(10)
  854. Ins_Char(1,OVERWRITE)
  855. //
  856. // Set #1,#2,#3 = current date = MDY.
  857. //
  858. Buf_Switch(Buf_Free(EXTRA))
  859. OI() DATE(NOMSG) OI(CLEAR)
  860. BOF()
  861. #1=NumEval(ADVANCE+SUPPRESS)
  862. c(1)
  863. #2=NumEval(ADVANCE+SUPPRESS)
  864. c(1)
  865. #3=NumEval()
  866. Buf_Quit(OK)
  867. //
  868. // Enter DBASE signature and current date as YMD (binary).
  869. //
  870. Buf_Switch(#16)
  871. BOF()
  872. Ins_Char(3,OVERWRITE)
  873. Ins_Char(#3-1900,OVERWRITE)
  874. Ins_Char(#1,OVERWRITE)
  875. Ins_Char(#2,OVERWRITE)
  876. //
  877. Buf_Switch(XLay)
  878. Num_Pop(0,5)
  879. return
  880. `) // [49]
  881. //
  882. // T-Reg[50] - Output diversion.
  883. //
  884. Reg_Set(50,`
  885. //
  886. // POST - Diversion termination.
  887. // Enter: Buf_Num = XLayBufNum.
  888. // Retrn: Buf_Num = XLayBufNum.
  889. //
  890. :POST:
  891. BS(XData)
  892. if (#42){ // If Unique ID wanted...
  893. if (XQCD){ // If Quoting & comma delimiting...
  894. IT(',"') // Output comma and opening quote
  895. NI(#55,SIMPLE+FILL+COUNT,#50) // Output JDate
  896. if (#40>0){
  897. NI(#41,SIMPLE+FILL+COUNT,#40) // Output the segment #
  898. }
  899. NI(XRecNum+#61,SIMPLE+FILL+COUNT,#62) // Output the record #
  900. IT('"') // Output closing quote
  901. } else { // Else...
  902. IC(' ') // Space for separation
  903. NI(#55,SIMPLE+FILL+COUNT,#50) // Output JDate
  904. if (#40>0){
  905. NI(#41,SIMPLE+FILL+COUNT,#40) // Output the segment #
  906. }
  907. NI(XRecNum+#61,SIMPLE+FILL+COUNT,#62) // Output the record #
  908. }
  909. }
  910. //
  911. // Move translated input fields into output file.
  912. //
  913. RCB(0,0,CP,DELETE)
  914. BS(#77)
  915. EOF()
  916. if (RSIZE(0)>0){
  917. if (#28&&AtBOL){
  918. ic(' ')
  919. // XLCP(XLCP+1) May need to update when appending allowed...
  920. }
  921. RI(0)
  922. }
  923. //
  924. // Append newline char(s), if specified.
  925. //
  926. if ((0<=#68)&&(#68<6)){
  927. if ((#68&1)==0){IC(0x0d)} // DOS and MAC
  928. if (#68<2){IC(0x0a)} // DOS and UNIX
  929. }
  930. //
  931. BS(XLay)
  932. return
  933. //
  934. // PRE - Diversion initialization.
  935. // Any passed over bytes translated.
  936. // All processed bytes moved into the output buffer.
  937. // Enter: Buf_Num = layout buffer XLayBufNum.
  938. // Retrn: Buf_Num = layout buffer XLayBufNum.
  939. //
  940. :PRE:
  941. //
  942. // Set XNextCol = XAdjBeg = column # of 1st field adjusted for inflation
  943. // (The 1st column must be specified by next layout line).
  944. // Do default processing on any passed-over fields.
  945. //
  946. SPOS()
  947. s("|<|Y|w",advance) //Pick up start of first field from next layout line
  948. XAB(NE()+XSO+XI) //XAdjBeg = beginning column # (inflation adjusted)
  949. RPOS() //Back to "rb" line
  950. call(57) //Translate any passed-over fields
  951. //XNextCol = 1st column #, inflation adjusted
  952. //
  953. // Move translated bytes into output buffer via T-Reg[0].
  954. //
  955. RCB(0,0,CP,DELETE) //Move bytes into T-Reg[0]
  956. BS(#77) //Switch to output buffer
  957. EOF()
  958. //
  959. // Include any .nam header file, if so specified.
  960. //
  961. if (#43&&AtBOF){
  962. Ins_File("|(FILE_ONLY).nam")
  963. }
  964. if (RSIZE(0)>0){
  965. if (#28&&AtBOL){
  966. ic(' ')
  967. XLCP(XLCP+1) // Note: XLCP already reflects the processed output length
  968. }
  969. RI(0) //Insert the bytes
  970. }
  971. //
  972. BS(XLay) //Reenter layout buffer
  973. return
  974. `) // [50]
  975. //
  976. // T-Reg[53] - Name Pre-Processor (error checking).
  977. // Name may be quoted or not; quotes stripped.
  978. // Return: T-Reg[0] = name
  979. // Cur_Pos past name["].
  980. //
  981. Reg_Set(53,`
  982. if (cc!='''&&cc!='"'){
  983. Set_Marker(8,Cur_Pos)
  984. sb("|{|b,//,|>}",cp,eolpos+1)
  985. Set_Marker(9,Cur_Pos)
  986. } else {
  987. rcb(0,cp,cp+1,norestore)
  988. Set_Marker(8,Cur_Pos)
  989. if(!sb(@0,cp,eolpos,advance+noerr)){
  990. goto BADLAY
  991. }
  992. Set_Marker(9,Cur_Pos-1)
  993. }
  994. rcb(0,Marker(8),Marker(9))
  995. return
  996. //
  997. :BADLAY:
  998. chain(#103,"BAD_LAY")
  999. `) // [53]
  1000. //
  1001. // T-Reg[54] - Name Processor.
  1002. // Name may be quoted or not; quotes stripped.
  1003. // Return: T-Reg[0] = name
  1004. // Cur_Pos past name["].
  1005. //
  1006. //
  1007. Reg_Set(54,`
  1008. if (cc!='''&&cc!='"'){
  1009. SM(8,CP)
  1010. sb("|{|b,//,|>}",cp,eolpos+1)
  1011. SM(9,CP)
  1012. }else{
  1013. rcb(0,cp,cp+1,norestore)
  1014. SM(8,Cur_Pos)
  1015. sb(@0,cp,eolpos,advance)
  1016. SM(9,CP-1)
  1017. }
  1018. RCB(0,Marker(8),Marker(9))
  1019. `) // [54]
  1020. //////////////////////////////////////////////////////////
  1021. // //
  1022. // T-Reg[55] & T-Reg[56] //
  1023. // Reserved for COBOL2V.VDM //
  1024. // //
  1025. //////////////////////////////////////////////////////////
  1026. //
  1027. // T-Reg[57] - Perform default translation on passed-over fields.
  1028. //
  1029. Reg_Set(57,`
  1030. BS(XData)
  1031. if ((#0=XAB-XNC)>0){
  1032. XDC(XDC+#0) // Update total-bytes-processed counter
  1033. XLCP(XLCP+#0)
  1034. if (XDefType=='e'){
  1035. TRB(CP,CP+#0,REVERSE+NORESTORE)
  1036. }else{if (XDefType=='a'){
  1037. TRB(CP,CP+#0,NORESTORE)
  1038. }else{
  1039. C(#0)
  1040. }}
  1041. XNC(XAB)
  1042. }
  1043. `) // [57]
  1044. //
  1045. // T-Reg[58] - Extraction Filename Processor.
  1046. //
  1047. // Enter: Buf_Num = XLayBufNum.
  1048. // Retrn: #77 = output buffer ID.
  1049. // #54 |= 1 (flag to output unique # at end of main output record).
  1050. // Buf_Num = XLayBufNum.
  1051. //
  1052. // Note: to force UID's on main records that have no extracted subsections,
  1053. // use uid=on option in the .lay file or as a "-u" invocation parameter.
  1054. //
  1055. Reg_Set(58,`
  1056. call(54) // T-Reg[0] = name
  1057. bs(#75) // Switch to main buffer so that we can
  1058. // use e.g. tx "|(FILEONLY).as1"
  1059. FO("|@(0)",NOMSG+NOEVENT)
  1060. #77=BN // #77 = output buffer
  1061. #54 = #54 | 1
  1062. XLCP(0)
  1063. BS(XLay)
  1064. `) // [58]
  1065. //
  1066. // T-Reg[59] - Extraction Filename Preprocessor.
  1067. //
  1068. // Processes 'code "filename"[,R]' where 'R' is a one or two letter
  1069. // record name for DBASE output.
  1070. // Deletes any existing file.
  1071. // Opens an empty file.
  1072. //
  1073. // For DBASE, generates 1st header row and sets T-Reg[3] <== 'R', if
  1074. // specified.
  1075. //
  1076. // Enter: #28 = DBASE flag.
  1077. // Retrn: #16 = buffer ID of extraction file.
  1078. // #27++ DBASE output record counter.
  1079. // [3] = #28 && 'R' present ? upto 1st 2 letters of "R" : [3]
  1080. //
  1081. // Called when preprocessing 'out'.
  1082. //
  1083. Reg_Set(59,`
  1084. call(53) // T-Reg[0] = filename
  1085. //
  1086. //
  1087. //
  1088. if (#28) { // If DBASE...
  1089. if ( match("|[|w],|[|w]",ADVANCE)==0) {
  1090. if (match("|a|[|a]")==0){
  1091. RegCopyBlock(3,cp,cp+cmat,norestore)
  1092. }
  1093. }
  1094. }
  1095. //
  1096. #27++
  1097. if (Buf_Free()>0){
  1098. bs(#75) // Switch to main buffer so that we can
  1099. // use e.g. tx "|(FILEONLY).as1"
  1100. File_Delete(@0,OK+NOERR)
  1101. FO("|@(0)",OVERWRITE+NOMSG+NOERR+NOEVENT)
  1102. #16 = Buf_Num
  1103. if (#68<6) {
  1104. Config(F_F_TYPE,#68,LOCAL)
  1105. } else {
  1106. if (#28) { // If DBASE...
  1107. Config(F_F_TYPE,32,LOCAL) // Header consists of 32-byte structures
  1108. } else { // else...
  1109. Config(F_F_TYPE,64,LOCAL) // For now...
  1110. }
  1111. }
  1112. } else {
  1113. goto TOOMANY
  1114. }
  1115. //
  1116. // For DBASE, initialize 1st 32-byte header structure; append terminating <cr>.
  1117. //
  1118. if (#28) { call(49) } // DBINIT0()
  1119. //
  1120. Buf_Switch(XLay)
  1121. return
  1122. :TOOMANY:
  1123. chain(#103,"TOO_MANY")
  1124. :BADLAY:
  1125. chain(#103,"BAD_LAY")
  1126. `) // [59]
  1127. //
  1128. // T-Reg[62] - Progress Display.
  1129. //
  1130. // First time, display estimated processing time.
  1131. // Also display persistent "Converted records: "
  1132. // Every time, display count and percentage of records processed.
  1133. //
  1134. Reg_Set(62,`
  1135. if (XRecNum==#31){call(63)}
  1136. WH(#33)
  1137. NT(XRecNum,NOCR) // count
  1138. #37=FSize-CP
  1139. if (#37>1000000){#34=100-(#37/(#36/100))}
  1140. else{if (#36==0){#34=100}
  1141. else{#34=100-((100*#37)/#36)}
  1142. }
  1143. Message(" (")
  1144. NT(#34,LEFT+NOCR) // percentage
  1145. Message("%)")
  1146. `) // [62] Progress Display
  1147. //
  1148. // T-Reg[63] - Progress Display (Initial Message).
  1149. //
  1150. // Display estimated processing time.
  1151. // Also display persistent "Converted records: "
  1152. // Empties itself on exit.
  1153. //
  1154. Reg_Set(63,`
  1155. #35=TT
  1156. WH(1)
  1157. Message("Estimated processing time is ")
  1158. #34=((#35-#32)*((#36/(#36-FSize+CP)))+500)/1000
  1159. NT(#34,LEFT+NOCR)
  1160. Message(" seconds\n")
  1161. Message("Converted records: ")
  1162. #33=WH
  1163. RE(MN,EXTRA)
  1164. `) // [63] Progress Display (Initial Message)
  1165. ///////////// [65] - [90] correspond to [A] - [Z], so DO NOT USE ////////////
  1166. //
  1167. // T-Reg[101] - Process invalid data error messages.
  1168. //
  1169. //
  1170. // DATERR - Report errors decompressing packed data, if enabled.
  1171. // On first error, report name of file being translated,
  1172. // the name of the edited layout file and a short description
  1173. // of a report line:
  1174. // XRecNum (data record #)
  1175. // .TMP layout line #
  1176. // the layout line itself
  1177. // position in the input file at which the data field began
  1178. // the source bytes themselves (in hex format).
  1179. // Upto #38 errors (default 1000) will be reported.
  1180. //
  1181. // Enter: T-Reg[103] = source bytes.
  1182. //
  1183. Reg_Set(101,`
  1184. :DATERR:
  1185. if (RSize(#65+18) && #38){ // If error reporting enabled...
  1186. num_push(1,10)
  1187. #1 = bn // Store current edit buffer id
  1188. //
  1189. // Set T-Reg[0] = offended layout line.
  1190. //
  1191. bs(XLay) // Switch to the edited layout file
  1192. char(-newline_chars)
  1193. rc(0,0) // Copy the line into T-Reg[0]
  1194. #2 = Cur_Line // Get its line #
  1195. line(1)
  1196. //
  1197. // Set T-Reg[1] = pathname of edited layout file layout.tmp
  1198. //
  1199. or(1) // Begin diversion into T-Reg[1]
  1200. nw(EXTRA+NOMSG) // Get full pathname of the edited layout file
  1201. or(CLEAR) // Turn diversion off
  1202. //
  1203. // On first error, report general information.
  1204. //
  1205. File_Open("|@(#65+18)",OVERWRITE+NOERR+NOMSG) // Switch to the error file
  1206. if ( File_Size == 0 ) {
  1207. //
  1208. // Output name of source data file.
  1209. //
  1210. Ins_Text("***** Invalid compressed data item(s) in ")
  1211. Reg_Ins(#65+15)
  1212. Ins_Newline(2)
  1213. //
  1214. // Describe error report line.
  1215. //
  1216. Ins_Text("line = layout line number from edited file ")
  1217. ri(1); re(1)
  1218. Ins_Text("record = source record number");in
  1219. Ins_Text("location = source file position of start of invalid data item (from 0)");in
  1220. in(2)
  1221. Ins_Text(" line data descriptor record location data item (hex)");in
  1222. Ins_Text(" ==== =============== ====== ======== ===============");in
  1223. }
  1224. //
  1225. // Report the edited layout line #.
  1226. //
  1227. Ins_Text(" ")
  1228. ni(#2,NOCR) // edited layout line #
  1229. //
  1230. // Include the edited layout line.
  1231. //
  1232. Ins_Text(" ")
  1233. ri(0) // The edited layout line
  1234. //
  1235. // Report the data record #.
  1236. //
  1237. Ins_Char(' ', COUNT, BOL_Pos + 27 - Cur_Pos )
  1238. Del_Block(BOL_Pos+27,cp)
  1239. ni(XRecNum,FORCE+NOCR) // data record #
  1240. //
  1241. // Report the field's starting location in the source file (from 0).
  1242. //
  1243. bs(XData) // Switch to the data source file
  1244. #3 = #36 - (File_Size - Cur_Pos) - XFSIZ
  1245. File_Open("|@(#65+18)",NOMSG) // Switch back to the error file
  1246. Ins_Text(" ")
  1247. ni(#3,FORCE+NOCR) // The field's starting position
  1248. //
  1249. // Display the source field in hex.
  1250. //
  1251. Ins_Text(" ")
  1252. Out_Ins()
  1253. Reg_Type(103,0x800) // Display in hex format
  1254. Out_Ins(CLEAR)
  1255. Ins_Newline(1)
  1256. //
  1257. // Finish up and return.
  1258. //
  1259. #38--
  1260. bs(#1)
  1261. num_pop(1,10)
  1262. }
  1263. return
  1264. `) // [101,DATERR]
  1265. //
  1266. // T-Reg[102] - Unexpected error breakout trap.
  1267. // Writes message into error file.
  1268. // Restores some original config values.
  1269. // Terminates.
  1270. //
  1271. Reg_Set(102,`
  1272. Reg_Lock_Macro(CLEAR) // Disable further error trapping
  1273. Reg_Empty(0)
  1274. File_Open("|@(#65+18)",OVERWRITE+NOERR+NOMSG) // Access error file
  1275. EOF
  1276. #0 = Cur_Pos
  1277. Ins_Newline()
  1278. Ins_Text("***** Unexpected breakout occurred.")
  1279. Ins_Newline()
  1280. #1 = Cur_Pos
  1281. Reg_Ins(120)
  1282. Reg_Copy_Block(0,#0,#1)
  1283. Reg_Push(0,0)
  1284. Call(#103,"CleanUp")
  1285. Call(#103,"CloseErr")
  1286. Reg_Pop(0,0)
  1287. Num_Pop(70,99) //Restore numeric regs
  1288. Num_Pop(0,59)
  1289. Config(U_AUTO_CFG,#0) //Restore user's config values
  1290. Config(F_AUTO_SAVE,#1)
  1291. Config(F_OVER_MODE,#2)
  1292. // no Config(F_F_TYPE,#3)
  1293. // no Config(F_REC_HEAD,#4)
  1294. Config(E_EXP_TAB,#5)
  1295. Config(E_RETAB_BK,#6)
  1296. Config(E_RETAB_FILL,#7&0xff)
  1297. Config(S_E_MORE,#8)
  1298. Config(D_DSP_WRAP,#9)
  1299. Num_Pop(0,10) //Restore remaining user numregs
  1300. Reg_Lock_Macro(#66)
  1301. #69 = 1 //WILDFILE flag for next time in
  1302. if (Is_Quiet || Is_Option(y)){
  1303. XALL(1)
  1304. } else {
  1305. if (Reg_Size(0)){
  1306. Reg_Type(0)
  1307. }
  1308. if (#105){
  1309. vm(SET)
  1310. }
  1311. }
  1312. `) // [102] Unexpected Error Breakout
  1313. $) // [1] - Submacros
  1314. Reg_Prep(1)
  1315. Call(1)
  1316. Reg_Empty(1)
  1317. } // 1st time in
  1318. :START:
  1319. Num_Push(0,10)
  1320. #0 = Config(U_AUTO_CFG,0) // Turn off auto-save-config
  1321. #1 = Config(F_AUTO_SAVE,0) // Turn off auto-save-changes every x minutes
  1322. #2 = Config(F_OVER_MODE,0) // Allow insert/delete even for fixed-records
  1323. #3 = Config(F_F_TYPE)
  1324. #4 = Config(F_REC_HEAD)
  1325. #5 = Config(E_EXP_TAB) // Tabs complicate COBOL processing
  1326. #6 = Config(E_RETAB_BK)
  1327. #7 = Config(E_RETAB_FILL)
  1328. #8 = Config(S_E_MORE,0)
  1329. #9 = Config(D_DSP_WRAP,0)
  1330. #66 = Reg_Lock_Macro // Save WILDFILE's locked-in-macro ID
  1331. Num_Push(0,59) // Save numeric regs used herein
  1332. Num_Push(70,99) // Except for #60-#69
  1333. //
  1334. // Default delimiter between output fields (none, normally)
  1335. //
  1336. XDREG(#65+17) // Register to hold user defined output field delimiter
  1337. Reg_Set(XDREG,'') // To define, use "v=Reg_Set(XDREG,'delimiter_string')"
  1338. //Reg_Set(XDREG," | ") // Or uncomment one of these lines
  1339. //Reg_Set(XDREG,'^') // Any string is permissible
  1340. //
  1341. #8 = 0 //No customizing record determining submacro
  1342. #26 = #27 = #28 = 0 //Reset DBASE field & record counters & flag
  1343. #76 = 0 //For calculating approx. line size
  1344. #105 = vm; vm(CLEAR)
  1345. Reg_Lock_Macro(102)
  1346. /////////////////////////////////////////////////////////////////////////////
  1347. //
  1348. // Sign-on and File Handling.
  1349. //
  1350. // Set #90 = source data file's buffer ID unless "-N2" was present on the
  1351. // command line; in which case, the current buffer is assumed to
  1352. // be the layout file (no other file is processed). Normally, the
  1353. // current edit buffer is considered to be the source data file.
  1354. // It will be closed and reopened for reading in another buffer
  1355. // and the initial buffer will be used as the standard output
  1356. // buffer.
  1357. //
  1358. // Set #92 = buffer ID of/for the data layout file.
  1359. // Presume any file in buffer[2] is the data layout file if
  1360. // this macro is being run from the command line: e.g.,
  1361. // vpw -x ebcdic-2 dname.ebc lname.lay
  1362. //
  1363. // Set #75 = buffer number for translated output; referred to herein as
  1364. // the standard output buffer.
  1365. //
  1366. // #1 used herein as a flag to prevent final renaming of the data
  1367. // output file to ".dbf" as determined by the layout file
  1368. // "r=n,DBASE-III". This flag is set below when processing "-a".
  1369. //
  1370. // To initiate data conversion manually, the layout file must be named
  1371. // EBCDIC.LAY and exist in the current or VEDIT HOME directory.
  1372. // In which case, after loading the data file, the user can initiate
  1373. // processing via {Misc,Load/Execute macro,EBCDIC-2.VDM}.
  1374. //
  1375. // Likewise, the layout file must be named EBCDIC.LAY to run under
  1376. // WILDFILE.VDM.
  1377. //
  1378. // To initiate just COBOL preprocessing manually, VEDIT must be started
  1379. // with the "-N2" option. Then, after loading the layout file, processing
  1380. // can be initiated as in the above paragraph. Or, run COBOL2V.VDM.
  1381. //
  1382. // E.g., vpw -n2 lname.lay
  1383. // {Misc,Load/Execute macro,EBCDIC-2.VDM}
  1384. //
  1385. //
  1386. #90 = #75 = Buf_Num //#90 = current buffer #
  1387. #92 = 0 //#92 = layout buffer ID; not yet set
  1388. #64 = 0 //Set = 1 to always use fname.LAY
  1389. //instead of EBCDIC.LAY when no explicit
  1390. //filename parameter "lname"
  1391. //
  1392. // For autoexecution (-x), presume anything in buffer #2 is the layout file.
  1393. //
  1394. // if ( -x && !Wildfile && 2nd buffer )
  1395. if ( Is_Auto_Execution && #99!=0x57495C44 && Buf_Status(2) >= 0 ) {
  1396. #92 = 2 // #92 = data layout buffer
  1397. #64 = #64 | 0x40 // Flag data description file already loaded
  1398. //
  1399. // Else, if "-N2", presume the current buffer has/will have the layout file.
  1400. //
  1401. } else { if (Is_Option(n) && (N_Option&2)) {
  1402. #92 = Buf_Num // #92 = data layout buffer
  1403. if ( Is_Open_Write ) {
  1404. #64 = #64 | 0x40 // Flag data description file already loaded
  1405. }
  1406. }}
  1407. if (Is_Option(n)) {
  1408. #0 = #64 & 0x40 //Save "explicit data layout file" bit
  1409. if (N_Option == 0) { #64 = 1 } // Handle "-N" with no parameter
  1410. #64 = #64 | (N_Option & 0xfffff) | #0

Large files files are truncated, but you can click here to view the full file