1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
|
SUBROUTINE DUMP(ZLIST,FILE,RECNUM,IWRDOFF,NWORDS)
C
C THIS ROUTINE IS A DEPENDENT OF PUTLST AND PERFORMS THE
C REQUIRED LOGIC TO WRITE A DIRECT ACCESS RECORD. IT IS
C EITHER WRITTEN TO THE CACHE AREA OR TO DISK.
C
CEND
C
C SG 6/5/96 If a full record is being written, do not copy it to the cache.
C
IMPLICIT INTEGER (A-Z)
DIMENSION ZLIST(1)
COMMON // ICORE(1)
COMMON /IOPOS/ ICRSIZ,ICHCSZ,IOFF(2),LENREC
COMMON /MACHSP/ IINTLN,IFLTLN,IINTFP,IALONE,IBITWD
COMMON /MACHSP2/ MASK1,MASK2,ISHFSZ
COMMON /CACHE/ CACHNUM,CACHNMP1,CACHDIR(100),CACHPOS(100),
& CACHFILE(100),CACHMOD(100),OLDEST
COMMON /FILSPC/ ILNBUF,IPRCLN,IPRCWD
cjp
cjp just for info for printout
#include "bwcc.com"
C
IPACK(I,J)=IOR(J,ISHFT(I-49,ISHFSZ))
UPACKR(I) =IAND(I,MASK1)
UPACKF(I) =IAND(ISHFT(I,-ISHFSZ),MASK2)+49
C
C CHECK TO SEE IF THE RECORD IS IN THE CACHE. IF IT IS, IIEQ WILL
C RETURN A VALUE IN THE RANGE 1-CACHNUM.
C
ITEST=IPACK(FILE,RECNUM)
ILOC=IIEQ(CACHNUM,CACHDIR,1,ITEST)
C IF THE CORRECT RECORD (FILE MUST MATCH AS WELL) IS IN THE CACHE,
C THE JUST COPY ZLIST TO IT AND LEAVE, BUT SET THE MODIFICATION
C FLAG FIRST.
C
IF(ILOC.NE.0)THEN
IADR=CACHPOS(ILOC)
IPOS=IADR+IWRDOFF-1
cjp debug
if(bwgossip) write(6,*) 'DUMP: cache hit!'
CALL ICOPY(NWORDS,ZLIST,1,ICORE(IPOS),1)
CACHMOD(ILOC)=1
ELSEIF (NWORDS .EQ. LENREC) THEN
CALL ACES_IO_WRITE(FILE,RECNUM,ZLIST,LENREC)
ELSE
C
C THE RECORD MUST BE PICKED UP FROM DISK. DUMP OLDEST SURVIVING RECORD
C TO DISK IF IT HAS BEEN MODIFIED. OTHERWISE, COPY OVER IT AND THEN
C PUT INFORMATION OVER IT.
C
IF(CACHMOD(OLDEST).NE.0)THEN
IADR=CACHPOS(OLDEST)
FILEOUT=UPACKF(CACHDIR(OLDEST))
RECWRT=UPACKR(CACHDIR(OLDEST))
CALL ACES_IO_WRITE(FILEOUT,RECWRT,ICORE(CACHPOS(OLDEST)),LENREC)
ENDIF
CALL ACES_IO_READ(FILE,RECNUM,ICORE(CACHPOS(OLDEST)),LENREC)
CACHFILE(OLDEST)=FILE
CACHDIR (OLDEST)=IPACK(FILE,RECNUM)
IPOS=CACHPOS(OLDEST)+IWRDOFF-1
CALL ICOPY(NWORDS,ZLIST,1,ICORE(IPOS),1)
CACHMOD(OLDEST)=1
OLDEST=OLDEST+1
IF(OLDEST.GT.CACHNUM)OLDEST=1
ENDIF
C
cjp
cjp for debug purposes in order to identify exactly, when some
cjp modifications of files occured, switch off caching mechanism
cjp by flushing caches immediatelly
cjp call aces_cache_flush
RETURN
END
|
