home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / LANGUAGS / FORTRAN / RATFOR.LBR / INCLUDE.RTF < prev    next >
Text File  |  2000-06-30  |  2KB  |  74 lines
  1.  
  2. include "b:ratdefn.rtf"
  3. define(NFILES,4)
  4. # include - replace  include file  by contents of file
  5.    character line(MAXLINE), str(MAXLINE)
  6.    integer equal, getlin, getwrd, fopen
  7.    integer infile(NFILES), len, level, loc
  8. #   string incl "include"
  9.    character incl(8)
  10.    data incl(1) /LETI/
  11.    data incl(2) /LETN/
  12.    data incl(3) /LETC/
  13.    data incl(4) /LETL/
  14.    data incl(5) /LETU/
  15.    data incl(6) /LETD/
  16.    data incl(7) /LETE/
  17.    data incl(8) /EOS/
  18.  
  19.    call initio
  20.  
  21.    infile(1) = STDIN
  22.    for (level = 1; level > 0; level = level - 1) {
  23.       while (getlin(line, infile(level)) ^= EOF) {
  24.      loc = 1
  25.      len = getwrd(line, loc, str)
  26.      if (equal(str, incl) == NO)
  27.         call putlin(line, STDOUT)
  28.      else {
  29.         level = level + 1
  30.         if (level > NFILES)
  31.            call error("includes nested too deeply.")
  32.         len = getwrd(line, loc, str)
  33.         infile(level) = fopen(str, RDONLY)
  34.         if (infile(level) == ERR)
  35.            call cant(str)
  36.         }
  37.      }
  38.       if (level > 1)
  39.      call close(infile(level))
  40.       }
  41.  
  42.    call putch(EOF,STDOUT)
  43.  
  44.    stop
  45.    end
  46. # getwrd - get non-blank word from in(i) into  out, increment i
  47.    integer function getwrd(in, i, out)
  48.    character in(ARB), out(ARB)
  49.    integer i, j
  50.  
  51.    while (in(i) == BLANK | in(i) == TAB)
  52.       i = i + 1
  53.    j = 1
  54.    while (in(i) ^= EOS & in(i) ^= BLANK
  55.       & in(i) ^= TAB & in(i) ^= NEWLINE) {
  56.       out(j) = in(i)
  57.       i = i + 1
  58.       j = j + 1
  59.       }
  60.    out(j) = EOS
  61.    getwrd = j - 1
  62.    return
  63.    end
  64. 
  65.  
  66.  
  67.  
  68.  
  69.  
  70.  
  71.  
  72.  
  73.  
  74.