Google
 

Trailing-Edge - PDP-10 Archives - LCG_Integration_Tools_Clearinghouse_T20_v7_30Apr86 - tools/conbat/vag004.cbl
There are 5 other files named vag004.cbl in the archive. Click here to see a list.
IDENTIFICATION DIVISION.
*=======================
 
Program-Id.	VAG004.
 
Author.	KATHY MCKENDRY
 
Date-Written.	15-Jan-85.
 
Date-Compiled.
 
Installation.	PAPER FREE SYSTEMS INC.
*-------------
*Program Title:
*-------------
*
*	System: VAXCON	DEC to VAX Conversion System
*	Module: VAG004	Command File Generator
*
*
*-------------------
*Program Description:
*-------------------
*
*	VAG004 converts DEC-10/20 control files (.CTL's) to VAX-11
*	command files (.COM's) using a user-modifiable table of conver-
*	sion factors and a file of skeleton .COM commands.
*
*----------------------------
*Program Modification History:
*----------------------------
*	--Date--   Who	What
*
*----------------------------------------------------------------------
ENVIRONMENT DIVISION.
*====================

CONFIGURATION SECTION.
*---------------------

SOURCE-COMPUTER.	DECSYSTEM-10.
OBJECT-COMPUTER.	DECSYSTEM-10.


INPUT-OUTPUT SECTION.
*--------------------

FILE-CONTROL.

select			CONTROL-FILE
	assign to	DSK
	file status is	CT-FS-STATUS
			CT-FS-ERROR-NO
			CT-FS-ACTION-CODE
			CT-FS-FILE-SPEC
			CT-FS-BLOCK-NO
			CT-FS-RECORD-NO
			CT-FS-FILE-NAME
			CT-FS-TABLE-POINTER
	recording mode	ASCII.

Select			COM-TABLE-FILE
	assign to	DSK
	recording mode	ASCII.

Select			STR-TABLE-FILE
	assign to	DSK
	recording mode	ASCII.

Select			DIR-TABLE-FILE
	assign to	DSK
	recording mode	ASCII.

Select			SKELETON-FILE
	assign to	DSK
	recording mode	ASCII.

select			COMMAND-FILE
	assign to 	DSK
	recording mode	ASCII.

DATA DIVISION.
*=============

FILE SECTION.
*------------

fd			CONTROL-FILE
	value of id	CONTROL-FILE-ID.

01	CONTROL-RECORD		display-7
				PIC X(105).

01	CONTROL-WORK-REC	display-7.
	02  CONTROL-WORK	pic  X(001)	occurs 105.

01	CONTROL-STASH-RECORD	DISPLAY-7.
	02  CTL-STASH-REC	PIC X(102).
	02  FILLER		PIC X(003).

fd			COM-TABLE-FILE
	value of id	COM-TABLE-FILE-ID.
 
01	COM-TABLE-RECORD		PIC  X(81).
 
fd			STR-TABLE-FILE
	value of id	STR-TABLE-FILE-ID.
 
01	STR-TABLE-RECORD		PIC  X(21).
 
fd			DIR-TABLE-FILE
	value of id	DIR-TABLE-FILE-ID.
 
01	DIR-TABLE-RECORD		PIC X(109).
 
fd			SKELETON-FILE
	value of id	SKELETON-FILE-ID.

01	SKELETON-RECORD		display-7
				PIC X(115).
*
fd			COMMAND-FILE
	value of id	COMMAND-FILE-ID.

01	COMMAND-RECORD			display-7.
	02  COMMAND-CHAR		pic  X(001)	occurs 105.
01	COMMAND-2			display-7.
	02  COMMAND-VAR			PIC  X(001)	OCCURS 1 TO 105
					DEPENDING ON	VAR-IDX.
WORKING-STORAGE SECTION.
*=======================

*===============================================================
*	S Y M B O L    T A B L E S
*===============================================================

01	W-MAIN-CMD-TABLE	OCCURS 1500
				INDEXED BY W-MCMD-IDX
				ASCENDING KEY W-MCMD-NAME.
	05  W-MCMD-TBL-NAME	PIC X(10).
	05  W-MCMD-NAME		PIC X(10).
	05  W-MCMD-FLAGS.
	    10	W-MCMD-NO-EQUIV		PIC 9(01).
	    10	W-MCMD-IGNORE		PIC 9(01).
	    10	W-MCMD-END-COM		PIC 9(01).
	    10	W-MCMD-TERM		PIC 9(01).
	    10	W-MCMD-FILE-NEXT	PIC 9(01).
	    10	W-MCMD-TOKEN-FIRST	PIC 9(01).
	05  W-MCMD-NXT-TBL	PIC X(10).
	05  W-MCMD-SKL-NAME	PIC X(10).
	05  W-MCMD-TOKEN-NAME	PIC X(05).
	05  W-MCMD-TOKEN-VALUE	PIC X(30).
 
01	W-MCMD-MAX-TBL		PIC S9(04) COMP	VALUE 1500.
 
01	WSS-TABLE-NAME		PIC  X(10).
01	WSS-RETURN-NAME		PIC  X(10).
 
01	W-SUB-CMD-WHOLE.
	05  W-SUB-CMD-TABLE	OCCURS 999
				INDEXED BY W-SCMD-IDX
				ASCENDING KEY W-SCMD-NAME.
	    10  W-SCMD-TBL-NAME		PIC X(10).
	    10  W-SCMD-NAME		PIC X(10).
	    10  W-SCMD-CHAR		REDEFINES
		W-SCMD-NAME		PIC X(01)
					OCCURS 10.
	    10  W-SCMD-FLAGS.
	        15  W-SCMD-NO-EQUIV	PIC 9(01).
	        15  W-SCMD-IGNORE	PIC 9(01).
	        15  W-SCMD-END-COM	PIC 9(01).
	        15  W-SCMD-TERM	PIC 9(01).
	        15  W-SCMD-FILE-NEXT	PIC 9(01).
	        15  W-SCMD-TOKEN-FIRST	PIC 9(01).
	    10  W-SCMD-NXT-TBL		PIC X(10).
	    10  W-SCMD-SKL-NAME		PIC X(10).
	    10  W-SCMD-TOKEN-NAME	PIC X(05).
	    10  W-SCMD-TOKEN-VALUE	PIC X(30).
 
01	W-SCMD-MAX-TBL		PIC S9(04) COMP.
01	W-SCMD-ABS-MAX-TBL	PIC S9(04) COMP	VALUE 1500.
01	W-SCMD-MAX-CHAR		PIC S9(01) COMP VALUE 6.
 
01	W-MAIN-DIR-TABLE	OCCURS 999
				INDEXED BY W-MDIR-IDX
				ASCENDING KEY W-MDIR-NAME.
	05  W-MDIR-TBL-NAME	PIC X(10).
	05  W-MDIR-NAME		PIC 9(06).
	05  W-MDIR-FLAGS.
	    10	W-MDIR-NO-EQUIV		PIC 9(01).
	    10	W-MDIR-IGNORE		PIC 9(01).
	    10	W-MDIR-END-DIR		PIC 9(01).
	05  W-MDIR-NXT-TBL	PIC X(10).
	05  W-MDIR-NEW-DIR	PIC X(80).
 
01	W-MDIR-MAX-TBL		PIC S9(03) COMP	VALUE 999.
 
01	W-SUB-DIR-WHOLE.
	05  W-SUB-DIR-TABLE	OCCURS 999
				INDEXED BY W-SDIR-IDX
				ASCENDING KEY W-SDIR-NAME.
	    10  W-SDIR-TBL-NAME	PIC X(10).
	    10  W-SDIR-NAME	PIC 9(06).
	    10  W-SDIR-FLAGS.
		15  W-SDIR-NO-EQUIV	PIC 9(01).
		15  W-SDIR-IGNORE	PIC 9(01).
		15  W-SDIR-END-DIR	PIC 9(01).
	    10  W-SDIR-NXT-TBL	PIC X(10).
	    10  W-SDIR-NEW-DIR	PIC X(80).
 
01	W-SDIR-MAX-TBL		PIC S9(03) COMP	VALUE 999.
 
01	WSS-MORE-ZEROES-SW	PIC S9(01) COMP.
	88  WSS-MORE-ZEROES	VALUE 1.
 
01	OPER-FOUND-SW		PIC S9(01) COMP.
	88  OPER-FOUND		VALUE 1.

01	WSS-NUMERIC-SW		PIC S9(01) COMP.
	88  WSS-NUMERIC-FIELD	VALUE 1.
 
01	W-HOLD-CMD-FLAGS.
	05  W-HCMD-NO-EQUIV		PIC 9(01).
	05  W-HCMD-IGNORE		PIC 9(01).
	05  W-HCMD-END-COM		PIC 9(01).
	    88	W-HCMD-END-YES		VALUE 1.
	05  W-HCMD-TERM		PIC 9(01).
	    88	W-HCMD-TERM-YES		VALUE 1.
	05  W-HCMD-FILE-NEXT		PIC 9(01).
	    88	W-HCMD-FILE-NEXT-YES	VALUE 1.
	05  W-HCMD-TOKEN-FIRST		PIC 9(01).
 
01	WSS-MORE-HOLD-STUFF.
	05  W-HCMD-NXT-TBL		PIC X(10).
	05  W-HCMD-SKL-NAME             PIC X(10).
	05  W-HCMD-TOKEN-NAME		PIC X(05).
	05  W-HCMD-TOKEN-VALUE		PIC X(30).
 
01	WSS-COMMAND		PIC  X(10).
01	WSS-COMMAND-ARRAY	REDEFINES
	WSS-COMMAND		OCCURS 10
				INDEXED BY CM-IDX
				PIC  X(01).
01	WSS-NEXT-COMMAND	PIC  X(10).
 
01	W-STRUCTURE-TABLE	OCCURS 999
				INDEXED BY W-STR-IDX
				ASCENDING KEY W-STR-OLD.
	05  W-STR-OLD		PIC  X(06).
	05  W-STR-NEW		PIC  X(15).
 
01	W-STR-MAX-TBL		PIC S9(03) COMP VALUE 999.

01	W-SKL-TABLE		OCCURS 999
				INDEXED BY W-SKL-IDX
				ASCENDING KEY W-SKL-NAME.
	05  W-SKL-NAME		PIC  X(010).
	05  W-SKL-DATA		PIC  X(105).
 
01	W-SKL-MAX-TBL		PIC S9(03) COMP	VALUE 999.
 
01	W-STANDARD-EXT-DATA.
	05  FILLER			PIC X(06) VALUE 'CBLCOB'.
	05  FILLER			PIC X(06) VALUE 'CTLCOM'.
	05  FILLER			PIC X(06) VALUE 'LSTLIS'.
	05  FILLER			PIC X(06) VALUE 'MICCOM'.
	05  FILLER			PIC X(06) VALUE 'PL1PLI'.
	05  FILLER			PIC X(06) VALUE 'RELOBJ'.
	05  FILLER			PIC X(06) VALUE 'TEMTMP'.
 
01	W-STANDARD-EXT-TABLE		REDEFINES
	W-STANDARD-EXT-DATA		OCCURS 7
					INDEXED BY W-EXT-IDX
					ASCENDING KEY W-EXT-OLD.
	05  W-EXT-OLD			PIC X(03).
	05  W-EXT-NEW			PIC X(03).
 
01	VAR-CHECK.
	05  VAR-CK-1			PIC X(01).
	05  FILLER			PIC X(01) VALUE '\'.

01	W-STANDARD-VAR-DATA.
	05  FILLER	PIC X(21) VALUE 'A\     P1\'.
	05  FILLER	PIC X(21) VALUE 'B\     P2\'.
	05  FILLER	PIC X(21) VALUE 'C\     P3\'.
	05  FILLER	PIC X(21) VALUE 'D\     P4\'.
	05  FILLER	PIC X(21) VALUE 'DATE\  F$TIME\'.
	05  FILLER	PIC X(21) VALUE 'E\     P5\'.
	05  FILLER	PIC X(21) VALUE 'F\     P6\'.
	05  FILLER	PIC X(21) VALUE 'G\     P7\'.
	05  FILLER	PIC X(21) VALUE 'H\     P8\'.
	05  FILLER	PIC X(21) VALUE 'JOB\   F$PROCESS()\'.
	05  FILLER	PIC X(21) VALUE 'LENGTH\F$LENGTH\'.
	05  FILLER      PIC X(21) VALUE 'PPN\   F$DIRECTORY()\'.
	05  FILLER	PIC X(21) VALUE 'TIME\  F$TIME()\'.
 
01	W-STANDARD-VAR-TABLE		REDEFINES
	W-STANDARD-VAR-DATA		OCCURS 13
					INDEXED BY W-VAR-IDX
					ASCENDING KEY W-VAR-OLD.
	05  W-VAR-OLD			PIC X(07).
	05  W-VAR-NEW			PIC X(14).
 
*========== E N D    O F    S Y M B O L    T A B L E S =========


*=============================================================
*	S Y M B O L    T A B L E    W S
*=============================================================

01	CT-MAX				PIC S9(03) COMP	VALUE 400.

01	CT-TOKEN
					pic X(400).
01	filler redefines CT-TOKEN.
	02  CT-TOKEN-20			PIC  X(20).
	02  filler			pic  X(380).
01	CT-TOKEN-ARRAY redefines CT-TOKEN
					occurs 400
					indexed by CT-IDX
					pic  X(01).
 
01	TOKEN-HOLD
					pic X(400).
01	TOKEN-HOLD-ARRAY redefines TOKEN-HOLD
					occurs 400
					indexed by TH-IDX
					pic  X(01).
01	TH-MAX				PIC S9(03) COMP VALUE 400.

01	HOLD-IDX			USAGE INDEX.
01	CURR-CHAR			PIC  X(01).
 
01	TOKEN-END-SW		pic  S9(01) comp.
	88  TOKEN-END value 1.

01	TEMP-TOKEN			PIC X(400).
01	TEMP-TOKEN-ARRAY		REDEFINES
	TEMP-TOKEN			PIC X(001)
					OCCURS 400
					INDEXED BY TEMP-IDX.
 
01	WSS-DIRECT		PIC X(80).
01	W-DIR-IDX		USAGE INDEX.
01	DIR-MAX			PIC  S9(02) COMP VALUE 80.
 
01	W-CONTROL-REC			PIC X(105).
 
01	CT-STATE-SWITCHES.
	02  CONTROL-END-SW	pic  S9(01) comp.
	    88 CONTROL-END value 1.

01	CONTROL-FILE-CONTROL	DISPLAY-6.
	02  CONTROL-FILE-ID.
	    04  CONTROL-FILE-NAME	pic  X(06).
	    04  CONTROL-FILE-EXT	pic  X(03).
	02  CT-FILE-STATUS.
	    04  CT-FS-STATUS			pic  9(02).
		88  CT-FS-STATUS-NORMAL			value 00.
		88  CT-FS-STATUS-EOF			value 10.
		88  CT-FS-STATUS-DUPLICATE-KEY		value 22.
		88  CT-FS-STATUS-NOT-FOUND		value 23.
		88  CT-FS-STATUS-OUT-OF-BOUNDS		value 24.
		88  CT-FS-STATUS-INVALID-KEY		value 22, 23, 24.
		88  CT-FS-STATUS-FATAL			value 30, 34.
	    04  CT-FS-ERROR-NO			pic  9(10).
	    04  filler redefines CT-FS-ERROR-NO.
		06  CT-FS-VERB-ERROR		pic  9(02).
		    88  CT-FS-OPEN-ERROR		value 01.
		    88  CT-FS-READ-ERROR		value 06.
		06  CT-FS-MONITOR-ERROR		pic  9(02).
		    88  CT-FS-LOOKUP-ERROR		value 03.
		06  filler			pic  9(06).
	    04  CT-FS-ACTION-CODE		usage index.
	    04  CT-FS-FILE-SPEC			pic  X(09).
	    04  CT-FS-BLOCK-NO			usage index.
	    04  CT-FS-RECORD-NO			usage index.
	    04  CT-FS-FILE-NAME			pic  X(30).
	    04  CT-FS-TABLE-POINTER		usage index.

01	CT-FILE-NAME-PROMPT		display-7
					pic  X(26)
	value 'Control file name       > '.

*=============================================================
*	M A C R O    E X P A N S I O N    W S
*=============================================================

*----------------
* Command Data
*----------------
*
01	LINE-POINTERS.
	02  CONTROL-PTR			pic S9(10) comp.
	02  MAX-CONTROL-PTR		pic S9(10) comp.
	02  LAST-CONTROL-PTR		PIC S9(10) COMP.
	02  CONTROL-COUNT		PIC S9(03) COMP.
* NOTE: THE FOLLOWING VALUE MAY BE INCREASED IF REQUIRED FOR NESTING
	02  MAX-CONTROL-COUNT		PIC S9(03) COMP	VALUE 5.
	02  SKELETON-PTR		pic S9(03) comp.
	02  COMMAND-PTR			pic S9(10) comp.
	02  MAX-COMMAND-PTR		pic S9(03) comp value 80.
	02  ERROR-LINE-PTR		pic S9(03) comp.
	02  SYMBOL-WORK-PTR		pic S9(03) comp.
 
01	WSS-SAVE-COMMAND		PIC X(10).
01	WSS-SAVE-COMMAND-ARRAY		REDEFINES
	WSS-SAVE-COMMAND		OCCURS 10
					INDEXED BY SAV-IDX
					PIC X(001).
 
01	COMMAND-WORK
					pic  X(105).
01	COMMAND-ARRAY redefines COMMAND-WORK
					occurs 105
					indexed by COMMAND-INDEX
					pic  X(01).
*
01	TOKEN-SPECIAL-CHAR		display-7.
	02  CURRENT-DELIMITER		pic  X(01).
	02  BEGIN-DELIMITER		pic  X(01) value '{'.
	02  END-DELIMITER		pic  X(01) value '}'.
	02  filler			pic  X(02).

*
01	SKL-END-SW			pic S9(01) comp.
	88  SKL-END			value 1.

01	STRING-END-SW			PIC S9(01) COMP.
	88  STRING-END			VALUE 1.
*
01	VAR-IDX				USAGE INDEX.
 
01	ERROR-HANDLING			display-7.
	02  ERROR-LINE			pic  X(105).
	02  ERROR-NUMBER		pic S9(10) comp.
	02  ERROR-SW			pic S9(01) comp.
	    88  NO-ERROR		VALUE 0.
*&	02  WSS-ERROR-HANDLING-SW	PIC S9(01) COMP.
*&	    88	WSS-ERROR-HANDLING	VALUE 1.

01	filler				display-7.
	02  TEMP-SUBSTITUTE-NAME	pic  X(06).
	02  filler			pic  X(04).
*
01	filler				display-7.
	02  ASCII-SUBSTITUTE-NAME	pic  X(06).
	02  filler			pic  X(04).
*
01	SUBSTITUTE-NAME			display-6.
	88  BLANK-NAME			VALUE 'BLANK'.
	88  COMNT-NAME			VALUE 'COMNT'.
	88  DATA1-NAME			VALUE 'DATA1'.
	88  DATLK-NAME			VALUE 'DATLK'.
	88  DIREC-NAME			VALUE 'DIREC'.
	88  EXT1-NAME			VALUE 'EXT1'.
	88  FILE1-NAME			VALUE 'FILE1'.
	88  FILE2-NAME			VALUE 'FILE2'.
	88  FILNM-NAME			VALUE 'FILNM'.
	88  GEN-NAME			VALUE 'GEN'.
	88  LABLE-NAME			VALUE 'LABLE'.
	88  LABLK-NAME			VALUE 'LABLK'.
	88  PROG-NAME			VALUE 'PROG'.
	88  SAVE-NAME			VALUE 'SAVE'.
	88  STRC1-NAME			VALUE 'STRC1'.
	88  STRC2-NAME			VALUE 'STRC2'.
	88  SWTCH-NAME			VALUE 'SWTCH'.
	88  SWTC2-NAME			VALUE 'SWTC2'.
	88  TOKEN-NAME			VALUE 'TOKEN'.
	88  SKL-SUB-NAME
	    VALUE 'COMNT', 'DATA1', 'FILE1', 'FILE2', 'PROG', 'STRC1',
		  'STRC2', 'SWTCH', 'SWTC2'.
	02  filler			pic  X(06).

01	WSS-LAST-TOKEN-NAME		PIC X(06).
 
01	TOKEN-DATA.
	02  COMNT			PIC X(400).
	02  DATA1			PIC X(400).
	02  DIREC			PIC X(400).
	02  EXT1			PIC X(400).
	02  FILE1			PIC X(400).
	02  FILE2			PIC X(400).
	02  FILNM			PIC X(400).
	02  GEN				PIC X(400).
	02  LABLE			PIC X(400).
	02  PROG			PIC X(400).
	02  STRC1			PIC X(400).
	02  STRC2			PIC X(20).
	02  SWTCH			PIC  X(400).
	02  SWTC2			PIC  X(400).
 
01	TABLE-STATE-SWITCHES.
	02  COM-TABLE-END-SW	PIC  S9(01) COMP.
	    88	COM-TABLE-END	VALUE 1.
	02  STR-TABLE-END-SW	PIC  S9(01) COMP.
	    88	STR-TABLE-END	VALUE 1.
	02  DIR-TABLE-END-SW	PIC  S9(01) COMP.
	    88	DIR-TABLE-END	VALUE 1.
 
01	COM-TABLE-FILE-ID.
	02  COM-TABLE-FILE-NAME		PIC  X(06).
	02  FILLER			PIC  X(03)	VALUE 'TBL'.
 
01	STR-TABLE-FILE-ID.
	02  STR-TABLE-FILE-NAME		PIC  X(06).
	02  FILLER			PIC  X(03)	VALUE 'TBL'.
 
01	DIR-TABLE-FILE-ID.
	02  DIR-TABLE-FILE-NAME		PIC  X(06).
	02  FILLER			PIC  X(03)	VALUE 'TBL'.
 
01	SKELETON-FILE-ID.
	02  FILLER			pic  X(09)	VALUE 'CONBATSKL'.

01	COMMAND-FILE-ID.
	02  COMMAND-FILE-NAME		pic  X(06).
	02  FILLER			pic  X(03)	VALUE 'COM'.

01	LINE-NUMBER			pic S9(05) comp.

01	PAGE-NUMBER			pic S9(05) comp.

01	SYMBOL-WORK			display-7
					pic  X(400).

01	SYMBOL-WORK-ARRAY redefines SYMBOL-WORK display-7
					occurs 400
					pic  X(01).

01	SIXBIT-SYMBOL-WORK		display-6
					pic  X(400).

01	CONTROL-FILE-STATUS		PIC S9(01) COMP VALUE 0.
	88  CONTROL-FILE-OPEN	VALUE 1.
 
01	COMMAND-FILE-STATUS		PIC S9(01) COMP VALUE 0.
	88  COMMAND-FILE-OPEN	VALUE 1.
*=========================================================
*	S C R A T C H    P A D
*=========================================================

01	STASH-REC-ARRAY			DISPLAY-7
					PIC X(525).
01	STASH-REC	REDEFINES	STASH-REC-ARRAY	DISPLAY-7
					OCCURS 5.
	05  STASH-COM			PIC X(03).
	05  STASH			PIC X(102).
01	STASH-IDX			USAGE INDEX.
01	STASH-MAX			USAGE INDEX.

01	WSS-CONTROL-REC			DISPLAY-7
					PIC X(105).
01	WSS-CTL-IDX			USAGE INDEX.

* SET THE FOLLOWING SWITCH TO 1 OR 2 DEPENDING ON OPERATING SYSTEM USED
* TO WRITE CONTROL FILE.  THIS WILL DETERMINE WHICH CONVERSION TABLE IS
* USED.
01	OP-SYS-SW		PIC  9(01) VALUE 1.
	88  OP-TOPS-10-SYS		VALUE 1.
	88  OP-TOPS-20-SYS		VALUE 2.
 
* SET THE FOLLOWING SWITCH TO 1 OR 2 DEPENDING ON WHETHER CTL'S OR MIC'S
* ARE BEING CONVERTED.  A VALUE OF 2 INSTRUCTS THE PROGRAM TO TREAT A 
* SINGLE QUOTE FOLLOWED BY A LETTER (E.G., 'A) AS A VARIABLE.
01	CTL-MIC-SW			PIC S9(01) VALUE 2.
	88  CTL-PROC			VALUE 1.
	88  MIC-PROC			VALUE 2.

01	COMNT-CHAR-IND			PIC X(01).
	88  COMNT-CHAR			VALUE '!', ';'.

01	COMNT-PROC-SW			PIC S9(01) COMP.
	88  COMNT-PROC			VALUE 1.

01	YES-NO-VALUES.
	02  YES-VALUE			pic S9(01) comp value 1.
	02  NO-VALUE			pic S9(01) comp value 0.
*
01	ERROR-TABLE			display-7.
	02  CURRENT-ERROR.
	    04  ERROR-LENGTH		pic  9(02).
	    04  ERROR-TEXT		pic  X(38).
	02  END-DELIMITER-ERROR		pic  X(40)
	    value '36 Beginning but no ending delimiter. \'.
	02  SYMBOL-ERROR		pic  X(40)
	    value '22 Unrecognized symbol. \'.
	02  DATA-TYPE-ERROR		pic  X(40)
	    value '33 Current data type is undefined. \'.
	02  NO-SKELETON-ERROR		pic  x(40)
	    value '26 No skeleton for command. \'.
	02  NO-DIRECTORY-ERROR		pic  X(40)
	    value '25 Directory not in table. \'.
	02  NO-EQUIV-ERROR		pic  X(40)
	    value '25 No equivalent in table. \'.
	02  NO-COMMAND-ERROR		pic  X(40)
	    value '23 Command not in table. \'.
	02  CMD-TABLE-ERROR		PIC  X(40)
	    VALUE '34 Command mishandled by CMD table. \'.
	02  SKL-TABLE-ERROR		PIC  X(40)
	    VALUE '34 Skeleton not found in SKL table. \'.

01	PROG-HEADING			display-7
					pic  X(55)
	value 'VAG004:  Command File Generator -- Version 1'.

01	PROG-PROCESSING-FLAG		pic S9(01) comp value 0.
	88  CONTINUE-PROCESSING	value 0.
	88  PROG-PROCESSING-END		value 9.

01	TERMINAL-INPUT-SW		pic S9(01) comp.
	88  TERMINAL-INPUT	value 1.

01	TERMINAL-REPLY			pic  X(10).

01	WS-SPECIAL-CHARACTERS		pic S9(10) comp value 3090.
01	filler	redefines	WS-SPECIAL-CHARACTERS	display-7.
	02  filler			pic  X(03).
	02  WS-PAGE-EJECT		pic  X(01).
	02  WS-TAB			pic  X(01).
01	WS-SAVE-PTR			pic S9(10) comp.
01	WSS-OPER-CHAR			PIC X(01).

01 TALLY				pic  9(10) COMP.
 
01	WSS-HELP-CHECK			PIC  X(10).
	88  WSS-HELP		VALUE 'HELP', 'Help', 'help', 'H', 'h', '?'.
 
01	WSS-END-OF-LINE-SW		PIC S9(01)	COMP.
	88  WSS-END-OF-LINE	VALUE 1.
 
01	WSS-DELIMITER-CK		PIC  X(01) VALUE 'X'.
	88  WSS-NO-DELIMITER		VALUE 'X'.
	88  WSS-APOSTROPHE		VALUE ''''.
 
01	LABEL-IND			PIC X(02) VALUE '::'.

01	WSS-TABLE-MATCH-SW		PIC S9(01) COMP.
	88  WSS-TABLE-MATCH-NOT-SET	VALUE 0.
	88  WSS-TABLE-MATCH		VALUE 1.
	88  WSS-TABLE-PART-MATCH	VALUE 8.
	88  WSS-TABLE-NO-MATCH		VALUE 9.
	88  WSS-TABLE-MATCH-END		VALUES 1, 8, 9.
 
01	WSS-UNIQUE-SW			PIC S9(01) COMP.
	88  WSS-UNIQUE			VALUE 1.
 
01	WSS-SEARCH-FLAG			PIC S9(01) COMP.
	88  WSS-SEARCH-DONE		VALUE 1.
 
01	WSS-WRITE-FLAG			PIC S9(01) COMP	VALUE 0.
	88  WSS-DO-WRITE		VALUE 1.
 
01	WSS-AVOID-STRC-PROC-FL		PIC S9(01) COMP VALUE 0.
	88  WSS-AVOID-STRC-PROC		VALUE 1.
PROCEDURE DIVISION.
*==================

DECLARATIVES.
*------------

D100-INPUT-ERROR SECTION.	use after standard error procedure on CONTROL-FILE.

D110-INPUT-ERROR.
	If  CT-FS-OPEN-ERROR
	    set CONTROL-FILE-STATUS	TO 0
	    If  CT-FS-LOOKUP-ERROR
		display space
		display '% File ['
		CONTROL-FILE-NAME '.' CONTROL-FILE-EXT
			'] not found.'
		display space
		set TERMINAL-INPUT-SW	TO YES-VALUE
		set CT-FS-ACTION-CODE	TO 1
	    else
		display space
		display '? Fatal error on file ['
			CONTROL-FILE-NAME '.' CONTROL-FILE-EXT
			'].'
		display '	(File Status / Error Number = '
			CT-FS-STATUS ' / ' CT-FS-ERROR-NO ')'.

END DECLARATIVES.
*----------------

THE-PROGRAM SECTION.

0000-PROG-MAIN-LOGIC.
	perform				0100-INITIALIZE.
	PERFORM				0200-PROCESS-ALL
		UNTIL	NOT CONTINUE-PROCESSING.
	perform				0300-TERMINATE.
	STOP RUN.
 
0100-INITIALIZE.
	display SPACE.
	display PROG-HEADING.
	display SPACE.
	IF  OP-TOPS-10-SYS
	    MOVE 'T10COM'		TO COM-TABLE-FILE-NAME
	    MOVE 'T10STR'		TO STR-TABLE-FILE-NAME
	    MOVE 'T10DIR'		TO DIR-TABLE-FILE-NAME
	    MOVE '.'			TO WSS-OPER-CHAR
	ELSE
	IF  OP-TOPS-20-SYS
	    MOVE 'T20COM'		TO COM-TABLE-FILE-NAME
	    MOVE 'T20STR'		TO STR-TABLE-FILE-NAME
	    MOVE 'T20DIR'		TO DIR-TABLE-FILE-NAME
	    MOVE '@'			TO WSS-OPER-CHAR
	ELSE
	    DISPLAY '? OP-SYS-SW has not been set in source file VAG004.'
	    DISPLAY 'Program is aborting.'
	    SET PROG-PROCESSING-FLAG	TO 9.
	IF  CONTINUE-PROCESSING
	    OPEN INPUT	COM-TABLE-FILE
	    PERFORM			0110-LOAD-COM-TABLE-FILE
		UNTIL COM-TABLE-END
	    CLOSE COM-TABLE-FILE
		    IF	CONTINUE-PROCESSING
			OPEN INPUT	DIR-TABLE-FILE
			PERFORM		0120-LOAD-DIR-TABLE-FILE
			    UNTIL DIR-TABLE-END
			CLOSE DIR-TABLE-FILE
	    IF	CONTINUE-PROCESSING
		OPEN	INPUT SKELETON-FILE
		PERFORM			0130-LOAD-SKELETON-FILE
		    UNTIL SKL-END
		CLOSE SKELETON-FILE
		IF  CONTINUE-PROCESSING
		    OPEN INPUT	STR-TABLE-FILE
		    PERFORM		0140-LOAD-STR-TABLE-FILE
			UNTIL STR-TABLE-END
		    CLOSE STR-TABLE-FILE.

0110-LOAD-COM-TABLE-FILE.
	PERFORM				8100-READ-COM-TBL.
	IF  NOT	COM-TABLE-END
	    SET W-MCMD-IDX UP		BY 1
	    IF	W-MCMD-IDX > W-MCMD-MAX-TBL
		DISPLAY '? Command table length exceeded.'
		DISPLAY 'Program is aborting.'
		SET COM-TABLE-END-SW	TO YES-VALUE
		SET PROG-PROCESSING-FLAG	TO 9
	    ELSE
		MOVE COM-TABLE-RECORD	TO W-MAIN-CMD-TABLE(W-MCMD-IDX).
 
0120-LOAD-DIR-TABLE-FILE.
	PERFORM				8200-READ-DIR-TBL.
	IF  NOT	DIR-TABLE-END
	    SET W-DIR-IDX UP		BY 1
	    IF	W-DIR-IDX > W-SDIR-MAX-TBL
		DISPLAY '? Directory table length exceeded.'
		DISPLAY 'Program is aborting.'
		SET DIR-TABLE-END-SW	TO YES-VALUE
		SET PROG-PROCESSING-FLAG	TO 9
	    ELSE
		MOVE DIR-TABLE-RECORD	TO W-MAIN-DIR-TABLE(W-DIR-IDX).
 
0130-LOAD-SKELETON-FILE.
	PERFORM				8300-READ-SKL.
	IF  NOT	SKL-END
	    SET W-SKL-IDX UP		BY 1
	    IF	W-SKL-IDX > W-SKL-MAX-TBL
		DISPLAY '? Skeleton table length exceeded.'
		DISPLAY 'Program is aborting.'
		SET SKL-END-SW		TO YES-VALUE
		SET PROG-PROCESSING-FLAG	TO 9
	    ELSE
		MOVE SKELETON-RECORD	TO W-SKL-TABLE(W-SKL-IDX).
 
0140-LOAD-STR-TABLE-FILE.
	PERFORM				8400-READ-STR-TBL.
	IF  NOT	STR-TABLE-END
	    SET W-STR-IDX UP		BY 1
	    IF	W-STR-IDX > W-STR-MAX-TBL
		DISPLAY '? Structure table length exceeded.'
		DISPLAY 'Program is aborting.'
		SET STR-TABLE-END-SW	TO YES-VALUE
		SET PROG-PROCESSING-FLAG	TO 9
	    ELSE
		MOVE STR-TABLE-RECORD	TO W-STRUCTURE-TABLE(W-STR-IDX).
 
0200-PROCESS-ALL.
	SET CONTROL-END-SW,
	    PROG-PROCESSING-FLAG	to 0.
	set TERMINAL-INPUT-SW		TO 1.
	PERFORM				0210-COLLECT-TERMINAL
		UNTIL	NOT TERMINAL-INPUT.
	If  CONTINUE-PROCESSING
	    MOVE 'TABLE1'		TO WSS-TABLE-NAME
	    PERFORM			9100-LOAD-SUB-CMD-TABLE.
	IF  CONTINUE-PROCESSING
	    PERFORM			9200-LOAD-SUB-DIR-TABLE.
	IF  CONTINUE-PROCESSING
	    MOVE 0			TO LINE-NUMBER,
					   STASH-IDX
					   STASH-MAX
					   W-HOLD-CMD-FLAGS
					   ERROR-NUMBER
					   ERROR-SW
					   WSS-UNIQUE-SW
	SET SKELETON-PTR,
	    COMMAND-PTR,
	    PAGE-NUMBER,
	    ERROR-LINE-PTR		TO 1
	MOVE SPACE			TO ERROR-LINE,
					   SUBSTITUTE-NAME
	    perform			1000-CREATE-COMMAND-FILE
		UNTIL	CONTROL-END
	    SET CONTROL-END-SW		TO NO-VALUE.

0210-COLLECT-TERMINAL.
	display CT-FILE-NAME-PROMPT
		WITH NO ADVANCING.
	accept	TERMINAL-REPLY.
	If  TERMINAL-REPLY = SPACE
	    set PROG-PROCESSING-FLAG	to 9
	    set TERMINAL-INPUT-SW	to NO-VALUE
	else
	    MOVE TERMINAL-REPLY		TO WSS-HELP-CHECK
	    IF	WSS-HELP
		DISPLAY '  Enter the name of the .CTL file to be used to create the .COM file'
	    ELSE
		perform			0215-OPEN-CTL
		PERFORM			0217-OPEN-COM.

0215-OPEN-CTL.
	IF  CONTROL-FILE-OPEN
	    SET CONTROL-FILE-STATUS	TO 0
	    CLOSE CONTROL-FILE.
	unstring TERMINAL-REPLY
		delimited by		'.'
		into			CONTROL-FILE-NAME,
					CONTROL-FILE-EXT.
	If  CONTROL-FILE-EXT = SPACE
	    IF	CTL-PROC
		move 'CTL'		to CONTROL-FILE-EXT
	    ELSE
	    IF	MIC-PROC
		MOVE 'MIC'		TO CONTROL-FILE-EXT.
	set TERMINAL-INPUT-SW		to NO-VALUE.
	SET CONTROL-FILE-STATUS		TO 1.
	open	INPUT			CONTROL-FILE.

0217-OPEN-COM.
	IF  COMMAND-FILE-OPEN
	    SET COMMAND-FILE-STATUS	TO 0
	    CLOSE COMMAND-FILE.
	MOVE CONTROL-FILE-NAME		TO COMMAND-FILE-NAME.
	SET COMMAND-FILE-STATUS		TO 1.
	open	OUTPUT			COMMAND-FILE.

0300-TERMINATE.
	IF CONTROL-FILE-OPEN
	    close	CONTROL-FILE.
	IF  COMMAND-FILE-OPEN
	    CLOSE 	COMMAND-FILE.

1000-CREATE-COMMAND-FILE.
	PERFORM				8000-READ-CTL.
	SET TALLY			TO 0.
	INSPECT CONTROL-RECORD
	    TALLYING TALLY		FOR ALL LABEL-IND
	    BEFORE INITIAL		WSS-OPER-CHAR.
	IF  TALLY > 0
	    MOVE 'LABLE'		TO WSS-TABLE-NAME
	    PERFORM			9100-LOAD-SUB-CMD-TABLE.
	SET STASH-IDX, STASH-MAX UP	BY 1.
	MOVE CTL-STASH-REC		TO STASH(STASH-IDX).
	PERFORM				9300-FIND-MAX.
	IF  MIC-PROC
	    SET WSS-CTL-IDX		TO 1
	MOVE SPACES			TO WSS-CONTROL-REC
	PERFORM				9400-REPLACE-VARIABLES.
	PERFORM				9300-FIND-MAX.
	SET WSS-END-OF-LINE-SW		TO NO-VALUE.
	IF  NOT CONTROL-END
		PERFORM			2000-PROCESS-CTL-LINE.
2000-PROCESS-CTL-LINE.
	MOVE SPACES			TO W-CONTROL-REC
					   SYMBOL-WORK
					   CT-TOKEN
					   TOKEN-HOLD
					   WSS-SAVE-COMMAND
					   WSS-LAST-TOKEN-NAME.
	SET CONTROL-COUNT
	    COMNT-PROC-SW
	    OPER-FOUND-SW
	    LAST-CONTROL-PTR		TO 0.
	PERFORM				3000-OPER-LEVEL
	    UNTIL WSS-END-OF-LINE.
	IF  NO-ERROR
	    SET WSS-END-OF-LINE-SW	TO NO-VALUE
	    MOVE 'ENND'			TO WSS-NEXT-COMMAND
	    PERFORM			3000-OPER-LEVEL
		UNTIL WSS-END-OF-LINE
	    PERFORM			3100-END-OF-LINE-PROC.
	IF  NO-ERROR AND W-HCMD-END-YES
	    IF	COMMAND-RECORD NOT = SPACES
	    OR	(WSS-DO-WRITE)
	    MOVE ZEROES			TO W-HOLD-CMD-FLAGS
	    PERFORM			8500-WRITE-COMMAND-LINE
	    MOVE SPACES			TO STASH-REC-ARRAY
	    SET STASH-IDX, STASH-MAX	TO 0
	    ELSE
		NEXT SENTENCE
	ELSE
	    SET ERROR-SW		TO 0.
 
3000-OPER-LEVEL.
	IF  CT-TOKEN = SPACES
	    SET CT-IDX			TO 1.
	IF  WSS-SAVE-COMMAND = SPACES
	    SET SAV-IDX			TO 1.
	IF  WSS-NEXT-COMMAND = SPACES
		SET CONTROL-PTR UP	BY 1
		MOVE CONTROL-WORK(CONTROL-PTR)	TO CURR-CHAR.
		IF  CONTROL-PTR NOT < MAX-CONTROL-PTR
		    SET WSS-END-OF-LINE-SW	TO YES-VALUE
		    IF	CONTROL-WORK(MAX-CONTROL-PTR) = '-'
			SET WS-SAVE-PTR		TO 0
			INSPECT CONTROL-RECORD
			    TALLYING WS-SAVE-PTR
					FOR ALL '!'
			    WS-SAVE-PTR	FOR ALL ';'
			IF  WS-SAVE-PTR = 0
		PERFORM			3010-PROCESS-CONT-LINE
		SET CONTROL-PTR UP	BY 1
		MOVE CONTROL-WORK(CONTROL-PTR)	TO CURR-CHAR.
	IF  CONTROL-PTR = LAST-CONTROL-PTR
	    SET CONTROL-COUNT UP	BY 1
	    IF	CONTROL-COUNT > MAX-CONTROL-COUNT
		MOVE CMD-TABLE-ERROR	TO CURRENT-ERROR
		SET WSS-END-OF-LINE-SW	TO YES-VALUE
		PERFORM			9999-RECORD-ERROR
	    ELSE
		NEXT SENTENCE
	ELSE
	    MOVE CONTROL-PTR		TO LAST-CONTROL-PTR
	    SET CONTROL-COUNT		TO 1.
* USE FOLLOWING LINE FOR DEBUGGING
*&DISPLAY 'CURR-CHAR ' CURR-CHAR ' CONTROL-PTR ' CONTROL-PTR
	IF  WSS-NEXT-COMMAND = SPACES
	    MOVE CURR-CHAR		TO WSS-COMMAND
	ELSE
	    MOVE WSS-NEXT-COMMAND	TO WSS-COMMAND
	    MOVE SPACES			TO WSS-NEXT-COMMAND.
	IF  WSS-COMMAND-ARRAY(2) = (SPACE OR WS-TAB)
	    MOVE WSS-COMMAND-ARRAY(1)	TO COMNT-CHAR-IND
	    IF  COMNT-CHAR
	    AND W-SCMD-TBL-NAME(1) NOT = 'TABLE1'
		MOVE SPACES		TO CT-TOKEN
		SET CT-IDX		TO 1
		PERFORM			3020-PROCESS-COMNT
		    UNTIL		WSS-END-OF-LINE
		SET COMNT-PROC-SW	TO YES-VALUE.
	IF  NOT COMNT-PROC
	IF  WSS-COMMAND = (SPACE OR WS-TAB)
	    MOVE 'SPTAB'		TO WSS-COMMAND.
* SEARCH FOR CURR CHAR (OR WHATEVER HAS BEEN PUT IN COMMAND); 
* IF MATCH, DO WHAT TABLE SAYS
* OTHERWISE, IF UNIQUE SWITCH ON, CK CURR CHAR AGAINST MATCHING
* CHAR IN RELEVANT TABLE ENTRY-- IF NOMATCH, ERROR
* IF UNIQUE SW OFF, STRING CURR CHAR INTO CT-TOKEN AND DO SERIAL
* SEARCH UNTIL UNIQUE OR END
	IF  NO-ERROR
	AND NOT COMNT-PROC
	    SET W-SCMD-IDX		TO 1
	    SET WSS-TABLE-MATCH-SW	TO 0
	    SEARCH W-SUB-CMD-TABLE
		AT END
		    SET WSS-TABLE-MATCH-SW	TO 9
		WHEN W-SCMD-NAME(W-SCMD-IDX) = WSS-COMMAND
		    SET WSS-TABLE-MATCH-SW	TO 1.
	IF  WSS-TABLE-MATCH
	AND NOT COMNT-PROC
	AND W-SCMD-IGNORE(W-SCMD-IDX) = YES-VALUE
	AND WSS-COMMAND-ARRAY(2) = (SPACE OR WS-TAB)
	AND (WSS-COMMAND-ARRAY(1) ALPHABETIC
	OR  WSS-COMMAND-ARRAY(1) NUMERIC)
	    IF 	((CONTROL-PTR < MAX-CONTROL-PTR)
	    AND (CONTROL-WORK(CONTROL-PTR + 1) ALPHABETIC
	    OR	CONTROL-WORK(CONTROL-PTR + 1) NUMERIC))
	    AND CONTROL-WORK(CONTROL-PTR + 1) NOT = (SPACE AND WS-TAB)
		SET WSS-TABLE-MATCH-SW		TO 9
	    ELSE
	    IF	CONTROL-PTR > 1
	    AND	(CONTROL-WORK(CONTROL-PTR - 1) NUMERIC
	    OR CONTROL-WORK(CONTROL-PTR - 1) ALPHABETIC)
		IF  CONTROL-WORK(CONTROL-PTR - 1) NOT = (SPACE AND WS-TAB)
		SET WSS-TABLE-MATCH-SW		TO 9.
	IF  NO-ERROR
	AND NOT COMNT-PROC
	IF  (WSS-TABLE-NO-MATCH)
	AND (WSS-COMMAND = WSS-COMMAND-ARRAY(1))
* SEARCH AGAIN IF COMMAND IS SINGLE CHARACTER
	    PERFORM			3040-DETERMINE-TYPE
	    SET WSS-TABLE-MATCH-SW	TO 0
	    SET W-SCMD-IDX		TO 1
	    SEARCH W-SUB-CMD-TABLE
		AT END
		    SET WSS-TABLE-MATCH-SW	TO 9
		WHEN W-SCMD-NAME(W-SCMD-IDX) = WSS-COMMAND
		    SET WSS-TABLE-MATCH-SW	TO 1.
	IF  NO-ERROR
	AND NOT COMNT-PROC
	IF  WSS-TABLE-MATCH
	    SET WSS-UNIQUE-SW		TO NO-VALUE
	    MOVE SPACES			TO WSS-SAVE-COMMAND
	    PERFORM			4000-TABLE-MATCH
	ELSE
	IF  WSS-TABLE-NO-MATCH
	    PERFORM			3030-STRING-COMMAND
	    IF	WSS-UNIQUE
		IF  W-SCMD-CHAR(HOLD-IDX,SAV-IDX - 1) NOT = WSS-SAVE-COMMAND-ARRAY(SAV-IDX - 1)
		    IF	WSS-TABLE-NAME = 'PROGNAM'
			MOVE 'USRPROG'		TO WSS-TABLE-NAME
			PERFORM			9100-LOAD-SUB-CMD-TABLE
			MOVE 0			TO W-HOLD-CMD-FLAGS
			STRING WSS-SAVE-COMMAND	DELIMITED BY SPACE
			    INTO		CT-TOKEN
			    WITH POINTER	CT-IDX
			MOVE SPACES		TO WSS-SAVE-COMMAND
		    ELSE
		    IF	WSS-TABLE-NAME = 'COMAND'
			STRING WSS-SAVE-COMMAND	DELIMITED BY SPACE
			    INTO		CT-TOKEN
			    WITH POINTER	CT-IDX
			MOVE SPACES		TO WSS-SAVE-COMMAND
			MOVE 'DATA1'		TO ASCII-SUBSTITUTE-NAME
			PERFORM			4200-FILL-TOKEN
			MOVE 'USRDATA'		TO WSS-TABLE-NAME
			PERFORM			9100-LOAD-SUB-CMD-TABLE
			MOVE 0			TO W-HOLD-CMD-FLAGS
		    ELSE
		    MOVE NO-EQUIV-ERROR	TO CURRENT-ERROR
		    SET WSS-END-OF-LINE-SW	TO YES-VALUE
		    PERFORM			9999-RECORD-ERROR
		ELSE
			MOVE W-SCMD-NXT-TBL(HOLD-IDX)	TO W-HCMD-NXT-TBL
			MOVE W-SCMD-TOKEN-NAME(HOLD-IDX)	TO W-HCMD-TOKEN-NAME
			MOVE W-SCMD-TOKEN-VALUE(HOLD-IDX)	TO W-HCMD-TOKEN-VALUE
			MOVE W-SCMD-FLAGS(HOLD-IDX)		TO W-HOLD-CMD-FLAGS
			MOVE W-SCMD-SKL-NAME(HOLD-IDX)	TO W-HCMD-SKL-NAME
	    ELSE
		SET WSS-TABLE-MATCH-SW	TO 0
		MOVE WSS-SAVE-COMMAND	TO WSS-COMMAND
		PERFORM			3050-SEARCH-TABLE
		IF  WSS-UNIQUE
			MOVE W-SCMD-NXT-TBL(HOLD-IDX)	TO W-HCMD-NXT-TBL
			MOVE W-SCMD-TOKEN-NAME(HOLD-IDX)	TO W-HCMD-TOKEN-NAME
			MOVE W-SCMD-TOKEN-VALUE(HOLD-IDX)	TO W-HCMD-TOKEN-VALUE
			MOVE W-SCMD-FLAGS(HOLD-IDX)		TO W-HOLD-CMD-FLAGS
			MOVE W-SCMD-SKL-NAME(HOLD-IDX)	TO W-HCMD-SKL-NAME
		ELSE
		IF  WSS-TABLE-NO-MATCH
		    IF	WSS-TABLE-NAME = 'PROGNAM'
			MOVE 'USRPROG'		TO WSS-TABLE-NAME
			PERFORM			9100-LOAD-SUB-CMD-TABLE
			MOVE 0			TO W-HOLD-CMD-FLAGS
			STRING WSS-SAVE-COMMAND	DELIMITED BY SPACE
			    INTO		CT-TOKEN
			    WITH POINTER	CT-IDX
		    ELSE
		    IF	WSS-TABLE-NAME = 'COMAND'
			STRING WSS-SAVE-COMMAND	DELIMITED BY SPACE
			    INTO		CT-TOKEN
			    WITH POINTER	CT-IDX
			MOVE SPACES		TO WSS-SAVE-COMMAND
			MOVE 'DATA1'		TO ASCII-SUBSTITUTE-NAME
			PERFORM			4200-FILL-TOKEN
			MOVE 'USRDATA'		TO WSS-TABLE-NAME
			PERFORM			9100-LOAD-SUB-CMD-TABLE
			MOVE 0			TO W-HOLD-CMD-FLAGS
		    ELSE
			MOVE NO-EQUIV-ERROR	TO CURRENT-ERROR
			SET WSS-END-OF-LINE-SW	TO YES-VALUE
			PERFORM			9999-RECORD-ERROR
			SET WSS-END-OF-LINE-SW	TO YES-VALUE.
	IF  NOT COMNT-PROC
	IF  WSS-NEXT-COMMAND NOT = SPACES
	    SET WSS-END-OF-LINE-SW	TO NO-VALUE.
	SET COMNT-PROC-SW		TO NO-VALUE.

3010-PROCESS-CONT-LINE.
	PERFORM				8000-READ-CTL.
	SET STASH-IDX, STASH-MAX UP	BY 1.
	MOVE CTL-STASH-REC		TO STASH(STASH-IDX).
	PERFORM				9300-FIND-MAX.
	IF  MIC-PROC
	SET WSS-CTL-IDX			TO 1
	MOVE SPACES			TO WSS-CONTROL-REC
	PERFORM				9400-REPLACE-VARIABLES
	PERFORM				9300-FIND-MAX.
	SET WSS-END-OF-LINE-SW		TO NO-VALUE.
* At this point, CONTROL-PTR is 0.  It will be incremented by 1 in
* paragraph 3000, so to bypass first asterisk CONTROL-PTR should be
* set to 1.
	IF  CONTROL-WORK(1) = '*'
	    SET CONTROL-PTR UP		BY 1.
	SET CONTROL-PTR UP		BY 1.
	SET WS-SAVE-PTR			TO CONTROL-PTR.
	PERFORM				9500-DO-NOTHING
	    VARYING CONTROL-PTR		FROM WS-SAVE-PTR BY 1
	    UNTIL CONTROL-WORK(CONTROL-PTR) NOT = SPACE
	    OR CONTROL-PTR = MAX-CONTROL-PTR.
	SET CONTROL-PTR DOWN		BY 1.
 
3020-PROCESS-COMNT.
	MOVE CONTROL-WORK(CONTROL-PTR)	TO CURR-CHAR.
	IF  CONTROL-PTR NOT < MAX-CONTROL-PTR
	    SET WSS-END-OF-LINE-SW	TO YES-VALUE.
	IF NOT COMNT-CHAR
	    STRING CURR-CHAR		DELIMITED BY SIZE
					INTO CT-TOKEN
	    WITH POINTER		CT-IDX
	ELSE
	    MOVE SPACE			TO COMNT-CHAR-IND.
	IF  WSS-END-OF-LINE
	    MOVE CT-TOKEN		TO COMNT
	    MOVE SPACES			TO CT-TOKEN
	ELSE
	    SET CONTROL-PTR UP		BY 1.

3030-STRING-COMMAND.
	STRING CURR-CHAR		DELIMITED BY SIZE
	    INTO			WSS-SAVE-COMMAND
	    WITH POINTER		SAV-IDX.
 
3040-DETERMINE-TYPE.
	IF  WSS-COMMAND-ARRAY(1) ALPHABETIC
	OR  WSS-COMMAND-ARRAY(1) NUMERIC
	OR  WSS-COMMAND-ARRAY(1) = "'"
*FOR VARIABLES
	    MOVE 'ALPHAN'		TO WSS-COMMAND
	ELSE
	    MOVE 'NONALP'		TO WSS-COMMAND.
 
3050-SEARCH-TABLE.
	SET W-SCMD-IDX			TO 1.
	SET CM-IDX			TO 1.
	SEARCH W-SUB-CMD-TABLE
	    AT END
		SET WSS-TABLE-MATCH-SW	TO 9
	    WHEN W-SCMD-CHAR(W-SCMD-IDX,1) = WSS-COMMAND-ARRAY(1)
		PERFORM			3055-REST-OF-SEARCH
		    UNTIL WSS-TABLE-MATCH-END.
	IF  WSS-TABLE-PART-MATCH
* Make sure match is unique
	    SET W-SCMD-IDX UP		BY 1
	    SET WSS-TABLE-MATCH-SW	TO 0
	    SET CM-IDX			TO 0
	    PERFORM			3055-REST-OF-SEARCH
		UNTIL WSS-TABLE-MATCH-END
	    IF	WSS-TABLE-PART-MATCH
* Duplicate - key word is not unique in table, so no match
		NEXT SENTENCE
	    ELSE
		SET W-SCMD-IDX DOWN	BY 1
		SET HOLD-IDX		TO W-SCMD-IDX
		SET WSS-UNIQUE-SW	TO YES-VALUE
		SET WSS-TABLE-MATCH-SW	TO 1
	ELSE 
	IF  WSS-TABLE-MATCH
	    SET HOLD-IDX		TO W-SCMD-IDX
	    SET WSS-UNIQUE-SW		TO YES-VALUE.
 
3055-REST-OF-SEARCH.
* If WSS-COMMAND is one character long, it must match exactly.
* If the first six letters of the key and table words match,
* a match has been found (1).  If the key word is smaller than
* the table word and all characters match, a partial match exists (8).
* Otherwise, there is no match (9).
	IF  W-SCMD-IDX > W-SCMD-MAX-TBL
	    SET WSS-TABLE-MATCH-SW	TO 9
	ELSE
	SET CM-IDX UP			BY 1
	IF  CM-IDX > W-SCMD-MAX-CHAR
	    SET WSS-TABLE-MATCH-SW	TO 1
	ELSE
	IF  WSS-COMMAND-ARRAY(CM-IDX) = (SPACE OR WS-TAB)
	AND W-SCMD-CHAR(W-SCMD-IDX,CM-IDX) = SPACE
* If the end of the current command array has been reached, there must
* not be additional letters waiting to be strung in.  This code was
* added to distinguish 'R' from 'RUN' commands.
	    IF  CONTROL-PTR = MAX-CONTROL-PTR
	    OR  (CONTROL-PTR < MAX-CONTROL-PTR
	    AND (CONTROL-WORK(CONTROL-PTR + 1) NOT ALPHABETIC
	    AND CONTROL-WORK(CONTROL-PTR + 1) NOT NUMERIC
	    OR  CONTROL-WORK(CONTROL-PTR + 1) = (SPACE OR WS-TAB)))
		SET WSS-TABLE-MATCH-SW	TO 1
	    ELSE
		SET WSS-TABLE-MATCH-SW	TO 8
	ELSE
	IF  WSS-COMMAND-ARRAY(CM-IDX) = (SPACE OR WS-TAB)
	    SET WSS-TABLE-MATCH-SW	TO 8
	ELSE
	IF  WSS-COMMAND-ARRAY(CM-IDX) > W-SCMD-CHAR(W-SCMD-IDX,CM-IDX)
* Key word is higher in the alphabet than current table word.  Increase
* index of table word by one and try again, unless table is exhausted.
	    SET W-SCMD-IDX UP		BY 1
	    SET CM-IDX		TO 0
	ELSE
	IF  WSS-COMMAND-ARRAY(CM-IDX) < W-SCMD-CHAR(W-SCMD-IDX,CM-IDX)
	    SET WSS-TABLE-MATCH-SW	TO 9.
 
3100-END-OF-LINE-PROC.
	MOVE SPACE			TO CURR-CHAR.
	IF  W-HCMD-END-COM = NO-VALUE
	SET W-SCMD-IDX				TO 1
	SEARCH W-SUB-CMD-TABLE
	    AT END
		MOVE CMD-TABLE-ERROR	TO CURRENT-ERROR
		SET WSS-END-OF-LINE-SW	TO YES-VALUE
		PERFORM			9999-RECORD-ERROR
	    WHEN W-SCMD-NAME(W-SCMD-IDX) = 'ENND'
		    SET WSS-UNIQUE-SW		TO NO-VALUE
		    PERFORM			4000-TABLE-MATCH.
	IF  NO-ERROR
	    IF	W-HCMD-END-YES
		SET COMMAND-PTR			TO 1
		PERFORM				3110-CHECK-LABLE
		IF  W-HCMD-SKL-NAME NOT = SPACES
		    PERFORM			3120-OBTAIN-SKL
		    IF	NO-ERROR
			SET WSS-WRITE-FLAG	TO YES-VALUE
			PERFORM			3130-FILL-SKL
			PERFORM			3140-CHECK-COMMENT
			MOVE SPACES		TO TOKEN-DATA.
	SET COMNT-PROC-SW			TO NO-VALUE.
	IF  NO-ERROR
	IF  W-SCMD-IDX NOT > W-SCMD-MAX-TBL
	    IF	W-SCMD-NXT-TBL(W-SCMD-IDX) NOT = SPACES
		MOVE W-SCMD-NXT-TBL(W-SCMD-IDX)	TO WSS-TABLE-NAME
		PERFORM				9100-LOAD-SUB-CMD-TABLE.
 
3110-CHECK-LABLE.
	IF  LABLE NOT = SPACES
	    STRING LABLE		DELIMITED BY '\'
		INTO			COMMAND-RECORD
		WITH POINTER		COMMAND-PTR
	    MOVE SPACES			TO LABLE.
 
3120-OBTAIN-SKL.
* NOTE:  FOR NOW, USE REG SEARCH; USE SEARCH ALL WHEN FINAL SIZE OF
* SKL TABLE IS DETERMINED...
	SET W-SKL-IDX				TO 1.
*	SEARCH ALL W-SKL-TABLE
	SEARCH W-SKL-TABLE
	    AT END
		MOVE SKL-TABLE-ERROR		TO CURRENT-ERROR
		SET WSS-END-OF-LINE-SW		TO YES-VALUE
		PERFORM				9999-RECORD-ERROR
	    WHEN W-SKL-NAME(W-SKL-IDX) IS = W-HCMD-SKL-NAME
		NEXT SENTENCE.
 
3130-FILL-SKL.
	SET SKELETON-PTR		TO 1.
	MOVE SPACES			TO COMMAND-WORK.
	PERFORM				3135-LINE-SCAN
	    UNTIL SKELETON-PTR > MAX-COMMAND-PTR.
 
3135-LINE-SCAN.
	move SPACE			to CURRENT-DELIMITER.
	unstring W-SKL-DATA(W-SKL-IDX)
		delimited by		BEGIN-DELIMITER
		into			COMMAND-WORK
		DELIMITER IN		CURRENT-DELIMITER
		COUNT IN		COMMAND-INDEX
		pointer			SKELETON-PTR.
	set COMMAND-INDEX		up by 1.
	If  SKELETON-PTR not> MAX-COMMAND-PTR
	    move '\'			to COMMAND-ARRAY(COMMAND-INDEX).
	string	COMMAND-WORK	delimited by '\'
		into			COMMAND-RECORD
		pointer			COMMAND-PTR.
	If  CURRENT-DELIMITER = BEGIN-DELIMITER
	    perform			3135-SUBSTITUTE-NAME.

3135-SUBSTITUTE-NAME.
	unstring W-SKL-DATA(W-SKL-IDX)
		delimited by		END-DELIMITER
		into			ASCII-SUBSTITUTE-NAME
		delimiter in		CURRENT-DELIMITER
		pointer			SKELETON-PTR.
	move ASCII-SUBSTITUTE-NAME	to SUBSTITUTE-NAME.
	If  SKELETON-PTR > MAX-COMMAND-PTR
	    move END-DELIMITER-ERROR	to CURRENT-ERROR
	    perform			9999-RECORD-ERROR
	    SET WSS-END-OF-LINE-SW	TO YES-VALUE
	else
	    perform			3135-FIELD-DATA-NAMES
	    IF COMNT-NAME
		PERFORM			9500-DO-NOTHING
		    VARYING VAR-IDX	FROM 105 BY -1
		    UNTIL COMMAND-VAR(VAR-IDX) NOT = SPACE
		    OR VAR-IDX = 1
		SET VAR-IDX UP		BY 1
		MOVE COMNT		TO SYMBOL-WORK
		PERFORM			9500-DO-NOTHING
		    VARYING	SYMBOL-WORK-PTR	FROM 400 BY -1
		    UNTIL	SYMBOL-WORK-ARRAY(SYMBOL-WORK-PTR) NOT = SPACE
		    OR SYMBOL-WORK-PTR = 1
		MOVE SPACE	TO SYMBOL-WORK-ARRAY(SYMBOL-WORK-PTR)
		MOVE SYMBOL-WORK	TO COMNT
		STRING COMNT		DELIMITED BY SIZE
					INTO COMMAND-RECORD
		    WITH POINTER	COMMAND-PTR
		MOVE SPACES			TO COMNT
	    ELSE
		SET WS-SAVE-PTR		TO 0
		INSPECT SYMBOL-WORK
		    TALLYING WS-SAVE-PTR	FOR CHARACTERS
		    BEFORE INITIAL '\'
		IF  WS-SAVE-PTR + COMMAND-PTR < MAX-COMMAND-PTR
* Allow for a space at end of line for '-' (continuation char)
		    string	SYMBOL-WORK	delimited by '\'
			into			COMMAND-RECORD
			pointer			COMMAND-PTR
		ELSE
		    SET SYMBOL-WORK-PTR	TO 1
		    PERFORM			3135-BREAK-LINE
			UNTIL SYMBOL-WORK-PTR > WS-SAVE-PTR.

3135-FIELD-DATA-NAMES.
	IF  FILE1-NAME
	    MOVE FILE1			TO SYMBOL-WORK
	ELSE IF FILE2-NAME
	    MOVE FILE2			TO SYMBOL-WORK
	ELSE IF COMNT-NAME
	    MOVE COMNT			TO SYMBOL-WORK
	ELSE IF DATA1-NAME
	    MOVE DATA1			TO SYMBOL-WORK
	ELSE IF PROG-NAME
	    MOVE PROG			TO SYMBOL-WORK
	ELSE IF STRC1-NAME
	    MOVE STRC1			TO SYMBOL-WORK
	ELSE IF STRC2-NAME
	    MOVE STRC2			TO SYMBOL-WORK
	ELSE IF DIREC-NAME
	    MOVE DIREC			TO SYMBOL-WORK
	ELSE IF SWTCH-NAME
	    MOVE SWTCH			TO SYMBOL-WORK
	ELSE IF SWTC2-NAME
	    MOVE SWTC2			TO SYMBOL-WORK.
	IF  SYMBOL-WORK = SPACES
	    MOVE '\'			TO SYMBOL-WORK.
	MOVE substitute-name		TO temp-substitute-name.
	IF  temp-substitute-name = ascii-substitute-name
	    MOVE symbol-work		TO sixbit-symbol-work
	    MOVE sixbit-symbol-work	TO symbol-work.

3135-A.
*PARAGRAPH TO OVERCOME 24-LEVEL NESTING LIMIT ON 'IF-ELSE'.
 
3135-BREAK-LINE.
	IF  COMMAND-PTR < MAX-COMMAND-PTR
	    STRING SYMBOL-WORK-ARRAY(SYMBOL-WORK-PTR)
		DELIMITED	BY SIZE
		INTO	COMMAND-RECORD
		POINTER	COMMAND-PTR
	    SET SYMBOL-WORK-PTR UP	BY 1
	ELSE
	    STRING '-'			DELIMITED BY SIZE
		INTO	COMMAND-RECORD
		POINTER	COMMAND-PTR
		PERFORM			8500-WRITE-COMMAND-LINE
		SET COMMAND-PTR		TO 5.

3140-CHECK-COMMENT.
	IF  COMNT NOT = SPACES
	    PERFORM			9500-DO-NOTHING
		VARYING VAR-IDX		FROM 105 BY -1
		UNTIL COMMAND-VAR(VAR-IDX) NOT = SPACE
		OR VAR-IDX = 1
	    IF  VAR-IDX = 1
	    AND COMMAND-VAR(VAR-IDX) = (SPACE OR WS-TAB)
		STRING '$ '		DELIMITED BY SIZE
					INTO COMMAND-RECORD
		WITH POINTER		VAR-IDX
	    ELSE
		SET VAR-IDX UP		BY 2.
	IF  COMNT NOT = SPACES
	    STRING '!' COMNT		DELIMITED BY SIZE
					INTO COMMAND-RECORD
		WITH POINTER		VAR-IDX
	    MOVE SPACES			TO COMNT.

4000-TABLE-MATCH.
	IF  W-SCMD-NO-EQUIV(W-SCMD-IDX) = YES-VALUE
	OR  W-HCMD-NO-EQUIV = YES-VALUE
	    MOVE NO-EQUIV-ERROR			TO CURRENT-ERROR
	    SET WSS-END-OF-LINE-SW		TO YES-VALUE
	    PERFORM				9999-RECORD-ERROR
	ELSE
	    MOVE W-SCMD-FLAGS(W-SCMD-IDX)	TO W-HOLD-CMD-FLAGS
	    IF	W-SCMD-TERM(W-SCMD-IDX) = NO-VALUE
		MOVE W-SCMD-TOKEN-NAME(W-SCMD-IDX)	TO W-HCMD-TOKEN-NAME
		MOVE W-SCMD-TOKEN-VALUE(W-SCMD-IDX)	TO W-HCMD-TOKEN-VALUE
		MOVE W-SCMD-NXT-TBL(W-SCMD-IDX)	TO W-HCMD-NXT-TBL
		MOVE W-SCMD-SKL-NAME(W-SCMD-IDX)	TO W-HCMD-SKL-NAME
	    ELSE
		MOVE WSS-COMMAND		TO WSS-NEXT-COMMAND.
	IF  NO-ERROR
	IF  W-SCMD-TERM(W-SCMD-IDX) = YES-VALUE
	AND W-SCMD-TOKEN-NAME(W-SCMD-IDX) NOT = SPACES
		MOVE W-SCMD-TOKEN-NAME(W-SCMD-IDX)	TO W-HCMD-TOKEN-NAME.
	IF  NO-ERROR
	IF  W-SCMD-TERM(W-SCMD-IDX) = YES-VALUE
	AND W-SCMD-TOKEN-VALUE(W-SCMD-IDX) NOT = SPACES
		MOVE W-SCMD-TOKEN-VALUE(W-SCMD-IDX)	TO W-HCMD-TOKEN-VALUE.
	IF  W-SCMD-TERM(W-SCMD-IDX) = YES-VALUE
	AND W-SCMD-NXT-TBL(W-SCMD-IDX) NOT = SPACES
		MOVE W-SCMD-NXT-TBL(W-SCMD-IDX)	TO W-HCMD-NXT-TBL.
	IF  NO-ERROR
	IF  W-HCMD-NXT-TBL = 'RETURN'
	    MOVE WSS-RETURN-NAME		TO W-HCMD-NXT-TBL
	    MOVE W-SCMD-NAME(W-SCMD-IDX)	TO WSS-NEXT-COMMAND
	    SET WSS-END-OF-LINE-SW		TO NO-VALUE.
	IF  NO-ERROR
	IF  W-HCMD-FILE-NEXT-YES
	    MOVE W-SCMD-TBL-NAME(W-SCMD-IDX)	TO WSS-RETURN-NAME
	    MOVE 'FN1'				TO W-HCMD-NXT-TBL
	    IF	CURR-CHAR = (SPACE OR WS-TAB)
		MOVE 'SPTAB'			TO WSS-NEXT-COMMAND
	    ELSE
		MOVE CURR-CHAR			TO WSS-NEXT-COMMAND.
	IF  NO-ERROR
	IF  W-SCMD-TOKEN-NAME(W-SCMD-IDX) = 'SAVE'
	    IF	CURR-CHAR = (SPACE OR WS-TAB)
		MOVE 'SPTAB'		TO WSS-NEXT-COMMAND
	    ELSE
		MOVE CURR-CHAR		TO WSS-NEXT-COMMAND.
	IF  NO-ERROR
	IF  W-SCMD-TOKEN-NAME(W-SCMD-IDX) = 'FILE1' OR 'FILE2' OR 'SWTCH' OR 'SWTC2'
	    PERFORM				4100-FILE-DONE.
	IF  NO-ERROR
	IF  W-HCMD-IGNORE = NO-VALUE
	    IF	W-HCMD-TOKEN-NAME NOT = SPACES
	    AND W-SCMD-TOKEN-NAME(W-SCMD-IDX)  NOT = 'SAVE'
		MOVE W-HCMD-TOKEN-NAME	TO ASCII-SUBSTITUTE-NAME
		IF  W-HCMD-TOKEN-VALUE NOT = SPACES
		AND W-HCMD-TOKEN-FIRST = NO-VALUE
		    STRING W-HCMD-TOKEN-VALUE	DELIMITED BY '\'
			INTO			CT-TOKEN
			WITH POINTER		CT-IDX
			PERFORM			4200-FILL-TOKEN
		ELSE
		IF  W-SCMD-TERM(W-SCMD-IDX) = YES-VALUE
		    PERFORM		4200-FILL-TOKEN
		ELSE
		IF  WSS-COMMAND NOT = 'ENND'
		    STRING CURR-CHAR	DELIMITED BY SIZE
			INTO		CT-TOKEN
			WITH POINTER	CT-IDX
		    PERFORM		4200-FILL-TOKEN
		ELSE
		    PERFORM		4200-FILL-TOKEN.
	IF  NO-ERROR
	AND W-HCMD-IGNORE = NO-VALUE
	AND (W-HCMD-NXT-TBL NOT = SPACES)
	    MOVE W-HCMD-NXT-TBL		TO WSS-TABLE-NAME
	    PERFORM			9100-LOAD-SUB-CMD-TABLE
	    MOVE SPACES			TO W-HCMD-NXT-TBL.
	IF  NO-ERROR
	IF  W-HCMD-TERM-YES
	    MOVE SPACES			TO CT-TOKEN
	    SET CT-IDX			TO 1.
	IF  NO-ERROR
	IF  WSS-NEXT-COMMAND = SPACES
	    MOVE SPACE			TO CURR-CHAR
	ELSE
	    SET WSS-END-OF-LINE-SW	TO NO-VALUE.
 
4100-FILE-DONE.
* Check all components of file for spaces.  This paragraph may be
* performed when the file has already been written out, prior to adding
* a comma or other addition to the file name.
	MOVE SPACES			TO CT-TOKEN.
	SET CT-IDX			TO 1.
	IF  STRC1 NOT = SPACES
	    MOVE STRC1			TO CT-TOKEN
	    PERFORM			4230-PROCESS-STRUCTURE
	    MOVE CT-TOKEN		TO STRC1.
	IF  DIREC NOT = SPACES
	    MOVE DIREC			TO CT-TOKEN
	    PERFORM			4110-PROCESS-DIREC
	    MOVE CT-TOKEN		TO DIREC.
	IF  EXT1 NOT = SPACES
	    MOVE EXT1			TO CT-TOKEN
	    PERFORM			4120-SEARCH-EXT
	    MOVE CT-TOKEN		TO EXT1.
	MOVE SPACES			TO CT-TOKEN.
	SET CT-IDX			TO 1.
	IF  STRC1 NOT = SPACES
	    STRING STRC1		DELIMITED BY '\'
					INTO CT-TOKEN
	    WITH POINTER		CT-IDX.
	IF  DIREC NOT = SPACES
	    STRING '['			DELIMITED BY SIZE
	    DIREC			DELIMITED BY '\'
	    ']'				DELIMITED BY SIZE
					INTO CT-TOKEN
	    WITH POINTER		CT-IDX.
	IF  FILNM NOT = SPACES
	STRING FILNM			DELIMITED BY '\'
					INTO CT-TOKEN
	    WITH POINTER		CT-IDX.
	IF  EXT1 NOT = SPACES
	    STRING '.'			DELIMITED BY SIZE
	    EXT1			DELIMITED BY '\'
					INTO CT-TOKEN
	    WITH POINTER		CT-IDX.
	IF  GEN NOT = SPACES
	    STRING ';'			DELIMITED BY SIZE
	    GEN				DELIMITED BY '\'
					INTO CT-TOKEN
	    WITH POINTER		CT-IDX.
	MOVE SPACES			TO DIREC
					   EXT1
					   GEN
					   FILNM
					   STRC1.
 
4110-PROCESS-DIREC.
	MOVE SPACES			TO WSS-DIRECT.
	SET W-DIR-IDX			TO 1.
* Single character wild card '?' becomes '%' on VAX
	INSPECT CT-TOKEN
	    REPLACING ALL '?'		BY '%'.
	MOVE CT-TOKEN			TO TOKEN-HOLD.
	MOVE SPACES			TO CT-TOKEN.
	SET TH-IDX			TO 0.
	SET WSS-NUMERIC-SW		TO YES-VALUE.
	SET TOKEN-END-SW		TO NO-VALUE.
	COMPUTE HOLD-IDX = TH-IDX - 1.
	MOVE 'TABLE1'			TO WSS-TABLE-NAME.
	PERFORM				9200-LOAD-SUB-DIR-TABLE.
	PERFORM				4115-DIREC-REMAINDER
	    UNTIL TOKEN-END
	    OR NOT CONTINUE-PROCESSING
	    OR NOT NO-ERROR.
	IF  NO-ERROR
	    IF	WSS-DIRECT NOT = SPACES
		IF W-DIR-IDX NOT > DIR-MAX
		   STRING '\'		DELIMITED BY SIZE
			INTO		WSS-DIRECT
			WITH POINTER	W-DIR-IDX
		    MOVE WSS-DIRECT	TO CT-TOKEN
		ELSE
		    MOVE WSS-DIRECT	TO CT-TOKEN.
 
4115-DIREC-REMAINDER.
	MOVE SPACES			TO CT-TOKEN.
	SET TH-IDX UP			BY 1.
	IF  TH-IDX > TH-MAX
	    SET TOKEN-END-SW		TO YES-VALUE
	ELSE
	    SET CT-IDX			TO 1
	    SET WSS-NUMERIC-SW		TO YES-VALUE
	    COMPUTE HOLD-IDX = TH-IDX - 1
	    PERFORM			4115-STRING-DATA
		UNTIL	TH-IDX > TH-MAX
		OR	TOKEN-HOLD-ARRAY(TH-IDX) = ('.' OR SPACE OR ',' OR '\' OR WS-TAB).
	IF  CT-TOKEN = SPACES
	    NEXT SENTENCE
	ELSE
	    PERFORM			4115-DIR-CONVERT.
 
4115-STRING-DATA.
	STRING TOKEN-HOLD-ARRAY(TH-IDX)	DELIMITED BY SIZE
	    INTO			CT-TOKEN
	    WITH POINTER		CT-IDX.
	IF  TOKEN-HOLD-ARRAY(TH-IDX) NOT NUMERIC
	    SET WSS-NUMERIC-SW		TO NO-VALUE.
	SET TH-IDX UP			BY 1.
 
4115-DIR-CONVERT.
	IF  WSS-NUMERIC-FIELD
	    MOVE CT-TOKEN		TO TEMP-TOKEN
	    MOVE SPACES			TO CT-TOKEN
	    SET WSS-MORE-ZEROES-SW	TO YES-VALUE
	    SET CT-IDX,
		TEMP-IDX		TO 1
	    PERFORM			4115-ELIM-LEADING-ZEROES
		UNTIL TEMP-IDX > CT-MAX
		OR    TEMP-TOKEN-ARRAY(TEMP-IDX) = (SPACE OR WS-TAB)
	    MOVE SPACES			TO TEMP-TOKEN.
	SET W-SDIR-IDX			TO 1.
	SEARCH W-SUB-DIR-TABLE
	    AT END
		SET WSS-END-OF-LINE-SW	TO YES-VALUE
		MOVE NO-DIRECTORY-ERROR	TO CURRENT-ERROR
		PERFORM			9999-RECORD-ERROR
	    WHEN W-SDIR-NAME(W-SDIR-IDX) = CT-TOKEN
		NEXT SENTENCE.
	IF  NO-ERROR
	    IF	W-SDIR-NO-EQUIV(W-SDIR-IDX) = YES-VALUE
		MOVE NO-EQUIV-ERROR	TO CURRENT-ERROR
		SET WSS-END-OF-LINE-SW	TO YES-VALUE
		PERFORM			9999-RECORD-ERROR
	    ELSE
	IF  W-SDIR-NEW-DIR(W-SDIR-IDX) NOT = SPACES
	    IF  WSS-DIRECT NOT = SPACES
		STRING '.'		DELIMITED BY SIZE
		W-SDIR-NEW-DIR(W-SDIR-IDX)	DELIMITED BY SPACE
					INTO WSS-DIRECT
		WITH POINTER		W-DIR-IDX
	    ELSE
		STRING W-SDIR-NEW-DIR(W-SDIR-IDX)	DELIMITED BY SPACE
					INTO WSS-DIRECT
		WITH POINTER		W-DIR-IDX.
	IF  NO-ERROR
	IF  W-SDIR-NXT-TBL(W-SDIR-IDX) NOT = SPACES
	    MOVE W-SDIR-NXT-TBL(W-SDIR-IDX)	TO WSS-TABLE-NAME
	    PERFORM				9200-LOAD-SUB-DIR-TABLE.
 
4115-ELIM-LEADING-ZEROES.
	IF  WSS-MORE-ZEROES
	    IF	TEMP-TOKEN-ARRAY(TEMP-IDX) = 0
		NEXT SENTENCE
	    ELSE
		SET WSS-MORE-ZEROES-SW	TO NO-VALUE
		STRING TEMP-TOKEN-ARRAY(TEMP-IDX)	DELIMITED BY SIZE
						INTO CT-TOKEN
		    WITH POINTER		CT-IDX
	ELSE
	    STRING TEMP-TOKEN-ARRAY(TEMP-IDX)	DELIMITED BY SIZE
						INTO CT-TOKEN
		WITH POINTER			CT-IDX.
	SET TEMP-IDX UP				BY 1.
 
4120-SEARCH-EXT.
	INSPECT CT-TOKEN
	    REPLACING '\'		BY SPACE.
	SEARCH ALL W-STANDARD-EXT-TABLE
	    WHEN W-EXT-OLD(W-EXT-IDX) = CT-TOKEN
		MOVE W-EXT-NEW(W-EXT-IDX)	TO CT-TOKEN.
	PERFORM				9500-DO-NOTHING
	    VARYING CT-IDX	FROM 400 BY -1
	    UNTIL   CT-TOKEN-ARRAY(CT-IDX) NOT = SPACE
		OR  CT-IDX = 1.
	IF  CT-IDX < 400
	    SET CT-IDX UP	BY 1
	    MOVE '\'			TO CT-TOKEN-ARRAY(CT-IDX).
 
4200-FILL-TOKEN.
	MOVE ASCII-SUBSTITUTE-NAME	TO SUBSTITUTE-NAME.
	IF  SUBSTITUTE-NAME = 'SWTCH' OR 'SWTC2'
* If the last token was a file or a structure,
* the switch should be strung onto the
* end of the file spec, not after the command in the skeleton 'SWTCH'
* position.
	    IF  WSS-LAST-TOKEN-NAME NOT = SPACES
	    AND WSS-LAST-TOKEN-NAME = 'FILE1' OR 'FILE2' OR 'STRC1' OR 'STRC2'
		MOVE WSS-LAST-TOKEN-NAME	TO ASCII-SUBSTITUTE-NAME
					   	   SUBSTITUTE-NAME
		SET WSS-AVOID-STRC-PROC-FL	TO YES-VALUE
	    ELSE
		MOVE ASCII-SUBSTITUTE-NAME	TO WSS-LAST-TOKEN-NAME
	ELSE
	IF  SKL-SUB-NAME
	    MOVE ASCII-SUBSTITUTE-NAME	TO WSS-LAST-TOKEN-NAME.
	IF  TOKEN-NAME
	OR  SAVE-NAME
	OR  BLANK-NAME
	    NEXT SENTENCE
	ELSE
	    IF	CT-IDX NOT > CT-MAX
		IF  CT-TOKEN-ARRAY(CT-IDX) = SPACE
		    MOVE '\'		TO CT-TOKEN-ARRAY(CT-IDX).
	IF  TOKEN-NAME
	OR  SAVE-NAME
	OR  BLANK-NAME
	    NEXT SENTENCE
	ELSE
	IF  COMNT-NAME
	    MOVE COMNT			TO TOKEN-HOLD
	    PERFORM			4210-FILL-IT
	    MOVE TOKEN-HOLD		TO COMNT
	ELSE
	IF  FILE1-NAME
	    MOVE FILE1			TO TOKEN-HOLD
	    PERFORM			4210-FILL-IT
	    MOVE TOKEN-HOLD		TO FILE1
	ELSE
	IF  FILE2-NAME
	    MOVE FILE2			TO TOKEN-HOLD
	    PERFORM			4210-FILL-IT
	    MOVE TOKEN-HOLD		TO FILE2
	ELSE
	IF  DATA1-NAME
	    MOVE DATA1			TO TOKEN-HOLD
	    PERFORM			4210-FILL-IT
	    MOVE TOKEN-HOLD		TO DATA1
	ELSE
	IF  LABLE-NAME
	    MOVE LABLE			TO TOKEN-HOLD
	    PERFORM			4210-FILL-IT
	    MOVE TOKEN-HOLD		TO LABLE
	ELSE
	IF  LABLK-NAME
	    MOVE LABLE			TO TOKEN-HOLD
	    PERFORM			4220-LOOK-UP-VAR
	    PERFORM			4210-FILL-IT
	    MOVE TOKEN-HOLD		TO LABLE
	ELSE
	IF  DATLK-NAME
	    MOVE DATA1			TO TOKEN-HOLD
	    PERFORM			4220-LOOK-UP-VAR
	    PERFORM			4210-FILL-IT
	    MOVE TOKEN-HOLD		TO DATA1
	ELSE
	IF  PROG-NAME
	    MOVE PROG			TO TOKEN-HOLD
	    PERFORM			4210-FILL-IT
	    MOVE TOKEN-HOLD		TO PROG
	ELSE
	IF  EXT1-NAME
	    MOVE EXT1			TO TOKEN-HOLD
	    PERFORM			4210-FILL-IT
	    MOVE TOKEN-HOLD		TO EXT1
	ELSE
	IF  FILNM-NAME
	    MOVE FILNM			TO TOKEN-HOLD
	    PERFORM			4210-FILL-IT
	    MOVE TOKEN-HOLD		TO FILNM
	ELSE
	IF  GEN-NAME
	    MOVE GEN			TO TOKEN-HOLD
	    PERFORM			4210-FILL-IT
	    MOVE TOKEN-HOLD		TO GEN
	ELSE
	IF  STRC1-NAME
	    IF	WSS-AVOID-STRC-PROC
		MOVE STRC1		TO TOKEN-HOLD
		PERFORM			4210-FILL-IT
		MOVE TOKEN-HOLD		TO STRC1
		SET WSS-AVOID-STRC-PROC-FL	TO NO-VALUE
	    ELSE
	    PERFORM			4230-PROCESS-STRUCTURE
	    MOVE CT-TOKEN-20		TO STRC1
	ELSE
	IF  STRC2-NAME
	    PERFORM			4230-PROCESS-STRUCTURE
	    MOVE CT-TOKEN-20		TO STRC2
	ELSE
	IF  DIREC-NAME
	    MOVE DIREC			TO TOKEN-HOLD
	    PERFORM			4210-FILL-IT
	    MOVE TOKEN-HOLD		TO DIREC
	ELSE
	IF  SWTCH-NAME
	    MOVE SWTCH			TO TOKEN-HOLD
	    PERFORM			4210-FILL-IT
	    MOVE TOKEN-HOLD		TO SWTCH
	ELSE
	IF  SWTC2-NAME
	    MOVE SWTC2			TO TOKEN-HOLD
	    PERFORM			4210-FILL-IT
	    MOVE TOKEN-HOLD		TO SWTC2
	ELSE
	    MOVE SYMBOL-ERROR		TO CURRENT-ERROR
	    SET PROG-PROCESSING-FLAG	TO 9
	    SET WSS-END-OF-LINE-SW	TO YES-VALUE
	    PERFORM			9999-RECORD-ERROR.
	IF  NOT TOKEN-NAME
	    MOVE SPACES			TO CT-TOKEN
	    SET CT-IDX			TO 1.
 
4210-FILL-IT.
	IF  W-HCMD-TOKEN-FIRST = YES-VALUE
	    IF	TOKEN-HOLD = SPACES
		MOVE W-HCMD-TOKEN-VALUE	TO TOKEN-HOLD
	    ELSE
		MOVE TOKEN-HOLD		TO SYMBOL-WORK
		PERFORM			9500-DO-NOTHING
		    VARYING	SYMBOL-WORK-PTR FROM 400 BY -1
		    UNTIL	SYMBOL-WORK-ARRAY(SYMBOL-WORK-PTR) NOT = SPACE
		STRING W-HCMD-TOKEN-VALUE	DELIMITED BY SIZE
					INTO SYMBOL-WORK
			WITH POINTER	SYMBOL-WORK-PTR
		MOVE SYMBOL-WORK	TO TOKEN-HOLD.
	IF  TOKEN-HOLD = SPACES
	    MOVE CT-TOKEN		TO TOKEN-HOLD
	ELSE
	    MOVE TOKEN-HOLD		TO SYMBOL-WORK
	    PERFORM			9500-DO-NOTHING
		VARYING		SYMBOL-WORK-PTR FROM 400 BY -1
		UNTIL		SYMBOL-WORK-ARRAY(SYMBOL-WORK-PTR) NOT = SPACE
* Note:  Position of pointer will cause 'string' to overwrite existing
* delimiter '\' in SYMBOL-WORK, since it should be at the end of the
* field only.
	    STRING CT-TOKEN '\'		DELIMITED BY SIZE
					INTO SYMBOL-WORK
		WITH POINTER		SYMBOL-WORK-PTR
	    MOVE SYMBOL-WORK		TO TOKEN-HOLD.

4220-LOOK-UP-VAR.
	SEARCH ALL W-STANDARD-VAR-TABLE
	    AT END
		NEXT SENTENCE
	    WHEN W-VAR-OLD(W-VAR-IDX) = CT-TOKEN
		MOVE W-VAR-NEW(W-VAR-IDX)	TO CT-TOKEN.

4230-PROCESS-STRUCTURE.
	INSPECT CT-TOKEN
	    REPLACING ':'		BY SPACE
		      '\'		BY SPACE.
	SET W-STR-IDX			TO 1.
	SEARCH W-STRUCTURE-TABLE
	    WHEN W-STR-OLD(W-STR-IDX) = CT-TOKEN
		MOVE W-STR-NEW(W-STR-IDX)	TO CT-TOKEN.
	PERFORM				9500-DO-NOTHING
	    VARYING CT-IDX	FROM 400 BY -1
	    UNTIL   CT-TOKEN-ARRAY(CT-IDX) NOT = SPACE
		OR  CT-IDX = 1.
	IF  CT-IDX < 400
	    SET CT-IDX UP	BY 1
	    MOVE ':'			TO CT-TOKEN-ARRAY(CT-IDX)
	    IF	CT-IDX < 400
		SET CT-IDX UP		BY 1
		MOVE '\'		TO CT-TOKEN-ARRAY(CT-IDX).
 
8000-READ-CTL.
	read CONTROL-FILE
		at end
		   set CONTROL-END-SW to YES-VALUE.

8100-READ-COM-TBL.
	READ COM-TABLE-FILE
		AT END
		   SET COM-TABLE-END-SW	TO YES-VALUE.

8200-READ-DIR-TBL.
	READ DIR-TABLE-FILE
		AT END
		   SET DIR-TABLE-END-SW	TO YES-VALUE.

8300-READ-SKL.
	READ SKELETON-FILE
		AT END
		   SET SKL-END-SW	TO YES-VALUE.

8400-READ-STR-TBL.
	READ STR-TABLE-FILE
		AT END
		   SET STR-TABLE-END-SW	TO YES-VALUE.

8500-WRITE-COMMAND-LINE.
	If  COMMAND-CHAR (1) = WS-PAGE-EJECT
	    set LINE-NUMBER		TO 0
	    set PAGE-NUMBER		up by 1
	else
	    set LINE-NUMBER		up by 100.
	PERFORM				9500-DO-NOTHING
	    VARYING VAR-IDX		FROM 105 BY -1
	    UNTIL COMMAND-VAR(VAR-IDX) NOT = SPACE
	    OR VAR-IDX = 1.
	write COMMAND-2
	    BEFORE ADVANCING 1 LINE.
	set COMMAND-PTR		to 1.
	move SPACE			to COMMAND-RECORD.
	If  LINE-NUMBER > 99700
	    move WS-PAGE-EJECT		to COMMAND-CHAR (1)
	    perform			8500-WRITE-COMMAND-LINE.
	SET WSS-WRITE-FLAG		TO NO-VALUE.

9100-LOAD-SUB-CMD-TABLE.
	SET W-SCMD-MAX-TBL		TO 0.
	MOVE SPACES			TO W-SUB-CMD-WHOLE.
	SET W-MCMD-IDX				TO 1
	SEARCH W-MAIN-CMD-TABLE
	    AT END
		DISPLAY '? Main table error -- program aborting.'
		SET PROG-PROCESSING-FLAG	TO 9
		SET WSS-END-OF-LINE-SW		TO YES-VALUE
	    WHEN W-MCMD-TBL-NAME(W-MCMD-IDX) = WSS-TABLE-NAME
		SET WSS-SEARCH-FLAG		TO 0
		SET W-SCMD-IDX
		    W-SCMD-MAX-TBL		TO 1
		MOVE W-MAIN-CMD-TABLE(W-MCMD-IDX)	TO W-SUB-CMD-TABLE(W-SCMD-IDX)
		PERFORM				9110-REST-OF-LOAD
		    UNTIL WSS-SEARCH-DONE.
 
9110-REST-OF-LOAD.
	SET W-MCMD-IDX,
	    W-SCMD-IDX UP		BY 1.
	IF  W-MCMD-IDX > W-MCMD-MAX-TBL
	    SET WSS-SEARCH-FLAG		TO 1
	ELSE
	IF  W-MCMD-TBL-NAME(W-MCMD-IDX) = WSS-TABLE-NAME
	    IF  W-SCMD-IDX > W-SCMD-ABS-MAX-TBL
		DISPLAY '? Sub-table size exceeded -- program aborting.'
		SET PROG-PROCESSING-FLAG	TO 9
		SET WSS-END-OF-LINE-SW		TO YES-VALUE
	    ELSE
		SET W-SCMD-MAX-TBL UP			BY 1
		MOVE W-MAIN-CMD-TABLE(W-MCMD-IDX)	TO W-SUB-CMD-TABLE(W-SCMD-IDX)
	ELSE
	    SET WSS-SEARCH-FLAG		TO 1.
 
9200-LOAD-SUB-DIR-TABLE.
	MOVE SPACES			TO W-SUB-DIR-WHOLE.
	SET W-MDIR-IDX				TO 1.
	SEARCH W-MAIN-DIR-TABLE
	    AT END
		DISPLAY '? Main table error -- program aborting.'
		SET PROG-PROCESSING-FLAG	TO 9
		SET WSS-END-OF-LINE-SW		TO YES-VALUE
	    WHEN W-MDIR-TBL-NAME(W-MDIR-IDX) = WSS-TABLE-NAME
		SET WSS-SEARCH-FLAG		TO 0
		SET W-SDIR-IDX			TO 1
		MOVE W-MAIN-DIR-TABLE(W-MDIR-IDX)	TO W-SUB-DIR-TABLE(W-SDIR-IDX)
		PERFORM				9210-REST-OF-LOAD
		    UNTIL WSS-SEARCH-DONE.
 
9210-REST-OF-LOAD.
	SET W-MDIR-IDX,
	    W-SDIR-IDX UP		BY 1.
	IF  W-MDIR-IDX > W-MDIR-MAX-TBL
	    SET WSS-SEARCH-FLAG		TO 1
	ELSE
	IF  W-MDIR-TBL-NAME(W-MDIR-IDX) = WSS-TABLE-NAME
	    IF  W-SDIR-IDX > W-SDIR-MAX-TBL
		DISPLAY '? Sub-table size exceeded -- program aborting.'
		SET PROG-PROCESSING-FLAG	TO 9
		SET WSS-END-OF-LINE-SW		TO YES-VALUE
	    ELSE
		MOVE W-MAIN-DIR-TABLE(W-MDIR-IDX)	TO W-SUB-DIR-TABLE(W-SDIR-IDX)
	ELSE
	    SET WSS-SEARCH-FLAG		TO 1.
 
9300-FIND-MAX.
	PERFORM				9500-DO-NOTHING
	    VARYING CONTROL-PTR		FROM 105 BY -1
	    UNTIL   CONTROL-WORK(CONTROL-PTR) NOT = SPACE
		OR  CONTROL-PTR = 1.
	SET MAX-CONTROL-PTR		TO CONTROL-PTR.
	SET CONTROL-PTR			TO 0.
 
9400-REPLACE-VARIABLES.
	SET STRING-END-SW		TO NO-VALUE.
	PERFORM				9410-STRING-IT
	    UNTIL STRING-END.
	IF  WSS-APOSTROPHE
	    SET CONTROL-PTR UP BY 1
	    IF	CONTROL-WORK(CONTROL-PTR) > "H"
		STRING CONTROL-WORK(CONTROL-PTR) "'"
					DELIMITED BY SIZE
		    INTO WSS-CONTROL-REC
		    WITH POINTER	WSS-CTL-IDX
	    ELSE
		MOVE CONTROL-WORK(CONTROL-PTR)	TO VAR-CK-1
		SEARCH ALL W-STANDARD-VAR-TABLE
		    WHEN W-VAR-OLD(W-VAR-IDX) = VAR-CHECK
			STRING W-VAR-NEW(W-VAR-IDX)	DELIMITED BY '\'
			       "'"		DELIMITED BY SIZE
			    INTO WSS-CONTROL-REC
			    WITH POINTER	WSS-CTL-IDX.
	IF  CONTROL-PTR < MAX-CONTROL-PTR
	    PERFORM			9400-REPLACE-VARIABLES.
	MOVE SPACES			TO CONTROL-WORK-REC
					   WSS-DELIMITER-CK.
	MOVE WSS-CONTROL-REC	TO CONTROL-WORK-REC.

9410-STRING-IT.
	SET CONTROL-PTR UP		BY 1.
	    STRING CONTROL-WORK(CONTROL-PTR)	DELIMITED BY SIZE
					INTO WSS-CONTROL-REC
		WITH POINTER WSS-CTL-IDX.
	    MOVE CONTROL-WORK(CONTROL-PTR)	TO WSS-DELIMITER-CK.
	    IF  WSS-APOSTROPHE
		SET STRING-END-SW	TO YES-VALUE.
	IF  CONTROL-PTR NOT < MAX-CONTROL-PTR
	    SET STRING-END-SW		TO YES-VALUE.

9500-DO-NOTHING.
 
*---------------------
* Record Error Routine
*---------------------
*	1.  Make sure WS-SAVE-PTR is where you want '^'.
*	2.  move error-name-ERROR	to CURRENT-ERROR.
*	3.  perform			9999-RECORD-ERROR.
9999-RECORD-ERROR.
	SET WS-SAVE-PTR			TO CONTROL-PTR.
	SET STASH-IDX			TO 0.
	PERFORM				9999A-OUTPUT-STASH
	    UNTIL STASH-IDX = STASH-MAX.
	MOVE SPACES			TO STASH-REC-ARRAY.
	SET STASH-IDX, STASH-MAX	TO 0.
	SET COMMAND-PTR			TO 1.
	STRING '$! '			DELIMITED BY SIZE
	    INTO			COMMAND-RECORD
	    POINTER			COMMAND-PTR.
	SET CONTROL-PTR			TO WS-SAVE-PTR.
	COMPUTE COMMAND-PTR = (CONTROL-PTR - SAV-IDX) + 4.
	string	'^'			delimited by SIZE
		into			COMMAND-RECORD
		pointer			COMMAND-PTR.
	SUBTRACT ERROR-LENGTH
	    from MAX-COMMAND-PTR	giving ERROR-LINE-PTR.
	If  COMMAND-PTR > ERROR-LINE-PTR
	    subtract ERROR-LENGTH,1	from COMMAND-PTR.
	string	ERROR-TEXT		delimited by '\'
		into			COMMAND-RECORD
		pointer			COMMAND-PTR.
	perform				8500-WRITE-COMMAND-LINE.
	set  ERROR-NUMBER		up by 1.
	set  ERROR-SW			TO 1.
	display 'Error # ' ERROR-NUMBER.
	MOVE 'TABLE1'		TO WSS-TABLE-NAME.
	    PERFORM			9100-LOAD-SUB-CMD-TABLE.
	    PERFORM			9200-LOAD-SUB-DIR-TABLE.
	    MOVE ZEROES			TO W-HOLD-CMD-FLAGS.
	MOVE SPACES			TO CT-TOKEN
					   CURR-CHAR
					   WSS-NEXT-COMMAND
					   WSS-COMMAND.
	SET CT-IDX			TO 1.
	    MOVE SPACES			TO TOKEN-DATA.
	IF  CONTROL-WORK(MAX-CONTROL-PTR) = '-'
	    PERFORM			9999B-COMMENT-REMAINDER.
		
9999A-OUTPUT-STASH.
	SET STASH-IDX UP		BY 1.
	MOVE '$! '			TO STASH-COM(STASH-IDX).
	MOVE STASH-REC(STASH-IDX)	TO COMMAND-RECORD.
	PERFORM				8500-WRITE-COMMAND-LINE.
	MOVE SPACE			TO COMMAND-RECORD.

9999B-COMMENT-REMAINDER.
	PERFORM				8000-READ-CTL.
	IF  NOT CONTROL-END
	    PERFORM			9300-FIND-MAX
	    STRING '$! ' CTL-STASH-REC	DELIMITED BY SIZE
					INTO COMMAND-RECORD
	    PERFORM			8500-WRITE-COMMAND-LINE
	    IF	CONTROL-WORK(MAX-CONTROL-PTR) = '-'
		SET WS-SAVE-PTR		TO 0
		INSPECT CONTROL-RECORD
		    TALLYING WS-SAVE-PTR
				FOR ALL '!'
		    WS-SAVE-PTR	FOR ALL ';'
		IF  WS-SAVE-PTR = 0
		    PERFORM		9999B-COMMENT-REMAINDER.