File P1TEST.FT (FORTRAN source file)

Directory of image this file is from
This file as a plain text file

	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



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search