SUBROUTINE GETSYM
C  PASCAL-S PARSER  VERSION VOM 20.12.80
	COMMON DIN,FIN,NERR,IERRS,LINE,LL,ICC,ICH,LC
	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)
	IB=0
5	IF(ICH+2016)15,10,15
10	CONTINUE
S	JMS GETCH
	GOTO 5
15	IF(ICH+1504)40,20,40
20	CONTINUE
S	JMS GETCH
	IF(ICH+1376)25,30,25
25	IB=1
	ICC=ICC-1
	GOTO 5
30	ICHVOR=ICH
S	JMS GETCH
	IF(ICHVOR+1376)30,35,30
35	IF(ICH+1440)30,37,30
37	CONTINUE
S	JMS GETCH
	GOTO 5
40	WRITE(4,650)ICC
650	FORMAT(I4,' ')
	IF(IB-1)43,42,43
42	ICH=-1504
43	IF(ICH-96)100,45,45
45	IF(ICH-1696)50,50,100
50	IL=0
52	IF(IAL-IL)54,54,53
53	IL=IL+1
	ID(IL)=ICH
54	CONTINUE
S	JMS GETCH
	IF(96-ICH)55,55,58
55	IF(ICH-1696)52,52,58
58	IF(ICH+992)47,59,59
59	IF(ICH+416)52,52,47
47	I1=IL+1
	DO 31 I=I1,10
31	ID(I)=-2016
	J=(ID(1)-32)/64
	M=IPOINT(J,1)
	N=IPOINT(J,2)
	DO 60 I=M,N
	IF(IL-LEN(I))60,98,60
98	DO 70 I1=2,10
	IF(ID(I1)-IWORD(I,I1))60,70,60
70	CONTINUE
	ISYM=50+I
	RETURN
60	CONTINUE
	ISYM=1
	RETURN
100	IF(ICH+992)180,105,105
105	IF(ICH+416)106,106,180
106	K=0
	INUM=0
	ISYM=2
108	INUM=INUM*10+(ICH+992)/64
	K=K+1
S	JMS GETCH
	IF(ICH+992)115,110,110
110	IF(ICH+416)108,108,115
115	IF(K-KMAX)116,116,120
116	IF(INUM-NMAX)117,117,120
120	CALL FEHL(21)
	INUM=0
	K=0
117	RNUM=FLOAT(INUM)
	IF(ICH+1120)140,121,140
121	CONTINUE
S	JMS GETCH
	IF(ICH+1120)124,123,124
123	ICC=ICC-1
	GOTO 140
124	ISYM=3
	K=0
127	IF(ICH+992)140,128,128
128	IF(ICH+416)130,130,140
130	K=K-1
	RNUM=10.*RNUM+FLOAT((ICH+992)/64)
S	JMS GETCH
	GOTO 127
140	IF(ICH-352)170,141,170
141	SYM=3
S	JMS GETCH
	IF(ICH+1312)150,142,150
142	CONTINUE
S	JMS GETCH
	GOTO 155
150	IF(ICH+1184)155,151,155
151	CONTINUE
S	JMS GETCH
	I=-1
155	IF(ICH+992)60,156,156
156	IF(ICH+416)157,157,160
157	J=J*10+(ICH+992)/64
S	JMS GETCH
	GOTO 155
160	J=J*I+K
	IF(J-MAXE)161,161,165
161	IF(J-MINE)165,170,170
165	CALL FEHL(21)
	J=0
170	RNUM=RNUM*10.**J
	RETURN
180	INDEX=-(ICH+32)/64
	IF(INDEX+28)182,184,186
182	IF(INDEX+30)190,188,190
188	ISYM=19
	GOTO 500
184	ISYM=18
	GOTO 500
190	WRITE(1,191)ICH
191	FORMAT('UNZULAESSIGES ZEICHEN:  ',A1)
	GOTO 500
186	IF(INDEX-16)195,280,300
195	IF(INDEX)190,190,220
220	GOTO (230,240,250,260,270),INDEX
230	CONTINUE
S	JMS GETCH
	IF(ICH+160)232,231,232
231	ISYM=15
	GOTO 500
232	ISYM=14
	RETURN
240	ISYM=16
	GOTO 500
250	CONTINUE
S	JMS GETCH
	IF(ICH+160)252,251,252
251	ISYM=13
	GOTO 500
252	IF(ICH+96)255,253,255
253	ISYM=17
	GOTO 500
255	ISYM=12
	RETURN
260	ISYM=23
	GOTO 500
270	CONTINUE
S	JMS GETCH
	IF(ICH+160)273,271,273
271	ISYM=20
	GOTO 500
273	ISYM=24
	RETURN
280	ISYM=22
	GOTO 500
300	IF(INDEX-24)305,400,190
305	IF(INDEX-17)190,310,320
310	CONTINUE
S	JMS GETCH
	IF(ICH+1120)312,311,312
311	ISYM=25
	GOTO 500
312	ISYM=21
	RETURN
320	ISYM=INDEX-12
	GOTO 500
400	K=0
	IB=1
	ISYM=5
S	JMS GETCH
405	K=K+1
	IF(K-LLENG)407,407,406
406	CALL FATAL (8)
407	IF(K+ISX-ISMAX)415,415,410
410	CALL FATAL (7)
415	IF(ICH+1568)418,416,418
416	CONTINUE
S	JMS GETCH
	IF(ICH+1568)419,418,419
418	ISTAB(K+ISX)=ICH
S	JMS GETCH
	GOTO 420
419	IB=0
420	IF(IB)405,425,405
425	ISLENG=K-1
	IF(ISLENG)440,430,440
430	CALL FEHL (365)
	ISYM=65
	GOTO 450
440	IF(ISLENG-1)450,441,450
441	ISYM=4
	INUM=ISX
	ISX=ISX+ISLENG
450	RETURN
500	CONTINUE
S	JMS GETCH
	RETURN
SGETCH,	0
	IF(ICC-LL)1100,1020,1020
1020	IF(LINE(LL)+1120)1030,1025,1030
1025	IEND=IEND+1
	ISYM=21
	RETURN
1030	ICC=0
	LL=80
	LC=LC+1
	WRITE(4,1150)LC
1150	FORMAT('-1 '/I4,' ')
	READ(4,1031)(LINE(I),I=1,80)
1031	FORMAT(80A1)
	IEND=IEND+1
1049	IF(LINE(LL)+2016)1100,1050,1100
1050	LL=LL-1
	GOTO 1049
1100	ICC=ICC+1
	ICH=LINE(ICC)
S	JMP I GETCH
	END