Google
 

Trailing-Edge - PDP-10 Archives - tops20tools_v6_9-jan-86_dumper - tools/isacon/cddict.skl
There are 5 other files named cddict.skl in the archive. Click here to see a list.
IDENTIFICATION DIVISION.
*=======================
 
/START
Program-Id.	{Modnm}.
 
Date-Written.	{%Date}.
 
Date-Compiled.
 
Installation.	Paper Free Systems, Inc.
		320 Parnassus
		San Francisco, CA  94117
 
*--------------
*Program Title:
*--------------
*
*	System: ISACON DEC to VAX Conversion
*	Module: {Modnm}.CBL -- Create {Filnm}.DDL for Common Data Dictionary
*	format
*
/END
*
*--------------------
*Standard Procedures:
*--------------------
*
*	Program Skeleton:  CDDICT.SKL	Version 1.0	Dated 08-Nov-84
*
*-----------------------------
*Program Modification History:
*-----------------------------
*	--Date--   Who	What
*
*--------------------------------------------------------
 
*	The following steps are necessary to get a clean compile:
*
*	1.  After the program is run and the .DDL is created, check
*	    the VALUE phases for any which contain 'VALUE ALL something.'
*	    These need to be converted to their actual length.  For
*	    example, a text field with the length of 6 and a 'VALUE ALL
*	    "-"' should be changed to 'VALUE "------"'.
 
*??	TO BE CONTINUED		??
 
/NOTE
	**** Constraints or Requirements of this Skeleton ****
	1.  You may NOT use the relational operator "{" (less than)
	    within /START thru /END code generation sections.  This
	    is due to our arbitrary selection of "{" as the left
	    delimiter for substitution variables.
 
	2.  In order for blank lines to be included in the generated
	    code, the "blank" line should actually consist of a single
	    space.  This is only necessary if the skeleton file is
	    "un-line-numbered" (by EDIT's "EU" command).
/END-NOTE
/PAGE
ENVIRONMENT DIVISION.
*====================
 
CONFIGURATION SECTION.
*---------------------
 
*SOURCE-COMPUTER. VAX-11.
 
*OBJECT-COMPUTER. VAX-11.
SOURCE-COMPUTER. DECSYSTEM-10.
OBJECT-COMPUTER. DECSYSTEM-10.
 
 
INPUT-OUTPUT SECTION.
*--------------------
 
FILE-CONTROL.
 
/START
SELECT			D-{Modtl}
*	ASSIGN TO 	"{Filnm}.DDL"
	ASSIGN TO	DSK
	ORGANIZATION IS	SEQUENTIAL.
/END
/PAGE
DATA DIVISION.
*=============
 
FILE SECTION.
*------------
 
/START
FD	D-{Modtl}
*
	VALUE OF ID IS WSS-FILE-ID
	BLOCK CONTAINS 0	RECORDS.
 
*01	DICT-RECORD			PIC X(80)	DISPLAY.
01	DICT-RECORD			PIC X(80)	DISPLAY-7.
*01	DICT-2						DISPLAY.
01	DICT-2						DISPLAY-7.
	05  DICT-VAR			PIC X(01)	OCCURS 1 TO 80
					DEPENDING ON	VAR-IDX.
/END
/PAGE
WORKING-STORAGE SECTION.
*-----------------------
 
01	WSS-ERROR-FLAG			PIC S9(01) COMP.
	88  WSS-ERROR			VALUE 1.
 
01	YES-NO-VALUES.
	05  YES-VALUE			PIC S9(01) COMP VALUE 1.
	05  NO-VALUE			PIC S9(01) COMP VALUE 0.
 
01	WSS-LEVELS.
	05  WSS-CURR-LVL		PIC  9(02).
	05  WSS-PREV-LVL		PIC  9(02) VALUE 0.
 
01	COMMAND-STACK			OCCURS 20
					INDEXED BY CMD-IDX.
	05  COM-LVL			PIC  9(02).
	05  COM-VAR			PIC  X(01).
	05  COM-DATA			PIC X(80).
 
01	WSS-COMMAND			PIC X(80).
 
01	DICT-PTR			PIC  S9(10) COMP.
 
01	WSS-FIELD-NAMES.
	05  WSS-DDL-NAME		PIC  X(30).
	05  WSS-COBOL-NAME		PIC  X(30).
 
01	WSS-POP-FINISHED		PIC S9(01) COMP.
	88  WSS-POP-DONE		VALUE 1.
 
01	WSS-RECORD-NAME			PIC  X(40).
 
01	WSS-LINE-PTR			PIC  9(03).
01	WSS-HOLD-PTR			PIC  9(03)  VALUE 1.
01	WSS-INDENT			PIC  9(02)  VALUE 28.
01	WSS-INDENT-4			PIC  9(02)  VALUE 32.
 
01	WSS-PICTURE-FIELDS.
	05  WSS-PICTURE			PIC X(30).
	05  WSS-PIC			REDEFINES
	    WSS-PICTURE			PIC X(01)
					OCCURS 30
					INDEXED BY PIC-IDX.
	05  WSS-PIC-PTR			PIC  9(02).
	05  WSS-HOLD-PIC		PIC  X(30).
	05  WSS-HOLD-PIC1		PIC  X(30).
	05  WSS-HOLD-PIC2		PIC  X(30).
	05  WSS-PIC-COUNT		PIC  9(02).
	05  WSS-PIC-DELIM		PIC  X(01).
	05  WSS-PIC-SIZE		PIC S9(03).
	05  WSS-DECIM-SIZE		PIC  9(03).
	05  WSS-PIC-DISP		PIC  ZZ9.
	05  WSS-HOLD-NUM		PIC  9(03).
	05  TALLY			PIC S9(10) COMP.
 
01	WSS-COUNTERS.
	05  WSS-88-COUNT		PIC  9(03).
	05  WSS-88-TOTAL		PIC  9(03).
 
01	WSS-VARIANT-FIELDS.
	05  WSS-VAR-SW			PIC S9(01).
	    88	WSS-VARIANT		VALUE 1.
	05  WSS-VAR-END-SW		PIC S9(01).
	    88	WSS-VAR-END		VALUE 1.
	05  WSS-VAR-LVL			PIC  9(02).
	05  WSS-VAR-NAME.
	    10	FILLER			PIC  X(01) VALUE 'V'.
	    10	WSS-VAR-FIELD		PIC  X(30).
 
01	VAR-IDX				USAGE INDEX.
 
01	WSS-AT-ELEM-LVL-FLAG		PIC S9(01)	VALUE 0.
	88  WSS-AT-ELEM-LVL		VALUE 1.
/START
 
01	WSS-FILE-ID.
	05  WSS-FILE-NAME		PIC X(06)	VALUE "{Filnm}".
	05  WSS-FILE-EXT		PIC X(03)	VALUE "DDL".
/END
/PAGE
PROCEDURE DIVISION.
 
0000-MAIN.
	PERFORM				0100-INITIALIZE.
	PERFORM				0200-CREATE-DDL.
	PERFORM				0300-TERMINATE.
	STOP RUN.
 
/START
0100-INITIALIZE.
	OPEN	OUTPUT	D-{Modtl}.
 
0200-CREATE-DDL.
/EACH-FIELD
/IF-NOT {Fldno} = 00
/IF-NOT {Fldno} = 66
/IF-NOT {Fldno} = 88
	MOVE {Fldno}			{%40}TO WSS-CURR-LVL.
/END-IF
	MOVE '{Field}'			{%40}TO WSS-DDL-NAME
					   WSS-COBOL-NAME.
	INSPECT WSS-DDL-NAME REPLACING
	    ALL '-'			BY '_'.
/IF {Fldno} = 01
	STRING 'DEFINE RECORD '		DELIMITED BY SIZE
	    WSS-DDL-NAME		DELIMITED BY SPACE
	    '.'				DELIMITED BY SIZE
	    INTO			DICT-RECORD
	PERFORM				8500-WRITE-DICT
	MOVE WSS-DDL-NAME		TO WSS-RECORD-NAME.
/END-IF
/IF-NOT {Fldno} = 88
	MOVE 0				TO WSS-88-COUNT.
/NOTE
* INDICATES HOW MANY 88 LEVELS THERE ARE...
/END-NOTE
/IF-NOT {Fvalu} = NONE
	MOVE {Fvalu}			{%40}TO WSS-88-TOTAL.
/ELSE
	MOVE 0				TO WSS-88-TOTAL.
/END-IF
/IF {Isrdf} = YES
	IF  WSS-VARIANT
	    IF	WSS-CURR-LVL NOT > WSS-VAR-LVL
		SET WSS-VAR-END-SW	TO YES-VALUE
		MOVE WSS-CURR-LVL	TO WSS-VAR-LVL
		MOVE WSS-DDL-NAME	{%40}TO WSS-VAR-FIELD
	    ELSE
		NEXT SENTENCE
	ELSE
	    SET WSS-VAR-SW		TO YES-VALUE
	    MOVE WSS-CURR-LVL		TO WSS-VAR-LVL
	    MOVE WSS-DDL-NAME		{%40}TO WSS-VAR-FIELD.
/ELSE
/IF {Redef} = NONE
	IF  (WSS-CURR-LVL NOT > WSS-VAR-LVL)
	AND WSS-VARIANT
	    SET WSS-VAR-END-SW		TO YES-VALUE
	    SET WSS-VAR-SW		TO NO-VALUE
	    MOVE SPACES			TO WSS-VAR-FIELD
	    SET WSS-VAR-SW		TO NO-VALUE.
/END-IF
/END-IF
	PERFORM				0250-POP-CK.
/IF {Isrdf} = YES
	PERFORM				0290-INIT-VAR.
/END-IF
	PERFORM				0260-CK-VAR.
/END-IF
/IF {Pict} = NONE
/IF {Fldno} = 88
	ADD 1				TO WSS-88-COUNT.
	IF  WSS-AT-ELEM-LVL
	    MOVE WSS-INDENT		TO WSS-LINE-PTR
	    STRING 'CONDITION FOR COBOL IS ' DELIMITED BY SIZE
		WSS-DDL-NAME		DELIMITED BY SIZE
		INTO			DICT-RECORD
		WITH POINTER		WSS-LINE-PTR
	    PERFORM			8500-WRITE-DICT
	    MOVE WSS-INDENT-4		TO WSS-LINE-PTR
	    STRING 'COBOL NAME IS "'	DELIMITED BY SIZE
		WSS-COBOL-NAME		DELIMITED BY SPACE
		'"'			DELIMITED BY SIZE
		INTO			DICT-RECORD
		WITH POINTER		WSS-LINE-PTR
	    PERFORM			8500-WRITE-DICT
	    MOVE WSS-INDENT-4		TO WSS-LINE-PTR
	    STRING 'VALUE '		DELIMITED BY SIZE
/IF {Fdlmt} = '
		"{Fvalu}"		{%40}DELIMITED BY SIZE
/ELSE
		'{Fvalu}'		{%40}DELIMITED BY SIZE
/END-IF
		INTO			DICT-RECORD
		WITH POINTER		WSS-LINE-PTR
	    IF WSS-88-TOTAL = WSS-88-COUNT
		STRING '.'		DELIMITED BY SIZE
		INTO			DICT-RECORD
		WITH POINTER		WSS-LINE-PTR
		PERFORM			8500-WRITE-DICT
	    ELSE
		PERFORM			8500-WRITE-DICT.
/ELSE
	IF  WSS-AT-ELEM-LVL
	    SET WSS-AT-ELEM-LVL-FLAG	TO NO-VALUE.
	MOVE WSS-HOLD-PTR		TO WSS-LINE-PTR.
	STRING WSS-DDL-NAME		DELIMITED BY SPACE
	    ' STRUCTURE'		DELIMITED BY SIZE
/IF-NOT {Focur} = NONE
	    ' OCCURS '			DELIMITED BY SIZE
	    '{Focur} TIMES.'		{%40}DELIMITED BY SIZE
/ELSE
	    '.'				DELIMITED BY SIZE
/END-IF
					INTO DICT-RECORD
	    WITH POINTER		WSS-LINE-PTR.
	PERFORM				8500-WRITE-DICT.
	MOVE WSS-HOLD-PTR		TO WSS-LINE-PTR.
	STRING 'END '			DELIMITED BY SIZE
	    WSS-DDL-NAME		DELIMITED BY SPACE
	    ' STRUCTURE.'		DELIMITED BY SIZE
	    INTO			WSS-COMMAND
	    WITH POINTER		WSS-LINE-PTR.
	PERFORM				1000-PUSH-COMMAND.
/END-IF
/END-IF
/IF-NOT {Pict} = NONE
	IF  NOT WSS-AT-ELEM-LVL
	    SET WSS-AT-ELEM-LVL-FLAG	TO YES-VALUE.
	MOVE WSS-HOLD-PTR		TO WSS-LINE-PTR.
	STRING WSS-DDL-NAME		DELIMITED BY SPACE
					INTO DICT-RECORD
	    WITH POINTER		WSS-LINE-PTR.
	PERFORM				8500-WRITE-DICT.
/IF-NOT {Focur} = NONE
	MOVE WSS-INDENT			TO WSS-LINE-PTR.
	STRING 'OCCURS '		DELIMITED BY SIZE
	'{Focur} TIMES'			{%40}DELIMITED  BY SIZE
					INTO DICT-RECORD
	    WITH POINTER		WSS-LINE-PTR.
	PERFORM				8500-WRITE-DICT.
/END-IF
	MOVE '{Pict}'			{%40}TO WSS-PICTURE.
	PERFORM				0280-PIC-CK.
	IF TALLY = 0
/IF {Usige} = DISPLAY
/IF {Fsign} = TRAILING
/IF {Fsep} = SEPARATE
		STRING 'RIGHT SEPARATE NUMERIC'	DELIMITED BY SIZE
					INTO DICT-RECORD
		    WITH POINTER	WSS-LINE-PTR
		PERFORM			8500-WRITE-DICT
		PERFORM			0225-NUM-SIZE
		PERFORM			0230-NUM-PRINT
/ELSE
		STRING 'RIGHT OVERPUNCHED NUMERIC'	DELIMITED BY SIZE
					INTO DICT-RECORD
		    WITH POINTER	WSS-LINE-PTR
		PERFORM			8500-WRITE-DICT
		PERFORM			0225-NUM-SIZE
		PERFORM			0230-NUM-PRINT
/END-IF
/END-IF
/IF {Fsign} = LEADING
/IF {Fsep} = SEPARATE
		STRING 'LEFT SEPARATE NUMERIC'	DELIMITED BY SIZE
					INTO DICT-RECORD
		    WITH POINTER	WSS-LINE-PTR
		PERFORM			8500-WRITE-DICT
		PERFORM			0225-NUM-SIZE
		PERFORM			0230-NUM-PRINT
/ELSE
		STRING 'LEFT OVERPUNCHED NUMERIC'	DELIMITED BY SIZE
					INTO DICT-RECORD
		    WITH POINTER	WSS-LINE-PTR
		PERFORM			8500-WRITE-DICT
		PERFORM			0225-NUM-SIZE
		PERFORM			0230-NUM-PRINT
/END-IF
/END-IF
/IF {Fsign} = NONE
	    MOVE 0			TO TALLY
	    INSPECT WSS-PICTURE
		TALLYING TALLY FOR ALL 'S'
	    IF TALLY > 0
		STRING 'RIGHT OVERPUNCHED NUMERIC'	DELIMITED BY SIZE
					INTO DICT-RECORD
		    WITH POINTER	WSS-LINE-PTR
		PERFORM			8500-WRITE-DICT
		PERFORM			0225-NUM-SIZE
		PERFORM			0230-NUM-PRINT
	    ELSE
		STRING 'UNSIGNED NUMERIC'	DELIMITED BY SIZE
					INTO DICT-RECORD
		    WITH POINTER	WSS-LINE-PTR
		PERFORM			8500-WRITE-DICT
		PERFORM			0225-NUM-SIZE
		PERFORM			0230-NUM-PRINT.
/END-IF
/END-IF
/IF {Usige} = COMP-1
	    STRING 'F_FLOATING'		DELIMITED BY SIZE
		INTO			DICT-RECORD
		WITH POINTER		WSS-LINE-PTR
	    PERFORM			8500-WRITE-DICT.
/END-IF
/IF {Usige} = COMP-3
	    STRING 'PACKED DECIMAL'	DELIMITED BY SIZE
		INTO			DICT-RECORD
		WITH POINTER		WSS-LINE-PTR
	    PERFORM			8500-WRITE-DICT
	    PERFORM			0225-NUM-SIZE
	    PERFORM			0230-NUM-PRINT.
/END-IF
/IF {Usige} = INDEX
	    STRING 'SIGNED LONGWORD'	DELIMITED BY SIZE
		INTO			DICT-RECORD
		WITH POINTER		WSS-LINE-PTR
	    PERFORM			8500-WRITE-DICT
	    PERFORM			0225-NUM-SIZE
	    PERFORM			0230-NUM-PRINT.
/END-IF
/IF {Usige} = COMP
	    PERFORM			0220-PROCESS-COMP.
/END-IF
	MOVE '{Pict}'			TO WSS-PICTURE.
	PERFORM				0270-MISC-PICT.
/END-IF
/IF-NOT {Fldno} = 88
	MOVE WSS-CURR-LVL		TO WSS-PREV-LVL.
/END-IF
/END-IF
/END-IF
/END-FIELD
	SET WSS-VAR-END-SW		TO YES-VALUE.
	SET WSS-CURR-LVL		TO 0.
	IF CMD-IDX > 0
	    SET WSS-POP-FINISHED	TO NO-VALUE
	    PERFORM 1100-POP-COMMAND	CMD-IDX TIMES.
	STRING 'END '			DELIMITED BY SIZE
	    WSS-RECORD-NAME		DELIMITED BY SPACE
	    ' RECORD.'			DELIMITED BY SIZE
	    INTO			DICT-RECORD.
	PERFORM				8500-WRITE-DICT.
 
0210-TEXT-SIZE.
	MOVE 0				TO TALLY.
	INSPECT WSS-PICTURE
	    TALLYING TALLY		FOR CHARACTERS
	    BEFORE INITIAL SPACE.
	MOVE 1				TO WSS-PIC-PTR.
	PERFORM				0295-UNSTRING-PIC
	    UNTIL WSS-PIC-PTR > TALLY.
 
0220-PROCESS-COMP.
	MOVE 0				TO TALLY.
	INSPECT WSS-PICTURE
	    TALLYING TALLY FOR ALL 'S'.
	IF  TALLY = 0
	    STRING 'UN'			DELIMITED BY SIZE
		INTO			DICT-RECORD
		WITH POINTER		WSS-LINE-PTR.
	PERFORM				0225-NUM-SIZE.
	IF  WSS-PIC-SIZE < 5
	    STRING 'SIGNED WORD'	DELIMITED BY SIZE
		INTO			DICT-RECORD
		WITH POINTER		WSS-LINE-PTR
	ELSE
	IF  WSS-PIC-SIZE < 10
	    STRING 'SIGNED LONGWORD'	DELIMITED BY SIZE
		INTO			DICT-RECORD
		WITH POINTER		WSS-LINE-PTR
	ELSE
	    STRING 'SIGNED QUADWORD'	DELIMITED BY SIZE
		INTO			DICT-RECORD
		WITH POINTER		WSS-LINE-PTR.
	PERFORM				8500-WRITE-DICT.
	PERFORM				0230-NUM-PRINT.
 
0225-NUM-SIZE.
	MOVE ZEROES			TO WSS-PIC-SIZE
					   WSS-DECIM-SIZE.
	MOVE SPACES			TO WSS-HOLD-PIC
					   WSS-HOLD-PIC1
					   WSS-HOLD-PIC2.
	UNSTRING WSS-PICTURE
	    DELIMITED BY 'V'		INTO WSS-HOLD-PIC1
					     WSS-HOLD-PIC2.
	IF  WSS-HOLD-PIC2 NOT = SPACES
	    MOVE WSS-HOLD-PIC2		TO WSS-PICTURE
	    MOVE 0			TO TALLY
	    INSPECT WSS-PICTURE
		TALLYING TALLY		FOR CHARACTERS
		BEFORE INITIAL SPACE
	    MOVE 1			TO WSS-PIC-PTR
	    PERFORM			0295-UNSTRING-PIC
		UNTIL WSS-PIC-PTR > TALLY
	    MOVE WSS-PIC-SIZE		TO WSS-DECIM-SIZE.
	MOVE 0				TO TALLY.
	MOVE WSS-HOLD-PIC1		TO WSS-PICTURE.
	INSPECT WSS-PICTURE
	    TALLYING TALLY FOR ALL 'S'.
	IF  TALLY > 0
	    SUBTRACT 1			FROM WSS-PIC-SIZE.
	MOVE 0				TO TALLY.
	INSPECT WSS-PICTURE
	    TALLYING TALLY		FOR CHARACTERS
	    BEFORE INITIAL SPACE.
	MOVE 1				TO WSS-PIC-PTR.
	PERFORM				0295-UNSTRING-PIC
	    UNTIL WSS-PIC-PTR > TALLY.
	MOVE WSS-PIC-SIZE		TO WSS-PIC-DISP.
 
0230-NUM-PRINT.
	MOVE WSS-INDENT			TO WSS-LINE-PTR.
	STRING 'SIZE IS '		DELIMITED BY SIZE
	    WSS-PIC-DISP		DELIMITED BY SIZE
	    ' DIGIT'			DELIMITED BY SIZE
	    INTO			DICT-RECORD
	    WITH POINTER		WSS-LINE-PTR.
	IF  WSS-PIC-SIZE > 1
	    STRING 'S'			DELIMITED BY SIZE
		INTO			DICT-RECORD
		WITH POINTER		WSS-LINE-PTR.
	IF  WSS-DECIM-SIZE > 0
	    MOVE WSS-DECIM-SIZE		TO WSS-PIC-DISP
	    STRING ' ' WSS-PIC-DISP	DELIMITED BY SIZE
		' FRACTION'		DELIMITED BY SIZE
		INTO			DICT-RECORD
		WITH POINTER		WSS-LINE-PTR
	    IF	WSS-DECIM-SIZE > 1
		STRING 'S'		DELIMITED BY SIZE
		    INTO		DICT-RECORD
		    WITH POINTER	WSS-LINE-PTR.
	PERFORM				8500-WRITE-DICT.
 
0250-POP-CK.
	IF WSS-CURR-LVL NOT > WSS-PREV-LVL
	    SET WSS-POP-FINISHED	TO NO-VALUE
	    PERFORM			1100-POP-COMMAND
		UNTIL WSS-POP-DONE
	ELSE IF WSS-HOLD-PTR > 1
	    COMPUTE WSS-HOLD-PTR = WSS-HOLD-PTR + 4
	ELSE
	    COMPUTE WSS-HOLD-PTR = WSS-HOLD-PTR + 3.
	SET WSS-VAR-END-SW		TO NO-VALUE.
 
0260-CK-VAR.
	IF  WSS-VARIANT
	AND WSS-CURR-LVL = WSS-VAR-LVL
	    MOVE WSS-HOLD-PTR		TO WSS-LINE-PTR
	    STRING 'VARIANT.'		DELIMITED BY SIZE
		INTO			DICT-RECORD
		WITH POINTER		WSS-LINE-PTR
	    PERFORM			8500-WRITE-DICT
	    MOVE WSS-HOLD-PTR		TO WSS-LINE-PTR
	    STRING 'END VARIANT.'	DELIMITED BY SIZE
		INTO			WSS-COMMAND
		WITH POINTER		WSS-LINE-PTR
	    PERFORM			1000-PUSH-COMMAND
	    ADD 4			TO WSS-HOLD-PTR.
 
0270-MISC-PICT.
	MOVE WSS-INDENT			TO WSS-LINE-PTR.
	STRING 'NAME FOR COBOL IS "'	DELIMITED BY SIZE
	    WSS-COBOL-NAME		DELIMITED BY SPACE
	    '"'				DELIMITED BY SIZE
	    INTO			DICT-RECORD
	    WITH POINTER		WSS-LINE-PTR.
	PERFORM				8500-WRITE-DICT.
	MOVE WSS-INDENT			TO WSS-LINE-PTR.
	STRING 'PICTURE FOR COBOL IS "'	DELIMITED BY SIZE
	    WSS-PICTURE			DELIMITED BY SPACE
	    '"'				DELIMITED BY SIZE
	    INTO			DICT-RECORD
	    WITH POINTER		WSS-LINE-PTR.
	IF  WSS-88-TOTAL = 0
	    STRING '.'			DELIMITED BY SIZE
	    INTO			DICT-RECORD
	    WITH POINTER		WSS-LINE-PTR.
	PERFORM				8500-WRITE-DICT.
 
0280-PIC-CK.
	MOVE ZERO			TO WSS-PIC-SIZE
					   WSS-PIC-DISP.
	MOVE WSS-INDENT			TO WSS-LINE-PTR.
	STRING 'DATATYPE IS '		DELIMITED BY SIZE
					INTO DICT-RECORD
	    WITH POINTER		WSS-LINE-PTR.
	MOVE 0				TO TALLY.
	INSPECT WSS-PICTURE
	    TALLYING TALLY FOR ALL 'X'
		TALLY FOR ALL 'A'.
	IF TALLY > 0
	    STRING 'TEXT'		DELIMITED BY SIZE
					INTO DICT-RECORD
	    WITH POINTER		WSS-LINE-PTR
	    PERFORM			8500-WRITE-DICT
	    PERFORM			0210-TEXT-SIZE
	    MOVE WSS-PIC-SIZE		TO WSS-PIC-DISP
	    MOVE WSS-INDENT		TO WSS-LINE-PTR
	    STRING 'SIZE IS '		DELIMITED BY SIZE
		WSS-PIC-DISP		DELIMITED BY SIZE
					INTO DICT-RECORD
		WITH POINTER		WSS-LINE-PTR
	    PERFORM			8500-WRITE-DICT.
 
0290-INIT-VAR.
	IF  WSS-CURR-LVL = WSS-VAR-LVL
	    MOVE WSS-HOLD-PTR		TO WSS-LINE-PTR
	    STRING WSS-VAR-NAME		DELIMITED BY SPACE
		' STRUCTURE.'		DELIMITED BY SIZE
		INTO			DICT-RECORD
		WITH POINTER		WSS-LINE-PTR
	    PERFORM			8500-WRITE-DICT
	    MOVE WSS-HOLD-PTR		TO WSS-LINE-PTR
	    STRING 'END '		DELIMITED BY SIZE
		WSS-VAR-NAME		DELIMITED BY SPACE
		' STRUCTURE.'		DELIMITED BY SIZE
		INTO			WSS-COMMAND
		WITH POINTER		WSS-LINE-PTR
	    MOVE 'V'			TO COM-VAR(CMD-IDX + 1)
	    PERFORM			1000-PUSH-COMMAND
	    ADD 4			TO WSS-HOLD-PTR
	    MOVE WSS-HOLD-PTR		TO WSS-LINE-PTR
	    STRING 'VARIANTS.'		DELIMITED BY SIZE
		INTO			DICT-RECORD
		WITH POINTER		WSS-LINE-PTR
	    PERFORM			8500-WRITE-DICT
	    MOVE WSS-HOLD-PTR		TO WSS-LINE-PTR
	    STRING 'END VARIANTS.'	DELIMITED BY SIZE
		INTO			WSS-COMMAND
		WITH POINTER		WSS-LINE-PTR
	    MOVE 'V'			TO COM-VAR(CMD-IDX + 1)
	    PERFORM			1000-PUSH-COMMAND
	    ADD 4			TO WSS-HOLD-PTR.
 
0295-UNSTRING-PIC.
	MOVE SPACES			TO WSS-HOLD-PIC.
	UNSTRING WSS-PICTURE
	    DELIMITED BY '(' OR SPACE	INTO WSS-HOLD-PIC
	    DELIMITER			IN WSS-PIC-DELIM
	    COUNT			IN WSS-PIC-COUNT
	    WITH POINTER		WSS-PIC-PTR.
	IF  WSS-PIC-DELIM = SPACES
	    ADD WSS-PIC-COUNT		TO WSS-PIC-SIZE
	ELSE
	    SUBTRACT 1			FROM WSS-PIC-COUNT
	    ADD WSS-PIC-COUNT		TO WSS-PIC-SIZE
	    PERFORM			0299-STRIP-PARENS.
 
0299-STRIP-PARENS.
	MOVE ZEROES			TO WSS-HOLD-NUM.
	UNSTRING WSS-PICTURE
	    DELIMITED BY ')' OR SPACE	INTO WSS-HOLD-NUM
	    WITH POINTER		WSS-PIC-PTR.
	ADD WSS-HOLD-NUM		TO WSS-PIC-SIZE.
 
0300-TERMINATE.
	CLOSE	D-{Modtl}.
 
1000-PUSH-COMMAND.
	SET CMD-IDX UP			BY 1.
	MOVE WSS-CURR-LVL		TO COM-LVL(CMD-IDX).
	MOVE WSS-COMMAND		TO COM-DATA(CMD-IDX).
	MOVE SPACES			TO WSS-COMMAND.
 
1100-POP-COMMAND.
	IF  COM-LVL(CMD-IDX) < WSS-CURR-LVL
	    SET WSS-POP-FINISHED	TO YES-VALUE
	ELSE IF COM-VAR(CMD-IDX) = 'V' AND (NOT WSS-VAR-END)
	    SET WSS-POP-FINISHED	TO YES-VALUE
	ELSE IF WSS-HOLD-PTR > 4
	    COMPUTE WSS-HOLD-PTR = WSS-HOLD-PTR - 4
	ELSE
	    COMPUTE WSS-HOLD-PTR = WSS-HOLD-PTR - 3.
	IF COM-LVL(CMD-IDX) NOT < WSS-CURR-LVL
	AND (NOT WSS-POP-DONE)
	    MOVE COM-DATA(CMD-IDX)	TO DICT-RECORD
	    PERFORM			8500-WRITE-DICT
	    MOVE SPACE			TO COM-VAR(CMD-IDX)
	    IF	CMD-IDX = 1
		SET WSS-POP-FINISHED	TO YES-VALUE
	    ELSE
		SET CMD-IDX DOWN	BY 1
		IF  COM-LVL(CMD-IDX) < WSS-CURR-LVL
		    SET WSS-POP-FINISHED	TO YES-VALUE.
 
8500-WRITE-DICT.
	PERFORM				9999-DO-NOTHING
	    VARYING VAR-IDX		FROM 80 BY -1
	    UNTIL DICT-VAR(VAR-IDX) NOT = SPACE
	    OR VAR-IDX = 1.
	WRITE DICT-2			BEFORE ADVANCING 1.
	MOVE SPACES TO DICT-RECORD.
 
9999-DO-NOTHING.
/END