File PBLOCK.FT (FORTRAN source file)

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

	COMMON NERR,IERRS,LC,CC
	COMMON SYM,ID,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,ID,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
	WHILE (GPUNKT.NE.0)
	GOTO (101,102,103,104,105) GPUNKT
101	CONTINUE	@"BEGIN S;... END BEARB.
	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
	    IF(SYM<2 .OR. SYM>5) CALL FATAL(183)
	    CALL ENTE
	    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
	    CALL ENTE
	    CALL TYPENDEKLARATION
	  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	IF (SYM.EQ.62.OR.SYM.EQ.70) 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)
	  KITUM(KZEIGER,1)=IDENT
	  KITUM(KZEIGER,2)=8
	  INKI1=KZEIGER
	  KZEIGER=KZEIGER+1
	  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)
	  IF(KITUM(INKI,2).NE.3) CALL FATAL(103)
	  KITUM(INKI1,3)=KITUM(INKI,3)
	  KITUM(INKI1,4)=KITUM(INKI,4)
	  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(ID)
	  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
	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