Time: Wed Jul 16 20:16:54 1997
	by primenet.com (8.8.5/8.8.5) with ESMTP id UAA26874
	for [address in tool bar]; Wed, 16 Jul 1997 20:15:16 -0700 (MST)
	by usr08.primenet.com (8.8.5/8.8.5) with SMTP id UAA06659;
	Wed, 16 Jul 1997 20:12:34 -0700 (MST)
Date: Wed, 16 Jul 1997 20:12:09 -0700
To: (Recipient list suppressed)
From: Paul Andrew Mitchell [address in tool bar]
Subject: SLS: software software software

If anybody should ask, here's the code which
accelerated FORTRAN binary input/output by
a factor of 20-to-1 over factory compiler
statements.  Bill Gates, are you listening,
or have you forgotten about efficiency too?


      SUBROUTINE FASTO(FUNIT,IBUF,LENGTH,CODE)
C
C     Writes LENGTH 16-bit words to file unit FUNIT,
C     from contiguous array IBUF, returning error CODE;
C     crosses segment boundaries as needed and
C     accommodates the PRWF$$ transmission limit by
C     breaking IBUF into sub-arrays that honor both limits.
C
C     FASTO performs raw memory transfers to disk, crossing
C     segment boundaries as needed, and making 2 CALLs to PRWF$$
C     for full segment transfers.  The quantity argument to
C     PRWF$$ is an UNsigned 16-bit integer, the maximum value
C     of which is 65,535.  But, a full segment has 65,536 words,
C     or one more than the maximum that can be transferred
C     per CALL to PRWF$$.  So, 2 separate CALLs are made to
C     PRWF$$ when an entire segment must be transferred.
C     Each CALL transfers at most a half-segment, or 32,768 words
C     (32 pages of virtual memory).  FASTO steps through the
C     user's array, honoring segment boundaries and the PRWF$$
C     limit, writing "chunks" of 32 pages in size (or less)
C     until the entire array is transferred to disk.  The distance
C     to the first segment boundary is computed by obtaining the
C     segment/word number pair from LOC, in virtual address format.
C     Thus, the first address in a segment has word number 0.
C     The number of words to the next segment boundary is computed
C     by the statement NSEG = 065536 - WORDNO, where WORDNO is zero
C     and NSEG = 65536, a full segment.  Subsequent segment
C     boundaries are computed mathematically as offsets from the
C     first one.
C
$INSERT SYSCOM>KEYS.FTN  /* file system keys
$INSERT SYSCOM>ERRD.FTN  /* return codes
C
C     DECLARE VARIABLES
      INTEGER*4 LENGTH, IADD, NLEFT, LOC, NSEG, NWORDS, INTL,
     &          WORDNO, FULLSG, HALFSG, RT
      INTEGER*2 FUNIT, IBUF(LENGTH), CODE, NW, IWORD(2), NWRITE, INTS
      INTRINSIC LOC, INTL, INTS, RT
      EQUIVALENCE (NWORDS, IWORD(1)), (NW, IWORD(2))
      EXTERNAL PRWF$$, ERRPR$
C
C     DECLARE CONSTANTS
      PARAMETER FULLSG = 065536    /* 32-bit integer constant
      PARAMETER HALFSG = FULLSG/2  /* 32-bit integer constant
C
C
C     INITIALIZE
      CODE = E$NULL /* initialize error code
C
C     CHECK LENGTH ARGUMENT
      IF(LENGTH.GT.0) GO TO 5
C
C        REPORT ERROR
         WRITE(1,1001) LENGTH, FUNIT  /* report error
 1001    FORMAT('LENGTH argument of ',I12,' is invalid '/
     &          'calling FASTO on file unit ',I3)
         RETURN
C
C     INITIALIZE WORDS REMAINING TO WRITE
    5 NLEFT = LENGTH
C
C     GET STARTING VIRTUAL ADDRESS (segment number | word number)
      IADD = LOC(IBUF(1))
C
C     TRUNCATE SEGMENT NUMBER
   10 WORDNO = RT(IADD,INTS(16))
C
C     COMPUTE WORD COUNT TO NEXT SEGMENT BOUNDARY
      NSEG = FULLSG - WORDNO
C
C     DO SPECIAL CASE OF FULL SEGMENT TRANSMISSION (2 CALLS @ 1/2 SEG)
C     OTHERWISE, IT IS A PARTIAL SEGMENT (ONLY 1 CALL @ FULL SEG)
      IF(WORDNO.EQ.0.AND.NLEFT.GE.FULLSG) NSEG = HALFSG
C
C     COMPUTE CHUNK SIZE
      NWORDS = NLEFT  /* "chunk" size to transmit
C
C     STAY WITHIN SEGMENT (DON'T CROSS SEGMENT BOUNDARY)
      IF(NWORDS.GT.NSEG) NWORDS = NSEG
C
C     CALL PRIMOS OUTPUT ROUTINE ON FILE UNIT "FUNIT"
C     "NW" IS UNSIGNED 16-BIT INTEGER WORD COUNT
      CALL PRWF$$(K$WRIT,FUNIT,IADD,NW,INTL(0),NWRITE,CODE)
C
C     CHECK FOR ERROR
      IF(CODE.EQ.0) GO TO 20
C
C        REPORT PRIMOS ERROR MESSAGE; RETURN THE ERROR CODE
         CALL ERRPR$(K$IRTN,CODE,'in FASTO',INTS(8),'PRWF$$',INTS(6))
         RETURN
C
C     DECREMENT NUMBER OF WORDS REMAINING
   20 NLEFT = NLEFT - NWORDS
C
C     CHECK IF DONE
      IF(NLEFT.EQ.0) RETURN
C
C     CHECK FOR NEGATIVE ERROR
      IF(NLEFT.GT.0) GO TO 30
C
C        REPORT ERROR
         WRITE(1,1002) NLEFT
 1002    FORMAT('invalid NLEFT of ',I12,' calling FASTO')
         CODE = E$NULL
         RETURN
C
C     UPDATE VIRTUAL ADDRESS POINTER
   30 IADD = IADD + NWORDS  /* new 32-bit virtual address
C
C     DO NEXT ARRAY SUBSET
      GO TO 10
      END 


========================================================================
Paul Andrew Mitchell                 : Counselor at Law, federal witness
B.A., Political Science, UCLA;  M.S., Public Administration, U.C. Irvine

tel:     (520) 320-1514: machine; fax: (520) 320-1256: 24-hour/day-night
email:   [address in tool bar]       : using Eudora Pro 3.0.3 on 586 CPU
website: http://www.supremelaw.com   : visit the Supreme Law Library now
ship to: c/o 2509 N. Campbell, #1776 : this is free speech,  at its best
             Tucson, Arizona state   : state zone,  not the federal zone
             Postal Zone 85719/tdc   : USPS delays first class  w/o this

As agents of the Most High, we came here to establish justice.  We shall
not leave, until our mission is accomplished and justice reigns eternal.
========================================================================
[This text formatted on-screen in Courier 11, non-proportional spacing.]

      


Return to Table of Contents for

Supreme Law School:   E-mail