home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / fortran / toolpack.000 / toolpack / toolpack1.2 / tools / istlx / SCNLIB.MAC.f < prev   
Encoding:
Text File  |  1989-03-04  |  3.8 KB  |  147 lines
  1. C---------------------------------------------------------
  2. C    TOOLPACK/1    Release: 2.4
  3. C---------------------------------------------------------
  4. C
  5. C  LIBRARY FOR ISTLX
  6. C
  7. C---------------------------------------------------------------------
  8. C
  9. C  INITIALISE THE SCANNER OPERATION
  10. C
  11.       SUBROUTINE INISCN
  12. C
  13.       COMMON /INSTCM/ INSTAT
  14.       INTEGER         INSTAT
  15.  
  16.       COMMON /CURSTC/ ACT, CHAR, ERRORF, FBKUPC, NEWACT, ENDSCR
  17.       INTEGER         ACT, CHAR,FBKUPC, NEWACT
  18.       LOGICAL         ERRORF, ENDSCR
  19.       COMMON /KSTAKC/ IKSTAC, MKSTAC, KSTACK(2500), FTOKEN, TOKEN, KEEPF
  20.       INTEGER         IKSTAC, MKSTAC, KSTACK, FTOKEN, TOKEN
  21.       LOGICAL         KEEPF
  22.       COMMON /CSTAKC/ ICSTAC, MCSTAC, CSTACK(100)
  23.       INTEGER         ICSTAC, MCSTAC, CSTACK
  24.       COMMON /NESTCM/ NSTELS
  25.       INTEGER         NSTELS
  26.       INTEGER         SDNCPW, SDNCPS
  27.       PARAMETER (SDNCPW=31, SDNCPS=128)
  28.       COMMON /CHRBFC/ ICHAR, CBFSIZ, CBFEND, MCHAR, CHRBUF(1603)
  29.       INTEGER         ICHAR, CBFSIZ, CBFEND, MCHAR, CHRBUF
  30.       COMMON /CHICOM/ ERRCHI, EOLCHI, EOICHI, EOFCHI
  31.       INTEGER         ERRCHI, EOLCHI, EOICHI, EOFCHI
  32.       INTEGER ACTSIZ
  33.       PARAMETER (ACTSIZ = 2050)
  34.       COMMON /AKSCM2/ AKSHN2(ACTSIZ)
  35.       INTEGER         AKSHN2
  36.       COMMON /AKSCM1/ AKSHN1(ACTSIZ)
  37.       INTEGER         AKSHN1
  38.       COMMON /XCDONE/ AA1(ACTSIZ),AA2(ACTSIZ),AA3(ACTSIZ),AA4(ACTSIZ),
  39.      +                AA5(ACTSIZ)
  40.       INTEGER         AA1,AA2,AA3,AA4,AA5
  41.  
  42.       INTEGER I, ZIAND, ZLRS, MASK1, MASK2
  43.       PARAMETER(MASK1=4095, MASK2=63)
  44.  
  45.       SAVE
  46. C
  47.       INSTAT=-1
  48.       ACT = 1
  49.       ERRORF = .FALSE.
  50.       ENDSCR = .FALSE.
  51.       IKSTAC = 1
  52.       KSTACK(1) = 0
  53.       FTOKEN = 1
  54.       TOKEN = 1
  55.       KEEPF = .FALSE.
  56.       ICSTAC = 1
  57.       CSTACK(1) = 0
  58.       NSTELS = 0
  59. C
  60. C  SET THE INTERNAL CHARACTERS REQUIRED TO INDICATE ERROR, END-OF-LINE,
  61. C  END-OF-INPUT AND END-OF-FILE.
  62. C
  63.       ERRCHI = SDNCPS + 1
  64.       EOLCHI = SDNCPS + 2
  65.       EOICHI = SDNCPS + 3
  66.       EOFCHI = SDNCPS + 4
  67. C
  68. C  SET UP THE CHARACTER BUFFER USED BY THE SCANNER
  69. C
  70.       CBFEND = MCHAR - 1
  71.       CBFSIZ = MCHAR - 2
  72.  
  73.       CHRBUF(MCHAR) = EOICHI
  74.       ICHAR         = 1
  75.       CHRBUF(1)     = EOICHI
  76.       CHAR          = EOICHI
  77. C
  78. C  AA1 = AKTYPE
  79. C  AA2 = AKCSET
  80. C  AA3 = CALLAK
  81. C  AA4 = VALLOC
  82. C  AA5 = NEXTAK
  83. C
  84.       DO 10 I = 1, ACTSIZ
  85.         AA1(I) = ZIAND(ZLRS(AKSHN1(I), 24), MASK2)
  86.         AA2(I) = ZIAND(ZLRS(AKSHN1(I), 12), MASK1)
  87.         AA3(I) = ZIAND(AKSHN1(I), MASK1)
  88.         AA4(I) = ZIAND(ZLRS(AKSHN2(I), 12), MASK1)
  89.         AA5(I) = ZIAND(AKSHN2(I), MASK1)
  90.    10 CONTINUE
  91.  
  92.       END
  93. C---------------------------------------------------------------------
  94. C
  95.       SUBROUTINE ADVANC(I,ARRAY,CS)
  96.  
  97.       INTEGER         SDNCPW, SDNCPS
  98.       PARAMETER (SDNCPW=31, SDNCPS=128)
  99.  
  100.       INTEGER I, ARRAY(*), CS, TEMP
  101.       LOGICAL IN
  102.       SAVE
  103. C
  104.    10 CONTINUE
  105.         TEMP = ARRAY(I)
  106.         IF(TEMP .LT. SDNCPS) TEMP = TEMP + 1
  107.         IF(.NOT.IN(TEMP, CS)) RETURN
  108.         I = I + 1
  109.       GO TO 10
  110. C
  111.       END
  112. C------------------------------------------------------------------------
  113. C
  114.       LOGICAL FUNCTION IN(CHAR, CS)
  115.       INTEGER CHAR, CS
  116. C
  117.       INTEGER BTVSIZ
  118.       PARAMETER (BTVSIZ = 72)
  119.       COMMON /BTVRCM/ BTVCTR(5, BTVSIZ)
  120.       INTEGER         BTVCTR
  121.       INTEGER         SDNCPW, SDNCPS
  122.       PARAMETER (SDNCPW=31, SDNCPS=128)
  123. C
  124.       INTEGER IBIT, ZLRS, ZIAND, IWORD
  125.       SAVE /BTVRCM/
  126.       EXTERNAL ZIAND,ZLRS
  127. C
  128.       IF(CHAR .LE. SDNCPW) THEN
  129.         IWORD = 1
  130.         IBIT = 31 - CHAR
  131.       ELSE IF(CHAR .LE. SDNCPW*2) THEN
  132.         IWORD = 2
  133.         IBIT = 31 - CHAR + SDNCPW
  134.       ELSE IF(CHAR .LE. SDNCPW*3) THEN
  135.         IWORD = 3
  136.         IBIT = 31 - CHAR + (SDNCPW*2)
  137.       ELSE IF(CHAR .LE. SDNCPW*4) THEN
  138.         IWORD = 4
  139.         IBIT = 31 - CHAR + (SDNCPW*3)
  140.       ELSE
  141.         IWORD = 5
  142.         IBIT = 31 - CHAR + (SDNCPW*4)
  143.       ENDIF
  144.       IN=ZIAND(ZLRS(BTVCTR(IWORD, CS), IBIT), 1).NE.0
  145. C
  146.       END
  147.