COMMON NERR,IERRS,LC,CC,DIN,FIN COMMON SYM,IDENT,INUM,RNUM,SLENG,CH,STRING COMMON STACK,BOTTOM,TOP,KITUM,KZEIGER,NIDEK,NZEIGER COMMON IC0,RC0,SC0,P0,I0,T0,GPUNKT COMMON ICZEIGER,RCZEIGER,PZEIGER,IZEIGER,TZEIGER,SCZEIGER COMMON ICTAB,RCTAB,SCTAB,SCZ,PTAB,PZ,ITAB,IZ,TTAB,TZ INTEGER PUNKT,GPUNKT,NPUNKT,INKITUM,INKI,INKI0,INKI1 INTEGER NERR,IERRS(61,3),LC,CC INTEGER SYM,IDENT,INUM,SLENG,CH,STRING(80) INTEGER STACK(200),BOTTOM(10),TOP(10),KITUM(200,4) INTEGER NIDEK(100,2),NZEIGER,IC0,RC0,SC0,P0,I0,T0 INTEGER ICZEIGER,RCZEIGER,PZEIGER,IZEIGER,TZEIGER,SCZEIGER INTEGER ICTAB(200),SCTAB(200),SCZ(50),PTAB(100),PZ(50) INTEGER ITAB(100),IZ(50),TTAB(400),TZ(50) REAL RNUM,RCTAB(50) LOGICAL LEER,DD,B 1 FORMAT(A2) @INTERN INTEGER 2 FORMAT(I6) @EXTERN INTEGER 3 FORMAT(A6) @INTERN REAL 4 FORMAT(E15.7) @EXTERN REAL 5 FORMAT(A1) @CHARACTER 6 FORMAT(80A1) @LINE 7 FORMAT('PHASE 1 OHNE FEHLER') CALL IOPEN('SYS@@@','PSFT@@') CALL OOPEN('SYS@@@','PSFT1@') NERR=0 TOP(1)=0 TOP(2)=80 TOP(3)=100 TOP(4)=115 TOP(5)=130 TOP(6)=145 TOP(7)=160 TOP(8)=170 TOP(9)=180 TOP(10)=190 DO 555 I = 1, 10 555 BOTTOM(I)=TOP(I) KZEIGER=1 CALL ENTER(1,1,1,1) CALL ENTER(2,1,2,2) CALL ENTER(3,2,1,0) CALL ENTER(4,2,1,1) CALL ENTER(5,3,1,0) CALL ENTER(6,3,2,0) CALL ENTER(7,3,3,0) CALL ENTER(8,3,4,0) CALL ENTER(9,7,2,3) CALL ENTER(10,7,3,3) CALL ENTER(11,7,4,2) CALL ENTER(12,7,3,3) CALL ENTER(13,7,1,0) CALL ENTER(14,7,1,0) CALL ENTER(15,7,3,3) CALL ENTER(16,7,3,3) CALL ENTER(17,7,1,2) CALL ENTER(18,7,2,4) CALL ENTER(19,7,2,3) CALL ENTER(20,7,3,3) CALL ENTER(21,7,3,3) CALL ENTER(22,7,2,3) CALL ENTER(23,6,0,1) CALL ENTER(24,6,0,-1) CALL ENTER(25,6,0,-1) CALL ENTER(26,6,0,-1) CALL ENTER(27,6,0,-1) CALL ENTER(28,7,5,0) CALL ENTER(29,7,5,0) CALL ENTER(30,6,2,3) CALL ENTER(31,6,0,0) IC0=1 RC0=1 SC0=1 I0=1 SCZ(1)=1 PZ(1)=1 PZ(2)=2 PTAB(1)=0 IZ(1)=1 TZ(1)=1 TZ(2)=2 TZ(3)=3 TZ(4)=4 TZ(5)=5 TZ(6)=9 T0=6 TTAB(5)=5 TTAB(6)=3 TTAB(7)=2 TTAB(8)=1 P0=2 NZEIGER=1 IZ(1)=1 CALL GETSYM IF (SYM.NE.71) @PROGRAM CALL FEHL(3) ELSE CALL GETSYM IF (SYM.NE.1) @IDENTIFIER CALL FEHL(2) ELSE CALL GETSYM ENDIF IF (SYM.NE.11) @"(" CALL FEHL(9) ELSE CALL GETSYM ENDIF IF (SYM.NE.1) @IDENT CALL FEHL(2) ELSE WHILE (SYM.EQ.1) @IDENT B=DD(IDENT) IF(.NOT.B) THEN @EINTRAGEN KITUM(KZEIGER,1)=IDENT KITUM(KZEIGER,2)=1 KITUM(KZEIGER,3)=0 KITUM(KZEIGER,4)=0 KZEIGER=KZEIGER+1 ELSE B=KITUM(INKITUM(IDENT),2).EQ.1 @IOPARAMETER IF (.NOT.B) THEN CALL FATAL(103) ENDIF ENDIF CALL GETSYM IF (SYM.EQ.7) @KOMMA CALL GETSYM IF (SYM.NE.1) CALL FATAL(2) ENDIF ENDWHILE IF(SYM.NE.10) @")" CALL FEHL(4) ELSE CALL GETSYM ENDIF IF(SYM.NE.23) @; CALL FEHL(14) ELSE CALL GETSYM ENDIF ENDIF ENDIF CALL EINKELLERN(0,1) CALL EINKELLERN(1,1) CALL EINKELLERN(2,1) WHILE (GPUNKT.NE.0) GOTO (101,102,103,104,105), GPUNKT 101 CONTINUE @"BEGIN S;... END BEARB. CALL AUSKELLERN(1) CALL SBLOCK GOTO 199 102 CONTINUE @BEGIN OF DECLARATION IF(SYM.EQ.55) @CONST CALL GETSYM WHILE(SYM.EQ.1) @IDENT B=DD(IDENT) IF (B) CALL FATAL(101) CALL GETSYM IF(SYM.EQ.16) @"=" CALL GETSYM ELSE IF(SYM.EQ.24) @":" CALL FEHL(16) CALL GETSYM ELSE CALL FATAL(16) ENDIF ENDIF B=(SYM<2.OR.SYM>5).AND.SYM.NE.6.AND.SYM.NE.8 IF (B) CALL FATAL(183) KITUM(KZEIGER,1)=IDENT KITUM(KZEIGER,2)=-1 CALL CONSTANT KITUM(KZEIGER,2)=2 KITUM(KZEIGER,3)=PUNKT(5) @TAU KITUM(KZEIGER,4)=0 KZEIGER=KZEIGER+1 IF (KZEIGER.GE.200) CALL FATAL(520) @KMAX CALL GETSYM IF(SYM .EQ. 23) @";" CALL GETSYM ELSE IF(SYM.EQ.7) @"," CALL GETSYM CALL FEHL(14) ENDIF ENDIF ENDWHILE ENDIF IF (SYM.EQ.76) @"TYPE" CALL GETSYM WHILE (SYM.EQ.1) @IDENT B=DD(IDENT) IF (B) CALL FATAL(101) CALL GETSYM IF (SYM.EQ.16) @"GLEICH" CALL GETSYM ELSE IF (SYM.EQ.24) @":" CALL FEHL(16) CALL GETSYM ELSE CALL FATAL(16) ENDIF ENDIF KITUM(KZEIGER,1)=IDENT KITUM(KZEIGER,2)=-1 KZEIGER=KZEIGER+1 IF(KZEIGER.GE.200) CALL FATAL(520) @KMAX CALL TKIT CALL TSTACK CALL TYPENDEKLARATION CALL TKIT CALL TSTACK KITUM(INKI0,2)=3 @TYPE ENDWHILE ENDIF IF (SYM.EQ.78) @"VAR" CALL GETSYM WHILE (SYM.EQ.1) @IDENT B=DD(IDENT) IF (B) CALL FATAL(101) KITUM(KZEIGER,1)=IDENT KITUM(KZEIGER,2)=5 @"VAR" KZEIGER=KZEIGER+1 IF (KZEIGER.EQ.200) CALL FATAL(520) @KMAX CALL GETSYM IF (SYM.EQ.24) @":" CALL GETSYM ELSE IF (SYM.EQ.16) @"=" CALL FEHL(5) CALL GETSYM ELSE CALL FATAL(5) ENDIF ENDIF CALL TYPENDEKLARATION ENDWHILE ENDIF 103 B=SYM.EQ.62.OR.SYM.EQ.70 IF (B) GOTO 104 @PROC ODER FUNT IF (SYM.EQ.53) @BEGIN CALL ERSETZEN(1,1) ELSE CALL FATAL(17) ENDIF GOTO 199 104 IF (SYM.EQ.62) @FUNCTION CALL GETSYM IF (SYM.NE.1) CALL FATAL(2) @IDENT B=DD(IDENT) IF (B) CALL FATAL(101) INKI0=KZEIGER KITUM(KZEIGER,1)=IDENT KITUM(KZEIGER,2)=7 KZEIGER=KZEIGER+1 IF (KZEIGER.GE.200) CALL FATAL(520) @KMAX CALL GETSYM CALL PARAMETERLISTE IF (SYM.NE.24) CALL FATAL(5) @":" CALL GETSYM IF (SYM.NE.1) CALL FATAL(2) @IDENT INKI=INKITUM(IDENT) IF (INKI .EQ.0) CALL FATAL(104) B=KITUM(INKI,2).NE.3 IF (B) CALL FATAL(103) KITUM(INKI0,3)=KITUM(INKI,3) CALL GETSYM IF (SYM.EQ.23) @";" CALL GETSYM ELSE CALL FEHL(14) IF (SYM.EQ.7) CALL GETSYM ENDIF ELSE @PROCEDURE CALL GETSYM IF (SYM.NE.1) CALL FATAL(2) @IDENT B=DD(IDENT) IF (B) CALL FATAL(101) KITUM(KZEIGER,1)=IDENT KITUM(KZEIGER,2)=6 KZEIGER=KZEIGER+1 IF (KZEIGER.EQ.200) CALL FATAL(520) @KMAX CALL GETSYM CALL PARAMETERLISTE IF (SYM.EQ.23) @";" CALL GETSYM ELSE CALL FEHL(14) ENDIF ENDIF CALL NEWLEVEL CALL ERSETZEN(5,1) CALL EINKELLERN(1,1) GOTO 199 105 IF (SYM.EQ.23) CALL GETSYM ELSE CALL FEHL(14) ENDIF CALL ERSETZEN(3,1) GOTO 103 199 CONTINUE ENDWHILE IF (SYM.NE.21) CALL FEHL(22) @PUNKT ERWARTET IF (NERR.EQ.0) WRITE(1,7) CALL CHAIN('PHASE2') ELSE CALL CHAIN('ERRORM') ENDIF CALL OCLOSE STOP END