home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / LIBRY31A.ZIP / LIBRY5.DOC < prev    next >
Encoding:
Text File  |  1987-01-21  |  9.9 KB  |  302 lines
  1. .pa
  2.                              FILE HANDLING
  3.  
  4. FORTRAN is rather ill suited to file I/O.  It is painfully slow compared
  5. to the actual speed of memory-to-disk transfers.  I have developed  this
  6. set  of  procedures  to  allow  fast  file  access from FORTRAN.  On the
  7. HP-1000F and HP-A900 these routines provide a speed increase  factor  of
  8. about  20.  On the PC the speed increase is more like 30.  It may seem a
  9. little circuitous at first to always read and  write  character  strings
  10. instead  of numbers and to call some subroutine rather than simply using
  11. "WRITE" and "READ" statements;  but once you get used to it, it isn't so
  12. bad;  and the speed is worth a little extra trouble.
  13.  
  14. As  far  as  numbers  go,  you  can  use  DEC0DE to decode them from the
  15. character strings and "WRITE(CBUF,1000)" to encode them.
  16.  
  17. I have allowed for only two  sequential  access  files  and  one  random
  18. access  file.   It's  not obvious in FORTRAN, but you can't just open an
  19. unlimited number of files.  Two has always been enough  for  me.   These
  20. procedures  are so much faster than FORTRAN you can afford to close one,
  21. open another, read what you want  from  it,  close  it,  and  then  skip
  22. through  the  first until you get to the point where you left off if you
  23. need more than two files at a time.
  24.  
  25. A word of warning about reading files created by word processors and the
  26. like...  these procedures ignore control characters on  either  read  or
  27. write  and chop-off trailing blanks on write.  Also, files must end with
  28. the standard EOF character (zero record length for HPs or SUB for  PCs).
  29. This  is  done  for you automatically by the end-file functions and most
  30. editors (at least WED and IBM's Professional Editor).  If you  create  a
  31. file  using  FORTRAN on the PC WITHOUT these procedures and then attempt
  32. to read it WITH these procedures you will get trash at  the  end  unless
  33. you  put  a  CHAR(26)  on the last line (A1 format) before you close the
  34. file.
  35. .pa
  36.                 QUICK LIST OF FILE HANDLING SUBROUTINES
  37.  
  38. GETPSP: get the program segment prefix (PC only - on HP use GETST)
  39. RRPAR:  get file name from runtime string
  40. ECLOS:  close random access file
  41. EOPEN:  open random access file
  42. EREAD:  read random access file
  43. EWRIT:  write random access file
  44. FBKSP1: backspace first sequential access file
  45. FBKSP2: backspace second sequential access file
  46. FCLOS1: close first sequential access file
  47. FCLOS2: close second sequential access file
  48. FENDF1: end (affix EOF marker to) first sequential access file
  49. FENDF2: end (affix EOF marker to) second sequential access file
  50. FOPEN1: open first sequential access file
  51. FOPEN2: open second sequential access file
  52. FREAD1: read first sequential access file
  53. FREAD2: read second sequential access file
  54. FRWND1: rewind first sequential access file
  55. FRWND2: rewind second sequential access file
  56. FWRIT1: write first sequential access file
  57. FWRIT2: write second sequential access file
  58. .pa
  59. NAME:     GETPSP
  60. PURPOSE:  get the program segment prefix (PC only - on HP use GETST)
  61. TYPE:     subroutine (far external)
  62. SYNTAX:   CALL GETPSP(PSP)
  63. INPUT:    none
  64. OUTPUT:   PSP (CHARACTER*1 PSP(128))
  65. NOTE:     This seems like a logical thing to want; but to actually find
  66.           the PSP after DOS gets through with it on the PC is no easy
  67.           task when working from inside an EXE file.
  68.  
  69.  
  70. NAME:     RRPAR
  71. PURPOSE:  get file name from runtime string
  72. TYPE:     subroutine (far external)
  73. SYNTAX:   CALL RRPAR(N,NAME)
  74. INPUT:    N (INTEGER*2) number of entry see example below
  75. OUTPUT:   NAME (CHARACTER*12)
  76. NOTE:     the purpose of this is to fetch and parse the string that you
  77.           type in after the name of your program as below
  78.  
  79.                MYPROG this.dat that.for other.bin wednesday
  80.  
  81.           fetch the names with the following
  82.  
  83.                CHARACTER NAME1*12,NAME2*12,NAME3*12,COMMENT*12
  84.                CALL RRPAR(1,NAME1)
  85.                CALL RRPAR(2,NAME2)
  86.                CALL RRPAR(3,NAME3)
  87.                CALL RRPAR(4,COMMENT)
  88.  
  89.           you will get the following
  90.  
  91.                NAME1='this.dat'
  92.                NAME2='that.for'
  93.                NAME3='other.bin'
  94.                COMMENT='wednesday'
  95.  
  96.  
  97. NAME:     ECLOS
  98. PURPOSE:  close random access file
  99. TYPE:     subroutine (far external)
  100. SYNTAX:   CALL ECLOS
  101. INPUT:    none
  102. OUTPUT:   none
  103.  
  104.  
  105. NAME:     EOPEN
  106. PURPOSE:  open random access file
  107. TYPE:     subroutine (far external)
  108. SYNTAX:   CALL EOPEN(NAME,NEW,LREC,IERR)
  109. INPUT:    NAME (CHARACTER*? up to 64 including drive and path)
  110.           NEW (INTEGER*2) NEW<0 means 'old', NEW=0 means 'unknown'
  111.           NEW>0 means 'new' (note that Microsoft hasn't yet learned what
  112.           'new', 'old', and 'unknown' mean.  'New' means make one and if
  113.           it already exists return an error.  'Old' means open it and if
  114.           it doesn't already exist return an error. 'Unknown' means open
  115.           it and create it if necessary.)
  116.           LREC (INTEGER*2) record length in bytes
  117. OUTPUT:   IERR (INTEGER*2) error indicator (IER=0 is normal)
  118.  
  119.  
  120. NAME:     EREAD
  121. PURPOSE:  read random access file
  122. TYPE:     subroutine (far external)
  123. SYNTAX:   CALL EREAD(CBUF,NREC,IERR)
  124. INPUT:    NREC (INTEGER*2) desired record number
  125. OUTPUT:   CBUF (CHARACTER*LREC see EOPEN) buffer
  126.           IERR (INTEGER*2) error indicator (IER=0 is normal)
  127.  
  128.  
  129. NAME:     EWRIT
  130. PURPOSE:  write random access file
  131. TYPE:     subroutine (far external)
  132. SYNTAX:   CALL EWRIT(CBUF,NREC,IERR)
  133. INPUT:    CBUF (CHARACTER*LREC see EOPEN) buffer
  134.           NREC (INTEGER*2) desired record number
  135. OUTPUT:   IERR (INTEGER*2) error indicator (IER=0 is normal)
  136.  
  137.  
  138. NAME:     FBKSP1
  139. PURPOSE:  backspace first sequential access file
  140. TYPE:     subroutine (far external)
  141. SYNTAX:   CALL FBKSP1(NREC)
  142. INPUT:    NREC (INTEGER*2) number of records to backspace (if NREC is
  143.           larger than the number of records read so far this will be
  144.           the same as a rewind)
  145. OUTPUT:   none
  146.  
  147.  
  148. NAME:     FCLOS1
  149. PURPOSE:  close first sequential access file
  150. TYPE:     subroutine (far external)
  151. SYNTAX:   CALL FCLOS1
  152. INPUT:    none
  153. OUTPUT:   none
  154.  
  155.  
  156. NAME:     FENDF1
  157. PURPOSE:  end (affix EOF marker to) first sequential access file
  158. TYPE:     subroutine (far external)
  159. SYNTAX:   CALL FENFD1
  160. INPUT:    none
  161. OUTPUT:   none
  162.  
  163.  
  164. NAME:     FOPEN1
  165. PURPOSE:  open first sequential access file
  166. TYPE:     subroutine (far external)
  167. SYNTAX:   CALL FOPEN1(NAME,NEW,IERR)
  168. INPUT:    NAME (CHARACTER*? up to 64 including drive and path)
  169.           NEW (INTEGER*2) NEW<0 means 'old', NEW=0 means 'unknown'
  170.           NEW>0 means 'new' (note that Microsoft hasn't yet learned what
  171.           'new', 'old', and 'unknown' mean.  'New' means make one and if
  172.           it already exists return an error.  'Old' means open it and if
  173.           it doesn't already exist return an error. 'Unknown' means open
  174.           it and create it if necessary.)
  175. OUTPUT:   IERR (INTEGER*2) error indicator (IER=0 is normal)
  176.  
  177.  
  178. NAME:     FREAD1
  179. PURPOSE:  read first sequential access file
  180. TYPE:     subroutine (far external)
  181. SYNTAX:   CALL FREAD1(CBUF,NBUF,LREC,IERR,IEND)
  182. INPUT:    NBUF (INTEGER*2) number of bytes in CBUF
  183. OUTPUT:   CBUF (CHARACTER*?) buffer
  184.           LREC (INTEGER*2) nominal record length
  185.           IERR (INTEGER*2) error indicator (IERR=0 is normal)
  186.           IEND (INTEGER*2) EOF indicator (IEND=0 is normal)
  187.  
  188.  
  189. NAME:     FWRIT1
  190. PURPOSE:  write first sequential access file
  191. TYPE:     subroutine (far external)
  192. SYNTAX:   CALL FWRIT1(CBUF,NBUF,IERR)
  193. INPUT:    CBUF (CHARACTER*?) buffer
  194.           NBUF (INTEGER*2) number of bytes in CBUF
  195. OUTPUT:   IERR (INTEGER*2) error indicator (IERR=0 is normal)
  196.  
  197.  
  198. NAME:     FRWND1
  199. PURPOSE:  rewind first sequential access file
  200. TYPE:     subroutine (far external)
  201. SYNTAX:   CALL FRWND1
  202. INPUT:    none
  203. OUTPUT:   none
  204. .pa
  205.                      EXAMPLE USING FILE PROCEDURES
  206.  
  207.  
  208.       PROGRAM EXMPL
  209. C
  210. C  IN THIS EXAMPLE ONE FILE WILL BE COPIED INTO ANOTHER
  211. C
  212.       IMPLICIT INTEGER*2 (I-N)
  213.       CHARACTER CBUF*80,INFILE*12,OUTFILE*12,ANS
  214.       DATA LINES/0/
  215. C
  216.       CALL ERASE
  217.       CALL WRTTY('EXMPL/V1.0: example using file procedures<')
  218.       CALL WRTTY(' (copying one file into another)<')
  219. C
  220. C  FETCH FILE NAMES FROM RUNTIME STRING
  221. C
  222.       CALL RRPAR(1,INFILE)
  223.       CALL RRPAR(2,OUTFILE)
  224. C
  225. C  CHECK FOR MISSING FILE NAMES
  226. C
  227.       IF(INFILE.NE.' '.AND.OUTFILE.NE.' ') GO TO 100
  228.       CALL WRTTY('missing file names... try something like<')
  229.       CALL WRTTY(' EXMPL infile outfile<')
  230.       GO TO 999
  231. C
  232. C  OPEN INFILE (NOTE: NEW='-1')
  233. C
  234.   100 CALL FOPEN1(INFILE,-1,IERR)
  235.       IF(IERR.EQ.0) GO TO 110
  236.       CALL WRTTY('unable to access infile<')
  237.       GO TO 999
  238. C
  239. C  OPEN OUTFILE, FIRST CHECK FOR ALREADY EXIST (NOTE: NEW=-1)
  240. C  IF YOU DON'T CARE TO CHECK FOR OVERWRITE JUST SET NEW=0
  241. C
  242.   110 CALL FOPEN2(OUTFILE,-1,IERR)
  243.       IF(IERR.NE.0) GO TO 120
  244. C
  245.   111 CALL WRTTY('outfile already exists... overwrite?(Y/N)_')
  246.       CALL READ1(ANS)
  247.       IF(ANS.EQ.'Y') GO TO 112
  248.       IF(ANS.EQ.'N') GO TO 900
  249.       CALL BEEP
  250.       CALL CLEAR1
  251.       GO TO 111
  252. C
  253.   112 CALL CLEAR1
  254. C
  255. C  OPEN OUTFILE, CREATE (NOTE: NEW=1)
  256. C
  257.   120 CALL FOPEN2(OUTFILE,1,IERR)
  258.       IF(IERR.EQ.0) GO TO 200
  259.       CALL WRTTY('unable to access outfile<')
  260.       GO TO 900
  261. C
  262. C  READ INFILE
  263. C
  264.   200 CALL FREAD1(CBUF,80,LREC,IERR,IEND)
  265.       IF(IERR.NE.0) GO TO 400
  266.       IF(IEND.NE.0) GO TO 300
  267.       LINES=LINES+1
  268. C
  269. C  COPY TO OUTFILE
  270. C
  271.       CALL FWRIT2(CBUF,LREC,IERR)
  272.       IF(IERR.NE.0) GO TO 500
  273.       GO TO 200
  274. C
  275. C  END OUTFILE
  276. C
  277.   300 CALL FENDF2
  278.       WRITE(CBUF,3000) LINES
  279.  3000 FORMAT('lines copied ',I5,'<')
  280.       CALL WRTTY(CBUF)
  281.       GO TO 900
  282. C
  283. C  READ ERROR
  284. C
  285.   400 WRITE(CBUF,4000) LINES
  286.  4000 FORMAT('infile read error at line ',I5,'<')
  287.       CALL WRTTY(CBUF)
  288.       GO TO 900
  289. C
  290. C  WRITE ERROR
  291. C
  292.   500 WRITE(CBUF,5000) LINES
  293.  5000 FORMAT('outfile write error at line ',I5,'<')
  294.       CALL WRTTY(CBUF)
  295. C
  296. C  CLOSE FILES
  297. C
  298.   900 CALL FCLOS2
  299.       CALL FCLOS1
  300.       STOP
  301.       END
  302.