/macros/cobol2v.vdm

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

// COBOL2V.VDM - Process COBOL copybook, converting to Greenview's

//		 "code colbeg,colend" format.

//

//		 Written by: Thomas C. Burt, Greenview Data, Inc.

//		 Last change: 07/26/2007

//

//		 Can now (10/31/2003) handle UniSys streaming nibbles that

//		 ignore byte boundaries; types 'm', 'mh' and 'mx'.

//

//		 Will also now optionally treat "COMP" as Packed-No-Zone.

//

// Requires:	 VEDIT PLUS 6.11.2E dated 11-05-2003 or later for NIBBLES or

//		 VEDIT PLUS 6.03    dated 06-01-2002 or later, otherwise.

//

//		 Can be run stand-alone or as a submacro to EBCDIC-n.VDM.

//

// Usage (stand alone):

//

//		 vpw [-y] -x COBOL2V copybook.cbk [-a layout.lay] [-u options]

//

//		 -y causes COBOL2V.VDM to exit to DOS when running in

//		    stand-alone-mode, saving all files. Otherwise, the

//		    newly generated .lay file is displayed in visual mode.

//

//		 -a changes the destination filename to something other

//		    than the source filename.

//

//		 -u options

//

//		    DBASE uses ".dbf" as the output extent for filenames

//			  in the .LAY output file;

//			  generates "// col (INDEX)" at the end of each

//			  record and extracted data section ("out" or "rb");

//			  generates a cross reference .XRF file. E.g.,

//

//			  "vpw -x cobol2v cobol.cbk -a gv.lay -u DBASE"

//

//			  produces both "gv.lay" and "gv.xrf".

//

//		    SQL   Generates ..._SQL_CRE.IMP file of SQL types & lengths.

//

//		    DOS   (default): emit <cr><lf> at the end of each

//			  output line.  Uses ".asc" as the output extent.

//

//		    UNIX: emit <lf> at the end of each output line.

//

//		    MAC:  emit <cr> at the end of each output line.

//

//		    cc=col_num to set starting column for comment field.

//

//		    comp=level for default "COMP." level (normally 4 for

//		         Big Endian (IBM) binary).

//

//		    NORELAY - don't run RELAY.VDM even in "stand-alone" mode.

//

//		    ISHORT - Insert short field names into comment section past

//		    	    "col" when DBASE is operative.

//

//		    NAMES - Generate .nam file with COBOL field names.

//		    	    Names are quoted and comma delimited.

//		    	    A newline is generated at the start of each record;

//		    	    i.e., at each "c=0" specification in the source file.

//		    	    To be properly included during data conversion by

//		    	    the EBCDIC-x conversion package, each line must later

//		    	    be extracted into its own separate ".nam" file.

//

//		    NIBBLES - Packing BCD digits across byte boundaries.

//		    	      When used, COMP fields are considered to be

//		    	      nibbles (usually BCD, with or without a sign

//		    	      nibble), packed streamwise from the left.

//

//		    PNZ	- all "COMP" fields are treated as Packed-No-Zone

//		    	  instead of being treated as binary data.

//		    	  Archaic; use "comp=6" instead.

//

//		 In stand alone mode, the entire active file is presumed

//		 to be COBOL copybook statements.  The only extra statements

//		 are blank lines, VEDIT comments, "c=0[,R]" and, perhaps,

//		 "p=" and "q=" lines.

//

//		 The "c=0[,R]" line is used to indicate the start of a new

//		 record type; 'R' is a unique letter for identifying

//		 the record type. It generates a 'tx "R.ext"' line and, for

//		 "-u DBASE", is used in generating the cross reference

//		 "short" field name.

//

//		 When being driven by EBCDIC-n.VDM, "p=" and "q=" brackets

//		 are required around any copybook statements.

//

// Usage as a submacro to EBCDIC-n.VDM:

//		 Set #64 = 0x200 to strip comments from the copybook.

//			 = 0x202 to comment out the copybook.

//			   (The copybook is always commented out when

//			   run stand-alone).

//		 Set #65 = base register.  Registers (base+10 - base+18)

//			   are used herein, saving/restoring user's

//			   contents.

//

//		 When run as a submacro, the "p=" and "q=" brackets must

//		 be used around each section of COBOL statements.

//

// Use "c=0[,R]" to indicate the start of a new record type. The 'R' will

// be used to form a proto-filename: 'tx "R.ASC"', e.g.

// The "c=0[,R]" line will be replaced by a proto record specification:

// "t 1,0xff,0xF1	// Record type #1: EBCDIC '1' in col 1"

// "l=reclen"

//

// Note: Comments out all REDEFINES clauses/paragraphs.  The user will

//	 probably need to edit the resulting output file or edit the

//	 source file and rerun COBOL2V on the edited source file.

//

// Handles multiple, even nested, OCCURS DEPENDING ON clauses.

//

// Handles: [COMP[-n]] [S][9[9...][(n)]] [V 9[9...][(n)]]  [COMP[-n]]

//	    [COMP[-n]]	  [9[9...][(n)]] [V 9[9...][(n)]]- [COMP[-n]]

//			   where n={1,2,3,4,6}

//				  ={Float,Double,BCD,binary,PNZ}.

//				   where BCD = Binary Coded Decimal = Packed Decimal

//					 PNZ = Packed-No-Zone = signless BCD

//	    X[X...][(n)], where 'n' = # bytes.

//	    B[B...][(n)],	  "

//	    C[C...][(n)],	  "

//	    D[D...][(n)],	  "

//	    F[F...][(n)],	  "

//	    H[H...][(n)],	  "

//	    Y[Y...][(n)],	  "

//

//	    'B' is binary (including 1-byte binary).

//	    'C' is for a custom field.

//	    'D' deletes the field.

//	    'F' fills the field with spaces.

//	    'H' is hexadecimal.

//	    'Y' is DATE (for SQL).

//

// Note: 'B', 'C', 'D', 'F', 'H' and 'Y' are special Greenview only codes.

//	 These codes must be edited into the COBOL copybook, replacing

//	 ambiguous 'X' picture statements.

//

// Note: 'Y' is converted to 'e' for the .lay file but generates a DATE

//       field type and length for the SQL .imp file.

//

// Note: "COMP." is binary (Big Endian) unless the "-u comp=level" parameter is used.

//

// Note: When the "-u  NIBBLES" parameter is used for UniSys' streaming nibbles,

//	 COMP's are assumed to be BCD or PNZ with or without a leading sign nibble.

//

// Note: The archaic "-u PNZ" is still valid but the alternative "-u comp=6" is preferred.

//

//	 COMP-1 is floating point.

//	 COMP-2 is double precision.

//	 COMP-3 is packed decimal.

//	 COMP-4 is IBM binary (Big Endian).

//	 COMP-5 is HardWare ordered binary (NYI).

//	 COMP-6 is Packed-No-Zone (PNZ).

//

//	The COBOL specification for binary is PIC [S]9(n) COMP, where normal

//	values for 'n' are 4, 8 and 18 for 2-, 4- and 8-byte binaries.

//	This macro supports all binary sizes upto 8 bytes.

//	It generates ",=len;" where "len" = # digits for picture clauses

//	other than the defaults. It generates the "raw" option for

//	binaries whose picture clauses specify that values may be larger

//	than "all spaces".

//

//	It outputs 'u' into the options field for unsigned numbers.

//

// Note: input field width for BCD pictures S9(n)v9... COMP-3 =

//	 Int(( Total(9's) / 2 )) + 1

//

//////////////////////////////////////////////////////////////////////////

//									//

//			Cross Reference File				//

//									//

//////////////////////////////////////////////////////////////////////////

//

// When the "-u DBASE" input option is used in stand-alone mode,

// a cross reference file will be generated consisting of

// "r[s]n" "cobol-statement-name" pairs.

//

// 'r' is a letter denoting the record name as specified by the "c=0,r"

// line or {A,B,C,...} if 'r' is not specified.

//

// 's' = {A,B,C,...} is a letter generated for records containing more than

// 250 fields. Such records are automatically split into 250-field sections.

// 'out "rs.DBF"' ... 'out' brackets are emitted into the .lay file.

// The opening bracket will be moved forward if it would otherwise appear

// in the middle of an "OCCURS" clause.

//

// 'n' is the field index, starting from one. It continues incrementing even

// when records are automatically split into sections. It is reset by each

// "c=0" line.

//

// Each line in the cross reference file consists of 12 spaces, the

// automatically generated "short" name and the full COBOL copybook name

// which starts in column 30.

//

// The filename will have the same name as the current .lay output filename

// with extension ".xrf".

//

//////////////////////////////////////////////////////////////////////////////

//

// Text Marker Usage

//

// Marker(8)-> (moving) start of the COBOL block.

// Marker(9)-> past end of the COBOL block.

// Marker(7)

// Marker(6)-> "." terminating current COBOL line.

// Marker(5)-> BOL of current COBOL statement.

//

//////////////////////////////////////////////////////////////////////////////

//

// Numerical Register Usage

//

// Note: Preserves Numerical Registers 6-8, 64-66, 75,76, 90-92, 99 and 105

//	 for EBCDIC-x.VDM.

//

//	#1	For last usable column + 1 (Set to 73 in Main Processing Loop)

//	#2	COMP level (0=no,1-6,0xFF=default)

//		(1=Float,2=Double,3=BCD,4=IBM binary,5=HW dependent binary,6=PNZ)

//		Note: COMP-5 not yet implemented...

//		"COMP." defaults to "COMP-4." (Big Endian (IBM) binary)

//	#21	Flag/buffer-ID for cross reference output file

//	#22	Running-stand-alone flag

//	#23	Field counter

//	#24	Record counter

//	#25	Record Name (1 letter)

//	#26	Record size

//	#27	Details record counter (OCCURS DEPENDING ON)

//	#28	File type: {DOS,UNIX,MAC,DBASE}

//	#29	Starting column for comments

//	#30	NORELAY flag

//	#32	ISHORT flag to insert short names into comment field

//	#33	Level-2 flag (single record, no OCCURS DEPENDING ON)

//	#34	NAMES flag to generate COBOL field names in .nam file

//	#35	NIBBLES flag for streaming BCD across byte boundaries

//	#36	Record size augmentation in half-bytes when NIBBLES

//	#37	Default "COMP" level; normally "4" (binary).

//	#38	SQL output_flag/buffer_id.

//	#90	ID of register this macro is running in.

//	#92	current (copybook) edit buffer ID

//

//////////////////////////////////////////////////////////////////////////////

//

// Text register usage (caller's text registers pushed and popped).

//

//	10	Work register converting "+len" to "bc,ec" format at end.

//	10-14	Regular expressions (OCCURS processing submacros).

//	15	"Next_Peer_Field" locating submacro of OCCURS submacro.

//	16	OCCURS processing submacro.

//	17	REDEFINES processing (comment out the paragraph).

//

// Text registers not pushed and popped:

//	0-2	Temporary

//	55	Determine block markers Marker(8) and Marker(9); run RELAY.VDM

//	56	.lay code generator (code +len [vn]) and cross referencer

//	99	Life-indicating message register

//

//////////////////////////////////////////////////////////////////////////////

//

// Abbreviations:

//

// '^' is beginning of a line

// 'v' is the edit position

// '.' is anything

// '01' is an example of a clause level

//

//	BOS	Beginning Of Statement:	   "^v...... 01 Clause_Name"

//	BOCL	Beginning of clause level: "^....... v01"

//	EOCL	End of clause level:	   "^....... 01v"

//	BOCN	Beginning of clause name:  "^....... 01	 vClause_Name"

//	EOCN	End of clause name:	   "^....... 01 Clause_Namev"

//

//////////////////////////////////////////////////////////////////////////////

//

//	Initialization.

//

// if (wstat($)<0){wr($,5,bottom)};ws($);bs(1,attach);ws($);update() ?

//

//	Just return if "p=,q=" brackets missing while being driven by EBCDIC-n.VDM.

//

if (#64&0x200) {	// When running as a submacro...

    if (Search("|<p=",BEGIN+NOERR)==0){return}

}



Num_Push(6,8)

Num_Push(64,66)

Num_Push(75,76)

Num_Push(90,92)

Num_Push(99,99)

Num_Push(105,105)



if ((#64&0x200)==0) {	// When running stand-alone...

    #65 = Reg_Free	// Get base register

}			// Otherwise, #65 is already defined

Reg_Push(#65+10,#65+18)	// Save caller's text registers

Config(U_AUTO_CFG,0)

Config(F_AUTO_SAVE,0)

Config(E_EXP_TAB,1,LOCAL)	// Tabs complicate COBOL processing

Config(E_RETAB_BK,0,LOCAL)

Config(E_RETAB_FILL,0,LOCAL)

Config(S_E_MORE,0)	// Disable CRT scroll-lock



#90 = Macro_Num

//

//////////////////////////////////////////////////////////////////////////////

//

// Setup submacros in T-Regs[15 - 17].

//

//

// T-Reg[15] - NEXT_PEER_FIELD submacro.

//	       Goto start of next statement whose level is less than or equal

//	       to that in #0; goto Marker(9) if no such field.

//

//	       Enter: #0 = statement level.

//		      #1 = Maximum usable data column.

//		      Marker(9).

//

//	       Uses numreg[10] for search/replace options; usage is consistent

//	       with that of the calling macro.

//

Reg_Set(#65+15,`

#10 = COLSET+REGEXP+MAX+ADVANCE+NOERR

repeat( all ) {

    if (Search_Block("\$+\@(#65+12)[0-9]",Cur_Pos,Marker(9),#10,1,#1-1)==0){

	GM(9)				// I don't know why 71 instead of 72

    }

    if (Cur_Pos >= Marker(9)) {

	GM(9)

	break

    }

    char(-1)

    if (Num_Eval(SUPPRESS)<=#0){

	BOL

	break

    }

    Line(1,errbreak)

}

return

`) // T-Reg[15] - NEXT_PEER_FIELD submacro



//////////////////////////////////////////////////////////////////////////////

//

// T-Reg[16] - OCCURS processing submacro.

//	       Process: OCCURS n TIMES [INDEXED BY...] clauses by duplication.

//			OCCURS [ m TO ] n [TIMES] DEPENDING ON x.

//

//	       Enter: #1 = Maximum usable data column

//		      Marker(8)-> start of COBOL specs.

//		      Marker(9)-> past end of COBOL specs.

//

// "OCCURS n [TIMES] [INDEXED BY ... ]."

//     Duplicate the paragraph 'n' times, appending '-m' (m=1,n) to names.

//     Comment out the "OCCURS" statement.

//

// "OCCURS ... DEPENDING ON x"

//	Generate 'rcx', 'rb' and 're' code lines for each occurrence.

//

//////////////////////////////////////////////////////////////////////////////

//

// Numreg usage in T-Reg[16] (caller's values saved by push/pop).

//

//	0	Paragraph level (T-Reg[15] also)

//	2-7,12	Duplicating paragraphs

//	3	OCCURS count

//	9	Edit Buffer Number

//	10	OPTIONS for search/replace (T-Reg[15] also)

//	11	Work Buffer Number

//	12	a.s.

//	27	Index of current "DEPENDING ON" clause, from 0

//

//////////////////////////////////////////////////////////////////////////////

//

// Marker usage:

//

//	Marker(1)-> BOS of "occurs ... depending on ...".

//	Marker(2)-> BOS defined in the "depending on" clause, if any.

//	Marker(3)-> BOS of "occurs" paragraph.

//	Marker(4)-> past " occurs ".

//	Marker(5)-> past statement terminating "."

//	Marker(6)-> one position ahead of the body (sub-clauses) to the <lf>

//		    following Marker(5). (When such body exists;  i.e., no

//		    PIC clause preceding the OCCURS clause)

//	Marker(7)-> past "occurs" paragraph.

//	Marker(8)-> start of COBOL specs (entry).

//	Marker(9)-> past end of COBOL specs (entry).

//

//////////////////////////////////////////////////////////////////////////////

//

Reg_Set(#65+16,`

Num_Push(0,12)

#11 = Buf_Free(EXTRA)	// Get ID of available work buffer

GM(8)			// Start at beginning of COBOL specs

repeat( all ){

    //

    // Set Marker(4) past next " occurs ".

    //

    #10 = COLSET+REGEXP+MAX+ADVANCE+ERRBREAK

    sb("\@(#65+11).* occurs ",cp,Marker(9),#10,1,#1)

    Set_Marker(4,Cur_Pos)

    //

    // Set Marker(5) past statement terminating "."

    //

    bol

    #10 = COLSET+REGEXP+MAX+ADVANCE

    sb("\@(#65+11).*\.",curpos,Marker(9),#10,1,#1)

    Set_Marker(5,Cur_Pos)



    ///////////////////////////////////////////////////////////////////////////

    //									     //

    //			     DEPENDING ON				     //

    //									     //

    ///////////////////////////////////////////////////////////////////////////

    //

    //	   Set Marker(1)-> BOS

    //		Generate 'rb ##27[ "Znr.DBF,Znr"]'<newline>.

    //	   Set Marker(2)-> BOS defined in "depending on" clause.

    //		Generate "rc ##27"<newline>.

    //	   Go to end of paragraph by finding start of the next

    //		paragraph at this or lower-numbered level.  Don't include

    //		commented lines at the end of the paragraph.

    //		Generate "re"<newline>

    //	   Advance to next line.

    //	   Loop

    //



    GM(4)

    if (sb("|bdepending",cp,Marker(5),ADVANCE+NOERR)) {

	match("|W",ADVANCE)

	if (cn>#1||AtEOL){

	    sb("^......\s+",cp,Marker(5),#10,1,#1)

	}

	if (match("on",ADVANCE)==0){

	match("|W",ADVANCE)

	if (cn>#1||AtEOL){

	    sb("^......\s+",cp,Marker(5),#10,1,#1)

	}

	Set_Marker(0,Cur_Pos)

	//

	// Goto BOS - set Marker(4) and generate 'rb ##27[ "Znr.DBF",Znr]'<newline>.

	//

	gm(4)

	#10 = COLSET+REGEXP+MAX+REVERSE

	sb("\$+\@(#65+13)",Marker(8),cp,#10,1,#1)

	#27++

	Ins_Text('rb #')

	Num_Ins(#27,LEFT+NOCR)

	if (#21>0){

	    Ins_Text(' "Z')

	    Num_Ins(#27,LEFT+NOCR)

	    Ins_Char(#25)

	    Ins_Text('.dbf",Z')

	    Num_Ins(#27,LEFT+NOCR)

	    Ins_Char(#25)

	}

	Ins_Newline()

	Set_Marker(1,Cur_Pos)

	c(7)

	#0 = Num_Eval(SUPPRESS)

	//

	// Goto EOS and copy counter's name into T-Reg[0].

	//

	GM(0)	

	s("|{|b,.}")

	rcb(0,Marker(0),Cur_Pos)

	//

	// Goto start of next clause and generate "re"<newline>

	//

	call(#65+15)			// NEXT_PEER_FIELD

	Ins_Text("re")

	Ins_Newline()

	//

	// Find the counter's definition.

	//

	GM(8)

	s("|b|@(0)|{|b,.}")

	//

	// Set Marker(2) and generate "rc ##27"<newline>.

	//

	BOL

	Ins_Text("rc #")

	Num_Ins(#27,LEFT)

	Set_Marker(2,Cur_Pos)

	GM(0)

	line(1,errbreak)

	continue

    }}

    

    ///////////////////////////////////////////////////////////////////////////

    //									     //

    //			OCCURS n [TIMES].				     //

    //									     //

    ///////////////////////////////////////////////////////////////////////////

    //

    // Set #3 = "dup" count.

    //

    gm(4)

    sb("|d",Cur_Pos,Marker(5),colset,7,#1)

    #3 = NumEval()

    //

    // Set #0 = paragraph level.

    //

    gm(4)

    #10 = COLSET+REGEXP+MAX+ADVANCE+REVERSE

    sb("\$+\@(#65+13)",Marker(8),cp,#10,1,#1)

    s(" ",reverse)

    #0 = Num_Eval(SUPPRESS)

    //

    // Set Marker(3)-> beginning of this line, the BOS.

    //

    Set_Marker(3,BOL_Pos)

    //

    // Handle case of single statement (with PIC clause) being duplicated.

    // Create subparagraph instance of the statement less the "occurs" clause.

    //

    GM(3)

    if (sb("|bPIC|[TURE]|W|F",Cur_Pos,Marker(5),ADVANCE+COLSET+NOERR,7,#1)) {

	//

	// Copy the statement into T-Reg[0] and advance to following line.

	//

	GM(5)

	Line(1)

	RCB(0,Marker(3),Cur_Pos)

	//

	// Move the statement into work buffer.

	//

	#9 = bn

	bs(#11)

	bof()

	dc(all)

	ri(0,BEGIN)

	//

	// Remove any comment lines.

	// Convert rest into simple string.

	//

	while (!At_EOF) {

	    Del_Char(6)

	    if (Match(" ")) {

		Del_Line(1)

		continue

	    } else {

		EOL

		if ((#2 = Cur_Pos - BOL_Pos - 66) > 0 ) {

		    Del_Char(-#2)

		}

		Line(1,ERRBREAK)

	    }

	}

	Replace("|L"," ",ALL+BEGIN+NOERR)

	//

	// Delete the "OCCURS..." clause.

	//

	Search(" occurs ",BEGIN+ADVANCE)

	#2 = Cur_Pos - 8

	Search("|d|s")

	Char(1)

	If (Search(" TIMES|S",ADVANCE+NOERR)) {

	    Char(-1)

	}

	if (Search(" INDEXED|WBY|W",ADVANCE+NOERR)) {

	    Search("|{ ,.}")

	}

	Del_Block(#2,Cur_Pos)

	//

	// Increment the statement level by one.

	// (Since this statement has a PIC clause, it has no subparagraphs).

	//

	BOF

	Match("|W",ADVANCE)

	#2 = Num_Eval(SUPPRESS) + 1

	#4 = Chars_Matched

	#5 = Cur_Pos

	Del_Char(#4)

	Ins_Char(' ',COUNT,#4)	// Additional indentation

	Num_Ins(#2,LEFT+NOCR)

	Set_Marker(0,Cur_Pos)	// 1st marker set in this edit buffer

	#6 = Cur_Pos - #5 - #4

	If (#6<#4) {

	    GP(#5+#4)

	    Ins_Char('0',COUNT,#4-#6)

	}

	//

	// Remove excess spaces.

	// Better too tight than grossly expansive.

	//

	GM(0)

	Match("|W",ADVANCE)

	Replace("|W"," ",ALL+NOERR)

	//

	// Restore the string to COBOL format.

	//

	BOF

	Ins_Char(' ',COUNT,6)

	Replace("|w|>"," ",NOERR)

	Ins_Newline(1)

	Char(-Newline_Chars)

	if (Cur_Pos > #1-5) {	// Need room for "-m", (m=1,999)

	    Search(" PIC|[TURE] ",BEGIN)

	    Char(1)

	    Ins_Newline(1)

	    Ins_Char(' ',COUNT,6+#5+#4+6)

	}

	BOF

	while (!At_EOF) {

	    EOL

	    #2 = Cur_Pos - BOL_Pos

	    if (#2 < #1 ) {

		Ins_Char(' ',COUNT,#1 - #2)

	    }

	    Line(1,ERRBREAK)

	}

	//

	// Move the reformatted statement into T-Reg[0].

	// Switch back to the main edit buffer and insert it.

	//

	rcb(0,0,EOB_Pos,DELETE)

	bs(#9)

	Reg_Ins(0)

    }

    //

    // Set Marker(6) two positions ahead of the paragraph's body.

    // (Guaranteed now to have one).

    //

    gm(5)

    Line(1,errbreak)

    Set_Marker(6,Cur_Pos-2)

    //

    // Set Marker(7) to end of paragraph by finding start of the next

    // paragraph at this or lower-numbered level.  Don't include commented

    // lines at the end of the paragraph.

    //

    call(#65+15)			// NEXT_PEER_FIELD

    Set_Marker(7,Cur_Pos)

    #10 = REGEXP+MAX+NOERR

    repeat( all ) {

	line(-1)

	if (Match("^......[^\s]",#10)==0) {

	    Set_Marker(7,Cur_Pos)

	} else {

	if (( Match("^......[\s]+",#10)==0) && Chars_Matched >= #1 ) {

	    Set_Marker(7,Cur_Pos)

	} else {

	    break

	}}

    }

    //

    // Move the paragraph body (Marker(6)+2,Marker(7)) to T-Reg[0].

    //

    RCB(0,Marker(6)+2,Marker(7),DELETE+NORESTORE)

    //

    // Strip out commented lines.

    //

    #9 = bn

    bs(#11)

    bof()

    dc(all)

    ri(0)

    #10 = BEGIN+ALL+REGEXP+MAX+NOERR

    rb("^......[^\s].*\N","",0,fsize,#10)

    //

    // Strip out level 88's (VALUE clauses).

    //

    bof

    #10 = REGEXP+MAX+NOERR

    while (sb("^......[\s]+88\s",cp,fsize,#10)) {

	#101 = BOL_Pos

	s(".")		// Comments gone; hope no quoted '.'s

	l()

	db(#101,cp)

    }

    RCB(1,0,FSIZE)

    bq(OK)

    bs(#9)

    //

    // Insert it #3 times, appending "-m" to each field name, m=1,#3.

    //	  Note: Uses numeric registers 2-7,12.

    //		Restores T-Reg[0] from T-Reg[1] at bottom of loop.

    //

    #4 = 1

    repeat( #3 ) {

	gm(7)

	#7 = Cur_Pos

	Reg_Ins(0,BEGIN)

	#10 = COLSET+REGEXP+MAX+ADVANCE+NOERR

	while(sb("\$+\@(#65+12)[0-9]",cp,Marker(7)-2,#10,1,#1-1)) { // BOCL

	    char(-1)

	    if (numeval(ADVANCE+SUPPRESS)==88){continue}

	    match("[\s]+[^\s\t.]+",REGEXP+MAX+ADVANCE)

	    if (Cur_Pos - BOL_POS >= #1){continue}

	    #5 = #12 = Cur_Pos

	    ic('-')

	    num_ins(#4,left+nocr)

	    #5 = #6 = #2 = Cur_Pos - #5

	    if (Cur_Char == '.'){c}

	    while( #5-- ) {

		if ( Cur_Char != ' ' ) {

		    break

		}

		Del_Char()

		#6--

	    }

	    //

	    // Restore space.

	    // Check for more space at end of line.

	    //

	    if (Cur_Char != ' ') {

		Ins_Char(' ')

		#6++

		Goto_Col(#1+1+#6)

		while( #6-- ) {

		    if ( Cur_Char(-1) != ' ' ) {

			Del_Block( Cur_Pos, EOL_Pos )

			if (cn<#1){

			    break

			}

			Goto_Pos(#12)

			Del_Char(#2)

			break

		    }

		    Del_Char(-1)

		}

	    }

	}

	if (#4 != 1) {

	    Block_Fill(' ',#7,Marker(7)-2,COLSET,1,6)

	    Del_Block(#7,Marker(7)-2,COLSET,#1+1,90)

	}

	//

	// Handle any DEPENDING ON var(n).

	// I.e., where "var" is defined within an OCCURS clause.

	//

	GP(#7)

	while(sb("\$+\@(#65+11).*DEPENDING",cp,Marker(7)-2,#10,1,#1-1)) {

	    sb(" ON ",cp,Marker(7)-2,COLSET+ADVANCE+NOERR,7,#1-1)

	    char(-1)

	    sb(" |A",cp,Marker(7)-2,COLSET+ADVANCE,7,#1-1)

	    #7 = cp - 1

	    Search("|{ ,.}")

	    Save_Pos()

	    rcb(0,#7,cp)

	    gm(8)

	    if (sb("\$+\@(#65+11).*\@(0)\h28",cp,Marker(7)-2,#10,1,#1-1)){

		Restore_Pos()

		Ins_Char(0x28)

		ni(#4,LEFT+NOCR)

		Ins_Char(0x29)

		match(".",advance)

		if (cn>70){

		    dl(1)

		    in(1)

		    gp(#7)

		    in(1)

		    ic(' ',count,20)

		}

	    } else {

		Restore_Pos()

	    }

	}

	//

	#4++

	Reg_Set(0,@1)

    }

    //

    // Comment out the "occurs" statement.

    //

    gm(3)

    Replace_Block("\@(#65+11)","*******",cp,Marker(5),REGEXP+ALL)

    //

    // Now go to the original paragraph body in case of nested "occurs".

    //

    GP(Marker(6)+2)



} // (all)



Num_Pop(0,12)



`) // T-Reg[16] - OCCURS submacro



//////////////////////////////////////////////////////////////////////////////

//

// T-Reg[17] - REDEFINES processing submacro.

//	       Comment out all REDEFINES paragraphs with '.'.

//	       Enter: Marker(8)-> start of COBOL statements.

//		      Marker(9)-> past end.

//		      #1 = Rightmost usable data column.

//

// Note: standard comment is '*' in column 7.  Using '.' will identify

//	 statements commented out by this macro.

//

//////////////////////////////////////////////////////////////////////////////

//

// Numreg usage:

//

//	0,2	Temporary

//	9 - 16	Equivalent-compressed-data processing

//	101	Search options

// 

//////////////////////////////////////////////////////////////////////////////

//

// Marker usage:

//

//	Marker(5)-> start of REDEFINES statement.

//	Marker(6)-> past " REDEFINES".

//	Marker(7)-> past REDEFINES block.

//

//	Marker(3)-> start of original definition statement.

//	Marker(4)-> past end of original definition block.

//

Reg_Set(#65+17,`

GM(8)

repeat ( all ) {

    //

    // Set marker(6) past next " REDEFINES".

    //

    #101 = COLSET+REGEXP+MAX+ADVANCE+ERRBREAK

    sb("\@(#65+11).* REDEFINES ",Cur_Pos,Marker(9),#101,1,#1)

    Set_Marker(6,Cur_Pos)

    //

    // Set marker(5) to BOS.

    // Set #0 = level.

    //

    #101 = COLSET+REGEXP+MAX+ADVANCE+REVERSE

    sb("\$+\@(#65+13)",Marker(8),cp,#101,1,#1)

    s(" ",reverse)

    #0 = Num_Eval(SUPPRESS)

    BOL

    Set_Marker(5,Cur_Pos)		// Start of "REDEFINES" line

    //

    // Set marker(7) to end of this paragraph by finding start

    // of the next peer or lower indexed statement.

    //

    line(1,noerr)

    call(#65+15)			// NEXT_PEER_FIELD

    SM(7,Cur_Pos)

    //

    // Comment out each line in the marked section.

    //

    GM(5)

    Replace_Block(" ",".",Cur_Pos,Marker(7)-1,COLSET+NOERR+ALL,7,7)

    //

    GM(7)



} // Commenting out REDFINES paragraphs.



`) // T-Reg[17] - REDEFINES submacro



//////////////////////////////////////////////////////////////////////////////

//

// T-Reg[55] - Determine block markers Marker(8) and Marker(9) vis a vis

//	       p=,q=, and c=0[,R].

//	       Set "l=reclen" for previous record type.

//	       Generate record name tx R.asc or R.dbf,R if at c=0,R.

//	       Generate prototype "t 1,0xFF,0xF1" line.

//

//	       Set Marker[8]-> start of COBOL block.

//	       Set Marker[9]-> past COBOL block.

//	       Delete any bounding "p=" and "q=" records.

//

//////////////////////////////////////////////////////////////////////////////



Reg_Set(55,`

GM(9)

//

// When running stand-alone:

//

if (#22) {				// Stand alone...

    call("COBBEG")			// Find/process start of COBOL block

    call("COBEND")			// Find/process end of COBOL block

    return

//

// When running as a submacro to EBCDIC-n.VDM:

//

} else {

    Set_Marker(8,Cur_Pos)

    Search("|<|{p=,q=}",NOERR)

    if (Error_Match){

	EOF()

	Set_Marker(8,Cur_Pos)		// Marker(8) at EOF

	Set_Marker(9,Cur_Pos)		// Marker(9) at EOF

	return

    }

    //

    //	Process p=[.].

    //

    if (Match_Item==1) {

	BOL()

	Del_Line(1)			// Delete the "p=" line

	while(Match("|<c=")==0){

	    Line(1,NOERR)

	}

	Set_Marker(8,Cur_Pos)		// Marker(8) at beginning of block

	Search("|<|{c=,q=}",NOERR)

	if (Error_Match){

	    Set_Marker(9,File_Size)

	    Return

	}

	Set_Marker(9,Cur_Pos)

	if (Match_Item==2){

	    Del_Line()

	}

	Return

    }

    //

    //	Process q=

    //

    Del_Line(1)

    Set_Marker(9,Cur_Pos)	// Marker(9) at end of block

    GM(8)

    While(Match("|<c=")==0){

	Line(1,NOERR)

    }

    Set_Marker(8,Cur_Pos)

    return



} // end else running as submacro to EBCDIC-x.VDM



// [55] main routine ends



//

// RECLEN - Create "l=reclen" lines for preceding record, if any.

//	    Enter: #26 = length of preceding record less 'm' digits.

//		   #36 = # 'm' digits and signs in record when NIBBLES.

//	    Retrn: #26 = #36 = 0.

//

:RECLEN:

    Save_Pos()

    if (#26>0) {

	BOL()

	if ( Search("|<t ",REVERSE+NOERR)) {

	    Line()

	    Ins_Text("l=")

	    Num_Ins(#26+#36/2+remainder,LEFT)

	}

    }

    #26 = #36 = 0

    Restore_Pos()

    return



// RECLEN ends



//

// RECORD - Generate record extraction name and proto definition if at c=0,R:

//	    'tx "file_only.ASC"' normally or "R.DBF",R for DBASE and

//	     "t 1,0xFF,0xF1 // Proto Record Type - EBCDIC 1 in column 1"

//	     Append newline char(s) to any .nam file.

//	     Enter: #23 = field counter.

//		    #24 = record counter, from 0.

//		    #27 = detail record counter.

//		    #29 = Starting column for comments.

//		    Marker[7]-> column index (from 0)

//	     Retrn: #23 = 0.

//		    #24 = (#23>0) ? #24++ : #24.

//		    #25 = record name = 'A' + #24.

//		    #27 = 0.

//{

:RECORD:

    #27 = 0

    if (#23!=0){		// Increment record counter

	#24++

    }

    #25 = #24 + 'A'		// Record Name

    #23=0			// Field counter

    GM(7)

    Num_Eval(ADVANCE)

    Match("|W",ADVANCE)

    //

    //	Generate 'tx "file_only.asc"', perhaps.

    //

    if (cc==','){

	c

	Match("|W",ADVANCE)

	if (Match("|A")==0){

	    #25 = Cur_Char

	    BOL()

	    Ins_Text('tx "')

	    if ( #21 ) {

		Ins_Char(#25)

		Ins_Text(".dbf")

	    } else {

		rs(0,File_Only)

		Reg_Ins(0)

		Ins_Text(".asc")

	    }

	    Ins_Char('"')

	    if ( #21 ) {

		Ins_Char(',')

		Ins_Char(#25)

	    }

	    Ins_Newline()

	}

    } else {

	BOL()

    }

    //

    //	Generate prototypical record identifier:

    //      "t 1,0xFF,0xF1	// comment"

    //

    Ins_Text("t 1,0xFF,0xF1")

    Ins_Indent(#29)

    Ins_Text("// Proto Record Type - EBCDIC 1 in column 1")

    Ins_Newline()

    Del_Line()

    //

    //	Finish .nam line

    //

    Call(#90,"ENDNAME")

    return



// RECORD ends}



//

// COBBEG - Return Marker(8) = CurPos at start of next COBOL block.

//	    if "c=0[,R]", generate:

//		 l=reclen	// for previous record

//		 t 1,0xff,0xf1	// for current record; preceded by

//		 tx "R.ext"[,R]	// if ",R" option; "ext" = {ASC,DBF}

//	    Delete any bounding "p=" and "c=0" records.

//{

:COBBEG:

    //

    //	Just return Marker(8) = CurPos when no blocking info.

    //

    Set_Marker(8,Cur_Pos)

    if (!Search("|<|{p,q,c}=",NOERR)){

	GM(8)				// No, ensure CurPos unchanged

	return				// Just return Marker(8) = CurPos

    }



    //

    // q=

    //

    if (mi==2){				// Can there be a valid "q=" at this point?

	GM(8)

	return

    }



    //

    //

    //

    while (Match("|<|{p=,c=}",ADVANCE)==0){

	//

	//	p=.

	//

	if (Match_Item==1){

	    BOL()

	    Del_Line(1)			// Delete the "p=[.]" line

	//

	// c=0[,R]

	//

	} else {

	    Set_Marker(7,Cur_Pos)	// Set marker(7) for RECORD()

	    call("RECLEN")		// Set "l=reclen" for previous record

	    call("RECORD")		// Generate "tx R.ext"[,R] and "t ..."

	}

	Set_Marker(8,Cur_Pos)

    }

    return



// COBBEG ends}



//

// COBEND - Set Marker(9) to end of current COBOL block.

//{

:COBEND:

    GM(8)

    Set_Marker(9,CurPos)

    Search("|<|{p,q,c}=",NOERR)		// p= or c=0 or q= ?

    //

    //	If no block marking info, just return Marker(9) = File_Size.

    //

    if (Error_Match){

	GM(8)

	Set_Marker(9,File_Size)

	return

    }

    //

    // Otherwise, return Marker(9) at the next blocking indicator.

    // Also, delete any "q=" line.

    //

    Set_Marker(9,Cur_Pos)

    if (mi==2){

	Del_Line()

    }

    return



// COBEND ends}



`) // T-Reg[55] - Block Marking Submacro with Marker(8) & Marker(9)



//////////////////////////////////////////////////////////////////////////////

//

// T-Reg[56] - Encoder - generate "code +size[,=len;] [u] [{v,.}n]".

//	       Call XREF to perhaps generate an entry in .xrf file.

//	       Call DOSQL to perhaps add name to _SQL_CRE.IMP file.

//	       Call REDOSQL to perhaps add type info to an entry in _SQL_CRE.IMP file.

//	       Enter short field name into comment section if -u ISHORT.

//	       Copy quoted-and-comma-delimited COBOL field name to .nam if -u NAMES.

//	       Enter: #1 = Maximum usable data column.

//		      #26 = record length, less any 'm' digits and signs.

//		      #28 = Output record type {0,1,2,3} for {DOS,UNIX,MAC,DBASE}

//		      #32 = ISHORT flag.

//		      #35 = NIBBLES flag.

//		      #36 = # 'm' digits and signs when NIBBLES.

//		      #37 = default "COMP" level.

//		      #38 = SQL output buffer id/flag

//

//		      Marker(8)-> start of COBOL statements.

//		      Marker(9)-> past end.

//	       Retrn: #26 and #36 updated.

//		      #81 = # digits before decimal point.

//		      Marker[5] -> start of statement.

//		      Marker[6] -> EOS past '.'

//

// Note: uses #2 - #9 internally; pushes and pops them.

//		      #2  = current COMP level (0=none,1-6,0xFF=default)

//		      #3  = # digits past decimal point

//		      #4  = signed # flag

//		      #5  = temporary

//		      #6  = # bytes in data field

//		      #7  = Adjusted COMP level (0,1-6,7) where '7' implies streaming nibbles

//		      #8  = # digits = #81 + #3.

//		      #9  = flag that '{v,.}[n]' encountered.

//

//////////////////////////////////////////////////////////////////////////////



Reg_Set(56,`

    Num_Push(2,9)		// Be safe

    //

    //	Convert PACKED-DECIMAL's to COMP-3's.

    //

    Save_Pos()

    while(replace(" PACKED-DECIMAL|[|w]."," COMP-3.",NOERR)){

	Ins_Char(' ',count,chars_matched-8)

    }

    Restore_Pos()

    //

    //	Convert BINARY's to COMP's.

    //

    Save_Pos()

    BoF()

    while(replace(" BINARY|[|w]."," COMP.",NOERR)){

	Ins_Char(' ',count,chars_matched-6)

    }

    Restore_Pos()

    //

    //	Convert PIC A's to PIC X's.

    //

    Save_Pos()

    BoF()

    while(replace(" PIC|[ture]|wA"," PIC X",NOERR)){

	#2 = Chars_Matched

	if (Match("A",ALL|ADVANCE)==0){

	    Del_Char(-Chars_Matched)

	    Ins_Char('X',COUNT,Chars_Matched)

	}

	search(".",ADVANCE)

	Ins_Char(' ',count,#2-6)

    }

    Restore_Pos()

    //

    #15 = ((#64 & 2)==2)	// Preprocessing-only flag

    repeat( all ) {

	#2 = 0			// No COMP encountered yet

	//

	// Search current block for next " PIC x", where x = {C,B,D,F,H,Y,S,V,X,9,-,+,.}.

	//		Set Marker(6) -> EOS (past '.').

	//

	sb("^...... .*[\s\t](picture|pic)[\s\t]+[cbdfhysvxCBDFHYSVX9-+.]",Marker(8),Marker(9),REGEXP+MAX+ADVANCE+ERRBREAK)

	Char(-1)

	//

	//	Find terminating period.

	//	While allowing PIC 9.9. !!!

	//

	Save_Pos()

	if (sb(".|{|>,|!9}",cp,eolpos,COLSET+NOERR,8,#1)==0) { // Kludge on kludge

	    sb("^...... .*\.",eolpos,Marker(9),COLSET+REGEXP+MAX,1,#1)

	}

	Set_Marker(6,Cur_Pos)

	//

	//		Set Marker(5) to BOS

	//

	#0 = REGEXP+MAX+ADVANCE+REVERSE

	sb("^...... [\s\t]*[0-9]",Marker(8),Cur_Pos,#0)

	BOL()

	Set_Marker(5,Cur_Pos)

	//

	//		Create cross reference entry in .xrf, if specified.

	//

	call("XREF")

	//

	//		Create entry in _SQL_CRE.imp, if specified.

	//

	call("DoSQL")

	//

	//		Append quoted-and-comma-delimited COBOL fieldname to .nam, maybe

	//

	call("NameIt")

	//

	//

	// Check for SIGN LEADING/TRAILING SEPARATE.

	//

	GM(5)

	#0 = COLSET+REGEXP+MAX+ADVANCE+NOERR

	#4 = 0				// Reset signed number flag

	if (sb("^...... .* SIGN ",cp,Marker(6),#0,1,#1)) {

	    BoL

	    sb("^...... .* {LEADING|TRAILING} ",cp,Marker(6),#0,1,#1)

	    c(-9)

	    match("|{ L,T}")

	    if (mi==1) {

		#3 = 'l'

	    } else {

		#3 = 't'

	    }

	    #4++			// Flag that LEADING/TRAILING found

	}

	//

	// Process any "COMP[-level]."

	// Normally the default (specified by #37) is "4" = Big Endian Binary

	//

	GM(5)

	#0 = COLSET+REGEXP+MAX+ADVANCE+NOERR

	if (sb("^...... .* (COMPUTATIONAL|COMP)[\s\.-]",cp,Marker(6),#0,1,#1)) {

	    if (cc(-1)=='-') {	// #2 = {1,2,3,4,[5],6}

		#2 = NumEval(SUPPRESS)

	    } else {

		#2 = 0xFF	// Default value; use #37

	    }

	}

	//

	// Comment-out upto the "PIC" line or delete upto the "PIC" data.

	//

	Restore_Pos()			// Just at start of PIC's data

	if ( #15 ) {			// if just preprocessing...

	    Set_Marker(7,Cur_Pos)	// Save pos @ {s or x or v or 9 or - or + or .}, x={B,C,D,F,H,Y,X}

	    GM(8)

	    while ( Cur_Pos < Marker(7) ) {

		Ins_Indent(#29)

		InsText("// ")

		//

		// Output 11 blanks for short-name alignment if ISHORT.

		//

		if (#32){

		    Ins_Char(' ',COUNT+ADVANCE,11)

		}

		line(1)

	    }

	    GM(7)			// Restore pos @ {s or x or v or 9 or - or + or .}

	    Set_Marker(7,BOL_Pos)	// Marker(7)-> BOL

	} else {			// when fully processing...

	    Del_Block(Marker(8),Cur_Pos) // Delete back to Marker(8)

	    Set_Marker(7,Cur_Pos)

	}



	///////////////////////////////////////////////////////////////////////

	//								     //

	// Set #0 = LowerCased(CurChar) = one of {s,x,v,9,-,+,.,b,c,d,f,h,y} //

	// #2 > 0 ==> packing of some sort...				     //

	// #2 = 1 to 6 for COMP-1,...,COMP-6 or 0xFF for default (use #37).  //

	// #37 set for UniSys' streaming nibbles.			     //

	//								     //

	///////////////////////////////////////////////////////////////////////



	#0 = Cur_Char | 0x20		// #0 = 'x' | 'v' | 's' | '9' | '-' | '+' | '.' |

					//	'b' | 'c' | 'd' | 'f' | 'h' | 'y'

	if (#0=='d'){ #0 = '@' }	// Break conflict between "Delete" and BCD

	if (#0=='y'){ #0 = '#' }	// Break conflict between "Date" and SIGN SEPARATE



	//////////////////////////////////////////////////////////

	//							//

	//	Most numerics, including GreenView codes.	//

	//							//

	//////////////////////////////////////////////////////////



	if ( #0=='s' || #0=='+' || #0=='-' || #0=='b' || #0=='c' || #0=='h' || #2>0 ) {

					// signed or binary or custom or hex or COMP-n?

	    if (#0=='s' || #0=='+' || #0=='-'){	// signed number

		#4++			// Set flag

		if (#15) {		// if just preprocessing...

		    Char(1)

		} else {

		    Del_Char(1)

		}

	    }

	    //

	    // Set #0 to proper Greenview code.

	    // I.e., #0 = a,b,c,d,e,f,h,l,m,u,x,y,z.

	    // Needed temporarily for generating proper gvc in column 1.

	    // Needed later for handling numeric options.

	    //

	    Save_Pos()

	    //

	    // COMP's and SIGN LEADING/TRAILING SEPARATE.

	    //

	    if ( #0 != 'b' && #0 != 'h' && #0 != 'c' && #0 != '#' ) {

		#7 = #2

		if (#7==0xFF){

		    if (#35) {			// Streaming nibbles

			#7 = 7

		    } else {

			#7 = #37		// Default packing

		    }

		}

		if (#7==1||#7==2){

		    #0 = 'l'

		} else { if (#7==3) {

		    #0 = 'd'

		} else { if (#7==4) {

		    #0 = 'b'

		} else { if (#7==6) {

		    #0 = 'n'

		} else { if (#7==7) {

		    #0 = 'm'

		} else { if (#0=='+'||#0=='-') { // Sign leading separate

		    #0 = 'y'

		    #3 = 'l'

		} else {

		    if (#4==2){			// SIGN SEPARATE

			#0 = 'y'

		    } else {

			#0 = 'z'

		    }

		}}}}}}

	    }

	    GM(7)

	    Ins_Char(#0)

	    if (#0=='y'){			// yol or yot

		Ins_Char('o')

		Ins_Char(#3)

		Del_Char(2*#15)			// Delete spaces, perhaps

	    }

	    Ins_Char(' ')

	    Del_Char(2*#15)			// Delete spaces, perhaps

	    Restore_Pos()



	//////////////////////////////////////////////////

	//						//

	//	Unsigned number ([v,.]9), perhaps.	//

	//						//

	//////////////////////////////////////////////////



	} else { if ( #0=='v' || #0=='.' || #0=='9' ) {

	    Save_Pos()

	    GM(7)

	    Ins_Text("u ")

	    Del_Char(2*#15)			// Delete spaces, perhaps

	    Restore_Pos()

	    if (#0=='.'){

		Ebc_Settings(InPoint,1)		// Explicit decimal point

	    }

	    #0 = 'u'				// Unsigned number



	//////////////////////////////////////////////////////////

	//							//

	//	Else simple nonnumeric (X), X={@,#,F,X}.	//

	//							//

	//////////////////////////////////////////////////////////



	} else {

	    Save_Pos()

	    GM(7)

	    if (#0=='@'){

		#0='x'				// Delete (eXcise)

		//

		// Remove any COBOL field name from .nam file.

		//

		if (#34){

		    File_Open("|(FILE_ONLY).nam",OK+NOMSG)

		    Search('|{|<",|,"}',REVERSE)

		    Del_Block(Cur_Pos,File_Size)

		    Buf_Switch(#92)

		}

		//

		// Remove any COBOL field name from _SQL_CRE.imp file.

		//

		if (#38){

		    Buf_Switch(#38)

		    Del_Line(-1)

		    Buf_Switch(#92)

		}

	    } else { if ( #0 != 'f' && #0 != '#' ){

		#0='e'

	    }}

	    if (#0=='#'){			// Date?

		Ins_Char('e')

	    } else {

		Ins_Char(#0)			// {e,f,x}

	    }

	    Ins_Char(' ')

	    Del_Char(2*#15)			// Delete spaces, perhaps

	    Restore_Pos()

	}}



	//

	// Set #81 = # digits/bytes before any decimal point.

	//

	if (Cur_Char(1)==0x28){			// CurChar + 1 == LParen?

	    if (#15) {				// if just preprocessing...

		Char(2)

		#81 = NumEval(SUPPRESS+ADVANCE)	// #81 = 'n'

		Char(1)				// Advance past RParen

	    } else {

		Del_Char(2)			// Delete "x(" or "9("

		#81 = NumEval(SUPPRESS)		// #81 = 'n'

		Del_Char(Chars_Matched+1)	// Delete "n)" ) for balance

	    }

	} else {

	    Match("[bcdfhxBCDFHX9]*",REGEXP+MAX+ADVANCE)

	    #81 = Chars_Matched			// #81 = 'n'

	    if (!#15) {				// if not just preprocessing

		Del_Char(-Chars_Matched)	// Delete all "X..." or "9..."

	    }

	}

	//

	// Finish converting to our "code +size [{v,.}n]" format.

	// Compute #3 = # digits past decimal point.

	//	   #8 = # digits, including before & after decimal point.

	//	   #9 = {'v' | '.'} ? 1 : 0.

	//	   EbcSettings(Inpoint) = '.' ? 1 : itself.

	//

	Save_Pos()

	GM(7)

	Ins_Char('+')

	Del_Char(1*#15)				// Delete spaces, perhaps

	Restore_Pos()

	#3 = #8 = #9 = 0			// No digits past decimal point, yet

	Ebc_Settings(In_Point,0)		// No explicit source decimal point, so far

	if (Match('|{v,.9}')==0) {		// Process '{v,.}9...' portion

	    #9 = 1				// Flag that 'v' or '.' encountered

	    if (CurChar=='.'){

		Ebc_Settings(InPoint,1)		// Flag that '.' encountered

	    }

	    if (#15) {				// if just preprocessing...

		Char(1)

	    } else {

		Del_Char(1)

	    }

	    if (Cur_Char(1)==0x28) {		// CurChar + 1 == LParen?

		if (#15) {			// if just preprocessing...

		    Char(2)

		    #3 = NumEval(SUPPRESS+ADVANCE)	// #3 = 'n'

		    Char(1)				// Advance past RParen

		} else {

		    Del_Char(2)			// Delete "9("

		    #3 = NumEval(SUPPRESS)	// #3 = 'n'

		    Del_Char(Chars_Matched+1)	// Delete "n)"

		}

	    } else {

		Match("9*",regexp+max)

		#3 = Chars_Matched		// #3 = # digits past "."

	    }

	}

	#8 = #81 + #3				// #8 = # digits

	//

	// Compute #6 = # bytes in data field or compute #36 = # digits and signs for NIBBLES.

	//

	GM(7)

	if ( #0=='b' || #0=='d' || #0=='l' || #0=='m' || #0=='n' ) {

	    if (#0=='b') {

		if (#8==1) {

		    #6 = 1

		} else {

		if (#8<5) {

		    #6 = 2

		} else { if (#8<10) {

		    #6 = 4

		} else {

		    #6 = 8

		}}}

	    } else { if (#0=='d') {

		#6 = ( #8 / 2 ) + 1

	    } else { if (#0=='n') {

		#6 = ( #8 / 2 ) + remainder

	    } else { if (#0=='l') {

		if (#2==1) {

		    #6 = 4			// short Float

		} else {

		    #6 = 8			// long Float (double precision)

		}

	    } else { // 'm'

		#6 = 0

	    }}}}

	} else { if ( #0 == 'y' ) {

	    #6 = #8 + 1				// Add sign back in for "+9" and "-9"

	} else {

	    #6 = #8				// One-to-one for 'c', 'e', 'f', & 'u'

	}}

	//

	//	Adjust for explicit decimal point in PIC clause.

	//

	#6 += EbcSettings(InPoint)

	//

	// Update record length.

	//

	if (#0=='m'){

	    #6 = #8+#4				// #6 = # 'm' digits plus any sign

	    #36 += #6

	} else {

	    #26 += #6				// Update record length

	}

	//

	// Insert field size.

	//

	#5 = Cur_Pos

	Num_Ins(#6,LEFT+NOCR)

	Del_Char((Cur_Pos-#5)*#15)		// Delete spaces, perhaps

	//

	// For binaries, include ",=ndigits;", perhaps.

	//	Enter: #3 = # digits past decimal point.

	//	       #8 = total # digits.

	//	       #4 = signed-number flag.

	//	       #9 = 'v' encountered flag.

	//

	if (#0=='b'){

	    #5 = Cur_Pos

	    if ( #8 != 2 && #8 != 4 && #8 != 8 && #8 != 18 ){

		Ins_Text(",=")

		Num_Ins(#8,LEFT+NOCR)

		Ins_Text(";")

	    }

	    Del_Char((Cur_Pos-#5)*#15)		// Delete spaces, perhaps

	}

	//

	// For Floats, Doubles and packed decimals with even # digits, include ",=n;"

	//

	if (#0=='l'||(#0=='d'&&!(#8&1))){

	    #5 = Cur_Pos

	    Ins_Text(",=")

	    Num_Ins(#8,LEFT+NOCR)

	    Ins_Text(";")

	    Del_Char((Cur_Pos-#5)*#15)		// Delete spaces, perhaps

	}

	//

	// For PNZ's with odd # digits, include ",=n;"

	//

	if (#0=='n' && (#8&1)){

	    #5 = Cur_Pos

	    Ins_Text(",=")

	    Num_Ins(#8,LEFT+NOCR)

	    Ins_Text(";")

	    Del_Char((Cur_Pos-#5)*#15)		// Delete spaces, perhaps

	}

	//

	// Include any "unsigned" option.

	//

	if ((#4==0)&&(#0=='b'||#0=='d'||#0=='l'||#0=='m')){

	    #5 = Cur_Pos

	    Ins_Text(" u")

	    Del_Char((Cur_Pos-#5)*#15)		// Delete spaces, perhaps

	}

	//

	// Explicit decimal point, perhaps.

	//

	if (#9>0 && (#64&4)) {			// Explicit decimal point

	    #5=Cur_Pos

	    if (EbcSettings(InPoint)){

		Ins_Text(" .")

	    } else {

		Ins_Text(" v")

	    }

	    Num_Ins(#3,LEFT+NOCR)

	    Del_Char((Cur_Pos-#5)*#15)		// Delete spaces, perhaps

	}

	if (!(#15)) {				// If fully processing...

	    Del_Block(Cur_Pos,EOL_Pos)		// Delete remainder of the line

	}

	Line(1)

	Set_Marker(8,Cur_Pos)

	//

	// Ensure code is generated at the statement beginning when commenting out.

	//

	Num_Push(0,0)

	if (#15) {

	    Line(-1)

	    Search("//")

	    #0 = Cur_Col

	    rcb(0,BOL_Pos,Cur_Pos,DELETE)

	    Ins_Char(' ',COUNT,#0-1)

	    EOL()

	    Search("//[\s\t]+[0-9]+[\s\t]+[A-Z0-9']",REVERSE+REGEXP)

	    Del_Block(BOL_Pos,Cur_Pos)

	    Reg_Ins(0)

	    if (#32){

		match("// ",ADVANCE)

		match("|B",count+advance,6)

		if (EOLPos-CurPos>RSIZE(1)){

		    Reg_Ins(1,OVERWRITE)

		} else {

		    Reg_Ins(1)

		}

		if (Match("|b")!=0){

		    InsChar(' ')

		}

	    }

	}

	//

	//	Append data type, length to _SQL_CRE.IMP, perhaps.

	//

	Num_Pop(0,0)

	if (#0!='x'){

	    call("RedoSQL")

	}

	GM(8)

    }

    Num_Pop(2,9)

    //

    // Comment out or delete anything upto Marker(9).

    //

    if (#15) {

	while ( Cur_Pos < Marker(9) ) {

	    Ins_Indent(#29)

	    InsText("// ")

	    line(1)

	}

    } else {

	Del_Block(Marker(8),Marker(9))

    }

    return

//

// XREF - Create entry in .xrf file if specified.

//	  Enter: Marker(5)-> BOS

//		 Marker(6)-> past "." at EOS

//		 #21 > 0 ? create entry in Buf_Num(#21).

//		 #27 = detail record type counter.

//

// Each entry in the file consists of 12 blank spaces, a generated

// short name, blank spaces upto column 30 and the COBOL copybook

// name for the current field. If the current record is a detail

// record, "Zn" is prepended to the record name, where 'n' is {1,2,...}.

// (There may be upto 40 detail record types per main record type).

//

// The short name is of the form rn where 'r'= {A,B,...} is the

// record name and 'n' = {1,2,...} is the field number.

//

// The initial 12 spaces can be used later to create a nickname.

// Column 29 could be used to indicate that the field is being

// deleted from the translated data.

//

:XREF:

if (!#21){return}

    call("COBNAM")		// Copy COBOL field name into T-Reg[0]

    Buf_Switch(#21)

    Ins_Char(' ',COUNT,12)

    #23++

    #4 = Cur_Pos

    Ins_Char(#25)

    Num_Ins(#23,LEFT+NOCR)

    #5 = Cur_Pos

    ii(30)

    Reg_Ins(0)

    rcb(1,#4,#5)

    Ins_Newline()

    Buf_Switch(#92)

    return

// XREF ends



//

// NameIt - Append quoted-and-comma-delimited COBOL field name to .nam, if specified.

//	    Enter: #34 ? doit : return

//		   Marker(5) at BOS

//		   Marker(6) at EOS

//

:NameIt:

    if (#34){

	call("COBNAM")		// T-Reg[0] = COBOL field name

	File_Open("|(FILE_ONLY).nam",OK+NOMSG)

	If (!At_BOL){

	    Ins_Char(',')

	}

	Ins_Char('"')

	Reg_Ins(0)

	Ins_Char('"')

	Buf_Switch(#92)

    }

    return

// NameIt ends



//

// DoSQL - Append COBOL field name to _SQL_CRE.imp, if specified.

//         Replace all '-' with '_'.

//	   Enter: #38 ? doit : return

//		  Marker(5) at BOS.

//		  Marker(6) at EOS.

//

:DoSQL:

if (#38){

    call("COBNAM")		// T-Reg[0] = COBOL field name

    Buf_Switch(#38)

    Reg_Ins(0)

    Ins_Newline(1)

    L(-1)

    Replace("-","_",ALL|NOERR)

    L(1,NOERR)

    Buf_Switch(#92)

}

return

// DoSQL ends



//

// RedoSQL - Append data type, length to _SQL_CRE.imp, if specified.

//	     Enter: #38 ? doit : return.

//                  #38 = Buffer_ID for ..._SQL_CRE.IMP.

//

//		     #0 = Greenview field code or '#'.

//		     #0 == '#' ? SQL type -> DATETIME (MS SQL).

//

//		     #2 = current COMP level (0=none,1-6,0xFF=default)

//		     #3 = # digits past decimal point

//		     #4 = signed # flag

//		     #5 = temporary

//		     #6 = # bytes in data field

//		     #7 = Adjusted COMP level (0,1-6,7) where '7' implies streaming nibbles

//		     #8 = # digits = #81 + #3.

//		     #9 = flag that '{v,.}[n]' encountered.

//

//		    Marker(5) at BOS.

//		    Marker(6) at EOS.

//

// Note: Originally programmed for MySQL (AB); changed to work with

//       MS DTS SQL Server. (I know nothing! SGT Shultz).

//

:RedoSQL:

if (#38){

    Buf_Switch(#38)

    Char(-Newline_Chars)

    Ins_Indent(15)

    if (cc(-1)!=' '){

	Ins_Char(' ')

    }

    //

    //	Text

    //

    if (#0=='e'||#0=='f'){

	Ins_Text("CHAR")

	Ins_Char(0x28)				// Left Paren

	Num_Ins(#8,LEFT|NOCR)

	Ins_Char(0x29)				// Right Paren



    //

    //	Date

    //

    } else { if (#0=='#'){

//	Ins_Text("DATE")

	Ins_Text("DATETIME")



    //

    //	Custom Date

    //

    } else { if (#0=='c'){

//	Ins_Text("DATE")

	Ins_Text("DATETIME")



	

    //

    //  Numeric.

    //

    } else {

	//

	//	Fixed Decimal Point (text).

	//

	if (#9) {

	    Ins_Text("DECIMAL")

	    Ins_Char(0x28)			// Left Paren

	    Num_Ins(#8,LEFT|NOCR)

	    Ins_Char(',')

	    Num_Ins(#3,LEFT|NOCR)

	    Ins_Char(0x29)			// Right Paren

	//

	//	TINYINT (8 bits).

	//

	} else { if (#8<3) {

	    Ins_Text("TINYINT")

	//

	//	SMALLINT (16 bits).

	//

	} else { if (#8<5) {

	    Ins_Text("SMALLINT")

	//

	//	MEDIUMINT (24 bits).

	//	Now, same as INT.

	//

	}…

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