home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / cug / softt-3.lbr / PRIM-I.QQQ / PRIM-I.
Text File  |  1984-07-05  |  8KB  |  266 lines
  1. #-h-  index          240  local  09/22/80  15:38:58
  2. # index - find character  c  in string  str
  3.  
  4.    integer function index (str, c)
  5.    character str (ARB), c
  6.  
  7.    for (index = 1; str (index) != EOS; index = index + 1)
  8.       if (str (index) == c)
  9.          return
  10.  
  11.    index = 0
  12.    return
  13.    end
  14. #-t-  index          240  local  09/22/80  15:38:58
  15. #-h-  initst         4393  local  09/22/80  15:38:36
  16. # initst - initialize variables and I/O for software tools programs
  17.  
  18.    subroutine initst
  19.  
  20.    character input (FILENAMESIZE),
  21.              output (FILENAMESIZE),
  22.              errout (FILENAMESIZE),
  23.              buf (MAXLINE)
  24.  
  25.    integer i, outacc, erracc
  26.    integer getarg, assign, insub, outsub, errsub
  27.  
  28.    filedes open
  29.  
  30.    # include args
  31.  
  32.  ## common block used to hold command line argument information
  33.  # Put on a file called 'args'
  34.  
  35.  common /args/ nbrarg, ptr (MAXARGS), arg (ARGBUFSIZE)
  36.  integer nbrarg         #number arguments in list; initialize to 0
  37.  integer ptr            #pointers (into 'arg') for each argument
  38.  character arg          #arguments stored as ascii strings terminated
  39.                         #with EOS markers
  40.  
  41.  
  42.    # include io
  43.  
  44.  ## io - common block holding I/O information for portable primitives
  45.  # put on a file called 'io'
  46.  
  47.  common /io/  unit (MAXOFILES), lastc (MAXOFILES), ccnt (MAXOFILES),
  48.               filacc (MAXOFILES), mode (MAXOFILES), ftype (MAXOFILES),
  49.               filenm (FILENAMESIZE, MAXOFILES),
  50.               buffer (MAXLINE, MAXOFILES)
  51.  
  52.     integer unit        # fortran unit number
  53.     integer lastc       # pointer to last character in unit's buffer
  54.     integer ccnt        # number characters read/written in file
  55.                         # (used only by seek)
  56.     integer filacc      # access used to open file
  57.                         # (READ, WRITE, READWRITE, or APPEND)
  58.     integer mode        # device mode (DISK or TERMINAL)
  59.     integer ftype       # file type (LOCAL, ASCII, BINARY)
  60.     character filenm    # file name associated with unit
  61.     character buffer    # line buffer for unit
  62.  
  63.  
  64.  
  65.    # Set default output and errout access types (WRITE or APPEND)
  66.    data outacc /WRITE/
  67.    data erracc /WRITE/
  68.  
  69.  
  70.    #----------------------------------------------------------------
  71.    #
  72.    #   These initializations are done with substitutions rather than
  73.    #   data or block data statements to avoid the problem of block
  74.    #   data programs.
  75.    #
  76.    #----------------------------------------------------------------
  77.  
  78.    # Initialize command line argument count
  79.    # (Located in /args/)
  80.  
  81.    nbrarg = 0
  82.  
  83.    # Initialize fortran units for I/O
  84.    # (These are located in the 'io' common block
  85.    # Change these to units appropriate to your machine
  86.  
  87.    #                      This is STDIN (1)
  88.    unit (STDIN) = STDINUNIT
  89.    mode (STDIN) = TERMINAL         # TERMINAL or DISK
  90.    ftype (STDIN) = LOCAL           # File type - LOCAL, ASCII, or BINARY
  91.  
  92.    #                      This is STDOUT (2)
  93.    unit (STDOUT) = STDOUTUNIT
  94.    mode (STDOUT) = TERMINAL        # TERMINAL or DISK
  95.    ftype (STDOUT) = LOCAL          # File type - LOCAL, ASCII, or BINARY
  96.  
  97.    #                      This is ERROUT (3)
  98.    unit (ERROUT) = ERROUTUNIT
  99.    mode (ERROUT) = TERMINAL        # TERMINAL or DISK
  100.    ftype (ERROUT) = LOCAL          # File type - LOCAL, ASCII, or BINARY
  101.  
  102.    #                      Any unit is OK here
  103.    unit (4) = UNITA
  104.    mode (4) = DISK                 # TERMINAL or DISK
  105.    ftype (4) = LOCAL               # File type - LOCAL, ASCII, or BINARY
  106.  
  107.    #                      This is UNITB (any unit)
  108.    unit (5) = UNITB
  109.    mode (5) = DISK                 # TERMINAL or DISK
  110.    ftype (5) = LOCAL               # File type - LOCAL, ASCII, or BINARY
  111.  
  112.    #                      This is UNITC (any unit)
  113.    unit (6) = UNITC
  114.    mode (6) = DISK                 # TERMINAL or DISK
  115.    ftype (6) = LOCAL               # File type - LOCAL, ASCII, or BINARY
  116.  
  117.  
  118.    # initialize default standard files
  119.    call termin (input)
  120.    call trmout (output)
  121.    call trmout (errout)
  122.  
  123.    # initialize /io/ common block variables
  124.    for (i = 1; i <= MAXOFILES; i = i + 1)
  125.           filenm (1, i) = EOS
  126.  
  127.    # set up list of command arguments
  128.    call makarg
  129.  
  130.    # pick up file substitutions for standard files
  131.    for (i=1; getarg (i, buf, MAXLINE) != EOF; ) {
  132.       if (insub (buf,input) == YES |
  133.        outsub (buf,output, outacc) == YES |
  134.        errsub (buf, errout, erracc) == YES )
  135.          call delarg (i)
  136.       else
  137.          i = i + 1
  138.       }
  139.  
  140.    # open standard input, output, and errout files
  141.    if (assign (errout, ERROUT, erracc) == ERR)
  142.       call endst    # can't print error message cause no ERROUT file
  143.    if (assign (input, STDIN, READ) == ERR)
  144.       call cant (input)
  145.    if (assign (output, STDOUT, outacc) == ERR)
  146.       call cant (output)
  147.  
  148.    return
  149.    end
  150. #-h-  initst         4393  local  09/22/80  15:38:36
  151. #-h-  inmap          237  local  09/22/80  15:39:00
  152. # inmap - convert hollerith characters to ascii
  153.  
  154.    character function inmap (c)
  155.    character c
  156.  
  157.    # You must supply your own version of INMAP here, or
  158.    #    use the Fortran version developed in the test of COPY
  159.  
  160.    return (c)
  161.    end
  162. #-t-  inmap          237  local  09/22/80  15:39:00
  163. #-h-  insub          276  local  09/22/80  15:38:46
  164. # insub - determine if argument is STDIN substitution
  165.  
  166.    integer function insub (arg, file)
  167.    character arg (ARB), file (ARB)
  168.  
  169.    if (arg (1) == LESS & arg (2) != EOS) {
  170.       insub = YES
  171.       call scopy (arg, 2, file, 1)
  172.       }
  173.    else
  174.       insub = NO
  175.  
  176.    return
  177.    end
  178. #-t-  insub          276  local  09/22/80  15:38:46
  179. #-h-  isatty         1107  local  09/22/80  15:38:37
  180. # isatty - determine if file is a teletype/CRT device
  181.  
  182.    integer function isatty (int)
  183.    filedes int
  184.  
  185.    # include io
  186.  
  187.  ## io - common block holding I/O information for portable primitives
  188.  # put on a file called 'io'
  189.  
  190.  common /io/  unit (MAXOFILES), lastc (MAXOFILES), ccnt (MAXOFILES),
  191.               filacc (MAXOFILES), mode (MAXOFILES), ftype (MAXOFILES),
  192.               filenm (FILENAMESIZE, MAXOFILES),
  193.               buffer (MAXLINE, MAXOFILES)
  194.  
  195.     integer unit        # fortran unit number
  196.     integer lastc       # pointer to last character in unit's buffer
  197.     integer ccnt        # number characters read/written in file
  198.                         # (used only by seek)
  199.     integer filacc      # access used to open file
  200.                         # (READ, WRITE, READWRITE, or APPEND)
  201.     integer mode        # device mode (DISK or TERMINAL)
  202.     integer ftype       # file type (LOCAL, ASCII, BINARY)
  203.     character filenm    # file name associated with unit
  204.     character buffer    # line buffer for unit
  205.  
  206.  
  207.    if (mode (int) == TERMINAL)
  208.       isatty = YES
  209.    else
  210.       isatty = NO
  211.  
  212.    return
  213.    end
  214. #-t-  initst         4393  local  09/22/80  15:38:36
  215. #-h-  itoc         1033  local  09/22/80  15:38:59
  216. # itoc - convert integer  int  to char string in  str
  217.  
  218.    integer function itoc (int, str, size)
  219.    integer int, size
  220.    character str (ARB)
  221.  
  222.    integer mod
  223.    integer d, i, intval, j, k
  224.  
  225.    # string digits "0123456789"
  226.    character digits (11)
  227.    data digits (1) /DIG0/,
  228.       digits (2) /DIG1/,
  229.       digits (3) /DIG2/,
  230.       digits (4) /DIG3/,
  231.       digits (5) /DIG4/,
  232.       digits (6) /DIG5/,
  233.       digits (7) /DIG6/,
  234.       digits (8) /DIG7/,
  235.       digits (9) /DIG8/,
  236.       digits (10) /DIG9/,
  237.       digits (11) /EOS/
  238.  
  239.    intval = iabs (int)
  240.    str (1) = EOS
  241.    i = 1
  242.    repeat {                          # generate digits
  243.       i = i + 1
  244.       d = mod (intval, 10)
  245.       str (i) = digits (d+1)
  246.       intval = intval / 10
  247.       } until (intval == 0 | i >= size)
  248.  
  249.    if (int < 0 & i < size) {         # then sign
  250.       i = i + 1
  251.       str (i) = MINUS
  252.       }
  253.    itoc = i - 1
  254.  
  255.    for (j = 1; j < i; j = j + 1) {   # then reverse
  256.       k = str (i)
  257.       str (i) = str (j)
  258.       str (j) = k
  259.       i = i - 1
  260.       }
  261.  
  262.    return
  263.    end
  264. #-t-  itoc         1033  local  09/22/80  15:38:59
  265.  int, size
  266.