Trailing-Edge
-
PDP-10 Archives
-
BB-H548C-BM
-
iql-source/iqa.cbl
There are 2 other files named iqa.cbl in the archive. Click here to see a list.
000100 IDENTIFICATION DIVISION.
000120 PROGRAM-ID. IQA.
000140 DATE-WRITTEN. 1978.
000160 DATE-COMPILED.
000180 SECURITY. COPYRIGHT 1981 AZREX INC.
000200 REMARKS. IQA CRACKS THE QUERY STATEMENTS; IT PREPARES
000220 EXECUTION TABLES WHICH ARE PASSED ON TO THE
000240 EXECUTION PHASE (IQE);
000260 THIS VERSION CONTAINS THE SUMMARY TRIPLE (PRIOR
000280 BREAK VALUE) LOGIC; IT PASSES INFORMATION ASSUMING
000300 IQE IS GOING TO PROCESS INTO/FROM A COMPOSITE
000320 WORKING STORAGE BUFFER ONLY FOR HOLD,SET ALPHA-VAR,
000340 AND PRIOR-SUMMARY VALUES--OTHERWISE, IQE IS GOING
000360 TO PROCESS INTO/FROM INDIVIDUAL I/O BUFFERS.
000380
000400 ENVIRONMENT DIVISION.
000420 CONFIGURATION SECTION.
000440 SOURCE-COMPUTER. DECSYSTEM-20.
000460 OBJECT-COMPUTER. DECSYSTEM-20.
000480 SPECIAL-NAMES. CHANNEL (1) IS TOP-OF-PAGE
000500 CONSOLE IS TTY.
000520
000540 INPUT-OUTPUT SECTION.
000560 FILE-CONTROL.
000580 SELECT QCSTMT ASSIGN TO DSK.
000600 SELECT QPDICT ASSIGN TO DSK.
000620 SELECT QTANLZ ASSIGN TO DSK.
000640 I-O-CONTROL.
000660* SAME AREA FOR QCSTMT QPDICT QTANLZ.
000680
000700 DATA DIVISION.
000720 FILE SECTION.
000740 FD QCSTMT
000760 VALUE OF IDENTIFICATION IS QCSTMTTMP
000780 LABEL RECORDS ARE STANDARD BLOCK CONTAINS 0 RECORDS
000800 DATA RECORD IS QCSTMT-REC.
000820 01 QCSTMT-REC USAGE IS DISPLAY-7.
000840 02 FILLER PICTURE X(80).
000860 FD QPDICT
000880 VALUE OF IDENTIFICATION IS 'QPDICTSEQ'
000900 LABEL RECORDS ARE STANDARD BLOCK CONTAINS 0 RECORDS
000920 DATA RECORD IS QPDICT-REC.
000940 01 QPDICT-REC USAGE IS DISPLAY-7.
000960 05 FILLER PICTURE X(150).
000980 FD QTANLZ
001000 VALUE OF IDENTIFICATION IS QTANLZTMP
001020 LABEL RECORDS ARE STANDARD BLOCK CONTAINS 0 RECORDS
001040 DATA RECORD IS QTANLZ-REC.
001060 01 QTANLZ-REC PICTURE X(90).
001080 WORKING-STORAGE SECTION.
000000*
000000 01 COPYRIGHT-NOTICE PIC X(50) VALUE
000000 "COPYRIGHT 1981 - AZREX, INC. - ALL RIGHTS RESERVED".
000000*
001090
001094 01 UNIVERSAL-PASSWORD PICTURE X(6) VALUE 'DRAGON'.
001098
001100 01 ALPHA-VAR-SPELLING PICTURE X(01) VALUE 'A'.
001120 01 CHAR PICTURE X(01) VALUE SPACE.
001140 01 CURR-BUCKETDX PICTURE S9(05) COMP VALUE ZERO.
001160 01 CURR-OPERAND PICTURE S9(05) COMP VALUE ZERO.
001180 01 CURR-OPERATOR PICTURE S9(05) COMP VALUE ZERO.
001200 01 CURR-PRECEDENCE PICTURE S9(05) COMP VALUE ZERO.
001220 01 DELTA PICTURE S9(05) COMP.
001240 01 DEVICER PICTURE X(06) VALUE SPACE.
001260 01 DX-IFLEFTSIDE PICTURE S9(05) COMP VALUE ZEROS.
001280 01 DX-LOWEST PICTURE S9(05) COMP VALUE ZEROS.
001300 01 DX-MAX PICTURE S9(05) COMP VALUE 200.
001320 01 DX-SAVE PICTURE S9(05) COMP.
001340 01 ECHAR PICTURE S9(05) COMP VALUE ZEROS.
001360 01 ECODE PICTURE S9(03) COMP VALUE ZEROS.
001362 88 WARNING-CODE VALUES ARE 54 55.
001380 01 EFF-PASSWORD PICTURE X(06) VALUE SPACE.
001400 01 ELSE-X PICTURE S9(05) COMP VALUE ZERO.
001420 01 EOQ PICTURE S9(01) COMP VALUE ZERO.
001440 01 FCHAR PICTURE S9(05) COMP VALUE ZEROS.
001450 01 FD-BLKSIZE-L PICTURE S9(05).
001460 01 FILENO PICTURE S9(05) COMP.
001480 01 FILETYPE PICTURE S9(05) COMP VALUE ZEROS.
001500 01 FIRST-PASSWORD PICTURE X(06) VALUE SPACES.
001520 01 FLAG-ACCUM PICTURE S9(01) COMP VALUE ZERO.
001530 01 flag-all-blank-line picture s9(01) comp value 1.
001540 01 FLAG-ALPHA PICTURE S9(01) COMP VALUE ZERO.
001560 01 FLAG-BAD-CHAR PICTURE S9(01) COMP VALUE ZERO.
001580 01 FLAG-BY PICTURE S9(01) COMP VALUE ZERO.
001590 01 FLAG-COMMENT PICTURE S9(01) COMP VALUE ZERO.
001600 01 FLAG-COMPUTE PICTURE S9(01) COMP VALUE ZERO.
001620 01 FLAG-CONTINUE PICTURE S9(01) COMP VALUE ZERO.
001640 01 FLAG-COPY PICTURE S9(01) COMP VALUE ZERO.
001660 01 FLAG-CREATE PICTURE S9(01) COMP VALUE ZERO.
001680 01 FLAG-CREATE-LOOP PICTURE S9(01) COMP VALUE ZERO.
001700 01 FLAG-DECIMAL PICTURE S9(01) COMP VALUE ZERO.
001720 01 FLAG-DEV-LBL-PPN PICTURE S9(01) COMP VALUE ZERO.
001740 01 FLAG-EOS PICTURE S9(01) COMP VALUE ZERO.
001760 01 FLAG-EOS2 PICTURE S9(01) COMP VALUE ZERO.
001780 01 FLAG-ERROR PICTURE S9(01) COMP VALUE ZERO.
001800 01 FLAG-EXIT PICTURE S9(01) COMP VALUE ZERO.
001820 01 FLAG-FIRST-PD PICTURE S9(01) COMP VALUE ZERO.
001840 01 FLAG-FD-FOUND PICTURE S9(01) COMP VALUE ZERO.
001850 01 FLAG-FIND PICTURE S9(01) COMP VALUE ZERO.
001855 01 FLAG-FINDFINI PICTURE S9(01) COMP VALUE ZERO.
001860 01 FLAG-DD-FOUND PICTURE S9(01) COMP VALUE ZERO.
001880 01 FLAG-IF PICTURE S9(01) COMP VALUE ZERO.
001890 01 flag-if-statement picture s9(01) comp value zero.
001900 01 FLAG-IFFIRST PICTURE S9(01) COMP VALUE ZERO.
001920 01 FLAG-GOTO PICTURE S9(01) COMP VALUE ZERO.
001940 01 FLAG-LBL-ERROR PICTURE S9(01) COMP VALUE ZERO.
001960 01 FLAG-LEFTLIT PICTURE S9(01) COMP VALUE ZERO.
001970 01 FLAG-LITERAL PICTURE S9(01) COMP VALUE ZERO.
001980 01 FLAG-LOCKED PICTURE S9(01) COMP VALUE ZERO.
001990 01 FLAG-NON-VERB PICTURE S9(01) COMP VALUE ZERO.
002000 01 FLAG-NOT PICTURE S9(01) COMP VALUE ZERO.
002020 01 FLAG-OPENARGS PICTURE S9(01) COMP VALUE ZERO.
002040 01 FLAG-PASS PICTURE S9(01) COMP VALUE 1.
002060 01 FLAG-PEEKED PICTURE S9(01) COMP VALUE 0.
002062 01 FLAG-PW-ITEM PICTURE S9(01) COMP VALUE 0.
002064 01 FLAG-PW-OPEN PICTURE S9(01) COMP VALUE 0.
002080 01 FLAG-QUERY PICTURE S9(01) COMP VALUE ZERO.
002100 01 FLAG-QUOTE PICTURE S9(01) COMP VALUE ZERO.
002120 01 FLAG-RANDOM-READ1 PICTURE S9(01) COMP VALUE ZERO.
002140 01 FLAG-RANDOM-READ2 PICTURE S9(01) COMP VALUE ZERO.
002160 01 FLAG-RANDOM-READ3 PICTURE S9(01) COMP VALUE ZERO.
002170 01 FLAG-SET-TO-COME PICTURE S9(01) COMP VALUE ZERO.
002180 01 FLAG-SIGN PICTURE S9(01) COMP VALUE ZERO.
002200 01 FLAG-SLASHES PICTURE S9(01) COMP VALUE ZERO.
002220 01 FLAG-SORT PICTURE S9(01) COMP VALUE ZERO.
002240 01 FLAG-STATEMENT-NO PICTURE S9(01) COMP VALUE ZERO.
002260 01 FLAG-SUMMARY-DEF-TIME PICTURE S9(01) COMP VALUE ZERO.
002280 01 FLAG-VERB PICTURE S9(01) COMP VALUE ZERO.
002300 01 HX PICTURE S9(05) COMP VALUE ZEROS.
002320 01 I PICTURE S9(05) COMP VALUE ZEROS.
002340 01 LI-MAX PICTURE S9(05) COMP VALUE 15.
002360 01 J PICTURE S9(05) COMP VALUE ZEROS.
002380 01 JOB-NO PICTURE S9(03) COMP VALUE 001.
002400 01 K PICTURE S9(05) COMP VALUE ZEROS.
002420 01 L-MAX PICTURE S9(05) COMP VALUE 90.
002424 01 LATEST-RECTYPE PICTURE S9(5) COMP VALUE 0.
002440 01 LAST-PW-ENTRY PICTURE S9(03) COMP VALUE 1.
002460 01 LAST-RD-ORIGIN PICTURE S9(04) COMP VALUE ZEROS.
002480 01 LCHAR PICTURE X(01) VALUE SPACE.
002482 01 LEFT-DX PICTURE S9(05) COMP.
002484 01 LEFT-LEN PICTURE S9(05) COMP.
002486 01 LEFT-TYPE PICTURE S9(05) COMP.
002500 01 MAX-ALLOWABLE-FILES PICTURE S9(05) COMP VALUE 001.
002520 01 MAX-FALSEGO PICTURE S9(05) COMP VALUE 9.
002540 01 MAX-HSPACE PICTURE S9(05) COMP VALUE 130.
002560 01 MAX-KEY-LENGTH PICTURE S9(05) COMP VALUE 60.
002580 01 MAX-LMARGIN PICTURE S9(05) COMP VALUE 130.
002600 01 MAX-NREPORTS PICTURE S9(05) COMP VALUE 9.
002620 01 MAX-PROTECTS PICTURE S9(05) COMP VALUE 10.
002640 01 MAX-TRUEGO PICTURE S9(05) COMP VALUE 9.
002660 01 MAX-REPORTNO PICTURE S9(05) COMP VALUE 9.
002680 01 MAX-VSPACE PICTURE S9(05) COMP VALUE 50.
002700 01 MAXCREATEBSZ PICTURE S9(05) COMP VALUE 640.
002720 01 MINUS-ONE PICTURE S9(01) COMP VALUE -1.
002740 01 MINUS-ONE-DX PICTURE S9(05) COMP VALUE 200.
002760 01 NCHAR PICTURE S9(05) COMP VALUE ZEROS.
002780 01 NUM-VAR-SPELLING PICTURE X(01) VALUE 'X'.
002800 01 NUMWORD PICTURE S9(09)V999 VALUE ZEROS.
002820 01 NUMWORDX REDEFINES NUMWORD PICTURE X(12).
002840 01 NFILES PICTURE S9(05) COMP VALUE ZEROS.
002860 01 N-INPUTFILES PICTURE S9(05) COMP VALUE ZEROS.
002880 01 N-OPENLPS PICTURE S9(05) COMP VALUE 00.
002900 01 N-PASSWORDS PICTURE S9(05) COMP VALUE 0.
002902 01 N-PW PICTURE S9(05) COMP VALUE 0.
002904 01 N-PROMPTS PICTURE S9(05) COMP.
002920 01 N-PD PICTURE S9(05) COMP VALUE 0.
002940 01 N-RSE PICTURE S9(05) COMP VALUE ZEROS.
002942 01 N-SKEYS PICTURE S9(05) COMP VALUE ZEROS.
002960 01 OPERANDS-CNT PICTURE S9(05) COMP VALUE ZEROS.
002980 01 ORIGIN PICTURE S9(05) COMP VALUE ZEROS.
003000 01 PARENCNT PICTURE S9(05) COMP VALUE ZEROS.
003020 01 PD-POINTER PICTURE S9(05) COMP.
003040 01 POPPED-X PICTURE S9(05) COMP VALUE ZEROS.
003060 01 PPN PICTURE S9(10) COMP VALUE ZEROS.
003080 01 PPN-HALF PICTURE S9(07) COMP VALUE ZEROS.
003100 01 PREV-BUCKETDX PICTURE S9(05) COMP VALUE ZERO.
003120 01 PROJ10 PICTURE S9(08) COMP VALUE ZEROS.
003140 01 PROJ8 PICTURE S9(08) COMP VALUE ZEROS.
003142 01 PW-LIST PICTURE S9(05) COMP VALUE 0.
003144 01 PROMPT-PW-POINTER PICTURE S9(05) COMP VALUE 0.
003160 01 PW-POINTER PICTURE S9(05) COMP.
003180 01 Q-MAX PICTURE S9(05) COMP VALUE 72.
003200 01 QUATERNARY-ORIGIN PICTURE S9(05) COMP VALUE ZEROS.
003202 01 RIGHT-LEN PICTURE S9(05) COMP.
003204 01 RIGHT-TYPE PICTURE S9(05) COMP.
003220 01 SAVE30 PICTURE X(30).
003240 01 SAVE-X PICTURE S9(05) COMP VALUE 01.
003260 01 SAVE-XX PICTURE S9(05) COMP VALUE 01.
003280 01 SCALE PICTURE S9(05) COMP VALUE ZEROS.
003282 01 SORT-GOTO-X PICTURE S9(05) COMP VALUE ZEROS.
003300 01 TALLI PICTURE S9(05) COMP VALUE ZEROS.
003320 01 T-INSTR PICTURE S9(05) COMP VALUE ZEROS.
003340 01 T-NUMBN PICTURE S9(10) COMP VALUE ZEROS.
003360 01 TCHAR PICTURE S9(05) COMP VALUE ZEROS.
003380 01 TEST-PROTEXCL PICTURE S9(01) COMP VALUE ZERO.
003400 01 TEST-QUOTE PICTURE S9(01) COMP VALUE ZERO.
003420 01 TEST-REF-NO PICTURE S9(05) COMP VALUE ZEROS.
003440 01 TMAX PICTURE S9(05) COMP VALUE 20.
003460 01 TLPARENCAP PICTURE S9(05) COMP VALUE 10.
003480 01 TRUTH PICTURE S9(05) COMP VALUE ZEROS.
003500 01 TYPEV PICTURE S9(05) COMP VALUE ZEROS.
003520 01 TYPE-ALPHA PICTURE S9(05) COMP VALUE 1.
003540 01 TYPE-AUTHORITY PICTURE S9(05) COMP VALUE 30.
003560 01 TYPE-AVERAGE PICTURE S9(05) COMP VALUE 8.
003580 01 TYPE-BINARY PICTURE S9(05) COMP VALUE 6.
003600 01 TYPE-CONSTANT PICTURE S9(05) COMP VALUE 9.
003620 01 TYPE-DBMS PICTURE S9(05) COMP VALUE 8.
003640 01 TYPE-DBMS-KEY PICTURE S9(05) COMP VALUE 18.
003660 01 TYPE-FILE PICTURE S9(05) COMP VALUE 41.
003680 01 TYPE-FILE-ASCII PICTURE S9(05) COMP VALUE 27.
003700 01 TYPE-FILE-SIXBIT PICTURE S9(05) COMP VALUE 26.
003720 01 TYPE-FILE-DBMS PICTURE S9(05) COMP VALUE 28.
003740 01 TYPE-GOTO PICTURE S9(05) COMP VALUE 20.
003760 01 TYPE-LITERAL PICTURE S9(05) COMP VALUE 10.
003780 01 TYPE-NUMERIC PICTURE S9(05) COMP VALUE 2.
003800 01 TYPE-NUMERIC-VARIABLE PICTURE S9(05) COMP VALUE 7.
003820 01 TYPE-PARTIAL-KEY PICTURE S9(05) COMP VALUE 16.
003840 01 TYPE-PD PICTURE S9(05) COMP VALUE 31.
003860 01 TYPE-PRIOR-SUMMARY PICTURE S9(05) COMP VALUE 23.
003880 01 TYPE-RECORD PICTURE S9(05) COMP VALUE 22.
003900 01 TYPE-SINGLE-KEY PICTURE S9(05) COMP VALUE 13.
003920 01 TYPE-THRU-KEY PICTURE S9(05) COMP VALUE 14.
003940 01 TYPE-TO-KEY PICTURE S9(05) COMP VALUE 15.
003960 01 TYPE-SUMMARY PICTURE S9(05) COMP VALUE 17.
003980 01 TYPE-VARIABLE PICTURE S9(05) COMP VALUE 12.
004020 01 USER10 PICTURE S9(08) COMP VALUE ZEROS.
004040 01 USER8 PICTURE S9(08) COMP VALUE ZEROS.
004060 01 V PICTURE S9(05) COMP VALUE ZEROS.
004080 01 VA PICTURE S9(05) COMP VALUE ZEROS.
004090 88 SUPPRESS-CONDITION VALUES ARE -117 -118 -119 -120.
004100 01 VAA PICTURE S9(05) COMP VALUE ZEROS.
004120 01 VP PICTURE S9(05) COMP VALUE ZEROS.
004140 01 VP-NOT PICTURE S9(05) COMP VALUE ZERO.
004160 01 V-ACCEPT PICTURE S9(05) COMP VALUE 14.
004180 01 V-ACROSS PICTURE S9(05) COMP VALUE 22.
004200 01 V-ADD PICTURE S9(05) COMP VALUE 01.
004220 01 V-AND PICTURE S9(05) COMP VALUE 83.
004240 01 V-ASCENDING PICTURE S9(05) COMP VALUE +1.
004260 01 V-AT-END PICTURE S9(05) COMP VALUE 13.
004280 01 V-AUTHORITY PICTURE S9(05) COMP VALUE 77.
004300 01 V-AVERAGE PICTURE S9(05) COMP VALUE 49.
004320 01 V-BEGINNING PICTURE S9(05) COMP VALUE 10.
004340 01 V-BOF1 PICTURE S9(05) COMP VALUE 55.
004360 01 V-BOF2 PICTURE S9(05) COMP VALUE 74.
004380 01 V-BOF3 PICTURE S9(05) COMP VALUE 75.
004400 01 V-BY PICTURE S9(05) COMP VALUE 00.
004420 01 V-CALL PICTURE S9(05) COMP VALUE 54.
004440 01 V-CLOSE PICTURE S9(05) COMP VALUE 2.
004460 01 V-CREATE PICTURE S9(05) COMP VALUE 09.
004480 01 V-COMPUTE PICTURE S9(05) COMP VALUE 43.
004500 01 V-CONCAT PICTURE S9(05) COMP VALUE 90989.
004520 01 V-COPY PICTURE S9(05) COMP VALUE 08.
004522 01 V-CURRENT PICTURE S9(05) COMP VALUE -50.
004540 01 V-DATE PICTURE S9(05) COMP VALUE 70.
004560 01 V-DESCENDING PICTURE S9(05) COMP VALUE -1.
004580 01 V-DISPLAY PICTURE S9(05) COMP VALUE 15.
004600 01 V-DISPLAYON PICTURE S9(05) COMP VALUE 34.
004620 01 V-DISPLAYOFF PICTURE S9(05) COMP VALUE 35.
004640 01 V-DIVIDE PICTURE S9(05) COMP VALUE 04.
004660 01 V-ELSE PICTURE S9(05) COMP VALUE 59.
004680 01 V-EOF PICTURE S9(05) COMP VALUE 09.
004700 01 V-EOF1 PICTURE S9(05) COMP VALUE 56.
004720 01 V-EOF2 PICTURE S9(05) COMP VALUE 71.
004740 01 V-EOF3 PICTURE S9(05) COMP VALUE 72.
004760 01 V-EOS PICTURE S9(05) COMP VALUE 90909.
004780 01 V-EQUAL PICTURE S9(05) COMP VALUE 01.
004840 01 V-FILLER PICTURE S9(05) COMP VALUE 58.
004860 01 V-FIND PICTURE S9(05) COMP VALUE 11.
004880 01 V-FIND-DBMS PICTURE S9(05) COMP VALUE 07.
004890 01 V-FINDUPLICATE PICTURE S9(05) COMP VALUE -16.
004900 01 V-FINDAREA PICTURE S9(05) COMP VALUE -18.
004920 01 V-FINDFROM PICTURE S9(05) COMP VALUE 10.
004940 01 V-FINDFIRST PICTURE S9(05) COMP VALUE -12.
004960 01 V-FINDKEY PICTURE S9(05) COMP VALUE 06.
004980 01 V-FINDKEY1 PICTURE S9(05) COMP VALUE 01.
005000 01 V-FINDKEY2 PICTURE S9(05) COMP VALUE 02.
005020 01 V-FINDKEY3 PICTURE S9(05) COMP VALUE 03.
005040 01 V-FINDLAST PICTURE S9(05) COMP VALUE -13.
005060 01 V-FINDNEXT PICTURE S9(05) COMP VALUE -15.
005080 01 V-FINDPRIOR PICTURE S9(05) COMP VALUE -14.
005100 01 V-FINDOWNER PICTURE S9(05) COMP VALUE -11.
005102 01 V-FINDOWNER-RECORD PICTURE S9(05) COMP VALUE -51.
005120 01 V-FINDRECORD PICTURE S9(05) COMP VALUE -19.
005140 01 V-FINDSET PICTURE S9(05) COMP VALUE -20.
005160 01 V-FINDSUPPRESS PICTURE S9(05) COMP VALUE -117.
005180 01 V-FORM-LINES PICTURE S9(05) COMP VALUE 45.
005200 01 V-FROM PICTURE S9(05) COMP VALUE 11.
005220 01 V-GOTO PICTURE S9(05) COMP VALUE 53.
005240 01 V-GOTONR PICTURE S9(05) COMP VALUE 52.
005260 01 V-GOTOQT PICTURE S9(05) COMP VALUE 50.
005280 01 V-GOTOXT PICTURE S9(05) COMP VALUE 51.
005300 01 V-GREATER PICTURE S9(05) COMP VALUE 04.
005320 01 V-GREATEREQUAL PICTURE S9(05) COMP VALUE 06.
005340 01 V-GROUP PICTURE S9(05) COMP VALUE 58.
005360 01 V-HEADING PICTURE S9(05) COMP VALUE 24.
005380 01 V-HEADINGON PICTURE S9(05) COMP VALUE 28.
005400 01 V-HEADINGOFF PICTURE S9(05) COMP VALUE 29.
005420 01 V-HOLD PICTURE S9(05) COMP VALUE 40.
005440 01 V-HSPACE PICTURE S9(05) COMP VALUE 18.
005460 01 V-IF PICTURE S9(05) COMP VALUE 61.
005480 01 V-IFANY PICTURE S9(05) COMP VALUE 64.
005500 01 V-IFFIRST PICTURE S9(05) COMP VALUE 62.
005520 01 V-IFFIRSTIME PICTURE S9(05) COMP VALUE 55.
005540 01 V-IFLAST PICTURE S9(05) COMP VALUE 63.
005560 01 V-IFLASTIME PICTURE S9(05) COMP VALUE 56.
005580 01 V-IFNEWGROUP PICTURE S9(05) COMP VALUE 58.
005600 01 V-IFNEWPAGE PICTURE S9(05) COMP VALUE 57.
005620 01 V-IFNEXT PICTURE S9(05) COMP VALUE 65.
005640 01 V-IFSAME PICTURE S9(05) COMP VALUE 66.
005660 01 V-ILLEGAL PICTURE S9(05) COMP VALUE 99.
005680 01 V-INVALID-KEY PICTURE S9(05) COMP VALUE 17.
005700 01 V-INVOKE PICTURE S9(05) COMP VALUE 02.
005720 01 V-LEFT PICTURE S9(05) COMP VALUE -3.
005740 01 V-LESS PICTURE S9(05) COMP VALUE 03.
005760 01 V-LESSEQUAL PICTURE S9(05) COMP VALUE 05.
005780 01 V-LINE PICTURE S9(05) COMP VALUE 00.
005800 01 V-LMARGIN PICTURE S9(05) COMP VALUE 20.
005820 01 V-LPAREN PICTURE S9(05) COMP VALUE 07.
005840 01 V-MARGIN PICTURE S9(05) COMP VALUE 20.
005860 01 V-MAXIMUM PICTURE S9(05) COMP VALUE 80.
005880 01 V-MINIMUM PICTURE S9(05) COMP VALUE 81.
005900 01 V-MULTIPLY PICTURE S9(05) COMP VALUE 03.
005920 01 V-NARROW PICTURE S9(05) COMP VALUE 00.
005940 01 V-NEW PICTURE S9(05) COMP VALUE -5.
005960 01 V-NEWPAGE PICTURE S9(05) COMP VALUE 25.
005980 01 V-NO PICTURE S9(05) COMP VALUE 00.
006000 01 V-NOT PICTURE S9(05) COMP VALUE 00.
006020 01 V-NOTEQUAL PICTURE S9(05) COMP VALUE 02.
006040 01 V-OF PICTURE S9(05) COMP VALUE 00.
006060 01 V-OFF PICTURE S9(05) COMP VALUE 00.
006080 01 V-ON PICTURE S9(05) COMP VALUE 00.
006100 01 V-OPEN PICTURE S9(05) COMP VALUE 02.
006120 01 V-OR PICTURE S9(05) COMP VALUE 84.
006140 01 V-POP PICTURE S9(10) COMP VALUE -1.
006160 01 V-POP2 PICTURE S9(05) COMP VALUE -2.
006180 01 V-NEXT PICTURE S9(05) COMP VALUE 12.
006200 01 V-NOP PICTURE S9(05) COMP VALUE 00.
006220 01 V-PAGE PICTURE S9(05) COMP VALUE 46.
006240 01 V-PAGE-LINE PICTURE S9(05) COMP VALUE 44.
006260 01 V-PAGE-WIDTH PICTURE S9(05) COMP VALUE 21.
006280 01 V-PAGING PICTURE S9(05) COMP VALUE 26.
006300 01 V-PAGINGON PICTURE S9(05) COMP VALUE 26.
006320 01 V-PAGINGOFF PICTURE S9(05) COMP VALUE 27.
006340 01 V-PICTURE PICTURE S9(05) COMP VALUE 78.
006360 01 V-PRINT PICTURE S9(05) COMP VALUE 16.
006380 01 V-PRINTON PICTURE S9(05) COMP VALUE 36.
006400 01 V-PRINTOFF PICTURE S9(05) COMP VALUE 37.
006420 01 V-PRIVACY-KEY PICTURE S9(05) COMP VALUE 00.
006440 01 V-PRIVACY-LOCK PICTURE S9(05) COMP VALUE 00.
006460 01 V-READ PICTURE S9(05) COMP VALUE 5.
006470 01 V-REOPEN PICTURE S9(05) COMP VALUE 86.
006480 01 V-REPORT PICTURE S9(05) COMP VALUE 23.
006500 01 V-RESET PICTURE S9(05) COMP VALUE 41.
006520 01 V-RESULT PICTURE S9(05) COMP VALUE 09.
006540 01 V-REWRITE PICTURE S9(05) COMP VALUE 87.
006560 01 V-RIGHT PICTURE S9(05) COMP VALUE -2.
006580 01 V-RMARGIN PICTURE S9(05) COMP VALUE 21.
006600 01 V-RPAREN PICTURE S9(05) COMP VALUE 85.
006620 01 V-RPTDATE PICTURE S9(05) COMP VALUE 70.
006640 01 V-RPTDATEON PICTURE S9(05) COMP VALUE 38.
006660 01 V-RPTDATEOFF PICTURE S9(05) COMP VALUE 39.
006680 01 V-RPTHEAD PICTURE S9(05) COMP VALUE 24.
006700 01 V-RPTHEADON PICTURE S9(05) COMP VALUE 28.
006720 01 V-RPTHEADOFF PICTURE S9(05) COMP VALUE 29.
006722 01 V-RUN-UNIT PICTURE S9(05) COMP VALUE -23.
006740 01 V-SCHEMA PICTURE S9(05) COMP VALUE 00.
006760 01 V-SET PICTURE S9(05) COMP VALUE 42.
006780 01 V-SLASHES PICTURE S9(05) COMP VALUE 90902.
006800 01 V-SORT PICTURE S9(05) COMP VALUE 12.
006820 01 V-STACK PICTURE S9(05) COMP VALUE 05.
006840 01 V-STATEMENT-NO PICTURE S9(05) COMP VALUE 03.
006860 01 V-STITLES PICTURE S9(05) COMP VALUE 00.
006880 01 V-STOP PICTURE S9(05) COMP VALUE 1.
006900 01 V-SUB-SCHEMA PICTURE S9(05) COMP VALUE 00.
006920 01 V-SUBTRACT PICTURE S9(05) COMP VALUE 02.
006940 01 V-SUMMARY PICTURE S9(05) COMP VALUE 32.
006960 01 V-SUMMARYON PICTURE S9(05) COMP VALUE 32.
006980 01 V-SUMMARYOFF PICTURE S9(05) COMP VALUE 33.
007000 01 V-SUPPRESSALL PICTURE S9(05) COMP VALUE -117.
007020 01 V-SUPPRESSAREA PICTURE S9(05) COMP VALUE -118.
007040 01 V-SUPPRESSRECORD PICTURE S9(05) COMP VALUE -119.
007060 01 V-SUPPRESSSET PICTURE S9(05) COMP VALUE -120.
007080 01 V-TALLY PICTURE S9(05) COMP VALUE 47.
007100 01 V-THAN PICTURE S9(05) COMP VALUE 00.
007120 01 V-THEN PICTURE S9(05) COMP VALUE 60.
007140 01 V-THRU PICTURE S9(05) COMP VALUE 06.
007160 01 V-TITLES PICTURE S9(05) COMP VALUE 79.
007180 01 V-TITLESON PICTURE S9(05) COMP VALUE 30.
007200 01 V-TITLESOFF PICTURE S9(05) COMP VALUE 31.
007220 01 V-TO PICTURE S9(05) COMP VALUE 42.
007240 01 V-TOTAL PICTURE S9(05) COMP VALUE 48.
007260 01 V-VERB-CONTROL PICTURE S9(05) COMP VALUE 04.
007280 01 V-VSPACE PICTURE S9(05) COMP VALUE 19.
007300 01 V-WIDTH PICTURE S9(05) COMP VALUE 21.
007320 01 WARNING-ERROR PICTURE S9(05) COMP VALUE 170.
007340 01 X-MAX PICTURE S9(05) COMP VALUE 3000.
007360 01 X-START PICTURE S9(05) COMP VALUE 24.
007380 01 XX PICTURE S9(05) COMP.
007400 01 ZERO-DX PICTURE S9(05) COMP VALUE 00.
007420 01 CALLED-NAME PICTURE X(06) VALUE 'IQE '.
007440 01 QCSTMTTMP.
007460 05 QCSTMT-PREFIX PICTURE X(02) VALUE 'QC'.
007480 05 QC-STMT-NO PICTURE 999 VALUE 001.
007500 05 FILLER PICTURE X(04) VALUE 'STMP'.
007520 01 QTANLZTMP.
007540 05 FILLER PICTURE X(02) VALUE 'QT'.
007560 05 QT-ANAL-NO PICTURE 999 VALUE 001.
007580 05 QT-ANLZ-EXT PICTURE X(04) VALUE 'ATMP'.
007600 01 QTNNNITMP.
007620 05 QRY-NAME PICTURE X(09) VALUE SPACE.
007640 05 FLAG-DUMP PICTURE S9(01) VALUE 0.
007660 05 FLAG-EXECUTE PICTURE S9(01) VALUE 1.
007680 05 FLAG-SAVE PICTURE S9(01) VALUE 0.
007700 05 FLAG-LIST PICTURE S9(01) VALUE 1.
007720 05 FILLER PICTURE X(69) VALUE SPACE.
007722 05 FILLER PICTURE X VALUE SPACE.
007724 05 FLAG-TMP-INPUT PICTURE S9(01) VALUE 0.
007740 01 FD-AREA.
007760 02 FD-IDNT PICTURE XX.
007780 02 FD-NAME PICTURE X(30).
007800 02 FD-NDICTS PICTURE 9(03).
007820 02 FD-DBMS-INFO.
007840 04 FD-DBMS-LABEL PICTURE X(30).
007860 04 FILLER PICTURE X(06).
007880 02 FILLER REDEFINES FD-DBMS-INFO.
007900 04 FD-INLABEL PICTURE X(09).
007920 04 FD-LABEL REDEFINES FD-INLABEL.
007940 06 FD-INFILE PICTURE X(06).
007960 06 FD-INEXT PICTURE X(03).
007980 04 FILLER PICTURE X(08).
008000 04 FD-PPN PICTURE X(19).
008020 02 FD-FILETYPE PICTURE 9.
008040 02 FD-RECSIZE PICTURE 9(04).
008060 02 FD-BLKSIZE PICTURE S9(04).
008080 02 FD-KEYPOS PICTURE 9(4).
008100 02 FD-KEYLEN PICTURE 9(3).
008120 02 FD-KEYTYPE PICTURE 9.
008140 02 FD-KEYSIGN PICTURE 9.
008160 02 FD-PROTECT PICTURE X(01).
008180 02 FD-READ-PROTECT PICTURE XX.
008200 02 FD-COPY-PROTECT PICTURE XX.
008220 02 FD-REWRITE-PROTECT PICTURE XX.
008240 02 FILLER PICTURE X(48).
008260 02 FD-LAST-UPDATE PICTURE X(06).
008280 01 FE-AREA.
008300 02 FE-IDNT PICTURE X(02).
008320 02 FE-NAME PICTURE X(30).
008340 02 FE-FILESPEC PICTURE X(68).
008360 02 FE-FILETYPE PICTURE X(01).
008380 02 FE-RECSIZE PICTURE 9(04).
008400 02 FE-BLKSIZE PICTURE S9(04).
008420 02 FE-KEYPOS PICTURE 9(04).
008440 02 FE-KEYLEN PICTURE 9(03).
008460 02 FE-KEYTYPE PICTURE 9(01).
008480 02 FE-KEYSIGN PICTURE 9(01).
008500 02 FE-PROTECT PICTURE X(01).
008520 02 FE-PROTECT-READ PICTURE X(02).
008540 02 FE-PROTECT-COPY PICTURE X(02).
008560 02 FE-PROTECT-REWRITE PICTURE X(02).
008580 02 FILLER PICTURE X(19).
008600 02 FE-LAST-UPDATE PICTURE X(06).
008620 01 DD-AREA.
008640 02 DD-IDNT PICTURE XX.
008660 02 DD-NAME.
008680 04 DD-NAMEX PICTURE X(01) OCCURS 30 INDEXED BY DD.
008700 02 DD-TITLE1 PICTURE X(10).
008720 02 DD-TITLE2 PICTURE X(10).
008740 02 DD-TCHAR PICTURE 99.
008760 02 DD-ECHAR PICTURE 9(4).
008780 02 DD-FCHAR PICTURE 9(4).
008800 02 DD-NCHAR PICTURE 9(4).
008820 02 DD-TYPEV PICTURE 9.
008840 02 DD-SCALE PICTURE 9.
008860 02 DD-OFFSET PICTURE 9.
008880 02 DD-EDITX PICTURE 99.
008900 02 DD-PICT PICTURE X(19).
008920 02 DD-GRPLEN PICTURE 999.
008940 02 DD-GRPNAME PICTURE X.
008960 02 DD-NREPEATS PICTURE S99.
008980 02 DD-STOPV PICTURE X.
009000 02 DD-REF-NO PICTURE 99.
009020 02 DD-PROTEXCL PICTURE 9.
009040 02 DD-RECTYPE PICTURE XXX.
009060 02 FILLER PICTURE X(47).
009080 01 HOLD-FD-NAME PICTURE X(30) VALUE SPACE.
009100 01 PD-AREA.
009120 02 PD-IDNT PICTURE XX.
009140 02 PD-REF-NO PICTURE 99.
009160 02 PD-DATE-FLAG PICTURE X.
009180 02 PD-LINE PICTURE X.
009200 02 PD-TEXT.
009220 04 PD-CHAR PICTURE X OCCURS 12 TIMES.
009240 02 FILLER PICTURE X(132).
009260 01 RD-AREA.
009280 02 RD-IDNT PICTURE XX.
009300 02 RD-NAME PICTURE X(30).
009320 02 RD-ORIGIN PICTURE 9(4).
009340 02 RD-LENGTH PICTURE 9(4).
009360 02 RD-RECNO PICTURE 9(3).
009380 02 FILLER PICTURE X(107).
009400 01 AD-AREA REDEFINES RD-AREA.
009420 02 AD-IDNT PICTURE XX.
009440 02 AD-NAME PICTURE X(30).
009460 02 AD-ORIGIN PICTURE 9(4).
009480 02 AD-LENGTH PICTURE 9(4).
009500 02 AD-AREA-NO PICTURE 9(3).
009520 02 FILLER PICTURE X(107).
009540 01 SD-AREA REDEFINES AD-AREA.
009560 02 SD-IDNT PICTURE XX.
009580 02 SD-NAME PICTURE X(30).
009600 02 SD-ORIGIN PICTURE 9(4).
009620 02 SD-LENGTH PICTURE 9(4).
009640 02 SD-OWNER-REC-NO PICTURE 9(3).
009660 02 FILLER PICTURE X(107).
009680 01 FX-AREAS.
009700 02 FX-PRIMARY PICTURE S9(05) COMP VALUE 1.
009720 02 PRIMARY-ORIGIN PICTURE S9(05) COMP VALUE -1.
009740 02 PRIMARY-LENGTH PICTURE S9(05) COMP VALUE 0.
009760 02 FX-SECONDARY PICTURE S9(05) COMP VALUE 1.
009780 02 SECONDARY-ORIGIN PICTURE S9(05) COMP VALUE -1.
009800 02 SECONDARY-LENGTH PICTURE S9(05) COMP VALUE 0.
009820 02 FX-TERTIARY PICTURE S9(05) COMP VALUE 1.
009840 02 TERTIARY-ORIGIN PICTURE S9(05) COMP VALUE -1.
009860 02 TERTIARY-LENGTH PICTURE S9(05) COMP VALUE 0.
009880 02 COPY-FX PICTURE S9(05) COMP VALUE 1.
009900 02 COPY-ORIGIN PICTURE S9(05) COMP VALUE -1.
009920 02 COPY-LENGTH PICTURE S9(05) COMP VALUE 0.
009940 02 CREATE-FX PICTURE S9(05) COMP VALUE 1.
009960 02 CREATE-ORIGIN PICTURE S9(05) COMP VALUE -1.
009980 02 CREATE-LENGTH PICTURE S9(05) COMP VALUE 0.
010000 01 REPORT-R-AREA.
010020 02 TYPE-REPORT PICTURE S9(10) COMP VALUE 19.
010040 02 R-RPT-NO PICTURE S9(10) COMP VALUE 1.
010060 02 R-PAGE-NO PICTURE S9(10) COMP VALUE 0.
010080 02 R-LINE-NO PICTURE S9(10) COMP VALUE 0.
010100 02 R-ACROSS-NO PICTURE S9(10) COMP VALUE 1.
010120 02 R-RPTDATE PICTURE S9(10) COMP VALUE -1.
010140 02 R-LAST-PRINTX PICTURE S9(10) COMP VALUE 0.
010160 02 R-RPTHEADX PICTURE S9(10) COMP VALUE 3.
010180 02 R-LAST-PRINTYPE PICTURE S9(10) COMP VALUE 0.
010200 02 FILLER PICTURE X(36) VALUE SPACE.
010220 01 TODAY-AREA.
010240 02 TYPE-TODAY PICTURE S9(05) COMP VALUE 16.
010260 02 TO-NCHAR PICTURE S9(05) COMP VALUE 06.
010280 02 TO-SCALE PICTURE S9(05) COMP VALUE 00.
010300 02 TO-ECHAR PICTURE S9(05) COMP VALUE 08.
010320 02 TO-TCHAR PICTURE S9(05) COMP VALUE 05.
010340 02 TO-FCHAR PICTURE S9(05) COMP VALUE 01.
010360 02 TO-NREPEATS PICTURE S9(05) COMP VALUE 01.
010380 02 TO-GRPLEN PICTURE S9(10) COMP.
010400 02 TO-TITLE1 PICTURE X(10) VALUE SPACE.
010420 02 TO-TITLE2 PICTURE X(10) VALUE 'TODAY'.
010440 02 TO-PICT PICTURE X(20) VALUE '99/99/99'.
010460 02 TO-GRPNAME PICTURE X(01) VALUE SPACE.
010480 02 TO-STOPV PICTURE X(01) VALUE '1'.
010482 01 ERROR-STATUS-AREA.
010484 02 TYPE-ERROR-STATUS PIC S9(10) COMP VALUE 24.
010486 02 ER-NCHAR PIC S9(10) COMP VALUE 10.
010488 02 ER-SCALE PIC S9(10) COMP VALUE 0.
010490 02 ER-ECHAR PIC S9(10) COMP VALUE 10.
010492 02 ER-TCHAR PIC S9(10) COMP VALUE 6.
010494 02 ER-FCHAR PIC S9(10) COMP VALUE 1.
010496 02 ER-NREPEATS PIC S9(10) COMP VALUE 1.
010498 02 ER-GRPLEN PIC S9(10) COMP VALUE 0.
010500 02 ER-TITLE1 PIC X(10) VALUE 'ERROR'.
010502 02 ER-TITLE2 PIC X(10) VALUE 'STATUS'.
010504 02 ER-PICT PIC X(20) VALUE "ZZZZZZZZZ9".
010506 02 ER-GRPNAME PIC X(1) VALUE SPACE.
010508 02 ER-STOPV PIC X(1) VALUE SPACE.
010500 01 XRANDOM-AREA.
010520 02 TYPE-XRANDOM PICTURE S9(05) COMP VALUE 11.
010540 02 XR-NCHAR PICTURE S9(05) COMP VALUE 10.
010560 02 XR-SCALE PICTURE S9(05) COMP VALUE 00.
010580 02 XR-ECHAR PICTURE S9(05) COMP VALUE 10.
010600 02 XR-TCHAR PICTURE S9(06) COMP VALUE 06.
010620 02 XR-FCHAR PICTURE S9(05) COMP VALUE 01.
010640 02 XR-NREPEATS PICTURE S9(05) COMP VALUE 01.
010660 02 XR-GRPLEN PICTURE S9(05) COMP.
010680 02 XR-TITLE1 PICTURE X(10) VALUE 'RANDOM'.
010700 02 XR-TITLE2 PICTURE X(10) VALUE 'NUMBER'.
010720 02 XR-PICT PICTURE X(20) VALUE '9999999999'.
010740 02 XR-GRPNAME PICTURE X(01) VALUE SPACE.
010741 02 XR-STOPV PICTURE X(01) VALUE '1'.
010742 01 AREA-IDENT-AREA.
010743 02 TYPE-AREA-IDENT PICTURE S9(10) COMP VALUE 36.
010744 02 AI-NCHAR PICTURE S9(10) COMP VALUE 30.
010745 02 AI-SCALE PICTURE S9(10) COMP VALUE 0.
010746 02 AI-ECHAR PICTURE S9(10) COMP VALUE 30.
010747 02 AI-TCHAR PICTURE S9(10) COMP VALUE 10.
010748 02 AI-FCHAR PICTURE S9(10) COMP VALUE 0.
010749 02 AI-REPEATS PICTURE S9(10) COMP VALUE 1.
010750 02 AI-GRPLEN PICTURE S9(10) COMP VALUE 0.
010751 02 AI-TITLE1 PICTURE X(10) VALUE 'AREA'.
010752 02 AI-TITLE2 PICTURE X(10) VALUE 'IDENTIFIER'.
010753 02 AI-PICT PICTURE X(20) VALUE SPACES.
010754 02 AI-FILLER1 PICTURE X(2).
010762 01 AREA-NAME-AREA.
010763 02 TYPE-AREA-NAME PICTURE S9(10) COMP VALUE 34.
010764 02 AN-NCHAR PICTURE S9(10) COMP VALUE 30.
010765 02 AN-SCALE PICTURE S9(10) COMP VALUE 0.
010766 02 AN-ECHAR PICTURE S9(10) COMP VALUE 30.
010767 02 AN-TCHAR PICTURE S9(10) COMP VALUE 4.
010768 02 AN-FCHAR PICTURE S9(10) COMP VALUE 0.
010769 02 AN-REPEATS PICTURE S9(10) COMP VALUE 1.
010770 02 AN-GRPLEN PICTURE S9(10) COMP VALUE 0.
010771 02 AN-TITLE1 PICTURE X(10) VALUE 'AREA'.
010772 02 AN-TITLE2 PICTURE X(10) VALUE 'NAME'.
010773 02 AN-PICT PICTURE X(20) VALUE SPACES.
010774 02 AN-FILLER1 PICTURE X(2).
010775 01 CURRENT-RECORD-KEY-AREA.
010776 02 TYPE-CURR-REC-KEY PICTURE S9(10) COMP VALUE 32.
010777 02 CK-NCHAR PICTURE S9(10) COMP VALUE 10.
010778 02 CK-SCALE PICTURE S9(10) COMP VALUE 0.
010779 02 CK-ECHAR PICTURE S9(10) COMP VALUE 10.
010780 02 CK-TCHAR PICTURE S9(10) COMP VALUE 10.
010781 02 CK-FCHAR PICTURE S9(10) COMP VALUE 0.
010782 02 CK-REPEATS PICTURE S9(10) COMP VALUE 1.
010783 02 CK-GRPLEN PICTURE S9(10) COMP VALUE 0.
010784 02 CK-TITLE1 PICTURE X(10) VALUE 'CURRENT'.
010785 02 CK-TITLE2 PICTURE X(10) VALUE 'RECORD KEY'.
010786 02 CK-PICT PICTURE X(20) VALUE 'ZZZZZZZZZ9'.
010787 02 CK-FILLER1 PICTURE XX.
010790 01 RECORD-NAME-AREA.
010791 02 TYPE-RECORD-NAME PICTURE S9(10) COMP VALUE 33.
010792 02 RN-NCHAR PICTURE S9(10) COMP VALUE 30.
010793 02 RN-SCALE PICTURE S9(10) COMP VALUE 0.
010794 02 RN-ECHAR PICTURE S9(10) COMP VALUE 30.
010795 02 RN-TCHAR PICTURE S9(10) COMP VALUE 6.
010796 02 RN-FCHAR PICTURE S9(10) COMP VALUE 0.
010797 02 RN-REPEATS PICTURE S9(10) COMP VALUE 1.
010798 02 RN-FILLER PICTURE S9(10) COMP VALUE 0.
010799 02 RN-TITLE1 PICTURE X(10) VALUE 'RECORD'.
010800 02 RN-TITLE2 PICTURE X(10) VALUE 'NAME'.
010801 02 RN-PICT PICTURE X(20) VALUE SPACES.
010802 02 RN-FILLER1 PICTURE XX.
010803 01 ERROR-COUNT-AREA.
010804 02 TYPE-ERROR-COUNT PIC S9(10) COMP VALUE 35.
010805 02 EC-NCHAR PIC S9(10) COMP VALUE 10.
010806 02 EC-SCALE PIC S9(10) COMP VALUE 0.
010807 02 EC-ECHAR PIC S9(10) COMP VALUE 10.
010808 02 EC-TCHAR PIC S9(10) COMP VALUE 5.
010809 02 EC-FCHAR PIC S9(10) COMP VALUE 0.
010810 02 EC-REPEATS PIC S9(10) COMP VALUE 1.
010811 02 EC-GRPLEN PIC S9(10) COMP VALUE 0.
010812 02 EC-TITLE1 PIC X(10) VALUE "ERROR".
010813 02 EC-TITLE2 PIC X(10) VALUE "COUNT".
010814 02 EC-PICT PIC X(20) VALUE "ZZZZZZZZZ9".
010815 02 EC-FILLER1 PIC X(02).
010816 01 PPN-TABLE.
010817 05 PPN-WORK PICTURE X(19) VALUE SPACE.
010820 05 FILLER REDEFINES PPN-WORK.
010840 10 PPN-ID PICTURE S9(10) COMP.
010860 10 FILLER PICTURE X(13).
010880 05 PPN-CHAR REDEFINES PPN-WORK PICTURE X OCCURS 19
010900 INDEXED BY PX.
010920 05 PPN-NUM REDEFINES PPN-CHAR PICTURE 9 OCCURS 19
010940 INDEXED BY PN.
010960 05 PPN-NUMBER PICTURE 9(6) VALUE ZEROS.
010980 05 PPN-DIGIT REDEFINES PPN-NUMBER PICTURE 9 OCCURS 6
011000 INDEXED BY PI.
011002 01 HIDDEN-ASCII PIC S9(10) COMP VALUE 29691190.
011004 01 FILLER REDEFINES HIDDEN-ASCII DISPLAY-7.
011006 02 ASCII-NULL PIC X.
011008 02 ASCII-BELL PIC X.
011010 02 ASCII-LF PIC X.
011012 02 ASCII-CR PIC X.
011014 02 ASCII-ESC PIC X.
011016 01 MASK1-7 DISPLAY-7.
011018 02 MASK1-6.
011020 04 MASK1 PIC X.
011022 04 FILLER PIC XXXXX.
011024 02 MASK7 PIC X.
011026 01 RETURNED-PASSWORD PIC XXXXXX.
011028
011030 01 PW-WORKER USAGE IS DISPLAY-6.
011040 02 PW-CHAR PICTURE X OCCURS 12 TIMES.
011060 01 PW-WORK REDEFINES PW-WORKER.
011080 02 PW-WORK1 PICTURE S9(10) COMP.
011100 02 PW-WORK2 PICTURE S9(10) COMP.
011120 01 PW-MASK1 PICTURE S9(10) COMP VALUE 14729163.
011140 01 PW-MASK2 PICTURE S9(10) COMP VALUE -24815212.
011160 01 PW-WORKER7.
011180 02 PW7-CHAR PICTURE X OCCURS 6 TIMES.
011200 01 FILE-PROTECT-TABLE.
011220 02 FD-PROT PICTURE X OCCURS 3 TIMES.
011240 02 FD-RPROT PICTURE XX OCCURS 3 TIMES.
011260 02 FD-CPROT PICTURE XX OCCURS 3 TIMES.
011280 02 FD-REWPROT PICTURE XX OCCURS 3 TIMES.
011300 02 FD-NAMEPROT PICTURE X(30) OCCURS 3 TIMES.
011320 01 LINE-TABLE.
011340 05 LINEX PICTURE X OCCURS 90 TIMES INDEXED BY L.
011360 05 LINE-WORD REDEFINES LINEX PICTURE S9(10) COMP
011380 OCCURS 15 TIMES INDEXED BY LI.
011400 01 PARSING-STACK.
011420 02 PARSING-TABLE OCCURS 10 TIMES INDEXED BY OPX.
011440 04 OPERATOR PICTURE S9(10) COMP.
011460 04 OPERAND PICTURE S9(10) COMP.
011480 04 PRECEDENCE PICTURE S9(10) COMP.
011482 01 PROMPTER-MESSAGE.
011484 02 FILLER PICTURE X(35)
011486 VALUE '*ADDITIONAL PASSWORD(S) NEEDED FOR '.
011488 02 ITEM-OR-FILE PICTURE X(11).
011490 02 FILLER PICTURE X(26)
011492 VALUE '. ENTER SPACE TO END LIST.'.
011500 01 HELD-WORD30.
011520 02 FILLER PICTURE X(05) VALUE 'HELD-'.
011540 02 HWORD30 PICTURE X(25) VALUE SPACE.
011560 01 WORD-TABLE.
011580 02 WORDX PICTURE X OCCURS 30 TIMES INDEXED BY W.
011600 02 WORD30 REDEFINES WORDX.
011620 04 WORD18.
011640 06 WORD12.
011660 08 WORD06.
011680 10 WORD04.
011700 12 WORD02.
011720 14 WORD01 PICTURE X(01).
011740 14 FILLER PICTURE X(01).
011760 12 FILLER PICTURE X(02).
011780 10 FILLER PICTURE X(02).
011800 08 FILLER PICTURE X(06).
011820 06 FILLER PICTURE X(06).
011840 04 WORD30-STNUMB PICTURE 99.
011860 04 FILLER PICTURE X(10).
011861 01 FILLER REDEFINES WORD-TABLE.
011862 02 WORD05 PICTURE X(05).
011863 02 FILLER PICTURE X(25).
011864 01 filler redefines word-table.
011866 02 filler picture x(9).
011868 02 word30-fatal-part picture x(21).
011880 01 PICTURE-TABLE REDEFINES WORD-TABLE.
011900 05 PICTX PICTURE X OCCURS 30 TIMES INDEXED BY P.
011920 01 NUMBER-TABLE.
011940 05 NUMBX PICTURE X OCCURS 18 TIMES INDEXED BY N.
011960 05 NUMBN REDEFINES NUMBX PICTURE S9(18).
011980 05 NUMBREDEF REDEFINES NUMBN.
012000 10 FILLER PICTURE X(08).
012020 10 NUMBN10 PICTURE S9(10).
012040 01 QUOTE-TABLE.
012060 05 QUOTEX PICTURE X OCCURS 72 TIMES INDEXED BY Q.
012080 05 QUOTERS REDEFINES QUOTEX.
012100 10 QUOTEN PICTURE S9(10) COMP OCCURS 12 TIMES.
012120 01 REMAINER PICTURE S9(04)V99 VALUE ZEROS.
012140 01 R4VR1R2 REDEFINES REMAINER.
012160 02 R4 PICTURE 9(04).
012180 02 R1 PICTURE 9.
012200 02 R2 PICTURE 9.
012220 01 TITLE-TABLE.
012240 05 TITLEX PICTURE X OCCURS 24 TIMES INDEXED BY T.
012260 05 TITLES REDEFINES TITLEX.
012280 10 TITLE1X PICTURE X(10).
012300 10 TITLE2X PICTURE X(10).
012320 10 FILLER PICTURE X(04).
012322 01 HINT-WORD DISPLAY-7.
012322 02 FILLER PICTURE XX VALUE '% '.
012324 02 HINT-WORD30 PICTURE X(30).
012330 01 WARNING-MESSAGE-HINT DISPLAY-7.
012332 02 FILLER PICTURE X(09) VALUE '*WARNING-'.
012334 02 WARNING-DATANAME1 PICTURE X(11).
012336 02 WARNING-DATANAME2 PICTURE X(10).
012340 01 IQANLZ-ERROR DISPLAY-7.
012360* 02 E1 PICTURE X(04) VALUE '%IQA'.
012380* 02 FATAL-WARNING PICTURE X(08) VALUE 'Deadly '.
012400* 02 DCODE PICTURE 999 VALUE 000.
012420 02 FILLER PICTURE X(01) VALUE SPACE.
012440 02 E-MSG PICTURE X(30) VALUE SPACE.
012460* 02 E2 PICTURE X(03) VALUE '% '.
012480 01 ERR-MSGS DISPLAY-7.
012500 05 FILLER1 PICTURE X(30) VALUE 'not defined'.
012520 05 FILLER2 PICTURE X(30) VALUE 'not numeric'.
012540 05 FILLER3 PICTURE X(30) VALUE 'not alphabetic'.
012560 05 FILLER4 PICTURE X(30) VALUE 'statement expected'.
012580 05 FILLER5 PICTURE X(30)
012582 VALUE 'encountered when verb expected'.
012600 05 FILLER6 PICTURE X(30)
012602 VALUE 'found when non-verb expected'.
012620 05 FILLER7 PICTURE X(30) VALUE 'invalid character'.
012640 05 FILLER8 PICTURE X(30) VALUE 'value beyond range'.
012660 05 FILLER9 PICTURE X(30) VALUE 'file not found'.
012680 05 FILLER10 PICTURE X(30) VALUE 'too many right paren'.
012700 05 FILLER11 PICTURE X(30) VALUE 'no ending quote'.
012720 05 FILLER12 PICTURE X(30) VALUE 'query size exceeded'.
012740 05 FILLER13 PICTURE X(30) VALUE 'invalid item type'.
012760 05 FILLER14 PICTURE X(30)
012780 VALUE 'invalid/missing password for'.
012800 05 FILLER15 PICTURE X(30) VALUE 'literal expected'.
012820 05 FILLER16 PICTURE X(30) VALUE 'literal max exceeded'.
012840 05 FILLER17 PICTURE X(30) VALUE 'no ending paren'.
012860 05 FILLER18 PICTURE X(30) VALUE 'ISAM file required'.
012880 05 FILLER19 PICTURE X(30) VALUE 'hold buffer full'.
012900 05 FILLER20 PICTURE X(30) VALUE 'invalid operation'.
012920 05 FILLER21 PICTURE X(30) VALUE 'invalid picture'.
012940 05 FILLER22 PICTURE X(30)
012942 VALUE 'CORRECT ANY ERRORS AND RE-TRY'.
012960 05 FILLER23 PICTURE X(30) VALUE 'variable used once'.
012980 05 FILLER24 PICTURE X(30) VALUE 'query not terminated'.
013000 05 FILLER25 PICTURE X(30) VALUE 'operator expected'.
013020 05 FILLER26 PICTURE X(30) VALUE 'operand expected'.
013040 05 FILLER27 PICTURE X(30) VALUE '= incorrectly used'.
013060 05 FILLER28 PICTURE X(30) VALUE '= must be first operator '.
013080 05 FILLER29 PICTURE X(30)
013100 VALUE 'invalid relational operator'.
013120 05 FILLER30 PICTURE X(30) VALUE 'verb use limit is 1'.
013140 05 FILLER31 PICTURE X(30) VALUE 'word max 30 chars'.
013160 05 FILLER32 PICTURE X(30) VALUE 'invalid DEV:FILE.EXT'.
013180 05 FILLER33 PICTURE X(30) VALUE 'invalid ( = ZZITEM )'.
013200 05 FILLER34 PICTURE X(30)
013220 VALUE 'num var names begin with X'.
013240 05 FILLER35 PICTURE X(30)
013260 VALUE 'undefined data name or else an'.
013280 05 FILLER36 PICTURE X(30)
013300 VALUE 'alpha var spelled incorrectly'.
013320 05 FILLER37 PICTURE X(30)
013340 VALUE 'dictionary not found for file'.
013360 05 FILLER38 PICTURE X(30)
013380 VALUE 'OPEN statement duplicate names'.
013400 05 FILLER39 PICTURE X(30)
013420 VALUE 'IF statemnt has no verb phrase'.
013440 05 FILLER40 PICTURE X(30)
013460 VALUE 'file name incorrectly used'.
013480 05 FILLER41 PICTURE X(30)
013500 VALUE 'no CREATE items designated or'.
013520 05 FILLER42 PICTURE X(30)
013540 VALUE 'possibly filename not quoted.'.
013542 05 FILLER43 PICTURE X(30)
013544 VALUE 'incorrectly used vocab word'.
013546 05 FILLER44 PICTURE X(30)
013548 VALUE 'can take no qualification'.
013550 05 FILLER45 PICTURE X(30) VALUE 'lack detail info dm item'.
013552 05 FILLER46 PICTURE X(30)
013554 VALUE 'NO DATA ITEM DESIGNATED'.
013555 05 FILLER47 PICTURE X(30)
013556 VALUE 'DBMS queries need a FIND verb'.
013558 05 filler48 picture x(30) value 'incorrectly specified'.
013560 05 filler49 picture x(30)
013562 value 'FIND statement incomplete'.
013564 05 filler50 picture x(30)
013566 value 'are possible missing word(s)'.
013567 05 FILLER51 PICTURE X(30)
013568 VALUE 'no file opened for sort'.
013570 05 FILLER52 PICTURE X(30)
013572 VALUE '"FIND" verb on a primary file'.
013573 05 FILLER53 PICTURE X(30)
013574 VALUE 'Nested "IF"s not allowed'.
013575 05 FILLER54 PICTURE X(30)
013576 VALUE '-NOT A NUMERIC COMPUTE OPERAND'.
013577 05 FILLER55 PICTURE X(30) VALUE 'NOT NUMERIC OPERAND'.
013578 05 filler56 picture x(30)
013579 value '"else" should not follow "."'.
013580 05 filler57 picture x(30)
013581 value 'preceed literal with space'.
013582 01 ERR-MSGR REDEFINES ERR-MSGS DISPLAY-7.
013583 05 ERR-MSG PICTURE X(30) OCCURS 57 TIMES.
013584 01 MAX-ERR-MSG PICTURE S9(10) COMP VALUE 57.
013600 01 TRUE-STACK.
013620 02 N-TRUEGO PICTURE S9(05) COMP VALUE 0.
013640 02 X-TRUEGO PICTURE S9(05) COMP
013660 OCCURS 9 INDEXED BY TSX.
013680 01 FALSE-STACK.
013700 02 N-FALSEGO PICTURE S9(05) COMP VALUE 0.
013720 02 X-FALSEGO PICTURE S9(05) COMP
013740 OCCURS 9 INDEXED BY FSX.
013760 01 NESTED-PAREN-TABLE.
013780 02 LPARENCNTR PICTURE S9(05) COMP VALUE 00.
013800 02 RPARENCNTR PICTURE S9(05) COMP VALUE 00.
013820 02 TLPX PICTURE S9(05) COMP VALUE 0.
013840 02 FLPX PICTURE S9(05) COMP VALUE 0.
013860 02 LPAREN-STACK.
013880 03 TRUE-LPAREN PICTURE S9(05) COMP OCCURS 9.
013900 03 FALSE-LPAREN PICTURE S9(05) COMP OCCURS 9.
013920 01 NOTT PICTURE S9 COMP OCCURS 9.
013940*****TABLES PASSED TO EXECUTION MODULE FOLLOW************
013960
013980 01 CONTROL-TABLE.
014000* *VALUES BELOW ARE DEFAULTS WHICH SHOULD BE PASSED IF
014020* QUERY DOES NOT AFFECT THAT QUANTITY*.
014040* *1ST ENTRY WILL STOP RUN IF EVER GET THERE*.
014060* *2ND & 3RD ENTRIES ARE DEFAULT RPTHEAD DX LIST.
014080 02 CONST1 PICTURE S9(10) COMP VALUE 1.
014100 02 FILLER PICTURE S9(10) COMP VALUE 1.
014120 02 CONST0 PICTURE S9(10) COMP VALUE 0.
014140 02 DYN-JOBNO PICTURE S9(10) COMP VALUE 1.
014160 02 EXEC-STARTX PICTURE S9(10) COMP VALUE 24.
014180 02 EOF1-X PICTURE S9(10) COMP VALUE 1.
014200 02 ACROSS-CONTROL PICTURE S9(10) COMP VALUE 1.
014220 02 DISPLAY-FLAG PICTURE S9(10) COMP VALUE 1.
014240 02 HEADING-FLAG PICTURE S9(10) COMP VALUE 1.
014260 02 PAGING-FLAG PICTURE S9(10) COMP VALUE 1.
014280 02 PRINT-FLAG PICTURE S9(10) COMP VALUE 1.
014300 02 SUMPRINT-FLAG PICTURE S9(10) COMP VALUE 1.
014320 02 TITLES-FLAG PICTURE S9(10) COMP VALUE 1.
014340 02 PAGE-LINES PICTURE S9(10) COMP VALUE 66.
014360 02 PRINT-LINES PICTURE S9(10) COMP VALUE 57.
014380 02 REPORT-DX PICTURE S9(10) COMP VALUE 1.
014400 02 NUMB-REPORTS PICTURE S9(10) COMP VALUE 1.
014420 02 HSPACE PICTURE S9(10) COMP VALUE 3.
014440 02 VSPACE PICTURE S9(10) COMP VALUE 1.
014460 02 LMARGIN PICTURE S9(10) COMP VALUE 1.
014480 02 RMARGIN PICTURE S9(10) COMP VALUE 72.
014500 02 SUMBREAK-FLAG PICTURE S9(10) COMP VALUE 0.
014520 02 FILLER PICTURE S9(10) COMP OCCURS 2978.
014540
014560 01 INSTR-TABLE REDEFINES CONTROL-TABLE.
014580 02 INSTR PICTURE S9(10) COMP
014600 OCCURS 3000 INDEXED BY X.
014620
014640 01 FILE-TABLE REDEFINES INSTR-TABLE.
014660 02 F-ENTRY OCCURS 200 INDEXED BY FX.
014680 04 F-TYPEV PICTURE S9(10) COMP.
014700 04 F-RECLEN PICTURE S9(10) COMP.
014720 04 F-BLKLEN PICTURE S9(10) COMP.
014740 04 F-ORIGIN PICTURE S9(10) COMP.
014760 04 F-KEYLOC PICTURE S9(10) COMP.
014780 04 F-KEYLEN PICTURE S9(10) COMP.
014800 04 F-KEYTYPE PICTURE S9(10) COMP.
014820 04 F-KEYSIGN PICTURE S9(10) COMP.
014840 04 F-PPN PICTURE S9(10) COMP.
014860 04 F-ID PICTURE X(29).
014870 04 F-OPENIO PICTURE X.
014880 04 F-DEVICE PICTURE X(6).
014900 01 DATA-BASE-TABLE REDEFINES FILE-TABLE.
014920 02 DB-ENTRY OCCURS 200 TIMES INDEXED BY BX.
014940 04 B-TYPEV PICTURE S9(10) COMP.
014960 04 FILLER PICTURE X(18).
014980 04 B-SUBSCHEMA PICTURE X(30).
015000 04 B-SCHEMA PICTURE X(30).
015020 04 B-PASSWORD PICTURE X(06).
015040 01 RD-AD-SD-TABLE REDEFINES DATA-BASE-TABLE.
015060 02 R-ENTRY OCCURS 200 TIMES INDEXED BY RX.
015080 04 R-TYPEV PICTURE S9(10) COMP.
015100 04 R-NCHAR PICTURE S9(10) COMP.
015120 04 R-SCALE PICTURE S9(10) COMP.
015140 04 FILLER PICTURE X(12).
015160 04 R-FCHAR PICTURE S9(10) COMP.
015180 04 FILLER PICTURE X(6).
015200 04 R-ENDKEY PICTURE X(30).
015220 04 R-AREA-SET PICTURE S9(10) COMP.
015240 04 R-REC-NO PICTURE S9(10) COMP.
015260 04 FILLER PICTURE X(6).
015280 01 DICTIONARY-TABLE REDEFINES RD-AD-SD-TABLE.
015300 02 D-ENTRY OCCURS 200 INDEXED BY DX.
015320 04 D-TYPEV PICTURE S9(10) COMP.
015340 04 D-NCHAR PICTURE S9(10) COMP.
015360 04 D-SCALE PICTURE S9(10) COMP.
015380 04 D-ECHAR PICTURE S9(10) COMP.
015400 04 D-TCHAR PICTURE S9(10) COMP.
015420 04 D-FCHAR PICTURE S9(10) COMP.
015440 04 D-NREPEATS PICTURE S9(10) COMP.
015460 04 D-GRPLEN PICTURE S9(10) COMP.
015480 04 D-TITLE1 PICTURE X(10).
015500 04 D-TITLE2 PICTURE X(10).
015520 04 D-PICT PICTURE X(20).
015540 04 D-GRPNAME PICTURE X.
015560 04 D-STOPV PICTURE X.
015580
015600 01 VARIABLE-TABLE REDEFINES DICTIONARY-TABLE.
015620 02 V-ENTRY OCCURS 200 INDEXED BY VX.
015640 04 V-TYPEV PICTURE S9(10) COMP.
015660 04 V-NCHAR PICTURE S9(10) COMP.
015680 04 V-SCALE PICTURE S9(10) COMP.
015700 04 V-ECHAR PICTURE S9(10) COMP.
015720 04 V-TCHAR PICTURE S9(10) COMP.
015740 04 V-BINARY PICTURE S9(18) COMP.
015760 04 V-WORK PICTURE S9(10) COMP.
015780 04 V-TITLE1 PICTURE X(10).
015800 04 V-TITLE2 PICTURE X(10).
015820 04 V-PICT PICTURE X(20).
015840 04 FILLER PICTURE XX.
015860
015880 01 CONSTANT-TABLE REDEFINES VARIABLE-TABLE.
015900 02 C-ENTRY OCCURS 200 INDEXED BY CX.
015920 04 C-TYPEV PICTURE S9(10) COMP.
015940 04 C-NCHAR PICTURE S9(10) COMP.
015960 04 C-SCALE PICTURE S9(10) COMP.
015980 04 FILLER PICTURE X(12).
016000 04 C-BINARY PICTURE S9(18) COMP.
016020 04 C-NUMERIC PICTURE S9(18).
016040 04 FILLER PICTURE X(30).
016060
016080 01 LITERAL-TABLE REDEFINES CONSTANT-TABLE.
016100 02 L-ENTRY OCCURS 200 INDEXED BY LX.
016120 04 L-TYPEV PICTURE S9(10) COMP.
016140 04 L-NCHAR PICTURE S9(10) COMP.
016160 04 L-VALUE PICTURE X(72).
016180 04 FILLER PICTURE X(06).
016200 01 KEY-TABLE REDEFINES LITERAL-TABLE.
016220 02 K-ENTRY OCCURS 200 TIMES INDEXED BY KX.
016240 04 K-TYPEV PICTURE S9(10) COMP.
016260 04 K-NCHAR PICTURE S9(10) COMP.
016280 04 K-STARTKEY PICTURE X(30).
016300 04 K-ENDKEY PICTURE X(30).
016320 04 FILLER PICTURE X(18).
016340 01 PROTECTION-PD-TABLE REDEFINES KEY-TABLE.
016360 02 P-ENTRY OCCURS 200 TIMES INDEXED BY FPX.
016380 04 P-TYPEV PICTURE S9(10) COMP.
016400 04 P-DYNREFNO PICTURE 99.
016420 04 P-DYNDATEFLAG PICTURE X.
016440 04 P-DYNPROTLINE PICTURE X.
016460 04 P-DYNPASSWORD PICTURE X(06).
016480 04 FILLER PICTURE X(74).
016500 01 AUTHORITY-TABLE REDEFINES PROTECTION-PD-TABLE.
016520 02 A-ENTRY OCCURS 200 TIMES INDEXED BY AX.
016540 04 A-TYPEV PICTURE S9(10) COMP.
016560 04 FILLER PICTURE X(36).
016580 04 AUTH-PASSWORD PICTURE X(06).
016600 04 FILLER PICTURE X(42).
016620
016622* 01 INTERRUPT-FLAG INDEX.
016624* 01 INTERRUPT-ERROR INDEX.
016640*$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
016660*$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
016680
016700* *==WHEN READY, CAN SIMPLY REPLACE ALL
016720* *==MOVE INSTR (X) TO INSTRX WITH
016740* *==ENTER MACRO IQGETX==
016760
016780*$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
016800*$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
016820
016840* SOME CONVENTIONS:
016860* FLAG-VERB: A COUNT OR INDICATOR WITHIN A 1ST PASS
016880* SYNTAX PROCESSOR TO INDICATE TO THAT
016900* PROCESSOR WHETHER THIS IS 1ST TIME HERE.
016920* FLAG-PASS=9: SERIOUS ERROR-QUIT NOW
016940* V=1: END OF QUERY STATEMENTS HAS BEEN REACHED
016960* THE FOLLOWING 4 FLAGS ARE PASSED TO IQA VIA IQL IN THE
016980* QTNNNI.TMP INFO FILE-VALUES SHOWN ARE THE DEFAULTS
017000* FLAG-DUMP=0: IF = 1,IQA SHOULD WRITE OUT ANALYSIS
017020* FILE AS IQDUMP.TMP
017040* FLAG-EXECUTE=1:IF = 1,IQA SHOULD WRITE OUT ANALYSIS
017060* FILES AS QTNNNA.TMP AND PASS CONTROL
017080* CONTROL TO IQE WHEN IQA IS DONE
017100* IF = 0,IQA SHOULD NOT WRITE A QTNNNA.TMP FILE
017120* AND SHOULD RETURN CONTROL TO IQL WHEN DONE.
017140* FLAG-SAVE=0: IF = 1,IQA SHOULD WRITE OUT ANALYSIS
017160* BY A NAME INDICATED BY QRY-NAME
017180* FLAG-LIST=1: IF = 1,IQA SHOULD LIST QUERY AS ITS ANALYZED.
017182* FLAG-TMP-INPUT:IF = 0, IQA READS QUERY INPUT FROM "QCnnnS.TMP" FILE
017184* IF = 1, IQA READS QUERY INPUT FROM "QTnnnS.TMP" FILE
017200 PROCEDURE DIVISION.
017220 START-OF-QANAL.
017222* SET INTERRUPT-FLAG TO 0.
017224* CALL SETINT USING 5,INTERRUPT-FLAG,INTERRUPT-ERROR.
017226* IF INTERRUPT-ERROR NOT = 0
017228* DISPLAY '? ERROR IN SETINT' STOP RUN.
017240 ENTER MACRO CLRTTY.
017260* GET JOB # TO BE USED AS PART OF TEMP FILE NAMES
017280 ENTER MACRO IQGJOB USING JOB-NO.
017300 MOVE JOB-NO TO QC-STMT-NO QT-ANAL-NO DYN-JOBNO.
017320* INITIALIZE X AND DX FOR LATER USE BY IQGETX
017340* ENTER MACRO IQSETX USING
017360* INSTR-TABLE X DICTIONARY-TABLE DX T-INSTR DD-AREA.
017380 SET DX TO DX-MAX.
017400 MOVE DX-MAX TO DX-LOWEST. ADD 1 TO DX-LOWEST.
017420 SET L TO L-MAX.
017440 SET X TO EXEC-STARTX. SET X DOWN BY 2.
017460 MOVE ZEROS TO PROJ8 USER8.
017480 MOVE 'ITMP' TO QT-ANLZ-EXT.
017500 MOVE QTANLZTMP TO FD-INLABEL.
017520* PEEK TO SEE IF QTANLZ FILE IS AVAILABLE.
017540 ENTER MACRO IQLOOK USING
017560 DEVICER,FD-INLABEL,PROJ8,USER8,I.
017580 IF I NOT EQUAL TO -1 GO TO BYPASS-CONTINUE.
017600 OPEN INPUT QTANLZ.
017620* READ FIRST(INFORMATION) RECORD PASSED FROM IQL
017640 READ QTANLZ AT END GO TO CONTINUE-START.
017660 MOVE QTANLZ-REC TO QTNNNITMP.
017662* * SEE IF INPUT SHOULD COME FROM QTnnnT.TMP, WHICH CONTAINS
017664* * A MACRO-EXPANDED QUERY.
017666 IF FLAG-TMP-INPUT = 1 MOVE 'QT' TO QCSTMT-PREFIX.
017680 CONTINUE-START.
017700 CLOSE QTANLZ.
017720 BYPASS-CONTINUE.
017740 MOVE 'ATMP' TO QT-ANLZ-EXT.
017760 MOVE QCSTMTTMP TO FD-INLABEL WORD30.
017780 ENTER MACRO IQLOOK USING
017800 DEVICER,FD-INLABEL,PROJ8,USER8,I.
017820 IF I NOT EQUAL TO -1 GO TO E009.
017840 OPEN INPUT QCSTMT.
017860 IF FLAG-LIST = 1
017880* DISPLAY ' IQA 3.0 USING ' QCSTMTTMP ' ' QTANLZTMP
017900* UPON CONSOLE.
017920 DISPLAY ' ' UPON CONSOLE.
017940 VERB-CONTROL.
017942* *CHECK FOR AN INTERRUPT REQUEST..IF SO, SIMULATE AN ERROR EXIT
017944* IF INTERRUPT-FLAG NOT = 0
017946* DISPLAY '[^E Panic interrupt detected]'
017948* MOVE 0 TO FLAG-EXECUTE GO TO QTANLZ-DAS-ENDE.
017960 IF X > X-MAX GO TO E012.
017980 IF DX < X-START IF N-RSE NOT = 3 GO TO E012.
018000 PERFORM GET-VERB THRU GET-VERB-EXIT.
018010 MOVE 0 TO FLAG-NON-VERB.
018020 IF FLAG-PASS = 2 AND V < 1 GO TO E022.
018040 IF V < 1 GO TO E005.
018060 GO TO QUERY1 OPEN1 STATEMENT1 VERB-CONTROL
018080 READ1 FINDKEY1 FINDDBMS1 COPY1
018100 CREATE1 FIND-FROM1 FIND1 SORT1
018120 AT-END1 ACCEPT1 DISPLAY1 PRINT1
018140 INVALID-KEY1 HSPACE1 VSPACE1 LMARGIN1
018160 RMARGIN1 ACROSS1 REPORT1 RPTHEAD1
018180 NEWPAGE1 PAGINGON1 PAGINGOFF1 HEADINGON1
018200 HEADINGOFF1 TITLESON1 TITLESOFF1 SUMMARYON1
018220 SUMMARYOFF1 DISPLAYON1 DISPLAYOFF1 PRINTON1
018240 PRINTOFF1 RPTDATEON1 RPTDATEOFF1 HOLD1
018260 RESET1 SET1 COMPUTE1 PAGE-LINES1
018280 FORM-LINES1 PAGE1 TALLY1 TOTAL1
018300 AVERAGE1 GOTOQT1 GOTOXT1 GOTONR1
018320 GOTO1 CALL1 IFFIRSTIME1 IFLASTIME1
018340 IFNEWPAGE1 IFNEWGROUP1 IFELSE1 IFTHEN1
018360 IF1 IFFIRST1 IFLAST1 IFANY1
018380 IFNEXT1 IFSAME1 E000 E000
018400 E000 RPTDATE1 IFEOF2 IFEOF3
018420 E000 IFBOF2 IFBOF3 E000
018440 AUTHORITY1 PICTURE1 TITLES1 MAXIMUM1
018460 MINIMUM1 E000 E000 E000
018465 E000 reopen1 rewrite1
018480 DEPENDING ON V.
018500 IF FLAG-PASS = 2 GO TO E022.
018520 GO TO E005.
018540 E000.
018541 GO TO E005.
018556 e057. add 1 to ecode.
018557 e056. add 1 to ecode.
018558 E055. ADD 1 TO ECODE.
018559 E054. ADD 1 TO ECODE.
018560 E053. ADD 1 TO ECODE.
018561 E052. ADD 1 TO ECODE.
018562 E051. ADD 1 TO ECODE.
018564 e050. add 1 to ecode.
018566 e049. add 1 to ecode.
018568 e048. add 1 to ecode.
018570 E047. ADD 1 TO ECODE.
018572 E046. ADD 1 TO ECODE.
018574 E045. ADD 1 TO ECODE.
018576 E044. ADD 1 TO ECODE.
018578 EO43. ADD 1 TO ECODE.
018580 E042. ADD 1 TO ECODE.
018600 E041. ADD 1 TO ECODE.
018620 E040. ADD 1 TO ECODE.
018640 E039. ADD 1 TO ECODE.
018660 E038. ADD 1 TO ECODE.
018680 E037. ADD 1 TO ECODE.
018700 E036. ADD 1 TO ECODE.
018720 E035. ADD 1 TO ECODE.
018740 E034. ADD 1 TO ECODE.
018760 E033. ADD 1 TO ECODE.
018780 E032. ADD 1 TO ECODE.
018800 E031. ADD 1 TO ECODE.
018820 E030. ADD 1 TO ECODE.
018840 E029. ADD 1 TO ECODE.
018860 E028. ADD 1 TO ECODE.
018880 E027. ADD 1 TO ECODE.
018900 E026. ADD 1 TO ECODE.
018920 E025. ADD 1 TO ECODE.
018940 E024. ADD 1 TO ECODE.
018960 E023. ADD 1 TO ECODE.
018980 E022. ADD 1 TO ECODE.
019000 E021. ADD 1 TO ECODE.
019020 E020. ADD 1 TO ECODE.
019040 E019. ADD 1 TO ECODE.
019060 E018. ADD 1 TO ECODE.
019080 E017. ADD 1 TO ECODE.
019100 E016. ADD 1 TO ECODE.
019120 E015. ADD 1 TO ECODE.
019140 E014. ADD 1 TO ECODE.
019160 E013. ADD 1 TO ECODE.
019180 E012. ADD 1 TO ECODE.
019200 E011. ADD 1 TO ECODE.
019220 E010. ADD 1 TO ECODE.
019240 E009. ADD 1 TO ECODE.
019260 E008. ADD 1 TO ECODE.
019280 E007. ADD 1 TO ECODE.
019300 E006. ADD 1 TO ECODE.
019320 E005. ADD 1 TO ECODE.
019340 E004. ADD 1 TO ECODE.
019360 E003. ADD 1 TO ECODE.
019380 E002. ADD 1 TO ECODE.
019400 E001. ADD 1 TO ECODE.
019420 PERFORM E-RROR THRU E-XIT.
019440 MOVE SPACES TO WORD30.
019459 IF FLAG-PASS = 9 GO TO QTANLZ-DAS-ENDE.
019460 IF FLAG-PASS = 2 GO TO VERB-RESET.
019461 move 0 to flag-if-statement.
019462 IF FLAG-EOS2 NOT = 0 GO TO VERB-RESET.
019463* NOW READ OVER REST OF STATEMENT UNTIL HIT EOS.
019464 MOVE 99 TO ECODE.
019465 READ-OVER.
019466 PERFORM GET-WORD THRU GET-WORDX.
019467 IF V = 1 GO TO QUERY1.
019468 IF FLAG-QUOTE NOT = 0 GO TO READ-OVER-LIT.
019469 IF FLAG-EOS2 NOT = 2 GO TO READ-OVER.
019470 MOVE 1 TO FLAG-EOS.
019480 GO TO VERB-RESET.
019482 READ-OVER-LIT.
019484 MOVE FLAG-QUOTE TO TEST-QUOTE. MOVE 0 TO FLAG-QUOTE.
019485 READ-OVER-LIT-LOOP.
019486 PERFORM GET-WORD THRU GET-WORDX.
019487 IF V = 1 GO TO QUERY1.
019488 IF FLAG-QUOTE NOT = TEST-QUOTE GO TO READ-OVER-LIT-LOOP.
019490 MOVE 0 TO TEST-QUOTE, FLAG-QUOTE.
019492 GO TO READ-OVER.
019500 E-RROR.
019510 MOVE 0 TO FLAG-NON-VERB.
019520* MOVE ECODE TO DCODE.
019540 IF ECODE = 022 OR ECODE = 037 OR ECODE = 009 OR
019560 ECODE = 038 OR ECODE = 012 MOVE 9 TO FLAG-PASS.
019580 IF NOT WARNING-CODE MOVE 1 TO FLAG-ERROR.
019600 IF FLAG-LIST = 0 AND FLAG-PASS = 1
019620 MOVE 2 TO FLAG-LIST
019640 DISPLAY LINE-TABLE UPON CONSOLE.
019660 IF ECODE < 001 OR ECODE > MAX-ERR-MSG
019680 MOVE 005 TO ECODE.
019700 IF ECODE = 36 OR ECODE = 42 MOVE SPACES TO IQANLZ-ERROR.
019720 MOVE ERR-MSG (ECODE) TO E-MSG.
019730 MOVE WORD30 TO HINT-WORD30.
019732 IF ECODE = 022
019734 MOVE '*PLS SUBMIT AN SPR-BUT FIRST, ' TO HINT-WORD30.
019740 DISPLAY HINT-WORD IQANLZ-ERROR UPON CONSOLE.
019760 IF ECODE = 36 MOVE '%IQA' TO IQANLZ-ERROR.
019780 MOVE ZEROS TO ECODE.
019800 E-XIT. EXIT.
019802 compute-warning.
019804 move d-title1 (dx) to warning-dataname1.
019805 move d-title2 (dx) to warning-dataname2.
019806 move warning-message-hint to word30.
019808 move 054 to ecode.
019810 perform e-rror thru e-xit.
019812 compute-warningx. exit.
019820
019840 GET-VERB.
019860 MOVE V TO VP. MOVE ZEROS TO TYPEV.
019880 IF FLAG-PASS = 2 GO TO GET-KNOWN-VERB.
019900* DONT GET NEXT WORD IF WE ALREADY HAVE IT.
019920 IF FLAG-PEEKED = 0 PERFORM GET-WORD THRU GET-WORDX.
019940 MOVE 0 TO FLAG-PEEKED.
019960* BUG OUT IF HIT END OF QUERY
019980 IF V = 1 GO TO GET-VERB-EXIT.
020000 MOVE 1 TO FLAG-QUERY.
020020 IF FLAG-QUOTE NOT EQUAL TO ZERO GO TO GET-LITERAL.
020040 IF FLAG-STATEMENT-NO = 1 MOVE V-STATEMENT-NO TO V
020060 GO TO GET-ONE-VERB.
020080 IF FLAG-ALPHA = ZEROS
020100* IF (V = V-COMPUTE OR V = V-GOTO) GO TO GOT-NON-VERB1
020120 GO TO GOT-NON-VERB.
020140 IF WORD12 = 'ACCEPT ' MOVE V-ACCEPT TO V
020160 GO TO GET-NON-VERB.
020180 IF WORD12 = 'ACROSS ' MOVE V-ACROSS TO V
020200 GO TO GET-NON-VERB.
020220 IF WORD04 = 'ALL ' AND V = V-FIND-DBMS
020240 AND VA = V-FINDSUPPRESS MOVE V-SUPPRESSALL TO VA
020250 MOVE 0 TO FLAG-SET-TO-COME
020260 GO TO GET-VERB-EXIT.
020280 IF WORD06 = 'AND ' GO TO LEGAL-AND-OR-RPAREN.
020300 IF WORD06 = 'AREA ' AND V = V-FIND-DBMS
020320 AND VA = V-FINDSUPPRESS MOVE V-SUPPRESSAREA TO VA
020330 MOVE 0 TO FLAG-SET-TO-COME
020340 GO TO GET-VERB-EXIT.
020360 IF WORD06 = 'AREA ' AND V = V-FIND-DBMS
020380 MOVE V-FINDAREA TO VA MOVE 0 TO FLAG-SET-TO-COME
020382 GO TO GET-VERB-EXIT.
020400 IF WORD06 = 'AREA ' AND V = V-INVOKE
020420 MOVE V-FINDAREA TO VA GO TO GET-NON-VERB.
020421 IF WORD12 = 'AREA-ID ' MOVE TYPE-AREA-IDENT TO TYPEV.
020422 IF WORD12 = 'AREA-NAME ' MOVE TYPE-AREA-NAME TO TYPEV.
020440 IF WORD12 = 'ASCENDING ' MOVE V-ASCENDING TO VA
020460 GO TO GET-VERB.
020480 IF WORD06 = 'AT ' AND V = V-FINDKEY
020500 MOVE V-AT-END TO VA GO TO GET-VERB.
020520 IF WORD12 = 'AUTHORITY ' MOVE V-AUTHORITY TO V
020540 GO TO GET-NON-VERB.
020560 IF WORD12 = 'AVERAGE ' MOVE V-AVERAGE TO V
020580 GO TO GET-NON-VERB.
020600 IF WORD12 = 'BEGINNING ' AND V = V-FIND
020620 MOVE V-BEGINNING TO VA GO TO GET-VERB-EXIT.
020640 IF WORD04 = 'BY ' GO TO LEGAL-BY.
020660 IF WORD06 = 'CALL ' MOVE V-CALL TO V MOVE 0 TO VA
020680 GO TO GET-NON-VERB.
020700 IF WORD12 = 'COMPUTE ' MOVE V-COMPUTE TO V
020720 GO TO GET-NON-VERB.
020740 IF WORD06 = 'COPY ' MOVE V-COPY TO V
020760 GO TO GET-ONE-VERB.
020780 IF WORD12 = 'CREATE ' MOVE V-CREATE TO V
020800 GO TO GET-NON-VERB.
020820 IF WORD12 = 'CURRENCY '
020840 AND V = V-FIND-DBMS GO TO GET-VERB.
020842 IF WORD12 = 'CURRENT ' AND V = V-FIND-DBMS
020844 MOVE 2 TO N-RSE MOVE 1 TO FLAG-SET-TO-COME
020846 GO TO GET-VERB.
020860 IF WORD30 = 'CURRENT-RECORD-KEY '
020880 MOVE TYPE-CURR-REC-KEY TO TYPEV.
020900 IF WORD12 = 'DESCENDING ' MOVE V-DESCENDING TO VA
020920 GO TO GET-VERB.
020940 IF WORD12 = 'DISPLAY ' MOVE V-DISPLAY TO V
020960 GO TO GET-NON-VERB.
020980 IF WORD12 = 'DISPLAYALL ' MOVE V-DISPLAYON TO V
021000 GO TO GET-ONE-VERB.
021020 IF WORD12 = 'DISPLAYON ' MOVE V-DISPLAYON TO V
021040 GO TO GET-ONE-VERB.
021060 IF WORD12 = 'DISPLAYOFF ' MOVE V-DISPLAYOFF TO V
021080 GO TO GET-ONE-VERB.
021090 IF WORD06 = 'ELSE ' AND FLAG-EOS = 1
021092 MOVE '"ELSE" IS PART OF AN "IF" AND' TO WORD30
021094 GO TO E056.
021100 IF WORD06 = 'ELSE ' MOVE V-ELSE TO V
021120 GO TO GET-ONE-VERB.
021140 IF WORD06 = 'END ' AND VA = V-AT-END
021160 MOVE V-AT-END TO VP GO TO GET-ONE-VERB.
021180 IF WORD06 = 'EOF ' AND V = V-FINDKEY
021200 MOVE V-EOF TO VP GO TO GET-VERB-EXIT.
021201 IF WORD12 = 'ERROR-COUNT ' MOVE TYPE-ERROR-COUNT TO TYPEV.
021202 IF WORD18 = 'ERROR-STATUS ' MOVE TYPE-ERROR-STATUS TO TYPEV.
021210* IF WORD06 = 'EXIT ' MOVE V-CALL TO V MOVE 0 TO VA
012121* GO TO GET-NON-VERB.
021220 IF WORD06 = 'FILLER' AND V = V-CREATE
021240 MOVE V-FILLER TO VAA GO TO GET-VERB.
021260 IF WORD06 = 'FIND ' MOVE V-FIND TO V
021280 MOVE ZEROS TO N-RSE VA VAA GO TO FIND-LIST.
021300 IF WORD12 = 'FORM-LINES ' MOVE V-FORM-LINES TO V
021320 GO TO GET-NON-VERB.
021340 IF WORD06 = 'FROM ' AND V = V-FIND
021360 MOVE V-FROM TO VA GO TO GET-VERB-EXIT.
021380 IF WORD06 = 'HOLD ' MOVE V-HOLD TO V
021400 GO TO GET-NON-VERB.
021420 IF WORD06 = 'GO ' MOVE V-GOTO TO V
021440 GO TO GET-VERB.
021460 IF WORD06 = 'GROUP ' MOVE V-GROUP TO V
021480 GO TO GET-ONE-VERB.
021500 IF WORD12 = 'HEADING ' MOVE V-HEADING TO V
021520 GO TO GET-NON-VERB.
021540 IF WORD12 = 'HEADINGOFF ' MOVE V-HEADINGOFF TO V
021560 GO TO GET-ONE-VERB.
021580 IF WORD12 = 'HEADINGON ' MOVE V-HEADINGON TO V
021600 GO TO GET-ONE-VERB.
021620 IF WORD12 = 'HSPACE ' MOVE V-HSPACE TO V
021640 GO TO GET-NON-VERB.
021642 IF WORD06 = 'IF '
021644 AND FLAG-IF-STATEMENT = 1 AND FLAG-EOS = 0
021646 MOVE 'change "if" to "and" ' to word30 go to E053.
021650 IF WORD06 = 'IF ' MOVE 1 to flag-if-statement.
021654 IF WORD06 = 'IF '
021656 IF V = V-FIND-DBMS IF FLAG-FINDFINI = 0
021658 GO TO GET-VERB.
021660 IF WORD06 = 'IF ' MOVE V-IF TO V
021680 GO TO IF-LIST.
021700 IF WORD12 = 'INVALID ' AND V = V-FINDKEY
021720 MOVE V-INVALID-KEY TO VA GO TO GET-VERB.
021740 IF WORD30 = 'INVOKE '
021760 MOVE V-INVOKE TO V GO TO GET-VERB.
021780 IF WORD06 = 'KEY ' AND VA = V-INVALID-KEY
021800 MOVE V-INVALID-KEY TO VP GO TO GET-ONE-VERB.
021820 IF WORD06 = 'LEFT ' MOVE V-LEFT TO V
021840 GO TO GET-VERB.
021860* IF WORD06 = 'LINE ' MOVE V-LINE TO V
021880* GO TO GET-NON-VERB.
021900 IF WORD12 = 'LMARGIN ' MOVE V-LMARGIN TO V
021920 GO TO GET-NON-VERB.
021940 IF WORD12 = 'MARGIN ' AND V = V-LEFT
021960 MOVE V-LMARGIN TO V GO TO GET-NON-VERB.
021980 IF WORD12 = 'MARGIN ' AND V = V-RIGHT
022000 MOVE V-RMARGIN TO V GO TO GET-NON-VERB.
022020 IF WORD12 = 'MAXIMUM ' MOVE V-MAXIMUM TO V
022040 GO TO GET-NON-VERB.
022060 IF WORD12 = 'MINIMUM ' MOVE V-MINIMUM TO V
022080 GO TO GET-NON-VERB.
022100 IF WORD12 = 'NARROW ' MOVE V-NARROW TO V
022120 GO TO GET-NON-VERB.
022140 IF WORD18 = 'NARROW.WIDTH ' MOVE V-NARROW TO V
022160 GO TO GET-NON-VERB.
022180 IF WORD12 = 'NEW ' MOVE V-NEW TO V
022200 GO TO GET-VERB.
022220 IF WORD12 = 'NEWPAGE ' MOVE V-NEWPAGE TO V
022240 GO TO GET-ONE-VERB.
022260 IF WORD06 = 'NEXT ' AND V = V-FIND
022280 MOVE V-NEXT TO VP GO TO GET-VERB-EXIT.
022300* IF WORD06 = 'NO ' MOVE V-NO TO V
022320* GO TO GET-VERB.
022340 IF WORD12 = 'NODISPLAY ' MOVE V-DISPLAYOFF TO V
022360 GO TO GET-ONE-VERB.
022380 IF WORD12 = 'NOHEADING ' MOVE V-HEADINGOFF TO V
022400 GO TO GET-ONE-VERB.
022420 IF WORD12 = 'NOPAGING ' MOVE V-PAGINGOFF TO V
022440 GO TO GET-ONE-VERB.
022460 IF WORD12 = 'NOPRINT ' MOVE V-PRINTOFF TO V
022480 GO TO GET-ONE-VERB.
022500 IF WORD12 = 'NOSUMMARY ' MOVE V-SUMMARYOFF TO V
022520 GO TO GET-ONE-VERB.
022540 IF WORD12 = 'NOSUMPRINT ' MOVE V-SUMMARYOFF TO V
022560 GO TO GET-ONE-VERB.
022580 IF WORD12 = 'NOTITLES ' MOVE V-TITLESOFF TO V
022600 GO TO GET-ONE-VERB.
022620 IF WORD06 = 'NR ' AND V = V-GOTO
022640 MOVE V-GOTONR TO V GO TO GET-ONE-VERB.
022660 IF WORD06 = 'OPEN ' MOVE V-OPEN TO V
022680 GO TO GET-NON-VERB.
022700 IF WORD06 = 'OF' AND V = V-IFNEWGROUP
022701 GO TO GET-VERB.
022702 IF WORD06 = 'OF ' AND V = V-FIND-DBMS
022704 GO TO GET-VERB.
022706* VAA ABOVE SET TO V-FINDSET INDICATES TO IQA THAT WHEN WE
022708* SUBSEQUENTLY READ 'SET', THAT IT SHOULD BE TREATED AS THE
022710* DBMS SET FIELD AS OPPOSED TO THE SET VERB.
022740 IF WORD06 = 'OFF ' GO TO LEGAL-OFF.
022760 IF WORD06 = 'ON ' GO TO LEGAL-ON.
022780 IF WORD06 = 'OR ' GO TO LEGAL-AND-OR-RPAREN.
022800 IF WORD06 = 'PAGE ' AND V = V-NEW
022820 MOVE V-NEWPAGE TO V GO TO GET-ONE-VERB.
022840 IF WORD06 = 'PAGE ' MOVE V-PAGE TO V
022860 GO TO GET-NON-VERB.
022880 IF WORD12 = 'PAGING ' MOVE V-PAGING TO V
022900 GO TO GET-NON-VERB.
022920 IF WORD12 = 'PAGINGOFF ' MOVE V-PAGINGOFF TO V
022940 GO TO GET-ONE-VERB.
022960 IF WORD12 = 'PAGINGON ' MOVE V-PAGINGON TO V
022980 GO TO GET-ONE-VERB.
023000 IF WORD12 = 'PAGE-LINE ' MOVE V-PAGE-LINE TO V
023020 GO TO GET-NON-VERB.
023040 IF WORD12 = 'PAGE-LINES ' MOVE V-PAGE-LINE TO V
023060 GO TO GET-NON-VERB.
023080 IF WORD12 = 'PAGE-WIDTH ' MOVE V-PAGE-WIDTH TO V
023100 GO TO GET-NON-VERB.
023120 IF WORD12 = 'PICTURE ' MOVE V-PICTURE TO V
023140 GO TO GET-NON-VERB.
023160 IF WORD12 = 'PRINT ' MOVE V-PRINT TO V
023180 GO TO GET-NON-VERB.
023200 IF WORD30 = 'PRIVACY ' AND V = V-INVOKE
023220 MOVE V-PRIVACY-KEY TO VA GO TO GET-NON-VERB.
023240 IF WORD30 = 'PRIVACY-KEY ' AND V = V-INVOKE
023260 MOVE V-PRIVACY-KEY TO VA GO TO GET-NON-VERB.
023280 IF WORD06 = 'QT ' AND V = V-GOTO
023300 MOVE V-GOTOQT TO V GO TO GET-ONE-VERB.
023320 IF WORD12 = 'RECORD ' AND (V = V-COPY OR V = V-CREATE)
023340 MOVE 'RECORD1 ' TO WORD12.
023360 IF WORD12 = 'RECORD ' GO TO LEGAL-RECORD.
023380 IF WORD12 = 'RECORD1 ' AND (V = V-COPY OR V = V-CREATE)
023400 MOVE 1 TO VA.
023420 IF WORD12 = 'RECORD2 ' AND (V = V-COPY OR V = V-CREATE)
023440 MOVE 2 TO VA.
023460 IF WORD12 = 'RECORD3 ' AND (V = V-COPY OR V = V-CREATE)
023480 MOVE 3 TO VA.
023482 IF WORD12 = 'RECORD-NAME ' MOVE TYPE-RECORD-NAME TO TYPEV.
023485 IF WORD12 = 'REOPEN '
023486 MOVE V-REOPEN TO V GO TO GET-ONE-VERB.
023500 IF WORD12 = 'REPORT ' MOVE V-REPORT TO V
023520 GO TO GET-NON-VERB.
023540 IF WORD12 = 'RESET ' MOVE V-RESET TO V
023560 GO TO GET-NON-VERB.
023580 IF WORD18 = 'RESUMEDISPLAY ' MOVE V-DISPLAYON TO V
023600 GO TO GET-ONE-VERB.
023620 IF WORD18 = 'RESUMEHEADING ' MOVE V-HEADINGON TO V
023640 GO TO GET-ONE-VERB.
023660 IF WORD18 = 'RESUMEPAGING ' MOVE V-PAGINGON TO V
023680 GO TO GET-ONE-VERB.
023700 IF WORD18 = 'RESUMEPRINT ' MOVE V-PRINTON TO V
023720 GO TO GET-ONE-VERB.
023740 IF WORD18 = 'RESUMESUMMARY ' MOVE V-SUMMARYON TO V
023760 GO TO GET-ONE-VERB.
023780 IF WORD18 = 'RESUMESUMPRINT ' MOVE V-SUMMARYON TO V
023800 GO TO GET-ONE-VERB.
023820 IF WORD18 = 'RESUMETITLES ' MOVE V-TITLESON TO V
023840 GO TO GET-ONE-VERB.
023860 IF WORD12 = 'REWRITE ' MOVE V-REWRITE TO V
023880 GO TO get-one-verb.
023900 IF WORD12 = 'RIGHT ' MOVE V-RIGHT TO V
023920 GO TO GET-VERB.
023940 IF WORD12 = 'RMARGIN ' MOVE V-RMARGIN TO V
023960 GO TO GET-NON-VERB.
023980 IF WORD12 = 'RPTDATE ' OR 'DATE ' MOVE V-RPTDATE TO V
024000 GO TO GET-NON-VERB.
024020 IF WORD12 = 'RPTHEAD ' MOVE V-RPTHEAD TO V
024040 GO TO GET-NON-VERB.
024042 IF WORD12 = 'RUN-UNIT' AND V = V-FIND-DBMS
024044 MOVE V-RUN-UNIT TO VAA MOVE 0 TO FLAG-SET-TO-COME
024045 SET X UP BY 1 GO TO GET-VERB-EXIT.
024050 IF WORD30 = 'SCHEMA ' AND V = V-INVOKE
024052 MOVE V-SCHEMA TO VA GO TO GET-NON-VERB.
024060 if WORD06 = 'SET ' AND FLAG-SET-TO-COME = 0
024062 move V-SET TO V GO TO GET-NON-VERB.
024064 if WORD06 = 'SET ' MOVE 0 TO FLAG-SET-TO-COME.
024081* if WORD06 = 'SET ' AND V = V-FIND-DBMS
024082* and (VA = V-FINDSET OR VA = V-SUPPRESSSET)
024088* MOVE V-SET TO V GO TO GET-NON-VERB.
024090* ABOVE WILL INTERPRET 'SET' AS THE NON-DBMS VERB 'SET'
024092* SINCE THE WORDS SUPPRESS OR SET HAVE ALREADY APPEARED(AS INDICATED
024094* BY VA) THEREFORE THIS USE OF 'SET' MUST BE THE VERB.
024100 IF WORD06 = 'SET ' AND V = V-FIND-DBMS
024120 AND VA = V-FINDSUPPRESS MOVE V-SUPPRESSSET TO VA
024122 GO TO GET-VERB-EXIT.
024122* VAA = V-FINDSET BELOW WOULD INDICATE THAT A DBMS 'SET' SHOULD
024124* BE EXPECTED.
024126 IF WORD06 = 'SET ' IF V = V-FIND-DBMS
024128 MOVE V-FINDSET TO VA GO TO GET-VERB-EXIT.
024145* EOS OR FINDFINI TEST BELOW WOULD MEAN THAT JUST PREVIOUS
024146* TO READING 'SET' WE HIT EOS ON OUR FIND CLAUSE.
024147* THEREFORE, WE HAVE AN INDEPENDENT 'SET' VERB, NOT A
024148* PART OF FIND.
024150* IF (WORD06 = 'SET ' AND V = V-FIND-DBMS AND
024151* (FLAG-EOS = 1 OR FLAG-FINDFINI = 1))
024152* MOVE V-SET TO V GO TO GET-NON-VERB.
024160* IF WORD06 = 'SET ' AND V = V-FIND-DBMS
024180* MOVE V-FINDSET TO VA GO TO GET-VERB-EXIT.
024200* IF WORD06 = 'SET ' MOVE V-SET TO V
024220* GO TO GET-NON-VERB.
024240 IF WORD06 = 'SORT ' MOVE V-SORT TO V
024260 GO TO GET-NON-VERB.
024280 IF WORD12 = 'STITLES ' MOVE V-STITLES TO V
024300 GO TO GET-NON-VERB.
024320 IF WORD30 = 'SUB-SCHEMA ' AND V = V-INVOKE
024340 MOVE V-SUB-SCHEMA TO VA GO TO GET-NON-VERB.
024360 IF WORD12 = 'SUMMARY ' MOVE V-SUMMARY TO V
024380 GO TO GET-NON-VERB.
024400 IF WORD18 = 'SUMMARYPRINT ' MOVE V-SUMMARY TO V
024420 GO TO GET-NON-VERB.
024440 IF WORD12 = 'SUMMARYOFF ' MOVE V-SUMMARYOFF TO V
024460 GO TO GET-ONE-VERB.
024480 IF WORD12 = 'SUMMARYON ' MOVE V-SUMMARYON TO V
024500 GO TO GET-ONE-VERB.
024520 IF WORD12 = 'SUMPRINT ' MOVE V-SUMMARY TO V
024540 GO TO GET-NON-VERB.
024560 IF WORD12 = 'SUPPRESS ' AND V = V-FIND-DBMS
024580 MOVE V-FINDSUPPRESS TO VA MOVE 1 TO FLAG-SET-TO-COME
024582 GO TO GET-VERB.
024600 IF WORD12 = 'SUPPRESS ' MOVE V-SUMMARYOFF TO V
024620 GO TO GET-ONE-VERB.
024640 IF WORD12 = 'SUPPRESSED ' MOVE V-SUMMARYOFF TO V
024660 GO TO GET-ONE-VERB.
024680 IF WORD06 = 'TALLY ' MOVE V-TALLY TO V
024700 GO TO GET-NON-VERB.
024720 IF WORD06 = 'THAN ' MOVE V-THAN TO V
024740 GO TO GET-VERB.
024760 IF WORD06 = 'THEN ' GO TO GET-VERB.
024780 IF WORD06 = 'THRU ' AND V = V-FINDKEY
024800 MOVE V-THRU TO VA GO TO GET-VERB.
024820 IF WORD12 = 'TITLES ' MOVE V-TITLES TO V
024840 GO TO GET-NON-VERB.
024860 IF WORD12 = 'TITLESOFF ' MOVE V-TITLESOFF TO V
024880 GO TO GET-ONE-VERB.
024900 IF WORD12 = 'TITLESON ' MOVE V-TITLESON TO V
024920 GO TO GET-ONE-VERB.
024940 IF WORD06 = 'TO ' GO TO LEGAL-TO.
024960 IF WORD06 = 'TODAY ' MOVE TYPE-TODAY TO TYPEV.
024980 IF WORD06 = 'TOTAL ' MOVE V-TOTAL TO V
025000 GO TO GET-NON-VERB.
025020 IF WORD12 = 'UNSUPPRESS ' MOVE V-SUMMARYON TO V
025040 GO TO GET-ONE-VERB.
025060 IF WORD18 = 'UNSUPPRESSED ' MOVE V-SUMMARYON TO V
025080 GO TO GET-ONE-VERB.
025100 IF WORD12 = 'UPDATES ' AND V = V-FIND-DBMS
025120 GO TO GET-VERB.
025140 IF WORD12 = 'USING ' AND V = V-FIND
025160 MOVE V-FIND-DBMS TO V MOVE 1 TO N-RSE
025180 GO TO GET-VERB.
025200 IF WORD12 = 'VSPACE ' MOVE V-VSPACE TO V
025220 GO TO GET-NON-VERB.
025240 IF WORD12 = 'WIDTH ' MOVE V-WIDTH TO V
025260 GO TO GET-NON-VERB.
025280 IF WORD12 = 'XRANDOM ' MOVE TYPE-XRANDOM TO TYPEV.
025300 IF WORD04 = 'XT ' AND V = V-GOTO
025320 MOVE V-GOTOXT TO V GO TO GET-ONE-VERB.
025340 IF WORD02 = '= ' GO TO LEGAL-EQUALS.
025360 IF WORD02 = '( ' GO TO LEGAL-LPAREN.
025380 IF WORD02 = '+ ' AND V = V-COMPUTE
025400 MOVE V-ADD TO VA GO TO GET-VERB-EXIT.
025420 IF WORD02 = '- ' AND V = V-COMPUTE
025440 MOVE V-SUBTRACT TO VA GO TO GET-VERB-EXIT.
025460 IF WORD02 = '* ' AND V = V-COMPUTE
025480 MOVE V-MULTIPLY TO VA GO TO GET-VERB-EXIT.
025500 IF WORD02 = '/ ' AND V = V-COMPUTE
025520 MOVE V-DIVIDE TO VA GO TO GET-VERB-EXIT.
025540 IF WORD02 = ') ' AND V = V-COMPUTE
025560 MOVE V-RPAREN TO VA GO TO GET-VERB-EXIT.
025580 IF WORD02 = ') ' AND VA = V-LPAREN
025600 MOVE V-RPAREN TO VA GO TO GET-VERB-EXIT.
025620 IF WORD02 = ') ' GO TO LEGAL-AND-OR-RPAREN.
025640 IF V = ZERO GO TO GET-VERB-EXIT.
025660* BUG OUT FOR --GO TO NR/XT/QT--
025680 IF V = V-GOTO GO TO GET-VERB-EXIT.
025700 IF FLAG-EOS = 1 AND FLAG-EOS2 NOT EQUAL TO 1
025720 GO TO E005.
025740 GOT-NON-VERB.
025760* HERE TO STORE THE 1ST OBJECT OF A VERB INTO INSTR
025780* IF VERB CAN TAKE MORE THAN 1 OBJECT(IE LIST), THEY
025800* MOST LIKELY WILL BE READ UNDER CONTROL OF VERB ITSELFS
025820 IF V = 0 GO TO GET-VERB-EXIT.
025840 PERFORM DROP-IN-DX THRU DIDX.
025860 IF V = V-GOTO GO TO GET-ONE-VERB.
025880 SET X UP BY 1. SET INSTR (X) TO DX.
025900 GO TO GET-VERB-EXIT.
025920 EQ-LIST.
025940 PERFORM GET-WORD THRU GET-WORDX.
025960 IF WORD04 = 'NOT ' NEXT SENTENCE
025980 ELSE GO TO EQ-LIST1.
026000* FLIP NOT FLAG FROM ITS PREVIOUS CONDITION ENABLING NOT/NOT NOT
026020 IF FLAG-NOT = 0 MOVE 1 TO FLAG-NOT ELSE MOVE 0 TO FLAG-NOT.
026040 MOVE 1 TO VP-NOT.
026060 GO TO EQ-LIST.
026080 EQ-LIST1.
026100 IF WORD06 = 'EQ ' MOVE V-EQUAL TO VA
026120 GO TO GET-VERB.
026140 IF WORD06 = '= ' MOVE V-EQUAL TO VA
026160 GO TO GET-VERB.
026180 IF WORD06 = 'EQUAL ' MOVE V-EQUAL TO VA
026200 GO TO GET-VERB.
026220 IF WORD12 = 'EQUALS ' MOVE V-EQUAL TO VA
026240 GO TO GET-VERB.
026260 IF WORD06 = 'IS ' MOVE V-EQUAL TO VA
026280 GO TO GET-VERB.
026300 IF WORD06 = 'NQ ' MOVE V-NOTEQUAL TO VA
026320 GO TO GET-VERB.
026340 IF WORD06 = '<> ' MOVE V-NOTEQUAL TO VA
026360 GO TO GET-VERB.
026380 IF WORD06 = '# ' MOVE V-NOTEQUAL TO VA
026400 GO TO GET-VERB.
026420 IF WORD06 = 'NE ' MOVE V-NOTEQUAL TO VA
026440 GO TO GET-VERB.
026460 IF WORD06 = 'NEQ ' MOVE V-NOTEQUAL TO VA
026480 GO TO GET-VERB.
026500 IF WORD06 = 'LS ' MOVE V-LESS TO VA
026520 GO TO GET-VERB.
026540 IF WORD06 = '< ' MOVE V-LESS TO VA
026560 GO TO GET-VERB.
026580 IF WORD06 = 'LT ' MOVE V-LESS TO VA
026600 GO TO GET-VERB.
026620 IF WORD06 = 'LESS ' MOVE V-LESS TO VA
026640 GO TO GET-VERB.
026660 IF WORD06 = 'GR ' MOVE V-GREATER TO VA
026680 GO TO GET-VERB.
026700 IF WORD06 = '> ' MOVE V-GREATER TO VA
026720 GO TO GET-VERB.
026740 IF WORD06 = 'GT ' MOVE V-GREATER TO VA
026760 GO TO GET-VERB.
026780 IF WORD12 = 'GREATER ' MOVE V-GREATER TO VA
026800 GO TO GET-VERB.
026820 IF WORD06 = 'GEQ ' MOVE V-GREATEREQUAL TO VA
026840 GO TO GET-VERB.
026860 IF WORD06 = '>= ' MOVE V-GREATEREQUAL TO VA
026880 GO TO GET-VERB.
026900 IF WORD06 = 'GE ' MOVE V-GREATEREQUAL TO VA
026920 GO TO GET-VERB.
026940 IF WORD06 = 'GQ ' MOVE V-GREATEREQUAL TO VA
026960 GO TO GET-VERB.
026980 IF WORD06 = 'LEQ ' MOVE V-LESSEQUAL TO VA
027000 GO TO GET-VERB.
027020 IF WORD06 = '<= ' MOVE V-LESSEQUAL TO VA
027040 GO TO GET-VERB.
027060 IF WORD06 = 'LE ' MOVE V-LESSEQUAL TO VA
027080 GO TO GET-VERB.
027100 IF WORD06 = 'LQ ' MOVE V-LESSEQUAL TO VA
027120 GO TO GET-VERB.
027140 MOVE 029 TO ECODE.
027160 PERFORM E-RROR THRU E-XIT.
027180 MOVE V-ILLEGAL TO VA. GO TO GET-VERB.
027182 FIND-LIST0.
027184 MOVE 1 TO FLAG-SET-TO-COME.
027200 FIND-LIST.
027205 IF FLAG-NON-VERB = 1 GO TO E006.
027210 MOVE 0 TO FLAG-FINDFINI.
027220 PERFORM GET-WORD THRU GET-WORDX.
027222 IF WORD06 = 'IN ' GO TO FIND-LIST.
027224 IF WORD06 = 'OF ' GO TO FIND-LIST.
027240 IF WORD06 = 'KEY ' MOVE V-FINDKEY TO V
027260 MOVE V-FINDKEY1 TO VA GO TO GET-NON-VERB.
027280 IF WORD06 = 'KEY1 ' MOVE V-FINDKEY TO V
027300 MOVE V-FINDKEY1 TO VA GO TO GET-NON-VERB.
027320 IF WORD06 = 'KEY2 ' MOVE V-FINDKEY TO V
027340 MOVE V-FINDKEY2 TO VA GO TO GET-NON-VERB.
027360 IF WORD06 = 'KEY3 ' MOVE V-FINDKEY TO V
027380 MOVE V-FINDKEY3 TO VA GO TO GET-NON-VERB.
027382 IF WORD12 = 'CURRENT ' MOVE V-FIND-DBMS TO V
027384 MOVE 2 TO N-RSE GO TO FIND-LIST0.
027386 IF WORD12 = 'RUN-UNIT ' MOVE V-FIND-DBMS TO V
027388 MOVE V-RUN-UNIT TO VAA PERFORM DROP-IN-VERB THRU DIVX
027390 SET X UP BY 1 GO TO GET-VERB-EXIT.
027392 IF WORD12 = 'DUPLICATE ' MOVE V-FIND-DBMS TO V
027394 MOVE V-FINDUPLICATE TO VA MOVE 5 TO N-RSE
027396 MOVE 0 TO FLAG-SET-TO-COME GO TO FIND-LIST.
027398 IF WORD12 = 'WITHIN ' GO TO FIND-LIST.
027400 IF WORD06 = 'FIRST ' MOVE V-FINDFIRST TO VA
027420 MOVE V-FIND-DBMS TO V
027440 MOVE 3 TO N-RSE GO TO FIND-LIST0.
027460 IF WORD06 = 'LAST ' MOVE V-FINDLAST TO VA
027480 MOVE V-FIND-DBMS TO V
027500 MOVE 3 TO N-RSE GO TO FIND-LIST0.
027520 IF WORD06 = 'NEXT ' MOVE V-FINDNEXT TO VA
027540 MOVE V-FIND-DBMS TO V
027560 MOVE 3 TO N-RSE GO TO FIND-LIST0.
027620 IF WORD06 = 'PRIOR ' MOVE V-FINDPRIOR TO VA
027640 MOVE V-FIND-DBMS TO V
027660 MOVE 3 TO N-RSE GO TO FIND-LIST0.
027680 IF WORD06 = 'OWNER ' MOVE V-FINDOWNER TO VA
027700 MOVE V-FIND-DBMS TO V
027720 MOVE 4 TO N-RSE GO TO FIND-LIST0.
027740 IF WORD12 = 'PARTIAL ' AND V = V-FIND
027760 MOVE TYPE-PARTIAL-KEY TO VA GO TO FIND-LIST.
027780 IF WORD12 = 'RECORD ' AND VA = V-FINDOWNER
027800 MOVE V-FIND-DBMS TO V MOVE V-FINDOWNER-RECORD TO VAA
027802 GO TO FIND-LIST.
027810 IF VA = V-FINDOWNER AND VAA NOT = V-FINDOWNER-RECORD
027812 MOVE 2 TO N-RSE.
027820 PERFORM DROP-IN-VERB THRU DIVX.
027830 IF N-RSE = 3 IF WORD12 = 'RECORD '
027832 MOVE 1 TO FLAG-PEEKED SET DX TO ZERO GO TO FIND-LIST1.
027840 PERFORM DROP-IN-DX THRU DIDX.
027842 FIND-LIST1.
027860 SET X UP BY 1. SET INSTR (X) TO DX.
027880 GO TO GET-VERB-EXIT.
027900 IF-LIST.
027910 IF FLAG-NON-VERB = 1 GO TO E006.
027920 MOVE 0 TO FLAG-IF.
027940 PERFORM GET-WORD THRU GET-WORDX.
027960 MOVE ZEROS TO VA.
027980 IF FLAG-QUOTE NOT EQUAL TO ZERO
028000 MOVE 1 TO FLAG-LEFTLIT GO TO GET-LITERAL.
028020 IF WORD06 = 'ANY ' MOVE V-IFANY TO V
028040 GO TO IF-LIST.
028060 IF WORD06 = 'BOF1 ' MOVE V-BOF1 TO V
028080 GO TO GET-ONE-VERB.
028100 IF WORD06 = 'BOF2 ' MOVE V-BOF2 TO V
028120 GO TO GET-ONE-VERB.
028140 IF WORD06 = 'BOF3 ' MOVE V-BOF3 TO V
028160 GO TO GET-ONE-VERB.
028180 IF WORD06 = 'EOF1 ' MOVE V-EOF1 TO V
028200 GO TO GET-ONE-VERB.
028220 IF WORD06 = 'EOF2 ' MOVE V-EOF2 TO V
028240 GO TO GET-ONE-VERB.
028260 IF WORD06 = 'EOF3 ' MOVE V-EOF3 TO V
028280 GO TO GET-ONE-VERB.
028300 IF WORD06 = 'FIRST ' MOVE V-IFFIRST TO V
028320 GO TO IF-LIST.
028340 IF WORD06 = 'LAST ' MOVE V-IFLAST TO V
028360 GO TO IF-LIST.
028380 IF WORD06 = 'NEXT ' MOVE V-IFNEXT TO V
028400 GO TO IF-LIST.
028420 IF WORD06 = 'SAME ' MOVE V-IFSAME TO V
028440 GO TO IF-LIST.
028460 IF WORD06 = 'TIME ' AND V = V-IFFIRST
028480 MOVE V-IFFIRSTIME TO V GO TO GET-ONE-VERB.
028500 IF WORD06 = 'TIME ' AND V = V-IFLAST
028520 MOVE V-IFLASTIME TO V GO TO GET-ONE-VERB.
028540 IF (WORD12 = 'FIRSTIME ' OR
028550 WORD12 = 'FIRSTTIME ' OR WORD12 = 'FIRSTME ')
028560 MOVE V-IFFIRSTIME TO V GO TO GET-ONE-VERB.
028580 IF (WORD12 = 'LASTIME ' OR
028590 WORD12 = 'LASTTIME ' OR WORD12 = 'LASTME ')
028600 MOVE V-IFLASTIME TO V GO TO GET-ONE-VERB.
028620 IF WORD12 = 'PAGE-LINES ' MOVE V-LINE TO V
028640 GO TO EQ-LIST.
028660 IF WORD06 = 'NEW ' MOVE V-NEW TO V
028680 GO TO IF-LIST.
028700 IF WORD12 = 'NEWGROUP ' MOVE V-IFNEWGROUP TO V
028720 GO TO GET-ONE-VERB.
028740 IF WORD12 = 'NEWGRPV ' MOVE V-IFNEWGROUP TO V
028760 GO TO GET-ONE-VERB.
028780 IF WORD12 = 'NEWPAGE ' MOVE V-IFNEWPAGE TO V
028800 GO TO GET-ONE-VERB.
028820 IF WORD18 = 'PAGE ' AND V = V-NEW
028840 GO TO GET-ONE-VERB.
028980 IF WORD04 NOT = 'NOT ' GO TO IF-LIST1.
029000 IF FLAG-NOT = 0 MOVE 1 TO FLAG-NOT
029020 ELSE MOVE 0 TO FLAG-NOT.
029040 MOVE 1 TO VP-NOT.
029060 GO TO IF-LIST.
029080 IF-LIST1.
029100 IF WORD02 = '( '
029120 ADD 1 TO LPARENCNTR
029140 ADD 1 TO N-OPENLPS
029160 MOVE FLAG-NOT TO NOTT (N-OPENLPS)
029180 MOVE 0 TO VP-NOT
029200 GO TO IF-LIST.
029220* SEE IF WE JUST READ 'IF' AFTER HAVING PREVIOUSLY
029240* READ AND/OR--IF SO, RESET V AND READ OBJECT FOLLOWING
029260* 'IF'.
029280 IF V NOT = V-AND AND V NOT = V-OR GO TO IF-LIST2.
029300 MOVE 0 TO FLAG-IF. MOVE V-IF TO V.
029320 IF WORD04 = 'IF '
029322 move 'change "and/or if" to "and/or" ' to word30
029324 go to e053.
029340* HERE WHEN HAVE AND/OR NOT FOLLOWED BY 'IF'
029360 IF-LIST2.
029380 PERFORM DROP-IN-VERB THRU DIVX.
029400* IF LEFT OF RELATIONAL WAS A LITERAL, WE ALREADY HAVE ITS DX.
029420 IF FLAG-LEFTLIT = 1
029440 MOVE 0 TO FLAG-LEFTLIT
029460 ELSE PERFORM DROP-IN-DX THRU DIDX.
029480 SET DX-IFLEFTSIDE TO DX.
029500 GO TO EQ-LIST.
029520 LEGAL-BY.
029540* MOST OF THESE LEAGAL ROUTINES INITIALIZE V = 0 SO THAT
029560* IF FALL THRU ALL TESTS, WHEN CONTROL IS GIVEN TO THE
029580* DISPATCHER IN VERB-CONTROL, IT WILL CAUSE ROUTING TO
029600* E005 BECAUSE V = 0.
029620 MOVE ZEROS TO V.
029640 MOVE 1 TO FLAG-BY.
029660 IF VP = V-AVERAGE MOVE V-AVERAGE TO V
029680 GO TO GET-VERB.
029700 IF VP = V-MAXIMUM MOVE V-MAXIMUM TO V
029720 GO TO GET-VERB.
029740 IF VP = V-MINIMUM MOVE V-MINIMUM TO V
029760 GO TO GET-VERB.
029780 IF VP = V-SORT MOVE V-SORT TO V MOVE V-ASCENDING TO VA
029800 GO TO GET-VERB.
029820 IF VP = V-TALLY MOVE V-TALLY TO V
029840 GO TO GET-VERB.
029860 IF VP = V-TOTAL MOVE V-TOTAL TO V
029880 GO TO GET-VERB.
029900 GO TO GET-VERB-EXIT.
029920 LEGAL-EQUALS.
029940 IF VP = V-COMPUTE MOVE V-COMPUTE TO V
029960 MOVE V-RESULT TO VA GO TO GET-VERB-EXIT.
029980 IF (VP = V-TALLY OR VP = V-TOTAL OR VP = V-AVERAGE OR
030000 VP = V-MAXIMUM OR VP = V-MINIMUM)
030020 AND VA = V-LPAREN
030040 MOVE 1 TO FLAG-SUMMARY-DEF-TIME GO TO GET-VERB.
030060 IF VP = V-CREATE IF VAA = V-FILLER
030080 MOVE V-CREATE TO V GO TO GET-VERB.
030100 IF VP = V-CREATE MOVE V-CREATE TO V
030120 MOVE V-EQUAL TO VA GO TO GET-VERB.
030140 IF VP = V-FIND MOVE V-FIND TO V
030160 MOVE V-EQUAL TO VA GO TO GET-VERB.
030180 IF VP = V-FINDKEY MOVE V-FINDKEY TO V
030200 MOVE V-EQUAL TO VP GO TO GET-VERB-EXIT.
030220 IF VP = V-PICTURE MOVE V-PICTURE TO V
030240 MOVE V-EQUAL TO VA GO TO GET-VERB.
030260 IF VP = V-TITLES MOVE V-TITLES TO V
030280 MOVE V-EQUAL TO VA GO TO GET-VERB.
030300 IF VP = V-SET MOVE V-SET TO V MOVE V-TO TO VA
030320 GO TO GET-VERB.
030330 IF VP = V-CALL
030332 MOVE 1 TO VA GO TO GET-VERB.
030340 MOVE ZEROS TO V.
030360 GO TO GET-VERB-EXIT.
030380 LEGAL-LPAREN.
030400 IF V = V-COMPUTE
030420 MOVE V-LPAREN TO VA GO TO GET-VERB-EXIT.
030440 IF V = V-TALLY OR V = V-TOTAL OR V = V-AVERAGE OR
030460 V = V-MAXIMUM OR V = V-MINIMUM
030480 MOVE V-LPAREN TO VA GO TO GET-VERB-EXIT.
030500 MOVE ZEROS TO V.
030520 GO TO GET-VERB-EXIT.
030540 LEGAL-OFF.
030560 MOVE ZEROS TO V.
030580 IF VP = V-DISPLAY MOVE V-DISPLAYOFF TO V.
030600 IF VP = V-HEADING MOVE V-HEADINGOFF TO V.
030620 IF VP = V-PAGING MOVE V-PAGINGOFF TO V.
030640 IF VP = V-PRINT MOVE V-PRINTOFF TO V.
030660 IF VP = V-RPTDATE MOVE V-RPTDATEOFF TO V.
030680 IF VP = V-RPTHEAD MOVE V-RPTHEADOFF TO V.
030700 IF VP = V-SUMMARY MOVE V-SUMMARYOFF TO V.
030720 IF VP = V-TITLES MOVE V-TITLESOFF TO V.
030740 SET INSTR (X) TO V.
030760 GO TO GET-VERB-EXIT.
030780 LEGAL-ON.
030800 MOVE ZEROS TO V.
030820 IF VP = V-DISPLAY MOVE V-DISPLAYON TO V.
030840 IF VP = V-HEADING MOVE V-HEADINGON TO V.
030860 IF VP = V-PAGING MOVE V-PAGINGON TO V.
030880 IF VP = V-PRINT MOVE V-PRINTON TO V.
030900 IF VP = V-RPTDATE MOVE V-RPTDATEON TO V.
030920 IF VP = V-RPTHEAD MOVE V-RPTHEADON TO V.
030940 IF VP = V-SUMMARY MOVE V-SUMMARYON TO V.
030960 IF VP = V-TITLES MOVE V-TITLESON TO V.
030980 SET INSTR (X) TO V.
031000 GO TO GET-VERB-EXIT.
031020 LEGAL-RECORD.
031040 IF V = V-FIND
031060 MOVE V-FIND-DBMS TO V MOVE V-FINDRECORD TO VA
031080 GO TO GET-VERB-EXIT.
031100 IF V NOT = V-FIND-DBMS GO TO E013.
031120 IF VA = V-FINDSUPPRESS MOVE V-SUPPRESSRECORD TO VA
031140 MOVE 0 TO FLAG-SET-TO-COME GO TO GET-VERB-EXIT.
031160 MOVE V-FINDRECORD TO VA.
031180 IF N-RSE = 4 GO TO GET-VERB.
031182 IF N-RSE = 2 MOVE 0 TO FLAG-SET-TO-COME.
031190 MOVE 4 TO FLAG-VERB.
031192 GO TO GET-VERB-EXIT.
031220 LEGAL-TO.
031240 MOVE ZEROS TO V.
031260 IF VP = V-COPY MOVE V-COPY TO V
031280 MOVE V-TO TO VA GO TO GET-VERB.
031300 IF VP = V-FINDKEY MOVE V-FINDKEY TO V
031320 MOVE V-TO TO VA GO TO GET-VERB.
031340 IF VP = V-GOTO MOVE V-GOTO TO V
031360 GO TO GET-VERB.
031380 IF VP = V-SET MOVE V-SET TO V
031400 MOVE V-TO TO VA GO TO GET-VERB.
031420 GO TO GET-VERB-EXIT.
031440 LEGAL-AND-OR-RPAREN.
031460 IF VP = V-IF OR
031480 VP = V-RPAREN OR
031500 VP = V-IFFIRSTIME OR
031520 VP = V-IFLASTIME OR
031540 VP = V-BOF1 OR VP = V-BOF2 OR VP = V-BOF3 OR
031560 VP = V-EOF1 OR VP = V-EOF2 OR VP = V-EOF3 OR
031580 VP = V-IFFIRST OR VP = V-IFLAST OR VP = V-IFANY OR
031600 VP = V-IFNEXT OR VP = V-IFSAME OR
031640 VP = V-IFNEWGROUP
031660 NEXT SENTENCE
031680 ELSE MOVE ZEROES TO V GO TO GET-VERB-EXIT.
031700 IF WORD18 NOT = ') ' GO TO LEGAL-AOP2.
031720 MOVE V-RPAREN TO V.
031740* NOW SET FLAG-NOT TO NEXT LOWER PAREN LEVEL
031760 SUBTRACT 1 FROM N-OPENLPS.
031780 IF N-OPENLPS NOT = 0
031800 MOVE NOTT (N-OPENLPS) TO FLAG-NOT
031820 ELSE
031840 MOVE 0 TO FLAG-NOT.
031860 GO TO GET-NON-VERB.
031880 LEGAL-AOP2.
031900 IF WORD18 = 'AND ' MOVE V-AND TO V
031920 ELSE MOVE V-OR TO V.
031940 PERFORM DROP-IN-VERB THRU DIVX.
031960 GO TO IF-LIST.
031980 GET-ONE-VERB.
031990 IF FLAG-NON-VERB = 1 GO TO E006.
032000 SET X UP BY 1. MOVE V-NOP TO INSTR (X).
032020 IF FLAG-EOS = 1 AND FLAG-EOS2 NOT EQUAL TO 1
032040 MOVE ZERO TO FLAG-eos flag-if flag-if-statement
032060 SET X UP BY 1 MOVE V-EOS TO INSTR (X).
032080 SET X UP BY 1. MOVE V TO INSTR (X).
032100 IF FLAG-EOS = 2 MOVE 1 TO FLAG-EOS.
032120 MOVE ZERO TO FLAG-EOS2 FLAG-BY.
032140 MOVE 1 TO FLAG-VERB.
032160 GO TO GET-VERB-EXIT.
032180 GET-NON-VERB.
032200* HERE FOR VERBS THAT CAN BE FOLLOWED BY NON-VERBS
032220* (IE OBJECTS)--NOW, WRAPUP(NOP) PREVIOUS VERB IN INSTR
032240* TABLE AND INSERT CURR VERB, SET VERB-FLAG, AND GET
032260* NEXT VERB( OR NON-VERB).
032265 IF FLAG-NON-VERB = 1 GO TO E006.
032270* MOVE 1 TO FLAG-NON-VERB.
032280 SET X UP BY 1. MOVE V-NOP TO INSTR (X).
032300 IF FLAG-EOS = 1 MOVE ZERO TO FLAG-EOS
032320 MOVE ZERO TO FLAG-IF MOVE ZERO TO FLAG-if-statement
032340 SET X UP BY 1 MOVE V-EOS TO INSTR (X).
032360 SET X UP BY 1. MOVE V TO INSTR (X).
032380 MOVE 1 TO FLAG-VERB.
032382 MOVE ZERO TO FLAG-BY.
032400 GO TO GET-VERB.
032420 GET-LITERAL.
032422 if word-table not = spaces go to e057.
032440 MOVE FLAG-QUOTE TO TEST-QUOTE.
032460 MOVE ZERO TO FLAG-QUOTE.
032480 IF V = V-FINDKEY MOVE SPACE TO LCHAR.
032500* IF LCHAR = '"' OR LCHAR = "'" GO TO GET-LITERAL2.
032520 MOVE ZERO TO FLAG-SLASHES.
032540 SET DX TO DX-LOWEST. SET LX TO DX.
032560 IF V = V-COPY OR V = V-CREATE OR V = V-OPEN
032580 GO TO GET-LITERAL1.
032590 IF V = V-CALL GO TO GET-LITERAL1.
032600 IF V = V-DISPLAY GO TO GET-LITERAL1.
032620 IF V = V-FINDKEY GO TO GET-LITERAL1.
032630 IF V = V-FIND GO TO GET-LITERAL1.
032640 IF V = V-IF GO TO GET-LITERAL1.
032660 IF V = V-IFFIRST GO TO GET-LITERAL1.
032680 IF V = V-IFLAST GO TO GET-LITERAL1.
032700 IF V = V-IFANY GO TO GET-LITERAL1.
032720 IF V = V-IFNEXT GO TO GET-LITERAL1.
032740 IF V = V-IFSAME GO TO GET-LITERAL1.
032800 IF V = V-PRINT GO TO GET-LITERAL1.
032820 IF V = V-PICTURE GO TO GET-LITERAL1.
032840 IF V = V-RPTDATE GO TO GET-LITERAL1.
032860 IF V = V-RPTHEAD GO TO GET-LITERAL1.
032880 IF V = V-SET GO TO GET-LITERAL1.
032900 IF V = V-TITLES GO TO GET-LITERAL1.
032920 MOVE CHAR TO WORD30. MOVE 007 TO ECODE.
032940 PERFORM E-RROR THRU E-XIT.
032960 MOVE ZEROS TO TEST-QUOTE.
032980 GO TO GET-VERB.
033000 GET-LITERAL1.
033020 SET DX DOWN BY 1.
033040 SET X UP BY 1. SET INSTR (X) TO DX.
033060 SET LX DOWN BY 1. SET DX-LOWEST TO LX.
033080 MOVE TYPE-LITERAL TO L-TYPEV (LX).
033100 MOVE TYPE-LITERAL TO TYPEV.
033120 SET Q TO 1.
033140 MOVE SPACE TO QUOTE-TABLE.
033160 MOVE SPACE TO CHAR.
033180 GET-LITERAL2.
033200 MOVE CHAR TO LCHAR.
033220* TEST-QUOTE NOT 0 CAUSES GET-WORD TO GET ONLY 1 CHAR
033240* AT A TIME
033260 PERFORM GET-WORD THRU GET-WORDX.
033280 IF V = 1 GO TO GET-LITERALX.
033300 IF FLAG-QUOTE = TEST-QUOTE MOVE ZERO TO TEST-QUOTE
033320 SET Q DOWN BY 1
033340 GO TO GET-LITERAL3.
033360 IF CHAR = '/' AND LCHAR = '/' AND V = V-RPTHEAD
033380 GO TO GET-LITERAL4.
033400 IF CHAR = '/' AND LCHAR = '/' AND V = V-TITLES
033420 GO TO GET-LITERAL4.
033440 MOVE CHAR TO QUOTEX (Q). MOVE Q TO L-NCHAR (LX).
033460 SET Q UP BY 1.
033480 IF Q > Q-MAX SET Q TO Q-MAX GO TO GET-LITERAL3.
033500 GO TO GET-LITERAL2.
033520 GET-LITERAL3.
033540 MOVE CHAR TO LCHAR.
033560 MOVE QUOTE-TABLE TO L-VALUE (LX).
033580 MOVE Q TO L-NCHAR (LX).
033600 MOVE 1 TO FLAG-ALPHA.
033620 IF TEST-QUOTE = ZERO MOVE ZERO TO FLAG-QUOTE
033640 ELSE GO TO GET-LITERAL3A.
033660 IF FLAG-LEFTLIT = 1 SET X DOWN BY 1 GO TO IF-LIST2.
033680 GO TO GET-VERB-EXIT.
033700 GET-LITERAL3A.
033720 IF V = V-TITLES AND FLAG-SLASHES = 1
033740 SET Q TO 11 GO TO GET-LITERAL2.
033760 IF V NOT EQUAL TO V-RPTHEAD GO TO GET-LITERALX.
033780 SET X UP BY 1. SET INSTR (X) TO V-SLASHES.
033800 GO TO GET-LITERAL1.
033820 GET-LITERAL4.
033840 ADD 1 TO FLAG-SLASHES. SET Q DOWN BY 1.
033860 MOVE SPACE TO QUOTEX (Q).
033880 SET Q DOWN BY 1.
033900 GO TO GET-LITERAL3.
033920 GET-LITERALX.
033940 MOVE QUOTE-TABLE TO WORD30.
033960 MOVE 011 TO ECODE.
033980 PERFORM E-RROR THRU E-XIT.
034000 MOVE ZERO TO FLAG-QUOTE TEST-QUOTE FLAG-SLASHES.
034020 GO TO GET-VERB-EXIT.
034040 GET-FILLER.
034060 MOVE SPACE TO WORD06. MOVE SPACE TO WORDX (7).
034080 MOVE ZERO TO FLAG-ALPHA.
034100 PERFORM GET-WORDN THRU GET-WORDX.
034120 GO TO VERB-CONTROL.
034140 GET-KNOWN-VERB.
034160 PERFORM GET-INSTR THRU GET-INSTRX.
034180 GO TO GET-VERB-EXIT.
034200 GET-VERB-EXIT. EXIT.
034220 DROP-IN-DX.
034240 SET DX TO DX-MAX.
034260 IF FLAG-ALPHA = 1 GO TO DID1.
034280 IF V = V-COMPUTE OR V = V-IF OR V = V-GOTO
034320 OR V = V-RPTDATE OR V = V-OR OR V = V-AND
034340 OR V = V-SET OR V = V-PAGE OR V = V-FIND
034342 OR V = V-IFANY OR V = V-IFFIRST OR V = V-IFLAST
034344 OR V = V-IFNEXT OR V = V-IFSAME OR V = V-CALL
034360 GO TO DID1.
034380 GO TO DIDX.
034400 DID1.
034420 IF DX < DX-LOWEST GO TO DID2.
034440 SET KX TO DX.
034460 IF WORD30 NOT EQUAL TO K-ENDKEY (KX)
034480 SET DX DOWN BY 1 GO TO DID1.
034500* IF THIS PREVIOUSLY REFERENCED SUMMARY ITEM (ZZ) IS JUST
034520* NOW BEING DEFINED BY '( = ZZ)' SYNTAX, THEN MODIFY
034540* THE PREVIOUS ENTRY TO BE TYPE-SUMMARY AND CHANGE THE
034560* DUPLICATE VX ENTRY POINTER THAT IS IN THE INSTR TABLE
034580* TO BE A POINTER TO THIS OLDER ENTRY.
034600 IF FLAG-SUMMARY-DEF-TIME = 0 GO TO DID1A.
034620 IF WORD02 NOT = 'ZZ' AND WORD01 NOT = 'X'
034640 MOVE 33 TO ECODE PERFORM E-RROR THRU E-XIT.
034642 IF D-TYPEV (DX) = TYPE-SUMMARY OR
034644 D-TYPEV (DX) = TYPE-AVERAGE
034646 MOVE 33 TO ECODE
034648 MOVE 'ZZITEM HAS BEEN DEFINED TWICE' TO WORD30
034650 PERFORM E-RROR THRU E-XIT.
034660 MOVE TYPE-SUMMARY TO D-TYPEV (DX).
034680 ADD 1 TO D-NREPEATS (DX).
034700* CALC HOW FAR BACK IN THE INSTR TABLE WE MUST GO TO
034720* FIND THE DUPLICATE VX POINTER=F(BY)
034740 IF FLAG-BY = 1 MOVE 4 TO DELTA ELSE MOVE 1 TO DELTA.
034760 SET X DOWN BY DELTA.
034780 SET INSTR (X) TO DX.
034800 SET X UP BY DELTA.
034820 GO TO DID3.
034840 DID1A.
034860* IF THE ITEM FOUND IS A PRIOR-SUMMARY TYPE, CONSIDER THE
034880* SPELLING NOT FOUND, SINCE IT IS AN INTERNAL UNIQUE ITEM
034900* WHOSE SPELLING IS KEPT THE SAME AS ITS MATE SO THAT RDICT
034920* CAN COPY THE CHARACTERISTICS FROM ITS MATE.
034940 IF D-TYPEV (DX) = TYPE-PRIOR-SUMMARY
034960 SET DX DOWN BY 1 GO TO DID1.
034980* IF THE FOUND DICT ITEM IS A STATEMENT NUMBER, MAKE SURE
035000* THAT WE ARE PROCESSING A GO TO, OTHERWISE WE HAVE NOT
035020* FOUND WHAT WE ARE LOOKING FOR.
035040* SIMILIARLY, IF THE FOUND DICT ITEM IS ANOTHER TYPE OF
035060* NUMERIC VALUE, MAKE SURE WE ARE NOT HUNTING FOR A
035080* GO TO STATEMENT NUMBER.
035100 IF V = V-GOTO AND D-TYPEV (DX) NOT EQUAL TO TYPE-GOTO
035120 SET DX DOWN BY 1 GO TO DID1.
035140 IF D-TYPEV (DX) EQUAL TYPE-GOTO
035160 AND V NOT EQUAL V-GOTO
035180 SET DX DOWN BY 1 GO TO DID1.
035200* THE 'RECORD' ENTRY DOES NOT NEED TO BE UNIQUE-IT IS
035220* A TEMPORARY DUMMY NAME
035240 IF WORD06 = 'RECORD' AND
035250 D-TYPEV (DX) NOT = TYPE-RECORD-NAME
035260 SET DX DOWN BY 1 GO TO DID1.
035280 IF D-TYPEV (DX) = TYPE-CONSTANT GO TO DID1B.
035282 ADD 1 TO D-NREPEATS (DX).
035284 IF D-TYPEV (DX) = TYPE-TODAY OR
035286 D-TYPEV (DX) = TYPE-XRANDOM OR
035288 D-TYPEV (DX) = TYPE-ERROR-STATUS OR
035289 D-TYPEV (DX) = TYPE-ERROR-COUNT OR
035290 D-TYPEV (DX) = TYPE-AREA-NAME OR
035291 D-TYPEV (DX) = TYPE-AREA-IDENT OR
035292 D-TYPEV (DX) = TYPE-RECORD-NAME OR
035294 D-TYPEV (DX) = TYPE-CURR-REC-KEY
035296 GO TO DID3.
035300 IF V = V-COMPUTE
035320 MOVE TYPE-NUMERIC-VARIABLE TO D-TYPEV (DX).
035322* ALLOW SET TO REDEFINE TYPE IF SPELLING STARTS WITH
035324* X OR ZZ--THIS CASE ARISES WHEN VARIABLE IS FIRST INTRO
035326* DUCED BY OTHER THAN SET OR COMPUTE
035328 IF V = V-SET IF (WORD01 = NUM-VAR-SPELLING OR WORD02 = 'ZZ')
035330 MOVE TYPE-NUMERIC-VARIABLE TO D-TYPEV (DX).
035340 IF (V = V-ACCEPT OR V = V-DISPLAY)
035360 AND WORD01 = NUM-VAR-SPELLING
035380 MOVE TYPE-NUMERIC-VARIABLE TO D-TYPEV (DX).
035400* FOR ACCEPTED AND DISPLAY ALPHA VAR, SET NCHAR NON-ZERO
035420* SO WONT GET ERROR IN DUP5 PARAGRAPH CHECK.
035440* IF (V = V-ACCEPT OR V = V-DISPLAY)
035460* AND WORD01 = ALPHA-VAR-SPELLING
035480* MOVE 1 TO D-NCHAR (DX).
035520 IF D-TYPEV (DX) NOT EQUAL TO TYPE-FILE GO TO DID3.
035540 IF V = V-OPEN OR V = V-CREATE OR V = V-SORT OR
035560 V = V-COPY GO TO DID3.
035580* CAN'T REFERENCE A FILE NAME EXCEPT FOR OPEN, SORT ETC
035600 GO TO E040.
035602 DID1B.
035604 SET CX TO DX.
035606 IF NUMBN NOT = C-BINARY (CX) OR
035608 SCALE NOT = C-SCALE (CX)
035610 SET DX DOWN BY 1 GO TO DID1.
035612 GO TO DID3.
035620 DID2.
035640 SET KX TO DX.
035660* IF THIS NEW ITEM IS A SUMMARY ITEM THAT IS BEING
035680* DEFINED NOW IE ( = ZZ) THEN RATHER THAN INSERTING
035700* AN ENTIRE NEW ITEM, JUST STORE THE ZZ SPELLING
035720* INTO THE VX BUCKET THAT HAS ALREADY BEEN RESERVED
035740* FOR IT AND IS POINTED TO BY EITHER
035760* PREV OR CURR-BUCKETDX
035780 IF FLAG-SUMMARY-DEF-TIME = 0 GO TO DID2A.
035800 IF WORD02 NOT = 'ZZ' AND WORD01 NOT = 'X'
035820 MOVE 33 TO ECODE PERFORM E-RROR THRU E-XIT.
035840 IF PREV-BUCKETDX = 0 SET DX TO CURR-BUCKETDX
035860 ELSE SET DX TO PREV-BUCKETDX.
035880 SET KX TO DX.
035900 MOVE WORD30 TO K-ENDKEY (KX).
035920 GO TO DID3.
035940 DID2A.
035960 MOVE WORD30 TO K-ENDKEY (KX).
035980* D-NREPEATS BELOW USED TO SEE HOW MANY TIMES VARIABLES
036000* ARE REFERENCED-ONCE MEANS ERROR-MOST LIKELY A
036020* MIS-SPELLED DATA ITEM.
036040 ADD 1 TO D-NREPEATS (DX).
036060 MOVE TYPE-VARIABLE TO D-TYPEV (DX).
036070 SET DX-LOWEST TO DX.
036072 IF V = V-COMPUTE
036074 MOVE TYPE-NUMERIC-VARIABLE TO D-TYPEV (DX).
036080 IF TYPEV = TYPE-TODAY MOVE TYPEV TO D-TYPEV (DX)
036090 GO TO DID3.
036100 IF TYPEV = TYPE-XRANDOM MOVE TYPEV TO D-TYPEV (DX)
036101 GO TO DID3.
036122 IF WORD30 = 'AREA-NAME '
036123 MOVE TYPE-AREA-NAME TO D-TYPEV (DX).
036124 IF WORD30 = 'AREA-ID '
036125 MOVE TYPE-AREA-IDENT TO D-TYPEV (DX).
036126 IF WORD30 = 'RECORD-NAME '
036128 MOVE TYPE-RECORD-NAME TO D-TYPEV (DX).
036130 IF WORD30 = 'CURRENT-RECORD-KEY'
036132 MOVE TYPE-CURR-REC-KEY TO D-TYPEV (DX).
036134 IF WORD30 = 'ERROR-COUNT '
036136 MOVE TYPE-ERROR-COUNT TO D-TYPEV (DX).
036137 IF WORD30 = 'ERROR-STATUS '
036138 MOVE TYPE-ERROR-STATUS TO D-TYPEV (DX).
036180* ALLOW SET TO DEFINE NUM-VAR IF SPELLING STARTS WITH 'X'/'ZZ'.
036200 IF V = V-SET IF (WORD01 = NUM-VAR-SPELLING OR WORD02 = 'ZZ')
036220 MOVE TYPE-NUMERIC-VARIABLE TO D-TYPEV (DX).
036240 IF (V = V-ACCEPT OR V = V-DISPLAY)
036260 AND (WORD01 = NUM-VAR-SPELLING OR WORD02 = 'ZZ')
036280 MOVE TYPE-NUMERIC-VARIABLE TO D-TYPEV (DX).
036300* FOR ACCEPT OR DISPLAY DEFINED ALPHA VAR, SET
036320* NCHAR NON-ZERO SO WONT GET ERROR IN DUP5 PARAGRAPH TEST.
036340* IF (V = V-ACCEPT OR V = V-DISPLAY)
036360* AND WORD01 = ALPHA-VAR-SPELLING
036380* MOVE 1 TO D-NCHAR (DX).
036400 IF FLAG-ALPHA = 1 GO TO DID3.
036420* HERE FOR NUMERICS, SET NC,SCALE VALUES AS SET BY GET-WORD
036440 IF V = V-GOTO MOVE TYPE-GOTO TO D-TYPEV (DX)
036460 GO TO DID3.
036480 SET CX TO DX.
036500 MOVE TYPE-CONSTANT TO D-TYPEV (DX).
036520* VALUES BELOW GOTTEN BY GET-WORD.
036540 MOVE NCHAR TO C-NCHAR (CX).
036560 MOVE SCALE TO C-SCALE (CX).
036580 MOVE NUMBN TO C-BINARY (CX).
036600 DID3.
036620 MOVE D-TYPEV (DX) TO TYPEV.
036640 DIDX. EXIT.
036660 DROP-IN-VERB.
036680 SET X UP BY 1. MOVE V-NOP TO INSTR (X).
036700 IF FLAG-EOS = 1 MOVE ZERO TO FLAG-EOS
036720 MOVE ZERO TO FLAG-IF
036740 SET X UP BY 1 MOVE V-EOS TO INSTR (X).
036760 SET X UP BY 1. MOVE V TO INSTR (X).
036780 MOVE 1 TO FLAG-VERB.
036800 DIVX. EXIT.
036820 GET-WORD.
036840 MOVE ZERO TO FLAG-ALPHA FLAG-SIGN FLAG-STATEMENT-NO.
036860 MOVE ZEROS TO FLAG-EOS2. MOVE ZERO TO FLAG-DECIMAL.
036880 MOVE ZEROS TO FLAG-BAD-CHAR.
036900 MOVE ZEROS TO NUMBN. MOVE ZEROS TO SCALE.
036920 SET W TO ZEROS. MOVE SPACE TO WORD-TABLE.
036940 SET L UP BY 1. IF L > 80 GO TO GET-QUERY.
036960 MOVE LINEX (L) TO CHAR.
036980 IF CHAR = "'" MOVE 1 TO FLAG-QUOTE
036990 move 0 to flag-all-blank-line go to get-wordx.
037000 IF CHAR = '"' MOVE 2 TO FLAG-QUOTE
037010 move 0 to flag-all-blank-line go to get-wordx.
037020 IF TEST-QUOTE NOT EQUAL TO ZERO GO TO GET-WORDX.
037040 IF CHAR = SPACE GO TO GET-WORD.
037042* are we introducing a comment? if so, get next query line.
037044 if char ='*' and flag-all-blank-line = 1 go to get-query.
037046 move 0 to flag-all-blank-line.
037060 MOVE SPACE TO LCHAR.
037080 IF CHAR = ',' GO TO GET-WORD.
037100 IF CHAR = ';' MOVE V-CONCAT TO NUMBN GO TO GET-WORDX.
037120 GET-WORD1.
037140 MOVE W TO NCHAR.
037160 MOVE LINEX (L) TO CHAR.
037180 IF CHAR = "'" MOVE 1 TO FLAG-QUOTE GO TO GET-WORDX.
037200 IF CHAR = '"' MOVE 2 TO FLAG-QUOTE GO TO GET-WORDX.
037220 IF TEST-QUOTE NOT EQUAL TO ZERO GO TO GET-WORDX.
037240 IF CHAR = SPACE GO TO GET-WORDN.
037260 IF LCHAR = '*' SET L TO L-MAX GO TO GET-WORDN.
037280 IF CHAR = ',' GO TO GET-WORDN.
037300 IF CHAR = ';' SET L DOWN BY 1 GO TO GET-WORDN.
037302 IF CHAR = '$' IF ECODE NOT = 0 GO TO GET-RDOVRX.
037304 IF CHAR = '.' IF ECODE NOT = 0 GO TO GET-WORD3.
037306 GET-WORD1A.
037320 IF CHAR = '.' AND FLAG-DECIMAL = ZERO AND FLAG-ALPHA = ZERO
037340 MOVE 1 TO FLAG-DECIMAL GO TO GET-WORD2.
037360 IF CHAR = '.' AND W > ZEROS
037380 MOVE 1 TO FLAG-EOS2 GO TO GET-WORDN.
037400 IF CHAR = '$' AND W > ZEROS
037420 MOVE 1 TO FLAG-EOS2 GO TO GET-WORDN.
037440 IF CHAR = '.' MOVE 1 TO FLAG-EOS GO TO GET-WORDN.
037460 IF CHAR = '$' MOVE 1 TO FLAG-EOS GO TO GET-WORDN.
037520 IF CHAR < '0' OR CHAR > '9' MOVE 1 TO FLAG-ALPHA.
037540* IF CHAR < '0' OR CHAR > 'Z' MOVE 1 TO FLAG-BAD-CHAR.
037560* IF CHAR > '9' AND CHAR < 'A' MOVE 1 TO FLAG-BAD-CHAR.
037580 IF FLAG-DECIMAL = 1 AND FLAG-ALPHA = ZERO
037600 ADD 1 TO SCALE.
037620 IF L > 3 AND W = 1 AND LCHAR = '-' AND CHAR IS NUMERIC
037640 SET W TO ZEROS
037660 MOVE ZERO TO FLAG-ALPHA MOVE 1 TO FLAG-SIGN.
037680 IF L > 3 AND W = 1 AND LCHAR = '+' AND CHAR IS NUMERIC
037700 SET W TO ZERO MOVE ZERO TO FLAG-ALPHA.
037720 SET W UP BY 1. IF W > 30 MOVE 031 TO ECODE
037740 PERFORM E-RROR THRU E-XIT SET W TO 1.
037760 MOVE CHAR TO WORDX (W).
037780 MOVE CHAR TO LCHAR.
037800 IF L = 2 AND FLAG-ALPHA = ZERO
037820 MOVE 1 TO FLAG-STATEMENT-NO GO TO GET-WORDN.
037840 GET-WORD2.
037860 SET L UP BY 1. IF L > 80 GO TO GET-WORDN.
037880 GO TO GET-WORD1.
037882 GET-WORD3.
037883* HERE WHEN FOUND DEC/PERIOD DURING ERROR CONDITION--EXIT NOW
037884* IF THIS IS A PERIOD(EOS), NOT WITHIN A LITERAL.
037886 IF FLAG-ALPHA = 1 GO TO GET-RDOVRX.
037887* IF ONLY HAVE HIT NUMERICS SO FAR, BUT HAVE ALSO HIT A .
037888* PREVIOUSLY, THEN THIS 2ND . MUST BE A PERIOD(EOS).
037890 IF FLAG-DECIMAL = 1 GO TO GET-RDOVRX.
037891 GO TO GET-PEEK.
037918 GET-QUERY.
037920 IF V = 1 GO TO GET-WORDX.
037940 READ QCSTMT AT END MOVE 1 TO V GO TO GET-WORDX.
037960 MOVE QCSTMT-REC TO LINE-TABLE.
037980 IF FLAG-LIST = 1 DISPLAY QCSTMT-REC UPON CONSOLE.
038000 IF FLAG-LIST NOT EQUAL TO 1 MOVE ZERO TO FLAG-LIST.
038020 SET L TO ZEROS.
038030 move 1 to flag-all-blank-line.
038040 GO TO GET-WORD.
038042 GET-PEEK.
038044 IF L = 80 GO TO GET-RDOVRX.
038046 SET L UP BY 1.
038048 IF LINEX (L) = SPACE SET L DOWN BY 1 GO TO GET-RDOVRX.
038050 SET L DOWN BY 1.
038052 GO TO GET-WORD1A.
038051 GET-RDOVRX.
038052 MOVE 2 TO FLAG-EOS2.
038054 GO TO GET-WORDX.
038060************************************
038080* FLAG-EOS FLAG-EOS2
038100* $VERB 1 0
038120* $ VERB 1 0
038140* VERB$ 1 1
038160* VERB $ 0 0
038180* $ VERB $ 1 0
038200* $ VERB$ 1 2
038220* $VERB$ 1 2
038240************************************
038260 GET-WORDN.
038280 IF V = V-GOTO AND FLAG-IF = 1
038300 AND FLAG-DECIMAL = 1 AND SCALE = 0
038320 MOVE 1 TO FLAG-EOS MOVE 1 TO FLAG-EOS2
038340 MOVE ZERO TO FLAG-IF
038360 GO TO GET-WORDN1.
038380* ABOVE BUGGED OUT FOR GO TO NN. WITHIN AN IF STATEMENT
038400 IF FLAG-DECIMAL = 1 AND SCALE = ZEROS
038420 AND V NOT EQUAL TO V-IF
038440 MOVE 1 TO FLAG-EOS MOVE 1 TO FLAG-EOS2.
038460 IF FLAG-EOS = 1 AND FLAG-EOS2 = 1
038480 MOVE 2 TO FLAG-EOS2.
038500 IF FLAG-EOS2 = 1 MOVE 1 TO FLAG-EOS.
038510 IF FLAG-EOS > 0 IF V = V-FIND-DBMS MOVE 1 TO FLAG-FINDFINI.
038520 GET-WORDN1.
038540 IF FLAG-EOS2 NOT EQUAL TO ZERO MOVE ZERO TO FLAG-IF.
038560 IF WORD30 = SPACE GO TO GET-WORD.
038580 if word06 = 'HELD '
038600 move '"hold" or "held-name" ' to word30 go to e048.
038660 IF FLAG-BAD-CHAR = 1 MOVE 007 TO ECODE
038680 PERFORM E-RROR THRU E-XIT GO TO GET-WORD.
038700 IF FLAG-ALPHA = 1 GO TO GET-WORDX.
038720 SET W TO 30. SET N TO 18.
038740 MOVE ZEROS TO NUMBN.
038760 GET-SHIFT.
038780* IF HAVE NUMERIC, COME HERE AND TRANSFER LEFT JUSTIFIED
038800* WORD30 TO RIGHT JUSTIFIED NUMBN.
038820 IF WORDX (W) NOT EQUAL TO SPACE GO TO GET-SHIFT1.
038840 SET W DOWN BY 1.
038860 IF W < 1 GO TO GET-WORDX.
038880 GO TO GET-SHIFT.
038900 GET-SHIFT1.
038920 MOVE WORDX (W) TO NUMBX (N).
038940 SET W DOWN BY 1. IF W < 1 GO TO GET-SHIFT2.
038960 SET N DOWN BY 1. IF N < 1 GO TO GET-SHIFT2.
038980 GO TO GET-SHIFT1.
039000 GET-SHIFT2.
039020 IF FLAG-STATEMENT-NO = 1 OR V = V-GOTO GO TO GET-WORDX.
039040 IF FLAG-SIGN = 1 MULTIPLY NUMBN BY -1 GIVING NUMBN.
039060* MOVE NUMBER-TABLE TO WORD-TABLE.
039080 GET-WORDX. EXIT.
039100 GET-TITLE.
039120* GET TITLE FOR SUMMARIES AND VARIABLES=DATA NAME
039140* SPELLING DURING SECOND PASS.
039160 EXAMINE WORD30 TALLYING ALL '-'.
039180 SET W TO 1. SET T TO ZEROS. MOVE ZEROS TO TCHAR.
039200 MOVE 10 TO TMAX. MOVE SPACE TO TITLE-TABLE.
039220 GET-TITLES.
039240 IF TALLY = ZEROS GO TO GET-TITLE2.
039260 IF TALLY = 1 GO TO GET-TITLE1.
039280 SET W UP BY 1. IF W > 30 GO TO GET-TITLEX.
039300 IF WORDX (W) = '-' SET W UP BY 1 SUBTRACT 1 FROM TALLY.
039320 GO TO GET-TITLES.
039340 GET-TITLE1.
039360 SET T UP BY 1. IF T > TMAX GO TO GET-TITLE2.
039380 MOVE WORDX (W) TO TITLEX (T).
039400 SET W UP BY 1. IF W > 30 GO TO GET-TITLEX.
039420 IF WORDX (W) = SPACE GO TO GET-TITLE2.
039440 IF WORDX (W) NOT EQUAL TO '-' GO TO GET-TITLE1.
039460 SET W UP BY 1. IF W > 30 GO TO GET-TITLEX.
039480 GET-TITLE2.
039500 IF T > 10 SUBTRACT 10 FROM T.
039520 IF T > 10 MOVE 10 TO T.
039540 IF T > TCHAR MOVE T TO TCHAR.
039560 IF TMAX = 10 MOVE 20 TO TMAX SET T TO 10
039580 GO TO GET-TITLE1.
039600 IF TITLEX (2) = SPACE MOVE SPACE TO TITLEX (1).
039620 GET-TITLEX. EXIT.
039640 CHECK-NUMERIC.
039660* THIS ROUTINE CHECKS TO SEE IF TYPE IS NUMERIC
039680* THIS ROUTINE IS INCOMPLETE
039700 IF D-TYPEV (DX) = TYPE-ALPHA MOVE 002 TO ECODE.
039720 CHECK-NUMERICX. EXIT.
039740 READ-DICT.
039760 ADD 1 TO NFILES.
039780 IF NFILES > N-INPUTFILES GO TO RDICT-XD1.
039800* FX-PRIMARY FX-SECONDARY FX-TERTIARY SET BY OPEN1 TO
039820* POINT TO APPROPRIATE DICT ENTRY FOR FD INFO
039840 IF NFILES = 1 SET FX TO FX-PRIMARY.
039860 IF NFILES = 2 SET FX TO FX-SECONDARY.
039880 IF NFILES = 3 SET FX TO FX-TERTIARY.
039900 IF FX = 1 GO TO RDICTX.
039920* FX = 1 IFF NO OPEN STATEMENT
039940 MOVE ZEROS TO FLAG-FD-FOUND FLAG-DEV-LBL-PPN.
039960 SET LX TO FX. SET LX DOWN BY 1.
039980* NCHAR(LX) POINTS TO FX WHEN LX ENTRY CONTAINS DEV LIT
040000 IF L-NCHAR (LX) = FX MOVE 1 TO FLAG-DEV-LBL-PPN.
040020 OPEN INPUT QPDICT.
040040 RDICT.
040060 READ QPDICT AT END GO TO RDICT-XD.
040080 MOVE QPDICT-REC TO FD-AREA.
040100 IF FD-IDNT = 'FD' GO TO RDICT-FD.
040120 IF FD-IDNT = 'FE' GO TO RDICT-FD.
040140 IF FLAG-FD-FOUND = ZERO GO TO RDICT.
040160 IF FD-IDNT = 'KD' GO TO RDICT-DD.
040180 IF FD-IDNT = 'DD' GO TO RDICT-DD.
040200 IF FD-IDNT = 'AD' GO TO RDICT-AD.
040220 IF FD-IDNT = 'RD' GO TO RDICT-RD.
040240 IF FD-IDNT = 'SD' GO TO RDICT-SD.
040260 IF FD-IDNT NOT = 'PD' GO TO RDICT.
040280* NOW STORE ALL PD INFO INTO PD TABLE AND MARK WHERE
040300* THIS BEGINS WITHIN THE INSTR TABLE.
040320 MOVE FD-AREA TO PD-AREA.
040340 SUBTRACT 1 FROM DX-LOWEST.
040360 SET FPX TO DX-LOWEST.
040380 IF FLAG-FIRST-PD = 0
040400 MOVE 1 TO FLAG-FIRST-PD SET PD-POINTER TO FPX.
040420 PERFORM PW-UNSCRAMBLE THRU PW-UNSCRAMBLE-EXIT.
040440 MOVE PW-WORKER7 TO P-DYNPASSWORD (FPX).
040460 MOVE PD-REF-NO TO P-DYNREFNO (FPX).
040480 MOVE TYPE-PD TO P-TYPEV (FPX).
040500 ADD 1 TO N-PD.
040520 GO TO RDICT.
040540 RDICT-FD.
040560 IF FLAG-FD-FOUND = 1 GO TO RDICT-XD.
040580 MOVE FD-NAME TO WORD30 HOLD-FD-NAME.
040600 SET KX TO FX.
040620* IS THE DICT FD THAT WE JUST READ = TO THE DICT WE ARE
040640* LOOKING FOR, IE THE PRIMARY, SECONDARY, OR TERTIARY AS
040660* DETERMINED BY PARA READ-DICT?
040680 IF WORD30 NOT EQUAL TO K-ENDKEY (KX) GO TO RDICT.
040700 MOVE 1 TO FLAG-FD-FOUND.
040720* SEE IF HAVE SPECIAL FILE SPECIFICATION FORMAT.
040740 IF FD-IDNT = 'FE' GO TO RDICT-FE.
040760 IF FD-FILETYPE = TYPE-DBMS GO TO RDICT-FD2.
040780* F-ID GETS INITIALIZED TO INFILE.EXT
040800 MOVE FD-INLABEL TO F-ID (FX).
040820* MOVE FD-PPN TO PPN-WORK.
040840* PERFORM PPN-RTN THRU PPN-EXIT.
040860* MOVE PPN TO F-PPN (FX).
040880 MOVE ZEROES TO F-PPN (FX).
040890 MOVE 'I' TO F-OPENIO (FX).
040900 RDICT-FD1.
040920 IF F-DEVICE (FX) = SPACE MOVE 'DSK' TO F-DEVICE (FX).
040940 RDICT-FD2.
040960* ADD 20 TO FILE TYPE TO DISTINGUISH FROM DATA TYPE
040980 MOVE FD-FILETYPE TO TYPEV. ADD 20 TO TYPEV.
041000 MOVE TYPEV TO F-TYPEV (FX).
041020 MOVE TYPEV TO FILETYPE.
041040* SET PRIMARY-LENGTH = RECSIZE OF MASTER FILE
041060* SECONDARY-LENGTH = RECSIZE OF SECONDARY FILE
041080* TERTIARY-LENGTH = RECSIZE OF TERTIARY FILE.
041100* SET PRIMARY-ORIGIN = 1
041120* SECONDARY-ORIGIN = PRIMARY-LENGTH
041140* TERTIARY-ORIGIN = SECONDARY ORIG + SECOND LEN
041160* SET FCHAR = MAX(PRIM,SEC,TERT ORIGIN) - 1
041180* ADJUST RECSIZE TO BE MULTIPLE OF 6 OR 7
041200 IF FILETYPE = TYPE-FILE-SIXBIT AND FD-BLKSIZE = ZEROS
041220 PERFORM ADJUST-SIXBIT THRU ADJUST-SIXT.
041240 IF FILETYPE = TYPE-FILE-ASCII AND FD-BLKSIZE = ZEROS
041260 PERFORM ADJUST-ASCII THRU ADJUST-ASCIXT.
041280 MOVE FD-RECSIZE TO F-RECLEN (FX).
041300 IF NFILES = 1 MOVE FD-RECSIZE TO PRIMARY-LENGTH
041320 MOVE CONST1 TO PRIMARY-ORIGIN
041340 MOVE PRIMARY-ORIGIN TO FCHAR.
041360 IF NFILES = 2 MOVE FD-RECSIZE TO SECONDARY-LENGTH
041380 ADD PRIMARY-ORIGIN PRIMARY-LENGTH
041400 GIVING SECONDARY-ORIGIN
041420 MOVE SECONDARY-ORIGIN TO FCHAR.
041440 IF NFILES = 3 MOVE FD-RECSIZE TO TERTIARY-LENGTH
041460 ADD SECONDARY-ORIGIN SECONDARY-LENGTH
041480 GIVING TERTIARY-ORIGIN
041500 MOVE TERTIARY-ORIGIN TO FCHAR.
041520* MOVE FCHAR TO F-ORIGIN (FX).
041540 MOVE 1 TO F-ORIGIN (FX).
041560 SUBTRACT 1 FROM FCHAR.
041580* FCHAR IS NOW ALL SET FOR THE DD'S WHICH IMMEDIATELY FOLLOW
041600* THIS FD--ONLY A SPELLING MATCH BETWEEN THE DD'S IN DICT(UP
041620* TO THE NEXT FD IN THE DICT) AND THE DD'S IN THE DYNAMIC DICT
041640* WILL BE ASSUMED TO BE IN THE FD(AND THEREFORE THE FCHAR) FOR
041660* WHICH WE JUST PROCESSED.
041680 IF FD-BLKSIZE < ZEROS
041700 MULTIPLY FD-BLKSIZE BY MINUS-ONE GIVING FD-BLKSIZE
041720 MULTIPLY FD-BLKSIZE BY FD-RECSIZE GIVING FD-BLKSIZE-L
041722 DIVIDE FD-RECSIZE INTO FD-BLKSIZE-L GIVING FD-BLKSIZE
041724 ELSE
041740 IF FD-BLKSIZE NOT EQUAL TO ZEROS
041760 AND FD-BLKSIZE NOT LESS THAN FD-RECSIZE
041780 DIVIDE FD-RECSIZE INTO FD-BLKSIZE GIVING FD-BLKSIZE.
041800 MOVE FD-BLKSIZE TO F-BLKLEN (FX).
041820 IF FILETYPE = TYPE-FILE-DBMS
041840 SET BX TO FX
041860 MOVE FD-NAME TO B-SUBSCHEMA (BX)
041880 MOVE FD-DBMS-LABEL TO B-SCHEMA (BX)
041900 MOVE FIRST-PASSWORD TO B-PASSWORD (BX)
041920 GO TO RDICT-FD3.
041940 IF FLAG-DEV-LBL-PPN = 1
041960 MOVE L-VALUE (LX) TO QUOTE-TABLE
041980 PERFORM GET-DEV-LBL-PPN THRU GET-DLP-EXIT.
042000 MOVE FD-KEYPOS TO F-KEYLOC (FX).
042020 MOVE FD-KEYLEN TO F-KEYLEN (FX).
042040 MOVE FD-KEYTYPE TO F-KEYTYPE (FX).
042060 MOVE FD-KEYSIGN TO F-KEYSIGN (FX).
042080 RDICT-FD3.
042100* SAVE FILE PROTECTION INFO FOR LATER TESTS WHEN PD
042120* IS AVAILABLE.
042140 MOVE FD-PROTECT TO FD-PROT (NFILES).
042160 MOVE FD-READ-PROTECT TO FD-RPROT (NFILES).
042180 MOVE FD-COPY-PROTECT TO FD-CPROT (NFILES).
042200 MOVE FD-REWRITE-PROTECT TO FD-REWPROT (NFILES).
042220 MOVE HOLD-FD-NAME TO FD-NAMEPROT (NFILES).
042240* NOW CONVERT PROG # AND USER # TO OCTAL
042260 ENTER MACRO IQDCOC USING PROJ10,PROJ8.
042280 ENTER MACRO IQDCOC USING USER10,USER8.
042282 IF FILETYPE = TYPE-FILE-DBMS IF FLAG-FIND = 0
042284 MOVE 047 TO ECODE PERFORM E-RROR THRU E-XIT.
042300 IF FILETYPE = TYPE-FILE-DBMS AND NFILES = 1
042320 MOVE 1 TO FLAG-RANDOM-READ1 GO TO RDICT.
042340 MOVE F-DEVICE (FX) TO DEVICER.
042360* ENTER MACRO IQLOOK USING
042380* DEVICER,FD-INLABEL,PROJ8,USER8,I.
042400* IF I = -1 GO TO RDICT.
042420* MOVE ZEROS TO PROJ8,USER8.
042440* ENTER MACRO IQLOOK USING
042460* DEVICER,FD-INLABEL,PROJ8,USER8,I.
042480* IF I = -1 GO TO RDICT.
042500* MOVE 009 TO ECODE.
042520* PERFORM E-RROR THRU E-XIT.
042540* NOW READ DD'S ASSOCIATED WITH THE FD WE JUST PROCESSED
042560* AND SET FCHAR FOR.
042580 GO TO RDICT.
042600 RDICT-FE.
042620* HERE FOR SPECIAL FILE-DEVICE SPECIFICATIONS
042640* IF DEC-20: FE-FILESPEC=DEVICE:<DIR>FILE.EXT
042660* IF DEC-10: FE-FILESPEC=DEVICE:FILE.EXT[PROJ,USER]
042680 MOVE FE-NAME TO FD-NAME.
042700 MOVE FE-FILESPEC TO QUOTE-TABLE.
042720 PERFORM GET-DEV-LBL-PPN THRU GET-DLP-EXIT.
042740 MOVE FE-FILETYPE TO FD-FILETYPE.
042760 MOVE FE-RECSIZE TO FD-RECSIZE.
042780 MOVE FE-BLKSIZE TO FD-BLKSIZE.
042800 MOVE FE-KEYPOS TO FD-KEYPOS.
042820 MOVE FE-KEYLEN TO FD-KEYLEN.
042840 MOVE FE-KEYTYPE TO FD-KEYTYPE.
042860 MOVE FE-KEYSIGN TO FD-KEYSIGN.
042880 MOVE FE-PROTECT TO FD-PROTECT.
042900 MOVE FE-PROTECT-READ TO FD-READ-PROTECT.
042920 MOVE FE-PROTECT-COPY TO FD-COPY-PROTECT.
042940 MOVE FE-PROTECT-REWRITE TO FD-REWRITE-PROTECT.
042960 GO TO RDICT-FD1.
042980 ADJUST-SIXBIT.
043000 DIVIDE FD-RECSIZE BY 6 GIVING REMAINER.
043020 IF R1 = 1 ADD 5 TO FD-RECSIZE.
043040 IF R1 = 3 ADD 4 TO FD-RECSIZE.
043060 IF R1 = 5 ADD 3 TO FD-RECSIZE.
043080 IF R1 = 6 ADD 2 TO FD-RECSIZE.
043100 IF R1 = 8 ADD 1 TO FD-RECSIZE.
043120 ADJUST-SIXT. EXIT.
043140 ADJUST-ASCII.
043160 DIVIDE FD-RECSIZE BY 7 GIVING REMAINER.
043180 IF R1 = 1 ADD 6 TO FD-RECSIZE.
043200 IF R1 = 2 ADD 5 TO FD-RECSIZE.
043220 IF R1 = 4 ADD 4 TO FD-RECSIZE.
043240 IF R1 = 5 ADD 3 TO FD-RECSIZE.
043260 IF R1 = 7 ADD 2 TO FD-RECSIZE.
043280 IF R1 = 8 ADD 1 TO FD-RECSIZE.
043300 ADJUST-ASCIXT. EXIT.
043320 RDICT-DD.
043340 MOVE QPDICT-REC TO DD-AREA.
043360 MOVE ZERO TO FLAG-DD-FOUND.
043380 MOVE DD-NAME TO WORD30.
043400* SEE IF DICT ITEM IS REFERENCED BY QUERY, RATHER THAN
043420* SEEING IF REFERENCED ITEM IS IN DICTIONARY
043440 PERFORM LOOK-IN-DX THRU LIDX.
043460 IF DX < DX-LOWEST GO TO RDICT-DD1.
043480* HERE IF FOUND ITEM.
043500 GO TO RDICT-DD5.
043520 RDICT-DD1.
043540 MOVE 1 TO FLAG-DD-FOUND.
043560 MOVE HOLD-FD-NAME TO WORD30.
043580 SET DD TO ZEROS. SET W TO ZEROS.
043600 RDICT-DD2.
043620* APPEND A DASH(-) AT END OF FILE NAME
043640 SET W UP BY 1. IF W > 30 GO TO RDICT.
043660 MOVE WORDX (W) TO CHAR.
043680 IF CHAR = SPACE MOVE '-' TO WORDX (W)
043700 GO TO RDICT-DD3.
043720 GO TO RDICT-DD2.
043740 RDICT-DD3.
043760* APPEND DATA NAME TO FILENAME-(IE FILENAME-DATANAME)
043780 SET DD UP BY 1. IF DD > 30 GO TO RDICT-DD4.
043800 MOVE DD-NAMEX (DD) TO CHAR.
043820 IF CHAR = SPACE GO TO RDICT-DD4.
043840 SET W UP BY 1. IF W > 30 GO TO RDICT-DD4.
043860 MOVE CHAR TO WORDX (W).
043880 GO TO RDICT-DD3.
043900 RDICT-DD4.
043920* SEE IF ITEM IS IN DICT AS FILENAME-DATANAME
043940 PERFORM LOOK-IN-DX THRU LIDX.
043960 IF DX < DX-LOWEST GO TO RDICT.
043980 RDICT-DD5.
044000* CHECK TO SEE IF ITEM IS PROTECTED BY PASSWORDS
044020 MOVE DD-REF-NO TO TEST-REF-NO.
044040 MOVE DD-PROTEXCL TO TEST-PROTEXCL.
044044 MOVE PW-POINTER TO PW-LIST.
044046 MOVE N-PASSWORDS TO N-PW.
044060 PERFORM UNLOCKER THRU UNLOCKER-EXIT.
044080 IF FLAG-LOCKED NOT = 1 GO TO RDICT-DD7.
044106* HERE IF USER DID NOT FURNISH PROPER PASSWORDS VIA AUTHORITY
044107* GET ADDITIONAL ONES VIA PROMPTING
044108 MOVE 'DATA ITEMS' TO ITEM-OR-FILE.
044109 IF FLAG-PW-ITEM = 0
044110 MOVE 1 TO FLAG-PW-ITEM
044111 PERFORM PASSWORD-PROMPTER THRU PROMPTX.
044112 IF N-PROMPTS = 0 GO TO RDICT-DD6.
044113 MOVE PROMPT-PW-POINTER TO PW-LIST.
044114 MOVE N-PROMPTS TO N-PW.
044115 PERFORM UNLOCKER THRU UNLOCKER-EXIT.
044116 IF FLAG-LOCKED NOT = 1 GO TO RDICT-DD7.
044117 RDICT-DD6.
044118 MOVE 14 TO ECODE. PERFORM E-RROR THRU E-XIT.
044119 RDICT-DD7.
044120 MOVE DD-TITLE1 TO D-TITLE1 (DX).
044140 MOVE DD-TITLE2 TO D-TITLE2 (DX).
044160 MOVE DD-PICT TO D-PICT (DX).
044180 MOVE DD-GRPLEN TO D-GRPLEN (DX).
044200 MOVE DD-GRPNAME TO D-GRPNAME (DX).
044220 MOVE DD-STOPV TO D-STOPV (DX).
044240* IF HAVE PRIOR-SUMMARY ITEM, PRESERVE BOTH THE FACT THAT
044260* WE HAVE A PRIOR-SUMMARY ITEM AND THE TYPE OF ITS FATHER.
044280 IF D-TYPEV (DX) = TYPE-PRIOR-SUMMARY
044300 ADD DD-TYPEV 50 GIVING D-TYPEV (DX)
044320 ELSE
044340 MOVE DD-TYPEV TO D-TYPEV (DX).
044360 MOVE DD-NCHAR TO D-NCHAR (DX).
044380 MOVE DD-SCALE TO D-SCALE (DX).
044400 MOVE DD-ECHAR TO D-ECHAR (DX).
044420 MOVE DD-TCHAR TO D-TCHAR (DX).
044440* FCHAR = F(PRIMARY,SECONDARY,TERTIARY)
044460* MODIFY FCHAR DEPENDING ON WHICH FILE ITEM IS IN
044480 ADD FCHAR TO DD-FCHAR.
044500 MOVE DD-FCHAR TO D-FCHAR (DX).
044502 IF FILETYPE NOT = 28 GO TO RDICT-DD8.
044504* *HERE IF PROCESSING DBMS; USE NREPEATS TO MARK
044506* * TYPE OF LATEST RECORD
044508 IF LATEST-RECTYPE = 7 GO TO RDICT-DD8.
044510* *USE NREPEATS < 0 TO FLAG ITEM IN SIXBIT RECORD
044512 IF DD-NREPEATS > 0
044514 SUBTRACT DD-NREPEATS FROM 0 GIVING DD-NREPEATS
044516 ELSE MOVE -1 TO DD-NREPEATS.
044518 RDICT-DD8.
044520 MOVE DD-NREPEATS TO D-NREPEATS (DX).
044540* NOW SEE IF SAME ITEM IS THERE AGAIN-POSSIBLE FOR PRIOR
044560* SUMMARY TYPES.
044580 MOVE 1 TO FLAG-CONTINUE.
044600 PERFORM LOOK-IN-DX THRU LIDX.
044620 IF DX < DX-LOWEST
044640 MOVE 0 TO FLAG-CONTINUE ELSE GO TO RDICT-DD5.
044660 IF FLAG-DD-FOUND = ZERO GO TO RDICT-DD1.
044680 GO TO RDICT.
044700 RDICT-AD.
044720 MOVE QPDICT-REC TO AD-AREA.
044740 MOVE AD-NAME TO WORD30.
044760 PERFORM LOOK-IN-DX THRU LIDX.
044780 IF DX < DX-LOWEST GO TO RDICT.
044800 SET RX TO DX.
044820 IF R-AREA-SET (RX) NOT EQUAL TO V-FINDAREA
044840 MOVE R-ENDKEY (RX) TO WORD30
044850 MOVE 013 TO ECODE PERFORM E-RROR THRU E-XIT.
044860 MOVE TYPE-DBMS-KEY TO R-TYPEV (RX).
044880 MOVE AD-ORIGIN TO R-FCHAR (RX).
044900 MOVE AD-AREA-NO TO R-SCALE (RX).
044920 MOVE AD-LENGTH TO R-NCHAR (RX).
044940 GO TO RDICT.
044960 RDICT-RD.
044980 MOVE QPDICT-REC TO RD-AREA.
045000 MOVE RD-NAME TO WORD30.
045010 MOVE RD-ORIGIN TO FCHAR. SUBTRACT 1 FROM FCHAR.
045011 MOVE RD-RECNO TO LATEST-RECTYPE.
045012 IF LATEST-RECTYPE NOT = 6 AND LATEST-RECTYPE NOT = 7
045013 DISPLAY " %RECORD TYPE IS NOT 6 OR 7; ASSUMING 7"
045014 DISPLAY " PLEASE CORRECT REC TYPES IN DICTIONARY"
045015 MOVE 7 TO LATEST-RECTYPE.
045020 PERFORM LOOK-IN-DX THRU LIDX.
045040 IF DX < DX-LOWEST GO TO RDICT.
045060 SET RX TO DX.
045080 MOVE RD-ORIGIN TO FCHAR. SUBTRACT 1 FROM FCHAR.
045100 MOVE TYPE-DBMS-KEY TO R-TYPEV (RX).
045120 MOVE RD-ORIGIN TO R-FCHAR (RX).
045140 MOVE RD-RECNO TO R-SCALE (RX).
045160 MOVE RD-RECNO TO R-REC-NO (RX).
045180 MOVE RD-LENGTH TO R-NCHAR (RX).
045200 GO TO RDICT.
045220 RDICT-SD.
045240 MOVE QPDICT-REC TO SD-AREA.
045260 MOVE SD-NAME TO WORD30.
045280 PERFORM LOOK-IN-DX THRU LIDX.
045300 IF DX < DX-LOWEST GO TO RDICT.
045320 SET RX TO DX.
045340 IF R-AREA-SET (RX) NOT EQUAL TO V-FINDSET
045360 MOVE R-ENDKEY (RX) TO WORD30
045370 MOVE 013 TO ECODE PERFORM E-RROR THRU E-XIT.
045380 MOVE TYPE-DBMS-KEY TO R-TYPEV (RX).
045400 MOVE SD-ORIGIN TO R-FCHAR (RX).
045420 MOVE SD-OWNER-REC-NO TO R-SCALE (RX).
045440 MOVE SD-OWNER-REC-NO TO R-REC-NO (RX).
045460 MOVE SD-LENGTH TO R-NCHAR (RX).
045480 GO TO RDICT.
045500 RDICT-XD.
045520 CLOSE QPDICT.
045540* DID WE SEARCH ENTIRE DICTIONARY WITHOUT A HIT?
045560 IF FLAG-FD-FOUND = 0
045580 MOVE K-ENDKEY (KX) TO WORD30
045600 GO TO E037.
045620 GO TO READ-DICT.
045640 RDICT-XD1.
045660* SET FCHAR BEYOND ALL INPUT BUFFERS.
045680 ADD PRIMARY-LENGTH SECONDARY-LENGTH TERTIARY-LENGTH 1
045700 GIVING FCHAR.
045720 RDICTX. EXIT.
045740 GET-DEV-LBL-PPN.
045760* CALLED FROM RDICT-FE,CREATE2,OPEN2A TO PROCESS FILE-SPECS
045780 IF FX < 2 MOVE 1 TO FLAG-LBL-ERROR GO TO GET-DLP-ERR.
045800 SET Q TO ZEROS. MOVE ZERO TO FLAG-LBL-ERROR.
045820* INITIALIZE DEVICE IN CASE IT IS NOT SPECIFIED
045840* F-PPN(FX) AND FD-LABEL ALREADY INITIALIZED BY CALLER
045860 MOVE "DSK" TO F-DEVICE (FX).
045880 GET-DLP.
045900 SET W TO 1. MOVE SPACE TO WORD30.
045920 GET-DEV.
045940 SET Q UP BY 1.
045960 MOVE QUOTEX (Q) TO CHAR.
045980 IF CHAR = SPACE GO TO GET-DLP-EXIT.
046000 IF CHAR = ':' GO TO GET-DEV1.
046020 IF CHAR = '.' GO TO GET-LBL.
046040 IF CHAR = '>' GO TO GET-DIR.
046060 IF CHAR = '[' GO TO GET-EXT.
046080 IF CHAR = ',' MOVE 1 TO FLAG-LBL-ERROR.
046100 IF CHAR = ']' MOVE 1 TO FLAG-LBL-ERROR.
046120 IF CHAR = '*' MOVE 1 TO FLAG-LBL-ERROR.
046140 MOVE CHAR TO WORDX (W).
046160 SET W UP BY 1. IF W > 30 MOVE 1 TO FLAG-LBL-ERROR.
046180 IF FLAG-LBL-ERROR = 1 GO TO GET-DLP-ERR.
046200 GO TO GET-DEV.
046220 GET-DEV1.
046240* GET HERE WHEN HIT : ASSUME WE JUST READ DEVICE
046260 MOVE WORD06 TO F-DEVICE (FX).
046280 GO TO GET-DLP.
046300 GET-DIR.
046320 MOVE WORD30 TO F-ID (FX).
046340 GO TO GET-DLP.
046360 GET-LBL.
046380 MOVE WORD06 TO FD-INFILE.
046400* NOW GET EXTENSION, IF SPECIFIED
046420 SET W TO 7.
046440 GET-LBL1.
046460 SET Q UP BY 1.
046480 MOVE QUOTEX (Q) TO CHAR.
046500 IF CHAR = SPACE
046520 MOVE WORD12 TO FD-LABEL GO TO GET-DLP-EXIT.
046540 IF CHAR = "["
046560 MOVE WORD12 TO FD-LABEL GO TO GET-EXT1.
046580 MOVE CHAR TO WORDX (W).
046600 IF W < 10
046620 SET W UP BY 1 GO TO GET-LBL1.
046640 GO TO GET-DLP-ERR.
046660 GET-EXT.
046680 MOVE WORD06 TO FD-INEXT.
046700 MOVE FD-LABEL TO F-ID (FX).
046720 GET-EXT1.
046740 SET PX TO 1. MOVE SPACE TO PPN-WORK.
046760 GET-PPN.
046780 MOVE QUOTEX (Q) TO CHAR.
046800 IF CHAR = SPACE GO TO GET-PPN2.
046820 MOVE CHAR TO PPN-CHAR (PX).
046840 SET Q UP BY 1. IF Q > 72 MOVE 1 TO FLAG-LBL-ERROR
046860 GO TO GET-DLP-ERR.
046880 SET PX UP BY 1. IF PX > 19 MOVE 1 TO FLAG-LBL-ERROR
046900 GO TO GET-DLP-ERR.
046920 GO TO GET-PPN.
046940 GET-PPN2.
046960 PERFORM PPN-RTN THRU PPN-EXIT.
046980* MOVE PPN TO F-PPN (FX).
047000 MOVE ZERO TO F-PPN (FX).
047020 GO TO GET-DLP-EXIT.
047040 GET-DLP-ERR.
047060 MOVE CHAR TO WORDX (W).
047080 MOVE 032 TO ECODE. PERFORM E-RROR THRU E-XIT.
047100 GET-DLP-EXIT. EXIT.
047120 PPN-RTN.
047140 IF PPN-WORK = SPACE GO TO PPN-ERR.
047160 EXAMINE PPN-WORK TALLYING ALL ','.
047180 IF TALLY NOT EQUAL TO 1 GO TO PPN-ERR.
047200 MOVE 000 TO ECODE.
047220 SET PX TO ZEROS.
047240 PPN0.
047260 MOVE ZEROS TO PPN-NUMBER PPN-HALF.
047280 SET PI TO 7.
047300 PPN1.
047320 SET PX UP BY 1. IF PX > 19 GO TO PPN-ERR.
047340 SET HX TO PX.
047360 IF PPN-CHAR (PX) = ',' GO TO PPN2.
047380 IF PPN-CHAR (PX) = ']' GO TO PPN4.
047400 IF PPN-CHAR (PX) = SPACE GO TO PPN4.
047420 GO TO PPN1.
047440 PPN2.
047460 SET PI DOWN BY 1. IF PI < 1 GO TO PPN3.
047480 SET PX DOWN BY 1. IF PX < 1 GO TO PPN3.
047500 SET PN TO PX.
047520 IF PPN-CHAR (PX) IS NUMERIC
047540 MOVE PPN-NUM (PN) TO PPN-DIGIT (PI).
047560 GO TO PPN2.
047580 PPN3.
047600 MOVE PPN-NUMBER TO PROJ10.
047620 PERFORM DEC-TO-BIN VARYING PI FROM 1 BY 1 UNTIL PI > 6.
047640 IF PPN-HALF > 32767 MOVE 001 TO ECODE.
047660 COMPUTE PPN = PPN-HALF * 262144.
047680 SET PX TO HX. GO TO PPN0.
047700 PPN4.
047720 SET PI DOWN BY 1. IF PI < 1 GO TO PPN5.
047740 SET PX DOWN BY 1. IF PX < 1 GO TO PPN5.
047760 SET PN TO PX.
047780 IF PPN-CHAR (PX) = ',' GO TO PPN5.
047800 IF PPN-CHAR (PX) IS NUMERIC
047820 MOVE PPN-NUM (PN) TO PPN-DIGIT (PI).
047840 GO TO PPN4.
047860 PPN5.
047880 MOVE PPN-NUMBER TO USER10.
047900 PERFORM DEC-TO-BIN VARYING PI FROM 1 BY 1 UNTIL PI > 6.
047920 COMPUTE PPN = PPN + PPN-HALF.
047940 IF ECODE NOT EQUAL TO 000 GO TO PPN-ERR.
047960 GO TO PPN-EXIT.
047980 DEC-TO-BIN.
048000 IF PPN-DIGIT (PI) = 8 OR 9 MOVE 001 TO ECODE.
048020 COMPUTE PPN-HALF = 8 * PPN-HALF + PPN-DIGIT (PI).
048040 PPN-ERR.
048060 MOVE 000 TO ECODE.
048080 MOVE ZEROS TO PPN PROJ10 USER10.
048100 PPN-EXIT. EXIT.
048120
048140*****************************
048160* SUBROUTINE BELOW CHECKS ANY PROTECTED ITEMS TO SEE IF
048180* THEIR PASSWORD WAS FURNISHED IN AN AUTHORITY STATEMENT.
048200*****************************
048220 UNLOCKER.
048240 IF FLAG-LOCKED = 2 GO TO UNLOCKER-EXIT.
048260* ABOVE BYPASSES PW CHECK IF UNIVERSAL PASSWORD
048280* WAS FURNISHED**.
048300 MOVE ZERO TO FLAG-LOCKED.
048320 IF TEST-REF-NO = ZERO GO TO UNLOCKER-EXIT.
048340* IF PW-LIST = 0, THEN NO PASSWORDS WERE FURNISHED.
048360 IF PW-LIST = 0
048380 MOVE 1 TO FLAG-LOCKED GO TO UNLOCKER-EXIT.
048400* SET INDEX FOR DYNAMIC PD INFO
048420 MOVE 1 TO J. SET FPX TO PD-POINTER.
048440 IF TEST-PROTEXCL = '0' GO TO UNLOCKER1.
048460 GO TO UNLOCKER-EXCL.
048480 UNLOCKER1.
048500 IF P-DYNREFNO (FPX) NOT LESS THAN TEST-REF-NO
048520 MOVE 1 TO K SET AX TO PW-LIST
048540 GO TO UNLOCKER3.
048560 UNLOCKER2.
048580 ADD 1 TO J. SET FPX DOWN BY 1.
048600 IF J IS NOT GREATER THAN N-PD GO TO UNLOCKER1.
048620 MOVE 1 TO FLAG-LOCKED. GO TO UNLOCKER-EXIT.
048640 UNLOCKER3.
048660 IF AUTH-PASSWORD (AX) = P-DYNPASSWORD (FPX)
048680 GO TO UNLOCKER-EXIT.
048700 ADD 1 TO K. SET AX DOWN BY 1.
048720 IF K IS NOT GREATER THAN N-PW GO TO UNLOCKER3.
048740 GO TO UNLOCKER2.
048760 UNLOCKER-EXCL.
048780 IF P-DYNREFNO (FPX) = TEST-REF-NO
048800 MOVE P-DYNPASSWORD (FPX) TO EFF-PASSWORD
048820 MOVE 1 TO J SET AX TO PW-LIST
048840 GO TO UNLOCKER-EXCL1.
048860 ADD 1 TO J. SET FPX DOWN BY 1.
048880 IF J IS NOT GREATER THAN N-PD GO TO UNLOCKER-EXCL.
048900 MOVE 1 TO FLAG-LOCKED.
048920 GO TO UNLOCKER-EXIT.
048940 UNLOCKER-EXCL1.
048960 IF EFF-PASSWORD = AUTH-PASSWORD (AX) GO TO UNLOCKER-EXIT.
048980 ADD 1 TO J. SET AX DOWN BY 1.
049000 IF J IS NOT GREATER THAN N-PW GO TO UNLOCKER-EXCL1.
049020 MOVE 1 TO FLAG-LOCKED.
049040 UNLOCKER-EXIT.
049060 EXIT.
049062 PASSWORD-PROMPTER.
049063 DISPLAY PROMPTER-MESSAGE UPON CONSOLE.
049064 MOVE 0 TO N-PROMPTS.
049066 PROMPT1.
049068 PERFORM CONFIDENTIAL-ASK.
049070 IF RETURNED-PASSWORD = SPACES GO TO PROMPTX.
049072 SUBTRACT 1 FROM DX-LOWEST.
049074 SET AX TO DX-LOWEST.
049076* SET PROMPT-PW-POINTER TO FIRST PASSWORD IN THIS LIST.
049078 IF N-PROMPTS = 0 SET PROMPT-PW-POINTER TO AX.
049080 ADD 1 TO N-PROMPTS.
049082 MOVE RETURNED-PASSWORD TO AUTH-PASSWORD (AX).
049084 MOVE TYPE-AUTHORITY TO A-TYPEV (AX).
049086 IF RETURNED-PASSWORD = UNIVERSAL-PASSWORD
049088 MOVE 2 TO FLAG-LOCKED.
049090 GO TO PROMPT1.
049092 PROMPTX.
049094 EXIT.
049096************************
049100* SUBROUTINE BELOW UNSCRAMBLES PASSWORDS.
049120************************
049140 PW-UNSCRAMBLE.
049160 MOVE 1 TO K.
049180 PW-UNSCRAMBLE1.
049200 MOVE PD-CHAR (K) TO PW-CHAR (K).
049220 ADD 1 TO K.
049240 IF K IS NOT GREATER THAN 12 GO TO PW-UNSCRAMBLE1.
049260 SUBTRACT PW-MASK1 FROM PW-WORK1.
049280 SUBTRACT PW-MASK2 FROM PW-WORK2.
049300 MOVE PW-CHAR (10) TO PW7-CHAR (1).
049320 MOVE PW-CHAR (9) TO PW7-CHAR (2).
049340 MOVE PW-CHAR (6) TO PW7-CHAR (3).
049360 MOVE PW-CHAR (12) TO PW7-CHAR (4).
049380 MOVE PW-CHAR (3) TO PW7-CHAR (5).
049400 MOVE PW-CHAR (2) TO PW7-CHAR (6).
049420 PW-UNSCRAMBLE-EXIT.
049440 EXIT.
049460************************
049480 DX-CLEANUP.
049500* SETS ALL NUMERIC AND SUMMARY-VAR TO S9(13)V9(5)
049520* CLEARS ECHAR TCHAR SCALE FCHAR FOR ANY OTHER VAR
049540* (IE ANYTHING ELSE EXCEPT SPECIALS LIKE XRANDOM)
049560 SET DX TO DX-MAX. SET DX UP BY 1.
049580 DUP1.
049600 SET DX DOWN BY 1. IF DX < DX-LOWEST GO TO DUP6.
049620 MOVE D-TYPEV (DX) TO TYPEV.
049640 IF TYPEV = TYPE-VARIABLE GO TO DUP2.
049660 IF TYPEV = TYPE-NUMERIC-VARIABLE GO TO DUP2.
049680 IF TYPEV = TYPE-SUMMARY GO TO DUP2.
049700 IF TYPEV = TYPE-AVERAGE GO TO DUP2.
049702 IF TYPEV = TYPE-PRIOR-SUMMARY GO TO DUP2.
049720 IF FLAG-PASS = 2 GO TO DUP1.
049740 IF TYPEV = TYPE-TODAY
049760 MOVE TODAY-AREA TO D-ENTRY (DX) GO TO DUP1.
049780 IF TYPEV = TYPE-XRANDOM
049800 MOVE XRANDOM-AREA TO D-ENTRY (DX) GO TO DUP1.
049802 IF TYPEV = TYPE-ERROR-STATUS
049804 MOVE ERROR-STATUS-AREA TO D-ENTRY(DX)
049806 GO TO DUP1.
049807 IF TYPEV = TYPE-AREA-IDENT
049808 MOVE AREA-IDENT-AREA TO D-ENTRY (DX) GO TO DUP1.
049810 IF TYPEV = TYPE-RECORD-NAME
049812 MOVE RECORD-NAME-AREA TO D-ENTRY (DX) GO TO DUP1.
049814 IF TYPEV = TYPE-AREA-NAME
049816 MOVE AREA-NAME-AREA TO D-ENTRY (DX) GO TO DUP1.
049817 IF TYPEV = TYPE-CURR-REC-KEY
049818 MOVE CURRENT-RECORD-KEY-AREA TO D-ENTRY (DX) GO TO DUP1.
049819 IF TYPEV = TYPE-ERROR-COUNT
MOVE ERROR-COUNT-AREA TO D-ENTRY (DX) GO TO DUP1.
049820 IF TYPEV = TYPE-CONSTANT
049840 SET CX TO DX
049860 MOVE C-BINARY (CX) TO C-NUMERIC (CX).
049880 GO TO DUP1.
049900 DUP2.
049920 SET KX TO DX. SET VX TO DX.
049940 MOVE K-ENDKEY (KX) TO WORD30.
049960 IF FLAG-PASS = 2 GO TO DUP4.
049980 IF TYPEV = TYPE-AVERAGE GO TO DUP1.
050000 MOVE ZEROS TO V-ECHAR (VX).
050020 MOVE TCHAR TO V-TCHAR (VX).
050040 MOVE ZEROS TO V-SCALE (VX).
050060 MOVE ZEROS TO D-FCHAR (DX).
050080 IF TYPEV = TYPE-NUMERIC-VARIABLE GO TO DUP3.
050082 IF TYPEV = TYPE-PRIOR-SUMMARY GO TO DUP3A.
050100 IF TYPEV NOT EQUAL TO TYPE-SUMMARY GO TO DUP1.
050120 MOVE 'SZ,ZZZ,ZZZ.99RRR' TO V-PICT (VX).
050140 DUP3.
050160 MOVE 18 TO V-NCHAR (VX). MOVE 5 TO V-SCALE (VX).
050180 MOVE 13 TO V-ECHAR (VX).
050200 GO TO DUP1.
050201 DUP3A.
050202* HERE FOR TYPE-PRIOR-SUMMARY WHICH CAN STILL BE
050204* IF THE BY-ITEM IS A VARIABLE
050206 IF WORD01 = ALPHA-VAR-SPELLING
050208 MOVE TYPE-VARIABLE TO DELTA
050210 ELSE
050212 MOVE TYPE-NUMERIC-VARIABLE TO DELTA.
050214 ADD 50 DELTA GIVING D-TYPEV (DX).
050216 GO TO DUP3.
050220 DUP4.
050240* HERE FOR VAR,NUM-VAR, AND SUMMARY AFTER 2ND PASS
050260 IF TYPEV = TYPE-AVERAGE GO TO DUP5.
050280 IF TYPEV = TYPE-SUMMARY GO TO DUP5.
050300* ZZ ITEMS WILL BE DEFINED AS NUM-VAR AND NOT TYPE-SUMMARY
050320* IF ZZ ITEM IS NEVER DEFINED IN SUMMARY CONTEXT IE ONLY
050340* IN A -SET ZZ- OR -COMPUTE ZZ- CONTEXT.
050360 IF TYPEV = TYPE-NUMERIC-VARIABLE AND
050380 (WORD01 NOT = NUM-VAR-SPELLING AND WORD02 NOT = 'ZZ' AND
050382 WORD05 NOT = 'HELD-')
050400 MOVE 034 TO ECODE
050420 PERFORM E-RROR THRU E-XIT GO TO DUP1.
050440 IF TYPEV = TYPE-VARIABLE AND
050460 (WORD01 NOT = ALPHA-VAR-SPELLING AND WORD05 NOT = 'HELD-')
050480 MOVE 035 TO ECODE
050500 PERFORM E-RROR THRU E-XIT
050520 MOVE SPACES TO WORD30 MOVE 036 TO ECODE
050540 PERFORM E-RROR THRU E-XIT GO TO DUP1.
050560 IF WORD01 = ALPHA-VAR-SPELLING OR WORD02 = 'ZZ' OR
050580 WORD01 = NUM-VAR-SPELLING OR WORD05 = 'HELD-'
050582 GO TO DUP5.
050600 MOVE 001 TO ECODE.
050620 PERFORM E-RROR THRU E-XIT. GO TO DUP1.
050640 DUP5.
050660 PERFORM GET-TITLE THRU GET-TITLEX.
050680 MOVE TITLE1X TO V-TITLE1 (VX).
050700 MOVE TITLE2X TO V-TITLE2 (VX).
050720 MOVE TCHAR TO V-TCHAR (VX).
050740 MOVE ZEROS TO V-WORK (VX).
050760* NOW MAKE TYPE SUMMARY SAME AS NUM-VER
050780 IF TYPEV = TYPE-SUMMARY MOVE 7 TO D-TYPEV (DX)
050800 MOVE ZEROS TO D-NREPEATS (DX)
050820 GO TO DUP1.
050840 IF TYPEV = TYPE-AVERAGE
050860 MOVE ZEROES TO D-NREPEATS (DX) GO TO DUP1.
050880* IS ITEM UNDEFINED? THIS CAN ONLY BE FOR VAR(ALPH VAR)
050900* SINCE NUM-VAR(VIA COMPUTE) ALWAYS HAS NCHAR = 18
050920 IF D-FCHAR (DX) = ZEROS AND D-NCHAR (DX) = ZEROS
050940 NEXT SENTENCE ELSE GO TO DUP5A.
050960* SINCE NEVER SET THIS VARIABLE(COULD HAPPEN FOR ACCEPT AND
050962* NO USAGE OF 'SET'), THEN ALLOCATE NOW.
050964 MOVE 12 TO D-NCHAR (DX) D-ECHAR (DX).
050966 IF FCHAR = 0 MOVE 1 TO FCHAR.
050968 MOVE FCHAR TO D-FCHAR (DX).
050970 ADD 12 TO FCHAR.
050972 DUP5A.
050980* IF VARIABLE HAS ONLY BEEN USED ONCE, IT IS INVALID,
051000* SINCE IT MUST BE BOTH SET AND GOT(2 REFERENCES)
051020 IF D-NREPEATS (DX) < 2
051040 MOVE 023 TO ECODE
051060 PERFORM E-RROR THRU E-XIT.
051080 IF TYPEV = TYPE-NUMERIC-VARIABLE
051100 MOVE 'SZ,ZZZ,ZZZ.99RRR' TO V-PICT (VX).
051120 IF TYPEV = TYPE-VARIABLE
051140 MOVE SPACE TO V-PICT (VX)
051160 MOVE TYPE-ALPHA TO D-TYPEV (DX).
051180 MOVE ZEROS TO D-NREPEATS (DX).
051200 GO TO DUP1.
051220 DUP6.
051240 IF FLAG-PASS = 1 GO TO DUPX.
051260* NOW MODIFY DATA ITEM TYPES TO ALSO INCORPORATE FILE AND
051280* RECORDING MODE INFO--MODIFY FCHAR TO ALWAYS BE REL 1, RATHER
051300* THAN A FUNCTION OF WHICH BUFFER(PRIM,SEC, OR TERT) THE ITEM
051320* IS IN.--FOR DYNAMICALLY ALLOCATED DATA, EG HOLD, SET ALPHA,
051340* AND PREV SUMMARY VALUES, FCHAR REL 1 RELATIVE TO THE
051360* DYNAMIC IQE BUFFER--ALSO FOR THE DYNAMICALLY ALLOCATED ITEMS
051380* THE ITEM TYPE VALUE WILL NOT BE MODIFIED.
051400*
051420* D-TYPE VALUES PASSED TO IQE WILL BE AS SHOWN BELOW
051440* ANY TYPES NOT SHOWN PERTAIN TO ITEMS WHOSE
051460* VALUES ARE CONTAINED WITHIN THE DICT ENTRY ITSELF AS
051480* OPPOSED TO A BUFFER.
051500*
051520* DATA TYPE MEANING
051540* ---- ---- -------
051560*
051580* 1 ALPHANUMERIC HOLD,SET, OR PRIOR SUMMARY VALUE.
051600* 2 NUMERIC HOLD,SET, OR PRIOR SUMMARY VALUE.
051620* 6 BINARY HOLD,SET, OR PRIOR SUMMARY VALUE.
051640* 101 ALPHANUMERIC ITEM IN A 6 BIT PRIMARY SEQ FILE.
051660* 102 NUMERIC ITEM ...
051680* 106 BINARY ITEM ...
051700* 201 ALPHANUMERIC ITEM IN A 7 BIT PRIMARY SEQ FILE.
051720* 202 NUMERIC ITEM ...
051740* 206 BINARY ITEM ...
051760* 301 ALPHANUMERIC ITEM IN A 6 BIT PRIMARY ISAM FILE.
051780* 302 NUMERIC ITEM ...
051800* 306 BINARY ITEM ...
051820* 401 ALPHANUMERIC ITEM IN A 7 BIT PRIMARY ISAM FILE
051840* 402 NUMERIC ITEM ...
051860* 406 BINARY ITEM ...
051880* 501 ALPHANUMERIC ITEM IN A PRIMARY DBMS FILE.
051900* 502 NUMERIC ITEM ...
051920* 506 BINARY ITEM ...
051940* 701 ALPHANUMERIC ITEM IN A 6 BIT SECONDARY SEQ FILE
051960* 702 NUMERIC ITEM ...
051980* 706 BINARY ITEM ...
052000* 801 ALPHANUMERIC ITEM IN A 7 BIT SECONDARY SEQ FILE
052020* 802 NUMERIC ITEM ...
052040* 806 BINARY ITEM ...
052060* 901 ALPHANUMERIC ITEM IN A 6 BIT SECONDARY ISAM FILE
052080* 902 NUMERIC ITEM ...
052100* 906 BINARY ITEM ...
052120* 1001 ALPHANUMERIC ITEM IN A 7 BIT SECONDARY ISAM FILE
052140* 1002 NUMERIC ITEM ...
052160* 1006 BINARY ITEM ...
052180* 1101 ALPHANUMERIC ITEM IN A SECONDARY DBMS FILE
052200* 1102 NUMERIC ITEM ...
052220* 1106 BINARY ITEM ...
052240* 1301 ALPHANUMERIC ITEM IN A 6 BIT TERTIARY SEQ FILE
052260* 1302 NUMERIC ITEM ...
052280* 1306 BINARY ITEM ...
052300* 1401 ALPHANUMERIC ITEM IN A 7 BIT TERTIARY SEQ FILE.
052320* 1402 NUMERIC ITEM ...
052340* 1406 BINARY ITEM ...
052360* 1501 ALPHANUMERIC ITEM IN A 6 BIT TERTIARY ISAM FILE
052380* 1502 NUMERIC ITEM ...
052400* 1506 BINARY ITEM ...
052420* 1601 ALPHANUMERIC ITEM IN A 7 BIT TERTIARY ISAM FILE.
052440* 1602 NUMERIC ITEM ...
052460* 1606 BINARY ITEM ...
052480* 1701 ALPHANUMERIC ITEM IN A TERTIARY DBMS FILE
052500* 1702 NUMERIC ITEM ...
052520* 1706 BINARY ITEM ...
052540*
052560* FIRST SET UPPER BOUND ORIGIN SINCE NOT SET BY RDICT.
052580 IF N-INPUTFILES = 1 COMPUTE SECONDARY-ORIGIN
052600 = PRIMARY-ORIGIN + PRIMARY-LENGTH.
052620 IF N-INPUTFILES = 2 COMPUTE TERTIARY-ORIGIN
052640 = SECONDARY-ORIGIN + SECONDARY-LENGTH.
052660 IF N-INPUTFILES = 3 COMPUTE QUATERNARY-ORIGIN
052680 = TERTIARY-ORIGIN + TERTIARY-LENGTH.
052700* NOW CYCLE THRU DICT, MODIFYING TYPES 1,2, 6 PERTAINING TO
052720* TYPE AND FCHAR.
052740 SET DX TO DX-MAX.
052760 DUP7.
052780 IF D-TYPEV (DX) = 1 OR D-TYPEV (DX) = 2 OR D-TYPEV (DX) = 6
052800 NEXT SENTENCE ELSE GO TO DUP10.
052820 IF D-FCHAR (DX) NOT LESS THAN SECONDARY-ORIGIN GO TO DUP11.
052840* HERE FOR PRIMARY FILE ITEM--MODIFY ITS TYPE
052860 MOVE 1 TO DELTA.
052880 SET FX TO FX-PRIMARY.
052900 DUP8.
052920 IF F-TYPEV (FX) = 27 ADD 1 TO DELTA.
052940 IF F-TYPEV (FX) NOT = 28 GO TO DUP9.
052942* *LOOK AT NREPEATS TO SEE WHAT KIND OF DBMS REC WE HAVE*
052944 IF D-NREPEATS (DX) NOT < 0 MOVE 2 TO DELTA ELSE
052946 SUBTRACT D-NREPEATS (DX) FROM 0 GIVING D-NREPEATS (DX)
052948 MOVE 1 TO DELTA.
052950 GO TO DUP9A.
052960 DUP9.
052980 IF F-KEYLEN (FX) NOT = 0 ADD 2 TO DELTA.
052982 DUP9A.
053000 COMPUTE D-TYPEV (DX) = D-TYPEV (DX) + DELTA * 100.
053020 DUP10.
053040 SET DX DOWN BY 1.
053060 IF DX LESS THAN DX-LOWEST GO TO DUPX.
053080 GO TO DUP7.
053100 DUP11.
053120 IF N-INPUTFILES = 1
053140 MOVE SECONDARY-ORIGIN TO ORIGIN GO TO DUP14.
053160 IF D-FCHAR (DX) NOT LESS THAN TERTIARY-ORIGIN GO TO DUP12.
053180* HERE FOR SECONDARY FILE ITEM.
053200 MOVE 7 TO DELTA.
053220 SET FX TO FX-SECONDARY.
053240* ADJUST FCHAR TO BE REL 1.
053260 COMPUTE D-FCHAR (DX) = D-FCHAR (DX) - SECONDARY-ORIGIN + 1.
053280 GO TO DUP8.
053300 DUP12.
053320 IF N-INPUTFILES = 2
053340 MOVE TERTIARY-ORIGIN TO ORIGIN GO TO DUP14.
053360 IF D-FCHAR (DX) NOT LESS THAN QUATERNARY-ORIGIN
053380 MOVE QUATERNARY-ORIGIN TO ORIGIN GO TO DUP14.
053400* HERE FOR A TERTIARY FILE ITEM.
053420 SET FX TO FX-TERTIARY.
053440 MOVE 13 TO DELTA.
053460 COMPUTE D-FCHAR (DX) = D-FCHAR (DX) - TERTIARY-ORIGIN + 1.
053480 GO TO DUP8.
053500 DUP14.
053520* HERE TO ADJUST FCHAR ONLY(IE NOT D-TYPE) FOR A HOLD OR
053540* DYNAMIC STORAGE TYPE ITEM.
053560 COMPUTE D-FCHAR (DX) = D-FCHAR (DX) - ORIGIN + 1.
053580 GO TO DUP10.
053600 DUPX. EXIT.
053620 LOOK-IN-DX.
053640 IF FLAG-CONTINUE = 1 GO TO LID1.
053660 SET DX TO DX-MAX. SET DX UP BY 1.
053680 LID1.
053700 SET DX DOWN BY 1. SET KX TO DX.
053720 IF DX < DX-LOWEST GO TO LIDX.
053740 MOVE K-TYPEV (KX) TO TYPEV.
053760 IF TYPEV = TYPE-AVERAGE GO TO LID1.
053780 IF TYPEV = TYPE-CONSTANT GO TO LID1.
053800 IF TYPEV = TYPE-FILE GO TO LID1.
053820 IF TYPEV = TYPE-GOTO GO TO LID1.
053840 IF TYPEV = TYPE-LITERAL GO TO LID1.
053860 IF TYPEV = TYPE-REPORT GO TO LID1.
053880 IF TYPEV = TYPE-SUMMARY GO TO LID1.
053900 IF WORD30 = K-ENDKEY (KX) GO TO LIDX.
053902 IF TYPEV NOT = TYPE-PRIOR-SUMMARY GO TO LID1.
053904 MOVE WORD30 TO HWORD30.
053906 IF HELD-WORD30 = K-ENDKEY (KX) GO TO LIDX.
053920 GO TO LID1.
053940 LIDX. EXIT.
053960 LOOK-IN-FX.
053980 SET FX TO DX-MAX. SET FX UP BY 1.
054000 LIF1.
054020 SET FX DOWN BY 1. SET KX TO FX.
054040 IF FX < DX-LOWEST GO TO LIFX.
054060 IF F-TYPEV (FX) NOT EQUAL TO TYPE-FILE GO TO LIF1.
054080 IF WORD30 = K-ENDKEY (KX) GO TO LIFX.
054100 GO TO LIF1.
054120 LIFX. EXIT.
054140 DROP-IN-FALSEGO.
054160* STACK CURRENT VALUE OF X ONTO FALSE STACK.
054180 IF N-FALSEGO = MAX-FALSEGO
054200 MOVE 010 TO ECODE PERFORM E-RROR THRU E-XIT
054220 GO TO DIFGOX.
054240 ADD 1 TO N-FALSEGO.
054260 SET FSX TO N-FALSEGO.
054280 SET X-FALSEGO (FSX) TO X.
054300 DIFGOX. EXIT.
054320 DROP-IN-TRUEGO.
054340* STACK CURRENT VALUE OF X ONTO TRUE STACK.
054360 IF N-TRUEGO = MAX-TRUEGO
054380 MOVE 010 TO ECODE PERFORM E-RROR THRU E-XIT
054400 GO TO DITGOX.
054420 ADD 1 TO N-TRUEGO.
054440 SET TSX TO N-TRUEGO.
054460 SET X-TRUEGO (TSX) TO X.
054480 DITGOX. EXIT.
054500 POP-TRUE.
054520* POP THE TOP ENTRY IN TRUE STACK AND SET THE
054540* INSTR ENTRY POINTED TO BY THIS POPPED ADDRESS
054560* TO POINT TO THE CURRENT X.
054580 IF N-TRUEGO = 0 GO TO POPTX.
054600 SET TSX TO N-TRUEGO.
054620 SET SAVE-X TO X.
054640 SET X TO X-TRUEGO (TSX).
054660* SAVE FOR OTHER USES*
054680 SET POPPED-X TO X.
054700 MOVE SAVE-X TO INSTR (X).
054720* IF WE ARE POPPING TRUEGO FOR AN IF NEWGROUP STATEMENT
054740* THEN SET THE TRUEGO ADDRESS TO A NEGATIVE VALUE FOR PURPOSES
054760* OF IQE INITIALIZING.
054780 SET X DOWN BY 1.
054800 IF INSTR (X) = V-IFNEWGROUP
054820 SET X UP BY 1
054840 MULTIPLY SAVE-X BY MINUS-ONE GIVING INSTR (X).
054860 SET X TO SAVE-X.
054880 SUBTRACT 1 FROM N-TRUEGO.
054900 POPTX. EXIT.
054920 POPALL-TRUE.
054940* POP ALL TRUE ENTRIES MAKING THEM ALL POINT TO X
054960 IF N-TRUEGO = 0 GO TO POPALLTX.
054980 PERFORM POP-TRUE THRU POPTX.
055000 GO TO POPALL-TRUE.
055020 POPALLTX. EXIT.
055040 POP-FALSE.
055060* POP THE TOP ENTRY IN FALSE-STACK AND SET THE INSTR
055080* ENTRY POINTED TO BY THIS ADDRESS TO POINT TO X
055100 IF N-FALSEGO = 0
055120 MOVE 010 TO ECODE PERFORM E-RROR THRU E-XIT
055140 GO TO POPFX.
055160 SET FSX TO N-FALSEGO.
055180 SET SAVE-X TO X.
055200 SET X TO X-FALSEGO (FSX).
055220* SAVE FOR USE ELSEWHERE
055240 SET POPPED-X TO X.
055260 MOVE SAVE-X TO INSTR (X).
055280 SET X TO SAVE-X.
055300 SUBTRACT 1 FROM N-FALSEGO.
055320 POPFX. EXIT.
055340 POPALL-FALSE.
055360* POP ALL FALSE ENTRIES MAKING THEM POINT TO CURRENT X
055380 IF N-FALSEGO = 0 GO TO POPALLF1.
055400 PERFORM POP-FALSE THRU POPFX.
055420 GO TO POPALL-FALSE.
055440* IF ELSE-X IS SET, THEN A GOTO MUST BE COMPLETED NOW
055460* TO WRAPUP IF-THEN-ELSE
055480 POPALLF1.
055500 IF ELSE-X = 0 GO TO POPALLF2.
055520 SET SAVE-X TO X. SET X TO ELSE-X.
055540 MOVE SAVE-X TO INSTR (X).
055560* INDICATE TO GOTO3 THAT THIS IS NOT A GOTO STATEMENT NUMBER.
055580* BUT MUST HAVE NON-ZERO VALUE HERE OR ELSE GOTO2 WILL
055600* THINK THIS GOTO HAS BEEN UNASSIGNED AND FLAG IT AS SUCH.
055620 ADD DX-MAX TO INSTR (X).
055640 MOVE 1 TO FLAG-GOTO.
055660 SET X TO SAVE-X. MOVE 0 TO ELSE-X.
055680 POPALLF2.
055700 MOVE 0 TO LPARENCNTR. MOVE 0 TO RPARENCNTR.
055720 MOVE 0 TO TLPX. MOVE 0 TO FLPX.
055740 POPALLFX. EXIT.
055760************************
055780 GET-INSTR.
055800* GET-INSTR WILL READ THE VERB AND STORE IT INTO
055820* INSTR (X) AND SET V TO IT; NEXT, BY EXECUTING
055840* GET-ONE-INSTR, IT WILL READ THE FOLLOWING WORD OR
055860* OBJECT INTO INSTR (X) AND SET T-INSTR TO IT
055880* ALSO, IT WILL POP ALL FALSE STACK IF IT FINDS $
055900 SET LI UP BY 1. IF LI > LI-MAX PERFORM GET-QT THRU GET-QTX.
055920 SET X UP BY 1. IF X > X-MAX MOVE 1 TO EOQ.
055940 IF EOQ = 1 MOVE EOQ TO V MOVE ZEROS TO T-INSTR
055960 GO TO GET-INSTRX.
055980 MOVE LINE-WORD (LI) TO INSTR (X).
056000 IF X < EXEC-STARTX GO TO GET-INSTR.
056020 MOVE INSTR (X) TO V.
056040 IF V = V-EOS
056060 PERFORM POPALL-FALSE THRU POPALLFX
056080 SET X DOWN BY 1
056100 GO TO GET-INSTR.
056120 IF V = ZEROS GO TO GET-INSTR.
056140 GET-ONE-INSTR.
056160 SET LI UP BY 1. IF LI > LI-MAX PERFORM GET-QT THRU GET-QTX.
056180 SET X UP BY 1. IF X > X-MAX MOVE 1 TO EOQ.
056200 IF EOQ = 1 MOVE EOQ TO V MOVE ZEROS TO T-INSTR
056220 GO TO GET-INSTRX.
056240 MOVE LINE-WORD (LI) TO INSTR (X).
056260 MOVE INSTR (X) TO T-INSTR.
056280 GO TO GET-INSTRX.
056300 GET-QT.
056320 READ QTANLZ AT END MOVE 1 TO EOQ GO TO GET-QTX.
056340 MOVE QTANLZ-REC TO LINE-TABLE.
056360 SET LI TO 1.
056380 GET-QTX. EXIT.
056400 GET-INSTRX. EXIT.
056420*********************
056440 ACCEPT1.
056460 IF FLAG-PASS = 2 GO TO ACCEPT2.
056480 IF FLAG-ALPHA = ZERO GO TO E003.
056500 SET INSTR (X) TO DX.
056520 GO TO VERB-CONTROL.
056540 ACCEPT2.
056560* FOR CASE OF ALPHA VAR, INTRODUCED BY ACCEPT, ALLOCATE
056580* STORAGE FOR IT NOW IN CASE THERE IS NO SET VERB TO
056600* ALLOCATE IT LATER.
056620* SET DX TO T-INSTR.
056640* IF D-TYPEV (DX) = TYPE-VARIABLE IF D-FCHAR (DX) = 0
056660* GO TO ACCEPT2A.
056680* GO TO ACCEPT2B.
056700*ACCEPT2A.
056720* IF FCHAR = 0 MOVE 1 TO FCHAR.
056740* MOVE FCHAR TO D-FCHAR (DX). ADD D-NCHAR (DX) TO FCHAR.
056760* MOVE D-NCHAR (DX) TO D-ECHAR (DX).
056770 IF T-INSTR = ZEROS GO TO VERB-CONTROL.
056780 ACCEPT2B.
056800 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
056820 IF T-INSTR = ZEROS GO TO VERB-CONTROL.
056840 GO TO ACCEPT2B.
056860 ACROSS1.
056880 IF FLAG-PASS = 2 GO TO VERB-CONTROL.
056900 IF FLAG-ALPHA = 1 GO TO E002.
056920 IF NUMBN < 1 GO TO E008.
056940 SET INSTR (X) TO NUMBN.
056960 GO TO VERB-RESET.
056980 AT-END1.
057000 GO TO VERB-CONTROL.
057020 AUTHORITY1.
057040 IF FLAG-PASS = 2 GO TO AUTHORITY2.
057060 IF FLAG-ALPHA = ZERO GO TO E003.
057080 SET AX TO DX.
057100 IF FLAG-VERB = 1
057120 MOVE 2 TO FLAG-VERB SET PW-POINTER TO AX.
057140 ADD 1 TO N-PASSWORDS.
057160 IF N-PASSWORDS = 1
057180 MOVE AUTH-PASSWORD (AX) TO FIRST-PASSWORD.
057200 IF AUTH-PASSWORD (AX) = UNIVERSAL-PASSWORD
057220 MOVE 2 TO FLAG-LOCKED.
057240 SET INSTR (X) TO DX.
057260 MOVE TYPE-AUTHORITY TO D-TYPEV (DX).
057280 GO TO VERB-CONTROL.
057300 AUTHORITY2.
057320 SET X DOWN BY 2.
057340 AUTHORITY2A.
057360 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
057380 SET X DOWN BY 1.
057400 IF T-INSTR = ZEROS GO TO VERB-CONTROL.
057420 GO TO AUTHORITY2A.
057440 AVERAGE1.
057460 IF FLAG-PASS = 2
057480 MOVE '*WARNING-AVERAGE STATEMENT' TO WORD30
057500 GO TO TALLY2.
057520 GO TO TALLY1.
057540 CALL1.
057560 IF FLAG-PASS = 2 GO TO CALL2.
057580 IF FLAG-VERB = 2 GO TO CALL1A.
057600 IF FLAG-ALPHA = 1 GO TO E002.
057620 MOVE 2 TO FLAG-VERB.
057640 CALL1A.
057650* IF VA # 0,THEN NEGATE STORED DX INDICATING A STORE ARGUMENT.
057652 IF VA NOT = 0
057654 SUBTRACT INSTR (X) FROM 0 GIVING INSTR (X)
057655 MOVE 0 TO VA
057656 ELSE
057660 SET INSTR (X) TO DX.
057680 GO TO VERB-CONTROL.
057700 CALL2.
057720 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
057740 IF T-INSTR = ZEROS GO TO VERB-RESET.
057760 GO TO CALL2.
057780 COMPUTE1.
057800 IF FLAG-PASS = 2 GO TO COMPUTE2.
057820 IF FLAG-VERB = 2 GO TO COMPUTE1A.
057840* HERE FOR FIRST TIME FOR THIS COMPUTE--SET FLAG-VERB
057860* TO INDICATE THAT THIS IS NOT FIRST TIME HERE
057880 MOVE 2 TO FLAG-VERB.
057900 IF FLAG-ALPHA = ZERO GO TO E003.
057920 MOVE 0 TO FLAG-COMPUTE.
057922* TYPEV = 0 ONLY IF DID NOT READ A DATA ITEM RIGHT AFTER COMPUTE
057924 IF TYPEV = 0
057926 MOVE 'MISSING ITEM AFTER "COMPUTE"' TO WORD30
057928 GO TO E026.
057940* AT THIS POINT, COMPUTE VERB CODE HAS BEEN SET INTO THE
057960* INSTR TABLE BY CONTROL AND X IS POINTING TO THE NEXT
057980* ENTRY OF INSTR TABLE--SET THE DX VALUE INTO THIS ENTRY
058000* THAT REPRESENTS THE LEFT SIDE OF =
058020 SET INSTR (X) TO DX.
058040* SET CONSTANT -1 INTO DICTIONARY AND SAVE POINTER TO IT.
058060 SUBTRACT 1 FROM 0 GIVING NUMBN.
058080 PERFORM INSERT-CONSTANT THRU INSERTCX.
058100 SET MINUS-ONE-DX TO DX.
058120* SET CONSTANT 0 INTO DICTIONARY AND SAVE POINTER
058140 MOVE 0 TO NUMBN.
058160 PERFORM INSERT-CONSTANT THRU INSERTCX.
058180 SET ZERO-DX TO DX.
058200 GO TO VERB-CONTROL.
058220 COMPUTE1A.
058240* WILL KEEP RETURNING TO COMPUTE1 FROM VERB-CONTROL
058260* FOR EACH OPERATOR AND OPERAND UNTIL HIT EOS-THIS
058280* FIRST PASS SECTION WILL BASICALLY CHECK FOR CURRENT
058300* SYNTAX AND STORE SYNTAX INTO INSTR TABLE--THE 2ND
058320* PASS SECTION WILL PARSE THE COMPUTE SYNTAX AND DO
058340* SOME FURTHUR ERROR CHECKING.
058360 IF VA = V-RESULT GO TO COMPUTE1F.
058370 IF FLAG-COMPUTE = 0
058372 MOVE SPACES TO WORD30
058374 GO TO E028.
058380 IF VA = V-ADD GO TO COMPUTE1B.
058400 IF VA = V-SUBTRACT GO TO COMPUTE1G.
058420 IF VA = V-MULTIPLY GO TO COMPUTE1B.
058440 IF VA = V-DIVIDE GO TO COMPUTE1B.
058460 IF VA = V-LPAREN GO TO COMPUTE1E.
058480 IF VA = V-RPAREN GO TO COMPUTE1H.
058500* IF VA NOT = 0*GO TO E000.
058520* HERE WHEN HAVE DX--THIS HAS ALREADY BEEN STORED
058540* INTO THE INSTR TABLE-THIS DX MUST HAVE BEEN PRECEEDED
058560* BY AN OPERATOR.
058580* NOW TEST FOR OPERAND-OPERATOR SEQUENCE OUT-OF-WHACK.
058600* WHERE FLAG-COMPUTE VALUES ARE AS FOLLOWS:
058620* 0=INITIAL VALUE; 1=OPERATOR FOUND; 2=OPERAND FOUND
058640 IF FLAG-COMPUTE NOT = 1 GO TO E025.
058660 MOVE 2 TO FLAG-COMPUTE.
058680 GO TO VERB-CONTROL.
058700 COMPUTE1B.
058720* HERE WHEN FOUND ARITHMETIC OPERATOR-CHECK ALLOWABILITY
058740* AND ALSO BUMPX AND DROP OPERATOR INTO INSTR TABLE.
058760 IF FLAG-COMPUTE NOT = 2 GO TO E026.
058780 COMPUTE1C.
058800 MOVE 1 TO FLAG-COMPUTE.
058820 COMPUTE1D.
058840 SET X UP BY 1.
058860 MOVE VA TO INSTR (X).
058880 MOVE ZERO TO VA.
058900* CLEAR EOS FLAG IN CASE IT GOT SET BY '.' SINCE '.'
058920* SHOULD NOT BE TREATED AS EOS WITHIN COMPUTE.
058940 MOVE 0 TO FLAG-EOS.
058960 GO TO VERB-CONTROL.
058980 COMPUTE1E.
059000* HERE FOR LEFT PAREN-CAN ONLY FOLLOW ANOTHER OPERATOR
059020 IF FLAG-COMPUTE NOT = 1 GO TO E025.
059040 GO TO COMPUTE1D.
059060 COMPUTE1F.
059080* HERE FOR = AND MUST BE THE FIRST OPERATOR
059100 IF FLAG-COMPUTE NOT = 0 GO TO E027.
059120 GO TO COMPUTE1C.
059140 COMPUTE1G.
059160* HERE FOR - MUST FOLLOW AN OPERAND OR POSSIBLY UNARY -
059180 IF FLAG-COMPUTE = 2 GO TO COMPUTE1C.
059200 GO TO COMPUTE1C.
059220 COMPUTE1H.
059240* HERE FOR RIGHT PAREN--CAN ONLY FOLLOW ANOTHER RIGHT
059260* PAREN OR AN OPERAND--ALSO ) MUST BE FOLLOWED BY RIGHT
059280* PAREN OR OPERATOR THEREFORE KEEP FLAG-COMPUTE = 2
059300 IF FLAG-COMPUTE = 2 GO TO COMPUTE1D.
059320 GO TO E026.
059340 COMPUTE2.
059360* COMPUTE2 ENTERED DURING 2ND PASS AND WILL PARSE THE
059380* INPUT STRING THAT RESIDES IN INSTR TABLE
059400* 'COMPUTE W' HAS ALREADY BEEN READ BY CONTROL-CHECK
059420* THAT 'W' IS NUMERIC.
059425* IF FIRST ARG IS 0, THEN HAVE ERROR PREVIOUSLY REPORTED
059530 IF T-INSTR = 0 GO TO VERB-CONTROL.
059440 SET DX TO T-INSTR.
059460 PERFORM CHECK-NUMERIC THRU CHECK-NUMERICX.
059480 if ecode not = 0
059482 perform compute-warning thru compute-warningx.
059500* NEXT, READ '=' AND GET RID OF IT FOR NOW AND INITIALZE
059520 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
059530* IF MISSING = OPERATOR, DONT REPORT IT AGAIN IN PASS2.
059540 IF T-INSTR NOT = V-RESULT GO TO VERB-RESET.
059560 SET SAVE-XX TO X.
059580 SET X DOWN BY 1.
059600* SET FIRST ENTRY IN PARSING TABLE TO LNIL WHERE THE
059620* OPERATOR CODE AND PRECEDENCE = 0.
059640 SET OPX TO 1.
059660 MOVE 0 TO OPERATOR (OPX) OPERAND (OPX) PRECEDENCE (OPX).
059680 MOVE 1 TO CURR-PRECEDENCE.
059700 MOVE V-RESULT TO CURR-OPERATOR.
059720 SET SAVE-X TO X.
059740* NOW READ A SINGLE OPERATOR OR OPERAND.
059760 COMPUTE2A.
059780 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
059800 IF T-INSTR = 0 GO TO COMPUTE2AA.
059820 IF T-INSTR = V-ADD GO TO COMPUTE2B.
059840 IF T-INSTR = V-SUBTRACT GO TO COMPUTE2E.
059860 IF T-INSTR = V-MULTIPLY GO TO COMPUTE2C.
059880 IF T-INSTR = V-DIVIDE GO TO COMPUTE2C.
059900 IF T-INSTR = V-LPAREN
059920 ADD 10 TO PARENCNT GO TO COMPUTE2A.
059940 IF T-INSTR NOT = V-RPAREN GO TO COMPUTE2F.
059960 IF PARENCNT LESS THAN 10
059962 MOVE 010 TO ECODE PERFORM E-RROR THRU E-XIT
059964 GO TO COMPUTE2A.
059980 SUBTRACT 10 FROM PARENCNT.
060000 GO TO COMPUTE2A.
060020 COMPUTE2AA.
060040* SET PRECEDENCE FOR EOS SUCH THAT REST OF PARSING
060060* STACK WILL BE POPPED.
060080 MOVE 0 TO CURR-PRECEDENCE.
060100 GO TO COMPUTE2G.
060120 COMPUTE2B.
060140* SET PRECEDENCE FOR + -
060160 MOVE 2 TO CURR-PRECEDENCE.
060180 GO TO COMPUTE2D.
060200 COMPUTE2C.
060220* SET PRECEDENCE FOR * /
060240 MOVE 3 TO CURR-PRECEDENCE.
060260 COMPUTE2D.
060280* SET CURR OPERATOR AND ADJUST PRECEDENCE =F(PARENS)
060300 MOVE T-INSTR TO CURR-OPERATOR.
060320 ADD PARENCNT TO CURR-PRECEDENCE.
060340 GO TO COMPUTE2A.
060360 COMPUTE2E.
060380* - SEE IF UNARY -
060400 IF OPX NOT = 1 GO TO COMPUTE2B.
060420* FOR UNARY (-), INSERT ZERO(DX) OPERAND.
060440 SET X UP BY 1.
060460 MOVE ZERO-DX TO INSTR (X) T-INSTR.
060480* SET LI TO READ (-) OPERATOR AGAIN
060500 SET LI DOWN BY 1.
060520 COMPUTE2F.
060540* HERE FOR ARITMETIC OPERAND
060560 MOVE T-INSTR TO CURR-OPERAND.
060562 set dx to t-instr.
060564 perform check-numeric thru check-numericx.
060566 if ecode not = 0
060568 perform compute-warning thru compute-warningx.
060580 COMPUTE2G.
060600* COMPARE PRECEDENCE OF LAST OPERATOR STACKED WITH THE
060620* LAST OPERATOR READ
060640 IF PRECEDENCE (OPX) NOT LESS THAN CURR-PRECEDENCE
060660 GO TO COMPUTE2H.
060680* STACK CURRENT OPERATOR(LAST READ) SINCE GEQ STACK TOP
060700 SET OPX UP BY 1.
060720 MOVE CURR-OPERATOR TO OPERATOR (OPX).
060740 MOVE CURR-OPERAND TO OPERAND (OPX).
060760 MOVE CURR-PRECEDENCE TO PRECEDENCE (OPX).
060780 ADD 1 TO OPERANDS-CNT.
060800 GO TO COMPUTE2A.
060820 COMPUTE2H.
060840* HERE TO GENERATE CODE FOR TOP OF PARSING STACK
060860 SET X TO SAVE-X.
060880 SET X UP BY 1.
060900* SAVE CURRENT ACCUMULATOR IF WE HAVE USED IT AND HAVE
060920* STACKED MORE THAN ONE OPERAND INTO PARSING-STACK SINCE
060940* THE ACCUM WAS LAST USED.
060960 IF OPERANDS-CNT GREATER THAN 1
060980 IF FLAG-ACCUM = 1
061000 MOVE V-STACK TO INSTR (X)
061020 SET X UP BY 1
061040 MOVE 0 TO FLAG-ACCUM.
061060 IF OPERATOR (OPX) = V-RESULT GO TO COMPUTE2T.
061080 IF OPERATOR (OPX) = V-DIVIDE GO TO COMPUTE2R.
061100 IF OPERATOR (OPX) = V-MULTIPLY GO TO COMPUTE2L.
061120 IF OPERATOR (OPX) = V-SUBTRACT GO TO COMPUTE2S.
061140 IF OPERATOR (OPX) NOT = V-ADD
061142 MOVE 020 TO ECODE PERFORM E-RROR THRU E-XIT.
061160* +
061180* IS CURRENT OPERAND IN ACCUMULATOR?
061200 COMPUTE2I.
061220 IF OPERAND (OPX) NOT = LOW-VALUES GO TO COMPUTE2K.
061240 COMPUTE2J.
061260 MOVE OPERATOR (OPX) TO INSTR (X).
061280 SET X UP BY 1.
061300 SET OPX DOWN BY 1.
061320 IF OPERAND (OPX) = LOW-VALUES
061340 MOVE V-POP TO INSTR (X)
061360 ELSE
061380 MOVE OPERAND (OPX) TO INSTR (X).
061400 GO TO COMPUTE2Q.
061420 COMPUTE2K.
061440* SEE IF PREVIOUS OPERAND WAS ACCUMULATOR
061460 SET OPX DOWN BY 1.
061480 IF OPERAND (OPX) = LOW-VALUES GO TO COMPUTE2P.
061500 SET OPX UP BY 1.
061520 MOVE OPERAND (OPX) TO INSTR (X).
061540 SET X UP BY 1.
061560 GO TO COMPUTE2J.
061580 COMPUTE2L.
061600* *
061620* IF TOP OPERAND(RIGHT SIDE) IS IN ACCUM ALREADY THEN
061640* CAN OPERATE AGAINST LEFT SIDE NOW
061660 IF OPERAND (OPX) NOT = LOW-VALUES GO TO COMPUTE2M.
061680 MOVE OPERATOR (OPX) TO INSTR (X).
061700 SET X UP BY 1.
061720 SET OPX DOWN BY 1.
061740* IF LEFT SIDE IS ACCUM ALSO, IT HAS BEEN STACKED AND
061760* MUST BE POPPED
061780 IF OPERAND (OPX) = LOW-VALUES
061800 MOVE V-POP TO INSTR (X)
061820 ELSE
061840 MOVE OPERAND (OPX) TO INSTR (X).
061860 GO TO COMPUTE2Q.
061880 COMPUTE2M.
061900* SEE IF LEFT OPERAND IS IN ACCUM--IF SO, THEN ALL SET
061920* ON LEFT OPERAND
061940 SET OPX DOWN BY 1.
061960 IF OPERAND (OPX) = LOW-VALUES GO TO COMPUTE2P.
061980 COMPUTE2N.
062000 MOVE OPERAND (OPX) TO INSTR (X).
062020 COMPUTE2NN.
062040 SET X UP BY 1.
062060 COMPUTE2P.
062080 SET OPX UP BY 1.
062100 MOVE OPERATOR (OPX) TO INSTR (X).
062120 SET X UP BY 1.
062140 MOVE OPERAND (OPX) TO INSTR (X).
062160 SET OPX DOWN BY 1.
062180 COMPUTE2Q.
062200* CLEAR TOP OF PARSING STACK AND SET NEW TOP OPERAND
062220* TO BE ACCUMULATOR
062240 MOVE LOW-VALUES TO OPERAND (OPX).
062260 MOVE 1 TO FLAG-ACCUM.
062280 MOVE 0 TO OPERANDS-CNT.
062300 SET SAVE-X TO X.
062320 GO TO COMPUTE2G.
062340 COMPUTE2R.
062360* /
062380* ARE BOTH LEFT AND RIGHT OPERANDS ACCUMULATORS?
062400 IF OPERAND (OPX) NOT EQUAL TO LOW-VALUES
062420 GO TO COMPUTE2M.
062440 SET OPX DOWN BY 1.
062500* STACK CURRENT ACCUM
062520 MOVE V-STACK TO INSTR (X).
062540 SET X UP BY 1.
062560* NOW, GENERATE OPERATOR TO GET 2ND ITEM FROM STACK IF LEFT
062561* OPERATOR IS ACCUM ALSO ELSE GENERATE STACKED OPERATOR
062570 IF OPERAND (OPX) EQUAL TO LOW-VALUES
062580 MOVE V-POP2 TO INSTR (X)
062582 ELSE
062584 MOVE OPERAND (OPX) TO INSTR (X).
062600 SET X UP BY 1.
062620 MOVE V-DIVIDE TO INSTR (X).
062640 SET X UP BY 1.
062660 MOVE V-POP TO INSTR (X).
062680 GO TO COMPUTE2Q.
062700 COMPUTE2S.
062720* -
062740* IF RIGHT OPERAND IS ACCUM, THEN MUST MULTIPLY IT BY -1
062760* AND CHANGE OPERATOR IN STACK TO +
062780 IF OPERAND (OPX) NOT = LOW-VALUES
062800 GO TO COMPUTE2M.
062820 MOVE V-MULTIPLY TO INSTR (X).
062840 SET X UP BY 1.
062860 MOVE MINUS-ONE-DX TO INSTR (X).
062880 MOVE V-ADD TO OPERATOR (OPX).
062900 SET X UP BY 1.
062920 GO TO COMPUTE2I.
062940 COMPUTE2T.
062960* HERE WHEN COMPUTE STRING IS FINISHED- STORE = INTO
062980* FINAL COMPUTE INSTR ENTRY.
063000* ALSO, IF HAVE NOT GENERATED ANY CODE YET THEN MUST
063020* HAVE SINGLE OPERAND TO RIGHT OF = AND MUST GEN CODE NOW.
063040 IF X = SAVE-XX
063060 MOVE OPERAND (OPX) TO INSTR (X)
063080 SET X UP BY 1.
063100 MOVE V-NOP TO INSTR (X).
063120 MOVE 0 TO OPERANDS-CNT FLAG-ACCUM.
063140 GO TO VERB-CONTROL.
063160 INSERT-CONSTANT.
063180 MOVE NUMBER-TABLE TO WORD-TABLE.
063200 MOVE 0 TO FLAG-ALPHA SCALE.
063220 MOVE 1 TO NCHAR.
063240 PERFORM DROP-IN-DX THRU DIDX.
063260 INSERTCX. EXIT.
063280 COPY1.
063300 IF FLAG-PASS = 2 GO TO COPY2.
063320 IF FLAG-VERB = 2 GO TO COPY1B.
063340 IF FLAG-VERB = 3 GO TO COPY1C.
063360 MOVE 2 TO FLAG-VERB.
063380 IF FLAG-EOS = 1 GO TO COPY1A.
063400 PERFORM GET-WORD THRU GET-WORDX.
063420 IF WORD06 = "RECORD"
063440 MOVE 1 TO FLAG-PEEKED GO TO VERB-CONTROL.
063460 MOVE 1 TO FLAG-PEEKED.
063480 MOVE WORD30 TO SAVE30.
063500* HERE FOR COPY ANOTHER-VOCAB--TREAT AS COPY$ VOCAB
063520 COPY1A.
063540* COPY$ SET UP FOR DEFAULT
063560 MOVE 1 TO VA.
063580 MOVE "RECORD1" TO WORD30.
063600 PERFORM DROP-IN-DX THRU DIDX.
063620 IF FLAG-PEEKED = 1 MOVE SAVE30 TO WORD30.
063640 SET X UP BY 1.
063660 SET INSTR (X) TO DX.
063680 COPY1B.
063700 MOVE 3 TO FLAG-VERB.
063720 IF VA < 1 OR VA > 3 GO TO E004.
063740 SET INSTR (X) TO DX. SET FX TO DX.
063760 MOVE TYPE-FILE TO F-TYPEV (FX).
063780 SET X UP BY 1. SET INSTR (X) TO VA.
063800 MOVE 1 TO FLAG-COPY.
063820 IF WORD04 = "TO "
063840 MOVE 0 TO FLAG-PEEKED MOVE V-TO TO VA
063860 ELSE MOVE ZEROS TO VA.
063880 GO TO VERB-CONTROL.
063900 COPY1C.
063920 IF VA NOT EQUAL TO V-TO GO TO E004.
063940 IF TYPEV NOT EQUAL TO TYPE-LITERAL GO TO E015.
063960 SET L-NCHAR (LX) TO FX.
063980 SET INSTR (X) TO LX.
064000 GO TO VERB-RESET.
064020 COPY2.
064040 SET HX TO T-INSTR.
064060 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
064080 SET VA TO T-INSTR.
064100 SET FX TO 1.
064120 IF VA = 1 SET FX TO FX-PRIMARY.
064140 IF VA = 2 SET FX TO FX-SECONDARY.
064160 IF VA = 3 SET FX TO FX-TERTIARY.
064180* SEE IF FILE PROTECTED AGAINST COPY
064200 MOVE FD-CPROT (VA) TO TEST-REF-NO.
064220 PERFORM UNLOCKER THRU UNLOCKER-EXIT.
064240 IF FLAG-LOCKED = 1
064260 MOVE 14 TO ECODE
064280 MOVE FD-NAMEPROT (VA) TO WORD30
064300 PERFORM E-RROR THRU E-XIT.
064320 IF FX = 1 GO TO E009.
064340 MOVE F-TYPEV (FX) TO TYPEV.
064360 IF TYPEV NOT EQUAL TO 27 MOVE 26 TO TYPEV.
064380 MOVE ZEROS TO T-INSTR.
064400 IF VA = 1 AND TYPEV = 26 MOVE 1 TO T-INSTR.
064420 IF VA = 1 AND TYPEV = 27 MOVE 2 TO T-INSTR.
064440 IF VA = 2 AND TYPEV = 26 MOVE 4 TO T-INSTR.
064460 IF VA = 2 AND TYPEV = 27 MOVE 5 TO T-INSTR.
064480 IF VA = 3 AND TYPEV = 26 MOVE 7 TO T-INSTR.
064500 IF VA = 3 AND TYPEV = 27 MOVE 8 TO T-INSTR.
064520 IF T-INSTR = ZEROS GO TO E009.
064540 SET INSTR (X) TO T-INSTR.
064560* INITIALIZE FD-INLABEL TO INPUT FILE ID
064580 MOVE F-ID (FX) TO FD-INLABEL.
064600 MOVE F-BLKLEN (FX) TO FD-BLKSIZE.
064620 MOVE F-RECLEN (FX) TO FD-RECSIZE.
064640 MOVE F-ORIGIN (FX) TO COPY-ORIGIN.
064660* NOW SET COPY FILE SPECS, WHOSE ENTRY PNTD TO BY HX
064680 SET FX TO HX.
064700 MOVE TYPEV TO F-TYPEV (FX).
064720 MOVE 'OUT' TO FD-INEXT. MOVE FD-INLABEL TO F-ID (FX).
064740 MOVE FD-BLKSIZE TO F-BLKLEN (FX).
064760 MOVE FD-RECSIZE TO F-RECLEN (FX).
064780 MOVE COPY-ORIGIN TO F-ORIGIN (FX).
064800 MOVE FD-RECSIZE TO COPY-LENGTH.
064820 MOVE "DSK" TO F-DEVICE (FX).
064840 MOVE ZEROS TO F-PPN (FX).
064860 COPY2A.
064880 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
064900 IF T-INSTR = ZEROS GO TO VERB-RESET.
064920* SINCE T-INSTR NOT = 0, WE HAVE OPTIONAL COPY FILE SPECS
064940* NOW PROCESS THESE COPY FILE SPECS
064960* FIRST, DELETE INSTR ENTRY USED TO POINT TO LITERAL SPECS
064980 SET X DOWN BY 1.
065000 SET LX TO T-INSTR. MOVE L-VALUE (LX) TO QUOTE-TABLE.
065020 PERFORM GET-DEV-LBL-PPN THRU GET-DLP-EXIT.
065040 MOVE FD-LABEL TO F-ID (FX).
065060 GO TO VERB-RESET.
065080 CREATE1.
065100 IF FLAG-PASS = 2 GO TO CREATE2.
065120 IF FLAG-VERB = 2 GO TO CREATE1A.
065140 MOVE 2 TO FLAG-VERB.
065160 IF FLAG-EOS2 = 1
065180 MOVE 041 TO ECODE
065200 PERFORM E-RROR THRU E-XIT
065220 MOVE SPACES TO WORD30
065240 GO TO E042.
065260* FLAG-CREATE (CLEARED BY SORT1) ALLOWS ONLY 1 CREATE/STAGE
065280* IF FLAG-CREATE = 1 GO TO E030.
065300 IF FLAG-ALPHA = ZERO GO TO E003.
065320 SET FX TO DX. SET LX TO FX.
065340* IF FIRST ARG AFTER VOCAB WORD -CREATE- WAS NOT
065360* QUOTED, THEN INSERT DEFAULT FILE SPECS NOW.
065380 IF TYPEV NOT = TYPE-LITERAL
065400 SET DX TO DX-LOWEST SET DX DOWN BY 1
065420 SET FX TO DX SET LX TO FX
065440 MOVE TYPE-LITERAL TO L-TYPEV (LX)
065460 MOVE 'CREATE.OUT' TO L-VALUE (LX) QUOTE-TABLE
065480 MOVE INSTR (X) TO T-INSTR.
065500 SET FX DOWN BY 1. SET L-NCHAR (LX) TO FX.
065520 IF FX LESS THAN DX-LOWEST SET DX-LOWEST TO FX.
065540 MOVE TYPE-FILE TO F-TYPEV (FX).
065560 MOVE QUOTE-TABLE TO F-ID (FX).
065580 SET INSTR (X) TO FX.
065600* IF WE JUST INSERTED FILE SPECS(FOR CASE OF 1ST ARG
065620* NOT A LITERAL), RE-INSERT THE CLOBBERED USER ARG.
065640 IF TYPEV NOT = TYPE-LITERAL
065660 SET X UP BY 1 MOVE T-INSTR TO INSTR (X).
065680 MOVE 1 TO FLAG-CREATE.
065700 GO TO VERB-CONTROL.
065720 CREATE1A.
065740 IF VAA = V-FILLER
065760 MOVE ZEROES TO VAA GO TO CREATE1B.
065780 SET INSTR (X) TO DX.
065800 GO TO VERB-CONTROL.
065820 CREATE1B.
065840 IF FLAG-ALPHA NOT EQUAL ZEROS
065860 MOVE QUOTE-TABLE TO WORD30 GO TO E002.
065880 MULTIPLY NUMBN10 BY MINUS-ONE GIVING INSTR (X).
065900 GO TO VERB-CONTROL.
065920 CREATE2.
065940 SET FX TO FX-PRIMARY. MOVE F-TYPEV (FX) TO TYPEV.
065960 IF TYPEV NOT EQUAL TO 27 MOVE 26 TO TYPEV.
065962* IF THIS IS NOT THE FIRST CREATE IN THIS STAGE, MAKE THE
065964* FD POINTER POINT TO THE SAME CFREATE FD AS THE FIRST CREATE.
065966 IF FLAG-CREATE = 0
065968 MOVE 1 TO FLAG-CREATE
065970 ELSE
065972 MOVE CREATE-FX TO T-INSTR INSTR (X).
065980 SET FX TO T-INSTR. SET CREATE-FX TO FX.
066000 SET LX TO FX. SET LX UP BY 1.
066020* LX ENTRY POINTS TO OPTIONAL USER SPECS IF NCHAR (LX)
066040* POINTS TO FX ENTRY.
066060 IF L-TYPEV (LX) = TYPE-LITERAL AND L-NCHAR (LX) = FX
066080 MOVE L-VALUE (LX) TO QUOTE-TABLE
066100 MOVE "CREATEOUT" TO FD-LABEL
066120 MOVE ZEROES TO F-PPN (FX)
066140 PERFORM GET-DEV-LBL-PPN THRU GET-DLP-EXIT
066160* FD-LABEL BELOW WILL HAVE GOTTEN RESET BY GET-DEV-LBL-PPN
066180* IF USER SPECIFIED A PROPER FILENAME(IE WITH PERIOD)
066200 MOVE FD-LABEL TO F-ID (FX).
066220* TYPE OF CREATE FILE IS SAME AS INPUT(IE 6 OR 7 BIT)
066240 MOVE TYPEV TO F-TYPEV (FX).
066260 IF FLAG-DEV-LBL-PPN = 0 MOVE ZEROS TO F-PPN (FX).
066280 MOVE 1 TO T-INSTR.
066300 IF TYPEV = 27 MOVE 2 TO T-INSTR.
066320 SET X UP BY 1. SET INSTR (X) TO T-INSTR.
066340 MOVE ZEROS TO NCHAR.
066360* FLAG-CREATE-LOOP SET BY OPEN1, GOTOQT1, GOTOXT1
066380* IF FLAG-CREATE-LOOP = ZERO MOVE 2 TO FLAG-CREATE-LOOP
066400* MOVE 024 TO ECODE PERFORM E-RROR THRU E-XIT.
066420 CREATE2A.
066440 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
066460 IF T-INSTR = ZEROS GO TO CREATE2B.
066480 IF T-INSTR LESS THAN 0
066500 MULTIPLY T-INSTR BY MINUS-ONE GIVING T-NUMBN
066520 ADD T-NUMBN TO NCHAR
066540 GO TO CREATE2A.
066560 SET DX TO T-INSTR.
066580* SUM TOTAL LENGTH OF CREATE ITEMS FOR LATER BUFF ALLOCATION
066600 ADD D-NCHAR (DX) TO NCHAR.
066620 GO TO CREATE2A.
066640 CREATE2B.
066660* FCHAR IS THE TOTAL STORAGE NEEDED FOR ALL BUFFERS
066680*
066700* DISABLE CREATE FROM AFFECTING ANY PART OF DYNAMIC STORAGE
066720* AS IT WILL NOW STORE DIRECTLY INTO ITS PRIVATE FD BUFFER.
066740*
066760* IF FCHAR < PRIMARY-LENGTH ADD PRIMARY-LENGTH TO FCHAR.
066780* IF FCHAR < SECONDARY-LENGTH ADD SECONDARY-LENGTH TO FCHAR.
066800* IF FCHAR < TERTIARY-LENGTH ADD TERTIARY-LENGTH TO FCHAR.
066820* MOVE FCHAR TO CREATE-ORIGIN.
066840 MOVE 1 TO CREATE-ORIGIN.
066860* MOVE FCHAR TO F-ORIGIN (FX).
066880 MOVE 1 TO F-ORIGIN (FX).
066882* USE THE LARGEST OF ANY MULTIPLE CREATE LIST(PER STAGE)
066884* AS THE CREATE LENGTH.
066886 IF NCHAR > F-RECLEN (FX)
066900 MOVE NCHAR TO F-RECLEN (FX).
066920 MOVE ZEROS TO F-BLKLEN (FX).
066940 MOVE ZEROS TO F-KEYLOC (FX).
066960 MOVE ZEROS TO F-KEYLEN (FX).
066980 MOVE F-RECLEN (FX) TO CREATE-LENGTH.
067000* ADD CREATE-LENGTH TO FCHAR.
067020 GO TO VERB-CONTROL.
067040 DISPLAY1.
067060 GO TO PRINT1.
067080 DISPLAYOFF1.
067100* IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
067120 GO TO VERB-RESET.
067140 DISPLAYON1.
067160* IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
067180 GO TO VERB-RESET.
067200 FIND1.
067220* HERE FOR MULTIPLE INPUT FILE FIND
067240 IF FLAG-PASS = 2 GO TO FIND2.
067260 IF FLAG-VERB = 2 GO TO FIND1A.
067280 IF FLAG-VERB = 3 GO TO FIND1B.
067300 FIND10.
067320 IF FLAG-ALPHA = ZERO GO TO E003.
067340 IF TYPEV NOT EQUAL TO TYPE-VARIABLE GO TO E003.
067360 IF VA = V-FROM GO TO E004.
067380 SET INSTR (X) TO FX. SET HX TO X. SET HX DOWN BY 1.
067400 SET X UP BY 1. SET INSTR (X) TO 5.
067420 SET X UP BY 1. SET INSTR (X) TO DX.
067440 SET PI TO DX.
067460 MOVE 2 TO FLAG-VERB.
067480 GO TO VERB-CONTROL.
067500 FIND1A.
067520 IF VA NOT EQUAL TO V-EQUAL GO TO E004.
067540 MOVE 3 TO FLAG-VERB.
067560 IF VP = V-NEXT
067570 SET X UP BY 1 MOVE VP TO INSTR (X)
067572 else
067580 SET INSTR (X) TO DX.
067600 GO TO VERB-CONTROL.
067620 FIND1B.
067640 IF VA = V-FROM GO TO VERB-CONTROL.
067660 IF VA NOT EQUAL TO V-BEGINNING GO TO FIND10.
067680 SET PX TO X. SET X TO HX.
067700 SET INSTR (X) TO V-FINDFROM.
067720 SET X TO PX.
067740 GO TO VERB-RESET.
067760 FIND2.
067780 IF T-INSTR = V-EOS GO TO VERB-CONTROL.
067800 IF T-INSTR NOT = 0 GO TO FIND2B.
067820* HERE ONLY FOR BAD FIND SYNTAX THAT HAS ALREADY BEEN
067840* REPORTED ON IN PASS 1--READ OVER TILL HIT EOS.
067860 FIND2A.
067880 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
067900 IF T-INSTR NOT = V-EOS GO TO FIND2A.
067920 GO TO VERB-CONTROL.
067940 FIND2B.
067960 SET PN TO X.
067980 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
068000 SET HX TO X.
068020 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
068040 SET DX TO T-INSTR.
068060 MOVE D-FCHAR (DX) TO NCHAR.
068080 IF NCHAR = ZEROS
068082 SET KX TO DX MOVE K-ENDKEY (KX) TO WORD30
068084 MOVE 1 TO ECODE
068086 PERFORM E-RROR THRU E-XIT
068088 GO TO FIND2A.
068100 MOVE 3 TO VA.
068120 IF NCHAR < TERTIARY-ORIGIN MOVE 2 TO VA.
068140 IF NCHAR < SECONDARY-ORIGIN MOVE 1 TO VA.
068160 IF VA = 3 IF TERTIARY-ORIGIN = -1
068180 MOVE 2 TO VA.
068200 IF N-INPUTFILES = 1 MOVE 1 TO VA.
068220 IF VA = 1
068240 MOVE 'legal only for DBMS/ISAM--' TO WORD30
068260 MOVE 52 TO ECODE PERFORM E-RROR THRU E-XIT
068270 GO TO FIND2A.
068280 IF VA = 2
068300 MOVE 'SECONDARY ' TO WORD18
068320 SET FX TO FX-SECONDARY.
068340 IF VA = 3
068360 MOVE 'TERTIARY ' TO WORD18
068380 SET FX TO FX-TERTIARY.
068400 IF FX = 1 GO TO E009.
068420 MOVE F-TYPEV (FX) TO TYPEV.
068440 IF TYPEV NOT EQUAL TO 27 MOVE 26 TO TYPEV.
068460 MOVE ZEROS TO T-INSTR.
068480 IF VA = 1 AND TYPEV = 26 MOVE 1 TO T-INSTR.
068500 IF VA = 1 AND TYPEV = 27 MOVE 2 TO T-INSTR.
068520 IF VA = 2 AND TYPEV = 26 MOVE 7 TO T-INSTR.
068540 IF VA = 2 AND TYPEV = 27 MOVE 8 TO T-INSTR.
068560 IF VA = 3 AND TYPEV = 26 MOVE 13 TO T-INSTR.
068580 IF VA = 3 AND TYPEV = 27 MOVE 14 TO T-INSTR.
068600 IF T-INSTR = ZEROS GO TO E009.
068620 IF F-KEYLOC (FX) NOT EQUAL TO ZERO ADD 2 TO T-INSTR.
068640 SET PX TO X.
068660 SET X TO PN. SET INSTR (X) TO FX.
068680 SET X TO HX. SET INSTR (X) TO T-INSTR.
068700 SET X TO PX.
068702 perform get-one-instr thru get-instrx.
068704* if do not have a 4th arg, then user has error.
068706 if t-instr = 0
068707 move 49 to ecode move spaces to word30
068708 perform e-rror thru e-xit
068710 move 50 to ecode
068712 move 'record-next-dataname-value' to word30
068714 perform e-rror thru e-xit go to verb-control.
068716 if t-instr = v-next set x down by 1.
068720 FIND2C.
068740 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
068760 IF T-INSTR = ZEROS GO TO VERB-CONTROL.
068780 GO TO FIND2C.
068800 FINDDBMS1.
068820 IF FLAG-PASS = 2 GO TO FINDDBMS2.
068840 IF FLAG-ALPHA = ZERO GO TO E003.
068850 MOVE 1 TO FLAG-FIND.
068860 IF FLAG-VERB = 2 GO TO FINDDBMS1A.
068880 IF FLAG-VERB = 3 GO TO FINDDBMS1B.
068900 IF FLAG-VERB = 4 GO TO FINDDBMS1C.
068920 IF FLAG-VERB = 5 GO TO FINDDBMS1D.
068940 SET INSTR (X) TO FX.
068960 SET X UP BY 1. SET INSTR (X) TO N-RSE.
068980 SET HX TO X.
069000 SET X UP BY 1. SET INSTR (X) TO VA.
069020 SET X UP BY 1. SET INSTR (X) TO DX.
069040 IF N-RSE = 4
069060 SET X UP BY 1 SET INSTR (X) TO DX
069070 MOVE 4 TO FLAG-VERB
069080 ELSE MOVE 3 TO FLAG-VERB.
069082 IF N-RSE = 5 MOVE 4 TO FLAG-VERB.
069084 IF N-RSE NOT = 2 GO TO VERB-CONTROL.
069086* SET ITEM AS A SET NAME AS PER PARA FINDDBMS1C.
069088 IF VA NOT = 0
069090 SET RX TO DX MOVE -20 TO R-AREA-SET (RX)
069092 GO TO VERB-CONTROL.
069094 MOVE 0 TO INSTR (X).
069096 SET X UP BY 1. SET INSTR (X) TO DX.
069098 IF VAA = V-RUN-UNIT
069100 MOVE VAA TO INSTR (X) GO TO VERB-CONTROL.
069102 MOVE 4 TO FLAG-VERB.
069104 GO TO VERB-CONTROL.
069120 FINDDBMS1A.
069140 MOVE 3 TO FLAG-VERB.
069160 IF N-RSE = 2 OR N-RSE = 3 OR N-RSE = 4
069180 GO TO VERB-CONTROL.
069200 IF VA = V-FINDRECORD AND N-RSE = ZEROS
069220 MOVE 5 TO N-RSE.
069240 SET X TO HX. SET INSTR (X) TO V.
069260 SET X UP BY 1. SET INSTR (X) TO FX.
069280 SET X UP BY 1. SET INSTR (X) TO N-RSE.
069300 SET X UP BY 1. SET INSTR (X) TO N-RSE.
069310 IF N-RSE = 5 MOVE 0 TO INSTR (X).
069320 SET X UP BY 1. SET INSTR (X) TO DX.
069330 IF N-RSE = 5 GO TO FINDDBMS1C.
069340 IF N-RSE = 1 SET INSTR (X) TO PI.
069360 SET X UP BY 1. SET INSTR (X) TO DX.
069380 MOVE 5 TO FLAG-VERB.
069400 GO TO VERB-CONTROL.
069420 FINDDBMS1B.
069440 SET INSTR (X) TO DX.
069442 IF N-RSE = 3
069444 SET RX TO DX MOVE VA TO R-AREA-SET (RX).
069460 MOVE 4 TO FLAG-VERB.
069480 GO TO VERB-CONTROL.
069500 FINDDBMS1C.
069510 IF VAA = V-RUN-UNIT GO TO FINDDBMS1D.
069520 IF VA < -20 OR VA > -18 GO TO E004.
069540 SET RX TO DX.
069560 MOVE VA TO R-AREA-SET (RX).
069562 IF N-RSE = 5
069564 SET X UP BY 1 MOVE 0 TO INSTR (X).
069580 MOVE 5 TO FLAG-VERB.
069600 GO TO VERB-CONTROL.
069620 FINDDBMS1D.
069622 IF VAA = V-RUN-UNIT
069624 MOVE VAA TO INSTR (X) MOVE 0 TO VAA GO TO VERB-CONTROL.
069640 IF NOT SUPPRESS-CONDITION GO TO FINDDBMS1C.
069660 SET X UP BY 1. ADD 100 VA GIVING INSTR (X).
069680 GO TO VERB-CONTROL.
069700 FINDDBMS2.
069720 IF FX-PRIMARY = 1 MOVE 'DBMS ' TO WORD18 GO TO E009.
069740 SET INSTR (X) TO FX-PRIMARY.
069742 MOVE 0 TO I.
069760 FINDDBMS2A.
069780 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
069800 ADD 1 TO I.
069820 IF I < 5 GO TO FINDDBMS2A.
069822 IF T-INSTR = 0 GO TO VERB-RESET.
069824 GO TO FINDDBMS2A.
069840 FINDFIRST1.
069860 GO TO VERB-CONTROL.
069880 FIND-FROM1.
069900 IF FLAG-PASS = 2 GO TO FIND2.
069920 GO TO E005.
069940 FINDKEY1.
069960 IF FLAG-PASS = 2 GO TO FINDKEY2.
069980 IF VP = V-EOF GO TO FINDKEY1C.
070000 IF FLAG-VERB = 2 GO TO FINDKEY1A.
070020 IF FLAG-VERB = 3 GO TO FINDKEY1B.
070040 MOVE 2 TO FLAG-VERB.
070060 IF VP NOT EQUAL TO V-EQUAL GO TO E004.
070080 SET X UP BY 1. SET INSTR (X) TO FX.
070100 SET X UP BY 1. SET INSTR (X) TO X.
070120 IF VA < 1 OR VA > 3 GO TO E008.
070140 IF VA = 1 MOVE 1 TO FLAG-RANDOM-READ1.
070160 IF VA = 2 MOVE 1 TO FLAG-RANDOM-READ2.
070180 IF VA = 3 MOVE 1 TO FLAG-RANDOM-READ3.
070200 SET X UP BY 1. SET INSTR (X) TO VA.
070220 MOVE ZEROS TO VA.
070240 GO TO VERB-CONTROL.
070260 FINDKEY1A.
070280 IF VA = V-THRU OR VA = V-TO GO TO E006.
070300 SET KX TO DX. SET HX TO KX.
070320 IF TYPEV = TYPE-LITERAL
070340 MOVE TYPE-SINGLE-KEY TO K-TYPEV (KX).
070360 SET INSTR (X) TO KX.
070380 MOVE ZEROS TO VA.
070400 MOVE 3 TO FLAG-VERB.
070420 GO TO VERB-CONTROL.
070440 FINDKEY1B.
070460 IF TYPEV NOT EQUAL TO TYPE-LITERAL GO TO E005.
070480 IF VA = V-THRU OR VA = V-TO GO TO FINDKEY1B1.
070500 GO TO FINDKEY1A.
070520 FINDKEY1B1.
070540 SET KX TO LX.
070560 MOVE K-STARTKEY (KX) TO WORD30.
070580 SET KX TO HX.
070600 MOVE TYPE-THRU-KEY TO K-TYPEV (KX).
070620 IF VA = V-TO MOVE TYPE-TO-KEY TO K-TYPEV (KX).
070640 MOVE WORD30 TO K-ENDKEY (KX).
070660 SET DX-LOWEST UP BY 1. SET X DOWN BY 1.
070680 MOVE ZEROS TO VA.
070700 MOVE 2 TO FLAG-VERB.
070720 GO TO VERB-CONTROL.
070740 FINDKEY1C.
070760 IF VA NOT EQUAL TO V-THRU GO TO E004.
070780 SET KX TO HX.
070800 MOVE TYPE-THRU-KEY TO K-TYPEV (KX).
070820 MOVE HIGH-VALUES TO K-ENDKEY (KX).
070840 GO TO VERB-RESET.
070860 FINDKEY2.
070880 SET PN TO X.
070900 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
070920 SET HX TO X.
070940 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
070960 SET VA TO T-INSTR.
070980 IF VA = 1 SET FX TO FX-PRIMARY.
071000 IF VA = 2 SET FX TO FX-SECONDARY.
071020 IF VA = 3 SET FX TO FX-TERTIARY.
071040 MOVE F-TYPEV (FX) TO TYPEV.
071060 IF VA = 1 AND TYPEV = 26 MOVE 1 TO T-INSTR.
071080 IF VA = 1 AND TYPEV = 27 MOVE 2 TO T-INSTR.
071100 IF VA = 2 AND TYPEV = 26 MOVE 5 TO T-INSTR.
071120 IF VA = 2 AND TYPEV = 27 MOVE 6 TO T-INSTR.
071140 IF VA = 3 AND TYPEV = 26 MOVE 9 TO T-INSTR.
071160 IF VA = 3 AND TYPEV = 27 MOVE 10 TO T-INSTR.
071180 SET INSTR (X) TO T-INSTR.
071200 FINDKEY2A.
071220 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
071240 IF FX = 1 GO TO E018.
071260 IF F-KEYLOC (FX) = ZEROS GO TO E018.
071280 IF T-INSTR NOT EQUAL TO ZEROS GO TO FINDKEY2A.
071300 SET PX TO X.
071320 SET X TO PN. SET INSTR (X) TO FX.
071340 SET X TO HX.
071360 SET PX UP BY 1. SET INSTR (X) TO PX.
071380 SET PX DOWN BY 1. SET X TO PX.
071400 GO TO VERB-CONTROL.
071420 FINDLAST1.
071440 GO TO VERB-CONTROL.
071460 FINDNEXT1.
071480 GO TO VERB-CONTROL.
071500 FINDOWNER1.
071520 GO TO VERB-CONTROL.
071540 FINDPRIOR1.
071560 GO TO VERB-CONTROL.
071580 FORM-LINES1.
071600 IF FLAG-PASS = 2 GO TO VERB-CONTROL.
071620 IF FLAG-ALPHA = 1 GO TO E002.
071640 IF NUMBN < 1 GO TO E008.
071660 SET INSTR (X) TO NUMBN.
071680 GO TO VERB-RESET.
071700 GOTO1.
071720 IF FLAG-PASS = 2 GO TO GOTO2.
071740 IF FLAG-ALPHA = 1 GO TO E002.
071760 IF NUMBN < 00 OR NUMBN > 99 GO TO E008.
071780 SET X UP BY 1. SET INSTR (X) TO DX.
071800 MOVE TYPE-GOTO TO D-TYPEV (DX).
071820 MOVE NUMBN TO D-NCHAR (DX).
071840 MOVE 1 TO FLAG-GOTO.
071860 GO TO VERB-RESET.
071880 GOTO2.
071900 SET DX TO T-INSTR.
071920* FOR STATEMENT #S, D-SCALE IS THE ASSIGNED ADDRESS WITHIN
071940* THE INSTR TABLE OF THE STATEMENT NUMBER.
071960 IF D-SCALE (DX) = ZEROS
071980 MOVE 'STATEMENT NUMBER' TO WORD30
072000 MOVE D-NCHAR (DX) TO WORD30-STNUMB
072020 GO TO E001.
072022 IF X = SORT-GOTO-X + 9 MOVE V-GOTO TO INSTR(SORT-GOTO-X)
072024 MOVE T-INSTR TO INSTR(SORT-GOTO-X + 1).
072040 GO TO VERB-CONTROL.
072060 GOTO3.
072080* GET HERE VIA PERFORM AFTER 2ND PASS IS COMPLETED.
072100 IF FLAG-GOTO = ZERO GO TO GOTO3X.
072120 SET HX TO X. SET X TO X-START. SET X DOWN BY 1.
072140 GOTO3A.
072160 IF X > HX GO TO GOTO3X.
072180 SET X UP BY 1. IF INSTR (X) = ZEROS GO TO GOTO3A.
072200 SET V TO INSTR (X).
072220 IF V NOT EQUAL TO V-GOTO GO TO GOTO3B.
072240 SET X UP BY 1.
072260* IF GOTO PARAMETER IS > DX-MAX, THEN WE HAVE AN INTERNALLY
072280* GENERATED GOTO(VIA ELSE2) AND WE MERELY SUBTRACT
072300* DX-MAX FROM GOTO PARAMETER AND GET CORRECT GOTO ADDRESS
072320 IF INSTR (X) > DX-MAX
072340 SUBTRACT DX-MAX FROM INSTR (X) GO TO GOTO3A.
072360 SET DX TO INSTR (X).
072380 SET INSTR (X) TO D-SCALE (DX).
072400 GO TO GOTO3A.
072420 GOTO3B.
072440 IF X > HX GO TO GOTO3X.
072460 SET X UP BY 1. IF INSTR (X) = ZEROS GO TO GOTO3A.
072480 GO TO GOTO3B.
072500 GOTO3X. EXIT.
072520 GOTONR1.
072540 GO TO VERB-RESET.
072560 GOTOQT1.
072580 MOVE 1 TO FLAG-CREATE-LOOP.
072600 GO TO VERB-RESET.
072620 GOTOXT1.
072640 MOVE 1 TO FLAG-CREATE-LOOP.
072660 GO TO VERB-RESET.
072680 HEADINGOFF1.
072700* IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
072720 GO TO VERB-RESET.
072740 HEADINGON1.
072760* IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
072780 GO TO VERB-RESET.
072800 HOLD1.
072820 IF FLAG-PASS = 2 GO TO HOLD2.
072840 IF FLAG-ALPHA = ZERO GO TO E003.
072860 IF TYPEV = TYPE-TODAY GO TO E003.
072880 IF TYPEV = TYPE-XRANDOM GO TO E003.
072900 SET INSTR (X) TO DX.
072920 MOVE WORD30 TO HWORD30. MOVE HELD-WORD30 TO WORD30.
072940 PERFORM DROP-IN-DX THRU DIDX.
072960 SET X UP BY 1. SET INSTR (X) TO DX.
072980 GO TO VERB-CONTROL.
073000 HOLD2.
073020 SET DX TO T-INSTR.
073040 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
073060 SET VX TO T-INSTR.
073080* MAKE THE HELD. ENTRY (VX) LOOK BASICALLY LIKE
073100* SOURCE OR HOLD ENTRY (DX) INCLDG TYPE,NC,SCALE
073120 MOVE D-ENTRY (DX) TO V-ENTRY (VX).
073140 SET DX TO VX.
073142 MOVE D-TYPEV (DX) TO TYPEV.
073144* FOR HELD SPECIAL ITEMS, CHANGE TYPE TO ALPHA OR NUM (BINARY?)
073146 IF TYPEV = 24 OR TYPEV = 32 OR TYPEV = 35
073148 MOVE 2 TO D-TYPEV (DX).
073150 IF TYPEV = 33 OR 34 OR 36 MOVE 1 TO D-TYPEV (DX).
073160 MOVE FCHAR TO D-FCHAR (DX).
073180 IF TYPEV = TYPE-BINARY
073200 IF D-NCHAR (DX) < 11 ADD 6 TO FCHAR ELSE ADD 12 TO FCHAR
073220 ELSE ADD D-NCHAR (DX) TO FCHAR.
073240 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
073260 IF T-INSTR = ZEROS GO TO VERB-CONTROL.
073280 GO TO HOLD2.
073300 HSPACE1.
073320 IF FLAG-PASS = 2 GO TO VERB-CONTROL.
073340 IF FLAG-ALPHA = 1 GO TO E002.
073360 IF NUMBN < 0 GO TO E008.
073380 MOVE NUMBN10 TO T-NUMBN.
073400 ADD 1 TO T-NUMBN.
073420 MULTIPLY T-NUMBN BY MINUS-ONE GIVING T-NUMBN.
073440 SET INSTR (X) TO T-NUMBN.
073460 GO TO VERB-RESET.
073480 IF1.
073500 IF FLAG-PASS = 2 GO TO IF2.
073520* BUG OUT IF NOT THE FIRST TIME AS ARGS ARE BEING
073540* INSERTED BY VERB-CONTROL.
073560 IF FLAG-IF = 1 GO TO VERB-CONTROL.
073580 MOVE 1 TO FLAG-IF.
073600* IF JUST READ 'NOT' (INDICATED BY VP-NOT = 1), THEN
073620* FLAG-NOT IS ALREADY SET, OTHERWISE SET FLAG-NOT TO
073640* SAVED FLAG-NOT PERTINENT THE CURRENT PAREN LEVEL.
073660 IF VP-NOT = 1 OR N-OPENLPS = 0 NEXT SENTENCE
073680 ELSE MOVE NOTT (N-OPENLPS) TO FLAG-NOT.
073700 SET INSTR (X) TO X.
073720 SET X UP BY 1. SET INSTR (X) TO X.
073740* SET ( INTO INSTR TABLE FOR EACH CONSECUTIVE ( FOUND.
073760 IF1A.
073780 IF LPARENCNTR = 0 GO TO IF1B.
073800 SUBTRACT 1 FROM LPARENCNTR.
073820 SET X UP BY 1.
073840 MOVE V-LPAREN TO INSTR (X).
073860 GO TO IF1A.
073880 IF1B.
073940 SET X UP BY 1 MOVE DX-IFLEFTSIDE TO INSTR (X).
073960 IF FLAG-NOT = 0 GO TO IF1C.
073980* FOR RELATIONALS THAT ARE PRECEEDED BY NOT, REVERSE THE RELATIO
074000 IF VA = V-EQUAL MOVE V-NOTEQUAL TO VA GO TO IF1C.
074020 IF VA = V-NOTEQUAL MOVE V-EQUAL TO VA GO TO IF1C.
074040 IF VA = V-LESS MOVE V-GREATEREQUAL TO VA GO TO IF1C.
074060 IF VA = V-GREATER MOVE V-LESSEQUAL TO VA GO TO IF1C.
074080 IF VA = V-LESSEQUAL MOVE V-GREATER TO VA GO TO IF1C.
074100 IF VA = V-GREATEREQUAL MOVE V-LESS TO VA GO TO IF1C.
074120 GO TO E029.
074140 IF1C.
074160 SET X UP BY 1. SET INSTR (X) TO VA.
074180 SET X UP BY 1. SET INSTR (X) TO DX.
074200* IF JUST READ 'NOT', FLIP IT BACK TO GLOBAL PAREN STATE.
074220 IF VP-NOT = 0 GO TO VERB-CONTROL.
074240 MOVE 0 TO VP-NOT.
074260 IF FLAG-NOT = 1 MOVE 0 TO FLAG-NOT
074280 ELSE MOVE 1 TO FLAG-NOT.
074300 GO TO VERB-CONTROL.
074320 IF2.
074340* IF VERB HAS BEEN READ AND STORED AND X IS POINTING
074360* TO THE NEXT INSTR ENTRY (TRUEGO).
074380* IF2 WILL STACK THE TRUE AND FALSE ADDRESS AND THEN
074400* READ THE ENTIRE IF LIST ENDED BY 0
074420 PERFORM DROP-IN-TRUEGO THRU DITGOX.
074440 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
074460 PERFORM DROP-IN-FALSEGO THRU DIFGOX.
074461* read/save left of relational.
074462 IF2-1.
074463 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
074464 IF T-INSTR = V-LPAREN
074466 PERFORM LPAREN2 THRU LPAREN2X GO TO IF2-1.
074467 SET DX TO T-INSTR. SET LEFT-DX TO DX.
074468 MOVE D-TYPEV (DX) TO LEFT-TYPE.
074470 MOVE D-NCHAR (DX) TO LEFT-LEN.
074472 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
074474* NOW READ RIGHT SIDE OF RELATIONAL
074480 IF2A.
074500 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
074520 IF T-INSTR = V-LPAREN
074540 PERFORM LPAREN2 THRU LPAREN2X GO TO IF2A.
074542 IF T-INSTR = 0 GO TO IF2B.
074544 SET DX TO T-INSTR.
074546 MOVE D-TYPEV (DX) TO RIGHT-TYPE.
074548 MOVE D-NCHAR (DX) TO RIGHT-LEN.
074550 IF LEFT-TYPE = TYPE-VARIABLE GO TO IF2A-3.
074552 IF RIGHT-TYPE NOT = TYPE-VARIABLE GO TO IF2A.
074554* HERE FOR DN:VAR
074556 IF LEFT-LEN < RIGHT-LEN GO TO IF2A.
074558 IF2A-1.
074560 MOVE LEFT-LEN TO D-NCHAR (DX) D-ECHAR (DX).
074562 IF2A-2.
074564 IF FCHAR = 0 MOVE 1 TO FCHAR.
074565 MOVE FCHAR TO D-FCHAR (DX).
074566 ADD D-NCHAR (DX) TO FCHAR.
074567 GO TO IF2A.
074568 IF2A-3.
074569* HERE FOR VAR:VAR AND VAR:DN
074570 IF RIGHT-TYPE = TYPE-VARIABLE GO TO IF2A-5.
074571* HERE FOR VAR:DN
074572 IF LEFT-LEN > RIGHT-LEN GO TO IF2A.
074573 IF2A-4.
074574 SET DX TO LEFT-DX.
074575 MOVE RIGHT-LEN TO D-NCHAR (DX) D-ECHAR (DX).
074576 GO TO IF2A-2.
074577 IF2A-5.
074578* HERE FOR VAR:VAR
074579 IF RIGHT-LEN = 0 AND LEFT-LEN = 0 GO TO IF2A.
074580 IF LEFT-LEN > RIGHT-LEN GO TO IF2A-1.
074581 GO TO IF2A-4.
074584* HAVE HIT END OF IF LIST--SEE IF THIS IS FOLLOWED BY
074600* ANOTHER IF OR A VERB LIST
074620 IF2B.
074640 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
074660 IF T-INSTR = V-THEN GO TO IFTHEN2.
074680 IF T-INSTR = V-AND GO TO IFAND2.
074700 IF T-INSTR = V-OR GO TO IFOR2.
074720 IF T-INSTR = V-RPAREN
074740 PERFORM RPAREN2 THRU RPAREN2X GO TO IF2B.
074760 IF T-INSTR = V-EOS
074762 MOVE 'PERHAPS DUE TO OTHER ERRORS,AN' TO WORD30
074764 GO TO E039.
074780 IF T-INSTR = 0 GO TO E022.
074800* HERE FOR VERB WITHOUT THEN OR IF WITHOUT AND/OR
074820* ACT AS THOUGH 'THEN' WERE READ AND THEN BACK UP READ
074840 PERFORM POPALL-TRUE THRU POPALLTX.
074860 SET LI DOWN BY 1.
074880 SET X DOWN BY 1.
074900 GO TO VERB-CONTROL.
074920 IFTHEN1.
074940 GO TO VERB-CONTROL.
074960 IFTHEN2.
074980* POP ALL TRUE STACK AND DELETE 'THEN' FROM INSTR
075000* TABLE BY DECREMENTING X
075020 PERFORM POPALL-TRUE THRU POPALLTX.
075040 IFTHEN2A.
075060* READ OVER THE NOP FOLLOWING -THEN- AND ILLIMINATE
075080* -THEN-NOP- FROM INSTR
075100 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
075120 IF T-INSTR = 0 SET X DOWN BY 2
075140 ELSE GO TO E022.
075160 GO TO VERB-CONTROL.
075180 IFAND2.
075200* POP TOP (IE LAST) TRUE AND DELETE 'AND' AND ITS
075220* TRAILING V-NOP FROM INSTR TABLE BY DECREMENTING X
075240 PERFORM POP-TRUE THRU POPTX.
075260 IF RPARENCNTR = 0 GO TO IFAND3.
075280 IF N-TRUEGO = 0
075300 MOVE 0 TO RPARENCNTR SUBTRACT 1 FROM LPARENCNTR
075320 GO TO IFAND3.
075340* POP TRUE STACK TILL FIND SAME X-TRUEGO AS INDICATED
075360* BY TOP OF TRUE-LPAREN STACK.
075380* REPEAT THIS SEARCHING-POPPING RPARENCNTR TIMES.
075400 IF TRUE-LPAREN (TLPX) < POPPED-X GO TO IFAND2.
075420 IF TRUE-LPAREN (TLPX) > POPPED-X GO TO IFAND2A.
075440 SUBTRACT 1 FROM TLPX.
075460 IFAND2A.
075480 SUBTRACT 1 FROM RPARENCNTR.
075500 SUBTRACT 1 FROM LPARENCNTR.
075520 IF RPARENCNTR GREATER THAN 0 GO TO IFAND2.
075540 IFAND3.
075560 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
075580 IF T-INSTR NOT = 0 GO TO E022.
075600 SET X DOWN BY 2.
075620 GO TO VERB-CONTROL.
075640 IFOR2.
075660* POP TOP (IE LAST) FALSE AND DELETE 'OR' FROM INSTR TABLE
075680* BY DECREMENTING X.
075700 PERFORM POP-FALSE THRU POPFX.
075720 IF RPARENCNTR = 0 GO TO IFAND3.
075740 IF N-FALSEGO = 0
075760 MOVE 0 TO RPARENCNTR SUBTRACT 1 FROM LPARENCNTR
075780 GO TO IFAND3.
075800* POP FALSE STACK SIMILIAR TO 'AND' ABOVE.
075820 IF FALSE-LPAREN (FLPX) < POPPED-X GO TO IFOR2.
075840 IF FALSE-LPAREN (FLPX) > POPPED-X GO TO IFOR2A.
075860 SUBTRACT 1 FROM FLPX.
075880 IFOR2A.
075900 SUBTRACT 1 FROM RPARENCNTR.
075920 SUBTRACT 1 FROM LPARENCNTR.
075940 IF RPARENCNTR GREATER THAN 0 GO TO IFOR2.
075960 GO TO IFAND3.
075980 IFELSE1.
076000 IF FLAG-PASS = 2 GO TO IFELSE2.
076020 GO TO VERB-CONTROL.
076040 IFELSE2.
076060* REPLACE ELSE AND V-NOP INSTR ENTRIES WITH GOTO N, WHERE
076080* N WILL BE ASSIGNED LATER.
076100* NEXT, POP FALSE STACK TO POINT TO NEXT INSTR ENTRY
076120* (START OF ELSE LIST).
076140 SET X DOWN BY 1.
076160 MOVE V-GOTO TO INSTR (X).
076180* TEMPORALLY, SET X UP 1 BEYOND GOTO/N ENTRIES TO ENABLE
076200* POP FALSE TO SET TO POINT TO ENTRY FOLLOWING CURRENT ENTRY.
076220 SET X UP BY 2.
076240 PERFORM POPALL-FALSE THRU POPALLFX.
076260 SET X DOWN BY 1.
076280 SET ELSE-X TO X.
076300 GO TO VERB-CONTROL.
076320 IFANY1.
076340 GO TO IF1.
076360 IFFIRST1.
076380 GO TO IF1.
076400 IFLAST1.
076420 GO TO IF1.
076440 IFNEXT1.
076460 GO TO IF1.
076480 IFSAME1.
076500 GO TO IF1.
076520 IFBOF1.
076540 GO TO IFFIRSTIME1.
076560 IFBOF2.
076580 GO TO IFFIRSTIME1.
076600 IFBOF3.
076620 GO TO IFFIRSTIME1.
076720 IFEOF1.
076740 GO TO IFFIRSTIME1.
076760 IFEOF2.
076780 GO TO IFFIRSTIME1.
076800 IFEOF3.
076820 GO TO IFFIRSTIME1.
076840 IFLASTIME1.
076860 GO TO IFFIRSTIME1.
076880 IFFIRSTIME1.
076900 IF FLAG-PASS = 2 GO TO IFFIRSTIME2.
076913* should only come here once for each use--otherwise
076914* a verb is missing and got here because v was not
076916* reset by a new verb
076917 if flag-verb = 2 go to e005.
076918 move 2 to flag-verb.
076919 MOVE 1 TO FLAG-IF.
076920 SET X UP BY 1.
076940 IF VP-NOT = 1 OR N-OPENLPS = 0 NEXT SENTENCE
076960 ELSE MOVE NOTT (N-OPENLPS) TO FLAG-NOT.
076980 MOVE FLAG-NOT TO INSTR (X).
077000 SET X UP BY 1. SET INSTR (X) TO X.
077020 SET X UP BY 1. SET INSTR (X) TO X.
077040* SET ( INTO INSTR TABLE FOR EACH CONSECUTIVE ( FOUND.
077060 IFFIRSTIME1A.
077080 IF LPARENCNTR = 0 GO TO IFFIRSTIME1B.
077100 SUBTRACT 1 FROM LPARENCNTR.
077120 SET X UP BY 1.
077140 MOVE V-LPAREN TO INSTR (X).
077160 GO TO IFFIRSTIME1A.
077180 IFFIRSTIME1B.
077200 IF VP-NOT = 0 GO TO VERB-CONTROL.
077220 MOVE 0 TO VP-NOT.
077240 IF FLAG-NOT = 1 MOVE 0 TO FLAG-NOT
077260 ELSE MOVE 1 TO FLAG-NOT.
077280 GO TO VERB-CONTROL.
077300 IFFIRSTIME2.
077320 MOVE INSTR (X) TO FLAG-NOT.
077340 SET X DOWN BY 1.
077360 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
077380* IF NOT CONDITION IS SET, THEN REVERSE TRUE/FALSE
077400 IF FLAG-NOT = 1
077420 PERFORM DROP-IN-FALSEGO THRU DIFGOX
077440 PERFORM GET-ONE-INSTR THRU GET-INSTRX
077460 PERFORM DROP-IN-TRUEGO THRU DITGOX
077480 GO TO IFFIRSTIME2A.
077500 PERFORM DROP-IN-TRUEGO THRU DITGOX.
077520 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
077540 PERFORM DROP-IN-FALSEGO THRU DIFGOX.
077560 IFFIRSTIME2A.
077580 IF FLAG-IFFIRST = 0 GO TO IF2A ELSE MOVE 0 TO FLAG-IFFIRST.
077600* GET GROUP ITEM entry for if newgroup(if there is one)
077620 IFFIRSTIME2B.
077640 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
077660 IF T-INSTR = 0 GO TO IF2B.
077670 if t-instr = v-lparen
077672 perform lparen2 thru lparen2x go to iffirstime2b.
077680* NEXT GET PRIOR VALUE ENTRY AND MODIFY ITS ORIGIN
077700 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
077720 PERFORM ASSIGN-PRIOR-ORIGIN THRU ASSIGN-PRIORX.
077740 GO TO IFFIRSTIME2B.
077760 IFNEWGROUP1.
077780 IF FLAG-PASS = 2 MOVE 1 TO FLAG-IFFIRST GO TO IFFIRSTIME2.
077800* INDICATE TO IQE THAT PREV RECORD MUST BE SAVED
077820 MOVE 1 TO SUMBREAK-FLAG.
077840 IF FLAG-ALPHA = ZERO GO TO E003.
077860* BUG OUT IF NOT FIRST TIME HERE AS ARGS ARE BEING
077880* STORED BY VERB-CONTROL.
077900 IF FLAG-IF = 1
077920 MOVE 1 TO FLAG-IFFIRST
077940 PERFORM ALLOCATE-ACCUM-BUCKETS THRU ALLOC-ACCX
077960 MOVE 0 TO FLAG-IFFIRST
077980 GO TO VERB-CONTROL.
078000 MOVE 1 TO FLAG-IF.
078020 GO TO IFFIRSTIME1.
078040 IFNEWPAGE1.
078060 GO TO IFFIRSTIME1.
078080 INVALID-KEY1.
078100 GO TO VERB-CONTROL.
078120 INVOKE1.
078140 IF FLAG-PASS = 2 GO TO INVOKE2.
078160 IF FLAG-VERB = 2 GO TO INVOKE1A.
078180 GO TO VERB-CONTROL.
078200 INVOKE1A.
078220 GO TO VERB-RESET.
078240 INVOKE2.
078260 GO TO VERB-CONTROL.
078280 LMARGIN1.
078300 IF FLAG-PASS = 2 GO TO VERB-CONTROL.
078320 IF FLAG-ALPHA = 1 GO TO E002.
078340 IF NUMBN < 1 GO TO E008.
078360 SET INSTR (X) TO NUMBN.
078380 GO TO VERB-RESET.
078400 LPAREN2.
078420 ADD 1 TO LPARENCNTR.
078440 ADD 1 TO TLPX.
078460* STORE CURRENT VALUE OF TOP OF TRUE STACK
078480 MOVE X-TRUEGO (TSX) TO TRUE-LPAREN (TLPX).
078500* DO SAME FOR FALSE PARENS
078520 ADD 1 TO FLPX.
078540 MOVE X-FALSEGO (FSX) TO FALSE-LPAREN (FLPX).
078560 SET X DOWN BY 1.
078580 LPAREN2X. EXIT.
078600 RPAREN2.
078620 ADD 1 TO RPARENCNTR.
078640 IF RPARENCNTR GREATER THAN LPARENCNTR
078642 MOVE 010 TO ECODE PERFORM E-RROR THRU E-XIT.
078660* ILLIMINATE ) AND FOLLOWING V-NOP FROM INSTR TABLE
078680 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
078700 SET X DOWN BY 2.
078720 RPAREN2X. EXIT.
078740 MAXIMUM1.
078760 IF FLAG-PASS = 2
078780 MOVE '*WARNING-MAXIMUM STATEMENT' TO WORD30
078800 GO TO TALLY2.
078820 GO TO TALLY1.
078840 MINIMUM1.
078860 IF FLAG-PASS = 2
078862 MOVE '*WARNING-MINIMUM STATEMENT' TO WORD30 GO TO TALLY2.
078864 GO TO TALLY1.
078880 NEWPAGE1.
078900* IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
078920 GO TO VERB-RESET.
078940 OPEN1.
078960 IF FLAG-PASS = 2 GO TO OPEN2.
078980 IF FLAG-ALPHA = ZERO GO TO E003.
079000 IF TYPEV = TYPE-LITERAL AND FLAG-VERB = 0
079020 GO TO E001.
079040 IF TYPEV = TYPE-LITERAL AND FLAG-VERB = 1
079060 SET L-NCHAR (LX) TO FX
079080 MOVE 0 TO FLAG-VERB GO TO VERB-CONTROL.
079100 SET X DOWN BY 1.
079120 MOVE 1 TO FLAG-VERB.
079140 SET FX TO DX. MOVE TYPE-FILE TO F-TYPEV (FX).
079160 ADD 1 TO N-INPUTFILES. IF N-INPUTFILES > 3 GO TO E005.
079180* OPEN1 SETS FX-PRIMARY,FX-SEC,FX-TERT DEPENDING ON
079200* WHICH ENTRY WE ARE COMING INTO OPEN1 WITH
079220 IF N-INPUTFILES = 1 SET FX-PRIMARY TO FX GO TO OPEN1A.
079240 IF N-INPUTFILES = 2 SET FX-SECONDARY TO FX.
079260 IF FX-SECONDARY = FX-PRIMARY GO TO E038.
079280 IF N-INPUTFILES = 2 GO TO OPEN1A.
079300 SET FX-TERTIARY TO FX.
079320 IF FX-TERTIARY = FX-PRIMARY GO TO E038.
079340 IF FX-TERTIARY = FX-SECONDARY GO TO E038.
079360 OPEN1A.
079380 MOVE 1 TO FLAG-CREATE-LOOP.
079400 GO TO VERB-CONTROL.
079420 OPEN2.
079440* FIRST CHECK FOR FILE READ PROTECT
079460 MOVE 0 TO FILENO.
079480 OPEN2A.
079500 ADD 1 TO FILENO.
079520 IF FILENO = 1 SET FX TO FX-PRIMARY.
079540 IF FILENO = 2 SET FX TO FX-SECONDARY.
079560 IF FILENO = 3 SET FX TO FX-TERTIARY.
079580 MOVE FD-RPROT (FILENO) TO TEST-REF-NO.
079600 PERFORM UNLOCKER THRU UNLOCKER-EXIT.
079620 IF FLAG-LOCKED NOT = 1 GO TO OPEN2A2.
079622* HERE IF USER HAS NOT FURNISHED PROPER PASSWORDS FOR FILE
079624* ACCESS EITHER THRU AUTHORITY OR A PREVIOUS PROMPTING
079626* POSSIBILITY IN RDICT-DD6
079627 MOVE 'FILE ACCESS' TO ITEM-OR-FILE.
079628 IF FLAG-PW-OPEN = 0
079629 MOVE 1 TO FLAG-PW-OPEN
079630 PERFORM PASSWORD-PROMPTER THRU PROMPTX.
079631 IF N-PROMPTS = 0 GO TO OPEN2A1.
079632 MOVE PROMPT-PW-POINTER TO PW-LIST.
079634 MOVE N-PROMPTS TO N-PW.
079636 PERFORM UNLOCKER THRU UNLOCKER-EXIT.
079638 IF FLAG-LOCKED NOT = 1 GO TO OPEN2A2.
079640 OPEN2A1.
079650 MOVE FD-NAMEPROT (FILENO) TO WORD30. MOVE 14 TO ECODE.
079660 PERFORM E-RROR THRU E-XIT.
079670 OPEN2A2.
079680 IF FILENO LESS THAN N-INPUTFILES GO TO OPEN2A.
079700* SEE IF FILE SPECS ARE TO BE MODIFIED
079720 MOVE 1 TO FLAG-OPENARGS.
079740 IF T-INSTR = 0 MOVE 0 TO FLAG-OPENARGS GO TO OPEN2B.
079760 PERFORM PROCESS-OPEN-ARGS THRU PROCESS-OPEN-ARGSX.
079780 MOVE ZERO TO INSTR (X).
079800 OPEN2B.
079820 IF FLAG-RANDOM-READ1 = 1 GO TO OPEN2C.
079840 SET X UP BY 1. SET INSTR (X) TO V-READ.
079860 MOVE V-ASCENDING TO T-INSTR.
079880 SET FX TO FX-PRIMARY.
079900 SET X UP BY 1. SET INSTR (X) TO FX.
079920 IF F-TYPEV (FX) = 27 ADD 1 TO T-INSTR.
079940* IS THIS INDEXED SEQUENTIAL?
079960 IF F-KEYLOC (FX) NOT = 0 ADD 2 TO T-INSTR.
079980 SET X UP BY 1. SET INSTR (X) TO T-INSTR.
080000 SET X UP BY 1. SET INSTR (X) TO ZEROS.
080020 OPEN2C.
080040 IF FLAG-OPENARGS = 0 GO TO VERB-CONTROL.
080060 OPEN2D.
080080 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
080100 IF T-INSTR = 0 GO TO VERB-CONTROL.
080120 PERFORM PROCESS-OPEN-ARGS THRU PROCESS-OPEN-ARGSX.
080140 MOVE V-OPEN TO INSTR (X).
080160 IF N-INPUTFILES = 3 IF FX = FX-SECONDARY
080180 SET X UP BY 1 MOVE 0 TO INSTR (X).
080200 GO TO OPEN2D.
080220 PROCESS-OPEN-ARGS.
080240* PROCESS THE OPEN ARGUMENT (WHICH IS A FILENAME SPECIFICATION
080260* LITERAL--PROCESS BY MODIFYING THE F-ID ACCDG TO LITERAL.
080280 SET LX TO T-INSTR.
080300 MOVE L-VALUE (LX) TO QUOTE-TABLE.
080320 SET FX TO LX. SET FX UP BY 1.
080340 PERFORM GET-DEV-LBL-PPN THRU GET-DLP-EXIT.
080360 MOVE FD-LABEL TO F-ID (FX).
080380 PROCESS-OPEN-ARGSX. EXIT.
080400 PAGE1.
080420 IF FLAG-PASS = 2 GO TO VERB-CONTROL.
080440 IF FLAG-ALPHA = 0
080460 IF NUMBN < 0 GO TO E008.
080480 SET INSTR (X) TO DX.
080500 GO TO VERB-RESET.
080520 PAGINGOFF1.
080540* IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
080560 GO TO VERB-RESET.
080580 PAGINGON1.
080600* IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
080620 GO TO VERB-RESET.
080640 PAGE-LINES1.
080660 IF FLAG-PASS = 2 GO TO VERB-CONTROL.
080680 IF FLAG-ALPHA = 1 GO TO E002.
080700 IF NUMBN < 1 GO TO E008.
080720 SET INSTR (X) TO NUMBN.
080740 GO TO VERB-RESET.
080760 PICTURE1.
080780 IF FLAG-PASS = 2 GO TO PICTURE2.
080800 IF FLAG-VERB = 2 GO TO PICTURE1A.
080820* FOR FLAG-VERB = 3, WE ARE ENTERING PICTURE1 VIA A MULTI
080840* LIST DESIGNATION(IE PICTURE DN=LIT,DN1=LIT1,... AND SINCE
080860* THERE IS ONLY 1 PICTURE VERB, AND WE ARE ON THE 2ND OR
080880* BEYOND DN, WE MISSED PUTTING IN THE ACTUAL 2ND ETC OCCURENCE
080900* OF PICTURE--BACK UP AND DO IT NOW.
080920 IF FLAG-VERB = 3 SET X DOWN BY 1
080940 PERFORM DROP-IN-VERB THRU DIVX SET X UP BY 1.
080960 MOVE 2 TO FLAG-VERB.
080980 IF FLAG-ALPHA = ZERO GO TO E003.
081000 SET INSTR (X) TO DX.
081020 GO TO VERB-CONTROL.
081040 PICTURE1A.
081060 MOVE 1 TO FLAG-VERB.
081080 IF VA NOT EQUAL TO V-EQUAL GO TO E004.
081100 IF TYPEV NOT EQUAL TO TYPE-LITERAL
081120 GO TO E015.
081140 IF Q > 20 GO TO E016.
081150 MOVE SPACES TO L-ENTRY (LX).
081160 SET DX-LOWEST UP BY 1.
081180 EXAMINE QUOTE-TABLE TALLYING ALL '.'.
081200 IF TALLY > 1 GO TO E021.
081220 EXAMINE QUOTE-TABLE TALLYING ALL 'S'.
081240 IF TALLY > 1 GO TO E021.
081260 SET INSTR (X) TO QUOTEN (1).
081280 SET X UP BY 1. SET INSTR (X) TO QUOTEN (2).
081300 SET X UP BY 1. SET INSTR (X) TO QUOTEN (3).
081320 SET X UP BY 1. SET INSTR (X) TO QUOTEN (4).
081340 MOVE 3 TO FLAG-VERB.
081360 GO TO VERB-CONTROL.
081380 PICTURE2.
081400 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
081420* MAKE SURE THE DATANAME IS FOLLOWED BY A PICTURE.
081440* IF T-INSTR = 0
081460* MOVE 'CHECK SYNTAX FOR DN = LITERAL' TO WORD30
081480* GO TO E021.
081500 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
081520 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
081540 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
081560 GO TO VERB-CONTROL.
081580 PRINT1.
081600 IF FLAG-PASS = 2 GO TO PRINT2.
081620 IF FLAG-VERB = 1 AND V = V-PRINT GO TO PRINT1A.
081640 IF FLAG-ALPHA = 1 SET INSTR (X) TO DX
081660 GO TO VERB-CONTROL.
081680 MOVE NUMBN10 TO T-NUMBN.
081700 IF T-NUMBN = V-CONCAT MOVE MINUS-ONE TO T-NUMBN.
081720 IF T-NUMBN < 0 MOVE ZEROS TO T-NUMBN.
081740 ADD 1 TO T-NUMBN.
081760 MULTIPLY T-NUMBN BY MINUS-ONE GIVING T-NUMBN.
081780 SET INSTR (X) TO T-NUMBN.
081800 GO TO VERB-CONTROL.
081820 PRINT1A.
081840 SET INSTR (X) TO CONST1. SET X UP BY 1.
081860 SET INSTR (X) TO CONST1. SET X UP BY 1.
081880 SET INSTR (X) TO CONST1. SET X UP BY 1.
081900 MOVE 2 TO FLAG-VERB.
081920 GO TO PRINT1.
081940 PRINT2.
081942 IF T-INSTR = 0 MOVE 'Print statement' TO WORD30 GO TO E046.
081944 PRINT2A.
081960 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
081980 IF T-INSTR = ZERO GO TO VERB-CONTROL.
082000 GO TO PRINT2A.
082020 PRINTOFF1.
082040* IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
082060 GO TO VERB-RESET.
082080 PRINTON1.
082100* IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
082120 GO TO VERB-RESET.
082140 DISPLAY-DICT.
082160 SET DX TO DX-MAX. SET DX UP BY 1.
082180 DISP-DICT-LOOP.
082200 SET DX DOWN BY 1. IF DX < DX-LOWEST GO TO DISPLAY-DICTX.
082220 DISPLAY '*DICT*DX=' DX ' ' D-TITLE1 (DX) ' ' D-TITLE2 (DX)
082240 ' ' D-TYPEV (DX) ' ' D-FCHAR (DX) ' '
082260 D-NCHAR (DX) UPON CONSOLE.
082280 GO TO DISP-DICT-LOOP.
082300 DISPLAY-DICTX. EXIT.
082320 QUERY1.
082340* HERE FROM VERB-CONTROL DISPATCH WHEN V=1=ALL
082360* STATEMENTS READ
082380* SET UP -GO TO NR- AND STOP
082400 IF FLAG-QUERY = ZERO MOVE 'EMPTY QUERY' TO WORD30
082420 MOVE 9 TO FLAG-PASS GO TO E005.
082440 IF FLAG-PASS = 2 GO TO QUERY2.
082460 SET X UP BY 1. MOVE V-NOP TO INSTR (X).
082480 MOVE ZERO TO FLAG-EOS.
082500 SET X UP BY 1. MOVE V-EOS TO INSTR (X).
082520 SET X UP BY 1. MOVE V-GOTONR TO INSTR (X).
082540 SET X UP BY 1. MOVE V-NOP TO INSTR (X).
082560 SET X UP BY 1. MOVE V-STOP TO INSTR (X).
082580* DISPLAY 'END OF FIRST PASS' UPON CONSOLE.
082600 CLOSE QCSTMT.
082620* IF N-INPUTFILES = 0 THEN HAVE NO OPEN STATEMENT
082640 IF N-INPUTFILES = ZERO
082642 IF FLAG-SORT = 0 MOVE 1 TO FCHAR GO TO QUERY1A
082644 ELSE
082646 MOVE 51 TO ECODE PERFORM E-RROR THRU E-XIT
082648 GO TO QUERY1A.
082660 MOVE ZEROS TO PROJ8,USER8.
082680 MOVE 'QPDICTSEQ' TO FD-INLABEL WORD30.
082700* SEE IF DICTIONARY IS AROUND
082720 ENTER MACRO IQLOOK USING
082740 DEVICER,FD-INLABEL,PROJ8,USER8,I.
082760 IF I NOT EQUAL TO -1 GO TO E009.
082780* COMPLETE DICT SPECS FOR ALL DICT ITEMS IN DICTIONARY
082800* COMPLETE DYN DICT WITH SUCH INFO AS:
082820* FD--PPN,ID,DEVICE,TYPE,BUFFER,ORIGINS,LENGTHS,RL,BL
082840* DD--ALL DICT INFO INCLDG SCALE,NC,FC,REPEATS,ETC.
082860 PERFORM READ-DICT THRU RDICTX.
082880 QUERY1A.
082900 IF REPORT-DX = 1 MOVE 1 TO NUMBN
082920 PERFORM REPORT1A THRU REPORT1X.
082940* NOW INITIALIZE CERTAIN DICT SPECS FOR VARIABLES ETC
082960* FOR ALPHA VAR: ECHAR=SCALE=FCHAR=0
082980* FOR NUM VAR : FCHAR=0; ECHAR=13,NCHAR=18,SCALE=0
083000 PERFORM DX-CLEANUP THRU DUPX.
083020 PERFORM QTANLZ-WRITE THRU QTANLZ-EXIT.
083040 MOVE QTANLZTMP TO QCSTMTTMP.
083060* GET DUMP FILE WHEN DUMP FLAG IS ON
083080 IF FLAG-DUMP = 1 MOVE 'IQDUMPTMP' TO QTANLZTMP
083100 PERFORM QTANLZ-WRITE THRU QTANLZ-EXIT
083120 MOVE QCSTMTTMP TO QTANLZTMP.
083140 MULTIPLY DX BY LI-MAX GIVING DX.
083160 IF DX < X GO TO E012.
083180 MOVE 2 TO FLAG-PASS. MOVE 0 TO FLAG-CREATE.
083200 SET LI TO LI-MAX.
083220 SET X TO ZEROS.
083240* IF FLAG-ERROR NOT EQUAL TO ZEROS GO TO QTANLZ-DAS-ENDE.
083260 MOVE SPACE TO WORD30.
083280 OPEN INPUT QTANLZ.
083300 GO TO VERB-CONTROL.
083320 QUERY2.
083340 SET EOF1-X TO X. SET EOF1-X DOWN BY 1.
083360 CLOSE QTANLZ.
083380 SET HX TO 1.
083400 QUERY2A.
083420* CLEAN OUT OLD JUNK IN INSTR TABLE LEFT OVER FROM WHEN
083440* INSTR TABLE SHRUNK DURING PASS2.
083460 SET X UP BY 1. IF INSTR (X) NOT EQUAL TO ZEROS
083480 MOVE V-NOP TO INSTR (X) SET HX TO 1 GO TO QUERY2A.
083500 IF HX < 6 SET HX UP BY 1 GO TO QUERY2A.
083520 PERFORM DX-CLEANUP THRU DUPX.
083540 PERFORM GOTO3 THRU GOTO3X.
083560 PERFORM QTANLZ-WRITE THRU QTANLZ-EXIT.
083600* FOR FINAL VERSION, ONLY PUT OUT A DUMP FILE
083620* IF DUMP FLAG IS ON IE =1
083640 IF FLAG-DUMP = 1
083642 MOVE 'IQDUMPTMP' TO QTANLZTMP
083660 PERFORM QTANLZ-WRITE THRU QTANLZ-EXIT
083662 MOVE QCSTMTTMP TO QTANLZTMP.
083700 IF FLAG-SAVE = 1 AND QRY-NAME NOT EQUAL TO SPACE
083702 MOVE QRY-NAME TO QTANLZTMP
083720 PERFORM QTANLZ-WRITE THRU QTANLZ-EXIT
083722 MOVE QCSTMTTMP TO QTANLZTMP.
083740 MULTIPLY DX BY LI-MAX GIVING DX.
083760 IF DX < X GO TO E012.
083780 IF FLAG-CREATE-LOOP = 0
083800 MOVE 'NEED OPEN OR GO TO XT/QT' TO WORD30
083820 MOVE 24 TO ECODE
083840 PERFORM E-RROR THRU E-XIT.
083860 GO TO QTANLZ-DAS-ENDE.
083880 READ1.
083900 GO TO VERB-CONTROL.
083920 RESET1.
083940 IF FLAG-PASS = 2 GO TO RESET2.
083960 IF FLAG-ALPHA = ZERO GO TO E003.
083980 IF TYPEV = TYPE-TODAY GO TO E003.
084000 IF TYPEV = TYPE-XRANDOM GO TO E003.
084020 SET INSTR (X) TO DX.
084040 GO TO VERB-CONTROL.
084060 RESET2.
084080 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
084100 IF T-INSTR = ZEROS GO TO VERB-CONTROL.
084120 GO TO RESET2.
084122 REOPEN1.
084124 IF FLAG-PASS = 1 GO TO VERB-CONTROL.
084126* NOW CHANGE INSTR TO BE V-OPEN FOLLOWED BY NOP
084128 SET X DOWN BY 1.
084130 MOVE V-OPEN TO INSTR (X).
084132 SET X UP BY 1.
084134 GO TO VERB-CONTROL.
084140 REPORT1.
084160 IF FLAG-PASS = 2 GO TO VERB-CONTROL.
084180 IF FLAG-ALPHA = 1 GO TO E002.
084200 IF NUMBN < 1 OR NUMBN > 99 GO TO E008.
084220 PERFORM REPORT1A THRU REPORT1X.
084240 SET INSTR (X) TO DX.
084260* SET INSTR (X) TO NUMBN.
084280* IF NUMBN > NUMB-REPORTS MOVE NUMBN TO NUMB-REPORTS.
084300 GO TO VERB-RESET.
084320 REPORT1A.
084340 SET DX-LOWEST DOWN BY 1. SET DX TO DX-LOWEST.
084360 SET REPORT-DX TO DX.
084380 MOVE REPORT-R-AREA TO D-ENTRY (DX).
084400 MOVE NUMBN TO D-NCHAR (DX).
084420 IF NUMBN > NUMB-REPORTS MOVE NUMBN TO NUMB-REPORTS.
084440 REPORT1X. EXIT.
084460 REWRITE1.
084480 IF FLAG-PASS = 2 GO TO rewrite2.
084482 move 1 to va.
084484 if flag-eos = 1 go to rewrite1a.
084486 perform get-word thru get-wordx.
084488 if word06 not = 'RECORD' move 1 to flag-peeked.
084490 if word12 = 'RECORD2' MOVE 4 to va.
084492 if word12 = 'RECORD3' MOVE 7 to va.
084494 rewrite1a.
084496 set x up by 1.
084498 move va to instr (x).
084500 go to verb-control.
084502 rewrite2.
084504 if T-INSTR = 1 set fx to fx-primary else if
084506 T-INSTR = 4 set fx to fx-secondary else if
084508 T-INSTR = 7 set fx to fx-tertiary.
084510 IF F-KEYLEN (FX) = 0
084512 move 018 to ecode
084514 MOVE 'FOR A REWRITE VERB' TO WORD30
084516 perform e-rror thru e-xit
084518 GO TO VERB-RESET.
084520* NOW SAVE FIRST ARG(1,4,OR 7 INDICATING PRIMARY,2ND,TERT), MODIFY IT
084521* TO INCLUDE 6-BIT OR 7-BIT, AND INSERT IT AS THE SECOND ARG.
084522* MAKE THE FIRST ARG BE AN FX POINTER.
084523* ALSO, SET I/O FLAG IN F-ENTRY TO INDICATE OPEN I-O
084524 MOVE 'O' TO F-OPENIO (FX).
084526 SET INSTR (X) TO FX.
084528 SET X UP BY 1.
084530 IF F-TYPEV (FX) = 27 ADD 1 TO T-INSTR.
084532 MOVE T-INSTR TO INSTR (X).
084534 GO TO VERB-RESET.
084540 RMARGIN1.
084560 IF FLAG-PASS = 2 GO TO VERB-CONTROL.
084580 IF FLAG-ALPHA = 1 GO TO E002.
084600 IF NUMBN < 1 GO TO E008.
084620 SET INSTR (X) TO NUMBN.
084640 GO TO VERB-RESET.
084660 RPTDATE1.
084680 IF FLAG-PASS = 2 GO TO VERB-CONTROL.
084700 SET INSTR (X) TO DX.
084720 GO TO VERB-RESET.
084740 RPTDATEON1.
084760* IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
084780 GO TO VERB-RESET.
084800 RPTDATEOFF1.
084820* IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
084840 GO TO VERB-RESET.
084860 RPTHEAD1.
084880 IF FLAG-PASS = 2 GO TO RPTHEAD2.
084900 GO TO PRINT1.
084920 RPTHEAD2.
084922 if t-instr = 0
084924 move 'heading syntax error:' to word30
084925 MOVE 15 TO ECODE
084926 perform e-rror thru e-xit
084928 go to verb-control.
084940 SET HX TO X.
084960 SET X UP BY 1. SET INSTR (X) TO T-INSTR.
084980 RPTHEAD2A.
085000 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
085020 IF T-INSTR NOT EQUAL TO ZEROS GO TO RPTHEAD2A.
085040 SET PX TO X. SET X TO HX.
085060 SET PX UP BY 1. SET INSTR (X) TO PX.
085080 SET PX DOWN BY 1. SET X TO PX.
085100 GO TO VERB-CONTROL.
085120 RPTHEADON1.
085140* IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
085160 GO TO VERB-RESET.
085180 RPTHEADOFF1.
085200* IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
085220 GO TO VERB-RESET.
085240 SET1.
085260 IF FLAG-PASS = 2 GO TO SET2.
085280 IF FLAG-VERB = 2 GO TO SET1A.
085300 MOVE 2 TO FLAG-VERB.
085320 IF FLAG-ALPHA = ZERO GO TO E003.
085340* TYPEV: SET BY DROP-IN-DX AND IS TYPE OF OBJECT
085360* CLEARED BY GET-VERB
085380* NOW CHECK TO SEE IF TRYING TO ILLEGALLY SET VALUE OF
085400* LITERAL-TODAY-XRANDOM--THEN SAVE SAVE LEFT SIDE
085420* OF 'TO' TO BE SET LATER
085440 IF TYPEV = TYPE-LITERAL GO TO E007.
085500 SET T-INSTR TO DX.
085520 SET X DOWN BY 1.
085540 GO TO VERB-CONTROL.
085560 SET1A.
085580* HERE FOR SETTING LEFT AND RIGHT SIDE OF 'TO'
085600 IF VA NOT EQUAL TO V-TO GO TO E004.
085620 SET INSTR (X) TO DX.
085640* T-INSTR CONTAINS LEFT OF 'TO'
085660 SET X UP BY 1. SET INSTR (X) TO T-INSTR.
085680 MOVE ZEROS TO VA.
085700* FLAG-VERB=1 ALLOWS MULTIPLE LIST FOR SET AND CAUSES
085720* US TO DO SET1 STUFF NEXT TIME WE HIT SET
085740 MOVE 1 TO FLAG-VERB.
085760 GO TO VERB-CONTROL.
085780 SET2.
085800* HERE DURING 2ND PASS-V-SET HAS BEEN READ INTO INSTR(X)
085820* AS HAS ITS FIRST ARG, THE RIGHT SIDE OF 'TO' (SOURCE)
085840* WHICH HAS ALSO BEEN STORED INTO T-INSTR
085860* X POINTS TO 1ST ARG ENTRY OF INSTR TABLE
085880 SET VX TO T-INSTR.
085890 IF T-INSTR = 0 GO TO SET2D.
085900 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
085920 IF T-INSTR = ZEROS GO TO SET2D.
085940 SET DX TO T-INSTR.
085960 MOVE D-TYPEV (DX) TO TYPEV.
085980 IF TYPEV = TYPE-NUMERIC-VARIABLE GO TO SET2A.
086000 IF TYPEV = TYPE-VARIABLE GO TO SET2A.
086020 GO TO SET2C.
086040 SET2A.
086060* GET HERE WHEN LEFT SIDE IS A VAR OR NUM VAR
086080* COMPARE LENGTHS OF LEFT SIDE(DX) WITH RIGHT SIDE(VX)
086100* NUM VAR (TYPE 7) WOULD HAVE BEEN INITIALIZED TO 18
086120* ALP VAR (TYPE12) WOULD HAVE BEEN INITIALIZED TO 0
086140 IF D-NCHAR (DX) > V-NCHAR (VX) GO TO SET2C.
086160* IF THE NCHAR OF THE VARIABLE ON THE LEFT HAS BEEN SET
086180* BY A PREVIOUS SET STATEMENT AND NOW MUST BE RESET TO
086200* A LARGER NCHAR, THEN THE FCHAR WILL ALSO BE RESET TO
086220* BE A NEW ALLOCATION, OTHERWISE WE MIGHT OVERLAP SOME
086240* INTERMEDIATE ALLOCATIONS.
086260 MOVE V-NCHAR (VX) TO NCHAR.
086280 MOVE NCHAR TO D-NCHAR (DX).
086300 MOVE NCHAR TO D-ECHAR (DX).
086320 IF V-TYPEV (VX) = TYPE-LITERAL GO TO SET2B.
086340* MOVE V-TYPEV (VX) TO D-TYPEV (DX).
086360 MOVE V-SCALE (VX) TO D-SCALE (DX).
086380 MOVE V-PICT (VX) TO D-PICT (DX).
086400 MOVE V-ECHAR (VX) TO D-ECHAR (DX).
086420 SET2B.
086440 MOVE FCHAR TO D-FCHAR (DX). ADD NCHAR TO FCHAR.
086460 SET2C.
086480* FOR VARIABLES, FCHAR = 0 IF THEY HAVENT BEEN SET YET
086500* SET FCHAR NOW
086520 IF D-FCHAR (DX) = ZEROS
086540 MOVE D-NCHAR (DX) TO NCHAR GO TO SET2B.
086560 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
086580 IF T-INSTR = ZEROS GO TO VERB-CONTROL.
086600 GO TO SET2.
086602 SET2D.
086604 MOVE 'SET VERB' TO WORD30. MOVE 043 TO ECODE.
086606 PERFORM E-RROR THRU E-XIT.
086608 GO TO VERB-CONTROL.
086620 SORT1.
086640 IF FLAG-PASS = 2 GO TO SORT2.
086660 IF FLAG-ALPHA = ZERO GO TO E003.
086680 IF FLAG-VERB = 2 GO TO SORT1A.
086700 MOVE 2 TO FLAG-VERB.
086720* ALLOW CREATE TO BE USED AGAIN FOR THIS NEW STAGE
086740 MOVE 0 TO FLAG-CREATE.
086760 MOVE ZEROS TO T-INSTR.
086780 IF DX = FX-PRIMARY MOVE 1 TO T-INSTR.
086800 IF DX = FX-SECONDARY MOVE 2 TO T-INSTR.
086820 IF DX = FX-TERTIARY MOVE 3 TO T-INSTR.
086840 SET INSTR (X) TO T-INSTR.
086860 IF VA NOT EQUAL TO V-DESCENDING
086880 MOVE V-ASCENDING TO VA.
086900 MOVE 1 TO FLAG-SORT.
086920 IF T-INSTR NOT EQUAL TO ZEROS GO TO VERB-CONTROL.
086940 SET INSTR (X) TO 1. SET X UP BY 1.
086960 SORT1A.
086980 MULTIPLY DX BY VA GIVING T-INSTR.
087000 SET INSTR (X) TO T-INSTR.
087020 GO TO VERB-CONTROL.
087040 SORT2.
087042 IF T-INSTR = V-NOP GO TO SORT2C.
087060 MOVE ZEROS TO NCHAR FLAG-CREATE N-SKEYS.
087080 SORT2A.
087100 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
087120* ARE WE AT END OF SORT KEY LIST?
087140 IF T-INSTR NOT = ZEROS GO TO SORT2AA.
087142 IF N-SKEYS = 0 GO TO SORT2C.
087144 GO TO SORT2B.
087146 SORT2AA.
087148 ADD 1 TO N-SKEYS.
087150 IF T-INSTR = V-EOS GO TO SORT2C.
087160* MOVE NCHAR TO F-RECLEN (FX) GO TO SORT2B.
087180 SET DX TO T-INSTR.
087200 IF DX < 1 MULTIPLY DX BY V-DESCENDING GIVING DX.
087220 ADD D-NCHAR (DX) TO NCHAR.
087240 GO TO SORT2A.
087260 SORT2B.
087262 SET X UP BY 1.
087264* SAVE X FOR THE IMPLICIT GO TO NR *
087266* SO THAT IF WE GET A GO TO NN *
087268* FOLLOWING IT, WE CAN NOP THE GO TO NR *
087270 SET SORT-GOTO-X TO X.
087272 MOVE V-GOTONR TO INSTR (X).
087300 PERFORM POPALL-FALSE THRU POPALLFX.
087302 SET X UP BY 1. MOVE V-NOP TO INSTR(X).
087304 SET X UP BY 1. MOVE V-NOP TO INSTR(X).
087320 SET X UP BY 1. MOVE V-STOP TO INSTR (X).
087340 SET X UP BY 1. MOVE V-READ TO INSTR (X).
087360 SET X UP BY 1. MOVE FX-PRIMARY TO INSTR (X).
087380 SET X UP BY 1. MOVE V-ASCENDING TO INSTR (X).
087400 SET X UP BY 1. MOVE V-NOP TO INSTR (X).
087420 GO TO VERB-RESET.
087422 SORT2C.
087424* HERE WHEN SORT STATEMENT HAS NO DESIGNATED SORT KEYS
087426 MOVE 'SORT STATEMENT HAS' TO WORD30.
087428 GO TO E046.
087440 STATEMENT1.
087460 IF FLAG-PASS = 2 GO TO STATEMENT2.
087480 SET V TO V-GOTO.
087500 PERFORM DROP-IN-DX THRU DIDX.
087520 MOVE TYPE-GOTO TO D-TYPEV (DX).
087540 MOVE NUMBN TO D-NCHAR (DX).
087560* SCALE CONTAINS LOCATION OF STATEMENT NUMBER IN INSTR TABLE
087580 SET D-SCALE (DX) TO X.
087600 SET X UP BY 1. SET INSTR (X) TO DX.
087620 GO TO VERB-RESET.
087640 STATEMENT2.
087660 SET DX TO T-INSTR.
087680 SET X DOWN BY 1.
087700 MOVE X TO D-SCALE (DX).
087720 SET X DOWN BY 1.
087740 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
087760* IF T-INSTR NOT EQUAL TO ZEROS GO TO E000.
087780 SET X DOWN BY 1.
087800 GO TO VERB-CONTROL.
087820 SUMMARYOFF1.
087840* IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
087860 GO TO VERB-RESET.
087880 SUMMARYON1.
087900* IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
087920 GO TO VERB-RESET.
087940 ASSIGN-PRIOR-ORIGIN.
087960* MODIFY ORIGIN OF PRIOR SUMMARY BUCKET+RESTORE TYPE
087980 SET DX TO T-INSTR.
088000 MOVE FCHAR TO D-FCHAR (DX).
088020 ADD D-NCHAR (DX) TO FCHAR.
088040 SUBTRACT 50 FROM D-TYPEV (DX).
088060 ASSIGN-PRIORX. EXIT.
088080 ALLOCATE-ACCUM-BUCKETS.
088100 IF FLAG-VERB = 2 MOVE 1 TO SUMBREAK-FLAG
088120 SUBTRACT 1 FROM DX-LOWEST SET DX TO DX-LOWEST
088140 SET KX TO DX MOVE WORD30 TO K-ENDKEY (KX)
088160 MOVE TYPE-PRIOR-SUMMARY TO D-TYPEV (DX)
088180 MOVE 2 TO D-NREPEATS (DX)
088200 SET X UP BY 1 SET INSTR (X) TO DX
088220 ELSE
088240 MOVE 0 TO PREV-BUCKETDX MOVE 0 TO CURR-BUCKETDX
088260 MOVE 0 TO FLAG-BY.
088280 IF FLAG-IFFIRST = 1 GO TO ALLOC-ACCX.
088300 MOVE 2 TO FLAG-VERB.
088320 SUBTRACT 1 FROM DX-LOWEST. SET DX TO DX-LOWEST.
088340 SET X UP BY 1. SET INSTR (X) TO DX.
088360 ALLOC-ACCX. EXIT.
088380 TALLY1.
088400 IF FLAG-PASS = 2
088420 MOVE '*WARNING-TALLY STATEMENT' TO WORD30 GO TO TALLY2.
088440 IF FLAG-ALPHA = ZERO GO TO E003.
088442* CATCH CASE OF 'TALLY BY ITEM' NOW.
088443* CASE OF 'TALLY.' CAUGHT IN 2ND PASS.
088444 IF (FLAG-VERB = 1 AND FLAG-BY = 1)
088445 MOVE 'FOR SUMMARY VERB' TO WORD30
088446 MOVE 046 TO ECODE PERFORM E-RROR THRU E-XIT.
088460 IF VA = V-LPAREN IF FLAG-SUMMARY-DEF-TIME = 0
088480 SET X UP BY 1 MOVE VA TO INSTR (X)
088500 GO TO VERB-CONTROL.
088520 IF VA = V-LPAREN IF FLAG-SUMMARY-DEF-TIME = 1
088540 MOVE 0 TO FLAG-SUMMARY-DEF-TIME
088560 GO TO VERB-CONTROL.
088580 IF VA = V-RPAREN
088600 SET X UP BY 1 MOVE VA TO INSTR (X)
088620 MOVE 0 TO VA GO TO VERB-CONTROL.
088640 PERFORM ALLOCATE-ACCUM-BUCKETS THRU ALLOC-ACCX.
088660* SAVE BUCKET POINTERS FOR POSSIBLE SUMMARY ITEM DEF USE
088680 IF CURR-BUCKETDX NOT = 0
088700 MOVE CURR-BUCKETDX TO PREV-BUCKETDX.
088720 MOVE INSTR (X) TO CURR-BUCKETDX.
088740 IF V = V-AVERAGE
088760 MOVE TYPE-AVERAGE TO D-TYPEV (DX)
088780 ELSE
088800 MOVE TYPE-SUMMARY TO D-TYPEV (DX).
088820 MOVE 2 TO D-NREPEATS (DX).
088840 GO TO VERB-CONTROL.
088860 TALLY2.
088862******FORMAT OF SUMMARY AND MAX-MIN VERBS:
088864* (X) = INSTR VALUE = 47,48,49,80,81
088866* (X+1) = DX OF SUMMARIZED ITEM
088868* (X+2) = START OF SUB-GROUP TRIPLETS AS FOLLOWS:
088870* VX OF SUMMARY BUCKET
088872* (X+3) = DX OF BREAK ITEM
088874* (X+4) = HX OF PRIOR VALUE
088880 IF T-INSTR = 0
088882 move word30-fatal-part to word30 go to e046.
088900* ABOVE IS ERROR IF NO DATA NAME FOLLOWING TALLY
088920 SUBTRACT T-INSTR FROM 0 GIVING INSTR (X).
088940 SET DX TO T-INSTR.
088941 IF V = V-TALLY GO TO TALLY2AA.
088942 perform check-numeric thru check-numericx.
088944 if ecode not = 0
088946 MOVE 055 TO ECODE PERFORM E-RROR THRU E-XIT.
088948 TALLY2AA.
088960 SET DX-SAVE TO DX.
088980 SET XX TO X. ADD 2 TO XX.
089000 TALLY2A.
089020 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
089040 IF T-INSTR = ZEROS GO TO TALLY2C.
089060 IF T-INSTR = V-LPAREN GO TO TALLY2B.
089080 SET VX TO T-INSTR.
089100 SET KX TO VX.
089120 MOVE K-ENDKEY (KX) TO SAVE30.
089140 MOVE D-ENTRY (DX) TO V-ENTRY (VX).
089160 MOVE SAVE30 TO K-ENDKEY (KX).
089180 MOVE TYPE-SUMMARY TO V-TYPEV (VX).
089200 MOVE ZEROS TO V-BINARY (VX).
089220 IF V = V-TALLY GO TO TALLY2A1.
089240 MOVE D-PICT (DX) TO V-PICT (VX).
089260 IF D-TYPEV (DX) = TYPE-NUMERIC-VARIABLE
089280 MOVE 'SZ,ZZZ,ZZZ.99RRR' TO V-PICT (VX).
089300 IF V = V-MINIMUM OR V = V-MAXIMUM GO TO TALLY2A2.
089320 IF V = V-AVERAGE MOVE TYPE-AVERAGE TO V-TYPEV (VX).
089340 MOVE V-PICT (VX) TO TITLE-TABLE.
089360 PERFORM TOTAL-SHIFT THRU TOTAL-SHIFTX.
089380 MOVE PPN-WORK TO V-PICT (VX).
089400 GO TO TALLY2A2.
089420 TALLY2A1.
089440 MOVE ZEROS TO V-SCALE (VX).
089460 MOVE 8 TO V-NCHAR (VX).
089480 MOVE 8 TO V-ECHAR (VX).
089500 MOVE 8 TO V-TCHAR (VX).
089520 MOVE 'ZZZZZZZ9' TO V-PICT (VX).
089540 TALLY2A2.
089560 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
089580 IF T-INSTR = ZEROS GO TO TALLY2C.
089600 IF T-INSTR = V-LPAREN GO TO TALLY2B.
089620 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
089640 IF T-INSTR = ZEROS GO TO TALLY2C.
089660 IF T-INSTR = V-LPAREN GO TO TALLY2B.
089680* HERE FOR TYPE-PRIOR-SUMMARY--MODIFY ITS ORIGIN
089700 PERFORM ASSIGN-PRIOR-ORIGIN THRU ASSIGN-PRIORX.
089720 SET DX TO DX-SAVE.
089740 GO TO TALLY2A.
089760 TALLY2B.
089780* DELETE V-LPAREN,VX,V-RPAREN SEQUENCE FROM INSTR TABLE
089800 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
089820 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
089840 IF T-INSTR NOT = V-RPAREN
089860 MOVE "MISSING RIGHT PARENTHESIS" TO WORD30 GO TO E033.
089880 SET X DOWN BY 3.
089900 GO TO TALLY2A.
089920 TALLY2C.
089940* GET RID OF EXTRANEOUS TRAILING BUCKET IF SUB-GRP
089960 IF XX = X GO TO VERB-CONTROL.
089980 SET X DOWN BY 1.
090000 MOVE V-NOP TO INSTR (X).
090020 GO TO VERB-CONTROL.
090040 TITLES1.
090060 IF FLAG-PASS = 2 GO TO TITLES2.
090080 IF FLAG-VERB = 2 GO TO TITLES1A.
090100 IF FLAG-VERB = 3 SET X DOWN BY 1
090120 PERFORM DROP-IN-VERB THRU DIVX SET X UP BY 1.
090140 MOVE 2 TO FLAG-VERB.
090160 IF FLAG-ALPHA = ZERO GO TO E003.
090180 SET INSTR (X) TO DX.
090200 GO TO VERB-CONTROL.
090220 TITLES1A.
090240 MOVE 1 TO FLAG-VERB.
090260 IF VA NOT EQUAL TO V-EQUAL GO TO E004.
090280 IF TYPEV NOT EQUAL TO TYPE-LITERAL
090300 GO TO E015.
090320 IF Q > 22 GO TO E016.
090330 MOVE SPACES TO L-ENTRY (LX).
090340 SET DX-LOWEST UP BY 1.
090360 SET INSTR (X) TO QUOTEN (1).
090380 SET X UP BY 1. SET INSTR (X) TO QUOTEN (2).
090400 SET X UP BY 1. SET INSTR (X) TO QUOTEN (3).
090420 SET X UP BY 1. SET INSTR (X) TO QUOTEN (4).
090440 MOVE 3 TO FLAG-VERB.
090460 GO TO VERB-CONTROL.
090480 TITLES2.
090500 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
090520 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
090540 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
090560 PERFORM GET-ONE-INSTR THRU GET-INSTRX.
090580 GO TO VERB-CONTROL.
090600 TOTAL1.
090620 IF FLAG-PASS = 2
090640 MOVE '*WARNING-TOTAL STATEMENT' TO WORD30
090660 GO TO TALLY2.
090680 GO TO TALLY1.
090700 TOTAL-SHIFT.
090720 MOVE V-ECHAR (VX) TO ECHAR.
090740 MOVE ZEROS TO NCHAR.
090760 IF ECHAR < 19 MOVE 1 TO NCHAR.
090780 IF ECHAR < 18 MOVE 2 TO NCHAR.
090800 IF ECHAR < 17 MOVE 3 TO NCHAR.
090820 SUBTRACT V-NCHAR (VX) FROM 18 GIVING DELTA.
090840* DELTA IS THE NUMBER OF DIGITS LESS THAN 18
090860* NCHAR IS THE NUMBER OF DIGITS WE WISH TO EXPAND
090880* CAN NOT EXCEED DELTA IE GO PAST 18 TOTAL DIGITS
090900 IF DELTA < NCHAR MOVE DELTA TO NCHAR.
090920 ADD NCHAR TO V-NCHAR (VX).
090940 ADD NCHAR TO V-ECHAR (VX).
090960 IF V-ECHAR (VX) > V-TCHAR (VX)
090980 MOVE V-ECHAR (VX) TO V-TCHAR (VX).
091000 SET T TO 1. SET PX TO 1.
091020 MOVE SPACES TO PPN-TABLE.
091040 TOTAL-SHIFT1.
091060* COPY THE LEADING EDIT CHAR(EXCEPT FOR $) NCHAR TIMES
091080 MOVE TITLEX (T) TO PPN-CHAR (PX).
091100 SET PX UP BY 1. IF PX > 19 GO TO TOTAL-SHIFTX.
091120 IF TITLEX (T) = 'S' GO TO TOTAL-SHIFT2.
091140 IF NCHAR > ZEROS
091160 SUBTRACT 1 FROM NCHAR GO TO TOTAL-SHIFT1.
091180 TOTAL-SHIFT2.
091200 SET T UP BY 1. IF T > 19 GO TO TOTAL-SHIFTX.
091220 GO TO TOTAL-SHIFT1.
091240 TOTAL-SHIFTX. EXIT.
091260 TITLESOFF1.
091280* IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
091300 GO TO VERB-RESET.
091320 TITLESON1.
091340* IF FLAG-PASS = 2 AND T-INSTR = ZEROS SET X DOWN BY 1.
091360 GO TO VERB-RESET.
091380 VSPACE1.
091400 IF FLAG-PASS = 2 GO TO VERB-CONTROL.
091420 IF FLAG-ALPHA = 1 GO TO E002.
091440 IF NUMBN < 1 GO TO E008.
091460 SET INSTR (X) TO NUMBN.
091480 GO TO VERB-RESET.
091500 VERB-RESET.
091520 MOVE ZEROS TO ECODE.
091540 MOVE ZEROS TO V VA VP.
091560 GO TO VERB-CONTROL.
091580 QTANLZ-WRITE.
091600 OPEN OUTPUT QTANLZ.
091620 SET DX TO 1.
091640 QTANLZ-X.
091660 MOVE D-ENTRY (DX) TO QTANLZ-REC.
091680 WRITE QTANLZ-REC.
091700* WRITE FROM BEGINNING OF INSTR TABLE TILL FIND END OF
091720* INSTRUCTIONS INDICATED BY ALL ZEROES--AFTER FIRST ALL
091740* ZERO RECORD IS WRITTEN AS A MARKER FOR IQE, START
091760* WRITING OUT FROM BOTTOM IE DICTIONARY PORTION AND
091780* THEN COMING BACK TO MIDDLE(DX-LOWEST). IQE WILL THEN
091800* PUT BACK IN CORRECT ORDER AS IT READS THE TABLE.
091820 IF D-TYPEV (DX) = ZEROS AND D-NCHAR (DX) = ZEROS
091840 AND D-SCALE (DX) = ZEROS AND D-ECHAR (DX) = ZEROS
091860 AND D-TCHAR (DX) = ZEROS AND D-FCHAR (DX) = ZEROS
091880 AND D-NREPEATS (DX) = ZEROS
091900 SET DX TO DX-MAX GO TO QTANLZ-DX.
091920 SET DX UP BY 1. IF DX > DX-MAX GO TO QTANLZ-CLOSE.
091940 GO TO QTANLZ-X.
091960 QTANLZ-DX.
091980 IF FLAG-PASS = 1 GO TO QTANLZ-CLOSE.
092000 MOVE D-ENTRY (DX) TO QTANLZ-REC.
092020 WRITE QTANLZ-REC.
092040 SET DX DOWN BY 1. IF DX < DX-LOWEST GO TO QTANLZ-CLOSE.
092060 GO TO QTANLZ-DX.
092080 QTANLZ-CLOSE.
092100 CLOSE QTANLZ.
092120 QTANLZ-EXIT. EXIT.
092140 QTANLZ-DAS-ENDE.
092180 IF FLAG-EXECUTE NOT = 1
092182 MOVE 'IQL ' TO CALLED-NAME.
092200 IF FLAG-ERROR = 1
092220 OPEN OUTPUT QTANLZ CLOSE QTANLZ WITH DELETE
092240 MOVE 'IQL ' TO CALLED-NAME.
092260 ENTER MACRO IQNEXT USING CALLED-NAME.
092280 STOP RUN.
092300
092320*********************************************************
092340* SUBROUTINE 'CONFIDENTIAL-ASK' TO ASK FOR A PASSWORD AND
092360* DELIVER IT IN WORKING STORAGE ITEM 'RETURNED-PASSWORD'.
092380*********************************************************
092400 CONFIDENTIAL-ASK.
092420 DISPLAY '*PASSWORD: ' UPON CONSOLE.
092440 MOVE ASCII-CR TO MASK7.
092460 MOVE '######' TO MASK1-6.
092480 DISPLAY MASK1-7 UPON CONSOLE WITH NO ADVANCING.
092500 MOVE 'HHHHHH' TO MASK1-6.
092520 DISPLAY MASK1-7 UPON CONSOLE WITH NO ADVANCING.
092540 MOVE 'IIIIII' TO MASK1-6.
092560 DISPLAY MASK1-7 UPON CONSOLE WITH NO ADVANCING.
092580 MOVE ASCII-CR TO MASK1.
092600 DISPLAY MASK1 UPON CONSOLE WITH NO ADVANCING.
092620 ACCEPT RETURNED-PASSWORD FROM TTY.