/macros/ebcdic-t.vdm
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
- // EBCDIC-T.VDM -- EBCDIC Level-2 Trial version - Limited to 5000 fields.
- // Convert EBCDIC with packed fields into ASCII.
- // Supports EBCDIC text, packed-decimal, packed-binary, zoned,
- // packed-no-zone, floating point, hexadecimal, ignored and
- // custom fields. (Floating point data whose magnitudes are
- // greater than 10E18 are blanked.)
- //
- // Converts COBOL picture specifications into commands
- // recognized by the rest of this macro. The picture
- // specifications may be edited to include new Greenview codes
- // for more flexibility in the translation. See COBOL2V.VDM.
- //
- // Note: comments out "REDEFINES" statements which are
- // otherwise unsupported.
- //
- //
- // Output Options:
- // Append newline char(s) at the end of each record.
- // Emit an explicit decimal point for packed and zoned fields.
- // Quote and comma delimit each field.
- // Optionally emit specified delimiter(s) after each field.
- // Write error messages to ebcdic.err (default).
- //
- // Now, optionally outputs records into DBASE .dbf files,
- // including creating and updating the DBASE header record.
- // Also, optionally includes a field-names record at the start
- // of each output file. The initial field names can be generated
- // from a COBOL copy-book. See COBOL2V.VDM.
- //
- // Originally by: Theodore Green, Greenview Data, Inc.
- // Generalized by: Thomas C. Burt, Greenview Data, Inc.
- // Last change: 09/26/2003
- //
- // Requires: VEDIT PLUS 6.10 dated 03-05-2003 or later.
- // EBCDIC.LAY or alias (see below).
- // REGPREP.VDM
- //
- // Optional: COBOL2V.VDM (for preprocessing COBOL copybooks).
- // RELAY.VDM for generating output column #'s.
- // EBCDIC-2.VCM (customization submacro library).
- // EBCDIC.CUS (q.v.)
- //
- // From OS: VPW [-N[mask]] [-Y] -X EBCDIC-2 fname [-A oname] [lname] [-u options]
- //
- // When done, saves the output file as fname.X, where 'X' is
- // "ASC", normally, or "DBF" for DBASE output, or as specified
- // by "-A oname" and displays it on the screen.
- //
- // Use {FILE, Exit} to exit.
- //
- // Unless an explicit data layout filename is specified via
- // optional parameter 'lname', the data layout file EBCDIC.LAY
- // (or "fname.LAY when option "-N" is specified) must exist
- // in the current directory or in Vedit's "Home" directory.
- // EBCDIC.LAY is described below.
- //
- // -Y exits Vedit automatically after saving the translated file.
- //
- // -A specifies the name of the output file, including optional
- // drive and path.
- //
- // -N[mask] with no parameter or when (mask&1) is true, uses
- // "fname.LAY" as its record description file.
- // Alternatively, to always use "fname.LAY", edit this macro
- // setting numeric variable #64 = 1 as described, below.
- //
- // When (mask&2) is true, this macro terminates after
- // COBOL preprocessing.
- //
- // When (mask&256) is true, this macro terminates after
- // all preprocessing has finished. (However, any "v="
- // commands are not executed).
- //
- // -U leadin to options for this macro. If used, must occur after
- // all filenames have been specified.
- //
- // Unique ID options (auto-generated record# [run_no] run_date)
- // run_no 0 <= n < 9; default == 1.
- // UID=val val={off,auto,on or all}={0,1,2};
- // default == 1.
- // d=run_date mm/dd/yyyy
- //
- // To include .nam at start of each output file:
- // i[nclude][=val] val={off,on}={0,1}; default == 0.
- //
- // NOD to prevent decimal points from being output
- //
- // E.g., -u 2 specifies that "2" is to be inserted into the
- // run_no bytes of any unique ID.
- //
- // ##### NOTE: WIN95 batch processing strips "="; so, in .BAT files
- // using the "-u" options, substitute "-" for the equals
- // signs in the above-mentioned options.
- //
- // Note: blank-fills, by default, invalid zoned/packed decimal fields (see
- // bc=, below). Also, writes error message to EBCDIC.ERR (see "e=" below).
- //
- //////////////////////////////////////////////////////////////////////////////
- //
- // EBCDIC-2.LAY - Describes the file being translated.
- // Lines specify optional header size, record size,
- // comment lines, Vedit command lines and data descriptions.
- // Columns must be specified in ascending order. Undescribed
- // columns may be optionally ignored (copied from input to
- // output as is); else are converted from EBCDIC to ASCII.
- // Cobol copybook statements may also be used.
- //
- // Data description (layout) lines:
- //
- // [code col_siz [sop] [#r] [: cusops]] [// comment]
- //
- // code is a string of letters followed by a space describing the
- // field to be translated. E.g., "e " describes EBCDIC text.
- // The codes are listed, below.
- //
- // col_siz specifies the columns to be decoded; this may be done in
- // two ways:
- //
- // a) begin_col<sep>end_col
- //
- // The separator is typically a comma or a hyphen.
- // Columns begin counting from one.
- // The end column is inclusive.
- //
- // The begin_col need not immediately follow any
- // preceding end_col since any unspecified columns are
- // processed according to the default type which is 'e'
- // unless changed with the "u=type" command (see below).
- //
- // E.g., e 1-4 // specifies that columns one through
- // // four are simple EBCDIC text.
- //
- // b) +size
- //
- // Specifies the length of the field; assumes this item
- // is adjacent to the preceding item, although a column
- // number can be specified by preceding this item with
- // a "c=col" line.
- //
- // Note the '+' prefix.
- //
- // E.g., e +4 // the next four colums are EBCDIC text
- //
- // sop (standard options):
- //
- // [,[-|=]padlen;] [numops] [[pc=]'padch'] [[bc=]'badch']
- //
- //
- // padlen = # padchars to insert behind the output field;
- // default "padch" is a blank space; changeable
- // by the "pc=" specification.
- //
- // -padlen = # padchars to insert before the output field.
- //
- // =padlen = # digits to be output for 'b', 'd', 'l',
- // 'n' & 'u' commands.
- //
- // = # bytes for 'pb', 'pd', 'pn' and 'pz' commands.
- //
- // Note: the leading comma is required; the semicolon
- // should be used to prevent misinterpretations.
- // (Memento Murphi)!
- //
- // numops: [+][b][z][u] [r[aw]] [v[n]]
- // [-][e][p][s]
- //
- // + to force plus sign for positive numbers, including
- // unsigned packed decimal data that are not specified
- // as unsigned; else, a blank is output. (Does not
- // affect negative numbers for which a minus sign is
- // always output).
- // - to override '+' specified on 'o=' (options) command.
- //
- // b to display sign at the beginning of the number.
- // e to override 'b' specified on 'o=' (options) command.
- //
- // s for signed numeric output. This is the default.
- // u for unsigned numeric output. No sign is expressed.
- //
- // z to display leading zeros.
- // p to override 'z' specified on 'o=' (options) command.
- //
- // r or raw to force non-compliant binaries to be evaluated.
- // I.e., those whose magnitude is > normal maximum value.
- // e.g., 0xc757 = 51031 which is larger than 4 digits which
- // is the normal maximum for a 2-byte binary described
- // as PIC 9(4) COMP. The previous example requires the ",=5;"
- // parameter as well.
- //
- // v[n] to output a decimal point 'n' digits from the
- // right for numeric fields. If 'n' is zero or omitted,
- // no fractional digits are output.
- //
- // [pc=]'padch': specify the padding character for the current
- // field; default is space; used with "[-]padlen";
- // when "pc=" is not specified, sets "badchar" as
- // well as "padchar". Also, used for the 'f' (fill
- // or replace) specification.
- //
- // [bc=]'badch': specify the "erase" character for the current
- // field when invalid zoned/packed fields are
- // encountered. Default is space. When "bc=" is not
- // specified, sets padchar" as well as "badchar".
- //
- // The specified padchar or badchar may be an ASCII char in the
- // range 0x20 to 0x7e ('a', e.g.) or null ('') or it may be
- // specified as a hex number 0xhh. (This is probably necessary
- // when translating from ASCII to EBCDIC).
- //
- // Note: the apostrophes are still required: '0x99', e.g.
- //
- // #r Specify the register that contains the custom macro
- // to execute for the current custom field (code='c').
- //
- // : cusops - The ":" indicates the presence of custom parameters
- // for the custom macro (code='c').
- //
- // // starts a comment field.
- //
- // Note: as indicated by the syntax above, blank lines and comment lines
- // are valid. All comments and blank lines are stripped during
- // preprocessing.
- //
- // Note: Not described above is the "code=arg" form. Such lines are
- // acted upon during preprocessing and then stripped from the
- // working layout file. These codes are listed below.
- //
- // Current codes are:
- // h= (header size)
- // r= (input record size/type[,output record type])
- // e= (max error report count, error filename)
- // i= (1 to include field-names header files *.nam)
- // o= (Set default output options: '+buz[,b2z]'; '-esp' is standard)
- //
- // c= (Set field beginning column; COBOL cut & paste)
- // p= (Start of COBOL record description)
- // q= (End of COBOL record description)
- //
- // u= (e[bcdic] (default) or i[gnore]) for unspecified cols
- // v= (Vedit commands - executed immediately)
- // x= (Vedit post-processing commands)
- //
- // a= (Additional offset for unique ID calculation)
- // b= (Base_date for unique ID calculation)
- // d= (Run_date for unique ID calculation)
- // n= (# digits displayed for unique ID's)
- //
- // bc=(badchar)
- // pc=(padchar)
- // xrf= (use DBASE cross reference file)
- //
- // b (binary)
- // c (customized processing)
- // d (packed decimal)
- // e (EBCDIC)
- // f (fill) i.e., replace with pad char, default = Space
- // h (hex)
- // i (ignore) i.e., copy to output
- // l (float/double) Upto 10E18.
- // n (packed_no_zone)
- // out [fname]
- // q or qcd: quote and comma delimit each output field (no parms)
- // s (signed ASCII decimal)
- // u (unsigned EBCDIC numeric)
- // x (delete)
- // z (zoned decimal)
- //
- // Details for some of the above commands:
- //
- // c Customized processing:
- // Initialization:
- // v=Reg_Set(r,'macro commands') or
- // v=Reg_Load(r,'macfile.vdm')
- //
- // Field specification:
- // c col_siz [sop] [#r] [: custom parameters] [// comment]
- //
- // col_siz, and [sop] are described above.
- // 'r' is the number of the T-Reg containing the
- // customized translation commands (default=12) aka
- // EBC_Settings(CustomMacro).
- // 'custom parameters' must be parsed by the
- // customizing macro. E.g.,
- // Buf_Switch(XLayBufNum)
- // processing code
- // Buf_Switch(XDataBufNum)
- // '//' starts a comment field. This field is stripped
- // during preprocessing, so any custom parameter
- // cracking need not be concerned about it.
- //
- // The custom macro must entirely process its source data
- // from CurPos upto but not including CurPos+XInpFieldSize;
- // i.e., replace, delete or skip over (ignore). On exit,
- // CurPos must be at the byte that was located, on entry,
- // at CurPos + XInpFieldSize.
- //
- // Note: on entry, the current buffer is the source input
- // data buffer XDataBufNum; i.e., (bn==xdata).
- //
- // f Fill (overwrite) with "padchar" (default=space) or specified char. E.g.,
- // f cb-ce '*' // Fill columns cb through ce with asterisks.
- //
- // Useful for cleaning "filler" areas containing garbage.
- // Especially needed if this garbage gets translated into
- // weird control characters.
- //
- // h Hex - Output each byte as two hex digits '0' - '9', 'A' - 'F'.
- //
- // l Floating point (IBM 360 style).
- // l bc,ec[,=ndigs;] [sop] [v[n]] [// comment]
- //
- // Fixed format only, right justified; short floats (single precision)
- // can express seven significant digits; long floats (double precision)
- // can express sixteen. Values upto 10E18 can be processed; least
- // significant digits beyond the seventh or sixteenth are always 0.
- // Floating point values > 10E18 are BAD-CHAR erased. Fractions smaller
- // than 10E-18 are output as zeros.
- //
- // Optional 'ndigs' specifies total # digit-output columns. The
- // decimal point, if any, is not counted nor is the sign.
- //
- // "sop" are standard options "+bz-esp".
- //
- // 'n' specifies the number of fractional digits to display.
- //
- // "v0" or "v" outputs a decimal point with no fractional digits
- // displayed.
- //
- // If "v[n]" is omitted, no decimal point is output.
- //
- // q[cd] Quote and comma delimit each output field (no parms).
- // Each field must be specified. Since only the first letter
- // is examined, this may be specified as "qcd" or "quote and
- // comma delimit".
- //
- // s Signed ASCII field being converted to ASCII. Analagous to
- // signed (zoned) EBCDIC field. Presumes the final signed
- // byte of the field is one of (ASCII) '{', 'A' - 'R', '}'.
- //
- // u Unsigned numeric field. Needed only if an explicit decimal
- // point is to be output or if leading zeros are desired or
- // if an entirely blank/null field is to be expressed as text
- // zero(s).
- //
- // x Delete the field. When quoting and comma delimiting or
- // outputting a user defined delimiter after each field,
- // nothing is output, including the delimiters.
- //
- // a=n Additional offset for calculating unique ID's.
- // Use when processing more than one file with extracted
- // fields on a given day. Set greater than or equal to last
- // record # processed by the previous run. Not very useful.
- // Use the "-u n" invocation option with the "n=,,1"
- // layout specification as described below.
- //
- // b=date Base date for calculating unique ID's. Default is 1-1-2000.
- // Date must be expressed in mm/dd/yyyy format. The separator
- // can be one of "/\._:-". The year must be completely expressed.
- //
- // d=date Run date for calculating unique ID's. Default is current date.
- //
- // n=l,m,n Control # digits displayed for each part of the unique ID.
- // 'l' is the number of digits for the days-elapsed count;
- // 'm' is the number of digits for the record count;
- // 'n' is the number of digits for "run_number".
- // Default is "n=5,6,1". Use "n=,,0" to remove the position
- // reserved for the run #, if so desired. Setting the run #
- // requires the use of the "-u run_number" invocation option.
- //
- // c=col Set field beginning column (actually, preceding field's
- // ending column) for use with 'code +len' style specs
- // that are not contiguous with the last specified field.
- // Particularly useful for cut-&-pasting COBOL specs.
- //
- // e=n[,f] Control writing of error messages to error file.
- // Default is to write all errors to EBCDIC.ERR, including
- // upto 1000 occurrences of invalid compressed data items.
- // This command allows changing the limit for reporting invalid
- // compressed data items; changing the default error filename;
- // and disabling error writing completely.
- //
- // 'n' is the maximum # of invalid data messages.
- // 'f' is the name of the error file, including optional
- // drive and path.
- // Disable error messages by including "e=" by itself.
- // e.g., "e= // Disable writing errors to file"
- //
- // The form "e=n" reports upto 'n' errors in "ebcdic.err".
- // The form "e=,errfname" reports upto 1000 errors in errfname.
- // Alternatively, use "e=errfname".
- //
- // Note: The file ebcdic.err is always deleted at startup.
- // Any explicitly named error file is emptied when the
- // "e=" line is processed.
- //
- // Note: Errors that occur during preprocessing generally
- // cause processing to stop immediately.
- //
- // N.B., Errors that occur before this command is processed
- // are written to EBCDIC.ERR.
- //
- // i=val Flag to include header files "*.nam" at the start of each
- // output file that contains data. These files are expected to
- // consist of quoted and comma delimited field-names. "val"
- // is one of {0,1,off,on}, default == "off". The filename
- // proper of each ".nam" file must be the same as that of the
- // output file into which it is to be included. This option
- // may also be turned on with the "-u include=1" invocation
- // option.
- //
- // h= Size of header. Used to pass over (copy to output)
- // header information. Ordinarily not used.
- //
- // o=nops[,b2z]
- //
- // Examples: o=+bz // explicit '+'; leading sign; leading zeros
- // o=uz // Unsigned numeric values; leading zeros
- // Default: o=-eps// blanked positive sign; trailing sign;
- // // blank padding; numbers are signed values
- //
- // Options are:
- // + for explicit plus sign for positive/unsigned numbers.
- // - to output a space instead of '+' (default).
- //
- // b to output the sign at the beginning of the number.
- // e to output the sign at the end of the number (default).
- //
- // s (signed) to express the sign at all. (Default).
- // u (unsigned) to suppress the sign.
- //
- // z to output leading zeros.
- // p for blank padding (default).
- //
- // ,b2z specifies that packed decimals, binaries and unsigned
- // numeric fields that are entirely blank or null will be
- // output as zero(s) formatted according to the other
- // options.
- //
- // This sets default output actions for 'b', 'd', 'l', 'n',
- // 'u' & 'z' fields. The defaults may be overriden by the
- // individual field specifications. E.g., d 5,12 +bz
- //
- // At most only one 'o=' line is needed. If more are used, the
- // effect is cumulative. Since these lines are preprocessed and
- // then stripped, there is little reason to use more than one
- // line.
- //
- // p=[x] Specifies start of COBOL picture specifications block;
- // 'x' to output explicit decimal point for 9...v99... formats.
- // Otherwise, no decimal point is output. (If initial field is
- // not contiguous with last specified field, follow with
- // "c=colm1" where colm1 is the starting column less one).
- //
- // q= Specifies end of COBOL specifications block. Multiple
- // blocks may be specified within the data description file.
- //
- // r= Record size 'r= input_size_or_type[,output_type]', where
- // type may be 0, 1, 2 or "f" (output only). If no output
- // record type is specified, the input type is used.
- //
- // When input/output records are/will be terminated by Carriage-
- // Return and/or Line-Feed, use record type:
- // 0 for <cr><lf> (DOS)
- // 1 for <lf> (UNIX)
- // 2 for <cr> (MAC)
- //
- // Record terminators are stripped from the input record.
- // They will then be appended to the output if output_type
- // (explicit or default) is one of the above three types.
- //
- // Record terminators are not normally used with EBCDIC data
- // files. They cannot be used when the data file contains
- // binary fields.
- //
- // When records are unterminated, specify the input record
- // length upto but not including the variable portion of
- // variable length records; i.e., fields occurring after a 'rf'
- // specification (OCCURS .... DEPENDING ON ... clause in COBOL).
- //
- // When unterminated multiple record types differing in length
- // are being processed, setting input_record_size_or_type to the
- // size of the largest record is probably appropriate.
- //
- // The input record size must be specified for unterminated
- // records; it may also be specified for fixed length records
- // even when they have terminating character(s). Be sure to
- // include the terminators in the record length and process
- // them in the .LAY file.
- //
- // Normally, no length is specified for the output record since
- // it is determined dynamically. Thus, for fixed length input
- // and output records, just specify the input record size:
- // "r=100", e.g.
- //
- // If the output is to be unterminated but the input is
- // terminated, use 'f' for the output_type. Thus, "r=0,f"
- // inputs records terminated by Carriage-Return and Line-Feed
- // but strips them from the output ("f" stands for "fixed").
- //
- // Examples: r=100,0 //Input record size = 100
- // //append <cr><lf> on output
- //
- // r=100 //Input record size = 100
- // //Output records are unterminated
- //
- // r=0 //Both input and output records
- // //terminated by <cr><lf>
- //
- // r=0,1 //Input records terminated by <cr><lf>
- // //Output records terminated by <lf>
- //
- // u=arg Specify action for non-specified fields.
- // arg=ebcdic to translate from EBCDIC to ASCII;
- // arg=ignore to simply copy the input columns to output.
- // Only the initial letter need be specified.
- // E.g, u=i // Copy unspecified columns to output.
- //
- // v= Vedit commands are executed as soon as they are encountered
- // and are then stripped from the layout file. The commands must
- // fit on one line but as many "v=" lines may be used as needed.
- // One line is sufficient for executing a macro file via a text
- // register.
- //
- // May be used to put a user-defined output field delimiter
- // (string) into T-Reg[XDREG]: e.g., v=Reg_Set(XDREG,"|"); or
- // v=rs(XDREG,' ^ '). Unlike quoted and comma delimited fields,
- // not all fields need be specified; a group of unspecified
- // fields will have just one instance of the delimiter string
- // appended to the end of the group.
- //
- // x= Vedit commands are stored into T-Reg[14]. They are then
- // executed in a post processing pass after all other commands
- // have been applied to the entire file. These commands must
- // fit on one line. Use Call_File() if more lines are needed.
- //
- // xrf=arg Use DBASE cross reference file fname.XRF for generating the DBASE
- // header record. "arg" = "1" or "on" to use; "0" or "off" may be
- // used to generate the names automatically or the "xrf" line may
- // be omitted to achieve the same result. If the file fname.XRF is
- // empty, the field names will be automatically generated.
- //
- // example EBCDIC-2.LAY file:
- //
- // // Each input record is 256 bytes long.
- // // Output records have <cr><lf> appended.
- // // The first 3 fields are packed decimal.
- // // Columns 42-45 and 50-53 are binary.
- // // Columns 54-57 are zoned decimal.
- // //
- // r=256,0 //Size of input records
- // //<cr><lf> appended to output
- // d 7-10 //Packed decimal
- // d 20-24 //Also packed decimal, (default = previous)
- // d 32-38
- // b 42-45 //Binary
- // b 50-53
- // z 54-57 //Zoned decimal
- // //
- // // The final fields contain leading zeros that are
- // // to be converted to blanks with 1 leading blank inserted.
- // //
- // v=RegLoad(EBC_Settings(CustomMacro),"nolzero.cus")
- // c 60-69 #12 // Field size remains contstant
- // c 70-75 // Uses T-Reg 12 for custom processing
- //
- //////////////////////////////////////////////////////////////////////////////
- //
- // Numeric register usage:
- //
- // #0 - #5 Temp
- // #3 Preprocessing: field counter
- // #4 Preprocessing: max # fields in any record
- // #8 Reserved for levels 3 & 4
- // #10-#13 Temp; used as such by customizing macros
- // Note: #10 - #74 are used implicitly by UNPAKDEC.VDM.
- // #14-#19 Reserved for customizing macros
- // #15 Preprocessing: temp
- // #16 Preprocessing: buffer ID of extraction file
- // #17 Preprocessing: 'out' counter
- // #18 Preprocessing: flag that .VCM customization submacros have been loaded
- // #26 DBASE field counter
- // #27 Preprocessing: DBASE output record counter
- // #28 DBASE flag
- // #31-#39 Statistics
- // #40 Run # size in unique ID
- // #41 Data "segment" count. Normally set by "-u count".
- // #42 Unique ID control: {0,1,2} for {off,auto,all}; set by UID=on,off,auto
- // or "-u uid=n"
- // #43 Flag to include ".nam" header file at start of each output file
- // #44 Explicit decimal point flag (default = 1)
- // #50 Run date for unique ID's (preprocessing); # digits to display (processing)
- // #51 Preprocessing: statistics
- // #52 Reserved for level 4
- // #54 Flag that extraction file(s) present.
- // #55 Julian base date for unique ID generation (default = 1-1-2000)
- // #56 Reserved for level 4
- // #57 Default input record type or length ("r={type|length}");
- // Config(F_F_TYPE) when no "r="
- // #58 Preprocessing: statistics
- // #59 Preprocessing: record-types counter (= 1, always)
- // #61 Additional offset for unique ID calculation
- // #62 # digits displayed for unique ID (3 parts)
- // #63 Buffer ID of .xrf file for obtaining DBASE field names or zero
- // #64 Flag variable (hex values)
- // 01 to use "fname.LAY" instead of EBCDIC.LAY
- // 02 to stop after COBOL preprocessing
- // 04 to force explicit decimal point when translating
- // COBOL picture lines of type 9...v9...
- // 08 to call T-Reg[14] for post processing ('x=').
- // 40 when explicit data layout file "lname"
- // 100 stops after preprocessing (doesn't execute v=)
- // 200 Flag to COBOL2V.VDM to run as submacro.
- // 800 to prevent generating unique ID's; archaic; use uid=off
- // #65 T-Reg offset for running under WILDFILE.VDM
- // #66 Save WILDFILE's Locked-in-Macro ID.
- // #67 Input record type (r=type): 0,1,2,3,6=fixed (see #87)
- // Determined from Config(F_F_TYPE) if no "r="
- // #68 Output record type: 0,1,2,6=fixed,7=DBASE (see #88)
- // #69 Zero 1st time; else 1
- // #73 Reserved for levels 3 & 4
- // #74 Reserved for level 4
- // #75 Main output buffer #
- // #76 Approx record size
- // #77 Current output buffer # for 'out' extractions
- // Temporary for initial statistics
- // #78 Temporary for stacking/popping XLASTCOLPROC with #77
- // #79 Reserved for level 4
- // #81 Preprocessing: temporary
- // #82 Reserved for levels 3 & 4
- // #85 Current data type (b,c,d,e,f,i,l,n,s,u,x,z)
- // #86 File header size (h=size) or -1
- // #87 Current input record size (r=size) or zero (see #67)
- // #88 Output record size or zero (see #68)
- // #90 Preprocessing: source data buffer
- // #91 Wildfile running flag
- // #92 Preprocessing: data layout buffer
- // #93 1st line number to convert
- // #99 ID flag, possibly set by WILDFILE macro
- //
- //////////////////////////////////////////////////////////////////////////////
- //
- // Text register usage:
- // Registers 10 - 19 are offset by Num_Reg(65) for running under WILDFILE.
- //
- // Note: cannot push COBOL preprocessing text register.
- // This register is loaded at startup before text registers are pushed.
- // This is partly due to the comment stripping processor and partly
- // due to WILDFILE interaction.
- //
- // 2 table of "raw" binary sizes
- // 3 DBASE preprocessing: record name
- // 4 table of "cooked" binary sizes
- // 5 Temporary layout output pathname for editing purposes
- // 6 Temporary data output pathame for editing purposes
- // 7 Full path to output subdirectory
- // 8 Full pathname of .xrf file (DBASE only)
- // 9 .lay input pathname.
- // 10 Data output pathname.
- // 11 Used to execute Vedit commands ('v=') from EBCDIC.LAY
- // Used initially in constructing output filenames
- // 12 Default T-Reg for custom decoding ('c').
- // 13 Default T-Reg for custom record determination ('tc').
- // 14 Optional post-processing macro ('x=')
- // 15 Source data file's full pathname.
- // "NEXT_PEER_CLAUSE" sub-macro (COBOL preprocessing).
- // 16 Explicit decimal point handling.
- // OCCURS clause sub-macro (COBOL preprocessing).
- // 17 Optional delimiter string output after each field.
- // REDEFINES clause commenting-out (COBOL preprocessing).
- // 18 Holds (path)name of error file. None when empty.
- // 19 Main COBOL preprocessing macro. Must not be pushed!
- // 46 - 54 Submacros
- // 55 - 56 Reserved for COBOL preprocessing.
- // 57 - 63 Submacros
- // 'A' - 'Z' Code to process each data type (T-Regs 65 - 90).
- // 101 Data error processing. Comment stripping, initially.
- // 102 Unexpected error breakout trapping macro.
- //
- //////////////////////////////////////////////////////////////////////////////
- // //
- // Execution starts here. //
- // //
- //////////////////////////////////////////////////////////////////////////////
- //
- // Speed optimize the EBCDIC-2 macro itself.
- //
- if (File_Exist(VEDIT_TEMP)==0) { //Create vedit/temp dir if needed
- File_Mkdir(VEDIT_TEMP)
- }
- if (#99==0x57495C44&[){goto noprep} // No prep for 2nd and later WILDFILE pass
- Reg_Prep() // Can't be nested when self-prepping
- :NOPREP:
- //
- // Initialize optional delimiter(s) to be output after each field.
- // Overriden by any "v=rs(XDREG,'delimiter string')" in the layout file.
- //
- #103 = Macro_Num // #103 = T-Reg # this macro is in
- if (#99==0x57495C44) { // When WILDFILE is running...
- if (!#91){ // Set == 0 by Wildfile
- #65 = Reg_Free // #65 = 1st available T-Reg
- #69 = 0 // 1st time in
- }
- } else {
- #65 = #69 = 0 // For backwards compatibility
- }
- #91++ // Update Wildfile pass counter
-
- if (!#69){ // 1st time in
- //
- // Check version #.
- //
- #0 = 520
- if (Version_Num<#0) {
- Reg_Set(1,"EBCDIC translation package requires VEDIT PLUS version ")
- #1 = #0/100
- #2 = Remainder
- ITOA(#1,1,LEFT+NOCR+APPEND)
- Reg_Set(1,".",APPEND)
- ITOA(#2,1,LEFT+NOCR+APPEND)
- Reg_Set(1," or later.",APPEND)
- Alert()
- Dialog_Input_1(0,`"Error","|@(1)"`)
- if (Is_Quiet) {
- XALL(1)
- } else {
- Reg_Empty(0)
- Reg_Empty(1)
- Break_Out(EXTRA)
- }
- }
- //
- // Load T-Reg[19] with COBOL preprocessor and speed optimize the code.
- //
- Reg_Empty(#65+19) // In case COBOL2V can't be found
- Reg_Load(#65+19,"COBOL2V.VDM",EXTRA+NOERR)
- Reg_Prep(#65+19)
-
- //
- // Use T-Reg[1] to load and speed optimize submacros.
- // Then distribute the code to their proper T-Regs.
- //
- Reg_Set(1,$
- //////////////////////////////////////////////////////////////////////////
- // //
- // Submacros for EBCDIC-2.VDM //
- // Last change: 07/24/2003 //
- // //
- // Note: most named submacros are now contained in EBCDIC-2.VCM //
- // for use by custom macros. They are reserved for this //
- // purpose. These are: a-f, h, i, s, u, x & z. //
- // //
- // Note: Named submacros 'a' - 'z' are actually stored into //
- // T-Reg['A'] - T-Reg['Z']. To invoke a given named macro, //
- // convert its name to upper case; e.g., call('r'-32). //
- // //
- //////////////////////////////////////////////////////////////////////////
-
- //
- // T-Reg[l] - Floating Point.
- //
- Reg_Set(l,`
- //
- // "NULL" for undefined?
- // Go figure!
- //
- if ((match("|{|HD5|HE4|HD3|HD3,|H80|H00|H00|H00}")==0)||CC==0){
- #7 = 0
- #9 = EBC_Settings(Field_Size)
- if (XFSIZ>4){ // DOUBLE
- if (#9==0){
- #7 = 16
- }
- } else { // FLOAT
- if (#9==0){
- #7 = 7
- }
- }
- if (#9==0){
- #9=#7
- }
- if (EBC_Settings(Out_Point) & 0xff){
- #9++
- }
- if (!EBC_Settings(Unsigned)){
- #9++
- }
- DC(XFSIZ)
- IC(' ',COUNT,#9)
- }else{
- #1=upf('l',XFSIZ)
- if (#1) {if (#38){call(101,"DATERR")}}
- }
- `) // [l]
-
- //
- // T-Reg[48] - Unique ID Processing.
- //
- Reg_Set(48,`
- //
- // UID - Generate unique ID at end of fixed portion of variable length record.
- // Similar to 'rb' & 're' processing, above.
- // Enter: #40 = # digits to display segment count of unique ID.
- // #50 = # digits to display elapsed days count of unique ID.
- // #62 = # digits to display record count of unique ID.
- // #41 = data segment/section/run #.
- // #55 = days elapsed since base date.
- // XRecNum = record #.
- // #61 = additional offset when more than 1 run per day.
- //
- :UID:
- if (XQCD){ // If Quoting & comma delimiting...
- IT(',"') // Output comma and quote mark
- NI(#55,SIMPLE+FILL+COUNT,#50) // Output JDate
- if (#40>0){
- NI(#41,SIMPLE+FILL+COUNT,#40) // Output the segment #
- }
- NI(XRecNum+#61,SIMPLE+FILL+COUNT,#62) // Output the record #
- IC('"') // Output quote mark
- } else { // Else...
- IC(' ') // Space for separation
- NI(#55,SIMPLE+FILL+COUNT,#50) // Output JDate
- if (#40>0){
- NI(#41,SIMPLE+FILL+COUNT,#40) // Output the segment #
- }
- NI(XRecNum+#61,SIMPLE+FILL+COUNT,#62) // Output the record #
- }
-
- `) // [48]
-
- //
- // T-Reg[49] - DBASE preprocessing.
- //
- Reg_Set(49,`
- //
- // DBINIT0 - Zero-out DBASE header's 1st 32-byte structure; insert '3' for
- // signature and current date in YMD (binary) format where
- // 'y' = year -1900.
- // Initialize record length (pos 10,11) = 1 for the initial blank
- // column, the deleted-record field.
- // Set 0x0d byte at end of header.
- //
- // Enter: #16 = ID of extraction buffer
- // #28 > 0 (DBASE flag)
- //
- :DBINIT0:
- Num_Push(0,5)
- Buf_Switch(#16) // DBASE output file
- Del_Block(0,FileSize)
- //
- // Zero-out initial header structure.
- // Set 0x0d byte at end.
- //
- Ins_Char(0,COUNT,32)
- Ins_Char(0x0d) // End of header byte
- Config(F_REC_HEAD,FSize,LOCAL)
- //
- // Set record-length to 1 to account for initial "deleted-record" field.
- //
- GP(10)
- Ins_Char(1,OVERWRITE)
- //
- // Set #1,#2,#3 = current date = MDY.
- //
- Buf_Switch(Buf_Free(EXTRA))
- OI() DATE(NOMSG) OI(CLEAR)
- BOF()
- #1=NumEval(ADVANCE+SUPPRESS)
- c(1)
- #2=NumEval(ADVANCE+SUPPRESS)
- c(1)
- #3=NumEval()
- Buf_Quit(OK)
- //
- // Enter DBASE signature and current date as YMD (binary).
- //
- Buf_Switch(#16)
- BOF()
- Ins_Char(3,OVERWRITE)
- Ins_Char(#3-1900,OVERWRITE)
- Ins_Char(#1,OVERWRITE)
- Ins_Char(#2,OVERWRITE)
- //
- Buf_Switch(XLay)
- Num_Pop(0,5)
- return
-
- `) // [49]
-
- //
- // T-Reg[50] - Output diversion.
- //
- Reg_Set(50,`
- //
- // POST - Diversion termination.
- // Enter: Buf_Num = XLayBufNum.
- // Retrn: Buf_Num = XLayBufNum.
- //
- :POST:
- BS(XData)
- if (#42){ // If Unique ID wanted...
- if (XQCD){ // If Quoting & comma delimiting...
- IT(',"') // Output comma and opening quote
- NI(#55,SIMPLE+FILL+COUNT,#50) // Output JDate
- if (#40>0){
- NI(#41,SIMPLE+FILL+COUNT,#40) // Output the segment #
- }
- NI(XRecNum+#61,SIMPLE+FILL+COUNT,#62) // Output the record #
- IT('"') // Output closing quote
- } else { // Else...
- IC(' ') // Space for separation
- NI(#55,SIMPLE+FILL+COUNT,#50) // Output JDate
- if (#40>0){
- NI(#41,SIMPLE+FILL+COUNT,#40) // Output the segment #
- }
- NI(XRecNum+#61,SIMPLE+FILL+COUNT,#62) // Output the record #
- }
- }
- //
- // Move translated input fields into output file.
- //
- RCB(0,0,CP,DELETE)
- BS(#77)
- EOF()
- if (RSIZE(0)>0){
- if (#28&&AtBOL){
- ic(' ')
- // XLCP(XLCP+1) May need to update when appending allowed...
- }
- RI(0)
- }
- //
- // Append newline char(s), if specified.
- //
- if ((0<=#68)&&(#68<6)){
- if ((#68&1)==0){IC(0x0d)} // DOS and MAC
- if (#68<2){IC(0x0a)} // DOS and UNIX
- }
- //
- BS(XLay)
- return
-
- //
- // PRE - Diversion initialization.
- // Any passed over bytes translated.
- // All processed bytes moved into the output buffer.
- // Enter: Buf_Num = layout buffer XLayBufNum.
- // Retrn: Buf_Num = layout buffer XLayBufNum.
- //
- :PRE:
- //
- // Set XNextCol = XAdjBeg = column # of 1st field adjusted for inflation
- // (The 1st column must be specified by next layout line).
- // Do default processing on any passed-over fields.
- //
- SPOS()
- s("|<|Y|w",advance) //Pick up start of first field from next layout line
- XAB(NE()+XSO+XI) //XAdjBeg = beginning column # (inflation adjusted)
- RPOS() //Back to "rb" line
- call(57) //Translate any passed-over fields
- //XNextCol = 1st column #, inflation adjusted
- //
- // Move translated bytes into output buffer via T-Reg[0].
- //
- RCB(0,0,CP,DELETE) //Move bytes into T-Reg[0]
- BS(#77) //Switch to output buffer
- EOF()
- //
- // Include any .nam header file, if so specified.
- //
- if (#43&&AtBOF){
- Ins_File("|(FILE_ONLY).nam")
- }
- if (RSIZE(0)>0){
- if (#28&&AtBOL){
- ic(' ')
- XLCP(XLCP+1) // Note: XLCP already reflects the processed output length
- }
- RI(0) //Insert the bytes
- }
- //
- BS(XLay) //Reenter layout buffer
- return
-
- `) // [50]
-
- //
- // T-Reg[53] - Name Pre-Processor (error checking).
- // Name may be quoted or not; quotes stripped.
- // Return: T-Reg[0] = name
- // Cur_Pos past name["].
- //
- Reg_Set(53,`
- if (cc!='''&&cc!='"'){
- Set_Marker(8,Cur_Pos)
- sb("|{|b,//,|>}",cp,eolpos+1)
- Set_Marker(9,Cur_Pos)
- } else {
- rcb(0,cp,cp+1,norestore)
- Set_Marker(8,Cur_Pos)
- if(!sb(@0,cp,eolpos,advance+noerr)){
- goto BADLAY
- }
- Set_Marker(9,Cur_Pos-1)
- }
- rcb(0,Marker(8),Marker(9))
- return
- //
- :BADLAY:
- chain(#103,"BAD_LAY")
- `) // [53]
-
- //
- // T-Reg[54] - Name Processor.
- // Name may be quoted or not; quotes stripped.
- // Return: T-Reg[0] = name
- // Cur_Pos past name["].
- //
- //
- Reg_Set(54,`
- if (cc!='''&&cc!='"'){
- SM(8,CP)
- sb("|{|b,//,|>}",cp,eolpos+1)
- SM(9,CP)
- }else{
- rcb(0,cp,cp+1,norestore)
- SM(8,Cur_Pos)
- sb(@0,cp,eolpos,advance)
- SM(9,CP-1)
- }
- RCB(0,Marker(8),Marker(9))
- `) // [54]
-
- //////////////////////////////////////////////////////////
- // //
- // T-Reg[55] & T-Reg[56] //
- // Reserved for COBOL2V.VDM //
- // //
- //////////////////////////////////////////////////////////
-
- //
- // T-Reg[57] - Perform default translation on passed-over fields.
- //
- Reg_Set(57,`
- BS(XData)
- if ((#0=XAB-XNC)>0){
- XDC(XDC+#0) // Update total-bytes-processed counter
- XLCP(XLCP+#0)
- if (XDefType=='e'){
- TRB(CP,CP+#0,REVERSE+NORESTORE)
- }else{if (XDefType=='a'){
- TRB(CP,CP+#0,NORESTORE)
- }else{
- C(#0)
- }}
- XNC(XAB)
- }
- `) // [57]
-
- //
- // T-Reg[58] - Extraction Filename Processor.
- //
- // Enter: Buf_Num = XLayBufNum.
- // Retrn: #77 = output buffer ID.
- // #54 |= 1 (flag to output unique # at end of main output record).
- // Buf_Num = XLayBufNum.
- //
- // Note: to force UID's on main records that have no extracted subsections,
- // use uid=on option in the .lay file or as a "-u" invocation parameter.
- //
- Reg_Set(58,`
- call(54) // T-Reg[0] = name
- bs(#75) // Switch to main buffer so that we can
- // use e.g. tx "|(FILEONLY).as1"
- FO("|@(0)",NOMSG+NOEVENT)
- #77=BN // #77 = output buffer
- #54 = #54 | 1
- XLCP(0)
- BS(XLay)
- `) // [58]
-
- //
- // T-Reg[59] - Extraction Filename Preprocessor.
- //
- // Processes 'code "filename"[,R]' where 'R' is a one or two letter
- // record name for DBASE output.
- // Deletes any existing file.
- // Opens an empty file.
- //
- // For DBASE, generates 1st header row and sets T-Reg[3] <== 'R', if
- // specified.
- //
- // Enter: #28 = DBASE flag.
- // Retrn: #16 = buffer ID of extraction file.
- // #27++ DBASE output record counter.
- // [3] = #28 && 'R' present ? upto 1st 2 letters of "R" : [3]
- //
- // Called when preprocessing 'out'.
- //
- Reg_Set(59,`
- call(53) // T-Reg[0] = filename
- //
- //
- //
- if (#28) { // If DBASE...
- if ( match("|[|w],|[|w]",ADVANCE)==0) {
- if (match("|a|[|a]")==0){
- RegCopyBlock(3,cp,cp+cmat,norestore)
- }
- }
- }
- //
- #27++
- if (Buf_Free()>0){
- bs(#75) // Switch to main buffer so that we can
- // use e.g. tx "|(FILEONLY).as1"
- File_Delete(@0,OK+NOERR)
- FO("|@(0)",OVERWRITE+NOMSG+NOERR+NOEVENT)
- #16 = Buf_Num
- if (#68<6) {
- Config(F_F_TYPE,#68,LOCAL)
- } else {
- if (#28) { // If DBASE...
- Config(F_F_TYPE,32,LOCAL) // Header consists of 32-byte structures
- } else { // else...
- Config(F_F_TYPE,64,LOCAL) // For now...
- }
- }
- } else {
- goto TOOMANY
- }
- //
- // For DBASE, initialize 1st 32-byte header structure; append terminating <cr>.
- //
- if (#28) { call(49) } // DBINIT0()
- //
- Buf_Switch(XLay)
- return
-
- :TOOMANY:
- chain(#103,"TOO_MANY")
-
- :BADLAY:
- chain(#103,"BAD_LAY")
-
- `) // [59]
-
- //
- // T-Reg[62] - Progress Display.
- //
- // First time, display estimated processing time.
- // Also display persistent "Converted records: "
- // Every time, display count and percentage of records processed.
- //
- Reg_Set(62,`
- if (XRecNum==#31){call(63)}
- WH(#33)
- NT(XRecNum,NOCR) // count
- #37=FSize-CP
- if (#37>1000000){#34=100-(#37/(#36/100))}
- else{if (#36==0){#34=100}
- else{#34=100-((100*#37)/#36)}
- }
- Message(" (")
- NT(#34,LEFT+NOCR) // percentage
- Message("%)")
- `) // [62] Progress Display
-
- //
- // T-Reg[63] - Progress Display (Initial Message).
- //
- // Display estimated processing time.
- // Also display persistent "Converted records: "
- // Empties itself on exit.
- //
- Reg_Set(63,`
- #35=TT
- WH(1)
- Message("Estimated processing time is ")
- #34=((#35-#32)*((#36/(#36-FSize+CP)))+500)/1000
- NT(#34,LEFT+NOCR)
- Message(" seconds\n")
- Message("Converted records: ")
- #33=WH
- RE(MN,EXTRA)
- `) // [63] Progress Display (Initial Message)
-
- ///////////// [65] - [90] correspond to [A] - [Z], so DO NOT USE ////////////
-
- //
- // T-Reg[101] - Process invalid data error messages.
- //
- //
- // DATERR - Report errors decompressing packed data, if enabled.
- // On first error, report name of file being translated,
- // the name of the edited layout file and a short description
- // of a report line:
- // XRecNum (data record #)
- // .TMP layout line #
- // the layout line itself
- // position in the input file at which the data field began
- // the source bytes themselves (in hex format).
- // Upto #38 errors (default 1000) will be reported.
- //
- // Enter: T-Reg[103] = source bytes.
- //
- Reg_Set(101,`
- :DATERR:
- if (RSize(#65+18) && #38){ // If error reporting enabled...
- num_push(1,10)
- #1 = bn // Store current edit buffer id
- //
- // Set T-Reg[0] = offended layout line.
- //
- bs(XLay) // Switch to the edited layout file
- char(-newline_chars)
- rc(0,0) // Copy the line into T-Reg[0]
- #2 = Cur_Line // Get its line #
- line(1)
- //
- // Set T-Reg[1] = pathname of edited layout file layout.tmp
- //
- or(1) // Begin diversion into T-Reg[1]
- nw(EXTRA+NOMSG) // Get full pathname of the edited layout file
- or(CLEAR) // Turn diversion off
- //
- // On first error, report general information.
- //
- File_Open("|@(#65+18)",OVERWRITE+NOERR+NOMSG) // Switch to the error file
- if ( File_Size == 0 ) {
- //
- // Output name of source data file.
- //
- Ins_Text("***** Invalid compressed data item(s) in ")
- Reg_Ins(#65+15)
- Ins_Newline(2)
- //
- // Describe error report line.
- //
- Ins_Text("line = layout line number from edited file ")
- ri(1); re(1)
- Ins_Text("record = source record number");in
- Ins_Text("location = source file position of start of invalid data item (from 0)");in
- in(2)
- Ins_Text(" line data descriptor record location data item (hex)");in
- Ins_Text(" ==== =============== ====== ======== ===============");in
- }
- //
- // Report the edited layout line #.
- //
- Ins_Text(" ")
- ni(#2,NOCR) // edited layout line #
- //
- // Include the edited layout line.
- //
- Ins_Text(" ")
- ri(0) // The edited layout line
- //
- // Report the data record #.
- //
- Ins_Char(' ', COUNT, BOL_Pos + 27 - Cur_Pos )
- Del_Block(BOL_Pos+27,cp)
- ni(XRecNum,FORCE+NOCR) // data record #
- //
- // Report the field's starting location in the source file (from 0).
- //
- bs(XData) // Switch to the data source file
- #3 = #36 - (File_Size - Cur_Pos) - XFSIZ
- File_Open("|@(#65+18)",NOMSG) // Switch back to the error file
- Ins_Text(" ")
- ni(#3,FORCE+NOCR) // The field's starting position
- //
- // Display the source field in hex.
- //
- Ins_Text(" ")
- Out_Ins()
- Reg_Type(103,0x800) // Display in hex format
- Out_Ins(CLEAR)
- Ins_Newline(1)
- //
- // Finish up and return.
- //
- #38--
- bs(#1)
- num_pop(1,10)
- }
- return
- `) // [101,DATERR]
-
- //
- // T-Reg[102] - Unexpected error breakout trap.
- // Writes message into error file.
- // Restores some original config values.
- // Terminates.
- //
- Reg_Set(102,`
- Reg_Lock_Macro(CLEAR) // Disable further error trapping
- Reg_Empty(0)
- File_Open("|@(#65+18)",OVERWRITE+NOERR+NOMSG) // Access error file
- EOF
- #0 = Cur_Pos
- Ins_Newline()
- Ins_Text("***** Unexpected breakout occurred.")
- Ins_Newline()
- #1 = Cur_Pos
- Reg_Ins(120)
- Reg_Copy_Block(0,#0,#1)
- Reg_Push(0,0)
- Call(#103,"CleanUp")
- Call(#103,"CloseErr")
- Reg_Pop(0,0)
- Num_Pop(70,99) //Restore numeric regs
- Num_Pop(0,59)
- Config(U_AUTO_CFG,#0) //Restore user's config values
- Config(F_AUTO_SAVE,#1)
- Config(F_OVER_MODE,#2)
- // no Config(F_F_TYPE,#3)
- // no Config(F_REC_HEAD,#4)
- Config(E_EXP_TAB,#5)
- Config(E_RETAB_BK,#6)
- Config(E_RETAB_FILL,#7&0xff)
- Config(S_E_MORE,#8)
- Config(D_DSP_WRAP,#9)
- Num_Pop(0,10) //Restore remaining user numregs
- Reg_Lock_Macro(#66)
- #69 = 1 //WILDFILE flag for next time in
- if (Is_Quiet || Is_Option(y)){
- XALL(1)
- } else {
- if (Reg_Size(0)){
- Reg_Type(0)
- }
- if (#105){
- vm(SET)
- }
- }
- `) // [102] Unexpected Error Breakout
- $) // [1] - Submacros
- Reg_Prep(1)
- Call(1)
- Reg_Empty(1)
-
- } // 1st time in
-
- :START:
- Num_Push(0,10)
- #0 = Config(U_AUTO_CFG,0) // Turn off auto-save-config
- #1 = Config(F_AUTO_SAVE,0) // Turn off auto-save-changes every x minutes
- #2 = Config(F_OVER_MODE,0) // Allow insert/delete even for fixed-records
- #3 = Config(F_F_TYPE)
- #4 = Config(F_REC_HEAD)
- #5 = Config(E_EXP_TAB) // Tabs complicate COBOL processing
- #6 = Config(E_RETAB_BK)
- #7 = Config(E_RETAB_FILL)
- #8 = Config(S_E_MORE,0)
- #9 = Config(D_DSP_WRAP,0)
- #66 = Reg_Lock_Macro // Save WILDFILE's locked-in-macro ID
- Num_Push(0,59) // Save numeric regs used herein
- Num_Push(70,99) // Except for #60-#69
-
- //
- // Default delimiter between output fields (none, normally)
- //
- XDREG(#65+17) // Register to hold user defined output field delimiter
- Reg_Set(XDREG,'') // To define, use "v=Reg_Set(XDREG,'delimiter_string')"
- //Reg_Set(XDREG," | ") // Or uncomment one of these lines
- //Reg_Set(XDREG,'^') // Any string is permissible
-
- //
- #8 = 0 //No customizing record determining submacro
- #26 = #27 = #28 = 0 //Reset DBASE field & record counters & flag
- #76 = 0 //For calculating approx. line size
-
- #105 = vm; vm(CLEAR)
- Reg_Lock_Macro(102)
-
- /////////////////////////////////////////////////////////////////////////////
- //
- // Sign-on and File Handling.
- //
- // Set #90 = source data file's buffer ID unless "-N2" was present on the
- // command line; in which case, the current buffer is assumed to
- // be the layout file (no other file is processed). Normally, the
- // current edit buffer is considered to be the source data file.
- // It will be closed and reopened for reading in another buffer
- // and the initial buffer will be used as the standard output
- // buffer.
- //
- // Set #92 = buffer ID of/for the data layout file.
- // Presume any file in buffer[2] is the data layout file if
- // this macro is being run from the command line: e.g.,
- // vpw -x ebcdic-2 dname.ebc lname.lay
- //
- // Set #75 = buffer number for translated output; referred to herein as
- // the standard output buffer.
- //
- // #1 used herein as a flag to prevent final renaming of the data
- // output file to ".dbf" as determined by the layout file
- // "r=n,DBASE-III". This flag is set below when processing "-a".
- //
- // To initiate data conversion manually, the layout file must be named
- // EBCDIC.LAY and exist in the current or VEDIT HOME directory.
- // In which case, after loading the data file, the user can initiate
- // processing via {Misc,Load/Execute macro,EBCDIC-2.VDM}.
- //
- // Likewise, the layout file must be named EBCDIC.LAY to run under
- // WILDFILE.VDM.
- //
- // To initiate just COBOL preprocessing manually, VEDIT must be started
- // with the "-N2" option. Then, after loading the layout file, processing
- // can be initiated as in the above paragraph. Or, run COBOL2V.VDM.
- //
- // E.g., vpw -n2 lname.lay
- // {Misc,Load/Execute macro,EBCDIC-2.VDM}
- //
- //
- #90 = #75 = Buf_Num //#90 = current buffer #
- #92 = 0 //#92 = layout buffer ID; not yet set
- #64 = 0 //Set = 1 to always use fname.LAY
- //instead of EBCDIC.LAY when no explicit
- //filename parameter "lname"
- //
- // For autoexecution (-x), presume anything in buffer #2 is the layout file.
- //
- // if ( -x && !Wildfile && 2nd buffer )
- if ( Is_Auto_Execution && #99!=0x57495C44 && Buf_Status(2) >= 0 ) {
- #92 = 2 // #92 = data layout buffer
- #64 = #64 | 0x40 // Flag data description file already loaded
- //
- // Else, if "-N2", presume the current buffer has/will have the layout file.
- //
- } else { if (Is_Option(n) && (N_Option&2)) {
- #92 = Buf_Num // #92 = data layout buffer
- if ( Is_Open_Write ) {
- #64 = #64 | 0x40 // Flag data description file already loaded
- }
- }}
- if (Is_Option(n)) {
- #0 = #64 & 0x40 //Save "explicit data layout file" bit
- if (N_Option == 0) { #64 = 1 } // Handle "-N" with no parameter
- #64 = #64 | (N_Option & 0xfffff) | #0
…
Large files files are truncated, but you can click here to view the full file