File PHASE1.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 NEWLEVEL
	CALL ENTER(1,1,1,1)	@INPUT
	CALL ENTER(2,1,2,2)	@OUTPUT
	CALL ENTER(3,2,1,0)	@FALSE
	CALL ENTER(4,2,1,1)	@TRUE
	CALL ENTER(5,3,1,0)	@BOOLEAN
	CALL ENTER(6,3,2,0)	@INTEGER
	CALL ENTER(7,3,3,0)	@REAL
	CALL ENTER(8,3,4,0)	@CHAR
	CALL ENTER(9,7,2,3)	@ABS
	CALL ENTER(10,7,3,3)	@ARCTAN
	CALL ENTER(11,7,4,2)	@CHR
	CALL ENTER(12,7,3,3)	@COS
	CALL ENTER(13,7,1,0)	@EOF
	CALL ENTER(14,7,1,0)	@EOLN
	CALL ENTER(15,7,3,3)	@EXP
	CALL ENTER(16,7,3,3)	@LN
	CALL ENTER(17,7,1,2)	@ODD
	CALL ENTER(18,7,2,4)	@ORD
	CALL ENTER(19,7,2,3)	@ROUND
	CALL ENTER(20,7,3,3)	@SIN
	CALL ENTER(21,7,3,3)	@SQRT
	CALL ENTER(22,7,2,3)	@TRUNC
	CALL ENTER(23,6,0,1)	@PAGE
	CALL ENTER(24,6,0,-1)	@READ
	CALL ENTER(25,6,0,-1)	@READLN
	CALL ENTER(26,6,0,-1)	@WRITE
	CALL ENTER(27,6,0,-1)	@WRITELN
	CALL ENTER(28,7,5,0)	@TIME
	CALL ENTER(29,7,5,0)	@DATE
	CALL ENTER(30,6,2,3)	@CLOCK
	CALL ENTER(31,6,0,0)	@HALT
	IC0=1
	RC0=1
	SC0=1
	SCZ(1)=1
	TZ(1)=1
	TZ(2)=2
	TZ(3)=3
	TZ(4)=4
	TZ(5)=5
	TZ(6)=9
	T0=6
	TTAB(1)=1
	TTAB(2)=2
	TTAB(3)=3
	TTAB(4)=4
	TTAB(5)=5
	TTAB(6)=3
	TTAB(7)=2
	TTAB(8)=1
	NZEIGER=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
	  I=0		@INTERNAL SIGN SET TO I/O BOTH
	  J=3		@CHANNEL #
	  IF (SYM.NE.1) 	@IDENT
	    CALL FEHL(2)
	  ELSE
	    WHILE (SYM.EQ.1)	@IDENT
	      B=DD(IDENT)
	      IF(.NOT.B) THEN 	@EINTRAGEN
		CALL ENTER(IDENT,1,I,J)
		J=J+1
	      ELSE
		B=KITUM(INKITUM(IDENT),2).EQ.1	@IOPARAMETER
		IF (.NOT.B) CALL FATAL(103)
		IF(I.GE.IDENT .OR. IDENT>3) CALL FATAL(101)
		I=IDENT
	      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(2,1)

WHILE (GPUNKT.NE.0) GOTO (101,102,103,104,105), GPUNKT 101 CONTINUE @"BEGIN S;... END BEARB. CALL AUSKELLERN(1) CALL ANWEISUNG 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 ENTER(IDENT,0,0,0) CALL GETSYM IF(SYM.EQ.16) @"=" CALL GETSYM ELSE IF(SYM.EQ.24) @":" CALL FEHL(16) CALL GETSYM ELSE CALL FATAL(16) ENDIF ENDIF CALL CONSTANT KZEIGER=KZEIGER-1 CALL ENTER(KITUM(KZEIGER,1),2,PUNKT(5),PUNKT(4)) CALL AUSKELLERN(5) CALL AUSKELLERN(4) 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 INKI0=KZEIGER CALL ENTER(IDENT,0,0,0) CALL TYPENDEKLARATION KITUM(INKI0,2)=3 @TYPE IF (SYM.EQ.23) CALL GETSYM @";" C$ CALL STEST ENDWHILE ENDIF IF (SYM.EQ.78) @"VAR" CALL GETSYM CALL EINKELLERN(0,6) @ZETA WHILE (SYM.EQ.1) @IDENT B=DD(IDENT) IF (B) CALL FATAL(101) CALL ENTER(IDENT,5,0,0) @VAR CALL AUFADDIEREN(1,6) CALL GETSYM IF(SYM.EQ.7) @"," CALL GETSYM IF(SYM.NE.1) CALL FATAL(2) ELSE IF (SYM.EQ.24) @":" CALL GETSYM ELSE IF (SYM.EQ.16) @"=" CALL FEHL(5) CALL GETSYM ELSE CALL FATAL(5) ENDIF ENDIF INKIV=KZEIGER CALL TYPENDEKLARATION M=KITUM(INKIV-1,3) K=PUNKT(6) @ZETA CALL ERSETZEN(0,6) DO 111 I=1,K INKIV=INKIV-1 111 KITUM(INKIV,3)=M C$ CALL KTEST IF(SYM.EQ.23) CALL GETSYM @";" ENDIF ENDWHILE CALL AUSKELLERN(6) 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 CALL ENTER(IDENT,7,0,0) 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) CALL ENTER(IDENT,6,0,0) CALL GETSYM CALL PARAMETERLISTE IF (SYM.EQ.23) @";" CALL GETSYM ELSE CALL FEHL(14) ENDIF ENDIF CALL NEWLEVEL CALL ERSETZEN(5,1) CALL EINKELLERN(2,1) GOTO 199 105 IF (SYM.EQ.23) CALL GETSYM ELSE CALL FEHL(14) ENDIF CALL ERSETZEN(3,1) 199 CONTINUE ENDWHILE
IF (SYM.NE.21) CALL FEHL(22) @PUNKT ERWARTET CALL OCLOSE IF (NERR.EQ.0) WRITE(1,7) CALL FATAL(-1) ELSE CALL CHAIN('ERRORM') ENDIF 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