Listing of file='MACROS.FOR;03' on disk='vmedia/ratfor-sector.ccvf'
INTEGER FUNCTION DEFTOK(TOKEN,TOKSIZ,FD)
IMPLICIT BYTE (A-Z)
INTEGER FD,LOOKUP
BYTE DEFN(80),TOKEN(80)
C
T = GTOK(TOKEN,TOKSIZ,FD)
23058 IF(.NOT.(T.NE.-3)) GOTO 23059
IF(.NOT.(T.NE.-100)) GOTO 23060
GOTO 23059
23060 CONTINUE
IF(.NOT.(LOOKUP(TOKEN,DEFN).EQ.0)) GOTO 23062
GOTO 23059
23062 CONTINUE
IF(.NOT.(DEFN(1).EQ.-10)) GOTO 23062
CALL GETDEF(TOKEN,TOKSIZ,DEFN,200,FD)
CALL INSTAL(TOKEN,DEFN)
GOTO 23065
23064 CONTINUE
CALL PBSTR(DEFN)
23065 CONTINUE
T = GTOK(TOKEN,TOKSIZ,FD)
IF(.NOT.(T.EQ.10)) GOTO 23066
T = GTOK(TOKEN,TOKSIZ,FD)
23066 CONTINUE
GOTO 23058
23059 CONTINUE
DEFTOK = T
RETURN
END
SUBROUTINE GETDEF(TOKEN,TOKSIZ,DEFN,DEFSIZ,FD)
IMPLICIT BYTE (A-Z)
INTEGER FD
BYTE TOKEN(80),DEFN(80),PTOKEN(80)
C
C = GTOK(PTOKEN,80,FD)
IF(.NOT.(C.EQ.'(')) GOTO 23136
T = '('
GOTO 23137
23136 CONTINUE
T = ' '
CALL PBSTR(PTOKEN)
23137 CONTINUE
IF(.NOT.(GTOK(TOKEN,TOKSIZ,FD).NE.-100)) GOTO 23138
CALL ERROR('10-NON-ALPHANUMERIC NAME IN DEFINE.')
23138 CONTINUE
C = GTOK(PTOKEN,80,FD)
IF(.NOT.(T.EQ.' ')) GOTO 23140
CALL PBSTR(PTOKEN)
I = 1
23142 CONTINUE
C = NGETCH(C,FD)
IF(.NOT.(I.GT.DEFSIZ)) GOTO 23145
CALL ERROR('11-DEFINITION TOO LONG.')
23145 CONTINUE
DEFN(I) = C
I = I+1
23143 IF(.NOT.(C.EQ.'#'.OR.C.EQ.10.OR.C.EQ.-3.OR.C.EQ.' '))
* GOTO 23142
23144 CONTINUE
IF(.NOT.(C.EQ.'#')) GOTO 23147
CALL PUTBAK(C)
23147 CONTINUE
GOTO 23141
23140 CONTINUE
IF(.NOT.(T.EQ.'(')) GOTO 23149
IF(.NOT.(T.EQ.',')) GOTO 23151
CALL ERROR('12-MISSING COMMA IN DEFINE.')
23151 CONTINUE
NLPAR = 0
I = 1
23153 IF(.NOT.(NLPAR.EQ.0)) GOTO 23155
IF(.NOT.(I.GT.DEFSIZ)) GOTO 23156
CALL ERROR('11-DEFINITION TOO LONG.')
GOTO 23157
23156 CONTINUE
IF(.NOT.(NGETCH(DEFN(I),FD).EQ.-3)) GOTO 23158
CALL ERROR('13-MISSING RIGHT PAREN IN DEFINE.')
GOTO 23159
23158 CONTINUE
IF(.NOT.(DEFN(I).EQ.'(')) GOTO 23160
NLPAR = NLPAR+1
GOTO 23161
23160 CONTINUE
IF(.NOT.(DEFN(I).EQ.')')) GOTO 23162
NLPAR = NLPAR-1
23162 CONTINUE
23161 CONTINUE
23159 CONTINUE
23157 CONTINUE
23154 I = I+1
GOTO 23153
23155 CONTINUE
GOTO 23150
23149 CONTINUE
CALL ERROR('14-UNEXPECTED TOKEN IN DEFINE.')
23150 CONTINUE
23141 CONTINUE
DEFN(I-1) = -2
RETURN
END
SUBROUTINE INITKW
IMPLICIT BYTE (A-Z)
BYTE DEFNAM(7),DEFTYP(2)
C
C COMMON BLOCKS
C
INTEGER AVAIL,TABLE(2000),TABPTR(26)
COMMON /CLOOK/AVAIL,TABLE,TABPTR
C
DATA DEFNAM/'D','E','F','I','N','E',-2/
DATA DEFTYP/-10,-2/
C
AVAIL = 1
DO 23239 I=1,26
TABPTR(I) = 0
23239 CONTINUE
23240 CONTINUE
CALL INSTAL(DEFNAM,DEFTYP)
RETURN
END
SUBROUTINE INSTAL(NAME,DEFN)
IMPLICIT BYTE (A-Z)
INTEGER LENGTH,DLEN,NLEN,C
BYTE NAME(1),DEFN(1)
C
C COMMON BLOCKS
C
INTEGER AVAIL,TABLE(2000),TABPTR(26)
COMMON /CLOOK/AVAIL,TABLE,TABPTR
C
NLEN = LENGTH(NAME)+1
DLEN = LENGTH(DEFN)+1
IF(.NOT.(AVAIL+NLEN+DLEN.GT.6500)) GOTO 23241
CALL PUTLIN(NAME,3)
CALL ERROR('20-TOO MANY DEFINITIONS.')
RETURN
23241 CONTINUE
IF(.NOT.(NAME(1).LT.'A'.OR.NAME(1).GT.'Z')) GOTO 23243
RETURN
23243 CONTINUE
C = NAME(1)-'A'+1
IF(.NOT.(TABPTR(C).NE.0)) GOTO 23245
C = TABPTR(C)
23247 IF(.NOT.(TABLE(C).NE.-4)) GOTO 23248
C = TABLE(C)
GOTO 23247
23248 CONTINUE
TABLE(C) = AVAIL
GOTO 23246
23245 CONTINUE
TABPTR(C) = AVAIL
23246 CONTINUE
TABLE(AVAIL) = -4
CALL SCOPY(NAME,1,TABLE,AVAIL+1)
TABLE(AVAIL+NLEN) = -2
AVAIL = AVAIL+NLEN+DLEN+1
RETURN
END
LOGICAL FUNCTION LOOKUP(NAME,DEFN)
IMPLICIT BYTE (A-Z)
INTEGER C,I
BYTE NAME(80),DEFN(80)
C
INTEGER AVAIL,TABLE(2000),TABPTR(26)
COMMON /CLOOK/AVAIL,TABLE,TABPTR
C
IF(.NOT.(NAME(1).LT.'A'.OR.NAME(1).GT.'Z')) GOTO 23286
LOOKUP = 0
RETURN
23286 CONTINUE
C = NAME(1)-'A'+1
IF(.NOT.(TABPTR(C).EQ.0)) GOTO 23288
LOOKUP = 0
RETURN
23288 CONTINUE
C = TABPTR(C)
23290 CONTINUE
I = C+1
K = 1
23293 IF(.NOT.(NAME(K).NE.-2)) GOTO 23295
IF(.NOT.(TABLE(I).NE.NAME(K)) GOTO 23296
IF(.NOT.(TABLE(C).EQ.-4)) GOTO 23298
LOOKUP = 0
RETURN
23298 CONTINUE
C = TABLE(C)
GOTO 23291
23296 CONTINUE
I = I+1
23294 K = K+1
GOTO 23293
23295 CONTINUE
IF(.NOT.(TABLE(I).EQ.-2)) GOTO 23300
C
I = I+1
K = 1
222 IF(.NOT.(TABLE(I).NE.-2)) GOTO 333
DEFN(K) = TABLE(I)
K = K+1
I = I+1
GOTO 222
333 DEFN(K) = -2
C
LOOKUP = X'FF'
RETURN
23300 CONTINUE
LOOKUP = 0
RETURN
23291 GOTO 23290
23292 CONTINUE
END