/macros/cobol2v.vdm

// 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.

	//

	} else { if (#8<7) {

//	    Ins_Text("MEDIUMINT")

	    Ins_Text("INT")

	//

	//	INT (32 bits).

	//

	} else { if (#8<10) {

	    Ins_Text("INT")

	//

	//	BIGINT (64 bits).

	//

	} else {

	    Ins_Text("BIGINT")

	}}}}

//	Ins_Char(0x28)				// Left Paren

//	Num_Ins(#8,LEFT|NOCR)

	}

//	Ins_Char(0x29)				// Right Paren

	if (!#4){				// Unsigned?

//	    Ins_Text(" UNSIGNED")

	}

    }}}

    Ins_Char(',')

    L(1,NOERR)

    Buf_Switch(#92)

}

return

// RedoSQL ends



//

// COBNAM - Copy COBOL field name into T-Reg[0].

//	    Enter: Marker(5)-> BOS.

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

//

:COBNAM:

    GM(5)

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

//  sb("\@(#65+14)",cp,Marker(6),#10,1,#1)	// Start of field-name

// ****** above doesn't work (but should) ************

    sb("^...... [\s\t]*[0-9]+[\s\t]+",cp,Marker(6),#10,1,#1)

    #4 = Cur_Pos

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

    rcb(0,#4,Cur_Pos)

    return

// COBNAM ends



`) // T-Reg[56] - Generating "type cb,ce"



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

//

//	Main Macro.

//

// { Main begins

//

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

//

#21 = #22 = #23 = #24 = #26 = #27 = #36 = 0

#25 = 'A'

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

#92 = Buf_Num

//

//	Replace tabs with spaces.

//

Dtab(0,File_Size)

//

//	Strip any <Ctrl-Z>'s and other junk at end of file.

//	Ensure file ends in <cr><lf>.

//

EoF()

do {				// Keep...

    char(-1)			// Backing up...

} while (Match("|k")==0)	// Over low values (except newlines)

Char(1)				// Keep the good stuff

Del_Char(ALL)			// Delete all the junk

if (cc(-1)!=0x0A){Ins_Newline()} // Insert missing newline char(s)

BoF()

//    

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

    #22 = 1		// Set flag

    #64 = 0x202		// Comment out - don't strip - COBOL copybook

    Call("SIGNON")

    Reg_Set(99,"Preprocessing...")

    call("MESSAGE")

    call("OPTIONZ")	// Setup cross reference file if -u DBASE option

}

//

// Regular Expression Search strings for REDEFINES & OCCURS submacros.

//

Reg_Set(#65+10,"[\s\t]*[0-9]+")			// Regexp from BOL thru clause level

Reg_Set(#65+11,"^...... ")			// Regexp for start of COBOL line

Reg_Set(#65+12,"^......[\s\t]+")		// Regexp from BOL to BOCL

Reg_Set(#65+13,"\@(#65+11)\@(#65+10)")		// Regexp from BOL to EOCL

Reg_Set(#65+14,"\@(#65+11)\@(#65+10)[\s\t]+")	// Regexp from BOL to BOCN



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

//									    //

//  Remove spaces from any {c=,p=,q=} lines.				    //

//									    //

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



Replace("^\s*{[cpq]}\s*=\s*","\1=",BEGIN+ALL+NOERR+REGEXP+MAX)



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

//									    //

//		M a i n	   P r o c e s s i n g	  L o o p		    //

//									    //

//	For each copybook section (upto next "c=0" when stand-alone) or	    //

//	between "p=" and "q="...					    //

//									    //

//	    Set Maker(8)-> p=; delete p=.				    //

//	    Set Marker(9)->q=; delete q=.				    //

//	    Set #1 = 73 for adjusted rightmost valid column # (see below).  //

//		Delete embedded blank lines and GreenView comment lines.    //

//		Insert blank columns after col 7 and #1; facilitates inter- //

//		pretation.						    //

//	    Propagate un-PIC'd COMPs over entire paragraph.		    //

//	    Comment out all REDEFINES paragraphs via T-Reg[17].		    //

//	    Process OCCURS clauses via T-Reg[16].			    //

//	    Generate .LAY descriptions via T-Reg[56]; also generate	    //

//	    .XRF line if DBASE option specified.			    //

//									    //

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

//

Begin_Of_File()

RegSet(99,"

Main Processing...")

Call("MESSAGE")

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

if (Search("DECIMAL-POINT|WIS|WCOMMA",NOERR)){

    Begin_Of_File()

    Ins_Text("COMDOT")

    Ins_Newline(1)

}

Set_Marker(8,Cur_Pos)

Set_Marker(9,Cur_Pos)



repeat ( all ) {

    Call(55)		// Set block markers Marker[8],Marker[9]

			// Generate "l=reclen" for previous record

			// Generate tx "R.ASC" or '"R.dbf",R' lines for c=0,R

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

			// Delete "c=0[,R]" line

    if (Marker(9)-Marker(8)==0){

	if (Marker(8)==File_Size){

	    break

	} else {

	    continue

	}

    }

    RegSet(99,"

    Preprocessing...")

    Call("MESSAGE")

    //

    // Delete any blank lines or Vedit comment lines within the COBOL block.

    //

    GM(8)

    rb("|<|[|w]|L","",Marker(8),Marker(9),ALL+NOERR)

    GM(8)

    rb("|<|[|w]//|Y|L","",Marker(8),Marker(9),ALL+NOERR)

    //

    //

    // Blank columns 1-6.

    //

    GM(8)

    rb("|<|?|?|?|?|?|?","      ",Marker(8),Marker(9),ALL+NOERR)

    //

    // Insert blank column after cols 7 and #1.

    // (Helps recognize keywords).

    //

    #1 = 73			// #1 = Last usable data column + 1

    GM(8)

    Block_Fill(' ',cp,Marker(9)-1,INSERT+COLSET,#1,#1)

    Block_Fill(' ',cp,Marker(9)-1,INSERT+COLSET,8,8) // #1 is now last usable data col



    //

    //	Propagate COMP's over entire paragraph when no accompanying PIC.

    //

    call("FIXCOMP")

    //

    // Comment out REDEFINES statements/paragraphs.

    //

    RegSet(99,"

    REDEFINES...")

    Call("MESSAGE")

    Set_Marker(1,CLEAR)

    Set_Marker(2,CLEAR)

    #4 = Marker(8)

    call(#65+17)

    Set_Marker(8,#4)

    //

    //	Process OCCURS clauses.

    //

    RegSet(99,"

    OCCURS...")

    Call("MESSAGE")

    Set_Marker(1,CLEAR)

    Set_Marker(2,CLEAR)

    call(#65+16)

    //

    // Code generation and cross referencing loop:

    // Search for next " PIC " or "|<rx" occurrence where 'x'={b,c,e}.

    // Normally delete from Marker(8) through " PIC ".

    // If "#64&2" (stop after preprocessing COBOL statements), comment out

    // each line upto the " PIC " line.

    //

    RegSet(99,"

    Code generation...")

    Call("MESSAGE")

    GM(8)

    #64 |= 4		// Set explicit decimal point flag

    while(sb("|<r|{b,c,e}",cp,Marker(9),NOERR)) {

	#0 = Cur_Pos

	GM(9)

	Save_Pos()

	GP(#0)

	Set_Marker(9,Cur_Pos)

	GM(8)

	call(56)		// Code generator: "code +len [{v,.}n]"

				// Also add field name to .xrf if #21

	Line(1,NOERR)

	Set_Marker(8,Cur_Pos)

	Restore_Pos()

	Set_Marker(9,Cur_Pos)

	GM(8)

    }

    call(56)			// Code generator for last field



} // Main conversion (loop for each p= & q= section)



RegSet(99,"

Post processing...")

Call("MESSAGE")

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

call(55,"RECLEN")		// Generate "l=reclen" for final record type

call("FIXRC")			// Set data type and length into any "rc #n"

if (#21>0){

    call("DETAIL")		// Append "Zn" to "short" names for detail records

    call("FIXBIG")		// Break up any record types having more

				// than 250 fields

    call("FIXREF")		// Convert short names to 'Fn' format

}

Buf_Switch(#92)



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

//

//	Post Processing - Run RELAY.VDM, perhaps.

//

//	When just COBOL preprocessing and not prohibited by the "-u NORELAY" option,

//	run RELAY.VDM to convert "+len,=outsize;" format to begin-/end-column format

//	and insert the field's output starting column # into the comment field:

//

//	      "bc,ec[,=outsize;]  // output_column_# ..."

//

//	   Uses Num_Regs 1 - 8:

//		#0 = temporary

//		#1 = initial code letter

//		#2 = begin_col

//		#3 = end_col

//		#4 = input field size = #3 - #2 + 1

//		#5 = output field size if specified, else 0.

//		#6 = output inflation

//		#7 = 1 when code_letters = "rf".

//		#8-> past code_letter[s]-space

//		#9 = # input_cols to be replaced by new format

//		#10 = "qcd" flag

//		#11 = Length of delimiting string (T-Reg[17]) output after

//		      each explicitly specified field.

//		#30 = NORELAY flag

//

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

//

if ((#64 & 2) && (#30==0)) {

    RegSet(99,"

    Running RELAY.VDM...")

    Call("MESSAGE")

    Reg_Empty(55)

    callf(55,"relay")

} // Converting "+len" to "bc,ec" and generating "ascii output col" after "//"



//

//	Termination.

//

Reg_Empty(0)

Reg_Empty(1)

Reg_Empty(2)

Reg_Empty(55)

Reg_Empty(56)

if (#22>0 && !IsQuiet){

    Reg_Empty(99)

}



BOF

Reg_Pop(#65+10,#65+18)



Num_Pop(105,105)

Num_Pop(99,99)

Num_Pop(90,92)

Num_Pop(75,76)

Num_Pop(64,66)

Num_Pop(6,8)



if (#22&&Is_Option(y)){

    XALL

}

return



// } Main ends



//

// FIXRC - Insert data type and length from next line into any "rc #n".

//{

:FIXRC:

bof

while(search("|<rc",ADVANCE+NOERR)) {

    Save_Pos()

    s("|<|Y+|M|b",ADVANCE)

    rcb(0,bolpos,cp-1)

    Restore_Pos()

    ri(0)

}

return



// FIXRC ends}



//

// FIXCOMP - Propagate COMP's over entire paragraph when no accompanying PIC.

//		#3 = pos past COMP.

//		#4 = pos of " COMP".

//		Marker(5) = BOSpos

//		Marker(6) = pos past "." in current statement.

//{

:FIXCOMP:

GM(8)

while (search_block(" COMP|[UTATIONAL]|[-|d]|{|b,.}",cp,Marker(9),advance+noerr)) {

    if ( cc( BOL_Pos - Cur_Pos + 6 ) != ' ' ) {continue}

    #4 = Cur_Pos - 1

    #3 = Cur_Pos - Chars_Matched

    //

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

    //

    bol

    #10 = COLSET+REGEXP+MAX+ADVANCE

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

    Set_Marker(6,Cur_Pos)

    //

    // Goto BOS and set Marker(5).

    //

    GP(#3)

    #10 = COLSET+REGEXP+MAX+REVERSE

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

    SM(5,cp)

    //

    // Next case, if any PIC clause.

    //

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

    if (sb("\@(#65+11).* {PICTURE|PIC} ",Cur_Pos,Marker(6),#10,1,#1)) {

	GM(6)

	continue

    }

    //

    // No PIC; get paragraph level.

    //

    GP( Marker( 5 ) + 7 )

    #0 = Num_Eval( SUPPRESS )

    //

    // Set Marker(2) to end of paragraph.

    //

    Line(1,errbreak)

    call(#65+15)			// NEXT_PEER_FIELD

    SM(2,cp-1)

    //

    // Move the COMP expression into T-Reg[0].

    //

    GP(#3)

    rcb(0,cp,#4,DELETE)

    //

    // Remove the COMP expression from the header paragraph statement.

    //

    Replace("|*|>")

    BoL()

    rb("|[|w]|>",".",cp,#3,NOERR)

    //

    // Propagate the COMP expression over each statement.

    //

    GM(6)

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

    l(1,errbreak)

    while( cp < Marker( 2 )) {

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

	r("|[|W].","",REVERSE)

	#5 = curpos-bolpos-RSIZE(0)-1

	if ( #1 - cn - 1 < RSIZE(0) + 2) {

	    Ins_Char(' ',COUNT,CMAT)

	    l(1,NOERR)

	    Ins_Text(' ',COUNT,#5)

	    ri(0)

	    Ins_Char('.')

	    Ins_Newline()

	} else {

	    ri(0,OVERWRITE)

	    Ins_Char('.',OVERWRITE)

	    l(1,errbreak)	// Note: must occur before "while( expression )"

	}

    }

} // Propagatating unPIC'd COMPs.



return

// FIXCOMP ends}



//

// FIXBIG - Break up any record types having more than 250 fields

//	    when outputting to DBASE-III file. Also, edit

//	    cross reference "short" names to rsn format, where 's'

//	    is the section name {A,B,...}.

//	    Enter: #21 = BufID of cross reference file.

//		   #92 = BufID of copybook/lay file.

//{

:FIXBIG:

    Buf_Switch(#92)

    BOF()

    Buf_Switch(#21)

    Replace("|<|[|w]|L","",BEGIN+ALL+NOERR)

    BOF()

    DetabBlock(0,File_Size,RESET)

    rcb(0,12,13)

    rcb(1,12,13)

    #1 = 1

    repeat(all){

	SearchBlock("|<|?|?|?|?|?|?|?|?|?|?|?|?|!|{|@(1)}",0,File_Size,NOERR+NORESTORE)

	call("SECTION")

	if (At_EOF){

	    break

	}

	#1 = Cur_Line

	Goto_Col(13)

	if(Match("Z|d|[|d]",ADVANCE)==0){

	    rcb(0,CurPos-Chars_Matched,CurPos+1)

	    rs(1,@0)

	} else {

	    rcb(0,CurPos,CurPos+1)

	    rcb(1,CurPos,CurPos+1)

	}

	BOL()

    }

    return

// FIXBIG ends}



//

// FIXREF -

//{

:FIXREF:

    if (#32) {			// Don't bother unless names are going into the .lay file

	#3=Buf_Num

	Buf_Switch(#92)

	BOF()

	if (Search("|<|{t,r}",NOERR)==0){

	    Replace("{//[\s\t]+}A","\1F",REGEXP+ALL+NOERR)

	}

	BOF()

    }

    Buf_Switch(#3)

    return

// FIXREF ends}



//

// DETAIL - Append "Zn" to short names in cross reference file.

//	    Resequence the field numbers from 1.

//	    Move the section to the end of the primary record.

//	    Enter: #92 = ID of .lay file

//		   #21 = ID of cross reference file

//{

:DETAIL:

Buf_Switch(#21)

Detab_Block(0,File_Size)

Buf_Switch(#92)

BOF()

while( Search("|<|rb|w#|m|w|s",ADVANCE+NOERR )){

    //

    //	Setup T-Reg[1] = Znr where 'n' is the detail record number

    //			 and 'r' is the base record name.

    //

    #0 = CurPos

    Search(".")

    rcb(1,#0,CurPos)		// R[1] = ZnR

    //

    //	Setup T-Reg[0] with base record name.

    //

    #0 = CurPos

    Search("|d",REVERSE+ADVANCE)

    rcb(0,cp,#0)		// R[0] = 'r' = base record name

    //

    //	Setup T-Reg[2] with first detail COBOL field name.

    //

    Search("|<|a +",ADVANCE+NOERR) // First .lay code

    if (#32) {

	Search("[0-9]*[A-Za-z][0-9A-Za-z]+\s+[0-9]+\s+[A-Z0-9-]+",ADVANCE+REGEXP) // "// sname n COBOL-copy-book-name"

	#0 = CurPos

	Search("|b",REVERSE+ADVANCE)

    } else {

	Search("[0-9]\s+[A-Z0-9-]+",REGEXP) // "n COBOL-copy-book-name"

	#0 = CurPos+CharsMatched

	Search("|A")		// "COBOL-copy-book-name"

    }

    rcb(2,CurPos,#0)		// R[2] = first detail field name

    //

    //	Setup T-Reg[3] = final detail COBOL field name.

    //

    Search("|<re|s")

    SetMarker(0,CurPos)

    Search("|<|a +",REVERSE+ADVANCE)

    if (#32) {

	Search("[0-9]*[A-Za-z][0-9A-Za-z]+\s+[0-9]+\s+[A-Z0-9-]+",ADVANCE+REGEXP) // "// sname n COBOL-copy-book-name"

	#0 = CurPos

	Search("|b",REVERSE+ADVANCE)

    } else {

	Search("[0-9]\s+[A-Z0-9-]+",REGEXP) // "n COBOL-copy-book-name"

	#0 = CurPos+CharsMatched

	Search("|A")		// "COBOL-copy-book-name"

    }

    rcb(3,CurPos,#0)		// R[3] = final detail field name

    //

    //	Advance past "re" line

    //

    GM(0)

    Line(1)

    //

    //	Cross Reference Editing - Find start of base record

    //

    Buf_Switch(#21)

    BOF()

    SearchBlock(@0,CurPos,File_Size,COLSET,13,13)

    Set_Marker(8,BOL_Pos)

    //

    //				- Find end record

    //

    SearchBlock(@0,CurPos,File_Size,ALL+COLSET,13,13)

    Line(1)

    SetMarker(9,CurPos)

    //

    //				- Find start of detail record

    //

    GM(8)

    #0 = 30+RSize(2)-1

    SearchBlock(@2,CurPos,Marker(9),COLSET,30,#0)

    SetMarker(6,BOL_Pos)

    //

    //				- Find end of detail record

    //

    #0 = 30+RSize(3)-1

    SearchBlock(@3,CurPos,Marker(9),COLSET,30,#0)

    SetMarker(7,EOL_Pos)

    //

    //				- Convert all Rsm to ZnRsm

    //

    GM(6)

    if (RegSize(1)>3){

	rb("[A-Z]{[A-Z]*[0-9]+}\s\s\s","\@(1)\1",Cur_Pos,Marker(7),ALL+REGEXP+COLSET,13,29)

    } else {

	rb("[A-Z]{[A-Z]*[0-9]+}\s\s","\@(1)\1",Cur_Pos,Marker(7),ALL+REGEXP+COLSET,13,29)

    }

    //

    //				- Resequence from 1

    //

    GM(6)

    #0 = 1

    while(CurPos<Marker(7)){

	char(12)

	Match("Z|d|[|d]|A|[|a]",ADVANCE)

	SavePos()

	ReplaceBlock("|d"," ",CurPos,CurPos+12,ALL)

	RestorePos()

	ITOA(#0++,0,LEFT+NOCR)

	Reg_Ins(0,OVERWRITE)

	Line(1)

    }

    //

    //				- Move detail record to end of base record

    //

    rcb(0,Marker(6),CurPos,DELETE)

    GM(9)

    Reg_Ins(0)

    Buf_Switch(#92)

}

return

// DETAIL ends}



//

// SECTION - Generate 'out "name.dbf",name' ... 'out' brackets around

//	     each section of 250 fields if current record has

//	     more than 250 fields; also, edit cross reference

//	     "short" name to 'rsn' format, where 's' is the

//	     section name {A,B,...}.

//	     Enter: #92 = bufID of .lay file

//		    #21 = bufID of cross reference file with

//		     #1 = record's starting line number and

//		 CurPos = start of next record in buffer(#21)

//		   R[0] = current record filename

//		   R[1] = current record short name prefix

//{

:SECTION:

    Buf_Switch(#92)

    if (Reg_Size(0)>1){

	Search('"|@(0).dbf"',NOERR)

	Line()

    } else {

	if (Search('"|@(0).dbf"|Ml=',NOERR+ADVANCE)) {

	    Line()

	} else {

	    while (Search("|<|v|b")){

		if (cc!='t'){

		    break

		}

		Line()

	    }

	}

    }

    Buf_Switch(#21)

    #2 = CurLine

    #3 = 0		// Section counter

    Goto_Line(#1)

    while(Cur_Line+250<#2){

	Line(250)

	//

	// Back up to beginning of any OCCURS section.

	//

	repeat (ALL) {

	    line(-1)

	    Search("|[|h29|[|w]]|>")

	    if ( CharsMatched == 0 ) { break }

	}

	//

	BOL()

	RegCopyBlock(3,cp+30-1,EOL_Pos) // R[3] = copybook field name

	Out_Reg(2)

	Type_Char(#3+'A')		// R[2] = section name

	Out_Reg(CLEAR)

	#3++

	ReplaceBlock("{[0-9]+}\s","\@(2)\1",#1,Cur_Line,BEGIN+ALL+LINESET+COLSET+REGEXP,13,18)

	Line()

	#1 = Cur_Line

	//

	// Generate 'out "R.dbf,R"'

	//

	Buf_Switch(#92)

	Ins_Text('out "')

	Reg_Ins(0)

	Reg_Ins(2)

	Ins_Text('.dbf",')

	Reg_Ins(0)

	Reg_Ins(2)

	Ins_Newline()

	//

	// Find end of block and generate "out".

	//

	Search("|b|@(3)|{|b,.,|>}")

	Line()

	Ins_Text("out")

	Ins_Newline()

	//

	Buf_Switch(#21)

    }

    if (#3 > 0 && Cur_Line < #2 ) {

	Out_Reg(2)

	Type_Char(#3+'A')		// R[2] = section name

	Out_Reg(CLEAR)

	ReplaceBlock("{[0-9]+}\s","\@(2)\1",Cur_Line,#2-1,ALL+LINESET+COLSET+REGEXP,13,18)

	BOL()

	RegCopyBlock(3,cp+30-1,EOL_Pos) // R[3] = copybook field name

	Line()



	Buf_Switch(#92)

	Ins_Text('out "')

	Reg_Ins(0)

	Ins_Char(#3+'A')

	Ins_Text('.dbf",')

	Reg_Ins(0)

	Ins_Char(#3+'A')

	Ins_Newline()

//

// *********** complications if OCCURS DEPENDING ON is followed by anything

//	       other than more OCCURS DEPENDING ON clauses...**************

//

	Search("|b|@(3)|{|b,.,|>}")

	Line()

	Ins_Text("out")

	Ins_Newline()



	if (Search("|<tx",NOERR)==0){

	    EOF()

	}

    }

    Buf_Switch(#21)

    GotoLine(#2)

    return

// SECTION ends}



//

// SIGNON - when running stand alone

//

:SIGNON:

//

//	Sign on.

//

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('*                COBOL2V.VDM    07/26/2007              *\n');TS(#0)

Message('*    Convert COBOL copybook text into .lay data layout  *\n');TS(#0)

Message('*********************************************************\n');TN()

}

return

// SIGNON ends



//

// MESSAGE - Display T-Reg[99] on console if running stand alone

//	     and not "quiet".

//

:MESSAGE:

if (#22>0 && !IsQuiet){

    WinHor(0)

    RegType(99)

    WinEOL()

}

return

// MESSAGE ends



//

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

//

:ENDNAME:

if (#34){

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

    if (!At_BoL){

	Ins_Newline()

    }

    Buf_Switch(#92)

}

return

// ENDNAME ends



//

// OPTIONZ - "-u option_list" where items in "option_list" are blank separated.

//

//	Option_List:

//	    CC=col_num to set starting column number for comment field (default = 20).

//	    COMP=level, level=1,6; default=4 (Big Endian (IBM) binary).

//

//	    DBASE (when stand alone) to generate .XRF file, et al.

//	    DOS (default) | UNIX | MAC for r=reclen,ftype {0,1,2}.

//	    NORELAY to not run RELAY.VDM even in stand-alone mode.

//	    ISHORT to generate short names in the main output comment field;

//		   requires DBASE.

//	    NAMES to output COBOL field names into .nam file.

//	    NIBBLES to propogate BCD or hex digits as a stream across byte

//		   boundaries. I.e., to start, the sign or MSN is packed into

//		   the upper nibble of a byte, followed by the remaining digits,

//		   streamwise; the next packed field will be packed contiguous

//		   with the end of the current field, even if that means packing

//		   the MSN into the lower nibble of an unfilled byte!

//	    PNZ to treat "COMP" as PNZ. (Archaic; use comp=6).

//

//

//	    If dBASE, create/open .xrf file, deleting any existing contents.

//

//	    Enter: Buf_Num = #92 = .LAY buffer ID.

//	    Retrn: #21 = ID of opened .XRF file.

//		   #28 = {DOS|UNIX|MAC|DBASE} ? {0,1,2,3} : 0.

//		   #29 = Starting comment column (default = 20).

//		   #30 = NORELAY ? 1 : 0.

//		   #32 = DBASE && ISHORT ? 1 : 0.

//		   #34 = NAMES ? 1 : 0.

//		   #35 = NIBBLES ? 1 : 0.

//		   #37 = default COMP level (1-6).

//		   #38 = SQL output flag.

//

:OPTIONZ:

    #4 = #28 = #30 = #32 = #34 = #35 = #38 = 0

    #29 = 20

    #37 = 4				// Default COMP is Big Endian binary

    if (vn>=530) {

	Buf_Switch(Buf_Free(EXTRA))

	Ins_Text(CMD_LINE)

	EOF()

	Ins_Char(' ')

	//

	// -u

	//

	if (Replace("|<|M-u|[|b]"," ",BEGIN+NOERR)) {

	    #4 = Buf_Num

	    //

	    // DOS or UNIX or MAC

	    //

	    if (Replace("|b|{DOS,UNIX,MAC}|b"," ",BEGIN+NOERR)){

		#28 = Match_Item - 1

	    }

	    //

	    // NORELAY

	    //

	    if (Replace("|bNORELAY|b"," ",BEGIN+NOERR)){

		#30 = 1

	    }

	    //

	    // DBASE

	    //

	    if (Replace("|bDBASE|b"," ",BEGIN+NOERR)) {

		#28 = 3

	    }

	    //

	    // SQL

	    //

	    if (Replace("|bSQL|b"," ",BEGIN+NOERR)) {

		#38 = 1

	    }

	    //

	    // ISHORT

	    //

	    if (Replace("|bISHORT|b"," ",BEGIN+NOERR)){

		#32 = 1

	    }

	    //

	    // NAMES

	    //

	    if (Replace("|bNAMES|b"," ",BEGIN+NOERR)){

		#34 = 1

	    }

	    //

	    // NIBBLES

	    //

	    if (Replace("|bNIBBLES|b"," ",BEGIN+NOERR)){

		#35 = 1

	    }

	    //

	    // PNZ  (Archaic; use "comp=6")

	    //

	    if (Replace("|bPNZ|b"," ",BEGIN+NOERR)){

		#37 = 6

	    }

	    //

	    // cc=col_num

	    //

	    if (Replace("|bcc|[|w]="," ",BEGIN+NOERR)){

		#3 = Cur_Pos

		#29 = Num_Eval(ADVANCE)

		DelBlock(#3,CurPos)

		if (#29 > 35) {#29 = 35}

		if (#29 < 10) {#29 = 10}

	    }

	    //

	    // COMP=level, 1-6

	    //

	    if (Replace("|bcomp|[|w]="," ",BEGIN+NOERR)){

		#3 = Cur_Pos

		#37 = Num_Eval(ADVANCE)

		DelBlock(#3,CurPos)

		if (#37 < 1) {#37 = 4}

		if (#37 > 6) {#37 = 4}

	    }

	}

	Buf_Quit(OK+NOMSG)

	Buf_Switch(#92)

    } else { if (Is_Option(n)) {

	#28 = 3

    }}

    //

    // Create or open and empty fname.XRF if DBASE.

    //

    if (#28 == 3 ){

	//

	// Set T-Reg[0] = "fname.XRF".

	//

	Reg_Set(0,PATH_NAME)

	Buf_Switch(Buf_Free(EXTRA))

	Reg_Ins(0)

	if (Search(".",BEGIN+ALL+ADVANCE+NOERR)){

	    char(-1)

	    Del_Char(ALL)

	} else {

	    EOF()

	}

	Ins_Text(".xrf")

	rc(0,0,REVERSE+DELETE)

	Buf_Quit(OK)

	//

	//

	//

	Buf_Switch(#92)

	File_Open(@0,OK+NOMSG)

	db(0,File_Size)

	#21 = Buf_Num

	Buf_Switch(#92)

    }

    //

    // Create or open and empty fname_SQL_CRE.IMP if DBASE.

    //

    if ( #38 ){

	//

	// Set T-Reg[0] = "fname_SQL_CRE.IMP".

	//

	Reg_Set(0,PATH_NAME)

	Buf_Switch(Buf_Free(EXTRA))

	Reg_Ins(0)

	if (Search(".",BEGIN+ALL+ADVANCE+NOERR)){

	    char(-1)

	    Del_Char(ALL)

	} else {

	    EOF()

	}

	Ins_Text("_SQL_CRE.IMP")

	rc(0,0,REVERSE+DELETE)

	Buf_Quit(OK)

	//

	//

	//

	Buf_Switch(#92)

	File_Open(@0,OK+NOMSG)

	db(0,File_Size)

	#38 = Buf_Num

	Buf_Switch(#92)

    }

    //

    // Reset #32 (ISHORT) if !DBASE.

    //

    if (#28!=3){

	#32=0

    }

    //

    // Create or open and empty fname.nam if NAMES.

    // Set DOS filetype.

    //

    if (#34){

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

	db(0,File_Size)

	Config(F_F_TYPE,0,LOCAL)

	Buf_Switch(#92)

    }

    //

    return



// OPTIONZ ends