/macros/ebcdic-t.vdm
Unknown | 3417 lines | 3324 code | 93 blank | 0 comment | 0 complexity | 279dd5af47de3d772dc7346120caacec MD5 | raw 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
- }
-
- //
- // Sign on.
- //
- if (#69==0) { if (!Is_Quiet) {
- if ( OS_Type == 1 && ( Screen_Lines < 15 || Screen_Cols < 57 )) {
- Screen_Size(15,57)
- Screen_Init()
- } else {
- Win_Clear()
- }
- Type_Newline()
- #0 = ( Screen_Cols - 57 ) >> 1
- Type_Space(#0)
- Message('*********************************************************\n');TS(#0)
- Message('* EBCDIC-2.VDM 09/26/2003 *\n');TS(#0)
- Message('* Convert EBCDIC file with encoded fields to ASCII *\n');TS(#0)
- Message('*********************************************************\n');TN()
- //
- // If no file open, prompt for filename and open it.
- //
- if (#64&2) { // If just COBOL preprocessing...
- Reg_Set(0,"data layout file")
- } else { // Normally...
- Reg_Set(0,"file to convert")
- }
- if (!Is_Open_Write) {
- repeat(ALL) {
- Reg_Set(0,"Enter name of ",INSERT)
- Reg_Set(0,": ",APPEND)
- Type_Newline()
- Reg_Type(0)
- Get_Input(#65+10,"",NOCR)
- if (File_Exist(@(#65+10))) { Break }
- Alert()
- Message("\nFile not found; please try again or <Ctrl-C> to cancel.\n")
- }
- File_Open("|@(#65+10)",NOEVENT)
- #90 = Buf_Num
- if (#64&2) {
- #92 = Buf_Num
- #64 = #64 | 0x40
- }
- }
- }}
-
- // if (wstat($)<0){wr($,5,bottom)};Reg_Lock_Macro(CLEAR);ws($);update() ?
-
- if ( File_Size == 0 ){
- goto DONE
- }
- //
- // Set Current Directory to source data file.
- //
- Reg_Push(0,0)
- Reg_Set(0,INPUT_FILE)
- Buf_Switch(Buf_Free(EXTRA))
- Reg_Ins(0)
- EOF()
- Replace("|{\,:}","",REVERSE)
- if(Match_Item==2){
- Ins_Text(":\")
- }
- Del_Line()
- Reg_Copy(1,0)
- ChDir(@(1))
- Buf_Quit(OK)
- Buf_Switch(#90)
-
- //
- // Set T-Reg[10] = data output pathname.
- // = path\fname.asc (normally)
- // = user specified (-a)
- //
- // Set #1 if "-a" input parameter.
- //
- #1 = 0 // Allow renaming output file to *.dbf
- if ( Is_SaveAs ) {
- #1 = 1 // Disallow changing output file's extension
- Reg_Set(#65+10,PATH_NAME) //T-Reg[10] = user-specified output pathname
- } else {
- Reg_Set(#65+10,PATH_ONLY) // = path
- Reg_Set(#65+10,"\",APPEND)
- Reg_Set(#65+10,FILE_ONLY,APPEND) // = path\fname
- Reg_Set(#65+10,".ASC",APPEND) // = path\fname.ASC
- }
-
- //
- // Set T-Reg[7] = output_path\.
- //
- #0 = Buf_Num
- Buf_Switch(Buf_Free(EXTRA))
- Reg_Ins(#65+10) //buf[] = full_path_name (output)
- Search("\",BEGIN+ALL+ADVANCE+NOERR) //Skip over pathname
- Reg_Copy(7,0) //T-Reg[7] = output_path\
- Buf_Quit(OK)
- Buf_Switch(#0)
-
- //
- // Delete default error file from the output directory.
- // Set T-Reg[18] with its full pathname.
- //
- Reg_Set(#65+18,@(7))
- Reg_Set(#65+18,`ebcdic.err`,APPEND)
- File_Delete( @(#65+18), OK + NOERR )
-
- //
- // Check for missing/empty data file.
- //
- if (! Is_Open_Write || FSize == 0 ) {
- Reg_Empty(1)
- Out_Reg(1,APPEND)
- Message("\n***** Misssing or empty data file ")
- Reg_Type(0)
- Message("\n")
- Out_Reg(CLEAR)
- Call("ERRMSG")
- if (Is_Quiet) {
- XALL(1)
- } else { if (#99==0x57495C44) {
- break_out
- } else {
- break_out(EXTRA)
- }}
- }
-
- //
- // Set T-Reg[15] = source_data_pathname.
- //
- Out_Reg(#65+15)
- Name_Read(EXTRA+NOMSG+NOCR)
- Out_Reg(CLEAR)
-
- //
- // Close the source data file.
- // Open an empty output buffer with the specified data output filename.
- // Set #75 = main output buffer ID.
- //
- Buf_Empty(OK)
- File_Open_Write(@(#65+10),OVERWRITE+OK+NOMSG)
- #75 = Buf_Num
- //
- // Set T-Reg[6] = temporary output pathname to allow editing the
- // source data file = outputpath\EBCDAT.TMP.
- //
- Reg_Set(0,@7) //T-Reg[0] = outputpath\
- Reg_Set(0,"EBCDAT",APPEND) //T-Reg[0] = outputpath\EBCDAT
- Reg_Set(6,@0) //T-Reg[6] =
- for ( #0=0; FileExist("|@(6).TMP",NOERR); #0++ ) {
- Reg_Set(6,@0) // T-Reg[6] = outputpath\EBCDAT
- Out_Reg(6,APPEND) // Divert output to end of T-Reg[6]
- Type_Char((#0/10)+'0')
- Type_Char(remainder+'0')
- Out_Reg(CLEAR) // Stop diverting output
- }
- Reg_Set(6,".TMP",APPEND) // T-Reg[6] = outputpath\EBCDAT[nn].TMP
- //
- // Reopen the source data file with temporary output pathname T-Reg[6].
- // Set #90 = buffer ID.
- //
- File_Open('"|@(#65+15)" -a "|@(6)"',OVERWRITE+OK+NOMSG)
- #90 = Buf_Num
- Config(F_OVER_MODE,0,ALL)
- //
- // Set T-Reg[9] = "source_data_path\fname.LAY".
- // Set T-Reg[11] = "fname.LAY".
- //
- Buf_Switch(Buf_Free(EXTRA)) //Switch to temp buffer
- Reg_Ins(#65+15) //buf[] = source_data_full_pathname
- Replace(".|M|>","",REVERSE+NOERR) //Delete any existing extent
- Ins_Text(".LAY",BEGIN) //Append ".LAY"
- Reg_Copy_Block(9,0,File_Size) //T-Reg[9] = "path\fname.LAY"
- //
- Search("\",BEGIN+ALL+ADVANCE+NOERR) //Skip over pathname
- Reg_Copy_Block(#65+11,CP,EOL_Pos) //T-Reg[11] = "fname.LAY"
- //
- Buf_Quit(OK) //Discard temporary buffer
- //
- // Open data layout file with temporary name for editing.
- // Unless already loaded, determine name: EBCDIC.LAY or fname.LAY;
- // then load it from the current directory if possible;
- // else from the VEDIT Home Directory;
- // quit if no such file.
- // Enter: T-Reg[9] = "source_data_path\fname.LAY".
- // T-Reg[11] = "fname.LAY".
- //
- if (#92>0) {
- Buf_Switch(#92) //Switch to data layout buffer
- }
- if (#64&0x40) { // If explicit data layout file
- Reg_Set(9,INPUT_FILE) // Full pathname for error handling
- Out_Reg(#65+11)
- Name_Read(NOMSG) // Filename only (for consistency)
- Out_Reg(CLEAR)
- } else { // No explicit layout file
- if (!(#64&1)) { // If !( -N 1 ) i.e., not fname.lay
- Reg_Set(9,"ebcdic.lay") // full pathname (current directory)
- Reg_Set(#65+11,"ebcdic.lay") // for VEDIT home directory
- }
- Reg_Set(0,"UNPAKEBC.DAT") // Archaic name
- if (File_Exist(@(9))) { //If local layout file, load it
- File_Open("|@(9)",OVERWRITE+OK+NOMSG) // but do not create backup file
- } else { if (File_Exist(@(0))) { //If local UNPAKEBC.DAT, load it
- File_Open("|@(0)",OVERWRITE+OK+NOMSG)
- } else { if (File_Exist("|(HOME)\|@(#65+11)")) {
- File_Open("|(HOME)\|@(#65+11)",OVERWRITE+OK+NOMSG)
- } else { if (File_Exist("|(HOME)\|@(0)")) {
- File_Open("|(HOME)\|@(0)",OVERWRITE+OK+NOMSG)
- } else {
- Reg_Empty(1)
- Out_Reg(1,APPEND)
- if (Is_Quiet) {
- Message("\n***** No data layout file.")
- }
- Message(`\nCannot find `); Reg_Type(9)
- Message(` in current nor VEDIT's "home" directory.`)
- Message(`\nRefer to EBCDIC-2.TXT for details.\n`)
- Out_Reg(CLEAR)
- Call("ERRMSG")
- if (Is_Quiet) {
- XALL(1)
- } else {
- Type_Newline(1)
- Buf_Quit(OK)
- Buf_Switch(#90)
- GetKey("Press any key to view data file...")
- Call("CloseErr")
- Break_Out(EXTRA)
- }
- }}}}
- }
-
- //
- // Close and reopen the layout file for editing as LAYOUTnn.TMP
- // Where nn is a number that, if present, creates a unique name.
- // Set T-Reg[5] = temporary layout pathname.
- //
- Reg_Set(9,INPUT_FILE) // For BADLAY
- Reg_Set(0,@7) //T-Reg[0] = outputpath\
- Reg_Set(0,"LAYOUT",APPEND) //T-Reg[0] = outputpath\EBCDAT
- Reg_Set(5,@0) //T-Reg[5] =
- for ( #0=0; FileExist("|@(5).TMP",NOERR); #0++ ) {
- Reg_Set(5,@0) // T-Reg[5] = outputpath\LAYOUT
- Out_Reg(5,APPEND) // Divert output to end of T-Reg[5]
- Type_Char((#0/10)+'0')
- Type_Char(remainder+'0')
- Out_Reg(CLEAR) // Stop diverting output
- }
- Reg_Set(5,".TMP",APPEND) // T-Reg[5] = outputpath\LAYOUT[nn].TMP
- Buf_Empty(OK)
- File_Open('"|@(9)" -a "|@(5)"',OVERWRITE+OK+NOMSG)
- #92 = Buf_Num
-
- //
- // Set T-Reg[8] = Cross Reference filename, in case DBASE.
- // Open the cross reference file in read only mode.
- //
- Reg_Set(0,INPUT_FILE)
- Buf_Switch(Buf_Free(EXTRA))
- Reg_Ins(0)
- if (Search(".",BEGIN+ALL+NOERR+ADVANCE)){
- Del_Block(CurPos-1,EOB_Pos)
- }
- EOF()
- Ins_Text(".xrf")
- BOL()
- rc(8,1)
- Buf_Quit(OK)
- Buf_Switch(#92)
- if (File_Exist(@(8))) {
- File_Open("|@(8)",BROWSE|OK|NOMSG)
- Buf_Switch(#92)
- }
- //
- // Remove junk (0x1a, e.g.) at end of layout file.
- //
- End_Of_File(); bol; if ( match("|[|w]|k") == 0 ) { db(cp,eolpos) }
- //
- // Ensure layout file is newline-terminated.
- //
- End_Of_File()
- Ins_Newline(1) //Ensure final newline
- line(-10,NOERR) //Back up a bit
- r("|<|L","",ALL+NOERR) //Strip empty lines
- //
- Config(E_EXP_TAB,1,LOCAL) // Tabs complicate COBOL processing
- Config(E_RETAB_BK,0,LOCAL)
- Config(E_RETAB_FILL,0,LOCAL)
- Detab_Block(0,File_Size)
- BOF()
- //
- // Rename data output file when not invoked with "-a"
- // to .dbf if DBASE.
- //
- if (#1==0) { // When not "-a"
- //
- // r=len,DBASE-III
- //
- if (s("^[\s\t]*r[\s\t]*=.*,[\s\t]*DB",REGEXP+NOERR)){
- Reg_Set(1,"dbf")
- Buf_Switch(#75)
- Reg_Set(0,FILE_ONLY)
- Buf_Quit(OK)
- Buf_Switch(#75)
- File_Open_Write('"|@(7)|@(0).|@(1)"',OVERWRITE+OK+NOMSG)
- #75 = Buf_Num // Belts and suspenders
- Reg_Set(#65+10,PATH_NAME)
- Buf_Switch(#92)
- }
- BOF()
- }
-
- //////////////////////////////////////////////////////////////////////////
- // //
- // Preprocessing COBOL copybook statements //
- // //
- //////////////////////////////////////////////////////////////////////////
-
- if (!Is_Quiet) {
- Message("Processing data description file... ")
- }
- #64 = #64 | 0x200 // Tell COBOL2V.VDM that it is a submacro
- call(#65+19) // COBOL preprocessing
- if (#99!=0x57495C44) { // When not running under WILDFILE...
- Reg_Empty(#65+19) // COBOL processor no longer needed
- }
- if ( #64 & 2 ) { // Quit when just preprocessing COBOL
- goto DONE
- }
-
- //
- // Check for and process invocation "-u option_list" parameter.
- // Need to do it now, for COBOL2V and RELAY and initial pre-processing
- // settings. Need to do it again after preprocessing in case the .lay
- // file set some values, since the "-u" parameters should prevail.
- //
- #41 = 0 //Unique ID run_no
- #42 = -1 //Unique ID flag
- #43 = 0 //Flags that .nam files to be included at start of each output file
- #44 = 1 //Output decimal points as specified by "vn" field options
- #50 = JDate() //#50 Run date; combined into #55 at end of preprocessing
- #55 = JDate("1-1-2000") //#55 is base date for unique extraction ID's
- call("OPTIONZ")
-
- //////////////////////////////////////////////////////////////////////////
- // //
- // Preprocessing our own data descriptions //
- // //
- //////////////////////////////////////////////////////////////////////////
- //
- // Strip comments, leading whitespace and blank lines.
- //
- // if (wstat($)<0){wr($,5,bottom)};Reg_Lock_Macro(CLEAR);ws($);update() ?
- Replace("|<|w","",BEGIN+ALL+NOERR) //Remove leading whitespace
- Replace("|<|[|W]//|Y|L","",BEGIN+ALL+NOERR) //Strip comment lines
- Replace("|[|W]//|Y|>","",BEGIN+ALL+NOERR) //Strip inline comments
- Replace("|<|L","",BEGIN+ALL+NOERR) //Remove blank lines
- Replace("^{[a-z]+[\s\t]+.*,[\s\t]*[0-9]+}[\s\t]+{[^\s\t].*}$","\1 \2",REGEXP+BEGIN+ALL+NOERR)
- //
- // Prevent explicit decimal points from being generated, as directed.
- //
- call("DOPOINT")
- //
- // Setup T-Regs[2,4] with binary output field sizes.
- //
- call("SETBREGS")
- //
- // Strip any "i=inflation" parameter; this is for relay.vdm only.
- //
- bof
- while (search("|<|[|w]|?|*|{:,|s|[|w]i|[nflation]|[|w]=}",noerr)){
- if (Match_Item!=1){
- Search("|[|w]i|[nflation]|[|w]=|[|w]")
- Del_Char(Chars_Matched)
- Num_Eval()
- Del_Char(Chars_Matched)
- if (Match("|[|w];|[|w]")==0){
- Del_Char(Chars_Matched)
- }
- if (!AtEOL){
- Ins_Char(' ')
- }
- } else {
- l(1,noerr)
- }
- }
- //
- // Set DBASE flag #23 if "r=len,DBASE".
- //
- if (s("^[\s\t]*r[\s\t]*=.*,[\s\t]*dbase",BEGIN+REGEXP+NOERR)){
- #28 = 1 // DBASE flag
- }
- //
- // Ascertain header & record size and optional output filetype code.
- // Set type explicitly for blank type fields.
- // Ensure codes are lower case.
- // Execute any Vedit ('v=') command lines.
- // Delete lines of type 'code letter=' after processing.
- //
- // Delete lines specifying the default type (XDefType) (e,i) when possible.
- //
- // Perform error checking; break out if bad input.
- // Convert to "cb,ce" format.
- // If the 'q' record has been specified (quote & comma delimit), it
- // must have been specified before any field specification;
- // and each field must be specified; (the start of each field_j
- // must = end of field_i + 1).
- //
- XNextCol(0) //XNextCol = last column #
- #3 = 0 //#3 = # fields current record
- #4 = 0 //#4 = max fields/record
- #17 = 0 //#17 counts 'out's
- #18 = 0 //#18 flags that .VCM customization submacros have been loaded
- #63 = 0 //#63 is DBASE .xrf Buffer ID or zero
- #67 = #68 = #86 = -1 //Record types & header size not yet specified
- #85 = 'd' //#85 = last code encountered, initially BCD
- #87 = #51 = #57 = #58 = #59 = #88 = 0 //Record sizes not yet specified
- XDefType('e') //Consider unspecified cols to be EBCDIC
- #38 = 1000 //Max # data errors to report
- //
- // Repeated Fields variables
- //
- #56 = #61 = #79 = 0 //#79 keeps from stripping default types ('rb')
- //#56 is record offset for multiple runs in one day
- //#61 is additional offset for unique ID calculation
- #62 = (5<<16) | (1<<8) | 6 //#62 is # digits displayed for unique ID (3 parts)
- XQCD(0) //Not Quoting and comma delimiting, yet
- XData(#90) //Define data input buffer
- XLay(#92) //Define .LAY buffer
- // if (wstat($)<0){wr($,5,bottom)};Reg_Lock_Macro(CLEAR);ws($);update() ?
- Begin_Of_File()
- while(!At_EOF) {
- //
- // #
- //
- if (match("#")==0){ // Level-4, repeat count adjuster
- goto ENDR
- }
-
- //////////////////////////////////////////////////////
- // //
- // code= processing //
- // //
- //////////////////////////////////////////////////////
- if (cc(1)=='='||cc(2)=='=') {
- //
- // p=
- //
- if (match("p=")==0) {goto MISSING} // COBOL2V.VDM wasn't found
- //
- // q=
- //
- if (match("q=")==0) {goto BAD_LAY} // Unmatched bracket
- //
- // h=
- //
- if (match("h=",advance)==0){ //If "h=" header specified
- #86=Num_Eval() //#86 = header length
- goto DELLN //Now delete this line
- }
- //
- // r=n
- //
- if (match("r=",advance)==0) { // If "r=" record types specified
- #57=#67=#68=Num_Eval(ADVANCE) // #57 = default input record type or length
- // #67 = input record type {0,1,2,3,6}
- // #68 = default output record type
- if (#67>4) {
- #87 = #67 // #87 = input record size
- #68 = #67 = 6 // #67 = fixed length input records
- // assume fixed output records
- }
- //
- // r=n,x where x={v,f=len,dbase}
- //
- if (match("|[|W],",advance)==0){
- if (Match("|{f,v}",advance)==0) {
- #68 = 6 // #68 = 6 = fixed output records
- Match("|[|w]=",advance)
- #88 = Num_Eval() // #88 = output record size
- } else { if (Match("DBASE")==0) {
- #68 = 7 // #68 = 7 = DBASE file
- #88 = 512 // Actual size determined dynamically
- #16 = #75
- Buf_Switch(#16)
- Del_Block(0,File_Size)
- Config(F_F_TYPE,32,LOCAL) // Header consists of 32-byte structures
- #27 = #59 = 1 // # records and record types
- Reg_Set(3,'F') // Short field name = "Fn", where n = field ordinal
- call(49) // DBINIT0()
- } else {
- #68 = Num_Eval() // #68 = {0,1,2,3} = output record type
- if (#68 > 4) {
- #88 = #68
- #68 = 6
- }
- }}
- }
- goto DELLN
- }
- //
- // c= // Column #
- //
- if ( match("c=",advance) == 0 ) { //If "c=" column #
- XNextCol(Num_Eval() - 1) //XNextCol = preceding field's ending col #
- goto DELLN //Now delete this line
- }
- //
- // a= // Additional offset for unique ID calculation
- //
- if ( match("a=",advance) == 0 ) { // if "a=" additional offset
- #61 = Num_Eval()
- goto DELLN
- }
- //
- // b= // base_date for unique Repeated Group extraction ID's
- //
- if ( match("b=",advance) == 0 ) { // if "b=" base_date
- #55 = Num_Eval_Date()
- goto DELLN
- }
- //
- // d= // current_date for unique Repeated Group extraction ID's
- //
- if ( match("d=",advance) == 0 ) { // if "d=" (run) date
- #50 = Num_Eval_Date()
- goto DELLN
- }
- //
- // n= // # digits displayed for each part of unique ID
- //
- if ( match("n=|[|w]",advance) == 0 ) { // if "n=" l,m,n
- #0 = 5 // Days elapsed
- #1 = 6 // Record count
- #2 = 1 // Run # count
- //
- // Days elapsed (default 5)
- //
- #5 = Num_Eval(ADVANCE)
- if (cmat>0){#0=#5}
- //
- // Record count (default 6)
- //
- Match("|w",ADVANCE)
- if (!At_EOL){
- Match("|s|[|w]",ADVANCE)
- #5 = Num_Eval(ADVANCE)
- if (cmat>0){#1=#5}
- //
- // Run # (default 1)
- //
- Match("|w",ADVANCE)
- if (!At_EOL){
- Match("|s|[|w]",ADVANCE)
- #5 = Num_Eval(ADVANCE)
- if (cmat>0&>=0){#2=#5}
- }
- }
- //
- #62 = (#0 << 16) | (#2 << 8) | #1
- goto DELLN
- }
- //
- // e= // Error file
- //
- if ( match("e=|[|w]",advance) == 0 ) { // "e="
- //
- // Just "e=".
- //
- if ( At_EOL || (Match("//") == 0 )) { // Just "e=" turns feature off
- FO("|@(#65+18)",OVERWRITE+NOEVENT) // In case ever any early messages
- if ( fsize ) {
- db(0,fsize) // User doesn't want to know
- File_Close(NOMSG+NOEVENT)
- }
- Buf_Quit(OK)
- Reg_Empty(#65+18)
- #38 = 0 // Speed optimization
- Buf_Switch(XLAY)
- //
- // e=n,filename
- //
- } else {
- //
- // Process limit on # invalid compressed data item messages.
- //
- #5 = Num_Eval(advance+suppress)
- if (Chars_Matched>0) {
- if (#5>=0) { // e=n
- #38 = #5 // #38 = limit
- }
- }
- //
- // Advance past ",[whitespace]"
- //
- match("|[|w],|[|w]",advance) // Advance past ","
- //
- // Process explicit error filename.
- // Set path to the main output directory unless an
- // explicit path is specified (at least one "\").
- //
- if (match("|{//,|>}")) { // When not at comment or eol
- call(53) // T-Reg[0] = filename
- Buf_Switch(Buf_Free(EXTRA))
- Reg_Ins(0)
- if (search("\",BEGIN+NOERR)==0) {
- Reg_Set(0,@(7),INSERT)
- }
- Buf_Quit(OK)
- Buf_Switch(XLAY)
- if (File_Check(@(#65+18))>0) { // If early processing errors...
- FO("|@(#65+18)",NOEVENT) // Switch to the error buffer
- File_Save_As(@0,OK+NOMSG) // Change filename
- File_Delete(@(#65+18),OK+NOERR)
- Reg_Set(#65+18,PATHNAME) // Copy error pathname into T-Reg[18]
- } else { // else if file not yet open ...
- if (Reg_Size(0)>0){ Reg_Set(#65+18,@0) }
- File_Open("|@(#65+18)",OVERWRITE+NOMSG+NOEVENT) // Open any pre-existing file
- Del_Char(ALL) // Empty it
- }
- Buf_Switch(XLAY) // Switch back to layout file
- }
- Reg_Lock_Macro(102,EXTRA) // Trap unexpected breakouts
- }
- goto DELLN
- }
- //
- // i=
- //
- if ( match("i=",advance) == 0 ) { //If "i=" include .nam header files
- if (match("|A")==0){
- if (match("on")==0){
- #43 = 1
- }
- } else {
- #43 = Num_Eval()
- }
- if (#43!=1) {
- #43 = 0
- }
- goto DELLN
- }
- //
- // o=
- //
- if ( match("o=",advance) == 0 ) { //If "o=" default options
- while( match("|[|w]|{b2z,+,b,u,z,-,e,s,p}",ADVANCE) == 0 ) {
- #1 = mi - 1
- if ( #1 == 0 ) {
- EBC_Settings( SP_2_ZERO, 1 )
- } else {
- #0 = 1
- if ( #1 > 4 ) {
- #0 = 0
- #1 -= 4
- }
- if ( #1 == 1 ) {
- EBC_Settings( Force_Plus,#0)
- } else { if ( #1 == 2 ) {
- EBC_Settings( Begin_Sign,#0)
- } else { if ( #1 == 3 ) {
- EBC_Settings( Unsigned,#0)
- } else { if ( #1 == 4 ) {
- EBC_Settings( Leading_Zeros,#0)
- }}}}
- }
- match(",",advance)
- }
- goto DELLN // Now delete this line
- }
- //
- // bc=badchar
- //
- if (match("bc=",advance)==0){
- if (match("|{'',',0x}")!=0){goto BAD_LAY}
- #0=0
- if (mi>1){
- #0=Num_Eval()
- }
- EBC_Settings(badchar,#0&0xFF)
- goto DELLN //Now delete this line
- }
- //
- // pc=padchar
- //
- if (match("pc=",advance)==0){
- if (match("|{'',',0x}")!=0){goto BAD_LAY}
- #0=0
- if (mi>1){
- #0=Num_Eval()
- }
- EBC_Settings(padchar,#0&0xFF)
- goto DELLN //Now delete this line
- }
- //
- // u= // Ignore,Ascii,Ebcdic
- //
- if (match("u=|[|W]",advance)==0){ // If "u=" unspecified columns
- XDefType(CurChar | 0x20) // ebcdic or ignore
- goto DELLN
- }
- //
- // v=
- //
- if (match("v=",advance)==0){ // if "v=" Vedit command
- if (#64&256) { goto ENDR }
- rcb(#65+11,cp,eolpos) // Copy command(s) into T-Reg[11]
- Buf_Switch(XData) // Switch to the source data buffer
- call(#65+11) // Perform them
- Buf_Switch(XLAY) // Reenter the data layout buffer
- goto DELLN // Delete this line!
- }
- //
- // x=
- //
- if (match("x=",advance)==0){ // if "x=" post processing commands
- rcb(#65+14,cp,eolpos) // Copy command(s) into T-Reg[14]
- #64 = #64 | 8 // Set flag
- goto DELLN // Delete this line!
- }
- } // (cc(1)=='='||cc(2)=='=')
-
- //
- // uid={off,auto,all}
- //
- if (match("uid|[|w]=|[|w]",advance)==0) { // If Unique ID is (not) wanted...
- if (match("|d")==0){
- #42 = Num_Eval()
- } else { if (match("|{off,auto,all}")==0) {
- #42 = Match_Item - 1
- } else { if (match("|{on,force}")==0) {
- #42 = 2
- } else {
- #42 = 0
- }}}
- if ( #42 < 0 || #42 > 2 ) {
- #42 = 1
- }
- goto DELLN
- }
- //
- // xrf=arg where arg = 1 or "on" to enable.
- //
- if (match("xrf|[|w]=|[|w]",advance)==0){
- #63 = 0
- if (match("|{1,on}")==0){
- File_Open("|@(8)",NOMSG) // Switch to the cross reference file
- if (File_Size > 0) {
- #63 = Buf_Num
- }
- Buf_Switch(XLAY) // Switch back to the .LAY file
- } else {
- #63 = 0 // Auto-generate the field names
- }
- goto DELLN
- }
-
- //////////////////////////////////////////////////////
- // //
- // Output diversion filename. //
- // //
- //////////////////////////////////////////////////////
-
- if (match("out|{|w,//,|>}",ADVANCE)==0) {
- #17 += 0x10000 // Count this "out"
- if(Match("|{//,|>}")) {
- NumPush(16,16)
- RegSet(0,@3)
- RegPush(0,0)
- or(3,APPEND); TypeChar('A' + ((#17>>8) & 0xff)); or(CLEAR)
- #17 += 0x100 // Update # "out" autogenerated short names
- call(59)
- } else {
- call("DBEOR")
- RegPop(3,3)
- NumPop(16,16)
- }
- goto ENDR
- }
-
- //////////////////////////////////////////////////////
- // //
- // Other Code Processing //
- // //
- //////////////////////////////////////////////////////
-
- #5 = 0
- //
- // Set #2 = lower case code letter.
- //
- if (match("|A")==0) {
- #2 = Cur_Char | 0x20 // make lower case
- //
- // q - quote and comma delimit
- //
- if (#2=='q') {
- XQCD(1) // Set Quote-and-Comma-Delimit flag
- if (#3!=0) { // Cannot have processed any fields yet
- goto BAD_LAY
- }
- if (#28) { // Cannot mix QCD and DBASE
- goto BAD_LAY
- }
- goto DELLN // Delete this line from the layout file
- }
- //
- // Set #85 = initial valid code letter and advance past it.
- //
- if (match("|{b,c,d,e,f,h,i,l,n,s,u,x,y,z}",advance)==0) {
- #85 = #2
- } else {
- goto BAD_LAY
- }
- } else {
- goto BAD_LAY
- }
- //
- // c - custom field.
- //
- if (#85 == 'c' && #18 == 0 ){
- //
- // Use T-Reg[1] to load and speed optimize submacros.
- // Then distribute the code to their proper T-Regs.
- //
- Reg_Load(1,"EBCDIC-2.VCM",EXTRA)
- Reg_Prep(1)
- Call(1)
- Reg_Empty(1)
- #18 = 1
- }
- //
- // Convert "+size" to "bc,ec".
- //
- Match("|W",ADVANCE)
- if (Cur_Char=='+'){ //Process code +size
- Del_Char(1)
- #10 = Num_Eval(SUPPRESS)
- XAdjBeg(XNextCol + 1) // cb
- XAdjEnd(XNextCol + #10) // ce
- Del_Char(Chars_Matched)
- Num_Ins(XAdjBeg,LEFT+NOCR)
- Ins_Char(',')
- Num_Ins(XAdjEnd,LEFT+NOCR)
- } else { //Process code bc,ec
- //
- // Check for invalid beginning column number.
- //
- XAdjBeg(Num_Eval(SUPPRESS+ADVANCE)) //Set field starting column
- if (XAdjBeg < 1 ) { goto BAD_LAY } //Check for valid number
- if (XQCD>0 && XAdjBeg!=XNextCol+1){goto BAD_LAY} //Contiguous quoted fields
- if (XAdjBeg < XNextCol) { goto BAD_LAY } //Fields must be in ascending order
- //
- // Convert "m<sep>n" to "m,n".
- //
- if (!Replace_Block("|[|W]|S|[|W]",",",Cur_Pos,EOL_Pos,NOERR)) {
- goto BAD_LAY }
- //
- // Check for invalid ending column number.
- //
- XAdjEnd(Num_Eval(SUPPRESS+ADVANCE)) //Set field ending column
- if (XAdjEnd < 1 ) { goto BAD_LAY } //Check for valid number
- if (XAdjEnd < XAdjBeg) { goto BAD_LAY } //Fields must be in ascending order
- }
- //
- // Valid field; count it.
- //
- #3++
- //
- // Set XNextCol to last specified column.
- //
- XNextCol(XAdjEnd)
- //
- // Process options.
- //
- EBC_Get_Opt()
- //
- // Add field to DBASE header, perhaps.
- //
- if (#28) {call("DBFIELD")}
- //
- // Optimize by stripping default field (ebcdic) specifications if able.
- //
- call("OPTIMIZE")
- if (Return_Value) {Goto DELLN}
- //
- // ENDR - Advance to next description line and loop, if possible;
- // terminate loop, otherwise.
- //
- :ENDR:
- line(1,errbreak)
- continue
- //
- // DELLN - Delete "code=" line from buffer.
- // Continue at top of loop.
- //
- :DELLN:
- if ( #64 & 256 ) { goto ENDR } // When just preprocessing
- BOL()
- Del_Line(1)
- continue
-
- ///////////////////////////////////////////////////////////////////////////////
- //
- // OPTIMIZE - Delete unnecessary specifications ('e', 'i' or 'u').
- // Cannot strip when QCD nor user delimited fields.
- // Cannot strip if FieldSize or PadCount.
- // Cannot strip 'u' if LeadingZeros, OutPoint or SP2Zero.
- // Cannot strip 1st nor last specification in an "out...out"
- // extraction block.
- //
- // Enter: #2 = current specification code's 1st letter.
- // #17 = 00 oo nn rr, where
- // rr = # out's
- // oo = # out-auto-generated short names
- // XDefType = default code {a,e,i}.
- // CurPos should be at EOL unless custom field.
- // Retrn: (RET_VAL == 1) if line is to be deleted.
- // CurPos on same line; may be at BOL.
- //
- :OPTIMIZE:
- //
- // Return NOSTRIP when not default item nor 'u';
- // also when quoting and comma delimiting or
- // using explicitly specified item separators.
- //
- if (( #2 != XDefType && #2 != 'u') || XQCD + RSize(XDREG) > 0 ) {
- return(0)
- }
- //
- // Give BADPARM error if !AtEOL/EOF.
- //
- if (!AtEOL){goto BAD_PARM}
- //
- // Return NOSTRIP if either FieldSize or PadCount.
- //
- if ( EBC_Settings( FieldSize ) || EBC_Settings( PadCount )) {
- return(0)
- }
- //
- // For 'u', return NOSTRIP if LeadingZeros, OutPoint or SP2Zero.
- //
- if ( #2 == 'u' ) {
- if ( EBC_Settings( LeadingZeros ) || EBC_Settings( OutPoint ) || EBC_Settings( SP2Zero )) {
- return(0)
- }
- }
- //
- // Backup to previous description.
- // If none, it's OK to STRIP.
- //
- BOL()
- SavePos()
- if (Search("|<|a",REVERSE+NOERR)==0){
- RestorePos()
- return(1)
- }
- //
- // If previous description is beginning 'out',
- // return NOSTRIP.
- //
- #0 = 0
- if (match("out|s")==0 && ((#17>>16)&1)) {
- #0 = 1
- }
- RestorePos()
- if (#0) {return(0)}
- //
- // Return NOSTRIP if the next description, if any, is
- // the ending 'out', else STRIP.
- //
- SavePos()
- Char(1)
- #0 = 1 // STRIP
- if (Search("|<|a",NOERR)){
- if (match("out|s")==0 && ((#17>>16)&1)) {
- #0 = 0
- }
- }
- RestorePos()
- return(#0)
-
- // OPTIMIZE ends
-
- ///////////////////////////////////////////////////////////////////////////////
- //
- // DOPOINT - Strip "vn" from field options as specified.
- // Enter: #44 = Allow-decimal-point flag.
- // Retrn: Lines beginning with "NOD" or "DOD" have been deleted.
- // Fields within purview of "NOD" have "vn" stripped out.
- // #44 undefined (not needed anymore).
- //
- :DOPOINT:
- bof
- Set_Marker(0,Cur_Pos)
- while (search("|<|[|w]|{n,d}od",NOERR)) {
- if (match("|[|w]n")==0){
- if (#44){
- Set_Marker(0,Cur_Pos)
- }
- #44 = 0;
- Del_Line(1)
- } else {
- if (#44==0){
- call("XPOINT")
- }
- #44 = 1
- Del_Line(1)
- }
- }
- if (#44==0){
- eof
- }
- :XPOINT:
- #0 = Cur_Pos
- Goto_Marker(0)
- Set_Marker(0,#0)
- while (search_block("|bv|[|d|[|d]]|s",Cur_Pos,Marker(0),NOERR)){
- replace("|bv|[|d|[|d]]","")
- }
- Goto_Marker(0)
- return
-
- ///////////////////////////////////////////////////////////////////////////////
- //
- // DBFIELD - Add current field to DBASE header; update header size; update record size.
- // Enter: #3 = Field Counter.
- // #28 > 0 (DBASE flag).
- // #63 = .xrf BufID
- // [3] = RecName
- // DBF - #16 = BufID of .dbf file.
- // #85 = field specifier {a,b,c,d,e,f,h,i,l,n,s,u,x,z}
- // XAdjBeg = begin column (input).
- // XAdjEnd = end column (input).
- //
- :DBFIELD:
- if (#85=='x'){return} // Do nothing when field is being deleted
- //
- // Set T-Reg[1] = field name.
- //
- if (#63>0){ // When .xrf file has been specified
- //
- // Use first name on .xrf file's current line and advance to next line.
- //
- Buf_Switch(#63)
- Match("|W",ADVANCE)
- #0 = Cur_Pos
- s("|b")
- rcb(1,#0,Cur_Pos) // T-Reg[1] = first name on current line
- Line(1,NOERR) // Advance to next line
- } else {
- //
- // Else auto-generate the field name.
- //
- RegSet(1,@3) // Record name
- ITOA(#3,1,LEFT+NOCR+APPEND) // Field number
- }
- //
- // DBF -
- // Enter: #16 = .dbf BufID
- // #85 = Field Type (.lay code)
- // XAdjBeg = Field Beginning Col
- // XAdjEnd = Field Ending Col (only need XAdjEnd - XAdjBeg to be valid)
- // [1] = Field Name
- //
- :DBF:
- BufSwitch(#16) // Switch to .dbf file
- NumPush(0,5)
- #0 = File_Size - 1 // Position just ahead of <cr> terminator
- GP(#0)
- Ins_Char(0,COUNT,32) // Zero-out current 32-byte structure
- //
- // Insert field name (Pos 0-10)
- //
- GP(#0)
- RegIns(1,OVERWRITE)
- //
- // Insert field type (Pos 11) {C,D,L,N}
- //
- GP(#0+11)
- Ins_Char('C',OVERWRITE) // Character type
- //
- // Compute and insert field length (Pos 16)
- //
- call("FIELD_SIZE") // #2 = size
- GP(#0+16)
- Ins_Char(Return_Value,OVERWRITE)
- //
- // Update # bytes in the header (pos 8-9).
- //
- GP(8)
- Ins_Char(FSIZE&0xFF,OVERWRITE)
- Ins_Char((FSIZE>>8)&0xFF,OVERWRITE)
- Config(F_REC_HEAD,FSIZE,LOCAL)
- //
- // Update # bytes in the record (pos 10-11).
- //
- #1 = cc + (cc(1)<<8) + #2
- Ins_Char(#1&0xFF,OVERWRITE)
- Ins_Char((#1>>8)&0xFF,OVERWRITE)
- Config(F_F_TYPE,#1,LOCAL)
- //
- Num_Pop(0,5)
- Buf_Switch(XLAY)
- return
-
- // DBFIELD ends
-
- //
- // SETBREGS - Set T-Reg[4] with table of default (cooked) binary sizes;
- // Set T-Reg[2] with table of max binary sizes when "raw";
- // (must agree with BMAX[] and RMAX[] in Veditc2.asm)
- //
- // BMAX DB 1,4,6, 8,11,13,16,18 ;Standard (cooked) binary sizes
- // RMAX DB 3,5,8,10,13,15,17,20 ;Raw binary sizes
- //
- :SETBREGS:
- #0 = Buf_Num
- Buf_Switch(Buf_Free(EXTRA))
- Ins_Char('.')
- Replace(".","|H01|H04|H06|H08|H0B|H0D|H10|H12",BEGIN)
- Reg_Copy_Block(4,0,Cur_Pos,DELETE)
- Ins_Char('.')
- Replace(".","|H03|H05|H08|H0A|H0D|H0F|H11|H14",BEGIN)
- Reg_Copy_Block(2,0,Cur_Pos,DELETE)
- Buf_Quit(OK)
- Buf_Switch(#0)
- Return
-
- // SETBREGS() ends
-
- ///////////////////////////////////////////////////////////////////////////////
- //
- // FIELD_SIZE - return # bytes in output field.
- // Enter: #85 = field specifier {a,b,c,d,e,f,h,i,l,n,s,u,x,z}.
- // XAdjBeg = begin column (input).
- // XAdjEnd = end column (input).
- // Retrn: Return_Value = field size.
- //
- // BMAX DB 1,4,6, 8,11,13,16,18 ;Standard binary sizes
- // RMAX DB 3,5,8,10,13,15,17,20 ;Raw binary sizes
- //
- :FIELD_SIZE:
- Num_Push(0,1)
- #0 = EBC_Settings( UNSIGNED )
- #2 = XAdjEnd - XAdjBeg + 1
- //
- if (#85=='b') {
- if (EBC_Settings(raw)){
- #5 = BtoI( 2, #2 - 1, 1 ) // #5 = max # decimal digits
- // packed into #2 binary bytes
- } else {
- #5 = BtoI( 4, #2 - 1, 1 ) // #5 = standard max # decimal digits
- // packed into #2 binary bytes
- }
- #2 = #5
- //
- // Other codes
- //
- } else { if (#85=='d'||#85=='n'||#85=='h'){
- #2 += #2
- if (#85=='d'){
- #2-- // Further adjustments yet to come
- }
- }}
- //
- // Adjust/recompute for ",[{-,=}]padlen;" option.
- //
- if (#1 = EBC_Settings( FIELD_SIZE )) {
- #2 = #1
- } else {
- #2 += abs( EBC_Settings( PAD_COUNT ) )
- }
- //
- // Adjust for any sign.
- //
- if ((#85=='b'||#85=='d'||#85=='z'||#85=='l'||#85=='s')&&!#0){
- #2++
- }
- //
- // Adjust for any explicit decimal point.
- //
- if ( EBC_Settings( Out_Point ) !=0 ) { #2++ }
- //
- Num_Pop(0,1)
- return(#2)
-
- // FIELD_SIZE ends
-
- ///////////////////////////////////////////////////////////////////////////////
- //
- // DQEOR - Proceed to DBEOR if current record type has extracted portions.
- // Note: CurPos is at start of next record type.
- // Enter: #28 = DBASE flag.
- // #59 = record types counter
- // #73 = segment level
- //
- :DQEOR:
- //
- // Just return if not DBASE or no items.
- //
- if (#28==0||#59==0){return}
- //
- if (#73){goto DBEOR}
- Set_Marker(9,CurPos)
- BOL()
- Search("|<|{l=,st,so,t}",REVERSE+NORESTORE+NOERR)
- l
- #0 = 0
- while(SearchBlock("|<|{out,rb|[|w#|d|[|d]]}|[|w]",CurPos,Marker(9),ADVANCE+NOERR)){
- if (!AtEOL){
- #0 = 1
- break
- }
- }
- GM(9)
- if (#0==0){return}
- //
- // DBEOR - For DBASE, enter unique field into header & set F_F_TYPE.
- // Enter: #59 = # record types (do nothing when 0).
- // #28 = DBASE flag.
- // #62 = sizes of reccnt, segcnt, jdate : { 0000 jjjj ssss rrrr }
- // [3] = DBASE record name.
- :DBEOR:
- if (#59==0){return}
- if (#28) {
- RegSet(1,@3)
- RegSet(1,"UID",APPEND)
- #85 = XDefType // #85 = default code ('e' for EBCDIC, e.g.)
- XAdjEnd((#62&0xFF) + ((#62>>8)&0xFF) + ((#62>>16)&0xFF) + 1) // XAdjEnd = length of unique ID
- XAdjBeg(1) // Only interested in XAdjEnd - XAdjBeg
- #85 = XDefType // Set field type to default
- EBC_Reset(LOCAL) // Reset all current options
- call("DBF")
- }
- return
-
- // DBEOR ends
-
- } // Preprocessing loop ends
-
- call("DQEOR")
-
- //////////////////////////////////////////////////////////////////////////
- // //
- // End of .LAY Preprocessing Loop //
- // //
- //////////////////////////////////////////////////////////////////////////
- //
- //
- // Check for and reprocess invocation "-u option_list" parameter.
- // Any settings in the invocation list should prevail.
- //
- Num_Push(14,14)
- call("OPTIONZ")
- if (#42<0){#42=1} // Auto option for UID's if not otherwise specified
- Num_Pop(14,14)
-
- //
- // Compute #55 = date portion of unique ID for Repeated Group extractions
- //
- #55 = #50 - #55
- //
- // Set #50 = # digits to display elapsed days count of unique ID
- // Set #62 = # digits to display record count of unique ID
- //
- #50 = (#62 >> 16) & 0xff
- #40 = (#62 >> 8) & 0xff
- #62 = #62 & 0xff
-
- if (#64 & 256) { goto DONE } // Quit when just preprocessing
-
- //////////////////////////////////////////////////////////////////////////////
- //
- // Final initialization.
- //
- BOF()
- Buf_Switch(XData) //Switch to source data file
- //
- // Deal with record size/type, allowing user to set record type
- // from {Config} menu.
- //
- if (#67>=0) { //For defined record types
- Config(F_F_TYPE,#57,LOCAL) //Set input record type/default-size
- //
- // Allow user to configure the record size/type by hand.
- //
- } else {
- #57 = #67 = #87 = Config(F_F_TYPE) //#87 = input record size/type
- if (#67<6) {
- #87 = 0
- } else {
- #67 = 6
- }
- }
- //
- // Move any header into output buffer via T-Reg[0].
- //
- if (#86>0) {
- RCB(0,0,#86,DELETE)
- EOF()
- BS(#75) //Standard output buffer
- RI(0)
- BS(XData)
- Config(F_REC_HEAD,#86,LOCAL)
- }
-
- //
- // For DBASE, output initial blank column.
- //
- if (#28){
- bs(#75)
- EOF()
- if (XDefType=='a'){
- Ins_Char(0x40)
- }else{
- Ins_Char(0x20)
- }
- }
- //
- #93 = 1
- Goto_Line(#93) //Start at 1st record
- #0 = CurPos+1 //Flag/value for record size adjustments
- //
- // Compute intermediate statistic values.
- // Enter: #67 = input record type {0,1,2,3,6} or = -1.
- // #58 = sum of record sizes.
- // #59 = # record-types.
- // Exit: #76 = (approx) record size.
- // #77 = (approx) # records in the file.
- //
- if (#67>3){ //If fixed-length records...
- if (#59>0) {
- #76 = (#58 + (#59>>1) + 1) / #59
- } else {
- #76 = #57 //Default record size
- }
- } else { //Else file should have newlines...
- Line(100,NOERR) //Advance a few lines
- #76 = (Cur_Pos - #0 + 1)/100 //Approx line size
- Goto_Line(#93) //Restore pos
- }
- #77 = (File_Size-#0+1) / #76 //#77 = # of records in file
- //
- // Set #31 = # records per reporting period {100 or 10 or 2}.
- //
- #31 = 100
- if (#77 < 500){ #31 = 10 }
- if (#77 < 50){ #31 = 2 }
- //
- // Show life by displaying "Processing first xxx data records..." message.
- //
- //
- if (!Is_Quiet) {
- Win_Hor(1)
- Message("Input file: ") // Display input drive:\path\name
- Reg_Type(#65+15,0)
- Win_EOL()
- Type_Newline()
- Buf_Switch(#75)
- Name_Write(EXTRA) // Ditto for output file
- Buf_Switch(XData)
- if (Reg_Size(#65+18)){
- Message("Error file: ") // Ditto for error error file
- Reg_Type(#65+18,0)
- Win_EOL()
- Type_Newline()
- }
- Message("Processing first ")
- Num_Type(#31,LEFT+NOCR)
- Message(" data records... ")
- }
- //
- // More statistics.
- //
- #36 = File_Size
- #39 = Reg_Free // Do nothing for record #0
-
- // if (wstat($)<0){wr($,5,bottom)};Reg_Lock_Macro(CLEAR);ws($);update() ?
-
- //////////////////////////////////////////////////////////////////////////////
- //
- // Main Processing loop.
- //
- #77 = #75 //Initially, output buffer = standard output buffer
- #32 = Time_Tick
- XAdjEnd(-1) //1st time flag for empty record type (all default data)
- XRecNum(0) //Init record counter
- XDataByteCount(0) //No bytes processed yet
- XSegOfs(0) //Segment column offset
- while(!AtEOF){ //For each record
- //
- // Switch to source data buffer.
- //
- BS(XData)
- //
- // Show progress message every 100 or 10 or 2 iterations.
- //
- if (!IsQuiet&&!(XRecNum%#31)){
- call(#39) // T-Reg(#39) is empty, initially
- #39=62 // Next time it'll have the right stuff
- }
- //
- // Initialization for each record:
- // Increment record #
- // Reset XRecByteCount - # bytes processed in current record
- // XInflation
- // XLastColProc
- // #54 - Extraction-file-present flag
- // Set XNextCol = 1
- // Set XAdjEnd = -1 - for u=ignore for extraction process
- //
- #54=0 // Extraction-file-present flag
- X_Init_Record()
-
- //////////////////////////////////////////////////////////////////////////
- //
- // Field processing loop
- //
- BS(XLAY) //Switch to ebcdic.lay file
- BOF
- while(!AtEOF){ //For each field
- //
- // Process Vedit Macro expression.
- // Allows adjusting pseudo repeat count (actually, variable record
- // length counter) that counts the counter itself.
- //
- if (CC=='#'){
- NE(ADVANCE) // Actually evaluates #x++ or #x+=2, e.g.
- // ADVANCE helps tracing
- l(1,errbreak)
- continue
- }
- //
- // out [filename]
- //
- if (match("out|[|W]",ADVANCE)==0){
- if(Match("|{//,|>}")) {
- #78=XLCP
- Num_Push(77,78) // Save current output stream
- call(50,"PRE")
- call(58) // #77 = extraction buffer ID
- } else {
- call(50) // "POST"
- Num_Pop(77,78) // Restore original output stream
- XLCP(#78)
- }
- l(1,noerr) // Advance to next field description
- continue
- }
-
- //////////////////////////////////////////////////////////////////////
- // //
- // Translate current field. //
- // //
- // Each independent subsection must entirely process its field, //
- // leaving the edit position just past it and past any extra //
- // characters that may have been added. //
- // //
- //////////////////////////////////////////////////////////////////////
-
- X_Doit()
-
- //
- // Switch back to data description file.
- //
- BS(XLAY) //Switch to ebcdic.lay file
-
- } // (!At_EOF)
-
- //////////////////////////////////////////////////////////////////////
- // //
- // End of record processing. //
- // //
- //////////////////////////////////////////////////////////////////////
- //
- // Convert any final unspecified columns.
- //
- BS(XData)
- //
- //
- //
- if (#67<6){ // If terminated input records...
- #0=eolpos-CP
- }else{ // But for fixed length records...
- #0=#87+XI-XNC+1
- } // Anyway, #0 = # chars to eol
- if (#0>0){
- if (XDefType=='e'){
- TRB(CP,CP+#0,REVERSE+NORESTORE)
- }else{
- C(#0)
- }
- }
- //
- // Delete any newline char(s).
- //
- if (#67<6) {
- R("|L","")
- }
- //
- // Move translated bytes into output buffer via T-Reg[0].
- //
- RCB(0,0,CP,DELETE)
- BS(#77)
- 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)
- }
- RI(0)
- }
- if (!AtBOL()){
- //
- // If any detail extraction file(s) specified, output unique ID
- // plus comma and quote marks, if so specified.
- //
- if((#42&2)||(#54&*)){call(48)} // UID()
-
- //
- // Insert newline char(s), if so specified.
- //
- if ((0<=#68)&&(#68<6)){
- if (#68!=1){IC(0x0d)} // DOS and MAC
- if (#68!=2){IC(0x0a)} // DOS and UNIX
- }
- }
- //
- // Switch back to the source data buffer.
- //
- BS(XData)
-
- } // Main processing loop
-
- /////////////////////////////////////////////////////////////////////////////
- //
- // Set true to view final statistics.
- //
- if ( 0 ) { if (!Is_Quiet) {
- Win_Hor(1)
- Message("Converted records: ")
- Num_Type(XRecNum-1,NOCR)
- Message(" (")
- Num_Type(100,LEFT+NOCR)
- Message("%)")
- Win_EOL()
- Message("\nActual elapsed time: ")
- if ( 0 ) {
- Num_Type((Time_Tick - #32 + 500)/1000,LEFT+NOCR)
- GetKey(" seconds.") // Pause at end of message
- } else {
- Num_Type(Time_Tick - #32,LEFT+NOCR)
- GetKey(" milliseconds.") // Pause at end of message
- }
- }}
-
- //////////////////////////////////////////////////////////////////////////////
- //
- call("CleanUp")
- File_Save(BEGIN+NOMSG) // Save output file; goto BOF (quickly)
- //
- // Do any specified post-processing.
- //
- if (#64&8){call(#65+14)}
- //
- // Discard data description buffer.
- // Delete the temporary file.
- //
- Buf_Switch(XLAY)
- Buf_Quit(OK)
- File_Delete(@(5),OK+NOERR)
- //
- // Release temporary source data file & delete it.
- //
- Buf_Switch(XData)
- Buf_Quit(OK)
- File_Delete(@(6),OK+NOERR) // Delete temporary data file
- //
- // Restore text and numerical registers and then terminate.
- //
- //{
- :DONE:
- Buf_Switch(#75) //Switch to main output buffer
- Reg_Empty(101) //Empty error reporting submacro
- Reg_Empty(102) //Empty unexpected breakout trapper
- Call("CloseErr")
- 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)
- 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)
- if (#99==0x57495C44) { //If WILDFILE macro running
- Config(F_F_TYPE,#4)
- Config(F_REC_HEAD,#5)
- }
- Num_Pop(0,10) //Restore remaining user numregs
- Reg_Lock_Macro(#66)
- #69 = 1 //WILDFILE flag for next time in
- if (Is_Option(y)) { Xall(NOMSG) } //If "-Y" invocation, exit now
- if (#99==0x57495C44) { //If WILDFILE macro running
- if (!Is_Quiet) {
- Type_Newline()
- }
- }
- if (#105) {
- vm(NOMSG)
- }
- return
-
- //} DONE()
-
- //////////////////////////////////////////////////////////////////////////////
- //
- // Clean up:
- // Release source data file.
- // Set appropriate viewing display modes for the output files.
- // For DBASE, append <ctrl-z>'s and fixup header info.
- //
- //
- // {
- :CleanUp:
- //
- // Release source file.
- //
- BS(XData)
- Buf_Quit(OK)
- //
- // Release .xrf file, unless DBASE
- //
- if (#28==0||#63==0){
- File_Open("|@(8)",OK+NOMSG)
- Buf_Quit(OK)
- }
- //
- // Configure, save, goto 1st line of each output file.
- //
- Buf_Switch(#75)
- call("SETDISP")
- if ( #68 >= 0 ) { // (Any "r=" sets #68 > -1)
- //
- // Primary output file.
- //
- if (#68 <= 4 ) { // #68 = output record type?
- Config(F_F_TYPE,#68,LOCAL) // Set record type for clean viewing
- } else { if (#28==0){ // But when fixed output but not DBASE
- if (#88<=0){
- Config(F_F_TYPE,64,LOCAL) // Set arbitrary record size
- } else {
- Config(F_F_TYPE,#88,LOCAL)
- }
- } else { // For DBASE...
- call("FIXDB")
- }}
- //
- // Also for extracted files
- //
- BS(XLAY)
- bof
- repeat(all){
- s("|<|{tx,rb|[|w]|[#|d|[|d]],out|!|L}|[|w]",advance+errbreak)
- if (At_EOL){continue}
- sm(8,cp)
- rcb(0,cp,cp+1,norestore) // Copy delimiter into T-Reg[0]
- s(@0) // Find terminating delimiter
- rcb(0,marker(8),cp) // Copy filename into T-Reg[0]
- bs(#75) // Switch to main buffer so that we can
- // use e.g. tx "|(FILEONLY).as1"
- fo("|@(0)",NOEVENT+NOMSG) // Switch to the buffer
- call("SETDISP")
- if (Is_Altered) {
- if (#28==0){ // When not debased...
- if (#68 <= 4 ) {
- Config(F_F_TYPE,#68,LOCAL) // Set record type for clean viewing
- } else {
- Config(F_F_TYPE,64,LOCAL) // Set arbitrary record size
- }
- } else { // DBASE ...
- call("FIXDB")
- }
- }
- bs(XLAY) // Switch back to the data description file
- }
- bs(#75) // Switch back to the standard output file
- }
- return
- // } // CleanUp()
-
- //
- // SETDISP -
- //
- // {
- :SETDISP:
- if (XDefType=='e') {
- Config(D_DSP_MODE,4,LOCAL)
- }
- return
-
- // } // SETDISP()
-
- //
- // FIXDB -
- //
- // {
- :FIXDB:
- EOF()
- if ( Cur_Pos - BOL_Pos == 1 ){
- Del_Char(-1) // Remove any orphaned "deleted-item" column
- }
- #0 = File_Size - Config( F_REC_HEAD )
- if ( #0 > 0 ) {
- Ins_Char( 0x1a ) // Append <EOF>
- File_Save(BEGIN+NOMSG) // Set edit position to file beginning
- Char(4) // Advance Cur_Pos to record counter field
- #0 = #0 / Config( F_F_TYPE ) // #0 = # records
- repeat(4){
- Ins_Char(#0&0xFF,OVERWRITE)
- #0 = #0 >> 8
- }
- Goto_Line(1) // Skip over any DBASE header
- }
- return
-
- // } // FIXDB()
-
- //////////////////////////////////////////////////////////////////////////////
- // //
- // Error Processing //
- // //
- //////////////////////////////////////////////////////////////////////////////
- :MISSING:
- Reg_Empty(1)
- Out_Reg(1,APPEND)
- Message("\n***** COBOL2V.VDM could not be found.")
- Message("\n Invalid data description line:\n")
- goto ALLBAD
-
- :BAD_PARM:
- Reg_Empty(1)
- Out_Reg(1,APPEND)
- Message("\n***** Unrecognized option: ")
- type(1)
- Message(" Occurred in line:\n")
- goto ALLBAD
-
- :BAD_LAY:
- Reg_Empty(1)
- Out_Reg(1,APPEND)
- Message("\n***** Invalid data description line:\n")
-
- //
- // ALLBAD - Main Fatal Error handling routine.
- // T-Reg[1] contains the error message; output has not yet been
- // displayed but appended to the end of this register. This is done
- // for quietness' sake.
- // Enter: T-Reg[1] contains main error message.
- // E-Buf[XLay] is the current edit buffer.
- // Exit: Additional info put into T-Reg[1], which is then copied
- // to the end of the .err file. Unless "-q" option, T-Reg[1]
- // is also copied to the screen.
- // Processing is terminated either with "xall" for ("-q") or
- // Break-Out(Extra), otherwise.
- //
- // Note: See "DATERR" in T-Reg[101] for non-fatal data error reporting.
- //
- :ALLBAD:
- BOL()
- type(1) // Copy current .lay line to the end of T-Reg[1]
- Out_Reg(CLEAR) // Turn output diversion off
- //
- // Find location of invalid specification in source .LAY file.
- //
- Search("|s")
- if (At_EOL) {
- #0 = Cur_Pos
- } else {
- #0 = Cur_Pos + 1
- }
- Reg_Copy_Block(0,BOL_Pos,Cur_Pos)
- BOF
- #1 = Search_Block("|<|@(0)",0,#0,ALL)
- #0 = 0
- if (!Is_Quiet) { // Want to keep edited layout file for "-q"
- Buf_Quit(OK)
- Buf_Switch(XLAY)
- }
- File_Open("|@(9)",OVERWRITE+NOMSG+NOERR) // Open source .lay file
- Search("|<|@(0)",COUNT+NOERR,#1) // Won't be there for manufactured codes
- //
- // Write source line # and filename into .err file for "-q".
- //
- if (Is_Quiet) {
- Out_Reg(1,APPEND)
- Message("Line # ")
- Num_Type(Cur_Line,LEFT)
- Message("File: ")
- Name_Write(EXTRA+NOMSG)
- Out_Reg(CLEAR)
- }
- Call("ERRMSG")
- if (Is_Quiet) {
- XALL(1)
- } else {
- GetKey("\nPress any key to edit data layout file...")
- Call("CloseErr")
- Break_Out(EXTRA)
- }
- //
- // ERRMSG - Output message in T-Reg[1] to screen and/or error file.
- //
- :ERRMSG:
- if ( Reg_Size(#65+18) ) {
- #0 = Buf_Num
- File_Open("|@(#65+18)",NOMSG) // Really just a buffer switch
- EOF
- Reg_Ins(1)
- Buf_Switch(#0)
- }
- if (!Is_Quiet) {
- Reg_Type(1)
- Reg_Empty(1)
- Alert()
- }
- return
- //
- // CloseErr -
- //
- :CloseErr:
- if (Reg_Size(#65+18)) { // If .err file exists
- #0 = Buf_Num
- File_Open("|@(#65+18)",NOMSG) // Buffer switch
- if (#0==Buf_Num) {
- #0 = XData // Don't want empty buffer/window
- }
- if (File_Size) { // If any errors
- Buf_Close(NOMSG+DELETE) // Save the message(s)
- } else {
- Buf_Quit(OK) // Else discard the empty file
- }
- Buf_Switch(#0)
- }
- return
-
- //////////////////////////////////////////////////////////////////////////////
- // //
- // Processing Macro specific parameters from DOS command via "-u" //
- // //
- //////////////////////////////////////////////////////////////////////////////
- //
- // OPTIONZ - Process user definable options from invocation line's "-u option_list".
- //
- // Note: WIN95 batch-file processing strips '=' from the parameter line.
- // So, use '-' instead.
- //
- // Option_List:
- // run_no // where 0 <= run_no < 10
- // UID=val // (Default = auto = 1)
- // d=run_date // For setting run date in Unique ID
- // i[nclude][=val] // To include .nam at start of each output file
- // // val={off,on} or {0,1}
- // NOD // No explicit decimal points
- //
- // Enter:
- // Retrn: #41 = run_no, 0 <= n < 9; run # for unique ID; default == 1.
- // #42 = {0,1,2} for UID={off,auto,on or all}; default == 1.
- // #43 = {0,1} for Include={off,on}; default == 0.
- // #44 = {0,1} for preventing/allowing decimal points; default=1
- // #50 = Run Date (# days since 1-1-1, more or less).
- //
- // Note: this routine is called both before and after preprocessing.
- //
- :OPTIONZ:
- #3 = Buf_Num
- #4 = 0
- if (#64&0x800){ // Old style, from "-n 0x800"
- #42 = 0
- }
- //
- // Process "-u options" for version 5.30 and later
- //
- if (vn>=530){
- Buf_Switch(Buf_Free(EXTRA))
- Ins_Text(CMD_LINE)
- EOF()
- Ins_Char(' ')
- if (Replace("|<|M-u"," ",BEGIN+NOERR)) {
- #4 = Buf_Num
- //
- // Set Unique ID option to {off,auto,all}
- //
- if (Replace("|buid|[|w]|{=,-}"," ",BEGIN+NOERR)) {
- #14 = Cur_Pos
- if (match("|d")==0){
- #42 = Num_Eval(ADVANCE)
- } else { if (match("|{off,auto,all}",advance)==0) {
- #42 = Match_Item - 1
- } else { if (match("|{on,force}",advance)==0) {
- #42 = 2
- } else {
- #42 = 0
- }}}
- if ( #42 < 0 || #42 > 2 ) {
- #42 = 0
- }
- Del_Block(#14,CurPos)
- }
- //
- // Include .nam header file at start of each output file, perhaps.
- //
- if (Search("|bi|[nclude]|s",BEGIN+NOERR)){
- Del_Char(CMAT-1)
- match("|W",ADVANCE)
- #43 = 1
- if (Match("|{=,-}|[|w]")==0){
- Del_Char(Chars_Matched)
- if (Match("|d")==0){
- #43=Num_Eval()
- } else { if (Match("|{off,on}")==0){
- #43 = Match_Item - 1
- }}
- #43 = max(#43,0)
- Del_Char(Chars_Matched)
- }
- }
- //
- // Set run_date for Unique ID: d=mm/dd/yyyy.
- //
- if (Replace("|bd|[|w]|{=,-}|[|w]","",BEGIN+NOERR)){
- #50 = Num_Eval_Date()
- Del_Char(Chars_Matched)
- }
- //
- // Prohibit generation of explicit decimal points, perhaps.
- //
- if (Search("|bnod|s",BEGIN+NOERR)){
- Del_Char(CMAT-1)
- #44 = 0
- }
- //
- // Process run-# for unique ID.
- // Note: Keep this code at the end of the <IF "-u"> clause.
- //
- BOF()
- if (match("|w|d|[|d]|b")==0){
- #14 = Cur_Pos + 1
- if ((#0 = Num_Eval(ADVANCE)) > 0 ) {
- #41 = #0
- Del_Block(#14,Cur_Pos)
- }
- }
- } // <IF "-u">
- }
- //
- // Clean up.
- //
- if (#4>0){
- Buf_Switch(#4)
- Buf_Quit(OK)
- }
- //
- //
- //
- Buf_Switch(#3)
- return
-
- // OPTIONZ ends