13 PROC ;INSTANT DIBOL - PARSE 23 ;************************************************** 33 ; SOURCE PRINT3 43 ;************************************************** 53 63 SQUOTE='&' ;CREATE A 73 INCR SQUOTX ; SINGLE QUOTE 83 WORKA= 93 TOPFLG=10 103 IF (SWITCH(1,1).NE.'L') GOTO INITL1 113 LPTSW='X' 123 INITL1, SHDAY=TODAY(3,4) 133 SHMON=MONTAB(TODAY(1,2)) 143 SHYEAR=TODAY(5,6) 153 CALL OPNSYS 163 CALL PARSE ;PARSE THE INPUT 173 IF (LPTLIN.NE.SPACE) CALL LISTIN 183 IF (LPTOPN.EQ.SPACE) GOTO INITL2 193 FORMS (2,0) 203 FINI (2) 213 INITL2, IF (FATALC.NE.0) STOP 223 CHAIN (1) 233 ; 243 ; MAIN PARSEING ROUTINE 253 ; 263 PARSE, CALL GETDIR 273 IF (WORD.EQ.'IDENT ') GOTO PARSE1 283 ERRCOD=19 293 CALL FATALA 303 IF (LPTSW.EQ.SPACE) RETURN 313 PARSE0, CALL GETLIN 323 IF (INLSIZ.NE.3) GOTO PARSE0 333 IF (INLINE.NE.'END') GOTO PARSE0 343 RETURN 353 363 PARSE1, CALL IDENT ;PARSE IDENT DIRECTIVE 373 PARSE2, CALL GETDIR 383 IF (FATALI.NE.0) GOTO PARSE2 393 IF (WORD.EQ.'HEAD1 ') GOTO PARSE3 403 IF (WORD.EQ.'HEAD2 ') GOTO PARSE4 413 IF (WORD.EQ.'INPUT ') GOTO PARSE5 423 ERRCOD=21 433 ERRCOL=1 443 CALL FATAL 453 IF (WORD.EQ.'COMPUT') GOTO PARSE6 463 IF (WORD.EQ.'PRINT ') GOTO PARSE8 473 IF (WORD.EQ.'END ') GOTO PARS8A 483 ERRCOD=20 493 CALL FATALA 503 GOTO PARSE2 513 523 PARSE3, CALL HEAD1 533 GOTO PARSE2 543 PARSE4, CALL HEAD2 553 GOTO PARSE2 563 573 PARSE5, CALL INPUT ;PARSE INPUT DIRECTIVE 583 IF (NAMEI.NE.0) GOTO PARSE6 593 ERRCOD=24 603 ERRCOL=1 613 CALL FATAL 623 PARSE6, IF (WORD.EQ.'COMPUT') CALL COMPUT 633 IF (WORD.EQ.'PRINT ') GOTO PARSE8 643 ERRCOD=22 653 ERRCOL=1 663 GOTO FATAL 673 683 PARSE8, CALL PRINT ;PARSE PRINT DIRECTIVE 693 PARS8A, IF (LISTI.NE.0) GOTO PARSE9 703 ERRCOD=25 713 ERRCOL=1 723 CALL FATAL 733 PARSE9, IF (PWIDTH.LE.LINMAX) RETURN 743 ERRCOD=26 753 ERRCOL=1 763 GOTO FATAL 773 ; 783 ; PROCESS 'IDENT' LINE 793 ; 803 IDENT, IF (ICHAR.NE.SPACE) CALL SYNTAX 813 CALL WDINT 823 PROGID=WORD 833 IF (ICHAR.EQ.',') GOTO IDENT7 843 IF (ICHAR.EQ.'/') GOTO IDENT3 853 IF (EOL.EQ.SPACE) GOTO SYNTAX 863 GOTO IDNT11 873 883 IDENT3, CALL GETINT 893 IF (NUMLIT(1,ATOMSZ).GT.15) GOTO IDENT4 903 IF (NUMLIT(1,ATOMSZ).GE.1) GOTO IDENT5 913 IDENT4, ERRCOD=8 923 CALL FATALA 933 PROGU= 943 GOTO IDENT6 953 IDENT5, PROGU=NUMLIT(1,ATOMSZ) 963 IDENT6, IF (ICHAR.EQ.',') GOTO IDENT7 973 IF (EOL.EQ.SPACE) CALL SYNTAX 983 GOTO IDNT11 993 1003 IDENT7, CALL SCANF 1013 IF (EOL.NE.SPACE) GOTOIDNT11 1023 ACOL1=ICOL 1033 IDENT8, IF (EOL.NE.SPACE) GOTO IDENT9 1043 CALL GETCH 1053 GOTO IDENT8 1063 IDENT9, ACOL2=ICOL-ACOL1 1073 IF (ACOL2.LE.24) GOTO IDNT10 1083 ACOL2=24 1093 IDNT10, AUTHOR=INLINE(ACOL1,ACOL1+ACOL2-1) 1103 IDNT11, RETURN 1113 ; 1123 ; PROCESS 'HEAD1' LINE 1133 ; 1143 HEAD1, IF (ICHAR.NE.SPACE) CALL SYNTAX 1153 CALL GATOM 1163 ERRCOD=8 1173 IF (ATMTYP.NE.4) GOTO FATALA 1183 IF (ATOMSZ+HEAD1S.LE.LINMAX) GOTO HEAD1E 1193 ATOMSZ=LINMAX-HEAD1S 1203 ERRCOD=9 1213 CALL FATALA 1223 HEAD1E, IF (ATOMSZ.LE.0) RETURN 1233 HEAD1T(HEAD1S+1,HEAD1S+ATOMSZ)=INLINE(ACOL1,ACOL1+ATOMSZ-1) 1243 HEAD1S=HEAD1S+ATOMSZ 1253 RETURN 1263 ; 1273 ;PROCESS 'HEAD2' LINE 1283 ; 1293 HEAD2, IF (ICHAR.NE.SPACE) CALL SYNTAX 1303 CALL GATOM 1313 ERRCOD=8 1323 IF (ATMTYP.NE.4) GOTO FATALA 1333 IF (ATOMSZ+HEAD2S.LE.LINMAX) GOTO HEAD2E 1343 ATOMSZ=LINMAX-HEAD2S 1353 ERRCOD=9 1363 CALL FATALA 1373 HEAD2E, IF (ATOMSZ.LE.0) RETURN 1383 HEAD2T(HEAD2S+1,HEAD2S+ATOMSZ)=INLINE(ACOL1,ACOL1+ATOMSZ-1) 1393 HEAD2S=HEAD2S+ATOMSZ 1403 RETURN 1413 ; 1423 ;PROCESS 'INPUT' LINE 1433 ; 1443 INPUT, FILNAM= 1453 FILUNT= 1463 SUMARY= 1473 IF (EOL.NE.SPACE) GOTO INPUT9 1483 IF (ICHAR.EQ.',') GOTO INPUT2 1493 IF (ICHAR.NE.SPACE) GOTO INPUT6 1503 CALL WDINT 1513 FILNAM=WORD 1523 IF (EOL.NE.SPACE) GOTO INPUT9 1533 IF (ICHAR.EQ.',') GOTO INPUT5 1543 IF (ICHAR.NE.'/') GOTO INPUT6 1553 INPUT2, CALL GETINT 1563 IF (ATOMSZ.GT.2) GOTO INPUT3 1573 IF (ATOMSZ.LT.1) GOTO INPUT3 1583 FILUNT=NUMLIT(1,ATOMSZ) 1593 IF (FILUNT.LE.15) GOTO INPUT4 1603 INPUT3, ERRCOD=12 1613 CALL FATALA 1623 FILUNT= 1633 INPUT4, IF (EOL.NE.SPACE) GOTO INPUT9 1643 IF (ICHAR.NE.',') GOTO INPUT6 1653 INPUT5, CALL GATOM 1663 IF (ATMTYP.NE.1) GOTO INPUT7 1673 IF (ATOMSZ.NE.1) GOTO INPUT7 1683 IF (WORD(1,1).NE.'S') GOTO INPUT7 1693 SUMARY='S' 1703 IF (EOL.NE.SPACE) GOTO INPUT9 1713 INPUT6, CALL SYNTAX 1723 GOTO INPUT9 1733 INPUT7, ERRCOD=13 1743 CALL FATALB 1753 ; 1763 ;PROCESS THE DATA ITEMS IN INPUT SECTION 1773 ; 1783 INPUT9, CALL GETLIN 1793 CALL SCANF 1803 IF (ICHAR.EQ.',') GOTO INPT10 1813 ICOL=ICOL-1 1823 CALL GATOM 1833 IF (ATMTYP.NE.1) GOTO INPT16 1843 IF (ICHAR.NE.',') GOTO INPT25 1853 CALL SEARCH 1863 IF (FINDSW.EQ.SPACE) GOTO INPT9A 1873 ERRCOD=31 1883 CALL FATALA 1893 INPT9A, DATANE= 1903 DATANM=WORD 1913 INPT10, CALL SCANF 1923 DATAM=ICHAR 1933 IF (ICHAR.EQ.'A') GOTO INPT11 1943 IF (ICHAR.NE.'D') GOTO INPT16 1953 INPT11, CALL GATOM 1963 IF (ATMTYP.NE.3) GOTO INPT16 1973 I=ATOMSZ-ATOMDP 1983 IF (I.LE.0) GOTO INPT16 1993 DATAS=NUMLIT(1,I) 2003 IF (ATOMDP.LE.0) GOTO INPT12 2013 DATADP=NUMLIT(I+1,ATOMSZ) 2023 INPT12, IF (DATAS.LE.0) GOTO INPT17 2033 IF (DATADP.GT.DATAS) GOTO INPT17 2043 IF (DATAM .EQ. 'A') GOTO INP12A 2053 IF (DATAS.GT.015) GOTO INPT17 2063 GOTO INPT13 2073 INP12A, IF (DATAS .GT. 510) GOTO INPT17 2083 IF (DPCOL.NE.0) GOTO INPT17 2093 INPT13, IF (EOL.NE.SPACE) GOTO INPT20 2103 IF (ICHAR.NE.',') GOTO INPT16 2113 CALL SCANF 2123 IF (ICHAR.NE.'L') GOTO INPT16 2133 CALL GETCH 2143 IF (ICHAR.LT.'1') GOTO INPT16 2153 IF (ICHAR.GT.'9') GOTO INPT16 2163 DATALV=ICHAR 2173 LEVELS(DATALV)=ICHAR 2183 CALL SCANF 2193 IF (ICHAR.NE.'P') GOTO INPT15 2203 IF (TOPFLG.LE.DATALV) GOTO INPT14 2213 TOPFLG=DATALV 2223 INPT14, CALL SCANF 2233 INPT15, IF (EOL.NE.SPACE) GOTO INPT20 2243 INPT16, CALL SYNTAX 2253 GOTO INPUT9 2263 INPT17, ERRCOD=18 2273 CALL FATALA 2283 GOTO INPUT9 2293 INPT20, IF (NAMEI.GE.DATMAX) GOTO INPT21 2303 INCR NAMEI 2313 DATANT(NAMEI)=DATANE 2323 GOTO INPUT9 2333 INPT21, IF (NAMEI.NE.DATMAX) GOTO INPUT9 2343 ERRCOL=1 2353 ERRCOD=17 2363 CALL FATAL 2373 GOTO INPUT9 2383 ; 2393 ; POSSIBLE END 2403 ; 2413 INPT25, IF (ICHAR.NE.SPACE) GOTO INPT16 2423 IF (WORD.EQ.'PRINT ') RETURN 2433 IF (WORD.EQ.'COMPUT') RETURN 2443 IF (WORD.EQ.'END ') RETURN 2453 GOTO INPT16