<< LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION>>               00000001
$SET X0=OFF,X1=ON, X2=ON, X3=OFF                               <<*8613>>00030000
$SET X3=OFF  << Enables bug catcher >>                         <<*8613>>00126000
$SET X8=ON                                                     <<l7481>>00127000
       Write'Disc'Label         Get'Disc'Info                           01814000
$EDIT VOID=01816000                                                     01816000
$PAGE "LOGICAL/PHYSICAL DEVICE TABLE AND LOGICAL DEVICE TABLE" <<06274>>02031000
$INCLUDE INCLLPDT                                              <<06274>>02031100
$PAGE "PROCESS CONTROL BLOCK (PCB) INCLUDE FILE"               <<l7481>>02031105
$INCLUDE INCLPCB5                                              <<06469>>02031110
$INCLUDE INCLLDT5                                              <<06274>>02031200
$EDIT VOID=02052000                                            <<06469>>02046000
$EDIT VOID=02130000                                            <<06274>>02060000
                                                               <<06274>>02064000
   DEFINE                                                      <<06274>>02065000
      ldt'index = 0 #,                                         <<06274>>02066000
      ldtx'index = 0 #,                                        <<06274>>02067000
      lpdt'index = ldev * INTEGER (lpdt'entry'size) #;         <<06274>>02068000
                                                               <<06274>>02069000
<<Cacheing strategy 4 is used to distinguish                            02170500
  DFS I/O from normal I/O>>                                    <<*2140>>02170600
       blocked'io'flag = %40001,                               <<*2140>>02172000
       serial'io'flag  = %42001;                               <<*2140>>02173000
  EQUATE PROGENPIN'NUM = 1;                             <<LAL>>         02219000
   DEFINE progen'pcbpt = pcbsize#; <<PROGEN's PCB is always 1>><<06531>>02222000
$EDIT VOID=02252000                                            <<06531>>02246000
                IF s0 > INTEGER (lpdt'max'entries) OR          <<06274>>02350000
<< Subroutine definitions for MOVE'FROM'DST and MOVE'TO'DST. >><<06274>>02426100
<< Usage: declare "SUBROUTINE DEF'MOVE'xx'DST" in each pro-  >><<06274>>02426200
<< cedure requiring it. Note that DBSOURCE and DBTARGET are  >><<06274>>02426300
<< LOGICAL only. Use the "@" when either one is a pointer.   >><<06274>>02426400
                                                               <<06274>>02426500
DEFINE                                                         <<06274>>02427000
   def'move'from'dst =                                         <<06274>>02427100
      move'from'dst (dbtarget, dstn, dstoffset, word'count);   <<06274>>02427200
         VALUE   dbtarget, dstn, dstoffset, word'count;        <<06274>>02427300
         LOGICAL dbtarget, dstn, dstoffset, word'count;        <<06274>>02427400
      BEGIN                                                    <<06274>>02427500
      x := TOS;                                                <<06274>>02427600
      ASSEMBLE (MFDS 0);                                       <<06274>>02427700
      TOS := x;                                                <<06274>>02427800
      END #,                                                   <<06274>>02427900
                                                               <<06274>>02427910
   def'move'to'dst =                                           <<06274>>02427920
      move'to'dst (dstn, dstoffset, dbsource, word'count);     <<06274>>02427930
         VALUE   dstn, dstoffset, dbsource, word'count;        <<06274>>02427940
         LOGICAL dstn, dstoffset, dbsource, word'count;        <<06274>>02427950
      BEGIN                                                    <<06274>>02427960
      x := TOS;   << Save return address >>                    <<06274>>02427970
      ASSEMBLE (MTDS 0);                                       <<06274>>02427980
      TOS := x;                                                <<06274>>02427990
      END #;                                                   <<06274>>02427991
                                                               <<06274>>02427992
   INTEGER PROCEDURE flush'cache (LDEV,START'ADDR,LIMIT'ADDR); <<f7840>>02632100
      VALUE   ldev,start'addr,limit'addr;                      <<f7840>>02632200
      INTEGER ldev;                                            <<f7840>>02632300
      DOUBLE  start'addr,limit'addr;                           <<f7840>>02632400
      OPTION  EXTERNAL;                                        <<f7840>>02632500
                                                               <<f7840>>02632600
                   add'high, add'low, serial'io'flag);         <<07331>>03030000
                   sector'size, 0, 0, serial'io'flag);         <<07331>>03190000
$EDIT VOID=03438000                                                     03212000
         IF NOT lpdt'non'sys'domain THEN                       <<06274>>04414000
         IF NOT lpdt'non'sys'domain THEN                       <<06274>>04450000
$EDIT VOID=05048000                                                     05046000
   LOGICAL ARRAY ldt (0:size'of'ldt'entry-1) = Q;              <<06274>>05104000
   LOGICAL ARRAY ldtx (0:size'of'ldtx'entry-1) = Q;            <<06274>>05105000
   SUBROUTINE def'move'from'dst;                               <<06274>>05113000
   SUBROUTINE def'move'to'dst;                                 <<06274>>05113100
                                                               <<06274>>05113200
   Soft'Death (422);                                           <<*7987>>05126000
   Move'From'Dst (@ldt, ldt'dst, 0, size'of'ldt'entry);        <<06274>>05588000
   ldtx'entry'offset := ldtx'base + ldev * size'of'ldtx'entry; <<06274>>05592000
                                                               <<06274>>05594000
   Move'From'Dst (@ldtx, ldt'dst, ldtx'entry'offset,           <<06274>>05598000
      size'of'ldtx'entry);                                     <<06274>>05600000
   ldtx'dfs'err := error'status;                               <<06274>>05604000
   Move'To'Dst (ldt'dst, ldtx'entry'offset, @ldtx,             <<06274>>05610000
      size'of'ldtx'entry);                                     <<06274>>05612000
   IF ldtx'disc'free'spc'xds <> 0 THEN                         <<06274>>05630000
      Move'To'Dst (ldtx'disc'free'spc'xds, @ds'error'status,   <<06274>>05632000
         @error'status, 1);                                    <<06274>>05634000
         progen'pcbpt                                          ((si.05))05772000
$EDIT VOID=05804000                                                     05802000
   LOGICAL ARRAY ldt (0:size'of'ldt'entry-1) = Q;              <<06274>>05870000
   LOGICAL ARRAY ldtx (0:size'of'ldtx'entry-1) = Q;            <<06274>>05871000
                                                               <<06274>>05875000
   SUBROUTINE def'move'from'dst;                               <<06274>>05875100
   SUBROUTINE def'move'to'dst;                                 <<06274>>05875200
                                                               <<06274>>05875300
   Soft'Death (422);                                           <<*7987>>05886000
   IF curprc = progen'pcbpt THEN                               <<06531>>05896000
         Move'From'Dst (@ldt, ldt'dst, 0, size'of'ldt'entry);  <<06274>>05940000
         ldtx'entry'offset := ldtx'base +                      <<06274>>05944000
            ldev * size'of'ldtx'entry;                         <<06274>>05946000
         Move'From'Dst (@ldtx, ldt'dst, ldtx'entry'offset,     <<06274>>05950000
            size'of'ldtx'entry);                               <<06274>>05952000
         ldtx'dfs'err := error'status;                         <<06274>>05956000
         Move'To'Dst (ldt'dst, ldtx'entry'offset,              <<06274>>05962000
            @ldtx, size'of'ldtx'entry);                        <<06274>>05964000
         IF ldtx'disc'free'spc'xds <> 0 THEN                   <<06274>>05982000
            Move'To'Dst (ldtx'disc'free'spc'xds,               <<06274>>05984000
               @ds'error'status, @error'status, 1);            <<06274>>05986000
       SENDMSG(PROGENPIN'NUM,0,4,SEND'FLAGS);           <<LAL>>         06014000
         Awake (progen'pcbpt, %20, 0);                         <<06531>>06022000
         progen'pcbpt                                          ((si.05))06174000
$EDIT VOID=06202000                                                     06200000
   LOGICAL ARRAY ldt (0:size'of'ldt'entry-1) = Q;              <<06274>>06234000
   LOGICAL ARRAY ldtx (0:size'of'ldtx'entry-1) = Q;            <<06274>>06235000
   SUBROUTINE def'move'from'dst;                               <<06274>>06251000
                                                               <<06274>>06251100
   Soft'Death (422);                                           <<*7987>>06264000
   Move'From'Dst (@ldt, ldt'dst, 0, size'of'ldt'entry);        <<06274>>06396000
   ldtx'entry'offset := ldtx'base + ldev * size'of'ldtx'entry; <<06274>>06400000
                                                               <<06274>>06402000
   Move'From'Dst (@ldtx, ldt'dst, ldtx'entry'offset,           <<06274>>06406000
      size'of'ldtx'entry);                                     <<06274>>06408000
   Exchangedb (ldtx'disc'free'spc'xds);                        <<06274>>06412000
   OPTION UNCALLABLE;                                          <<*7870>>06485000
         progen'pcbpt                                          ((si.05))06602000
   Soft'Death (422);                                           <<*7987>>06674000
   IF curprc = progen'pcbpt THEN                               <<06531>>06698000
      SENDMSG (PROGENPIN'NUM,0,4,SEND'FLAGS);           <<LAL>>         06734000
         Awake (progen'pcbpt, %20, 0);                         <<06531>>06742000
$EDIT VOID=07020000                                                     07018000
   LOGICAL ARRAY ldt (0:size'of'ldt'entry-1);                  <<06274>>07102000
   LOGICAL ARRAY ldtx (0:size'of'ldtx'entry-1);                <<06274>>07103000
                                                               <<06274>>07137000
   SUBROUTINE def'move'from'dst;                               <<06274>>07137100
   SUBROUTINE def'move'to'dst;                                 <<06274>>07137200
   Move'From'Dst (@ldt, ldt'dst, 0, size'of'ldt'entry);        <<06274>>07388000
   ldtx'entry'offset := ldtx'base + ldev * size'of'ldtx'entry; <<06274>>07392000
                                                               <<06274>>07394000
   Move'From'Dst (@ldtx, ldt'dst, ldtx'entry'offset,           <<06274>>07398000
      size'of'ldtx'entry);                                     <<06274>>07400000
   IF ldtx'disc'free'spc'xds <> 0 AND                          <<06274>>07420000
   INTEGER (ldtx'disc'free'spc'xds) <> dfs'dst THEN            <<06274>>07422000
      Reldataseg (ldtx'disc'free'spc'xds);                     <<06274>>07424000
   ldtx'disc'free'spc'xds := dfs'dst;                          <<06274>>07428000
   ldtx'dfs'err := no'error;                                   <<06274>>07430000
   ldtx'dfs'disc := true;                                      <<01279>>07431000
   Move'To'Dst (ldt'dst, ldtx'entry'offset, @ldtx,             <<06274>>07434000
      size'of'ldtx'entry);                                     <<06274>>07436000
$EDIT VOID=07964000                                                     07962000
   LOGICAL ARRAY ldt (0:size'of'ldt'entry-1) = Q;              <<06274>>08016000
   LOGICAL ARRAY ldtx (0:size'of'ldtx'entry-1) = Q;            <<06274>>08017000
                                                               <<06274>>08017010
   SUBROUTINE def'move'from'dst;                               <<06274>>08017020
   SUBROUTINE def'move'to'dst;                                 <<06274>>08017030
                                                               <<06274>>08017100
   Move'From'Dst (@ldt, ldt'dst, 0, size'of'ldt'entry);        <<06274>>08054000
   ldtx'entry'offset := ldtx'base + ldev * size'of'ldtx'entry; <<06274>>08058000
                                                               <<06274>>08060000
   Move'From'Dst (@ldtx, ldt'dst, ldtx'entry'offset,           <<06274>>08064000
      size'of'ldtx'entry);                                     <<06274>>08066000
   IF ldtx'disc'free'spc'xds <> 0 THEN                         <<06274>>08070000
      Reldataseg (ldtx'disc'free'spc'xds);                     <<06274>>08072000
   ldtx'disc'free'spc'xds := 0;                                <<06274>>08076000
   ldtx'dfs'err := 0;                                          <<06274>>08078000
   ldtx'dfs'disc := false;                                     <<01279>>08079000
   Move'To'Dst (ldt'dst, ldtx'entry'offset, @ldtx,             <<06274>>08082000
      size'of'ldtx'entry);                                     <<06274>>08084000
$EDIT VOID=08200000                                                     08198000
   LOGICAL ARRAY ldt (0:size'of'ldt'entry-1);                  <<06274>>08236000
   LOGICAL ARRAY ldtx (0:size'of'ldtx'entry-1);                <<06274>>08237000
                                                               <<06274>>08245000
   SUBROUTINE def'move'from'dst;                               <<06274>>08245100
   Move'From'Dst (@ldt, ldt'dst, 0, size'of'ldt'entry);        <<06274>>08278000
   ldtx'entry'offset := ldtx'base + ldev * size'of'ldtx'entry; <<06274>>08282000
                                                               <<06274>>08284000
   Move'From'Dst (@ldtx, ldt'dst, ldtx'entry'offset,           <<06274>>08288000
      size'of'ldtx'entry);                                     <<06274>>08290000
   IF NOT ldtx'dfs'err THEN                                    <<06274>>08298000
   OPTION UNCALLABLE;                                          <<*7870>>08719000
      Getsir                                                            08814000
$EDIT VOID=08818000                                                     08816000
   LOGICAL ARRAY ldt (0:size'of'ldt'entry-1);                  <<06274>>08852000
   LOGICAL ARRAY ldtx (0:size'of'ldtx'entry-1);                <<06274>>08854000
                                                               <<06274>>08871000
   SUBROUTINE def'move'from'dst;                               <<06274>>08871100
   SUBROUTINE def'move'to'dst;                                 <<06274>>08871200
   Move'From'Dst (@ldt, ldt'dst, 0, size'of'ldt'entry);        <<06274>>08884000
   highest'ldev'number := lpdt'max'entries;                    <<06274>>08888000
   ldtx'offset := ldtx'base;                                   <<06274>>08892000
         Move'From'Dst (@ldt, ldt'dst,                         <<06274>>08912000
            ldev * size'of'ldt'entry, size'of'ldt'entry);      <<06274>>08914000
         IF ldt'device'type < ldt'card'reader AND              <<06274>>08918000
            ldt'record'width <> 0 THEN                         <<06274>>08919000
                     Move'From'Dst (@ldtx, ldt'dst,            <<06274>>08942000
                        ldtx'offset + ldev*size'of'ldtx'entry, <<06274>>08944000
                        size'of'ldtx'entry);                   <<06274>>08946000
                     ldtx'disc'free'spc'xds := 0;              <<06274>>08950000
                     ldtx'dfs'err := 0;                        <<06274>>08952000
                     Move'To'Dst (ldt'dst,                     <<06274>>08956000
                        ldtx'offset + ldev*size'of'ldtx'entry, <<06274>>08958000
                        @ldtx, size'of'ldtx'entry);            <<06274>>08960000
               Move'From'Dst (@vtab'entry, vtab'dst,           <<06274>>08984000
                  ldt'volume'tbl'index * vtab'entry'size,      <<06274>>08986000
                  vtab'entry'size);                            <<06274>>08988000
                    page'address'low, serial'io'flag);         <<07331>>09692000
   LOGICAL ARRAY ldt (0:size'of'ldt'entry-1) = Q;              <<06274>>12580000
   LOGICAL ARRAY ldtx (0:size'of'ldtx'entry-1) = Q;            <<06274>>12581000
   LOGICAL pcbpt,my'pin;                                       <<07394>>12584000
                                                               <<06531>>12586100
                                                               <<06274>>12587000
   SUBROUTINE def'move'from'dst;                               <<06274>>12587100
   SUBROUTINE def'move'to'dst;                                 <<06274>>12587200
   Move'From'Dst (@ldt, ldt'dst, 0, size'of'ldt'entry);        <<06274>>12632000
                                                               <<06274>>12634000
   ldtx'entry'offset := ldtx'base + ldev * size'of'ldtx'entry; <<06274>>12636000
                                                               <<06274>>12637000
   Move'From'Dst (@ldtx, ldt'dst, ldtx'entry'offset,           <<06274>>12638000
      size'of'ldtx'entry);                                     <<06274>>12640000
   dfs'dst := ldtx'disc'free'spc'xds;                          <<06274>>12644000
                                                               <<06274>>12646000
$EDIT VOID=12662000                                            <<06274>>12648000
   return'value := ldtx'dfs'err;                               <<06274>>12674000
      Soft'Death (421);                                        <<*7987>>12726000
$EDIT VOID=12854000                                            <<07394>>12742000
   my'pin := curprc;       << My PIN PCB offset.            >> <<07394>>12744000
   pseudodisable;          << Insure mutual exclusion.      >> <<07394>>12746000
   IF ds'lock = 0 then                                         <<07394>>12748000
      BEGIN                << DST is not locked.            >> <<07394>>12750000
      ds'lock := my'pin;                                       <<07394>>12752000
      ds'lock'count := 1;                                      <<07394>>12754000
      pseudoenable;                                            <<07394>>12756000
      END                                                      <<07394>>12758000
   ELSE                    << The DS segment already locked.>> <<07394>>12760000
      IF ds'lock = my'pin THEN                                 <<07394>>12762000
         BEGIN             << Already locked by process.    >> <<07394>>12764000
         ds'lock'count := ds'lock'count + 1;                   <<07394>>12766000
         pseudoenable;                                         <<07394>>12768000
         END                                                   <<07394>>12770000
      ELSE                                                     <<07394>>12772000
         BEGIN             << Locked by another process.    >> <<07394>>12774000
         IF ds'queue'head = 0 THEN                             <<07394>>12776000
            BEGIN          << Empty queue, we're at head.   >> <<07394>>12778000
            ds'queue'head := my'pin;                           <<07394>>12780000
            ds'queue'tail := my'pin;                           <<07394>>12782000
            END                                                <<07394>>12784000
         ELSE                                                  <<07394>>12786000
            BEGIN          << Wasn't empty, go to end of Q. >> <<07394>>12788000
            pcbpt := ds'queue'tail;                            <<07394>>12790000
            spcbnimppin := my'pin;                             <<07394>>12792000
            ds'queue'tail := my'pin;                           <<07394>>12794000
            END;                                               <<07394>>12796000
                                                               <<07394>>12798000
         Impede(0);        << Wait for our turn to come.    >> <<07394>>12800000
                                                               <<07394>>12802000
         << Make sure that no one has disabled free space   >> <<07394>>12804000
         << allocation on this ldev while we were waiting,  >> <<07394>>12806000
         << as could be the case if an unexpected error     >> <<07394>>12808000
         << occured. If so, unlock DST and split.           >> <<07394>>12810000
                                                               <<07394>>12812000
         IF ds'error'status.error'type >= fatal'dfs'error THEN <<07394>>12814000
            BEGIN                                              <<07394>>12816000
            return'value := ds'error'status;                   <<07394>>12818000
            Unlock'Dfs'Data'Seg;                               <<07394>>12820000
            RETURN;                                            <<07394>>12822000
            END;                                               <<07394>>12824000
         END;              << Locked by another process.    >> <<07394>>12826000
   LOGICAL next'pin,pcbpt;                                     <<07394>>12989000
   IF curprc <> ds'lock or ds'lock'count <= 0 THEN             <<06531>>13006000
      Soft'Death (421);                                        <<*7987>>13014000
$EDIT VOID=13082000                                            <<07394>>13030000
   IF ds'lock'count = 0 THEN                                   <<07394>>13032000
      IF ds'queue'head = 0 THEN                                <<07394>>13034000
         ds'lock := 0      << No one waiting.               >> <<07394>>13036000
      ELSE                                                     <<07394>>13038000
         BEGIN             << Unimpede next process.        >> <<07394>>13040000
         next'pin := pcbpt := ds'queue'head;                   <<07394>>13042000
         IF ds'queue'head = ds'queue'tail THEN                 <<07394>>13044000
            BEGIN          << No one else is waiting.       >> <<07394>>13046000
            ds'queue'head := 0;                                <<07394>>13048000
            ds'queue'tail := 0;                                <<07394>>13050000
            END                                                <<07394>>13052000
         ELSE              << Head becomes next in line.    >> <<07394>>13054000
            ds'queue'head := spcbnimppin;                      <<07394>>13056000
         spcbnimppin := 0; << Clear next pin's link.        >> <<07394>>13058000
         ds'lock := next'pin;                                  <<07394>>13060000
         ds'lock'count := 1;                                   <<07394>>13062000
         Unimpede(next'pin);                                   <<07394>>13064000
         END;                                                  <<07394>>13066000
      4 = Illegal number'of'sectors ( <=0 ) requested.                  13155000
                                                               <<c7486>>13305000
   <<check that number of sectors requested is greater than 0>><<c7486>>13305100
                                                               <<c7486>>13305200
   if number'of'sectors <= 0D then                             <<c7486>>13305300
      BEGIN                                                    <<c7486>>13305400
      return'value := 4;                                       <<c7486>>13305500
      Resetcritical (critical'flag);                           <<c7486>>13305600
      RETURN;                                                  <<c7486>>13305700
      END;                                                     <<c7486>>13305800
      Soft'Death (421);                                        <<*7987>>13478000
                                                               <<c7486>>13683000
   <<check that number of sectors returned is greater than 0>> <<c7486>>13683100
                                                               <<c7486>>13683200
   if number'of'sectors <= 0D then                             <<c7486>>13683300
      BEGIN                                                    <<c7486>>13683400
      Resetcritical (critical'flag);                           <<c7486>>13683500
      RETURN;                                                  <<c7486>>13683600
      END;                                                     <<c7486>>13683700
   << flush cache before returning disc space, in >>           <<f7840>>13685000
   << case it has the old contents of that space  >>           <<f7840>>13685100
                                                               <<f7840>>13685200
   flush'cache (ldev, disc'address,                            <<f7840>>13685300
                      disc'address + number'of'sectors);       <<f7840>>13685400
                                                               <<f7840>>13685500
      Soft'Death (421);                                        <<*7987>>13736000
      4 - Illegal number'of'sectors ( <=0 ) requested.                  13865000
                                                               <<c7486>>14029000
$EDIT VOID=14037000                                            <<c7752>>14029100
   <<check that number of sectors requested is greater than 0>><<c7752>>14029150
                                                               <<c7752>>14029200
   if number'of'sectors <= 0D then                             <<c7752>>14029300
      BEGIN                                                    <<c7752>>14029400
      return'value := 4;                                       <<c7752>>14029500
      Resetcritical (critical'flag);                           <<c7752>>14029600
      RETURN;                                                  <<c7752>>14029700
      END;                                                     <<c7752>>14029800
                                                                        14030000
   TOS := Lock'Dfs'Data'Seg (ldev);                                     14032000
                                                                        14034000
   IF NOT TOS THEN                                                      14036000
