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