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

C  PASCAL-S PARSER  VERSION VOM 20.12.80
	COMMON NERR,IERRS,LC,ICC,DIN,FIN,ICH,LL,LINE
	COMMON ISYM,LEN,IWORD,IPOINT,ID,IAL
	COMMON NAME,IRZEIG,LZEIG,MAX,IL,ISTAB
	COMMON MAXE,MINE,KMAX,NMAX,ISX,LLENG,ISLENG,ISMAX
	DIMENSION LINE(80),LZEIG(200),IRZEIG(200),NAME(200,10)
	DIMENSION IWORD(29,10),IPOINT(26,2),ID(10),LEN(29)
	DIMENSION IERRS(61,3),ISTAB(600),IZEIL(40)
	INTEGER Q(20),DIN(2),FIN(4),I,J,K,CPOS,PPOS
	ISY=0
	IRZEIG(1)=-1
	LZEIG(1)=-1
	MAX=0
	NERR=0
	LLENG=72
	ISMAX=600
	MAXE=99
	MINE=-99
	KMAX=4
	NMAX=2046
C  EINLESEN DER SCHLUESSELWOERTER
	IAL=10
	DIN(1) = 'SY'
	DIN(2) = 'S@'
	FIN(1) = 'WO'
	FIN(2) = 'RD'
	FIN(3) = 0
	FIN(4) = 'DA'
	CALL IOPEN('SYS@','WORD@@DA')
	DO 5 I=1,29
	READ(4,6)(IWORD(I,J),J=1,10)
6	FORMAT(10A1)
C  LAENGE DER SCHLUESSELWOERTER BESTIMMEN
	IL=IAL
45	IF(IWORD(I,IL)+2016)47,46,47
46	IL=IL-1
	GOTO 45
47	LEN(I)=IL
5	CONTINUE
	READ(4,11)(IPOINT(I,1),I=1,26)
	READ(4,11)(IPOINT(I,2),I=1,26)
11	FORMAT(26I2)
	DO 20 I=1,31
	READ(4,21)(ID(J),J=1,10)
21	FORMAT(10A1)
	CALL NAMLI
20	CONTINUE
10	READ(1,110)(Q(I),I=1,20)
110	FORMAT('*',20A1)
	DO 111 I=1,2
	  DIN(I)=0
111	  FIN(I)=0
	FIN(3)=0
	DO 222 I=1,20
	  Q(I)=Q(I)/64
	  K=Q(I)
	  IF (K<0)
	    Q(I)=Q(I)+63
	    K=Q(I)
	  ENDIF
	  IF (K.EQ.32) Q(I)=0		@BLANK = 40 OCT => "@"
	  IF (K.EQ.58) CPOS = I		@":"   = 72 OCT
	  IF (K.EQ.46) PPOS = I		@"."   = 56 OCT
222	CONTINUE
	IF (CPOS>5 .OR. PPOS>18)
	  WRITE(1,30)
30	FORMAT ('ILLEGALE SYNTAX')
	  GOTO 10
	ENDIF
	IF (CPOS .EQ. 0)
	  DIN(1) = 'SY'
	  DIN(2) = 'S@'
	ELSE
	  Q(CPOS) = 0		@'@'
	  I=1
	  J=1
	  WHILE (I<CPOS)
	    DIN(J)  = Q(I)*64 + Q(I+1)
	    J=J+1
	    I=I+2
	  ENDWHILE
	ENDIF
	IF (PPOS.EQ.0)
	  PPOS = 20
	  FIN(4) = 'PS'
	ELSE
	  Q(PPOS) = 0		@"@"
	  FIN(4) = Q(PPOS+1)*64 + Q(PPOS+2)
	ENDIF
	I=CPOS+1
	J=1
	WHILE (J<4 .AND. I<PPOS)
	  FIN(J)=Q(I)*64 + Q(I+1)
	  J=J+1
	  I=I+2
	ENDWHILE
	WRITE(1,39)I,
39	FORMAT(/'PASCAL - S   BERGNEUSTADT  TV040281    ',I0)
	WRITE(1,40)(DIN(I),I=1,2),(FIN(I),I=1,4),I,
40	FORMAT(2A2,':',3A2,'.',A2,10X,I0)
	CALL DATUM
	CALL IOPEN(DIN,FIN)
	Q(1) = 'PS'
	Q(2) = 'FT'
	Q(3) = 0
	Q(4) =  'DA'
	CALL OOPEN(DIN,Q)
	LC=0
	LINE(80)=-2016
	ICC=80
	LL=80
	ICH=-2016
120	IVSYM=ISYM
	ISX=1
	CALL GETSYM
	IF(ISYM-1)123,122,123
122	WRITE(4,211)ISYM
	CALL NAMLI
123	IF(ISX)212,200,212
212	WRITE(4,211)ISYM
200	CONTINUE
211	FORMAT(I4,' ')
	IF(ISYM-21)120,130,120
130	IF(IVSYM-60)120,135,120
135	CALL OCLOSE
	IF (NERR)  1000,1000,1200
1000	WRITE(1,1)
1	FORMAT('PHASE 0 OHNE FEHLER')
	CALL CHAIN('PHASE1SV')
1200	CALL CHAIN('ERRORMSV')
	END