Google
 

Trailing-Edge - PDP-10 Archives - tops10_integ_tools_v4_10jan-86 - 70,6067/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.
	02  CTL-FIRST-CHAR	PIC X(001).
	    88	CTL-COMMENT	VALUE ';' '!'.
	    88	CTL-BYPASS	VALUE '*' '.'.
*& MAYBE MORE?
	    88	CTL-FIRST-SPACE	VALUE ' '.
	02  CTL-REMAINDER	PIC X(104).

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

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.
	05  FILLER		PIC X(010).
	05  SKELETON-BODY	PIC X(105).
*
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
*=============================================================

*& TEMP AMT
01	W-MAIN-CMD-TABLE	OCCURS 999
				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-CHAR		REDEFINES
	    W-MCMD-NAME		PIC X(01)
				OCCURS 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).
* VALUES FOR NEXT SWITCH:  0=NO, 1=YES, 2=MAYBE!
	    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).
 
*& TEMP AMT
01	W-MCMD-MAX-TBL		PIC S9(03) COMP	VALUE 999.
 
01	WSS-TABLE-NAME		PIC  X(10).
01	WSS-RETURN-NAME		PIC  X(10).
 
01	W-SUB-CMD-WHOLE.
*& TEMP AMT
	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).
* VALUES FOR NEXT SWITCH:  0=NO, 1=YES, 2=MAYBE!
	        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(03) COMP.
01	W-SCMD-ABS-MAX-TBL	PIC S9(03) COMP	VALUE 999.
01	W-SCMD-MAX-CHAR		PIC S9(01) COMP VALUE 6.
 
*& TEMP AMT
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).
 
*& TEMP AMT
01	W-MDIR-MAX-TBL		PIC S9(03) COMP	VALUE 999.
 
01	W-SUB-DIR-WHOLE.
*& TEMP AMT
	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).
 
*& TEMP AMT
01	W-SDIR-MAX-TBL		PIC S9(03) COMP	VALUE 999.
 
01	WSS-MORE-ZEROES-SW	PIC S9(01) COMP.
	88  WSS-NO-MORE-ZEROES	VALUE 0.
	88  WSS-MORE-ZEROES	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-SAME-YES		VALUE 1.
	    88	W-HCMD-SAME-EXC		VALUE 2.
* VALUES FOR NEXT SWITCH:  0=NO, 1=YES, 2=MAYBE!
	05  W-HCMD-FILE-NEXT		PIC 9(01).
	    88	W-HCMD-FILE-NEXT-YES	VALUE 1.
	    88	W-HCMD-FILE-NEXT-MBE	VALUE 2.
	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).
 
*& TEMP AMT
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).
 
*& TEMP AMT
01	W-STR-MAX-TBL		PIC S9(03) COMP VALUE 999.

*& TEMP AMT
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).
 
*& TEMP AMT
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'.
 
*& TEMP AMT
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).
 
*========== 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 105.

01	CT-TOKEN
					pic X(105).
01	filler redefines CT-TOKEN.
	02  CT-TOKEN-1			pic  X(01).
	02  filler			pic X(104).
01	filler redefines CT-TOKEN.
	02  CT-TOKEN-2			pic  X(02).
	02  filler			pic X(103).
01	filler redefines CT-TOKEN.
	02  CT-TOKEN-3			pic  X(03).
	02  filler			pic X(102).
01	filler redefines CT-TOKEN.
	02  CT-TOKEN-4			pic  X(04).
	02  filler			pic X(101).
01	filler redefines CT-TOKEN.
	02  CT-TOKEN-5.
	    04	filler			pic  X(03).
	    04	CT-TOKEN-5-2		pic  X(02).
	02  filler			pic X(100).
01	filler redefines CT-TOKEN.
	02  CT-TOKEN-6			pic  X(06).
	02  filler			pic X(099).
01	filler redefines CT-TOKEN.
	02  CT-TOKEN-7			pic  X(07).
	02  filler			pic X(098).
01	filler redefines CT-TOKEN.
	02  CT-TOKEN-10			pic  X(10).
	02  filler			pic  X(95).
01	filler redefines CT-TOKEN.
	02  CT-TOKEN-15			pic  X(15).
	02  filler			pic  X(90).
01	filler redefines CT-TOKEN.
	02  CT-TOKEN-16			pic  X(16).
	02  filler			pic  X(89).
01	filler redefines CT-TOKEN.
	02  CT-TOKEN-20			PIC  X(20).
	02  filler			pic  X(85).
01	filler redefines CT-TOKEN.
	02  CT-TOKEN-30			pic  X(30).
	02  filler			pic  X(75).
01	filler redefines CT-TOKEN.
	02  CT-TOKEN-40			pic  X(40).
	02  filler			pic  X(65).
01	filler redefines CT-TOKEN.
	02  CT-TOKEN-80			pic  X(80).
	02  filler			pic  X(25).
01	CT-TOKEN-ASCII redefines
	CT-TOKEN			pic X(105).
01	CT-TOKEN-ARRAY redefines CT-TOKEN
					occurs 105
					indexed by CT-IDX
					pic  X(01).
 
01	TOKEN-HOLD
					pic X(105).
01	TOKEN-HOLD-ARRAY redefines TOKEN-HOLD
					occurs 105
					indexed by TH-IDX
					pic  X(01).
01	TH-MAX				PIC S9(03) COMP VALUE 105.

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

01	TEMP-TOKEN			PIC X(105).
01	TEMP-TOKEN-ARRAY		REDEFINES
	TEMP-TOKEN			PIC X(001)
					OCCURS 105
					INDEXED BY TEMP-IDX.
 
01	WSS-FILE-DATA.
	05  WSS-STRUCTURE	PIC X(16).
	05  WSS-FILE-ID.
	    10  WSS-FILE-NAME	PIC X(06).
	    10  WSS-FILE-EXT	PIC X(03).
	05  WSS-DIRECT		PIC X(80).
	05  WSS-DIRECT-ARRAY	REDEFINES
	    WSS-DIRECT		PIC X(01)
				OCCURS 80
				INDEXED BY W-DIR-IDX.
	05  WSS-OLD-PROT	PIC 9(03).
 
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)	VALUE 'CTL'.
	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       > '.

01	TEST-PIC			DISPLAY-6.
	88  DATE-PIC		value 'DATE@'.
	02  TEST-PIC-ARRAY		occurs 20
					indexed by TEST-PIC-INDEX
					pic  X(01).


01	PRT-PIC				display-6.
	02  PRT-PIC-ARRAY		occurs 20
					indexed by PRT-PIC-INDEX
					pic  X(01).
01	PRT-PIC-LEFT			usage index.
01	PRT-PIC-RIGHT			usage index.
01	CHAR-COUNT			usage index.

01	TEMP-INDEX			usage index.
*=============================================================
*	M A C R O    E X P A N S I O N    W S
*=============================================================

*----------------
* Command Data
*----------------
*
01	LINE-POINTERS.
	02  HOLD-PTR			PIC S9(03) COMP.
	02  CONTROL-PTR			pic S9(03) comp.
	02  MAX-CONTROL-PTR		pic S9(03) comp.
	02  LAST-CONTROL-PTR		PIC S9(03) 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 105.
	02  LAST-COMMAND-PTR		pic S9(03) comp.
	02  LAST-COL-NO			pic S9(03) comp.
	02  CURR-COL-NO			pic S9(03) comp.
	02  NEXT-COL-NO			pic S9(03) comp.
	02  NEXT-TAB-NO			pic S9(03) comp.
	02  FILL-COUNT			pic S9(02) comp.
	02  ERROR-LINE-PTR		pic S9(03) comp.
	02  SYMBOL-WORK-PTR		pic S9(03) comp.
*
01	WSS-CONTROL.
	05  WSS-CONTROL-FIRST		PIC X(105).
	05  WSS-CONTROL-WORK		REDEFINES
	    WSS-CONTROL-FIRST		OCCURS 105
					INDEXED BY WSS-CTL-IDX
					PIC X(001).
	05  WSS-CONTROL-SECOND		PIC X(105).
 
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	COMMAND-STATE-SWITCHES.
	02  COMMAND-VALID-SW		pic S9(01) comp.
	    88 COMMAND-VALID		value 1.
	02  SKL-END-SW	pic S9(01) comp.
	    88  SKL-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.
	    88	IS-ERROR		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  COMNT-NAME			VALUE 'COMNT'.
	88  DATA1-NAME			VALUE 'DATA1'.
	88  DATA2-NAME			VALUE 'DATA2'.
	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  LABLE-NAME			VALUE 'LABLE'.
	88  PROG-NAME			VALUE 'PROG'.
	88  SAVE-NAME			VALUE 'SAVE'.
	88  STRC1-NAME			VALUE 'STRC1'.
	88  STRC2-NAME			VALUE 'STRC2'.
*&	88  SVALU-NAME			VALUE 'SVALU'.
	88  SWTCH-NAME			VALUE 'SWTCH'.
	88  TOKEN-NAME			VALUE 'TOKEN'.
	02  filler			pic  X(01).
	    88  RESERVED-VARIABLE	value '%'.
	02  RESERVED-NAME.
	    88  DATE-VARIABLE		value 'DATE'.
	    04  RESERVED-NAME-CHAR-1	pic  X(01).
	    04  filler			pic  X(04).

01	WSS-LAST-TOKEN-NAME		PIC X(06).
 
01	TOKEN-DATA.
	02  COMNT			PIC X(105).
	02  DATA1			PIC X(105).
	02  DATA2			PIC X(105).
	02  DIREC			PIC X(105).
	02  EXT1			PIC X(105).
	02  FILE1			PIC X(105).
	02  FILE2			PIC X(105).
	02  FILNM			PIC X(105).
	02  LABLE			PIC X(105).
	02  PROG			PIC X(105).
	02  STRC1			PIC X(105).
	02  STRC2			PIC X(20).
	02  SWTCH			PIC  X(105).
	02  TOKEN			PIC X(105).
*& NO SVALU FIELD -- 'NAME' ALONE IS USED TO ALERT NEED FOR '=' IN
*& STRING INSTEAD OF '/'
 
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  COM-TABLE-FILE-EXT		PIC  X(03)	VALUE 'TBL'.
 
01	STR-TABLE-FILE-ID.
	02  STR-TABLE-FILE-NAME		PIC  X(06).
	02  STR-TABLE-FILE-EXT		PIC  X(03)	VALUE 'TBL'.
 
01	DIR-TABLE-FILE-ID.
	02  DIR-TABLE-FILE-NAME		PIC  X(06).
	02  DIR-TABLE-FILE-EXT		PIC  X(03)	VALUE 'TBL'.
 
01	SKELETON-FILE-ID.
	02  SKELETON-FILE-NAME		pic  X(06)	VALUE 'VAXCOM'.
	02  SKELETON-FILE-EXT		pic  X(03)	VALUE 'SKL'.

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

01	WS-FILE-NAME			DISPLAY-6
					PIC  X(12).

01	LINE-NUMBER			pic S9(05) comp.
01	LINE-NUMBER-PRT			pic  ZZZZ9.

01	PAGE-NUMBER			pic S9(05) comp.

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

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

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

01	INPUT-FLAG-SAVE			pic S9(01) comp.
 
01	CONTROL-FILE-STATUS		PIC S9(01) COMP VALUE 0.
	88  CONTROL-FILE-CLOSED	VALUE 0.
	88  CONTROL-FILE-OPEN	VALUE 1.
 
01	SKL-STATUS			PIC S9(01) COMP VALUE 0.
	88  SKL-FILE-CLOSED	VALUE 0.
	88  SKL-FILE-OPEN	VALUE 1.
 
01	COMMAND-FILE-STATUS		PIC S9(01) COMP VALUE 0.
	88  COMMAND-FILE-CLOSED	VALUE 0.
	88  COMMAND-FILE-OPEN	VALUE 1.
*=========================================================
*	S C R A T C H    P A D
*=========================================================

* 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.
 
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  RESERVED-VARIABLE-ERROR	pic  X(40)
	    value '30 Undefined reserved variable. @'.
	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-TODAY			display-6.
	02  WS-DATE.
	    04  WS-DATE-YY		pic  X(02).
	    04	WS-DATE-MM		pic  X(02).
	    04	WS-DATE-DD		pic  X(02).

01	WS-TODAY-WORK			display-7.
	02  WS-DATE-WORK.
	    04  WS-DATE-MM-WORK		pic  X(02).
	    04  filler			pic  X(01) value '/'.
	    04  WS-DATE-DD-WORK		pic  X(02).
	    04  filler			pic  X(01) value '/'.
	    04	WS-DATE-YY-WORK		pic  X(02).

01	WS-SAVE-PTR			pic S9(10) comp.
01	WS-INDEX			pic S9(03) comp.

01	WS-NUMBER-6		pic  9(06).
01	filler redefines WS-NUMBER-6.
	02  filler		pic  9(03).
	02  WS-NUMBER-3		pic  9(03).
01	filler redefines WS-NUMBER-6.
	02  filler		pic  9(04).
	02  WS-NUMBER-2		pic  9(02).

01	TAB-WIDTH			pic S9(01) comp value 8.

01	NO-WARNING-COMP			display-6
					pic S9(06).

01	NO-WARNING-6 redefines NO-WARNING-COMP.
	02  filler			pic  X(01).
	02  NO-WARNING-5.
	    04  filler			pic  X(01).
	    04  NO-WARNING-4.
		06  filler		pic  X(01).
		06  NO-WARNING-3.
		    08  filler		pic  X(01).
		    08  NO-WARNING-2.
			10  filler	pic  X(01).
			10  NO-WARNING-1 
					pic  9(01).

01	WSS-LEVEL			PIC  9(01) COMP.
	88  WSS-LEVEL-NOT-SET	VALUE 0.
	88  WSS-OPER-LEVEL	VALUE 1.
	88  WSS-USER-LEVEL	VALUE 2.
	88  WSS-LEVEL-SET	VALUES 1, 2.
 
01	WSS-CHAR-CHECK			PIC  X(01).
*& TEMP VAL
	88  WSS-OPER-CHAR		VALUE '.' '@'.
	88  WSS-USER-CHAR		VALUE '*'.
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-PERIOD			VALUE '.'.
	88  WSS-COMMA			VALUE ','.
	88  WSS-COLON			VALUE ':'.
	88  WSS-SEMICOLON		VALUE ';'.
	88  WSS-ASTERISK		VALUE '*'.
	88  WSS-LEFT-ANGLE		VALUE '<'.
	88  WSS-RIGHT-ANGLE		VALUE '>'.
	88  WSS-LEFT-BRACKET		VALUE '['.
	88  WSS-RIGHT-BRACKET		VALUE ']'.
	88  WSS-AT-SIGN			VALUE '@'.
	88  WSS-EXCLAMATION		VALUE '!'.
	88  WSS-QUESTION		VALUE '?'.
 
01	WSS-FL-DELIMITER-CK		PIC  X(01) VALUE 'X'.
	88  WSS-FL-NO-DELIMITER		VALUE 'X'.
	88  WSS-FL-PERIOD		VALUE '.'.
	88  WSS-FL-COMMA		VALUE ','.
	88  WSS-FL-COLON		VALUE ':'.
	88  WSS-FL-SEMICOLON		VALUE ';'.
	88  WSS-FL-ASTERISK		VALUE '*'.
	88  WSS-FL-LEFT-ANGLE		VALUE '<'.
	88  WSS-FL-RIGHT-ANGLE		VALUE '>'.
	88  WSS-FL-LEFT-BRACKET		VALUE '['.
	88  WSS-FL-RIGHT-BRACKET	VALUE ']'.
	88  WSS-FL-AT-SIGN		VALUE '@'.
	88  WSS-FL-EXCLAMATION		VALUE '!'.
	88  WSS-FL-QUESTION		VALUE '?'.
 
01	WSS-LAST-DELIMITER-CK		PIC  X(01) VALUE 'X'.
	88  WSS-LAST-NO-DELIMITER	VALUE 'X'.
	88  WSS-LAST-PERIOD		VALUE '.'.
	88  WSS-LAST-COMMA		VALUE ','.
	88  WSS-LAST-COLON		VALUE ':'.
	88  WSS-LAST-SEMICOLON		VALUE ';'.
	88  WSS-LAST-ASTERISK		VALUE '*'.
	88  WSS-LAST-LEFT-ANGLE		VALUE '<'.
	88  WSS-LAST-RIGHT-ANGLE	VALUE '>'.
	88  WSS-LAST-LEFT-BRACKET	VALUE '['.
	88  WSS-LAST-RIGHT-BRACKET	VALUE ']'.
	88  WSS-LAST-AT-SIGN		VALUE '@'.
	88  WSS-LAST-EXCLAMATION	VALUE '!'.
	88  WSS-LAST-QUESTION		VALUE '?'.
 
01	WSS-HOLD-DELIMITER		PIC  X(01).
 
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-COMMENT			PIC X(105).
 
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
	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
	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 SKELETON-FILE
		PERFORM			0120-LOAD-SKELETON-FILE
		    UNTIL SKL-END
		CLOSE SKELETON-FILE
		IF  CONTINUE-PROCESSING
		    OPEN INPUT	STR-TABLE-FILE
		    PERFORM		0130-LOAD-STR-TABLE-FILE
			UNTIL STR-TABLE-END
		    CLOSE STR-TABLE-FILE
		    IF	CONTINUE-PROCESSING
			OPEN INPUT	DIR-TABLE-FILE
			PERFORM		0140-LOAD-DIR-TABLE-FILE
			    UNTIL DIR-TABLE-END
			CLOSE DIR-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-SKELETON-FILE.
	PERFORM				8200-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).
 
0130-LOAD-STR-TABLE-FILE.
	PERFORM				8300-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).
 
0140-LOAD-DIR-TABLE-FILE.
	PERFORM				8400-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).
 
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			9900-LOAD-SUB-CMD-TABLE.
	IF  CONTINUE-PROCESSING
	    PERFORM			9500-LOAD-SUB-DIR-TABLE.
	IF  CONTINUE-PROCESSING
*& SET ANY SWITCHES?  CHECK FOLLOWING...
	    MOVE 0			TO LINE-NUMBER,
					   W-HOLD-CMD-FLAGS
					   ERROR-NUMBER
					   ERROR-SW
					   WSS-UNIQUE-SW
	SET SKELETON-PTR,
	    COMMAND-PTR,
	    PAGE-NUMBER,
	    WSS-LEVEL,
	    ERROR-LINE-PTR		TO 1
	MOVE SPACE			TO ERROR-LINE,
					   SUBSTITUTE-NAME
	    perform			1000-CREATE-COMMAND-FILE
		UNTIL	CONTROL-END
*& OR NOT CONTINUE OR ERROR?
	    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
	    move 'CTL'			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.
	PERFORM				9710-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
*&					   HOLD-CHAR
					   CT-TOKEN
					   WSS-SAVE-COMMAND
					   WSS-LAST-TOKEN-NAME.
	SET CONTROL-COUNT
	    LAST-CONTROL-PTR		TO 0.
* Initial level is 1 -- operating system level
*& LEVEL SHOULD BE SET FOR CONT LINES ('-') FURTHER COMMANDS (',')...
*& OR USER LEVEL?  TO GO BACK TO OPER LEVEL...
	IF  WSS-LEVEL-NOT-SET
	    PERFORM			2010-SET-LEVEL
		UNTIL	WSS-LEVEL-SET
		OR	WSS-END-OF-LINE.
	IF  WSS-OPER-LEVEL
*&	    IF	WSS-TABLE-NAME NOT = 'TABLE1'
*&		MOVE 'TABLE1'		TO WSS-TABLE-NAME
*&		PERFORM			9900-LOAD-SUB-CMD-TABLE
		PERFORM			3000-OPER-LEVEL
		    UNTIL WSS-END-OF-LINE
		SET WSS-END-OF-LINE-SW	TO NO-VALUE
		MOVE 'END'		TO WSS-NEXT-COMMAND
		PERFORM			3000-OPER-LEVEL
		    UNTIL WSS-END-OF-LINE
		PERFORM			3200-END-OF-LINE-PROC
*&	    ELSE
*&		PERFORM			3000-OPER-LEVEL
*&		    UNTIL WSS-END-OF-LINE
*&		IF  NO-ERROR
*&		SET WSS-END-OF-LINE-SW	TO NO-VALUE
*&		MOVE 'END'		TO WSS-NEXT-COMMAND
*&		PERFORM			3000-OPER-LEVEL
*&		    UNTIL WSS-END-OF-LINE
*&		PERFORM			3200-END-OF-LINE-PROC
*&		ELSE
*&		    NEXT SENTENCE
	ELSE
	IF  WSS-USER-LEVEL
*& MOVE IN APPROPRIATE TABLE?
	    PERFORM			4000-USER-LEVEL
		UNTIL WSS-END-OF-LINE.
	IF  NO-ERROR
	IF  WSS-USER-LEVEL
	OR  (W-HCMD-END-COM = YES-VALUE
	AND (WSS-OPER-LEVEL))
*& AND LINE NOT CONTINUING? (-)
*&	    MOVE 'TABLE1'		TO WSS-TABLE-NAME
*&	    PERFORM			9900-LOAD-SUB-CMD-TABLE
*&	    PERFORM			9500-LOAD-SUB-DIR-TABLE
	    IF	COMMAND-RECORD NOT = SPACES
	    OR	(WSS-DO-WRITE)
	    MOVE ZEROES			TO W-HOLD-CMD-FLAGS
*&	    MOVE SPACES			TO TOKEN-DATA
	    PERFORM			8500-WRITE-COMMAND-LINE
	    ELSE
		NEXT SENTENCE
	    ELSE
		NEXT SENTENCE
	ELSE
	    SET ERROR-SW		TO 0.
 
2010-SET-LEVEL.
*& THIS NEEDS THOUGHT...
	    SET CONTROL-PTR UP			BY 1.
	    MOVE CONTROL-WORK(CONTROL-PTR)	TO WSS-CHAR-CHECK
	    IF	WSS-USER-CHAR
	    OR	WSS-OPER-CHAR
		SET CONTROL-PTR UP	BY 1
		    IF	WSS-OPER-CHAR
			MOVE 1		TO WSS-LEVEL
		    ELSE
		    IF	WSS-USER-CHAR
			MOVE 2		TO WSS-LEVEL.
3000-OPER-LEVEL.
	IF  CT-TOKEN = SPACES
	    SET CT-IDX			TO 1.
	IF  WSS-SAVE-COMMAND = SPACES
	    SET SAV-IDX			TO 1.
*&
*&	DISPLAY 'HOLD-CHAR ' HOLD-CHAR ' WSS-COMMAND ' WSS-COMMAND.
	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) = '-'
*&
*SHOULD THE FOLLOWING BE HANDLED IN THE TABLES?
		PERFORM			9700-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.
*&		ELSE
*&
DISPLAY 'CURR-CHAR ' CURR-CHAR ' CONTROL-PTR ' CONTROL-PTR
*&	IF  NOT WSS-END-OF-LINE
	IF  WSS-NEXT-COMMAND = SPACES
*&	    IF	W-HCMD-DATA-NEXT = YES-VALUE
*&		MOVE 'DATA'		TO WSS-COMMAND
*&	    ELSE
		MOVE CURR-CHAR		TO WSS-COMMAND
	ELSE
	    MOVE WSS-NEXT-COMMAND	TO WSS-COMMAND
	    MOVE SPACES			TO WSS-NEXT-COMMAND.
*&	IF  NOT WSS-END-OF-LINE
	IF  WSS-COMMAND = (SPACE OR WS-TAB)
	    MOVE 'SPTAB'		TO WSS-COMMAND.
*&	    ELSE
*&		PERFORM			3200-END-OF-LINE-PROC
*&	ELSE
*& 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  NOT WSS-END-OF-LINE
	IF  NO-ERROR
	    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 WSS-COMMAND-ARRAY(2) = SPACES
	AND (WSS-COMMAND-ARRAY(1) ALPHABETIC
	OR  WSS-COMMAND-ARRAY(1) NUMERIC)
PERFORM S1
	    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
		SET WSS-TABLE-MATCH-SW		TO 9
PERFORM Q1
	    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
PERFORM R1
		SET WSS-TABLE-MATCH-SW		TO 9.
*&	IF  NOT WSS-END-OF-LINE
	IF  NO-ERROR
	IF  (WSS-TABLE-NO-MATCH)
	AND (WSS-COMMAND = WSS-COMMAND-ARRAY(1))
* SEARCH AGAIN IF COMMAND IS SINGLE CHARACTER
	    PERFORM			3115-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 NOT WSS-END-OF-LINE
	IF  NO-ERROR
	IF  WSS-TABLE-MATCH
	    SET WSS-UNIQUE-SW		TO NO-VALUE
	    MOVE SPACES			TO WSS-SAVE-COMMAND
	    PERFORM			9200-TABLE-MATCH
	ELSE
	IF  WSS-TABLE-NO-MATCH
	    PERFORM			3110-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			9900-LOAD-SUB-CMD-TABLE
			STRING WSS-SAVE-COMMAND	DELIMITED BY SPACE
			    INTO		CT-TOKEN
			    WITH POINTER	CT-IDX
			MOVE SPACES		TO WSS-SAVE-COMMAND
PERFORM F1
		    ELSE
*& ERROR
		    MOVE NO-EQUIV-ERROR	TO CURRENT-ERROR
		    SET WSS-END-OF-LINE-SW	TO YES-VALUE
		    PERFORM			9999-RECORD-ERROR
*&		    DISPLAY 'ERROR!' W-SCMD-CHAR(HOLD-IDX,SAV-IDX - 1) ' ' WSS-SAVE-COMMAND-ARRAY(SAV-IDX - 1)
PERFORM F1
*&	DISPLAY 'CT-TOKEN ' CT-TOKEN ' CT-IDX ' CT-IDX
		ELSE
*&		    IF	W-SCMD-NXT-TBL(HOLD-IDX) NOT = SPACES
			MOVE W-SCMD-NXT-TBL(HOLD-IDX)	TO W-HCMD-NXT-TBL
			MOVE W-SCMD-SKL-NAME(HOLD-IDX)	TO W-HCMD-SKL-NAME
			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
*&NOTE:  MORE THINGS MAY NEED TO BE MOVED -- SEE 9200
*&		    ELSE
*&			NEXT SENTENCE
	    ELSE
		SET WSS-TABLE-MATCH-SW	TO 0
*&		MOVE CT-TOKEN-10	TO WSS-COMMAND
		MOVE WSS-SAVE-COMMAND	TO WSS-COMMAND
		PERFORM			3120-SEARCH-TABLE
		IF  WSS-UNIQUE
*&		AND W-SCMD-NXT-TBL(HOLD-IDX) NOT = SPACES
			MOVE W-SCMD-NXT-TBL(HOLD-IDX)	TO W-HCMD-NXT-TBL
			MOVE W-SCMD-SKL-NAME(HOLD-IDX)	TO W-HCMD-SKL-NAME
			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
		ELSE
		IF  WSS-TABLE-NO-MATCH
		    IF	WSS-TABLE-NAME = 'PROGNAM'
			MOVE 'USRPROG'		TO WSS-TABLE-NAME
			PERFORM			9900-LOAD-SUB-CMD-TABLE
			STRING WSS-SAVE-COMMAND	DELIMITED BY SPACE
			    INTO		CT-TOKEN
			    WITH POINTER	CT-IDX
PERFORM D1
		    ELSE
*&		    PERFORM		3120-SEARCH-TABLE
*&		    IF	WSS-TABLE-NO-MATCH
*& ERROR
			MOVE NO-EQUIV-ERROR	TO CURRENT-ERROR
			SET WSS-END-OF-LINE-SW	TO YES-VALUE
			PERFORM			9999-RECORD-ERROR
*&			DISPLAY 'ABORT ON COMMAND ' WSS-COMMAND
*&
PERFORM D1
			SET WSS-END-OF-LINE-SW	TO YES-VALUE.
	IF  WSS-NEXT-COMMAND NOT = SPACES
	    SET WSS-END-OF-LINE-SW	TO NO-VALUE.
PERFORM X1.
*&			SET PROG-PROCESSING-FLAG	TO 9.
*&		    ELSE
*&		    IF	WSS-TABLE-MATCH
*&			PERFORM		9200-TABLE-MATCH.
*&	IF  WSS-END-OF-LINE
*&	    PERFORM			3200-END-OF-LINE-PROC.
 
*&
D1.
F1.
X1.
 
Q1.
R1.
S1.
3110-STRING-COMMAND.
*& SHOULD THIS BE CURR-CHAR INSTEAD OF CONTROL?
*&	STRING CONTROL-WORK(CONTROL-PTR)	DELIMITED BY SIZE
	STRING CURR-CHAR		DELIMITED BY SIZE
*&	    INTO			CT-TOKEN
*&	    WITH POINTER		CT-IDX.
	    INTO			WSS-SAVE-COMMAND
	    WITH POINTER		SAV-IDX.
*&	SET CONTROL-PTR UP		BY 1.
 
3115-DETERMINE-TYPE.
	IF  WSS-COMMAND-ARRAY(1) ALPHABETIC
	OR  WSS-COMMAND-ARRAY(1) NUMERIC
	    MOVE 'ALPHAN'		TO WSS-COMMAND
	ELSE
	    MOVE 'NONALP'		TO WSS-COMMAND.
 
3120-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			3125-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			3125-REST-OF-SEARCH
		UNTIL WSS-TABLE-MATCH-END
	    IF	WSS-TABLE-PART-MATCH
* Duplicate - key word is not unique in table, so no match
*&		SET WSS-TABLE-MATCH-SW	TO 9
		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.
 
3125-REST-OF-SEARCH.
* If WSS-COMMAND is one character long, it must match exactly.
*&	IF  WSS-COMMAND-ARRAY(2) = SPACE
*&	    IF	W-SCMD-NAME(W-SCMD-IDX) NOT = WSS-COMMAND
*&		SET WSS-TABLE-MATCH-SW	TO 9
*&	    ELSE
*&		SET WSS-TABLE-MATCH-SW	TO 1.
* 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  NOT WSS-TABLE-MATCH-END
	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
	OR  WSS-COMMAND-ARRAY(CM-IDX) = SPACE
	AND W-SCMD-CHAR(W-SCMD-IDX,CM-IDX) = SPACE
	    SET WSS-TABLE-MATCH-SW	TO 1
	ELSE
	IF  WSS-COMMAND-ARRAY(CM-IDX) = SPACE
	    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
*&	    IF	W-SCMD-IDX > W-SCMD-MAX-TBL
*&		SET WSS-TABLE-MATCH-SW	TO 9
*&	    ELSE
		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.
 
3132-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				9500-LOAD-SUB-DIR-TABLE.
	PERFORM				3132-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.
 
3132-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			9311-STRING-DATA
		UNTIL	TH-IDX > TH-MAX
		OR	TOKEN-HOLD-ARRAY(TH-IDX) = (SPACE OR ',' OR '@').
*&
*&DISPLAY TH-IDX ' ' WSS-FL-DELIMITER-CK ' ' CT-TOKEN
	IF  CT-TOKEN = SPACES
	    NEXT SENTENCE
	ELSE
	    PERFORM			9314-DIR-CONVERT.
 
3132-DIR-PROT-CONVERT.
 
*& DO SOMETHING ABOUT PROTECTION HERE?  OR WHERE?
3200-END-OF-LINE-PROC.
	MOVE SPACE			TO CURR-CHAR.
	IF  W-HCMD-END-COM = NO-VALUE
*& OR SCMD?  ALSO SEE BELOW...
	SET W-SCMD-IDX				TO 1
	SEARCH W-SUB-CMD-TABLE
*&	    AT END
*&		DISPLAY '? No "end" in sub-table -- program aborting.'
*&		SET PROG-PROCESSING-FLAG	TO 9
	    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) = 'END'
		    SET WSS-UNIQUE-SW		TO NO-VALUE
		    PERFORM			9200-TABLE-MATCH.
*& THIS NEEDS FIXING...
*&	IF  CONTINUE-PROCESSING
	IF  NO-ERROR
	    IF	W-HCMD-END-COM = YES-VALUE
		SET COMMAND-PTR			TO 1
		PERFORM				3230-CHECK-LABLE
		IF  W-HCMD-SKL-NAME NOT = SPACES
		    PERFORM			3210-OBTAIN-SKL
		    IF	CONTINUE-PROCESSING
			SET WSS-WRITE-FLAG	TO YES-VALUE
			PERFORM			3220-FILL-SKL
			PERFORM			3240-CHECK-COMMENT.
	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
*&	    ELSE
*&		MOVE 'TABLE1'			TO WSS-TABLE-NAME
*&	ELSE
*&	    MOVE 'TABLE1'			TO WSS-TABLE-NAME.
	PERFORM				9900-LOAD-SUB-CMD-TABLE.
 
3210-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
*&		DISPLAY '? Skeleton table error -- program aborting.'
*&		SET PROG-PROCESSING-FLAG	TO 9
		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.
 
3220-FILL-SKL.
	SET SKELETON-PTR		TO 1.
*& MAX MAY NOT WORK, BECAUSE SKL PTR NOT ALLOWING FOR SIZE OF LABLE...
	MOVE SPACES			TO COMMAND-WORK.
	PERFORM				9400-LINE-SCAN
	    UNTIL SKELETON-PTR > MAX-COMMAND-PTR.
	MOVE SPACES			TO TOKEN-DATA.
 
3230-CHECK-LABLE.
	IF  LABLE NOT = SPACES
	    STRING LABLE		DELIMITED BY '@'
		INTO			COMMAND-RECORD
		WITH POINTER		COMMAND-PTR
	    MOVE SPACES			TO LABLE.
 
3240-CHECK-COMMENT.
*& THIS IS CRUDE...NO CHECKING FOR RECORD OVERFLOW
	IF  COMNT NOT = SPACES
	    PERFORM			9800-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
	    STRING ' !' COMNT		DELIMITED BY SIZE
					INTO COMMAND-RECORD
		WITH POINTER		COMMAND-PTR
	    MOVE SPACES			TO COMNT.
4000-USER-LEVEL.
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-SKL.
	READ SKELETON-FILE
		AT END
		   SET SKL-END-SW	TO YES-VALUE.

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

8400-READ-DIR-TBL.
	READ DIR-TABLE-FILE
		AT END
		   SET DIR-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				9800-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.
*& DETERMINE, SOMEWHERE, WHAT THE NEXT LEVEL (OPER OR USER) IS GOING
*& TO BE AND, IF NECC, BLANK OUT CURRENT SUB-TABLE AND MOVE MAIN TABLE
*& BACK IN... HERE?  AND WHAT DETERMINES NEXT LEVEL -- SWITCH IN CURR
*& SUB-TABLE?  AND WHAT ABOUT ONES WHERE YOU'RE NOT SURE?
9100-EAT-SPACES.
	Set CONTROL-PTR		up by 1.

9200-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
PERFORM A1
		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
*&	    IF	CURR-CHAR = SPACE
*&		MOVE 'SPTAB'			TO WSS-NEXT-COMMAND
*&	    ELSE
*&		MOVE CURR-CHAR			TO WSS-NEXT-COMMAND
		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
PERFORM B1.
	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
PERFORM C1
	    SET WSS-END-OF-LINE-SW		TO NO-VALUE.
	IF  NO-ERROR
	IF  W-HCMD-FILE-NEXT = YES-VALUE
	    MOVE W-SCMD-TBL-NAME(W-SCMD-IDX)	TO WSS-RETURN-NAME
	    MOVE 'FN1'				TO W-HCMD-NXT-TBL
	    IF	CURR-CHAR = SPACE
		MOVE 'SPTAB'			TO WSS-NEXT-COMMAND
	    ELSE
		MOVE CURR-CHAR			TO WSS-NEXT-COMMAND
PERFORM E1.
	IF  NO-ERROR
	IF  W-SCMD-TOKEN-NAME(W-SCMD-IDX) = 'SAVE'
	    IF	CURR-CHAR = SPACE
		MOVE 'SPTAB'		TO WSS-NEXT-COMMAND
	    ELSE
		MOVE CURR-CHAR		TO WSS-NEXT-COMMAND
PERFORM G1.
	IF  NO-ERROR
	IF  W-HCMD-TOKEN-FIRST = YES-VALUE
	    MOVE W-HCMD-TOKEN-NAME	TO ASCII-SUBSTITUTE-NAME
	    STRING W-HCMD-TOKEN-VALUE	DELIMITED BY SPACE
		INTO			CT-TOKEN
		WITH POINTER		CT-IDX
	    PERFORM			9399-FILL-TOKEN.
*&	IF  NO-ERROR
*&	    IF	W-SCMD-TOKEN-NAME(W-SCMD-IDX) = 'PROG'
*&		MOVE SPACES		TO WSS-NEXT-COMMAND
*&		STRING FILNM		DELIMITED BY '@'
*&		    INTO		WSS-NEXT-COMMAND
*&PERFORM H1.
	IF  NO-ERROR
	IF  W-SCMD-TOKEN-NAME(W-SCMD-IDX) = 'FILE1' OR 'FILE2'
*&	IF  W-SCMD-TOKEN-NAME(W-SCMD-IDX) = 'FILE1' OR 'FILE2' OR 'PROG'
	    PERFORM				9315-FILE-DONE.
*&	ELSE
	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 SPACE
			INTO			CT-TOKEN
			WITH POINTER		CT-IDX
			PERFORM			9399-FILL-TOKEN
		ELSE
		IF  W-SCMD-TERM(W-SCMD-IDX) = YES-VALUE
		    PERFORM		9399-FILL-TOKEN
		ELSE
		IF  WSS-COMMAND NOT = 'END'
		    STRING CURR-CHAR	DELIMITED BY SIZE
			INTO		CT-TOKEN
			WITH POINTER	CT-IDX
		    PERFORM		9399-FILL-TOKEN
		ELSE
		    PERFORM		9399-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			9900-LOAD-SUB-CMD-TABLE
	    MOVE SPACES			TO W-HCMD-NXT-TBL.
	IF  NO-ERROR
	IF  W-HCMD-TERM = YES-VALUE
	    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.
 
*&
B1.
C1.
E1.
G1.
H1.
 
9311-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.
 
9312-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				9800-DO-NOTHING
	    VARYING CT-IDX	FROM 105 BY -1
	    UNTIL   CT-TOKEN-ARRAY(CT-IDX) NOT = SPACE
		OR  CT-IDX = 1.
	IF  CT-IDX < 105
	    SET CT-IDX UP	BY 1
	    MOVE '@'			TO CT-TOKEN-ARRAY(CT-IDX).
 
9313-PROT-CONVERT.
 
9314-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			9314-ELIM-LEADING-ZEROES
		UNTIL TEMP-IDX > CT-MAX
		OR    TEMP-TOKEN-ARRAY(TEMP-IDX) = SPACE
	    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
		SET WS-SAVE-PTR UP	BY HOLD-IDX
		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				9500-LOAD-SUB-DIR-TABLE.
 
9314-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.
 
9315-FILE-DONE.
	MOVE SPACES			TO CT-TOKEN.
	SET CT-IDX			TO 1.
	IF  STRC1 NOT = SPACES
	    MOVE STRC1			TO CT-TOKEN
	    PERFORM			9316-PROCESS-STRUCTURE
	    MOVE CT-TOKEN		TO STRC1.
	IF  DIREC NOT = SPACES
	    MOVE DIREC			TO CT-TOKEN
	    PERFORM			3132-PROCESS-DIREC
	    MOVE CT-TOKEN		TO DIREC.
	IF  EXT1 NOT = SPACES
	    MOVE EXT1			TO CT-TOKEN
	    PERFORM			9312-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.
	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  W-SCMD-TOKEN-VALUE(W-SCMD-IDX) NOT = SPACES
*&		    STRING W-SCMD-TOKEN-VALUE(W-SCMD-IDX)
*&					DELIMITED BY SPACE
*&					INTO CT-TOKEN
*&			WITH POINTER	CT-IDX.
*&	MOVE W-HCMD-TOKEN-NAME		TO ASCII-SUBSTITUTE-NAME.
*&	PERFORM				9399-FILL-TOKEN.
	MOVE SPACES			TO DIREC
					   EXT1
					   FILNM
					   STRC1.
*& DO SOMETHING ABOUT PROTECTION HERE?  OR WHERE?

*&
A1.
 
9316-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				9800-DO-NOTHING
	    VARYING CT-IDX	FROM 105 BY -1
	    UNTIL   CT-TOKEN-ARRAY(CT-IDX) NOT = SPACE
		OR  CT-IDX = 1.
	IF  CT-IDX < 105
	    SET CT-IDX UP	BY 1
	    MOVE ':'			TO CT-TOKEN-ARRAY(CT-IDX)
	    IF	CT-IDX < 105
		SET CT-IDX UP		BY 1
		MOVE '@'		TO CT-TOKEN-ARRAY(CT-IDX).
 
9399-FILL-TOKEN.
	MOVE ASCII-SUBSTITUTE-NAME	TO SUBSTITUTE-NAME.
	IF  SUBSTITUTE-NAME = 'SWTCH'
* 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 NOT = ASCII-SUBSTITUTE-NAME
	    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
	    MOVE ASCII-SUBSTITUTE-NAME	TO WSS-LAST-TOKEN-NAME.
	IF  TOKEN-NAME
	OR  SAVE-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
	    NEXT SENTENCE
	ELSE
	IF  COMNT-NAME
	    MOVE COMNT			TO TOKEN-HOLD
	    PERFORM			9399-FILL-IT
	    MOVE TOKEN-HOLD		TO COMNT
	ELSE
	IF  FILE1-NAME
	    MOVE FILE1			TO TOKEN-HOLD
	    PERFORM			9399-FILL-IT
	    MOVE TOKEN-HOLD		TO FILE1
	ELSE
	IF  FILE2-NAME
	    MOVE FILE2			TO TOKEN-HOLD
	    PERFORM			9399-FILL-IT
	    MOVE TOKEN-HOLD		TO FILE2
	ELSE
	IF  DATA1-NAME
	    MOVE DATA1			TO TOKEN-HOLD
	    PERFORM			9399-FILL-IT
	    MOVE TOKEN-HOLD		TO DATA1
	ELSE
	IF  DATA2-NAME
	    MOVE DATA2			TO TOKEN-HOLD
	    PERFORM			9399-FILL-IT
	    MOVE TOKEN-HOLD		TO DATA2
	ELSE
	IF  LABLE-NAME
	    MOVE LABLE			TO TOKEN-HOLD
	    PERFORM			9399-FILL-IT
	    MOVE TOKEN-HOLD		TO LABLE
	ELSE
	IF  PROG-NAME
	    MOVE PROG			TO TOKEN-HOLD
	    PERFORM			9399-FILL-IT
	    MOVE TOKEN-HOLD		TO PROG
	ELSE
	IF  EXT1-NAME
	    MOVE EXT1			TO TOKEN-HOLD
	    PERFORM			9399-FILL-IT
	    MOVE TOKEN-HOLD		TO EXT1
	ELSE
	IF  FILNM-NAME
	    MOVE FILNM			TO TOKEN-HOLD
	    PERFORM			9399-FILL-IT
	    MOVE TOKEN-HOLD		TO FILNM
	ELSE
	IF  STRC1-NAME
	    IF	WSS-AVOID-STRC-PROC
		MOVE STRC1		TO TOKEN-HOLD
		PERFORM			9399-FILL-IT
		MOVE TOKEN-HOLD		TO STRC1
		SET WSS-AVOID-STRC-PROC-FL	TO NO-VALUE
	    ELSE
	    PERFORM			9316-PROCESS-STRUCTURE
	    MOVE CT-TOKEN-20		TO STRC1
	ELSE
	IF  STRC2-NAME
	    PERFORM			9316-PROCESS-STRUCTURE
	    MOVE CT-TOKEN-20		TO STRC2
	ELSE
	IF  DIREC-NAME
	    MOVE DIREC			TO TOKEN-HOLD
	    PERFORM			9399-FILL-IT
	    MOVE TOKEN-HOLD		TO DIREC
	ELSE
	IF  SWTCH-NAME
*&	    IF	SWTCH = SPACES
*&		MOVE CT-TOKEN		TO SWTCH
*&	    ELSE
*&		MOVE SWTCH		TO SYMBOL-WORK
*&		PERFORM			9800-DO-NOTHING
*&		    VARYING	SYMBOL-WORK-PTR	FROM 105 BY -1
*&		    UNTIL	SYMBOL-WORK-ARRAY(SYMBOL-WORK-PTR) NOT = SPACE
*&		STRING '/' CT-TOKEN '@'	DELIMITED BY SIZE
*&					INTO SYMBOL-WORK
*&		    WITH POINTER	SYMBOL-WORK-PTR
*&		MOVE SYMBOL-WORK	TO SWTCH
	    MOVE SWTCH			TO TOKEN-HOLD
	    PERFORM			9399-FILL-IT
	    MOVE TOKEN-HOLD		TO SWTCH
*&	ELSE
*&	IF  SVALU-NAME
*&	    MOVE SWTCH			TO SYMBOL-WORK
*&	    PERFORM			9800-DO-NOTHING
*&		VARYING	SYMBOL-WORK-PTR	FROM 105 BY -1
*&		UNTIL	SYMBOL-WORK-ARRAY(SYMBOL-WORK-PTR) NOT = SPACE
*&	    STRING '=' CT-TOKEN	'@'	DELIMITED BY SIZE
*&					INTO SYMBOL-WORK
*&		WITH POINTER		SYMBOL-WORK-PTR
*&		MOVE SYMBOL-WORK	TO SWTCH
*& ETC.
	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.
 
 
9399-FILL-IT.
	IF  TOKEN-HOLD = SPACES
	    MOVE CT-TOKEN		TO TOKEN-HOLD
	ELSE
	    MOVE TOKEN-HOLD		TO SYMBOL-WORK
	    PERFORM			9800-DO-NOTHING
		VARYING		SYMBOL-WORK-PTR FROM 105 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.
*--------------
* Start Command
*--------------

9400-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			9410-SUBSTITUTE-NAME.

9410-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 If RESERVED-VARIABLE
	    perform			9410-RESERVED-VARIABLE
	else
	    perform			9410-FIELD-DATA-NAMES
	    string	SYMBOL-WORK		delimited by '@'
		into				COMMAND-RECORD
		pointer				COMMAND-PTR.

9410-RESERVED-VARIABLE.
	IF DATE-VARIABLE
	    string WS-DATE-WORK
		delimited by		SIZE
		into			COMMAND-RECORD
		pointer			COMMAND-PTR
	else If RESERVED-NAME-CHAR-1 is numeric
	    unstring RESERVED-NAME delimited by space  into NEXT-COL-NO
	    perform			9430-ADJUST-OUTPUT-COLUMN
*	else If condition
	else
	    move RESERVED-VARIABLE-ERROR to CURRENT-ERROR
	    SET WSS-END-OF-LINE-SW	TO YES-VALUE
	    perform			9999-RECORD-ERROR.

9410-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 DATA2-NAME
	    MOVE DATA2			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.
	IF  SYMBOL-WORK = SPACES
	    MOVE '@'			TO SYMBOL-WORK.
*&	ELSE IF SVALU-NAME
*&	    MOVE SVALU			TO SYMBOL-WORK.
*& ETC...
	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.

9410-A.
*PARAGRAPH TO OVERCOME 24-LEVEL NESTING LIMIT ON 'IF-ELSE'.
 
9430-ADJUST-OUTPUT-COLUMN.
	set CURR-COL-NO,
	    LAST-COL-NO,
	    LAST-COMMAND-PTR		to 0.
	perform				9431-CALC-LAST-COL-NO
	    varying  WS-INDEX  from 1 by 1
	      until  WS-INDEX  =  COMMAND-PTR.
	compute COMMAND-PTR  =  LAST-COMMAND-PTR + 1.
	If  (LAST-COL-NO + 1)  >  NEXT-COL-NO
	    perform			9432-INSERT-SPACE
		varying  COMMAND-PTR  from COMMAND-PTR by 1
		  until  COMMAND-PTR  >  MAX-COMMAND-PTR
	    perform			8500-WRITE-COMMAND-LINE
	    set LAST-COL-NO		to 0
	    set COMMAND-PTR		to 1.
	If  (LAST-COL-NO + 1)  not>  NEXT-COL-NO
	    divide   NEXT-COL-NO by TAB-WIDTH	giving NEXT-TAB-NO
	    multiply NEXT-TAB-NO by TAB-WIDTH giving NO-WARNING-COMP
	    move NO-WARNING-3		TO NEXT-TAB-NO
	    perform			9433-INSERT-TAB
		varying  COMMAND-PTR  from COMMAND-PTR by 1
		  until  LAST-COL-NO  NOT<  NEXT-TAB-NO
	    perform			9432-INSERT-SPACE
		varying  COMMAND-PTR  from COMMAND-PTR by 1
		  until  LAST-COL-NO  NOT<  NEXT-COL-NO.
9431-CALC-LAST-COL-NO.
	set CURR-COL-NO			up by 1.
	If  COMMAND-CHAR (WS-INDEX)  =  WS-TAB
	    divide  CURR-COL-NO by 8	giving    TALLY
					REMAINDER FILL-COUNT
	    COMPUTE CURR-COL-NO  =  CURR-COL-NO + 8 - FILL-COUNT
	else
	If  COMMAND-CHAR (WS-INDEX)  =  SPACE
	    NEXT SENTENCE
	else
	    move WS-INDEX		to LAST-COMMAND-PTR
	    move CURR-COL-NO		to LAST-COL-NO.

9432-INSERT-SPACE.
	move SPACE			to COMMAND-CHAR (COMMAND-PTR).
	set  LAST-COL-NO		up by 1.

9433-INSERT-TAB.
	move WS-TAB			to COMMAND-CHAR (COMMAND-PTR).
	divide  LAST-COL-NO by 8	giving    TALLY
					REMAINDER FILL-COUNT
	COMPUTE LAST-COL-NO  =  LAST-COL-NO + 8 - FILL-COUNT.

9500-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.'
*&
*&DISPLAY WSS-TABLE-NAME
		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				9510-REST-OF-LOAD
		    UNTIL WSS-SEARCH-DONE.
 
9510-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.
 
9700-PROCESS-CONT-LINE.
	PERFORM				8000-READ-CTL.
	PERFORM				9710-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.
 
9710-FIND-MAX.
	PERFORM				9800-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.
 
9800-DO-NOTHING.
 
9900-LOAD-SUB-CMD-TABLE.
	SET W-SCMD-MAX-TBL		TO 0.
	MOVE SPACES			TO W-SUB-CMD-WHOLE.
*&					   W-HOLD-CMD-FLAGS.
*& ZERO FLAGS HERE OR ELSEWHERE?
	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				9910-REST-OF-LOAD
		    UNTIL WSS-SEARCH-DONE.
 
9910-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.
 
*---------------------
* 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 COMMAND-PTR.
	move CONTROL-RECORD		to COMMAND-RECORD.
	perform				8500-WRITE-COMMAND-LINE.
	move SPACE			to COMMAND-RECORD.
*&	set COMMAND-PTR		to WS-SAVE-PTR.
	COMPUTE COMMAND-PTR = (CONTROL-PTR - SAV-IDX) + 1.
	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.
*&	set SKELETON-PTR		to MAX-COMMAND-PTR.
*&	set SKELETON-PTR		up by 1.
	display 'Error # ' ERROR-NUMBER.
*&	IF  WSS-USER-LEVEL
*&	OR  (W-HCMD-END-COM = YES-VALUE
*&	AND (WSS-OPER-LEVEL))
*& AND LINE NOT CONTINUING? (-).
	MOVE 'TABLE1'		TO WSS-TABLE-NAME.
	    PERFORM			9900-LOAD-SUB-CMD-TABLE.
	    PERFORM			9500-LOAD-SUB-DIR-TABLE.
	    MOVE ZEROES			TO W-HOLD-CMD-FLAGS.
	MOVE SPACES			TO CT-TOKEN
					   CURR-CHAR
*&					   HOLD-CHAR
					   WSS-NEXT-COMMAND
					   WSS-COMMAND.
	SET CT-IDX			TO 1.
	    MOVE SPACES			TO TOKEN-DATA.