         << LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION >>     00000001
   DEFINE D'L             =   DOUBLE(LOGICAL#;                 <<c9392>>00190100
                                                               <<c9392>>00190200
            M328          =  328,                              <<c9392>>00250000
            M279          =  279;                              <<c9392>>00251000
                                                               <<c9392>>00910100
<< DIRECTORY CACHE EQUATES/DEFINES >>                          <<c9392>>00910120
                                                               <<c9392>>00910140
EQUATE                                                         <<c9392>>00910160
   DCCTL'INIT       = 0,                                       <<c9392>>00910180
   DCCTL'ENABLE     = 1,                                       <<c9392>>00910200
   DCCTL'DISABLE    = 2,                                       <<c9392>>00910220
   DCCTL'INTEGON    = 3,                                       <<c9392>>00910240
   DCCTL'INTEGOFF   = 4,                                       <<c9392>>00910260
   DCCTL'FLUSH      = 5,                                       <<c9392>>00910280
   DCCTL'CLOSE      = 6;                                       <<c9392>>00910300
DEFINE                                                         <<c9392>>00910320
   DIRCACDST        = ABSOLUTE(%1426)#;                        <<c9392>>00910340
INTEGER ARRAY                                                  <<c9392>>00910360
   DC'TBL(*)        = DB+0;                                    <<c9392>>00910380
<< HEADER ENTRY >>                                             <<c9392>>00910400
LOGICAL                                                        <<c9392>>00910420
   DC'SIZE          = DB+0,                                    <<c9392>>00910440
   DC'DISABLED      = DB+1,                                    <<c9392>>00910460
   DC'INTEGRITY     = DB+2;                                    <<c9392>>00910480
DOUBLE                                                         <<c9392>>00910500
   DC'TOTACC        = DB+%10,                                  <<c9392>>00910520
   DC'HITS          = DB+%12,                                  <<c9392>>00910540
   DC'PHYIOS        = DB+%14,                                  <<c9392>>00910560
   DC'PHYWRTS       = DB+%16;                                  <<c9392>>00910580
<< CACHE ENTRY TABLE >>                                        <<c9392>>00910600
EQUATE                                                         <<c9392>>00910620
   DC'NRENTS        = 10,                                      <<c9392>>00910640
   DC'ENTSIZE       = 4,                                       <<c9392>>00910660
   DC'ENTTABSIZE    = DC'NRENTS * DC'ENTSIZE;                  <<c9392>>00910680
INTEGER ARRAY                                                  <<c9392>>00910700
   DC'FIRSTENTRY(*) = DB+%20;                                  <<c9392>>00910720
DEFINE                                                         <<c9392>>00910740
   DC'DIRPNTR       = CACENT#,                                 <<c9392>>00910760
   DC'BUFPTR        = CACENT(1)#,                              <<c9392>>00910780
   DC'BUFSIZE       = CACENT(2)#,                              <<c9392>>00910800
   DC'DIRTY         = CACENTL(3)#;                             <<c9392>>00910820
<< BUFFER AREA >>                                              <<c9392>>00910840
EQUATE                                                         <<c9392>>00910860
   DC'BUFFAREA      = %100;                                    <<c9392>>00910880
                                                               <<c9392>>00910900
                                                               <<F9415>>00911100
<< DISC FREE SPACE CACHE EQUATES/DEFINES >>                    <<F9415>>00911110
                                                               <<F9415>>00911120
EQUATE                                                         <<F9415>>00911130
   DSCTL'INIT       = 0,                                       <<F9415>>00911140
   DSCTL'ENABLE     = 1,                                       <<F9415>>00911150
   DSCTL'DISABLE    = 2,                                       <<F9415>>00911160
   DSCTL'INTEGON    = 3,                                       <<F9415>>00911170
   DSCTL'INTEGOFF   = 4,                                       <<F9415>>00911180
   DSCTL'FLUSH      = 5,                                       <<F9415>>00911190
   DSCTL'CLOSE      = 6;                                       <<F9415>>00911200
DEFINE                                                         <<F9415>>00911210
   DFSCACDST        = ABSOLUTE(%1427)#;                        <<F9415>>00911220
INTEGER ARRAY                                                  <<F9415>>00911230
   FC'TBL(*)        = DB+0;                                    <<F9415>>00911240
<< HEADER ENTRY >>                                             <<F9415>>00911250
EQUATE                                                         <<F9415>>00911260
   FC'HDRSIZE       = %20;                                     <<F9415>>00911270
INTEGER                                                        <<F9415>>00911280
   FC'SIZE          = DB+0,                                    <<F9415>>00911290
   FC'ENTRIES       = DB+1;                                    <<F9415>>00911300
LOGICAL                                                        <<F9415>>00911310
   FC'DISABLED      = DB+2,                                    <<F9415>>00911320
   FC'INTEGRITY     = DB+3;                                    <<F9415>>00911330
INTEGER ARRAY                                                  <<F9415>>00911340
   FC'ENTAREA(@)    = DB+4,                                    <<F9415>>00911350
   FC'BUFAREA(@)    = DB+5;                                    <<F9415>>00911360
INTEGER                                                        <<F9415>>00911370
   FC'HEADP         = DB+6,                                    <<F9415>>00911380
   FC'TAILP         = DB+7;                                    <<F9415>>00911390
DOUBLE                                                         <<F9415>>00911400
   FC'TOTACC        = DB+%10,                                  <<F9415>>00911410
   FC'HITS          = DB+%12,                                  <<F9415>>00911420
   FC'PHYIOS        = DB+%14,                                  <<F9415>>00911430
   FC'PHYWRTS       = DB+%16;                                  <<F9415>>00911440
<< CACHE ENTRY TABLE >>                                        <<F9415>>00911450
EQUATE                                                         <<F9415>>00911460
   FC'CACENTS       = 32,                                      <<F9415>>00911470
   FC'ENTSIZE       = 7;                                       <<F9415>>00911480
<< CACHE ENTRY FORMAT >>                                       <<F9415>>00911490
EQUATE                                                         <<F9415>>00911500
   FC'FORLDISP      = 0,                                       <<F9415>>00911510
   FC'BACKLDISP     = 1;                                       <<F9415>>00911520
DEFINE                                                         <<F9415>>00911530
   FC'FORL          = CACENT#,                                 <<F9415>>00911540
   FC'BACKL         = CACENT(1)#,                              <<F9415>>00911550
   FC'DISCADR       = CACENTD(1)#,                             <<F9415>>00911560
   FC'LDEV          = CACENT(4)#,                              <<F9415>>00911570
   FC'BUFPTR        = CACENT(5)#,                              <<F9415>>00911580
   FC'DIRTY         = CACENTL(6)#;                             <<F9415>>00911590
<< BUFFER AREA >>                                              <<F9415>>00911600
EQUATE                                                         <<F9415>>00911610
   FC'BUFSTART      = (FC'HDRSIZE+FC'CACENTS*FC'ENTSIZE+7)/8*8,<<F9415>>00911620
   FC'BUFSIZE       = 128;                                     <<F9415>>00911630
                                                               <<F9415>>00911640
INTEGER PROCEDURE DIRIO(FUNCTION,DIRPNTR,DIRBUF,WORDS,MISCWD); <<c9392>>00914100
   VALUE FUNCTION,DIRPNTR,WORDS,MISCWD;                        <<c9392>>00914200
   INTEGER FUNCTION,DIRPNTR,WORDS;                             <<c9392>>00914300
   ARRAY DIRBUF;                                               <<c9392>>00914400
   LOGICAL MISCWD;                                             <<c9392>>00914450
   OPTION FORWARD;                                             <<c9392>>00914500
                                                               <<c9392>>00914600
INTEGER PROCEDURE DIRCACHECTL( FUNCTION, PARM);                <<c9392>>00914700
   VALUE FUNCTION, PARM;                                       <<c9392>>00914800
   INTEGER FUNCTION, PARM;                                     <<c9392>>00914900
   OPTION VARIABLE, FORWARD;                                   <<c9392>>00915000
                                                               <<c9392>>00915100
PROCEDURE MFDS( BUFF, DST, OFFSET, WORDS);                     <<c9392>>01100050
   VALUE DST, OFFSET, WORDS;                                   <<c9392>>01100100
   ARRAY BUFF;                                                 <<c9392>>01100150
   INTEGER DST, OFFSET, WORDS;                                 <<c9392>>01100200
   OPTION EXTERNAL;                                            <<c9392>>01100250
                                                               <<c9392>>01100300
PROCEDURE MTDS( DST, OFFSET, BUFF, WORDS);                     <<c9392>>01100350
   VALUE DST, OFFSET, WORDS;                                   <<c9392>>01100400
   INTEGER DST, OFFSET, WORDS;                                 <<c9392>>01100450
   ARRAY BUFF;                                                 <<c9392>>01100500
   OPTION EXTERNAL;                                            <<c9392>>01100550
                                                               <<c9392>>01100600
DOUBLE PROCEDURE INITTABLE( NRENTRIES, ENTRYSIZE, WHERE,       <<c9392>>01100650
                           B32, DSTN, SYSIX);                  <<c9392>>01100700
   VALUE NRENTRIES,ENTRYSIZE,WHERE,B32,DSTN,SYSIX;             <<c9392>>01100750
   INTEGER NRENTRIES, ENTRYSIZE, WHERE, DSTN, SYSIX;           <<c9392>>01100800
   LOGICAL B32;                                                <<c9392>>01100850
   OPTION VARIABLE,EXTERNAL;                                   <<c9392>>01100900
                                                               <<c9392>>01100950
INTEGER PROCEDURE GETENTRY( DSTNR );                           <<c9392>>01101000
   VALUE DSTNR;                                                <<c9392>>01101050
   INTEGER DSTNR;                                              <<c9392>>01101100
   OPTION EXTERNAL;                                            <<c9392>>01101150
                                                               <<c9392>>01101200
PROCEDURE RETURNENTRY( DSTNR, ENTRYNR);                        <<c9392>>01101250
   VALUE DSTNR, ENTRYNR;                                       <<c9392>>01101300
   INTEGER DSTNR, ENTRYNR;                                     <<c9392>>01101350
   OPTION EXTERNAL;                                            <<c9392>>01101400
                                                               <<c9392>>01101450
PROCEDURE DISC'( FUNCTION, LDEV, DISCADR, MEMADR, WORDS);      <<F9415>>01101500
   VALUE FUNCTION, LDEV, DISCADR, MEMADR, WORDS;               <<F9415>>01101510
   INTEGER FUNCTION, LDEV, WORDS;                              <<F9415>>01101520
   DOUBLE DISCADR, MEMADR;                                     <<F9415>>01101530
   OPTION EXTERNAL;                                            <<F9415>>01101540
                                                               <<F9415>>01101550
INTEGER ERR;                                                   <<c9392>>02185000
<< REMOVE AREA FROM DIRECTROY CACHE >>                         <<c9392>>02190100
EXCHANGEDB( 0 );                                               <<c9392>>02190200
ERR := DIRCACHECTL( DCCTL'FLUSH, PNTR);                        <<c9392>>02190300
IF <> THEN ERRMESSAGE( M279, ERR);                             <<c9392>>02190400
EXCHANGEDB( DDSDST );                                          <<c9392>>02190500
                                                               <<c9392>>02190600
INTEGER ERR;                                                   <<c9392>>02369000
$EDIT VOID=02406000                                            <<c9392>>02396000
   ERR := DIRIO(WRITE,IBASE(CONTENTS),TEMPP,TEMP,BASE(MISCWD));<<c9392>>02397000
   IF <> THEN ERRMESSAGE( M279, ERR);                          <<c9392>>02398000
INTEGER ERR;                                                   <<c9392>>02427000
$EDIT VOID=02448000                                            <<c9392>>02438000
   ERR := DIRIO(READ,PNTR,TEMPP,DDSBWSIZE,EEMISCWD);           <<c9392>>02439000
   IF <> THEN ERRMESSAGE( M279, ERR);                          <<c9392>>02440000
$CONTROL SEGMENT=DIRECTORY1                                    <<c9392>>05848000
INTEGER PROCEDURE DIRCACHECTL( FUNCTION, PARM);                <<c9392>>05850000
   VALUE FUNCTION, PARM;                                       <<c9392>>05852000
   INTEGER FUNCTION, PARM;                                     <<c9392>>05854000
   OPTION VARIABLE;                                            <<c9392>>05856000
BEGIN                                                          <<c9392>>05858000
   COMMENT                                                     <<c9392>>05860000
                                                               <<c9392>>05862000
   FUNCTION  PARM      DESCRIPTION                             <<c9392>>05864000
      0      none      Initialize cache data segment           <<c9392>>05866000
      1      none      Enable caching                          <<c9392>>05868000
      2      none      Disable caching                         <<c9392>>05870000
      3      none      Set integrity on.                       <<c9392>>05872000
      4      none      Set integrity off.                      <<c9392>>05874000
      5      none      Flush entire cache.                     <<c9392>>05876000
             Dir pntr  Flush cache buffer with this            <<c9392>>05878000
                       Directory pointer.                      <<c9392>>05880000
      6      none      Close caching.                          <<c9392>>05882000
                                                               <<c9392>>05884000
   DB MUST be at the stack upon entry.                         <<c9392>>05886000
                                                               <<c9392>>05888000
   RETURNS:                                                    <<c9392>>05890000
      CCE - OK      (function has previous state)              <<c9392>>05892000
      CCL - FAILURE (function has error number)                <<c9392>>05894000
                                                               <<c9392>>05896000
   ERROR CODES:                                                <<c9392>>05898000
      #1   Call to DIRCACHECTL before data segment             <<c9392>>05900000
           initialized.                                        <<c9392>>05902000
      #2   Call to DIRCACHECTL to initialize when data         <<c9392>>05904000
           segment already created.                            <<c9392>>05906000
                                                               <<c9392>>05908000
   Initialize cache data segment                               <<c9392>>05910000
      After initialiation caching will be enabled with         <<c9392>>05912000
      integrity on.                                            <<c9392>>05914000
   Enable caching                                              <<c9392>>05916000
   Disable caching                                             <<c9392>>05918000
      The cache will first be flushed and then disabled.       <<c9392>>05920000
   Set integrity on                                            <<c9392>>05922000
      The cache will first be flushed and thereafter a         <<c9392>>05924000
      write to the cache will result in also a write           <<c9392>>05926000
      to the disc.                                             <<c9392>>05928000
   Set integrity off                                           <<c9392>>05930000
      A write to the cache will not result in a write          <<c9392>>05932000
      to the disc.  Blocks will only be writtern to the        <<c9392>>05934000
      disc when a block replacement is required.               <<c9392>>05936000
      Uses:                                                    <<c9392>>05938000
         Reload - there is no need to keep the directory       <<c9392>>05940000
                  current since the only option for a          <<c9392>>05942000
                  failed reload is another reload.             <<c9392>>05944000
         Recover lost disc space.                              <<c9392>>05946000
         Reseting use counts in the directory                  <<c9392>>05948000
   Flush cache                                                 <<c9392>>05950000
      If a parameter is passed, only the block with that       <<c9392>>05952000
      directory pointer is flushed.  Otherwise the entire      <<c9392>>05954000
      cache is flushed.                                        <<c9392>>05956000
   Close cache                                                 <<c9392>>05958000
      The cache is flushed and the cache data segment          <<c9392>>05960000
      returned.  After this function will be neccessary        <<c9392>>05962000
      to do another initialize cache to start caching          <<c9392>>05964000
      again.                                                   <<c9392>>05966000
;                                                              <<c9392>>05968000
                                                               <<c9392>>05970000
   EQUATE                                                      <<c9392>>05972000
      ACCTINXSIZE   = SYSSAIBSIZE  * 128,                      <<c9392>>05974000
      USERINXSIZE   = %600,               << VARIABLE SIZE >>  <<G9487>>05976000
      GROUPINXSIZE  = %600,               << VARIABLE SIZE >>  <<G9487>>05978000
      FILEINXSIZE   = SYSGFIBSIZE  * 128,                      <<c9392>>05980000
      VSINXSIZE     = SYSGVSIBSIZE * 128,                      <<c9392>>05982000
      ACCTENTSIZE   = SYSAEBSIZE   * 128,                      <<c9392>>05984000
      USERENTSIZE   = SYSUEBSIZE   * 128,                      <<c9392>>05986000
      GROUPENTSIZE  = SYSGEBSIZE   * 128,                      <<c9392>>05988000
      FILEENTSIZE   = SYSFEBSIZE   * 128,                      <<c9392>>05990000
      VSENTSIZE     = SYSVSEBSIZE  * 128;                      <<c9392>>05992000
   INTEGER ARRAY ENTRYSIZES( *) = PB :=                        <<c9392>>05994000
      << 0 >> FILEINXSIZE,      << 1 >> FILEENTSIZE,           <<c9392>>05996000
      << 2 >> GROUPINXSIZE,     << 3 >> GROUPENTSIZE,          <<c9392>>05998000
      << 4 >> ACCTINXSIZE,      << 5 >> ACCTENTSIZE,           <<c9392>>06000000
      << 6 >> USERINXSIZE,      << 7 >> USERENTSIZE,           <<c9392>>06002000
      << 8 >> VSINXSIZE,        << 9 >> VSENTSIZE;             <<c9392>>06004000
   EQUATE                                                      <<c9392>>06006000
      DSEGSIZE = FILEINXSIZE+FILEENTSIZE+GROUPINXSIZE+         <<c9392>>06008000
                 GROUPENTSIZE+USERINXSIZE+USERENTSIZE+         <<c9392>>06010000
                 ACCTINXSIZE+ACCTENTSIZE+VSINXSIZE+            <<c9392>>06012000
                 VSENTSIZE+DC'BUFFAREA,                        <<c9392>>06014000
      DSTDSTN   = 2;                                           <<c9392>>06016000
   LOGICAL                                                     <<c9392>>06018000
      MASK      = Q-4;      << OPTION VARIABLE MASK >>         <<c9392>>06020000
   INTEGER                                                     <<c9392>>06022000
      ERROR     = DIRCACHECTL,                                 <<c9392>>06024000
      NEXTADR,                                                 <<c9392>>06026000
      I;                                                       <<c9392>>06028000
   DOUBLE                                                      <<c9392>>06030000
      DIRBASE';                                                <<c9392>>06032000
   INTEGER POINTER                                             <<c9392>>06034000
      CACENT;                                                  <<c9392>>06036000
   LOGICAL POINTER                                             <<c9392>>06038000
      CACENTL   = CACENT;                                      <<c9392>>06040000
                                                               <<c9392>>06042000
   CC := CCL;   << ASSUME THE WORST >>                         <<c9392>>06044000
                                                               <<c9392>>06046000
   IF FUNCTION <> 0 AND DIRCACDST = 0 THEN                     <<c9392>>06048000
      BEGIN                                                    <<c9392>>06050000
      ERROR := 1;  << CALL BEFORE INITIALIZATION >>            <<c9392>>06052000
      RETURN;                                                  <<c9392>>06054000
      END;                                                     <<c9392>>06056000
                                                               <<c9392>>06058000
   CASE FUNCTION OF                                            <<c9392>>06060000
      BEGIN                                                    <<c9392>>06062000
                                                               <<c9392>>06064000
<<0>> BEGIN   << INITIALIZE CACHEING >>                        <<c9392>>06066000
      IF DIRCACDST <> 0 THEN                                   <<c9392>>06068000
         BEGIN                                                 <<c9392>>06070000
         ERROR := 2;  << ALREADY INITIALIZED >>                <<c9392>>06072000
         RETURN;                                               <<c9392>>06074000
         END;                                                  <<c9392>>06076000
      DIRCACDST := GETENTRY( DSTDSTN);                         <<c9392>>06078000
      DIRCACHECTL := DIRCACDST;                                <<c9392>>06080000
      INITTABLE(DSEGSIZE,1,4,FALSE,DIRCACDST); << TEMP SPACE >><<c9392>>06082000
      EXCHANGEDB( DIRCACDST);                                  <<c9392>>06084000
      << BUILD HEADER >>                                       <<c9392>>06086000
      DC'SIZE := DSEGSIZE;                                     <<c9392>>06088000
      DC'DISABLED := FALSE;                                    <<c9392>>06090000
      DC'INTEGRITY := TRUE;                                    <<c9392>>06092000
      NEXTADR := DC'BUFFAREA;                                  <<c9392>>06094000
      << BUILD BUFFER PTRS; OPEN INDEX/ENTRY BUFFERS >>        <<c9392>>06096000
      I := 0;                                                  <<c9392>>06098000
      DO BEGIN                                                 <<c9392>>06100000
         @CACENT := @DC'FIRSTENTRY( I*DC'ENTSIZE );            <<c9392>>06102000
         DC'DIRPNTR := -1;                                     <<c9392>>06104000
         DC'BUFPTR := NEXTADR;                                 <<c9392>>06106000
         DC'BUFSIZE := ENTRYSIZES( I );                        <<c9392>>06108000
         DC'DIRTY := FALSE;                                    <<c9392>>06110000
         NEXTADR := NEXTADR + ENTRYSIZES( I );                 <<c9392>>06112000
         END                                                   <<c9392>>06114000
      UNTIL (I:=I+1) = DC'NRENTS;                              <<c9392>>06116000
      EXCHANGEDB( 0 );                                         <<c9392>>06118000
      END;                                                     <<c9392>>06120000
                                                               <<c9392>>06122000
<<1>> BEGIN   << ENABLE CACHE >>                               <<c9392>>06124000
      EXCHANGEDB( DIRCACDST );                                 <<c9392>>06126000
      DIRCACHECTL := DC'DISABLED;                              <<c9392>>06128000
      DC'DISABLED := FALSE;                                    <<c9392>>06130000
      EXCHANGEDB( 0 );                                         <<c9392>>06132000
      END;                                                     <<c9392>>06134000
                                                               <<c9392>>06136000
<<2>> BEGIN   << DISABLE CACHE >>                              <<c9392>>06138000
      DIRCACHECTL( DCCTL'FLUSH );                              <<c9392>>06140000
      EXCHANGEDB( DIRCACDST );                                 <<c9392>>06142000
      DIRCACHECTL := DC'DISABLED;                              <<c9392>>06144000
      DC'DISABLED := TRUE;                                     <<c9392>>06146000
      EXCHANGEDB( 0 );                                         <<c9392>>06148000
      END;                                                     <<c9392>>06150000
                                                               <<c9392>>06152000
<<3>> BEGIN   << SET INTEGRITY ON >>                           <<c9392>>06154000
      DIRCACHECTL( DCCTL'FLUSH );                              <<c9392>>06156000
      EXCHANGEDB( DIRCACDST );                                 <<c9392>>06158000
      DIRCACHECTL := DC'INTEGRITY;                             <<c9392>>06160000
      DC'INTEGRITY := TRUE;                                    <<c9392>>06162000
      EXCHANGEDB( 0 );                                         <<c9392>>06164000
      END;                                                     <<c9392>>06166000
                                                               <<c9392>>06168000
<<4>> BEGIN   << SET INTEGRITY OFF >>                          <<c9392>>06170000
      EXCHANGEDB( DIRCACDST );                                 <<c9392>>06172000
      DIRCACHECTL := DC'INTEGRITY;                             <<c9392>>06174000
      DC'INTEGRITY := FALSE;                                   <<c9392>>06176000
      EXCHANGEDB( 0 );                                         <<c9392>>06178000
      END;                                                     <<c9392>>06180000
                                                               <<c9392>>06182000
<<5>> BEGIN   << FLUSH CACHE >>                                <<c9392>>06184000
      MFDS(DIRBASE',DDSDST,@DIRBASE,2);                        <<c9392>>06186000
      EXCHANGEDB( DIRCACDST );                                 <<c9392>>06188000
      IF MASK THEN                                             <<c9392>>06190000
         BEGIN  << FLUSH ONLY ONE ENTRY >>                     <<c9392>>06192000
         I := 0;                                               <<c9392>>06194000
         DO BEGIN                                              <<c9392>>06196000
            @CACENT := @DC'FIRSTENTRY(I);                      <<c9392>>06198000
            IF DC'DIRPNTR = PARM THEN                          <<c9392>>06200000
               BEGIN                                           <<c9392>>06202000
               IF DC'DIRTY THEN                                <<c9392>>06204000
                  BEGIN                                        <<c9392>>06206000
                  DC'TOTACC := DC'TOTACC+1D;                   <<c9392>>06208000
                  DC'PHYIOS := DC'PHYIOS+1D;                   <<c9392>>06210000
                  DC'PHYWRTS := DC'PHYWRTS+1D;                 <<c9392>>06212000
                  DIRDISC(WRITE,DIRBASE'+D'L(DC'DIRPNTR)),     <<c9392>>06214000
                     DC'TBL(DC'BUFPTR),DC'BUFSIZE);            <<c9392>>06216000
                  DC'DIRTY := FALSE;                           <<c9392>>06218000
                  END;                                         <<c9392>>06220000
               DC'DIRPNTR := -1;                               <<c9392>>06222000
               END;                                            <<c9392>>06224000
            END                                                <<c9392>>06226000
          UNTIL (I:=I+DC'ENTSIZE) = DC'ENTTABSIZE;             <<c9392>>06228000
         END                                                   <<c9392>>06230000
      ELSE                                                     <<c9392>>06232000
         BEGIN  << FLUSH ENTIRE CACHE >>                       <<c9392>>06234000
         I := 0;                                               <<c9392>>06236000
         DO BEGIN                                              <<c9392>>06238000
            @CACENT := @DC'FIRSTENTRY(I);                      <<c9392>>06240000
            IF DC'DIRTY THEN                                   <<c9392>>06242000
               BEGIN                                           <<c9392>>06244000
               DC'TOTACC := DC'TOTACC+1D;                      <<c9392>>06246000
               DC'PHYIOS := DC'PHYIOS+1D;                      <<c9392>>06248000
               DC'PHYWRTS := DC'PHYWRTS+1D;                    <<c9392>>06250000
               DIRDISC(WRITE,DIRBASE'+D'L(DC'DIRPNTR)),        <<c9392>>06252000
                  DC'TBL(DC'BUFPTR),DC'BUFSIZE);               <<c9392>>06254000
               DC'DIRTY := FALSE;                              <<c9392>>06256000
               END;                                            <<c9392>>06258000
            DC'DIRPNTR := -1;                                  <<c9392>>06260000
         END UNTIL (I:=I+DC'ENTSIZE) = DC'ENTTABSIZE;          <<c9392>>06262000
         END;                                                  <<c9392>>06264000
      EXCHANGEDB( 0 );                                         <<c9392>>06266000
      END;                                                     <<c9392>>06268000
                                                               <<c9392>>06270000
<<6>> BEGIN   << CLOSE DIRECTORY CACHE >>                      <<c9392>>06272000
      DIRCACHECTL( DCCTL'FLUSH );                              <<c9392>>06274000
      RETURNENTRY( DSTDSTN, DIRCACDST);                        <<c9392>>06276000
      DIRCACDST := 0;                                          <<c9392>>06278000
      END;                                                     <<c9392>>06280000
                                                               <<c9392>>06282000
      END;  << CASE >>                                         <<c9392>>06284000
                                                               <<c9392>>06286000
   CC := CCE;                                                  <<c9392>>06288000
END; << DIRCACHECTL >>                                         <<c9392>>06290000
INTEGER PROCEDURE DIRIO(FUNCTION,DIRPNTR,DIRBUF,WORDS,MISCWD); <<c9392>>06292000
   VALUE FUNCTION,DIRPNTR,WORDS,MISCWD;                        <<c9392>>06294000
   INTEGER FUNCTION,DIRPNTR,WORDS;                             <<c9392>>06296000
   ARRAY DIRBUF;                                               <<c9392>>06298000
   LOGICAL MISCWD;                                             <<c9392>>06300000
BEGIN                                                          <<c9392>>06302000
   COMMENT                                                     <<c9392>>06304000
                                                               <<c9392>>06306000
      There are 5 index types and 5 entry types.  A buffer     <<c9392>>06308000
   is provided for each making a total of 10 buffers.          <<c9392>>06310000
   This will allow us to cache the entire section of the       <<c9392>>06312000
   tree.  This is very effective, especially when scaning      <<c9392>>06314000
   the directory.  See DIRCACHECTL which controls this         <<c9392>>06316000
   operation of this procedure.                                <<c9392>>06318000
                                                               <<c9392>>06320000
   DB MUST be at the base of the directory data segment(20)    <<c9392>>06322000
   upon entry.                                                 <<c9392>>06324000
                                                               <<c9392>>06326000
   RETURNS:                                                    <<c9392>>06328000
      CCE  -  OK                                               <<c9392>>06330000
      CCL  -  FAILURE (function has error number)              <<c9392>>06332000
                                                               <<c9392>>06334000
   ERROR CODES:                                                <<c9392>>06336000
      #10   The only case the MISCWD should be zero is when    <<c9392>>06338000
            we are READING a INDEX block.                      <<c9392>>06340000
;                                                              <<c9392>>06342000
   INTEGER                                                     <<c9392>>06344000
      DDSDISP    = DIRBUF,                                     <<c9392>>06346000
      FIRSTWORD,                                               <<c9392>>06348000
      INX;                                                     <<c9392>>06350000
   DOUBLE                                                      <<c9392>>06352000
      DIRBASE',                                                <<c9392>>06354000
      DIRDISCADR;                                              <<c9392>>06356000
   INTEGER POINTER                                             <<c9392>>06358000
      CACBUF,                                                  <<c9392>>06360000
      CACENT;                                                  <<c9392>>06362000
   LOGICAL POINTER                                             <<c9392>>06364000
      CACENTL     = CACENT;                                    <<c9392>>06366000
                                                               <<c9392>>06368000
   SUBROUTINE ERROR( ERRORNR );                                <<c9392>>06370000
      VALUE ERRORNR;                                           <<c9392>>06372000
      INTEGER ERRORNR;                                         <<c9392>>06374000
   BEGIN                                                       <<c9392>>06376000
      DIRIO := ERRORNR;                                        <<c9392>>06378000
      EXCHANGEDB( DDSDST );                                    <<c9392>>06380000
      CC := CCL;                                               <<c9392>>06382000
      ASSEMBLE( EXIT 5 );                                      <<c9392>>06384000
   END;                                                        <<c9392>>06386000
                                                               <<c9392>>06388000
   LOGICAL SUBROUTINE SEARCHCACHE;                             <<c9392>>06390000
   BEGIN                                                       <<c9392>>06392000
      INX := 0;                                                <<c9392>>06394000
      DO BEGIN                                                 <<c9392>>06396000
         @CACENT := @DC'FIRSTENTRY( INX );                     <<c9392>>06398000
         IF DC'DIRPNTR = DIRPNTR THEN                          <<c9392>>06400000
            BEGIN                                              <<c9392>>06402000
            @CACBUF := DC'BUFPTR;                              <<c9392>>06404000
            SEARCHCACHE := TRUE;                               <<c9392>>06406000
            RETURN;                                            <<c9392>>06407000
            END;                                               <<c9392>>06408000
         INX := INX+DC'ENTSIZE;                                <<c9392>>06410000
         END                                                   <<c9392>>06412000
      UNTIL INX = DC'ENTTABSIZE;                               <<c9392>>06414000
   END;                                                        <<c9392>>06416000
                                                               <<c9392>>06418000
   CC := CCE;  << ASSUME THE BEST >>                           <<c9392>>06420000
   DIRBASE' := DIRBASE;                                        <<c9392>>06422000
   DIRDISCADR := DIRBASE + D'L(DIRPNTR));                      <<c9392>>06424000
   FIRSTWORD := DIRBUF;                                        <<c9392>>06426000
                                                               <<c9392>>06428000
   IF DIRCACDST = 0 THEN                                       <<c9392>>06430000
      BEGIN   << CACHE NOT INITIALIZED >>                      <<c9392>>06432000
      DIRDISC(FUNCTION,DIRDISCADR,DIRBUF,WORDS);               <<c9392>>06434000
      RETURN;                                                  <<c9392>>06436000
      END;                                                     <<c9392>>06438000
                                                               <<c9392>>06440000
   EXCHANGEDB( DIRCACDST );                                    <<c9392>>06442000
   DC'TOTACC := DC'TOTACC + 1D;                                <<c9392>>06444000
   IF DC'DISABLED THEN                                         <<c9392>>06446000
      BEGIN                                                    <<c9392>>06448000
      DC'PHYIOS := DC'PHYIOS+1D;                               <<c9392>>06450000
      IF FUNCTION = WRITE THEN DC'PHYWRTS := DC'PHYWRTS+1D;    <<c9392>>06452000
      EXCHANGEDB( DDSDST );                                    <<c9392>>06454000
      DIRDISC(FUNCTION,DIRDISCADR,DIRBUF,WORDS);               <<c9392>>06456000
      RETURN;                                                  <<c9392>>06458000
      END;                                                     <<c9392>>06460000
                                                               <<c9392>>06462000
   IF SEARCHCACHE THEN                                         <<c9392>>06464000
      BEGIN  << HIT >>                                         <<c9392>>06466000
      DC'HITS := DC'HITS + 1D;                                 <<c9392>>06468000
      IF FUNCTION = READ THEN                                  <<c9392>>06470000
         BEGIN                                                 <<c9392>>06472000
         MTDS(DDSDST,DDSDISP,CACBUF,WORDS);                    <<c9392>>06474000
         END                                                   <<c9392>>06476000
      ELSE                                                     <<c9392>>06478000
         BEGIN  << WRITE >>                                    <<c9392>>06480000
         MFDS(CACBUF,DDSDST,DDSDISP,WORDS);                    <<c9392>>06482000
         DC'DIRTY := TRUE;                                     <<c9392>>06484000
         IF DC'INTEGRITY THEN                                  <<c9392>>06486000
            BEGIN                                              <<c9392>>06488000
            DC'PHYIOS := DC'PHYIOS + 1D;                       <<c9392>>06490000
            DC'PHYWRTS := DC'PHYWRTS + 1D;                     <<c9392>>06492000
            DIRDISC(WRITE,DIRDISCADR,CACBUF,WORDS);            <<c9392>>06494000
            DC'DIRTY := FALSE;                                 <<c9392>>06496000
            END                                                <<c9392>>06498000
         END;                                                  <<c9392>>06500000
      END                                                      <<c9392>>06502000
   ELSE                                                        <<c9392>>06504000
      BEGIN  << MISS >>                                        <<c9392>>06506000
      IF FUNCTION = READ THEN                                  <<c9392>>06508000
         BEGIN                                                 <<c9392>>06510000
         DC'PHYIOS := DC'PHYIOS + 1D;                          <<c9392>>06512000
         EXCHANGEDB( DDSDST );                                 <<c9392>>06514000
         DIRDISC(READ,DIRDISCADR,DIRBUF,WORDS);                <<c9392>>06516000
         << The misc word will be zero only when we are >>     <<c9392>>06518000
         << reading an index block.  In this case we    >>     <<c9392>>06520000
         << will get the misc word from the buffer we   >>     <<c9392>>06522000
         << just read from disc.                        >>     <<c9392>>06524000
         IF MISCWD = 0 THEN                                    <<c9392>>06526000
            BEGIN                                              <<c9392>>06528000
            MISCWD := DIRBUF;                                  <<c9392>>06530000
            IF MISCWD.(TYPEF) <> INDEXTYPE THEN ERROR(10);     <<c9392>>06532000
            END;                                               <<c9392>>06534000
         EXCHANGEDB( DIRCACDST );                              <<c9392>>06536000
         END;                                                  <<c9392>>06538000
      INX := IF MISCWD.(TYPEF) = ENTRYTYPE THEN                <<c9392>>06540000
         MISCWD.(LEVELF)*2+1 ELSE MISCWD.(LEVELF)*2;           <<c9392>>06542000
      @CACENT := @DC'FIRSTENTRY(INX*DC'ENTSIZE);               <<c9392>>06544000
      @CACBUF := DC'BUFPTR;                                    <<c9392>>06546000
      IF DC'DIRTY THEN                                         <<c9392>>06548000
         BEGIN                                                 <<c9392>>06550000
         DC'PHYIOS := DC'PHYIOS + 1D;                          <<c9392>>06552000
         DC'PHYWRTS := DC'PHYWRTS + 1D;                        <<c9392>>06554000
         DIRDISC(WRITE,DIRBASE'+D'L(DC'DIRPNTR)),              <<c9392>>06556000
            DC'TBL(DC'BUFPTR),DC'BUFSIZE);                     <<c9392>>06558000
         DC'DIRTY := FALSE;                                    <<c9392>>06560000
         END;                                                  <<c9392>>06562000
      DC'DIRPNTR := DIRPNTR;                                   <<c9392>>06564000
      << WE CALUATE THE BLOCKSIZE OF THE INDEX BLOCK BECAUSE >><<G9487>>06564900
      << THE GROUP AND USER BLOCKS ARE VARIABLE IN SIZE      >><<G9487>>06564910
      IF MISCWD.(TYPEF) = INDEXTYPE THEN                       <<G9487>>06565000
         DC'BUFSIZE := MISCWD.(BSIZEF) * 128;                  <<G9487>>06565100
      MFDS(CACBUF,DDSDST,DDSDISP,DC'BUFSIZE);                  <<c9392>>06566000
      IF FUNCTION = WRITE THEN                                 <<c9392>>06568000
         BEGIN                                                 <<c9392>>06570000
         DC'DIRTY := TRUE;                                     <<c9392>>06572000
         IF DC'INTEGRITY THEN                                  <<c9392>>06574000
            BEGIN                                              <<c9392>>06576000
            DC'PHYIOS := DC'PHYIOS + 1D;                       <<c9392>>06578000
            DC'PHYWRTS := DC'PHYWRTS + 1D;                     <<c9392>>06580000
            DIRDISC(WRITE,DIRDISCADR,DC'TBL(DC'BUFPTR),WORDS); <<c9392>>06582000
            DC'DIRTY := FALSE;                                 <<c9392>>06584000
            END;                                               <<c9392>>06586000
         END;                                                  <<c9392>>06588000
      END;                                                     <<c9392>>06590000
                                                               <<c9392>>06592000
   EXCHANGEDB( DDSDST );                                       <<c9392>>06594000
END;                                                           <<c9392>>06596000
$CONTROL SEGMENT=DISCSPACE                                     <<F9415>>06598000
INTEGER PROCEDURE DFSDISC(FUNCTION,LDEV,DISCADR,BUF,WORDS);    <<F9415>>06600000
   VALUE FUNCTION,LDEV,DISCADR,WORDS;                          <<F9415>>06602000
   INTEGER FUNCTION,LDEV,WORDS;                                <<F9415>>06604000
   DOUBLE DISCADR;                                             <<F9415>>06606000
   ARRAY BUF;                                                  <<F9415>>06608000
BEGIN                                                          <<F9415>>06610000
   DOUBLE                                                      <<F9415>>06612000
      DBREG    = Q+1,                                          <<F9415>>06614000
      MEMADR   = Q+3;                                          <<F9415>>06616000
                                                               <<F9415>>06618000
   PUSH( DB );                << INITIALIZE DBREG >>           <<F9415>>06620000
   TOS := DBREG + D'L(@BUF)); << INITIALIZE MEMADR >>          <<F9415>>06622000
   TOS := ABSOLUTE( 10 );   << STACK BANK >>                   <<F9415>>06624000
   TOS := ABSOLUTE( 11 );   << STACK DB >>                     <<F9415>>06626000
   SET( DB );  << SET DB TO THE STACK >>                       <<F9415>>06628000
   DISC'(FUNCTION,LDEV,DISCADR,MEMADR,WORDS);                  <<F9415>>06630000
   TOS := DBREG;                                               <<F9415>>06632000
   SET( DB );                                                  <<F9415>>06634000
END;                                                           <<F9415>>06636000
INTEGER PROCEDURE DFSCACHECTL( FUNCTION, LDEV, DISCADR);       <<F9415>>06638000
   VALUE FUNCTION, LDEV, DISCADR;                              <<F9415>>06640000
   INTEGER FUNCTION, LDEV;                                     <<F9415>>06642000
   DOUBLE DISCADR;                                             <<F9415>>06644000
   OPTION VARIABLE;                                            <<F9415>>06646000
BEGIN                                                          <<F9415>>06648000
   COMMENT                                                     <<F9415>>06650000
                                                               <<F9415>>06652000
   FUNCTION  PARM      DESCRIPTION                             <<F9415>>06654000
      0      none      Initialize cache data segment           <<F9415>>06656000
      1      none      Enable caching                          <<F9415>>06658000
      2      none      Disable caching                         <<F9415>>06660000
      3      none      Set integrity on.                       <<F9415>>06662000
      4      none      Set integrity off.                      <<F9415>>06664000
      5      none      Flush entire cache.                     <<F9415>>06666000
             Block adr Flush cache buffer that matches         <<F9415>>06668000
                       this ldev and disc address.             <<F9415>>06670000
      6      none      Close caching.                          <<F9415>>06672000
                                                               <<F9415>>06674000
   RETURNS:                                                    <<F9415>>06676000
      CCE - OK      (function has previous state)              <<F9415>>06678000
      CCL - FAILURE (function has error number)                <<F9415>>06680000
                                                               <<F9415>>06682000
   ERROR CODES:                                                <<F9415>>06684000
      #1   Call to DFSCACHECTL before data segment             <<F9415>>06686000
           initialized.                                        <<F9415>>06688000
      #2   Call to DFSCACHECTL to initialize when data         <<F9415>>06690000
           segment already created.                            <<F9415>>06692000
                                                               <<F9415>>06694000
   Initialize cache data segment                               <<F9415>>06696000
      After initialiation caching will be enabled with         <<F9415>>06698000
      integrity on.                                            <<F9415>>06700000
   Enable caching                                              <<F9415>>06702000
   Disable caching                                             <<F9415>>06704000
      The cache will first be flushed and then disabled.       <<F9415>>06706000
   Set integrity on                                            <<F9415>>06708000
      The cache will first be flushed and thereafter a         <<F9415>>06710000
      write to the cache will result in also a write           <<F9415>>06712000
      to the disc.                                             <<F9415>>06714000
   Set integrity off                                           <<F9415>>06716000
      A write to the cache will not result in a write          <<F9415>>06718000
      to the disc.  Blocks will only be written to the         <<F9415>>06720000
      disc when a block replacement is required.               <<F9415>>06722000
      Uses:                                                    <<F9415>>06724000
         Reload - there is no need to keep the disc free       <<F9415>>06726000
                  map current since the only option for a      <<F9415>>06728000
                  failed reload is another reload.             <<F9415>>06730000
         Recover lost disc space.                              <<F9415>>06732000
   Flush cache                                                 <<F9415>>06734000
      If parameters are passed, only the block with that       <<F9415>>06736000
      ldev and disc address is flushed.  Otherwise the         <<F9415>>06738000
      entire cache is flushed.                                 <<F9415>>06740000
   Close cache                                                 <<F9415>>06742000
      The cache is flushed and the cache data segment          <<F9415>>06744000
      returned.  After this function will be neccessary        <<F9415>>06746000
      to do another initialize cache to start caching          <<F9415>>06748000
      again.                                                   <<F9415>>06750000
;                                                              <<F9415>>06752000
                                                               <<F9415>>06754000
   EQUATE                                                      <<F9415>>06756000
      DSTDSTN   = 2;                                           <<F9415>>06758000
   LOGICAL                                                     <<F9415>>06760000
      MASK      = Q-4;      << OPTION VARIABLE MASK >>         <<F9415>>06762000
   INTEGER                                                     <<F9415>>06764000
      ERROR     = DFSCACHECTL,                                 <<F9415>>06766000
      NEXTADR,                                                 <<F9415>>06768000
      INX;                                                     <<F9415>>06770000
   INTEGER POINTER                                             <<F9415>>06772000
      CACENT;                                                  <<F9415>>06774000
   LOGICAL POINTER                                             <<F9415>>06776000
      CACENTL   = CACENT;                                      <<F9415>>06778000
   DOUBLE POINTER                                              <<F9415>>06780000
      CACENTD   = CACENT;                                      <<F9415>>06782000
   EQUATE                                                      <<F9415>>06784000
      DSEGSIZE   = FC'BUFSTART + FC'CACENTS * FC'BUFSIZE;      <<F9415>>06786000
                                                               <<F9415>>06788000
   CC := CCL;   << ASSUME THE WORST >>                         <<F9415>>06790000
                                                               <<F9415>>06792000
   IF FUNCTION <> 0 AND DFSCACDST = 0 THEN                     <<F9415>>06794000
      BEGIN                                                    <<F9415>>06796000
      ERROR := 1;  << CALL BEFORE INITIALIZATION >>            <<F9415>>06798000
      RETURN;                                                  <<F9415>>06800000
      END;                                                     <<F9415>>06802000
                                                               <<F9415>>06804000
   CASE FUNCTION OF                                            <<F9415>>06806000
      BEGIN                                                    <<F9415>>06808000
                                                               <<F9415>>06810000
<<0>> BEGIN   << INITIALIZE CACHING >>                         <<F9415>>06812000
      IF DFSCACDST <> 0 THEN                                   <<F9415>>06814000
         BEGIN                                                 <<F9415>>06816000
         ERROR := 2;  << ALREADY INITIALIZED >>                <<F9415>>06818000
         RETURN;                                               <<F9415>>06820000
         END;                                                  <<F9415>>06822000
      DFSCACDST := GETENTRY( DSTDSTN);                         <<F9415>>06824000
      DFSCACHECTL := DFSCACDST;                                <<F9415>>06826000
      INITTABLE(DSEGSIZE,1,4,FALSE,DFSCACDST);                 <<T9458>>06828000
      EXCHANGEDB( DFSCACDST);                                  <<F9415>>06830000
      << BUILD HEADER >>                                       <<F9415>>06832000
      FC'SIZE := DSEGSIZE;                                     <<F9415>>06834000
      FC'ENTRIES := FC'CACENTS;                                <<F9415>>06836000
      FC'DISABLED := FALSE;                                    <<F9415>>06838000
      FC'INTEGRITY := TRUE;                                    <<F9415>>06840000
      @FC'ENTAREA := FC'HDRSIZE;                               <<F9415>>06842000
      @FC'BUFAREA := FC'BUFSTART;                              <<F9415>>06844000
      << INITIALIZE CACHE ENTRIES >>                           <<F9415>>06846000
      NEXTADR := FC'BUFSTART;                                  <<F9415>>06848000
      INX := 0;                                                <<F9415>>06850000
      WHILE INX < FC'CACENTS*FC'ENTSIZE DO                     <<F9415>>06852000
         BEGIN                                                 <<F9415>>06854000
         @CACENT := @FC'ENTAREA(INX);                          <<F9415>>06856000
         FC'FORL := @CACENT + FC'ENTSIZE;                      <<F9415>>06858000
         FC'BACKL := @CACENT - FC'ENTSIZE;                     <<F9415>>06860000
         FC'DISCADR := -1D;                                    <<F9415>>06862000
         FC'LDEV := -1;                                        <<F9415>>06864000
         FC'BUFPTR := NEXTADR;                                 <<F9415>>06866000
         FC'DIRTY := FALSE;                                    <<F9415>>06868000
         NEXTADR := NEXTADR + FC'BUFSIZE;                      <<F9415>>06870000
         INX := INX + FC'ENTSIZE;                              <<F9415>>06872000
         END;                                                  <<F9415>>06874000
      FC'HEADP := @FC'ENTAREA;                                 <<F9415>>06876000
      FC'TAILP := @CACENT;                                     <<F9415>>06878000
      FC'FORL := 0;   << TERMINATOR >>                         <<F9415>>06880000
      @CACENT := FC'HEADP;                                     <<F9415>>06882000
      FC'BACKL := 0;  << TERMIANTOR >>                         <<F9415>>06884000
      EXCHANGEDB( 0 );                                         <<F9415>>06886000
      END;                                                     <<F9415>>06888000
                                                               <<F9415>>06890000
<<1>> BEGIN   << ENABLE CACHE >>                               <<F9415>>06892000
      EXCHANGEDB( DFSCACDST );                                 <<F9415>>06894000
      DFSCACHECTL := FC'DISABLED;                              <<F9415>>06896000
      FC'DISABLED := FALSE;                                    <<F9415>>06898000
      EXCHANGEDB( 0 );                                         <<F9415>>06900000
      END;                                                     <<F9415>>06902000
                                                               <<F9415>>06904000
<<2>> BEGIN   << DISABLE CACHE >>                              <<F9415>>06906000
      DFSCACHECTL( DSCTL'FLUSH );                              <<F9415>>06908000
      EXCHANGEDB( DFSCACDST );                                 <<F9415>>06910000
      DFSCACHECTL := FC'DISABLED;                              <<F9415>>06912000
      FC'DISABLED := TRUE;                                     <<F9415>>06914000
      EXCHANGEDB( 0 );                                         <<F9415>>06916000
      END;                                                     <<F9415>>06918000
                                                               <<F9415>>06920000
<<3>> BEGIN   << SET INTEGRITY ON >>                           <<F9415>>06922000
      DFSCACHECTL( DSCTL'FLUSH );                              <<F9415>>06924000
      EXCHANGEDB( DFSCACDST );                                 <<F9415>>06926000
      DFSCACHECTL := FC'INTEGRITY;                             <<F9415>>06928000
      FC'INTEGRITY := TRUE;                                    <<F9415>>06930000
      EXCHANGEDB( 0 );                                         <<F9415>>06932000
      END;                                                     <<F9415>>06934000
                                                               <<F9415>>06936000
<<4>> BEGIN   << SET INTEGRITY OFF >>                          <<F9415>>06938000
      EXCHANGEDB( DFSCACDST );                                 <<F9415>>06940000
      DFSCACHECTL := FC'INTEGRITY;                             <<F9415>>06942000
      FC'INTEGRITY := FALSE;                                   <<F9415>>06944000
      EXCHANGEDB( 0 );                                         <<F9415>>06946000
      END;                                                     <<F9415>>06948000
                                                               <<F9415>>06950000
<<5>> BEGIN   << FLUSH CACHE >>                                <<F9415>>06952000
      EXCHANGEDB( DFSCACDST );                                 <<F9415>>06954000
      IF MASK THEN                                             <<F9415>>06956000
         BEGIN  << FLUSH ONLY ONE ENTRY >>                     <<F9415>>06958000
         @CACENT := FC'HEADP;                                  <<F9415>>06960000
         WHILE @CACENT <> 0 DO                                 <<F9415>>06962000
            BEGIN                                              <<F9415>>06964000
            IF FC'LDEV = LDEV AND                              <<F9415>>06966000
               FC'DISCADR = DISCADR THEN                       <<F9415>>06968000
               BEGIN                                           <<F9415>>06970000
               IF FC'DIRTY THEN                                <<F9415>>06972000
                  BEGIN                                        <<F9415>>06974000
                  FC'TOTACC := FC'TOTACC+1D;                   <<F9415>>06976000
                  FC'PHYIOS := FC'PHYIOS+1D;                   <<F9415>>06978000
                  FC'PHYWRTS := FC'PHYWRTS+1D;                 <<F9415>>06980000
                  DFSDISC(WRITE,FC'LDEV,FC'DISCADR,            <<F9415>>06982000
                     FC'TBL(FC'BUFPTR),FC'BUFSIZE);            <<F9415>>06984000
                  FC'DIRTY := FALSE;                           <<F9415>>06986000
                  END;                                         <<F9415>>06988000
               FC'LDEV := -1;                                  <<F9415>>06990000
               END;                                            <<F9415>>06992000
            @CACENT := FC'FORL;                                <<F9415>>06994000
            END;                                               <<F9415>>06996000
         END                                                   <<F9415>>06998000
      ELSE                                                     <<F9415>>07000000
         BEGIN  << FLUSH ENTIRE CACHE >>                       <<F9415>>07002000
         @CACENT := FC'HEADP;                                  <<F9415>>07004000
         WHILE @CACENT <> 0 DO                                 <<F9415>>07006000
            BEGIN                                              <<F9415>>07008000
            IF FC'DIRTY THEN                                   <<F9415>>07010000
               BEGIN                                           <<F9415>>07012000
               FC'TOTACC := FC'TOTACC+1D;                      <<F9415>>07014000
               FC'PHYIOS := FC'PHYIOS+1D;                      <<F9415>>07016000
               FC'PHYWRTS := FC'PHYWRTS+1D;                    <<F9415>>07018000
               DFSDISC(WRITE,FC'LDEV,FC'DISCADR,               <<F9415>>07020000
                  FC'TBL(FC'BUFPTR),FC'BUFSIZE);               <<F9415>>07022000
               FC'DIRTY := FALSE;                              <<F9415>>07024000
               END;                                            <<F9415>>07026000
            FC'LDEV := -1;                                     <<F9415>>07028000
            @CACENT := FC'FORL;                                <<F9415>>07030000
            END;                                               <<F9415>>07032000
         END;                                                  <<F9415>>07034000
      EXCHANGEDB( 0 );                                         <<F9415>>07036000
      END;                                                     <<F9415>>07038000
                                                               <<F9415>>07040000
<<6>> BEGIN   << CLOSE CACHE >>                                <<F9415>>07042000
      DFSCACHECTL( DSCTL'FLUSH );                              <<F9415>>07044000
      RETURNENTRY( DSTDSTN, DFSCACDST);                        <<F9415>>07046000
      DFSCACDST := 0;                                          <<F9415>>07048000
      END;                                                     <<F9415>>07050000
                                                               <<F9415>>07052000
      END;  << CASE >>                                         <<F9415>>07054000
                                                               <<F9415>>07056000
   CC := CCE;                                                  <<F9415>>07058000
END; << DFSCACHECTL >>                                         <<F9415>>07060000
INTEGER PROCEDURE DFSIO(FUNCTION,LDEV,DISCADR,BUF,WORDS);      <<F9415>>07062000
   VALUE FUNCTION,LDEV,DISCADR,WORDS;                          <<F9415>>07064000
   INTEGER FUNCTION,LDEV,WORDS;                                <<F9415>>07066000
   DOUBLE DISCADR;                                             <<F9415>>07068000
   ARRAY BUF;                                                  <<F9415>>07070000
BEGIN                                                          <<F9415>>07072000
   COMMENT                                                     <<F9415>>07074000
                                                               <<F9415>>07076000
      The DFS caching data segment is divided into 3 parts:    <<F9415>>07078000
   the header, the caching entries and the buffer area.        <<F9415>>07080000
   The caching entries are in a doubly linked list with        <<F9415>>07082000
   the head and tail pointers in the header area.  When        <<F9415>>07084000
   a hit occurs, the entry is brought to the head of the       <<F9415>>07086000
   list.  When a block replacement is required, the entry      <<F9415>>07088000
   at the tail is used.  The number of buffers can be          <<F9415>>07090000
   configured from 1 to 240, by changing the equate            <<F9415>>07092000
   "FC'CACENTS".  See DFSCACHECTL which controls the           <<F9415>>07094000
   operation of this procedure.                                <<F9415>>07096000
                                                               <<F9415>>07098000
   DB MUST be at the stack upon entry.                         <<F9415>>07100000
                                                               <<F9415>>07102000
   RETURNS:                                                    <<F9415>>07104000
      CCE  -  OK                                               <<F9415>>07106000
      CCL  -  FAILURE (function has error number)              <<F9415>>07108000
                                                               <<F9415>>07110000
   ERROR CODES:                                                <<F9415>>07112000
      NONE at present                                          <<F9415>>07114000
;                                                              <<F9415>>07116000
   INTEGER                                                     <<F9415>>07118000
      INX;                                                     <<F9415>>07120000
   INTEGER POINTER                                             <<F9415>>07122000
      CACBUF,                                                  <<F9415>>07124000
      CACENT,                                                  <<F9415>>07126000
      OLDENT;                                                  <<F9415>>07128000
   LOGICAL POINTER                                             <<F9415>>07130000
      CACENTL     = CACENT;                                    <<F9415>>07132000
   DOUBLE POINTER                                              <<F9415>>07134000
      CACENTD     = CACENT;                                    <<F9415>>07136000
                                                               <<F9415>>07138000
   SUBROUTINE MTDS( DSTNR, DISP, BUF, WORDS);                  <<F9415>>07140000
      VALUE DSTNR, DISP, WORDS;                                <<F9415>>07142000
      INTEGER DSTNR, DISP, WORDS;                              <<F9415>>07144000
      ARRAY BUF;                                               <<F9415>>07146000
   BEGIN                                                       <<F9415>>07148000
      EXCHANGEDB( 0 );                                         <<F9415>>07150000
      X := TOS;                                                <<F9415>>07152000
      ASSEMBLE( MTDS 0 );                                      <<F9415>>07154000
      TOS := X;                                                <<F9415>>07156000
      EXCHANGEDB( DFSCACDST );                                 <<F9415>>07158000
   END;                                                        <<F9415>>07160000
   SUBROUTINE MFDS( BUF, DSTNR, DISP, WORDS);                  <<F9415>>07162000
      VALUE DSTNR, DISP, WORDS;                                <<F9415>>07164000
      INTEGER DSTNR, DISP, WORDS;                              <<F9415>>07166000
      ARRAY BUF;                                               <<F9415>>07168000
   BEGIN                                                       <<F9415>>07170000
      EXCHANGEDB( 0 );                                         <<F9415>>07172000
      X := TOS;                                                <<F9415>>07174000
      ASSEMBLE( MFDS 0 );                                      <<F9415>>07176000
      TOS := X;                                                <<F9415>>07178000
      EXCHANGEDB( DFSCACDST );                                 <<F9415>>07180000
   END;                                                        <<F9415>>07182000
   SUBROUTINE ERROR( ERRORNR );                                <<F9415>>07184000
      VALUE ERRORNR;                                           <<F9415>>07186000
      INTEGER ERRORNR;                                         <<F9415>>07188000
   BEGIN                                                       <<F9415>>07190000
      DFSIO := ERRORNR;                                        <<F9415>>07192000
      EXCHANGEDB( 0 );                                         <<F9415>>07194000
      CC := CCL;                                               <<F9415>>07196000
      ASSEMBLE( EXIT 6 );                                      <<F9415>>07198000
   END;                                                        <<F9415>>07200000
                                                               <<F9415>>07202000
   LOGICAL SUBROUTINE SEARCHCACHE;                             <<F9415>>07204000
   BEGIN                                                       <<F9415>>07206000
      @CACENT := FC'HEADP;                                     <<F9415>>07208000
      WHILE @CACENT <> 0 DO                                    <<F9415>>07210000
         BEGIN                                                 <<F9415>>07212000
         IF FC'LDEV = LDEV AND FC'DISCADR = DISCADR THEN       <<F9415>>07214000
            BEGIN                                              <<F9415>>07216000
            @CACBUF := FC'BUFPTR;                              <<F9415>>07218000
            SEARCHCACHE := TRUE;                               <<F9415>>07220000
            RETURN;                                            <<F9415>>07222000
            END;                                               <<F9415>>07224000
         @CACENT := FC'FORL;                                   <<F9415>>07226000
         END;                                                  <<F9415>>07228000
   END;                                                        <<F9415>>07230000
                                                               <<F9415>>07232000
   SUBROUTINE DELINK( INX );                                   <<F9415>>07234000
      VALUE INX;                                               <<F9415>>07236000
      INTEGER INX;                                             <<F9415>>07238000
   BEGIN                                                       <<F9415>>07240000
      @OLDENT := @CACENT;  << SAVE ORGINAL POINTER >>          <<F9415>>07242000
      @CACENT := INX;                                          <<F9415>>07244000
                                                               <<F9415>>07246000
      IF @CACENT <> FC'HEADP THEN                              <<F9415>>07248000
         FC'TBL(FC'BACKL+FC'FORLDISP) := FC'FORL               <<F9415>>07250000
      ELSE                                                     <<F9415>>07252000
         FC'HEADP := FC'FORL;                                  <<F9415>>07254000
                                                               <<F9415>>07256000
      IF @CACENT <> FC'TAILP THEN                              <<F9415>>07258000
         FC'TBL(FC'FORL+FC'BACKLDISP) := FC'BACKL              <<F9415>>07260000
      ELSE                                                     <<F9415>>07262000
         FC'TAILP := FC'BACKL;                                 <<F9415>>07264000
                                                               <<F9415>>07266000
      @CACENT := @OLDENT; << RESTORE >>                        <<F9415>>07268000
   END;                                                        <<F9415>>07270000
                                                               <<F9415>>07272000
   SUBROUTINE ADDTOHEAD( INX );                                <<F9415>>07274000
      VALUE INX;                                               <<F9415>>07276000
      INTEGER INX;                                             <<F9415>>07278000
   BEGIN                                                       <<F9415>>07280000
      @OLDENT := @CACENT; << SAVE ORGINAL POINTER >>           <<F9415>>07282000
                                                               <<F9415>>07284000
      IF FC'HEADP = 0 THEN                                     <<F9415>>07286000
         BEGIN                                                 <<F9415>>07288000
         @CACENT := INX;                                       <<F9415>>07290000
         FC'FORL := 0;                                         <<F9415>>07292000
         FC'BACKL := 0;                                        <<F9415>>07294000
         FC'HEADP := FC'TAILP := INX;                          <<F9415>>07296000
         END                                                   <<F9415>>07298000
      ELSE                                                     <<F9415>>07300000
         BEGIN                                                 <<F9415>>07302000
         @CACENT := FC'HEADP;                                  <<F9415>>07304000
         FC'BACKL := INX;                                      <<F9415>>07306000
         @CACENT := INX;                                       <<F9415>>07308000
         FC'FORL := FC'HEADP;                                  <<F9415>>07310000
         FC'BACKL := 0;                                        <<F9415>>07312000
         FC'HEADP := INX;                                      <<F9415>>07314000
         END;                                                  <<F9415>>07316000
                                                               <<F9415>>07318000
      @CACENT := @OLDENT; << RESTORE >>                        <<F9415>>07320000
   END;                                                        <<F9415>>07322000
                                                               <<F9415>>07324000
   CC := CCE;  << ASSUME THE BEST >>                           <<F9415>>07326000
                                                               <<F9415>>07328000
   IF DFSCACDST = 0 THEN                                       <<F9415>>07330000
      BEGIN   << CACHE NOT INITIALIZED >>                      <<F9415>>07332000
      DFSDISC(FUNCTION,LDEV,DISCADR,BUF,WORDS);                <<F9415>>07334000
      RETURN;                                                  <<F9415>>07336000
      END;                                                     <<F9415>>07338000
                                                               <<F9415>>07340000
   EXCHANGEDB( DFSCACDST );                                    <<F9415>>07342000
   FC'TOTACC := FC'TOTACC + 1D;                                <<F9415>>07344000
   IF FC'DISABLED THEN                                         <<F9415>>07346000
      BEGIN                                                    <<F9415>>07348000
      FC'PHYIOS := FC'PHYIOS+1D;                               <<F9415>>07350000
      IF FUNCTION = WRITE THEN FC'PHYWRTS := FC'PHYWRTS+1D;    <<F9415>>07352000
      EXCHANGEDB( 0 );                                         <<F9415>>07354000
      DFSDISC(FUNCTION,LDEV,DISCADR,BUF,WORDS);                <<F9415>>07356000
      RETURN;                                                  <<F9415>>07358000
      END;                                                     <<F9415>>07360000
                                                               <<F9415>>07362000
   IF SEARCHCACHE THEN                                         <<F9415>>07364000
      BEGIN  << HIT >>                                         <<F9415>>07366000
      FC'HITS := FC'HITS + 1D;                                 <<F9415>>07368000
      IF FUNCTION = READ THEN                                  <<F9415>>07370000
         BEGIN                                                 <<F9415>>07372000
         MFDS(BUF,DFSCACDST,@CACBUF,WORDS);                    <<F9415>>07374000
         END                                                   <<F9415>>07376000
      ELSE                                                     <<F9415>>07378000
         BEGIN  << WRITE >>                                    <<F9415>>07380000
         MTDS(DFSCACDST,@CACBUF,BUF,WORDS);                    <<F9415>>07382000
         FC'DIRTY := TRUE;                                     <<F9415>>07384000
         IF FC'INTEGRITY THEN                                  <<F9415>>07386000
            BEGIN                                              <<F9415>>07388000
            FC'PHYIOS := FC'PHYIOS + 1D;                       <<F9415>>07390000
            FC'PHYWRTS := FC'PHYWRTS + 1D;                     <<F9415>>07392000
            DFSDISC(WRITE,LDEV,DISCADR,CACBUF,WORDS);          <<F9415>>07394000
            FC'DIRTY := FALSE;                                 <<F9415>>07396000
            END                                                <<F9415>>07398000
         END;                                                  <<F9415>>07400000
      DELINK( @CACENT );                                       <<F9415>>07402000
      ADDTOHEAD( @CACENT );                                    <<F9415>>07404000
      END                                                      <<F9415>>07406000
   ELSE                                                        <<F9415>>07408000
      BEGIN  << MISS >>                                        <<F9415>>07410000
      IF FUNCTION = READ THEN                                  <<F9415>>07412000
         BEGIN                                                 <<F9415>>07414000
         FC'PHYIOS := FC'PHYIOS + 1D;                          <<F9415>>07416000
         EXCHANGEDB( 0 );                                      <<F9415>>07418000
         DFSDISC(READ,LDEV,DISCADR,BUF,WORDS);                 <<F9415>>07420000
         EXCHANGEDB( DFSCACDST );                              <<F9415>>07422000
         END;                                                  <<F9415>>07424000
      @CACENT := FC'TAILP;                                     <<F9415>>07426000
      @CACBUF := FC'BUFPTR;                                    <<F9415>>07428000
      IF FC'DIRTY THEN                                         <<F9415>>07430000
         BEGIN                                                 <<F9415>>07432000
         FC'PHYIOS := FC'PHYIOS + 1D;                          <<F9415>>07434000
         FC'PHYWRTS := FC'PHYWRTS + 1D;                        <<F9415>>07436000
         DFSDISC(WRITE,FC'LDEV,FC'DISCADR,FC'TBL(FC'BUFPTR),   <<F9415>>07438000
            FC'BUFSIZE);                                       <<F9415>>07440000
         FC'DIRTY := FALSE;                                    <<F9415>>07442000
         END;                                                  <<F9415>>07444000
      FC'LDEV := LDEV;                                         <<F9415>>07446000
      FC'DISCADR := DISCADR;                                   <<F9415>>07448000
      MTDS(DFSCACDST,@CACBUF,BUF,WORDS);                       <<F9415>>07450000
      IF FUNCTION = WRITE THEN                                 <<F9415>>07452000
         BEGIN                                                 <<F9415>>07454000
         FC'DIRTY := TRUE;                                     <<F9415>>07456000
         IF FC'INTEGRITY THEN                                  <<F9415>>07458000
            BEGIN                                              <<F9415>>07460000
            FC'PHYIOS := FC'PHYIOS + 1D;                       <<F9415>>07462000
            FC'PHYWRTS := FC'PHYWRTS + 1D;                     <<F9415>>07464000
            DFSDISC(WRITE,LDEV,DISCADR,FC'TBL(FC'BUFPTR),      <<F9415>>07466000
               WORDS);                                         <<F9415>>07467000
            FC'DIRTY := FALSE;                                 <<F9415>>07468000
            END;                                               <<F9415>>07470000
         END;                                                  <<F9415>>07472000
      DELINK( FC'TAILP );                                      <<F9415>>07474000
      ADDTOHEAD( @CACENT );                                    <<F9415>>07476000
      END;                                                     <<F9415>>07478000
                                                               <<F9415>>07480000
   EXCHANGEDB( 0 );                                            <<F9415>>07482000
END;                                                           <<F9415>>07484000
END.  << INITIAL DIRECTORY PROCEDURES >>                       <<F9415>>07486000
