<< LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION>>               00000001
$CONTROL MAP,CODE,USLINIT                                               00010000
<<SADUTIL, MODULE SA >>                                                 00012000
<< HP32002C MPE SOURE C.00.08 >>                                        00014000
<< COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980    >>         00016000
<<     THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT >>          00018000
<<     TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED>>          00020000
<<     OR STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER   >>          00022000
<<     REPRODUCTION OF IS THIS PROGRAM EXCEPT FOR ARCHIVAL  >>          00024000
<<     PURPOSES IS PROHIBITED WITHOUT THE PRIOR WRITTEN     >>          00026000
<<     CONSENT OF HEWLETT-PACKARD COMPANY.                  >>          00028000
<<***NOTE - Dollar Copyright cannot be used with this module>>          00030000
$CONTROL USLINIT,CODE,MAP                                      <<03628>>00032000
$TP                                                                     00034000
<<   * * *  S A D U T I L  * * *   >>                          <<01.01>>00036000
                                                                        00038000
BEGIN                                                          <<01.01>>00040000
   DEFINE                                                      <<01.01>>00042000
PTITLE=("Disc Utility V.UU.FF (C) Hewlett-Packard Co., 1982")#;<<04148>>00044000
                                                               <<01.01>>00046000
<<**********************************************************>> <<*GR1*>>00048000
<<                                                          >> <<*GR1*>>00050000
<<                                                          >> <<*GR1*>>00052000
<<                ****IMPORTANT!!!!****                     >> <<*GR1*>>00054000
<<                                                          >> <<*GR1*>>00056000
<<                ****ATTENTION!!!!****                     >> <<*GR1*>>00058000
<<                                                          >> <<*GR1*>>00060000
<<                ***COMPILE OPTIONS***                     >> <<*GR1*>>00062000
<<                                                          >> <<*GR1*>>00064000
<<  X1=OFF Default Option                                   >> <<*GR1*>>00066000
<<                                                          >> <<*GR1*>>00068000
<<         Running under the HP-IB version HP 3000 line     >> <<*GR1*>>00070000
<<         of computers. These include the following:       >> <<*GR1*>>00072000
<<         Series 30/33/40/44                               >> <<*GR1*>>00074000
<<                                                          >> <<*GR1*>>00076000
<<  X1=ON  Series II/III Option                             >> <<*GR1*>>00078000
<<                                                          >> <<*GR1*>>00080000
<<         Running under the Series II/III versions.        >> <<*GR1*>>00082000
<<                                                          >> <<*GR1*>>00084000
<<**********************************************************>> <<*GR1*>>00086000
                                                               <<*GR1*>>00088000
<<**********************************************************>> <<*GR1*>>00090000
<<                                                          >> <<*GR1*>>00092000
<<  This version is running under the Series II/III systems >> <<*GR1*>>00094000
<<                                                          >> <<*GR1*>>00096000
                                                               <<*GR1*>>00098000
$SET X1=ON                                                     <<03628>>00100000
                                                               <<*GR1*>>00102000
<<**********************************************************>> <<*GR1*>>00104000
$PAGE                                                                   00104010
COMMENT                                                                 00104020
                                                                        00104030
******************** MAINTAINING SADUTIL **********************         00104040
                                                                        00104050
     Please  read  the  below  information before attempting to         00104060
maintain  SADUTIL.  Any  engineer that maintains SADUTIL should         00104070
know this information.                                                  00104080
                                                                        00104090
     As  is  indicated by the above comment, there are two ver-         00104100
sions  of SADUTIL, the  Series II/III version and the HPIB ver-         00104110
sion.  Below  I will  explain  the differences between the two          00104120
versions  and  how to create an experimental cold load tape for         00104130
each version.                                                           00104140
                                                                        00104150
    This  module contains all the upper level routines to prop-         00104160
erly  perform  all  of SADUTIL's function.  The main difference         00104170
between  the  two  versions is the low level drivers.  There is         00104180
a  seperate  set  of  I/O  drivers for each version of SADUTIL.         00104190
These  drivers  are  kept  in  what is called an RL file, which         00104200
means  Relocatable  Library.  These  drivers  are  brought into         00104210
an  RL  file  by  means  of the segmenter and combined into the         00104220
SADUTIL  program  file  when  SADUTIL's USL file is preped into         00104230
a  program  file.  Then  this  program file is used to create a         00104240
SADUTIL  cold  load tape using a different method for each ver-         00104250
sion.  To  see  how this is done, obtain the job files for each         00104260
version.                                                                00104270
                                                                        00104280
    Now, I feel that it is appropriate to discuss the maintain-         00104290
ing  of the two versions.  The Series II/III version runs under         00104300
a  program  called SDUPII and is maintained by the MPE integra-         00104310
tion  group.  The  HPIB  version  runs under the control of the         00104320
Diagnotic  Utility  System  (DUS) and is maintained by the DUS/         00104330
Diagnostic  group.  However, there is a  single source file for         00104340
both versions. This source file is kept in the module SA by the         00104350
integration  group.  Any  and  all changes MUST be turned in to         00104360
this  group, even  if the changes are for HPIB only.  Then, the         00104370
new  maintainance  file  with the changes can be copied over to         00104380
the  diagnostics  machine.  As  you may have guessed, there are         00104390
two  copies  of  the  source  and  maintainance  files floating         00104400
around.  You  must  be  very carefull that the two versions are         00104410
alway  exactly  the same at all times.  The ONLY difference be-         00104420
tween  the  two  versions will be with lines 94 and 100.  These         00104430
lines  govorn  which version is being run by the compile option         00104440
X1.  The  source  file  of  the  MPE  integration group has the         00104450
compile  option set at X1=ON, since they support Series II/III.         00104460
The  source of the DUS diagnostics group has the compile option         00104470
set  at  X1=OFF  in  their  source, since they support the HPIB         00104480
version.  Other  than  these  two lines, the rest of the source         00104490
and the maintainance files MUST be identical!                           00104500
                                                                        00104510
     The  source and maintainance files can be obtained by nor-         00104520
mal  methods through the integration group.  The DUS source and         00104530
maintainance files are kept in the group HP32231 in the account         00104540
SUPPORT.  The  machine  in  which  these sources are maintained         00104550
varies.  At  present, they are kept on the machine Mello Yello,         00104560
but  this  could change without notice, so be carefull.  There-         00104570
fore,  after the needed changes have been made and submitted to         00104580
integration,  the new maintainance files MUST then be copied to         00104590
HP32231.SUPPORT  on  the appropriate machine so that the newest         00104600
version  of DUS can be made.  The job file for the HPIB version         00104610
is  called  JSADUTIL  and is kept in HP32231.SUPPORT.  This job         00104620
file is very complicated and MUST be read before doing anything         00104630
for the HPIB version.                                                   00104640
                                                                        00104650
     As  was stated before, the two versions have a seperate RL         00104660
file  containing  all  the  I/O  drivers, plus a bunch of other         00104670
goodies.  The  RL file for the Series II/III version is kept in         00104680
the module called SADTLRL, module RL, and is maintained strict-         00104690
ly  by  the integration group.  This module is used in conjunc-         00104700
tion  with  SADUTIL  to  create  a Seriess II/III program file.         00104710
See the job file in the maintainance account on how the SADUTIL         00104720
program file is created for Series II/III.                              00104730
                                                                        00104740
     The  HPIB  RL  file  is  called  SDFUTIL and is maintained         00104750
strictly  by  the DUS/Diagnostics  group.  The source and main-         00104760
tainace  files  for  SDFUTIL are  kept  in  the  same group and         00104770
account  as  the  HPIB  SADUTIL, HP32231.SUPPORT.  This  module         00104780
again  contains  all the HPIB stand alone drivers, plus a bunch         00104790
of  other good stuff (Serial Disc interface, traps, etc.). This         00104800
module is extremely complicated and great care must be taken if         00104810
changes  are  made  in it.  See  the job file, JSADUTIL in this         00104820
group and account on how the HPIB SADUTIL program file is crea-         00104830
ted.  The process for creating the HPIB SADUTIL program file is         00104840
extremely  complicated  and  prone  to errors.  Again, you MUST         00104850
read  this  file  before  attempting to create a cold load HPIB         00104860
SADUTIL tape.                                                           00104870
                                                                        00104880
     The  two RL files are basically independent except for two         00104890
drivers.  The  drivers  for  the  7976 and the 7935 drivers are         00104900
basically  the  same  except  the  Series  II/III  version runs         00104910
through  the  Starfish  interface.  If changes are needed to be         00104920
made  to  one than changes will probobly be needed in the other         00104930
driver.  The two drivers are MTDVR76 and CS80DSC0.                      00104940
                                                                        00104950
     Now,  I will briefly explain how to create cold load tapes         00104960
for  Series  II/II  and  HPIB.  To  create a cold load tape for         00104970
Series  II/III,  you  will  need the program file SDUPII.  This         00104980
can  be  found  in  the  group  and account, HP32230.SUPPORT on         00104990
one  of  the  production  machines.  Simple  run  this program,         00105000
answering  the  questions properly and entering the name of the         00105010
newly  created  Series  II/III  SADUTIL  program file.  Then go         00105020
reply  to  the  tape request.  See the Utilties Manual for more         00105030
details on how to create a Series II/III SADUTIL tape.                  00105040
                                                                        00105050
     To  create  a  DUS  tape to run SADUTIL, do the following.         00105060
First,  you  must  obtain  the  program file TPSTOMP and the SL         00105070
file  DUSSL.  Both  of  these  can  be  obtained  from the same         00105080
group  and  account,  HP32231.SUPPORT.  Set  up  the  following         00105090
two file equations:                                                     00105100
                                                                        00105110
   :FILE AMIGOSL=DUSSL                                                  00105120
   :FILE AEXPSL =DUSSL                                                  00105130
                                                                        00105140
Then  run  TPSTOMP,TAPE  for magtape and enter the name of your         00105150
newly created HPIB SADUTIL program file. Then, enter CR for the         00105160
following four questions and "DUS" for the fifth question.  You         00105260
are now ready to reply to the tape request.                             00105360
                                                                        00105460
     As  you can see, maintaining SADUTIL can be difficult.  If         00105560
If you have any problems, ask someone.                        ;         00105660
                                                                        00105760
$PAGE                                                                   00105860
                                                               <<*GR1*>>00106000
$IF X1=OFF  << V.UU.FF FOR HPIB SYSTEMS, RUNNING UNDER DUS  >> <<04148>>00108000
                                                               <<04148>>00110000
DEFINE OFFICIAL'VUUFF = "  03.01"#;                            <<06057>>00112000
                                                               <<04148>>00114000
$IF X1=ON   << V.UU.FF FOR SERIES II/III, INCLUDE FILE.     >> <<04148>>00116000
                                                               <<04148>>00118000
$INCLUDE INCLVUF                                               <<04148>>00120000
                                                               <<04148>>00122000
$IF                                                            <<04148>>00124000
                                                               <<04148>>00126000
EQUATE VUUFF'COL = 13;                                         <<04148>>00128000
                                                               <<04148>>00130000
$PAGE "HP/3000 DISC UTILITY - GLOBAL DECLARATIONS "                     00278000
$CONTROL SEGMENT=SADUTIL                                                00280000
                                                                        00282000
<<**********************************************************>> <<06057>>00286000
<< The following DB relative declaration(s) MUST be the 1st.>> <<06057>>00288000
<< declarations in SADUTIL.  They are used for the Series   >> <<06057>>00290000
<< II/III RL routines to pass information to the procedures >> <<06057>>00292000
<< over there since they do not normally access DB relative >> <<06057>>00294000
<< locations.                                               >> <<06057>>00296000
<<                                                          >> <<06057>>00298000
<<                                                          >> <<06057>>00300000
<< The switch register is used to store the DRT number of   >> <<06057>>00302000
<< the cold load device.  Bit 1 is on if it is a HP7976.    >> <<06057>>00304000
<< This info is stored in MB1 by SDUPII when cold loading   >> <<06057>>00305000
<< and is stored here in SETUPSHOP for future use be the    >> <<06057>>00305100
<< procedure PERFORMIO in the Series II/III RL to determine >> <<06057>>00305200
<< which tape drive to write to.                            >> <<06057>>00305300
<<**********************************************************>> <<06057>>00305400
                                                               <<06057>>00305500
INTEGER    SWITCH'REGISTER;  << DB + 0, reserved for RL.    >> <<06057>>00305600
                                                               <<06057>>00305700
<<**********************************************************>> <<06057>>00305800
                                                               <<06057>>00305900
                                                                        00306000
LOGICAL STATUS'REGISTER=Q-1;                                   <<*GR1*>>00308000
INTEGER XREG=X;                                                         00310000
INTEGER X=X;                                                            00312000
INTEGER S0=S-0,S1=S-1,S2=S-2,S3=S-3,S4=S-4,S5=S-5;                      00314000
INTEGER QM0=Q-0,QM5=Q-5,QM7=Q-7;                               <<00.01>>00316000
LOGICAL LS0=S-0;                                                        00318000
BYTE BS0=S-0;                                                  <<SY.31>>00320000
BYTE POINTER BPS0=S-0,BPS1=S-1;                                         00322000
LOGICAL RETURNP=Q-2;  <<RETURN POINTER IN STACK MARKER>>                00324000
                                                                        00326000
                                                                        00328000
EQUATE                                                                  00330000
     SYSLDEV =  1,  <<LOGICAL DEVICE NUMBER FOR SYSTEM DISC>>           00332000
     SERIAL  =  0,  <<Serial device information in LDEV(0)  >> <<*GR1*>>00334000
     CONSLDV = -1,  <<Console info in LDEV(-1) for SeriesIII>> <<03628>>00336000
     LDEVMAX = 64;  <<SDUP RESTRICTION ON SIZE OF INIT. DB AREA>>       00338000
                                                               <<*GR1*>>00340000
<<Logical To Physical Device Table>>                           <<*GR1*>>00342000
LOGICAL ARRAY LPDT(-1:LDEVMAX);                                <<03628>>00344000
<< FORMAT:  ------------------------------------------------ >><<SY.30>>00346000
<<          !       DRT(0:9)      !unused(9:3)! UNIT(12:4) ! >><<SY.30>>00348000
<<          ------------------------------------------------ >><<SY.30>>00350000
                                                               <<SY.30>>00352000
LOGICAL ARRAY LPDTYPE(-1:LDEVMAX);                             <<03628>>00354000
<< FORMAT:  ------------------------------------------------ >><<SY.30>>00356000
<<          !     STYPE (0:8)       !       TYPE(8:8)      ! >><< JSC >>00358000
<<          ------------------------------------------------ >><<SY.30>>00360000
                                                               <<SY.30>>00362000
INTEGER ARRAY VTAB(0:LDEVMAX);                                          00364000
                                                                        00366000
INTEGER FUNCT:=0;                                                       00368000
                                                                        00370000
INTEGER OUTPUTMODE;                                                     00372000
INTEGER ARRAY OUTLEN(0:1):=74,120;                             <<01.DM>>00374000
                                                                        00376000
INTEGER                                                                 00378000
     DISC'STATUS,                                              <<06057>>00378100
     NO'FILES'REEL,  <<FILES PER REEL>>                        <<01.DM>>00380000
     INDEX,                                                             00382000
     INITQ,                                                    <<01.DM>>00384000
     CONTINUEP,                                                <<01.DM>>00386000
     SAVEP,            << USED BY "SETUPSHOP" SAVE REGS >>     <<*GR1*>>00388000
     OSTAT,            << FOR LATER USE BY "CTLY'TRAP"  >>     <<*GR1*>>00390000
     SAVEQ,            <<   TO RE-ENTER AT "RESTART"    >>     <<*GR1*>>00392000
     SAVES,            <<  WITH STACK SET UP THE SAME   >>     <<*GR1*>>00394000
     FDEV,                                                              00396000
     TDEV,                                                              00398000
     RLEN,                                                              00400000
     SYSDU,     <<SYSTEM DISC DRT/UNIT>>                                00406000
     SYSTYPE,   <<SYSTEM DISC SUB-TYPE>>                                00408000
     VTABSIZE;                                                          00410000
                                                                        00412000
                                                               <<01.DM>>00414000
LOGICAL EBLOCKCHANGES:=FALSE;                                           00416000
                                                                        00418000
LOGICAL MISCFLAGS:=0;  << MISCELLANEOUS FLAGS - SET TO FALSE >>         00420000
                                                                        00422000
DEFINE                                                                  00424000
     INIT       = CON %20302; CON 6#,                                   00426000
     SIOP       = CON %20302; CON 0#,                                   00428000
     SYSUP      = MISCFLAGS.(14:1)#;                                    00430000
                                                                        00432000
LOGICAL                                                                 00434000
PVOL'SET,            << True if a private volume set.       >> <<06057>>00435000
FRDEVSPEC, <<From Device Specification>>                       <<*GR1*>>00436000
TODEVSPEC; <<To Device Spec>>                                  <<*GR1*>>00438000
                                                                        00440000
DOUBLE                                                                  00442000
     EBLOCKP,                                                           00444000
<<Directory Base Address(in sectors)>>                         <<*GR1*>>00446000
     DIRBASE,                                                           00448000
<<Volume Table Base Address>>                                  <<*GR1*>>00450000
     VTABASE;                                                           00452000
INTEGER                                                        <<04827>>00454000
   DIR'BITMAP'SIZE;  << Directory bit map size in sectors.  >> <<04827>>00456000
                                                                        00458000
INTEGER ARRAY  <<DIRECTORY INFORMATION STORAGE AREAS>>                  00460000
     INDEXBLOCK(0:767),  <<STORAGE FOR 6 SECTORS>>                      00462000
     ENTRYBLOCK(0:895);  <<STORAGE FOR 7 SECTORS>>                      00464000
                                                                        00466000
INTEGER ARRAY  <<DIRECTORY STORAGE AREA INDEX/ENTRY POINTERS>>          00468000
     XBLOCK(0:2),  <<INDEX BLOCK POINTERS>>                             00470000
     EBLOCK(0:2);  <<ENTRY BLOCK POINTERS>>                             00472000
                                                                        00474000
INTEGER ARRAY  <<DIRECTORY INDEX/ENTRY INFORMATION>>                    00476000
     CECNT(0:2),  <<CURRENT ENTRY COUNTS>>                              00478000
     TECNT(0:2),  <<TOTAL ENTRY COUNTS>>                                00480000
     CXCNT(0:2),  <<CURRENT INDEX COUNTS>>                              00482000
     TXCNT(0:2),  <<TOTAL INDEX COUNTS>>                                00484000
     XSIZE(0:2),  <<INDEX SIZES>>                                       00486000
     ESIZE(0:2),  <<ENTRY SIZES>>                                       00488000
     XBSIZE(0:2), <<INDEX BLOCK SIZES>>                                 00490000
     EBSIZE(0:2); <<ENTRY BLOCK SIZES>>                                 00492000
                                                                        00494000
                                                                        00496000
          <<------------------------------------                        00498000
            MOVING HEAD DISC INFORMATION TABLE                          00500000
          ------------------------------------>>                        00502000
  EQUATE  MHINFOSIZE=    7,          <<ENTRY SIZE>>            <<01.DM>>00504000
          MHDEFLPS  =    0,          <<DEFAULT LOGICAL PACK SIZE>>      00506000
          MHMAXLPS  =    1,          <<MAX LOGICAL PACK SIZE>>          00508000
          MHTRKCYL  =    2,          <<TRACKS/CYLINDER>>                00510000
          MHSECTRK  =    3,          <<SECTORS/TRACK>>                  00512000
          MHTRKMULT =    4,          <<TRACK MULTIPLIER>>               00514000
          MHSTHEAD  =    5,          <<STARTING HEAD #>>       <<25.00>>00516000
          MHFRSPCSCT=    6;          <<SECT IN FREE SPACE TBL>>         00518000
                                                                        00520000
EQUATE  << DISC TYPES >>                                                00522000
   SUCCESSFULL'IO   = 1,                                       <<06057>>00523000
   CS'80'TYPE       = 3,     << Command Set 80 disk type. >>   << JSC >>00524000
   FHDISCTYPE       = 1,     << Fixed head disc.          >>   << JSC >>00526000
   TFLEXIBLE        = 2,     << Flexible disc type        >>   <<*GR1*>>00528000
     MHDISCTYPE   = 0,                                                  00530000
     NMHSUBTYPES = 13;                                         <<SY.31>>00532000
                                                                        00534000
EQUATE  << VOLUME LABEL INFORMATION >>                                  00536000
     LABVOL        = 10,  <<WORD INDEX>>                                00538000
     BLABVOL       = 20,  <<BYTE INDEX>>                                00540000
     LABTYPE       =  6,  <<WORD INDEX>>                                00542000
     LABSYSID      = 16,  <<BYTE INDEX>>                                00544000
     LABCOLDLOAD   =  7;  <<WORD INDEX>>                                00546000
                                                                        00548000
DEFINE                                                                  00550000
     LABDISCTYPE    = QBUF(6).(6:6)#,                                   00552000
     LABDISKSUBTYPE = QBUF(6).(12:4)#;                                  00554000
                                                                        00556000
INTEGER ARRAY MHTABSIZE(0:9) := 12,12,16,32,20,16,24,16,32,64; <<31480>>00558000
                                                                        00560000
INTEGER ARRAY MHINFO(0:NMHSUBTYPES*MHINFOSIZE-1) :=            <<01.DM>>00562000
       66, 70,1,30,1,0,0,    <<STYPE  0, FLOP SINGLE   >>      <<01.DM>>00564000
       66, 70,2,30,1,0,0,    <<STYPE  1, FLOP DOUBLE   >>      <<01.DM>>00566000
       66, 70,1,26,1,0,0,    <<STYPE  2, IBM FLOP SINGLE >>    <<01.DM>>00568000
       66, 70,2,26,1,0,0,    <<STYPE  3, IBM FLOP DOUBLE >>    <<01.DM>>00570000
      400,411,2,48,1,0,20,   <<STYPE  4, 7905, REM CART>>      <<01.DM>>00572000
      400,411,1,48,1,2,16,   <<STYPE  5, 7905, FIXED PLATTER>> <<01.DM>>00574000
      400,411,3,48,1,0,24,   <<STYPE  6, 7905, BOTH PLATTERS>> <<01.DM>>00576000
      120,125,3,48,1,0,16,   <<STYPE  7, FH DISC REPLACEMENT>> <<01.DM>>00578000
      815,823,5,48,1,0,32,   <<STYPE  8, 7920>>                <<01.DM>>00580000
      815,823,9,64,1,0,64,   <<STYPE  9, 7925>>                <<31480>>00582000
      400,411,2,48,1,0,20,   <<STYPE 10, 7906, REMOVEABLE CART><<01.DM>>00584000
      400,411,2,48,1,2,20,   <<STYPE 11, 7906, FIXED PLATTER>> <<01.DM>>00586000
      400,411,4,48,1,0,32;   <<STYPE 12, 7906, BOTH PLATTERS>> <<01.DM>>00588000
LOGICAL ARRAY MHINFOL(*) = MHINFO;                                      00590000
                                                               << JSC >>00592000
                                                               << JSC >>00594000
     << Command Set 80 Disc Information Table.   >>            << JSC >>00596000
                                                               << JSC >>00598000
EQUATE                                                         << JSC >>00600000
   CS80INFOSIZE     = 6,   << # entries per subtype.      >>   << JSC >>00602000
   SECT'TRACK       = 0,   << Sectors per track.          >>   << JSC >>00604000
   TRACKS'CYL       = 1,   << Tracks per cylinder.        >>   << JSC >>00606000
   STARTING'HEAD    = 2,   << Starting Head.              >>   << JSC >>00608000
   TRACK'MULT       = 3,   << Track multiplier.           >>   << JSC >>00610000
   DEFLT'PACK'SIZE  = 4,   << Default logical pack size.  >>   << JSC >>00612000
   MAX'PACK'SIZE    = 5,   << = default for CS'80.        >>   << JSC >>00614000
                                                               << JSC >>00616000
   NCS80SUBTYPES    = 4;   << 7911, 7912, 7914 and 7935.  >>   <<06057>>00618000
                                                               << JSC >>00620000
                                                               << JSC >>00622000
INTEGER ARRAY CS80INFO( 0:NCS80SUBTYPES*CS80INFOSIZE-1 ) :=    << JSC >>00624000
   64,  3,  0,  1,  572,  572,    << 7911 (subtype 1).   >>    << JSC >>00626000
   64,  7,  0,  1,  572,  572,    << 7912 (subtype 2).   >>    << JSC >>00628000
   64,  7,  0,  1, 1152, 1152,    << 7914 (subtype 4).   >>    <<06057>>00629000
   92, 13,  0,  1, 1321, 1321;    << 7935 (subtype 8).   >>    << JSC >>00630000
                                                               << JSC >>00632000
                                                               << JSC >>00634000
INTEGER ARRAY                                                  << JSC >>00636000
   SUBTYPE'TRANSFER(0:10)      << Transfer vector for the >>   << JSC >>00638000
      := -1, 0, 1, -1,  2, -1, << translation of CS80 sub->>   <<06057>>00640000
         -1, -1, 3, -1, -1;    << types into indexes into >>   <<06057>>00642000
                               << CS80INFO.               >>   << JSC >>00644000
                                                               << JSC >>00646000
INTEGER ARRAY                                                  << JSC >>00648000
   MHINFO'TRANSFER(0:CS80INFOSIZE-1) << Transfer vector for >> << JSC >>00650000
      := MHSECTRK,           << translation of an index into>> << JSC >>00652000
         MHTRKCYL,           << CS80INFO to an index into   >> << JSC >>00654000
         MHSTHEAD,           << MHINFO.                     >> << JSC >>00656000
         MHTRKMULT,                                            << JSC >>00658000
         MHDEFLPS,                                             << JSC >>00660000
         MHMAXLPS;                                             << JSC >>00662000
                                                               << JSC >>00664000
<< Note:  for more information on the uses of a "transfer   >> << JSC >>00666000
<<        vector", see the header comment to the procedure, >> << JSC >>00668000
<<        GETDISCINFO.                                      >> << JSC >>00670000
                                                               << JSC >>00672000
                                                               << JSC >>00674000
INTEGER ARRAY FHINFO(0:2):=128,256,512;                        <<*GR1*>>00676000
                                                                        00678000
INTEGER ARRAY SCANINFO(0:15);  <<INFO ON LAST FILE FOUND BY DIRSCAN>>   00680000
DOUBLE ARRAY SCANINFOD(*) = SCANINFO;                                   00682000
BYTE ARRAY SCANANAME(*)   = SCANINFO(2);                                00684000
BYTE ARRAY SCANGNAME(*)   = SCANINFO(8);                                00686000
DEFINE                                                                  00688000
     SCANDRTUNIT     = SCANINFO            #,                           00690000
     SCANSTYPE       = SCANINFO ( 1).STYPEF#,                  <<SY.30>>00692000
     SCANTYPE        = SCANINFO ( 1).DTYPEF#,                  <<SY.30>>00694000
     SCANAINFO       = SCANINFOD( 3)       #,                           00696000
     SCANGINFO       = SCANINFOD( 6)       #,                           00698000
     SCANGINDEXADDR  = SCANINFO (14)       #,                           00700000
     SCANFINDEXADDR  = SCANINFO (15)       #;                           00702000
INTEGER ARRAY IVNAME(0:3);                                              00704000
BYTE ARRAY VNAME(*) = IVNAME;                                           00706000
                                                                        00708000
                                                                        00710000
EQUATE TRACKLEN = 11776, <<7935 track length, 92 sectors *  >> <<03628>>00712000
                         << 128 words/sector                >> <<03628>>00714000
       COPYBUFLEN = 4096; <<Length of COPYTOTAPE buffer     >> <<03628>>00716000
EQUATE SECT'TRACK'MAX = TRACKLEN/128;<< NO. SECTORS IN TRACK >><<01.DM>>00718000
POINTER TRACKBUF;              <<DISC TRACK BUFFER>>           <<01.DM>>00720000
POINTER COPYBUF ;              <<COPYTOTAPE BUFFER>>           <<03628>>00722000
BYTE POINTER BTRACKBUF;                                        <<01.DM>>00724000
POINTER SECTBUF = TRACKBUF;        <<DISC SECTOR BUFFER>>      <<01.DM>>00726000
DOUBLE POINTER SECTBUFD = TRACKBUF;                            <<01.DM>>00728000
BYTE POINTER SECTBUFB = BTRACKBUF;                             <<01.DM>>00730000
POINTER VTABUF = TRACKBUF;                                     <<01.DM>>00732000
BYTE POINTER VTABUFB = BTRACKBUF;                              <<01.DM>>00734000
POINTER PVOL'TABLE;                                            <<06057>>00735000
BYTE POINTER PVOL'TABLE'B;                                     <<06057>>00735500
                                                                        00736000
LOGICAL POINTER USE;   <<DISC-IN-USE LIST>>                    <<01.DM>>00738000
                                                                        00740000
POINTER QBUF;                                                  <<*GR1*>>00742000
  BYTE POINTER BQBUF;                                          <<*GR1*>>00744000
INTEGER POINTER XDTT;                                          <<*GR1*>>00746000
                                                               <<*GR1*>>00748000
<<rearranged tha following arrays so that word buff defined>>  <<31480>>00750000
<<before byte buff, so SPL addrs will be computed correctly>>  <<31480>>00752000
POINTER RBUFW;                                                 <<*GR1*>>00754000
  BYTE POINTER RBUF;                                           <<*GR1*>>00756000
POINTER PBUFW;                                                 <<*GR1*>>00758000
  BYTE POINTER PBUF;                                           <<*GR1*>>00760000
POINTER LBUFW;                                                 <<*GR1*>>00762000
  BYTE POINTER LBUF;                                           <<*GR1*>>00764000
                                                                        00766000
$PAGE                                                          <<*GR1*>>00768000
BYTE ARRAY PREAMBLE(0:18):="SADUTIL 03.01";                    <<06057>>00770000
EQUATE FUNCTMAX = 107;                                         <<06057>>00772000
BYTE ARRAY FUNCTLIST(0:FUNCTMAX):=                                      00774000
     "ERR ",  << FUNCTION ERROR >>                                      00776000
     "   d",  << LTOF:  Lower to Fixed - Deleted >>            <<SY.31>>00778000
     "   d",  << FTOL:  Fixed to Lower - Deleted >>            <<SY.31>>00780000
     "   d",  << UTOF:  Upper to Fixed - Deleted >>            <<SY.31>>00782000
     "   d",  << FTOU:  Fixed to Upper - Deleted >>            <<SY.31>>00784000
     "   d",  << RTOF:  Lower to Fixed in cyl mode - Deleted >><<SY.31>>00786000
     "   d",  << FTOR:  Fixed to Lower in cyl mode - Deleted >><<SY.31>>00788000
     "RTOR",  << COPY REMOVEABLE TO REMOVEABLE >>                       00790000
     "   d",  << UPDT:  Update Fixed from Lower    - Deleted >><<SY.31>>00792000
     "   d",  << INIT:  Initialize Volume - Deleted >>         <<SY.31>>00794000
     "   d",  << COND:  Condense Volume   - Deleted >>         <<SY.31>>00796000
     "   d",  << BDMP:  Build Dump File   - Deleted >>         <<SY.31>>00798000
     "SAVE",  << DISC FILE SAVE >>                                      00800000
     "EDIT",  << DISC EDIT >>                                           00802000
     "   d",  << PFRE:  Print FST  - Deleted >>                <<SY.31>>00804000
     "PDSK",  << PRINT DISC SECTORS >>                                  00806000
     "PDTT",  << PRINT DEFECTIVE TRACKS TABLE >>                        00808000
     "PVOL",  << PRINT VOLUME INFORMATION >>                            00810000
     "PFIL",  << PRINT FILES IN DIRECTORY >>                            00812000
     "OUTM",  << OUTPUT MODE - CONSOLE OR LINE PRINTER >>               00814000
     "CONF",  << CALL CONFIGURATOR >>                                   00816000
     "COPY",  << DISC COPY FUNCTION >>                         <<01.DM>>00818000
     "FIND",  <<FIND VOLUME FOR FILE LABELS>>                  <<*GR1*>>00820000
     "STOP",  << TERMINATE THE DISC UTILITY >>                          00822000
     "DBUG",  << Debugging facility, ti does not work!      >> <<06057>>00824000
     "HELP",  << Explain procedure, it lists out commands.  >> <<06057>>00824500
     "CLID";  << Changes all cold load ID's to 1.           >> <<06057>>00825000
                                                                        00826000
INTEGER POINTER DTT;  <<POINTS TO EITHER SYSDTT OR ALTDTT>>             00828000
                                                                        00830000
EQUATE CCG=0,                                                           00832000
       CCL=1,                                                           00834000
       CCE=2;                                                           00836000
                                                                        00838000
EQUATE  <<DIRECTORY INDEX/ENTRY TYPES>>                                 00840000
     ATYPE = 0,  <<ACCOUNT TYPE>>                                       00842000
     GTYPE = 1,  <<GROUP TYPE>>                                         00844000
     FTYPE = 2;  <<FILE TYPE>>                                          00846000
                                                                        00848000
EQUATE  << DISC I/O COMMANDS >>                                         00850000
     READD  = 0,   <<READ DISC>>                                        00852000
     WRITED = 1,   <<WRITE DISC>>                                       00854000
                                                                        00856000
     READSC = 2,   <<READ AND SET COND. CODE>>                          00858000
     FLAGDT = 3,   <<FLAG DEFECTIVE TRACK>>                             00860000
     READFS = 4;   <<READ FULL SECTOR>>                                 00862000
                                                                        00864000
EQUATE  << TAPE I/0 COMMANDS >>                                         00866000
     BACK'SPACE'FILE  =   8,                                   <<*GR1*>>00868000
     FORWARD'SPACE'FILE  =   7,                                <<06057>>00869000
     REWIND           =   5,                                   <<06057>>00869100
     EOF              =   6,                                   <<*GR1*>>00870000
     REWIND'UNLOAD    =   9,                                   <<*GR1*>>00872000
     SERIAL'DEV       =   2, <<PERFORMIO call for serial dev>> <<*GR1*>>00874000
     READT   = 0,                                                       00876000
     WRITET  = 1;                                                       00878000
                                                                        00880000
EQUATE  <<DIRECTORY DATA SEGMENT VALUES>>                               00882000
     DSIABZ  = 3,                                                       00884000
     DMAXBZ  = 3;                                                       00886000
                                                                        00888000
EQUATE  <<DEFECTIVE TRACKS TABLE VALUES >>                              00890000
     DTTALT = 126,  <<NEXT AVAILABLE ALTERNATE>>                        00892000
     DTTLPS = 127;  <<LOGICAL PACK SIZE>>                               00894000
                                                                        00896000
EQUATE                                                                  00898000
     CR       = %15,                                                    00900000
     CRLF     = %201,                                                   00902000
     NOCRLF   = %320;                                                   00904000
                                                                        00906000
EQUATE   << MAG. TAPE INFORMATION >>                           <<00.01>>00908000
     TAPE'REC'LEN    = 4096,                                   <<00.01>>00910000
     SECT'TAPE'REC   =   32;                                   <<00.01>>00912000
                                                                        00914000
EQUATE BADLABEL = 10;  <<DIRECTORY ERROR NUMBER>>                       00916000
                                                                        00918000
EQUATE  << OUTPUT MODES >>                                              00920000
     CONSOLE   = 0,                                                     00922000
     PRINTER   = 1;                                                     00924000
                                                                        00926000
                                                                        00928000
EQUATE PREFIXSIZE = 10;                                                 00930000
                                                                        00932000
EQUATE  <<PREFIX INFORMATION LOCATIONS>>                                00934000
     XINFOLOC  = 0,  <<INDEX INFORMATION>>                              00936000
     XCOUNTLOC = 1,  <<INDEX COUNT>>                                    00938000
     ETOTALLOC = 3,  <<ENTRY TOTAL>>                                    00940000
     EINFOLOC  = 4;  <<ENTRY INFORMATION>>                              00942000
                                                                        00944000
EQUATE  << INDEX ENTRY INFOMATION >>                                    00946000
     IEPNTRLOC   = 4,                                                   00948000
     IECOUNTLOC  = 5;                                                   00950000
                                                                        00952000
EQUATE  << ACCOUNT/GROUP ENTRY INFORMATION >>                           00954000
     IPNTRLOC   = 4;                                                    00956000
                                                                        00958000
                                                                        00964000
EQUATE                                                                  00966000
     SECTLEN      = 128;  <<SECTOR LENGTH - WORDS>>                     00968000
EQUATE  << COLD LOAD INFORMATION SECTOR >>                              00970000
     MESSADR    =  8,  <<MESSAGE CATALOG ADDRESS LOC (DOUBLE)>>         00972000
     MESSECT    = 22,  <<MESSAGE CATALOG SIZE (SECTORS)>>               00974000
     DIRBASELOC =  6,  <<DIRECTORY ADDRESS LOC. (DOUBLE)>>              00976000
     VTABASELOC = 19,  <<VOLUME TABLE ADDRESS LOC (DOUBLE)>>            00978000
     DIRMAXLOC  = 20,                                                   00980000
     VTABMAXLOC = 36;                                                   00982000
                                                                        00984000
                                                                        00986000
EQUATE MDUMPADDRESS = 18143;  <<(MAX. 7905 DISC ADDRESS) - 1057>>       00988000
                                                                        00990000
                                                                        00992000
DEFINE  << FILE LABEL INFORMATION >>                                    00994000
     FLMISCX       = 28#,                                      <<*GR1*>>00996000
     FLCHECKSUMX   = 34#,                                      <<*GR1*>>00998000
     FLCLIDX       = 35#,                                      <<*GR1*>>01000000
     FLFLIM        = FLABD(15)#,                                        01002000
     FLRECSIZE     = FLAB(37)#,                                         01004000
     FLBLKSIZE     = FLAB(38)#,                                         01006000
     FLSECTOFF     = FLAB(39).(0:8)#,                                   01008000
     FLNUMEXTS     = FLAB(39).(11:5)#,                         <<06057>>01009000
     FLLASTEXTSIZE = FLAB(40)#,                                         01010000
     FLEXTSIZE     = FLAB(41)#;                                         01012000
                                                               <<01.DM>>01014000
EQUATE                                                         <<01.DM>>01016000
     ATTENTION  = 6,                                           <<01.DM>>01018000
     DEVICECLOSE = 4,                                                   01020000
     MAGTAPE    = 24,                                                   01022000
     ST7976     =  1,     <<HP7976 Subtype            >>       <<*GR1*>>01024000
     ST7970     =  0,     <<HP7070 Subtype            >>       <<*GR1*>>01026000
     SADUTILDST = 16;     << DST # OF SADUTIL'S STACK >>       <<01.DM>>01028000
                                                                        01030000
EQUATE              << I/O error codes.                     >> <<06057>>01031000
TRANFAIL = %14,     << Data transfer failure.               >> <<06057>>01031010
EOT      =  %31,    << End of tape on a write.              >> <<06057>>01031100
CHANFAIL = %144,    << I/O channel error.                   >> <<06057>>01031200
SIOFAIL  = %44,     << SIO failure.                         >> <<06057>>01031300
UNITFAIL = %54,     << UNIT failure.                        >> <<06057>>01031400
BSFAIL   = %73,     << BOT and back space file.             >> <<06057>>01031500
NORING   = %40;     << No write ring.                       >> <<06057>>01031600
                                                                        01032000
DEFINE  << PARTIAL FIELDS >>                                            01034000
     DRTF       = (0 :9)#, << DRT field expanded to 9 bits >>  <<SY.30>>01036000
     VOLF       = (0 :8)#,                                              01038000
     UNITF      = (12:4)#,                                              01040000
     STYPEF     = (0 :8)#, << Subtype field >>                 <<SY.30>>01042000
     DTYPEF     = (8 :8)#, << Device type field >>             <<SY.30>>01044000
     XSIZEF     = (5: 7)#,                                     <<01.DM>>01046000
     ESIZEF     = (5: 7)#,                                     <<01.DM>>01048000
     XBSIZEF    = (12:4)#,                                     <<01.DM>>01050000
     EBSIZEF    = (12:4)#,                                     <<01.DM>>01052000
     VTYPEF     = (6 :6)#,                                              01054000
     VSTYPEF    = (12:4)#;                                     <<06057>>01056000
                                                               <<06057>>01057000
DEFINE   << Volume table definitions.                       >> <<06057>>01058000
     PVOL'NUM'VOLS     = INTEGER(PVOL'TABLE(5).(0:4))#,        <<06057>>01059000
     PVOL'STYPE'VTABX  = PVOL'TABLE(I*PVOL'ENTRY'SIZE+5)#,     <<06057>>01059100
     VTAB'NUM'VOLS     = INTEGER(VTABUF(0).(0:8))#,            <<06057>>01060000
     VTAB'ENTRY'SIZE   = INTEGER(VTABUF(0).(8:8))#,            <<06057>>01060100
     VTAB'LDEV         = VTABUF(I*VTAB'ENTRY'SIZE+12).(0:8)#,  <<06057>>01060200
     VTAB'SYSTEM'BITS  = VTABUF(I*VTAB'ENTRY'SIZE+12).(8:8)#;  <<06057>>01060300
                                                               <<06057>>01060400
EQUATE                                                         <<06057>>01060500
     PVOL'ENTRY'SIZE   = 6,                                    <<06057>>01060600
     PVOL'DIRMAXLOC    = 16,                                   <<06057>>01060700
     PVOL'DIRBASELOC   = 15;                                   <<06057>>01060800
                                                                        01062000
DEFINE CC=STATUS'REGISTER.(6:2)#;                              <<*GR1*>>01064000
DEFINE DUPLICATE = ASSEMBLE(DUP)#;                                      01066000
DEFINE DELETE = ASSEMBLE(DEL)#;                                         01068000
DEFINE HARDHALT = ASSEMBLE(HALT 0;BR*-1)#;                              01070000
<<Enable external interrupts>>                                 <<*GR1*>>01072000
DEFINE ENABLE = ASSEMBLE(SED 1)#;                              <<01.DM>>01074000
DEFINE                                                                  01076000
     MPYD = ASSEMBLE(LDXA,LMPY;CAB,LDXA;MPY,ZERO;DADD)#,                01078000
     DIVD = ASSEMBLE(ZERO,CAB;LDXA,LDIV;CAB,LDXA;LDIV)#;                01080000
DEFINE RESETSCANINFO = SCANDRTUNIT:=0#;                                 01082000
DEFINE PRINTSTANDARDINFO = PRINTINFO(LDEV,DRTUNIT,STYPE,0)#;            01084000
DEFINE  << SDUPII turns on bit 1 for 7976 for Series II/III.>> <<06057>>01086000
   HP7976    =    SWITCH'REGISTER.(0:1)=1#,                    <<06057>>01086100
   NOTHP7976 =    SWITCH'REGISTER.(0:1)=0#,                    <<06057>>01086200
   COLDLOADSECT = 28D#;                                        <<06057>>01086300
                                                                        01088000
$PAGE                                                          <<*GR1*>>01090000
<<************************ FORWARD PROCEDURES ************************>>01114000
                                                                        01116000
PROCEDURE SMESSAGE(N);                                         <<06057>>01118000
 VALUE N; INTEGER N;                                                    01120000
 OPTION FORWARD;                                                        01122000
                                                                        01124000
PROCEDURE PDSK(BASEADDRESS);                                            01126000
 VALUE BASEADDRESS;                                                     01128000
 DOUBLE BASEADDRESS;                                                    01130000
 OPTION VARIABLE;                                                       01132000
 OPTION FORWARD;                                                        01134000
                                                               <<01.DM>>01136000
PROCEDURE OUTM;                                                <<01.DM>>01138000
 OPTION FORWARD;                                               <<01.DM>>01140000
                                                                        01142000
LOGICAL PROCEDURE VERIFIED(LDEV,DRTUNIT,SUBTYPE,NOMSG);        <<01.DM>>01144000
   VALUE LDEV,DRTUNIT,SUBTYPE,NOMSG;                           <<01.DM>>01146000
   LOGICAL DRTUNIT,NOMSG;                                      <<01.DM>>01148000
   INTEGER LDEV,SUBTYPE;                                       <<01.DM>>01150000
   OPTION VARIABLE, FORWARD;                                   <<01.DM>>01152000
                                                               <<01.DM>>01154000
PROCEDURE DISC( FUNC, LDEV,DRTUNIT,STYPE,BUF,RECORD,WORDS);    <<06057>>01156000
   VALUE FUNC,  LDEV, RECORD, WORDS, DRTUNIT, STYPE;           <<06057>>01160000
   INTEGER FUNC,  LDEV, DRTUNIT, STYPE, WORDS;                 <<06057>>01162000
   DOUBLE RECORD;                                              << JSC >>01164000
   ARRAY BUF;                                                  << JSC >>01166000
OPTION FORWARD;                                                <<06057>>01168000
                                                               << JSC >>01170000
                                                               <<*GR1*>>01172000
PROCEDURE FUNCTION;                                            <<*GR1*>>01174000
  OPTION FORWARD;                                              <<*GR1*>>01176000
                                                               <<*GR1*>>01178000
PROCEDURE CTLY'TRAP;                                           <<*GR1*>>01180000
  OPTION FORWARD;                                              <<*GR1*>>01182000
                                                               <<*GR1*>>01184000
<<************************ EXTERNAL PROCEDURES ***********************>>01186000
                                                                        01188000
PROCEDURE PRINT(MESSAGE,COUNT,TYPE);                                    01190000
 VALUE COUNT,TYPE;                                                      01192000
 INTEGER COUNT,TYPE;                                                    01194000
 BYTE ARRAY MESSAGE;                                                    01196000
 OPTION EXTERNAL;                                                       01198000
                                                                        01200000
INTEGER PROCEDURE READ(BUFFER,MAXCOUNT);                                01202000
 VALUE MAXCOUNT;                                                        01204000
 INTEGER MAXCOUNT;                                                      01206000
 BYTE ARRAY BUFFER;                                                     01208000
 OPTION EXTERNAL;                                                       01210000
                                                               <<01.DM>>01212000
PROCEDURE SETOFFLINE;                                          <<01.DM>>01214000
 OPTION EXTERNAL;                                              <<01.DM>>01216000
                                                               <<01.DM>>01218000
PROCEDURE CLEAROFFLINE;                                        <<01.DM>>01220000
 OPTION EXTERNAL;                                              <<01.DM>>01222000
                                                               <<01.DM>>01224000
PROCEDURE STARTIDLE; <<INITIATE LOOKING FOR CONTROL Y>>        <<01.DM>>01226000
 OPTION EXTERNAL;                                              <<01.DM>>01228000
                                                               <<01.DM>>01230000
PROCEDURE STOPIDLE;  << STOPS LOOKING FOR CTL Y, CLEARS CTL Y>><<01.DM>>01232000
 OPTION EXTERNAL;                                              <<01.DM>>01234000
                                                               <<01.DM>>01236000
PROCEDURE SETIO( DATA, INDEX);                                 <<01.DM>>01238000
 VALUE DATA, INDEX;                                            <<01.DM>>01240000
 INTEGER DATA, INDEX;                                          <<01.DM>>01242000
 OPTION EXTERNAL;                                              <<01.DM>>01244000
                                                               <<01.DM>>01246000
INTEGER PROCEDURE GETIO( INDEX);                               <<01.DM>>01248000
 VALUE INDEX;                                                  <<01.DM>>01250000
 INTEGER INDEX;                                                <<01.DM>>01252000
 OPTION EXTERNAL;                                              <<01.DM>>01254000
                                                               <<01.DM>>01256000
DOUBLE PROCEDURE PERFORMIO( LDEV, FUNCTION, TARGET, COUNT, PARM);       01258000
 VALUE LDEV, FUNCTION, COUNT, PARM;                            <<01.DM>>01260000
 INTEGER LDEV, FUNCTION, COUNT;                                <<01.DM>>01262000
 ARRAY TARGET;                                                 <<01.DM>>01264000
 DOUBLE PARM;                                                  <<01.DM>>01266000
 OPTION VARIABLE, EXTERNAL;                                    <<01.DM>>01268000
                                                               <<01.DM>>01270000
PROCEDURE INITIALIZEGLOBAL( FIRSTAVAILMEM, LASTAVAILMEM, CURRENTDST,    01272000
        STACKDST);                                             <<01.DM>>01274000
 VALUE FIRSTAVAILMEM, LASTAVAILMEM, CURRENTDST, STACKDST;      <<01.DM>>01276000
 INTEGER FIRSTAVAILMEM, LASTAVAILMEM, CURRENTDST, STACKDST;    <<01.DM>>01278000
 OPTION VARIABLE, EXTERNAL;                                    <<01.DM>>01280000
                                                               <<01.DM>>01282000
PROCEDURE CHANGEDEVICE( SYSDISCDESC, SERIALDESC, AUXDISC1DESC, <<01.DM>>01284000
    AUXDISC2DESC, CONSOLEDESC, PRINTERDESC);                   <<01.DM>>01286000
 VALUE SYSDISCDESC, SERIALDESC, AUXDISC1DESC, AUXDISC2DESC,    <<01.DM>>01288000
    CONSOLEDESC, PRINTERDESC;                                  <<01.DM>>01290000
 DOUBLE SYSDISCDESC, SERIALDESC, AUXDISC1DESC, AUXDISC2DESC,   <<01.DM>>01292000
    CONSOLEDESC, PRINTERDESC;                                  <<01.DM>>01294000
 OPTION VARIABLE, EXTERNAL;                                    <<01.DM>>01296000
                                                               <<01.DM>>01298000
LOGICAL PROCEDURE IDENTIFYDEVICE( DRTUNIT, DESC);              <<01.DM>>01300000
  VALUE DRTUNIT;                                               <<01.DM>>01302000
  INTEGER DRTUNIT;                                             <<01.DM>>01304000
  DOUBLE DESC;                                                 <<01.DM>>01306000
  OPTION EXTERNAL;                                             <<01.DM>>01308000
                                                               <<01.DM>>01310000
$IF X1=OFF                                                     <<*GR1*>>01312000
INTEGER PROCEDURE CALL'DISCDRIVER(DRTUNIT,TYPE,STYPE,FUNCT,    <<*GR1*>>01314000
     RECORD,BUF, WC);                                          <<*GR1*>>01316000
 VALUE DRTUNIT, TYPE, STYPE, FUNCT, RECORD, BUF, WC;           <<01.DM>>01318000
 INTEGER DRTUNIT, TYPE, STYPE, WC;                             <<01.DM>>01320000
 INTEGER FUNCT;                                                <<*GR1*>>01322000
 DOUBLE RECORD, BUF;                                           <<01.DM>>01324000
 OPTION EXTERNAL;                                              <<01.DM>>01326000
$IF X1=ON                                                      <<*GR1*>>01328000
                                                               << JSC >>01330000
                                                               << JSC >>01346000
                                                                        01348000
                                                               <<*GR1*>>01350000
INTEGER PROCEDURE DISCDRIVER(LDEV,DRTUNIT,TYPE,SUBTYPE,FUNCT,  <<*GR1*>>01352000
                    SECT'ADDRESS,DB'ADDRESS,COUNT,LPS);        <<*GR1*>>01354000
  VALUE LDEV,DRTUNIT,TYPE,SUBTYPE,FUNCT,SECT'ADDRESS,COUNT,LPS;<<*GR1*>>01356000
  INTEGER LDEV,DRTUNIT,TYPE,SUBTYPE,FUNCT,COUNT,LPS;           <<*GR1*>>01358000
  DOUBLE SECT'ADDRESS;                                         <<*GR1*>>01360000
  ARRAY DB'ADDRESS;                                            <<*GR1*>>01362000
  OPTION EXTERNAL;                                             <<*GR1*>>01364000
                                                               <<*GR1*>>01366000
$IF                                                            <<*GR1*>>01368000
PROCEDURE WAITINSERTDISC( LDEV);                                        01370000
 VALUE LDEV;                                                            01372000
 INTEGER LDEV;                                                          01374000
 OPTION EXTERNAL;                                                       01376000
                                                                        01378000
PROCEDURE XCONTRAP( TRAPLABEL, OLDTRAPLABEL);                  <<01.DM>>01380000
 VALUE TRAPLABEL;                                              <<01.DM>>01382000
 INTEGER TRAPLABEL, OLDTRAPLABEL;                              <<01.DM>>01384000
 OPTION EXTERNAL;                                              <<01.DM>>01386000
                                                               <<01.DM>>01388000
PROCEDURE TESTCONTROLYTRAP;                                    <<01.DM>>01390000
 OPTION EXTERNAL;                                              <<01.DM>>01392000
                                                               <<01.DM>>01394000
PROCEDURE HELP;                                                <<01.DM>>01396000
 OPTION EXTERNAL;                                              <<01.DM>>01398000
                                                               <<01.DM>>01400000
                                                               <<*GR1*>>01402000
LOGICAL PROCEDURE BINARY(STRING,LENGTH);                       <<*GR1*>>01404000
  VALUE LENGTH;                                                <<*GR1*>>01406000
  BYTE ARRAY STRING;                                           <<*GR1*>>01408000
  INTEGER LENGTH;                                              <<*GR1*>>01410000
  OPTION EXTERNAL;                                             <<*GR1*>>01412000
                                                               <<*GR1*>>01414000
DOUBLE PROCEDURE DBINARY(STRING,LENGTH);                       <<*GR1*>>01416000
  VALUE LENGTH;                                                <<*GR1*>>01418000
  BYTE ARRAY STRING;                                           <<*GR1*>>01420000
  INTEGER LENGTH;                                              <<*GR1*>>01422000
  OPTION EXTERNAL;                                             <<*GR1*>>01424000
                                                               <<*GR1*>>01426000
PROCEDURE TAPE'READY'CHECK;                                    <<*GR1*>>01428000
  OPTION EXTERNAL;                                             <<*GR1*>>01430000
                                                               <<*GR1*>>01432000
                                                               <<01.DM>>01434000
$PAGE "RETRIEVES STATISTIC INFORMATION ON DISCS."              << JSC >>01436000
INTEGER PROCEDURE GETDISCINFO ( TYPE, SUBTYPE, REQUEST );      << JSC >>01438000
   VALUE TYPE, SUBTYPE, REQUEST;                               << JSC >>01440000
   INTEGER TYPE, SUBTYPE, REQUEST;                             << JSC >>01442000
BEGIN                                                          << JSC >>01444000
                                                               << JSC >>01446000
<< This procedure returns statistical information of the disc>><< JSC >>01448000
<< device as specified by TYPE and SUBTYPE.  The information >><< JSC >>01450000
<< it is capable of returning is                             >><< JSC >>01452000
<<       Sectors per track,                                  >><< JSC >>01454000
<<       Tracks per cylinder,                                >><< JSC >>01456000
<<       Starting head,                                      >><< JSC >>01458000
<<       Track multiplier,                                   >><< JSC >>01460000
<<       Default logical pack size,                          >><< JSC >>01462000
<<       Maximum logical pack size.                          >><< JSC >>01464000
<< The parameter, REQUEST, holds a value specifying the      >><< JSC >>01466000
<< information desired.                                      >><< JSC >>01468000
<<                                                           >><< JSC >>01470000
<< This procedure uses global information for the meaning of >><< JSC >>01472000
<< REQUEST and also uses the global arrays, CS80INFO and     >><< JSC >>01474000
<< MHINFO, which stores the informations on the discs        >><< JSC >>01476000
<< supported by SADUTIL.                                     >><< JSC >>01478000
<<                                                           >><< JSC >>01480000
<< ERROR HANDLING:  This procedure returns CCE if a valid    >><< JSC >>01482000
<< disc type was selected and CCL otherwise.  If the disc    >><< JSC >>01484000
<< type is a Command Set 80 disc, then the subtype is checked>><< JSC >>01486000
<< for support by SADUTIL.  If it is not supported, CCL is   >><< JSC >>01488000
<< returned.  Note that there is no check for valid REQUEST. >><< JSC >>01490000
<<                                                           >><< JSC >>01492000
<< TRICKS:  The array MHINFO contains information that is no >><< JSC >>01494000
<< longer needed by SADUTIL; thus, the number of entries per >><< JSC >>01496000
<< disc subtype is different than in CS80INFO.  Rather than  >><< JSC >>01498000
<< waste storage, CS80INFO is smaller than MHINFO; therefore >><< JSC >>01500000
<< the indexes into the arrays are different.  REQUEST is a  >><< JSC >>01502000
<< valid index into CS80INFO but not into MHINFO.  A transfer>><< JSC >>01504000
<< vector, called MHINFO'TRANSFER, is used to translate; thus>><< JSC >>01506000
<< MHINFO'TRANSFER( REQUEST ) is the index needed to get the >><< JSC >>01508000
<< requested information out of MHINFO.                      >><< JSC >>01510000
<<    Also, a similar trick is played to translate a subtype >><< JSC >>01512000
<< of a Command Set 80 disc into an index into CS80INFO.  The>><< JSC >>01514000
<< transfer vector in this case is called SUBTYPE'TRANSFER.  >><< JSC >>01516000
                                                               << JSC >>01518000
                                                               << JSC >>01520000
INTEGER STYPEINDEX;  << Index into CS80INFO.                 >><< JSC >>01522000
                                                               << JSC >>01524000
                                                               << JSC >>01526000
<< Assume successful completion.                             >><< JSC >>01528000
   CC := CCE;                                                  << JSC >>01530000
                                                               << JSC >>01532000
   IF TYPE = CS'80'TYPE THEN      << Command Set 80 Disc.    >><< JSC >>01534000
   BEGIN                                                       << JSC >>01536000
                                                               << JSC >>01538000
      STYPEINDEX := SUBTYPE'TRANSFER( SUBTYPE );               << JSC >>01540000
      IF STYPEINDEX < 0 THEN      << Unknown subtype.        >><< JSC >>01542000
      BEGIN                                                    << JSC >>01544000
         CC := CCL;                                            << JSC >>01546000
         GETDISCINFO := 0;                                     << JSC >>01548000
         RETURN;                                               << JSC >>01550000
      END;                                                     << JSC >>01552000
      GETDISCINFO := CS80INFO( STYPEINDEX * CS80INFOSIZE +     << JSC >>01554000
                               REQUEST );                      << JSC >>01556000
                                                               << JSC >>01558000
   END                                                         << JSC >>01560000
   ELSE                                                        << JSC >>01562000
   IF TYPE = MHDISCTYPE           << Moving Head Disc.       >><< JSC >>01564000
      OR TYPE = TFLEXIBLE         << Flexible disc           >><<*GR1*>>01566000
      THEN  GETDISCINFO := MHINFO( SUBTYPE * MHINFOSIZE +      << JSC >>01568000
                                   MHINFO'TRANSFER(REQUEST) )  << JSC >>01570000
                                                               << JSC >>01572000
   ELSE                           << Unknown Disc Type.      >><< JSC >>01574000
   BEGIN                                                       << JSC >>01576000
      GETDISCINFO := 0;                                        << JSC >>01578000
      CC := CCL;                                               << JSC >>01580000
   END;                                                        << JSC >>01582000
                                                               << JSC >>01584000
END;  << PROC GETDISCINFO >>                                   << JSC >>01586000
$PAGE " "                                                      << JSC >>01588000
                                                               <<01.DM>>01590000
$PAGE "HP/3000 DISC UTILITY - GENERAL UTILITY PROCEDURES"               01592000
PROCEDURE OUTPUT(BUFF,LENGTH);                                          01594000
  VALUE LENGTH;                                                         01596000
  INTEGER LENGTH;                                                       01598000
  ARRAY BUFF;                                                           01600000
  BEGIN                                                                 01602000
    BYTE ARRAY BM(*)=BUFF;                                              01604000
    TESTCONTROLYTRAP;                                          <<01.DM>>01606000
    IF LENGTH > 0 THEN LENGTH := -LENGTH;                      <<01.DM>>01608000
    IF OUTPUTMODE=PRINTER THEN SETOFFLINE;                     <<01.DM>>01610000
    PRINT(BM,LENGTH,CRLF);                                     <<01.DM>>01612000
    CLEAROFFLINE;                                              <<01.DM>>01614000
  END;                                                                  01616000
$PAGE                                                          <<*GR1*>>01618000
LOGICAL PROCEDURE  FMGR(N,BUF,SADR,B1,B2,B3,B4);                        01620000
  VALUE N,B1,B2,B3,B4;                                                  01622000
  INTEGER N,B1,B2,B3,B4;                                                01624000
  INTEGER ARRAY SADR;                                                   01626000
  BYTE ARRAY BUF;                                                       01628000
  OPTION EXTERNAL,VARIABLE;                                             01630000
                                                                        01632000
                                                                        01634000
<<*****************************************************>>               01636000
                                                                        01638000
                                                                        01640000
<<******************************************************>>              01642000
                                                                        01644000
INTEGER PROCEDURE ASCII (WORD, STRING, BASE);                           01646000
   VALUE WORD, BASE;                                                    01648000
   LOGICAL WORD;                                                        01650000
   INTEGER BASE;                                                        01652000
   BYTE ARRAY STRING;  <<RESULT. PROVIDE ROOM FOR AT LEAST 6 BYTES>>    01654000
   OPTION VARIABLE,PRIVILEGED;                                          01656000
                                                                        01658000
BEGIN                                                                   01660000
   LOGICAL PMAP = Q-4;                                                  01662000
   BYTE ARRAY TEMP (0:5) = Q;                                           01664000
   INTEGER WORDD = WORD;                                                01666000
   LOGICAL FLAGS:=0;                                                    01668000
   DEFINE START = FLAGS.(15:1) #;                                       01670000
   DEFINE RTJUST = FLAGS.(14:1) #;                                      01672000
   INTEGER LENGTH = Q-8;                                                01674000
                                                                        01676000
<< MAIN CODE >>                                                         01678000
   IF NOT PMAP THEN BASE:=10;  <<BASE 10 DEFAULT>>                      01680000
   IF NOT (-8<=BASE<=8) THEN                                            01682000
      BEGIN                                                             01684000
      IF BASE <> 10 THEN                                                01686000
         BEGIN    <<RT JUSTIFY REQUEST>>                                01688000
         RTJUST:=TRUE;                                                  01690000
         BASE:=10;                                                      01692000
         END;                                                           01694000
      IF WORDD < 0 THEN                                                 01696000
         BEGIN                                                          01698000
         PUSH (STATUS);                                                 01700000
         ASSEMBLE (TRBC 2);                                             01702000
         SET (STATUS);                                                  01704000
         WORDD_ -WORDD;                                                 01706000
         IF OVERFLOW THEN                                               01708000
            BEGIN                                                       01710000
            MOVE TEMP:="-32768";                                        01712000
            XREG:=0;                                                    01714000
            GOTO SETUP;                                                 01716000
            END;                                                        01718000
         START:=TRUE;                                                   01720000
         END;                                                           01722000
      TOS_ WORDD;                                                       01724000
      XREG:=6;                                                          01726000
      DO BEGIN                                                          01728000
         TOS:=BASE;                                                     01730000
         ASSEMBLE (DIV, DECX);                                          01732000
         TEMP(XREG):=TOS +%60;                                          01734000
         ASSEMBLE (TEST);                                               01736000
         END                                                            01738000
      UNTIL =;                                                          01740000
      IF START THEN TEMP (XREG:=XREG -1):="-";                          01742000
SETUP:                                                                  01744000
      << XREG = LEFT BYTE OF RESULT IN TEMP >>                          01746000
      LENGTH:=6 -XREG;                                                  01748000
      TOS:=@STRING;    <<SETUP FOR MOVE>>                               01750000
      TOS:=@TEMP;                                                       01752000
      IF RTJUST THEN                                                    01754000
         BEGIN    <<RT JUSTIFICATION>>                                  01756000
         TOS:=TOS +5;                                                   01758000
         TOS:=-LENGTH;                                                  01760000
         END                                                            01762000
      ELSE                                                              01764000
         BEGIN    <<LEFT JUSTIFY>>                                      01766000
         TOS:=TOS +XREG;                                                01768000
         TOS:=LENGTH;                                                   01770000
         END;                                                           01772000
      << (S-3):(S-1) = MOVE SETUP >>                                    01774000
      ASSEMBLE (MVB);                                                   01776000
      END                                                               01778000
   ELSE                                                                 01780000
      BEGIN    <<OCTAL>>                                                01782000
      XREG:=5;                                                          01784000
      LENGTH:=1;                                                        01786000
      IF BASE < 0 THEN @STRING:=@STRING-5;                              01788000
      STRING(XREG):=%60;                                                01790000
      TOS_ WORD;                                                        01792000
      DO BEGIN                                                          01794000
         DUPLICATE;                                                     01796000
         TOS:=TOS LAND 7;                                               01798000
         IF <> THEN LENGTH:=6-XREG;                                     01800000
         IF S1 <> 0 THEN STRING (XREG):=TOS + %60 ELSE DELETE;          01802000
         TOS:=TOS & LSR(3);                                             01804000
         XREG:=XREG -1;                                                 01806000
         END                                                            01808000
      UNTIL <;                                                          01810000
      END;                                                              01812000
END  << ASCII >>;                                                       01814000
$PAGE                                                          <<*GR1*>>01816000
                                                                        01818000
<<*******************************************************>>             01820000
                                                                        01822000
INTEGER PROCEDURE DASCII(WORD,BASE,STRING);                             01824000
   VALUE WORD,BASE;                                                     01826000
   DOUBLE WORD; INTEGER BASE;                                           01828000
   BYTE ARRAY STRING;                                                   01830000
   OPTION PRIVILEGED;                                                   01832000
BEGIN LOGICAL SNFLG:=FALSE;                                             01834000
      INTEGER J;                                                        01836000
      BYTE ARRAY LSTRING(0:10);                                         01838000
      INTEGER LENGTH = Q-8;                                             01840000
      LOGICAL K=S-0;                                                    01842000
      DOUBLE TOP=S-1;                                                   01844000
      J:=11;                                                            01846000
      TOS:=WORD;                                                        01848000
      IF (-8<=BASE<=8) THEN  <<OCTAL CONVERSION>>                       01850000
      BEGIN LENGTH:=1;                                                  01852000
            MOVE LSTRING:="          0";                                01854000
            WHILE (J:=J-1) >= 0 DO                                      01856000
            BEGIN TOS:=K LAND 7;                                        01858000
                  IF <> THEN LENGTH:=11-J;                              01860000
                  IF S1 <> 0 THEN LSTRING(J):=TOS+%60 ELSE DELETE;      01862000
                  TOS:=TOS & DLSR(3);                                   01864000
            END;                                                        01866000
            IF BASE < 0 THEN  <<LEFT JUSTIFY SIGNIFICANT OCTADES>>      01868000
            BEGIN                                                       01870000
                 TOS:=LENGTH;                                           01872000
                 J:=11-LENGTH;                                          01874000
            END ELSE                                                    01876000
            BEGIN                                                       01878000
                 TOS:=11;                                               01880000
                 J:=J + 1;                                              01882000
            END;                                                        01884000
            GO TO FINISH                                                01886000
      END;                                                              01888000
      ASSEMBLE(DTST);                                                   01890000
      IF = THEN                                                         01892000
      BEGIN LSTRING(10):=%60;                                           01894000
            TOS:=(LENGTH:=1);                                           01896000
            J:=10;                                                      01898000
            GO TO FINISH                                                01900000
      END;                                                              01902000
      IF < THEN                                                         01904000
      BEGIN SNFLG:=TRUE;                                                01906000
            IF TOP <> %20000000000D THEN ASSEMBLE(DNEG);                01908000
      END;                                                              01910000
LOOP:                                                                   01912000
      J:=J - 1;                                                         01914000
      ASSEMBLE(ZERO,CAB);                                               01916000
      TOS:=10;                                                          01918000
      ASSEMBLE(DIVL,CAB);                                               01920000
      TOS:=10;                                                          01922000
      ASSEMBLE(DIVL);                                                   01924000
      LSTRING(J):=TOS + %60;                                            01926000
      ASSEMBLE(DTST);                                                   01928000
      IF = THEN                                                         01930000
      BEGIN IF SNFLG THEN                                               01932000
            BEGIN J:=J - 1;                                             01934000
                  LSTRING(J):="-";                                      01936000
            END;                                                        01938000
            TOS := (LENGTH:=11-J);                                      01940000
FINISH:                                                                 01942000
            MOVE STRING:=LSTRING (J), (S0);                             01944000
            RETURN;                                                     01946000
      END;                                                              01948000
      GO TO LOOP                                                        01950000
END   << DASCII >>;                                                     01952000
$PAGE                                                          <<*GR1*>>01954000
                                                                        01956000
<<************************************************************>>        01958000
                                                                        01960000
  PROCEDURE SMESSAGE(N);                                       <<06057>>01962000
    VALUE N; INTEGER N;    <<MESSAGE NUMBER>>                           01964000
      BEGIN                                                             01966000
        BYTE ARRAY VOCAB(*)=PB:=                               <<06057>>01968000
<<00>>    1,"*",                                                        01970000
<<01>>    1,"#",                                                        01972000
<<02>>    1,",",                                                        01974000
<<03>>    1,"-",                                                        01976000
<<04>>    2,%15,%12,                                                    01978000
<<05>>    2,"IN",                                                       01980000
<<06>>    2,"NO",                                                       01982000
<<07>>    2,"OF",                                                       01984000
<<08>>    2,"OR",                                                       01986000
<<09>>    2,"TO",                                                       01988000
<<10>>    3,"CPU",                                                      01990000
<<11>>    3,"DRT",                                                      01992000
<<12>>    3,"DTT",                                                      01994000
<<13>>    3,"FOR",                                                      01996000
<<14>>    3,"JOB",                                                      01998000
<<15>>    3,"MAX",                                                      02000000
<<16>>    3,"NOT",                                                      02002000
<<17>>    3,"SEG",                                                      02004000
<<18>>    4,"AREA",                                                     02006000
<<19>>    4,"CODE",                                                     02008000
<<20>>    4,"DATA",                                                     02010000
<<21>>    4,"DISC",                                                     02012000
<<22>>    4,"FROM",                                                     02014000
<<23>>    4,"FULL",                                                     02016000
<<24>>    4,"JOBS",                                                     02018000
<<25>>    4,"LIST",                                                     02020000
<<26>>    4,"MUST",                                                     02022000
<<27>>    4,"NAME",                                                     02024000
<<28>>    4,"PACK",                                                     02026000
<<29>>    4,"PART",                                                     02028000
<<30>>    4,"SIZE",                                                     02030000
<<31>>    4,"TIME",                                                     02032000
<<32>>    4,"TYPE",                                                     02034000
<<33>>    4,"UNIT",                                                     02036000
<<34>>    5,"ENTER",                                                    02038000
<<35>>    5,"ERROR",                                                    02040000
<<36>>    5,"EXTRA",                                                    02042000
<<37>>    5,"GROUP",                                                    02044000
<<38>>    5,"LABEL",                                                    02046000
<<39>>    5,"LIMIT",                                                    02048000
<<40>>    5,"LOGON",                                                    02050000
<<41>>    5,"STACK",                                                    02052000
<<42>>    5,"TABLE",                                                    02054000
<<43>>    5,"TRACK",                                                    02056000
<<44>>    5,"VALID",                                                    02058000
<<45>>    6,"DELETE",                                                   02060000
<<46>>    6,"DEVICE",                                                   02062000
<<47>>    6,"FACTOR",                                                   02064000
<<48>>    6,"IGNORE",                                                   02066000
<<49>>    6,"SYSTEM",                                                   02068000
<<50>>    6,"VOLUME",                                                   02070000
<<51>>    7,"ACCOUNT",                                                  02072000
<<52>>    7,"ADDRESS",                                                  02074000
<<53>>    7,"CHANGES",                                                  02076000
<<54>>    7,"DEFAULT",                                                  02078000
<<55>>    7,"DELETED",                                                  02080000
<<56>>    7,"DEVICES",                                                  02082000
<<57>>    7,"ENTRIES",                                                  02084000
<<58>>    7,"FLAGGED",                                                  02086000
<<59>>    7,"ILLEGAL",                                                  02088000
<<60>>    7,"INVALID",                                                  02090000
<<61>>    7,"LOGICAL",                                                  02092000
<<62>>    7,"RECOVER",                                                  02094000
<<63>>    7,"RUNNING",                                                  02096000
<<64>>    7,"SECONDS",                                                  02098000
<<65>>    7,"SUBTYPE",                                                  02100000
<<66>>    7,"WARNING",                                                  02102000
<<67>>    8,"FUNCTION",                                                 02104000
<<68>>    8,"REASSIGN",                                                 02106000
<<69>>    8,"REFORMAT",                                                 02108000
<<70>>    8,"REQUIRED",                                                 02110000
<<71>>    8,"RESERVED",                                                 02112000
<<72>>    8,"SESSIONS",                                                 02114000
<<73>>    9,"ALTERNATE",                                                02116000
<<74>>    9,"AVAILABLE",                                                02118000
<<75>>    9,"COMPLETED",                                                02120000
<<76>>    9,"DIRECTORY",                                                02122000
<<77>>   10,"ALTERNATES",                                               02124000
<<78>>   10,"CONCURRENT",                                               02126000
<<79>>   10,"CONFIGURED",                                               02128000
<<80>>   10,"REMOVEABLE",                                               02130000
<<81>>   11,"(CYLINDERS)",                                              02132000
<<82>>   11,"IMPLEMENTED",                                              02134000
<<83>>   12,"REINITIALIZE",                                             02136000
<<84>>   13,"CONFIGURATION",                                            02138000
<<85>>   13,"SPECIFICATION",                                            02140000
<<86>>   13,"UNINITIALIZED",                                            02142000
<<87>>   16,"SEGMENTS/PROCESS",                                         02144000
<<88>>    7,"PRINTER",                                                  02146000
<<89>>    6,"SERIAL",                                                   02148000
<<90>>    6,"OUTPUT",                                                   02150000
<<91>>    2,"BE",                                              <<01.DM>>02152000
<<92>>    4,"SAME",                                            <<01.DM>>02154000
<<93>>    4,"COPY",                                            <<01.DM>>02156000
<<94>>    9,"OPERATION",                                       <<01.DM>>02158000
<<95>>    8,"CONTINUE",                                        <<01.DM>>02160000
<<96>>    7,"CONSOLE",                                         <<03628>>02162000
<<97>>    4,"READ",                                            <<06057>>02162100
<<98>>    7,"PRIVATE",                                         <<06057>>02162200
<<99>>    3,"SET",                                             <<06057>>02162300
          0;                                                            02164000
$PAGE                                                          <<*GR1*>>02166000
        BYTE ARRAY DICT(*)=PB:=                                <<06057>>02168000
<<00>>    4,0,60,0,4,            <<* INVALID *>>                        02170000
<<01>>    4,60,21,52,4,          <<INVALID DISC ADDRESS>>               02172000
<<02>>    3,16,82,4,             <<NOT IMPLEMENTED - AVAILABLE>>        02174000
<<03>>    3,16,82,4,             <<NOT IMPLEMENTED - AVAILABLE>>        02176000
<<04>>    3,49,21,23,            <<SYSTEM DISC FULL>>                   02178000
<<05>>    6,60,65,13,22,46,4,    <<INVALID SUBTYPE FOR FROM DEVICE>>    02180000
<<06>>    6,60,65,13,9,46,4,     <<INVALID SUBTYPE FOR TO DEVICE>>      02182000
<<07>>    5,61,28,30,35,4,       <<LOGICAL PACK SIZE ERROR>>            02184000
<<08>>    4,6,77,74,4,           <<NO ALTERNATES AVAILABLE>>            02186000
<<09>>    4,44,38,3,83,          <<VALID LABEL - REINITIALIZE>>         02188000
<<10>>    3,76,23,4,             <<DIRECTORY FULL>>                     02190000
<<11>>    4,59,46,85,4,          <<ILLEGAL DEVICE SPECIFICATION>>       02192000
<<12>>    4,60,46,85,4,          <<INVALID DEVICE SPECIFICATION>>       02194000
<<13>>    8,80,29,7,49,21,16,79, <<REMOVEABLE PART OF SYSTEM DISC>>     02196000
            4,                   <<NOT CONFIGURED>>                     02198000
<<14>>    6,0,67,16,75,0,4,      <<* FUNCTION NOT COMPLETED *>>         02200000
<<15>>    4,50,42,35,4,          <<VOLUME TABLE ERROR>>                 02202000
<<16>>    3,76,35,4,             <<DIRECTORY ERROR>>                    02204000
<<17>>    5,49,21,16,79,4,       <<SYSTEM DISC NOT CONFIGURED>>         02206000
<<18>>    3,86,21,4,             <<UNINITIALIZED DISC>>                 02208000
<<19>>    4,49,21,86,4,          <<SYSTEM DISC UNINITIALIZED>>          02210000
<<20>>    3,34,50,27,            <<ENTER VOLUME NAME>>                  02212000
<<21>>    4,61,28,30,81,         <<LOGICAL PACK SIZE(CYLINDERS)>>       02214000
<<22>>    5,6,57,5,42,4,         <<NO ENTRIES IN TABLE>>                02216000
<<23>>    3,45,8,62,             <<DELETE OR RECOVER>>                  02218000
<<24>>    3,45,8,68,             <<DELETE OR REASSIGN>>                 02220000
<<25>>    5,45,2,68,8,62,        <<DELETE,REASSIGN OR RECOVER>>         02222000
<<26>>    5,55,43,5,12,4,        <<DELETED TRACK IN DTT>>               02224000
<<27>>    8,55,43,60,3,26,69,28, <<DELETED TRACK INVALID - >>           02226000
            4,                   <<MUST REFORMAT PACK>>                 02228000
<<28>>    6,66,3,5,73,18,4,      <<WARNING - IN ALTERNATE AREA>>        02230000
<<29>>    1,45,                  <<DELETE>>                             02232000
<<30>>   10,58,43,5,71,18,3,     <<FLAGGED TRACK IN RESERVED AREA>>     02234000
            26,69,28,4,          <<- MUST REFORMAT PACK>>               02236000
<<31>>    6,66,3,5,71,18,4,      <<WARNING - IN RESERVED AREA>>         02238000
<<32>>    1,62,                  <<RECOVER>>                            02240000
<<33>>    3,46,84,53,            <<DEVICE CONFIGURATION CHANGES>>       02242000
<<34>>    2,61,46,               <<LOGICAL DEVICE>>                     02244000
<<35>>    1,11,                  <<DRT>>                                02246000
<<36>>    1,33,                  <<UNIT>>                               02248000
<<37>>    1,32,                  <<TYPE>>                               02250000
<<38>>    1,65,                  <<SUBTYPE>>                            02252000
<<39>>    3,25,61,56,            <<LIST LOGICAL DEVICES>>               02254000
<<40>>    2,84,53,               <<CONFIGURATION CHANGES>>              02256000
<<41>>    5,54,14,10,31,39,      <<DEFAULT JOB CPU TIME LIMIT>>         02258000
<<42>>    5,1,7,64,9,40,         <<# OF SECONDS TO LOGON>>              02260000
<<43>>    4,15,19,17,30,         <<MAX CODE SEG SIZE>>                  02262000
<<44>>    5,15,1,7,19,87,        <<MAX # OF CODE SEGMENTS/PROCESS>>     02264000
<<45>>    3,15,41,30,            <<MAX STACK SIZE>>                     02266000
<<46>>    5,15,36,20,17,30,      <<MAX EXTRA DATA SEG SIZE>>            02268000
<<47>>    6,15,1,7,36,20,87,     <<MAX # OF DATA SEGMENTS/PROCESS>>     02270000
<<48>>    6,15,1,7,78,63,72,     <<MAX # OF CONCURRENT RUNNING >>       02272000
                                 << SESSIONS>>                          02274000
<<49>>    6,15,1,7,78,63,24,     <<MAX # OF CONCURRENT RUNNING >>       02276000
                                 << JOBS>>                              02278000
<<50>>    2,47,53,               <<FACTOR CHANGES>>                     02280000
<<51>>    2,30,47,               <<SIZE FACTOR>>                        02282000
<<52>>    2,88,11,               <<PRINTER DRT>>                        02284000
<<53>>    3,21,84,53,            <<DISC CONFIGURATION CHANGES>>         02286000
<<54>>    4,67,16,82,4,          <<FUNCTION NOT IMPLEMENTED>>           02288000
<<55>>    4,49,21,11,1,          <<SYSTEM DISC DRT #>>                  02290000
<<56>>    3,89,46,53,            <<SERIAL DEVICE CHANGES>>     <<01.DM>>02292000
<<57>>    3,22,61,46,            <<FROM LOGICAL DEVICE>>       <<01.DM>>02294000
<<58>>    3,9,61,46,             <<TO LOGICAL DEVICE>>         <<01.DM>>02296000
<<59>>    1,95,                                                <<01.DM>>02298000
<<60>>    4,59,93,94,4,          <<ILLEGAL COPY OPERATION>>    <<01.DM>>02300000
<<61>>    4,60,89,46,4,          <<INVALID SERIAL DEVICE>>     <<01.DM>>02302000
<<62>>    3,68,49,96,            <<REASSIGN SYSTEM CONSOLE  >> <<03628>>02304000
<<63>>    4,21,97,35,4,          << DISC READ ERROR         >> <<06057>>02304100
<<64>>    3,25,89,46,            << LIST SERIAL DEVICE      >> <<06057>>02304200
<<65>>    3,98,50,99,            << PRIVATE VOLUME SET      >> <<06057>>02304300
          0;                                                            02306000
$PAGE                                                          <<*GR1*>>02308000
        INTEGER ARRAY MESSBUF(0:35);                                    02310000
        BYTE ARRAY BMESS(*) = MESSBUF;                                  02312000
        BYTE POINTER BPMESS := @BMESS;                                  02314000
        INTEGER I:=0,COUNT;                                             02316000
                                                                        02318000
          BMESS:=" ";  <<INSERT LEADING BLANK>>                         02320000
          IF SYSUP THEN @BPMESS:=@BPMESS+1;  <<INDENT FUNCT. MESSAGES>> 02322000
          XREG := -1;                                                   02324000
          TOS := 0;                                                     02326000
          TOS := @BS0+1;    <<ADDRESS OF RIGHT BYTE OF S-1>>            02328000
          TOS := @DICT;                                                 02330000
          WHILE (XREG:=XREG+1) <= \N\ DO                                02332000
            BEGIN                                                       02334000
              TOS := TOS+S2;    <<UPDATE DICT POINTER>>                 02336000
              MOVE * := * PB,(1),1;      <<COUNT IN S-2>>               02338000
              ASSEMBLE(DECB);  <<POINT S-1 BACK TO S-2>>                02340000
            END;                                                        02342000
          COUNT := S2;   <<NUMBER OF VOCAB ENTRIES IN MESSAGE>>         02344000
          WHILE (I:=I+1) <= COUNT DO                                    02346000
            BEGIN                                                       02348000
              MOVE * := * PB,(1),1;  <<VOCAB ENTRY NUMBER>>             02350000
              ASSEMBLE(DECB);                                           02352000
              XREG := -1;                                               02354000
              TOS := 0;                                                 02356000
              TOS := @BS0+1;                                            02358000
              TOS := @VOCAB;                                            02360000
              WHILE (XREG:=XREG+1) <= S5 DO                             02362000
                BEGIN                                                   02364000
                  TOS := TOS+S2;    <<UPDATE VOCAB PTR>>                02366000
                  MOVE * := * PB,(1),1;   <<VOCAB ENTRY LENGTH>>        02368000
                  ASSEMBLE(DECB);                                       02370000
                END;                                                    02372000
              MOVE BPMESS := * PB,(S2),2;  <<MOVE MESSAGE>>             02374000
              TOS := TOS-1;                                             02376000
              IF INTEGER(BPS0)<>%12 THEN                                02378000
                BEGIN  <<DELIMIT WITH BLANK>>                           02380000
                  TOS := TOS+1;                                         02382000
                  BPS0 := " ";                                          02384000
                END;                                                    02386000
              @BPMESS := TOS+1;                                         02388000
              DDEL;                                                     02390000
            END;                                                        02392000
          TOS:=@BMESS;                                                  02394000
          TOS := @BMESS;                                                02396000
          TOS := @BPMESS;                                               02398000
          IF N<0 THEN                                                   02400000
            BEGIN       <<APPEND QUESTION MARK>>                        02402000
              BPS0 := " ";                                              02404000
              TOS := TOS-1;                                             02406000
              BPS0 := "?";                                              02408000
              TOS := TOS+2;                                             02410000
            END;                                                        02412000
          ASSEMBLE(SUB);   <<COMPUTE NUMBER OF BYTES>>                  02414000
          PRINT(*,*,NOCRLF);                                            02416000
END << MESSAGE >>;                                                      02418000
$PAGE                                                          <<06057>>02418010
PROCEDURE EXPL;                                                <<06057>>02418020
                                                               <<06057>>02418030
<<**********************************************************>> <<06057>>02418040
<< This procedure prints out a short summary of all the     >> <<06057>>02418050
<< SADUTIL commands                                         >> <<06057>>02418060
<<**********************************************************>> <<06057>>02418070
                                                               <<06057>>02418080
BEGIN                                                          <<06057>>02418090
INTEGER LEN;                                                   <<06057>>02418100
                                                               <<06057>>02418110
SUBROUTINE CLEAR'BUFF;                                         <<06057>>02418120
BEGIN                                                          <<06057>>02418130
PBUF:=" ";MOVE PBUF(1):=PBUF,(79);                             <<06057>>02418140
END;                                                           <<06057>>02418150
                                                               <<06057>>02418160
CLEAR'BUFF; PRINT(PBUF,-1,CRLF);                               <<06057>>02418170
MOVE PBUF(2) :=                                                <<06057>>02418180
"Below are all the commands supported by SADUTIL";             <<06057>>02418190
PRINT(PBUF,-79,CRLF); CLEAR'BUFF;                              <<06057>>02418200
PRINT(PBUF,-1,CRLF);                                           <<06057>>02418210
MOVE PBUF :=  "CLID";                                          <<06057>>02418220
MOVE PBUF(21) := "Set all Cold Load ID's to 1";                <<06057>>02418230
PRINT(PBUF,-79,CRLF); CLEAR'BUFF;                              <<06057>>02418240
MOVE PBUF := "CONF [ldev]";                                    <<06057>>02418250
MOVE PBUF(21) := "Configure logical devices";                  <<06057>>02418260
PRINT(PBUF,-79,CRLF); CLEAR'BUFF;                              <<06057>>02418270
MOVE PBUF := "COPY";                                           <<06057>>02418280
MOVE PBUF(21) := "Copy one disk to another";                   <<06057>>02418290
PRINT(PBUF,-79,CRLF); CLEAR'BUFF;                              <<06057>>02418300
MOVE PBUF := "DBUG";                                           <<06057>>02418310
MOVE PBUF(21) := "Enter symbolic debugger";                    <<06057>>02418320
PRINT(PBUF,-79,CRLF); CLEAR'BUFF;                              <<06057>>02418330
MOVE PBUF := "EDIT";                                           <<06057>>02418340
MOVE PBUF(21) := "Below are the five edit commands";           <<06057>>02418350
PRINT(PBUF,-79,CRLF); CLEAR'BUFF;                              <<06057>>02418360
MOVE PBUF := "  BASE [basesector]";                            <<06057>>02418370
MOVE PBUF(21) := "Specifies base sector number";               <<06057>>02418380
PRINT(PBUF,-79,CRLF); CLEAR'BUFF;                              <<06057>>02418390
MOVE PBUF := "  DISC [ldev]";                                  <<06057>>02418400
MOVE PBUF(21) := "Specifies logical device to edit";           <<06057>>02418410
PRINT(PBUF,-79,CRLF); CLEAR'BUFF;                              <<06057>>02418420
MOVE PBUF :=                                                   <<06057>>02418430
"  MODIFY [diskaddr][,wordloc][,wordcount] Modify a sector";   <<06057>>02418440
PRINT(PBUF,-79,CRLF); CLEAR'BUFF;                              <<06057>>02418450
MOVE PBUF := "  PDSK";                                         <<06057>>02418460
MOVE PBUF(21) :=                                               <<06057>>02418470
"Print Disk. Enter address as [address][,sectcount][;A|O]";    <<06057>>02418480
PRINT(PBUF,-79,CRLF); CLEAR'BUFF;                              <<06057>>02418490
MOVE PBUF := "  OUTM [C|P]";                                   <<06057>>02418500
MOVE PBUF(21) := "Output to Console or Printer";               <<06057>>02418510
PRINT(PBUF,-79,CRLF); CLEAR'BUFF;                              <<06057>>02418520
MOVE PBUF := "FIND";                                           <<06057>>02418530
MOVE PBUF(21) := "Scan a disk for file labels";                <<06057>>02418540
PRINT(PBUF,-79,CRLF); CLEAR'BUFF;                              <<06057>>02418550
MOVE PBUF := "HELP";                                           <<06057>>02418560
MOVE PBUF(21) := "Explain facility";                           <<06057>>02418570
PRINT(PBUF,-79,CRLF); CLEAR'BUFF;                              <<06057>>02418580
MOVE PBUF := "OUTM [C|P]";                                     <<06057>>02418590
MOVE PBUF(21) := "Output to Console or Printer";               <<06057>>02418600
PRINT(PBUF,-79,CRLF); CLEAR'BUFF;                              <<06057>>02418610
MOVE PBUF := "PDTT [ldev]";                                    <<06057>>02418620
MOVE PBUF(21) := "Print Defective Tracks Table";               <<06057>>02418630
PRINT(PBUF,-79,CRLF); CLEAR'BUFF;                              <<06057>>02418640
MOVE PBUF := "PDSK [ldev]";                                    <<06057>>02418650
MOVE PBUF(21) :=                                               <<06057>>02418660
"Print Disk. Enter address as [address][,sectcount][;A|O]";    <<06057>>02418670
PRINT(PBUF,-79,CRLF); CLEAR'BUFF;                              <<06057>>02418680
MOVE PBUF :=  "PFIL";                                          <<06057>>02418690
MOVE PBUF(21) := "Print Files names from directory";           <<06057>>02418700
PRINT(PBUF,-79,CRLF); CLEAR'BUFF;                              <<06057>>02418710
MOVE PBUF := "PVOL [ldev]";                                    <<06057>>02418720
MOVE PBUF(21) := "Print Volume Label of ldev";                 <<06057>>02418730
PRINT(PBUF,-79,CRLF); CLEAR'BUFF;                              <<06057>>02418740
MOVE PBUF := "SAVE";                                           <<06139>>02418741
MOVE PBUF(21) := "Save files to serial device";                <<06139>>02418742
PRINT(PBUF,-79,CRLF); CLEAR'BUFF;                              <<06139>>02418743
MOVE PBUF := "STOP";                                           <<06057>>02418750
MOVE PBUF(21) := "Exit SADUTIL";                               <<06057>>02418760
PRINT(PBUF,-79,CRLF); CLEAR'BUFF;                              <<06057>>02418770
PRINT(PBUF,-1,CRLF);                                           <<06057>>02418780
END;                                                           <<06057>>02418790
$PAGE                                                          <<*GR1*>>02420000
                                                                        02422000
                                                                        02424000
PROCEDURE PRINTINFO(LDEV,DRTUNIT,STYPE,OFFSET);                         02426000
VALUE LDEV,DRTUNIT,STYPE,OFFSET;                                        02428000
INTEGER LDEV,DRTUNIT,STYPE,OFFSET;                                      02430000
BEGIN                                                                   02432000
     << PRINTS STANDARD LINE OF INFORMATION COMMON TO                   02434000
        ALL PRINT FUNCTIONS >>                                          02436000
     INTEGER I;                                                         02438000
     ARRAY BLANK(0:0);                                         <<01.01>>02440000
                                                                        02442000
     SUBROUTINE SPACE(SPACENUM);                                        02444000
     VALUE SPACENUM; INTEGER SPACENUM;                                  02446000
     BEGIN                                                              02448000
          MOVE BLANK:="  ";                                             02450000
          FOR I:=1 UNTIL SPACENUM DO                                    02452000
          OUTPUT(BLANK,2);                                              02454000
     END <<SPACE>>;                                                     02456000
     LBUF:=" ";                                                         02460000
     MOVE LBUF(OFFSET):=(" LDEV=    , DRT=    , UNIT=    , TYPE=    ,", 02462000
                         " SUBTYPE=    ");                              02464000
     ASCII(LDEV,LBUF(9+OFFSET),-10);                                    02466000
     ASCII(DRTUNIT.DRTF,LBUF(19+OFFSET),-10);                           02468000
     ASCII(DRTUNIT.UNITF,LBUF(30+OFFSET),-10);                          02470000
     ASCII(LPDTYPE(LDEV).DTYPEF,LBUF(41+OFFSET),-10);          <<SY.30>>02472000
     ASCII(STYPE,LBUF(55+OFFSET),-10);                                  02474000
     OUTPUT(LBUFW,56+OFFSET);                                  <<01.01>>02476000
     IF OUTPUTMODE = PRINTER THEN SPACE(2);                             02478000
END << PRINTINFO >>;                                                    02480000
$PAGE                                                          <<*GR1*>>02482000
                                                                        02484000
<<**********************************************************>> <<*GR1*>>02486000
<< This procedure converts the data from ASCII to JULIAN    >> <<*GR1*>>02488000
<< and vise-versa.  If Date is returned a -1, then an error >> <<*GR1*>>02490000
<< occured during conversion.                               >> <<*GR1*>>02492000
<<**********************************************************>> <<*GR1*>>02494000
                                                               <<*GR1*>>02496000
LOGICAL PROCEDURE DATECONV(BA,N,CONVTYPE);                              02498000
VALUE CONVTYPE;                                                         02500000
BYTE ARRAY BA;INTEGER N,CONVTYPE;                                       02502000
OPTION VARIABLE;                                                        02504000
BEGIN                                                                   02506000
     LOGICAL PMAP = Q-4;                                                02508000
     INTEGER I,M,D,Y;                                                   02510000
     LOGICAL NUMERROR;                                                  02512000
     BYTE POINTER SI;                                                   02514000
     EQUATE   SYSB      = 3;                                            02516000
     EQUATE   ASCII'TO'JULIAN = 0,                                      02518000
              JULIAN'TO'ASCII = 1;                                      02520000
     INTEGER ARRAY DTAB(0:11)=PB_0,31,59,90,120,151,181,                02522000
                                 212,243,273,304,334;                   02524000
     INTEGER ARRAY DIMO(0:11)=PB _ 31,28,31,30,31,30,                   02526000
                                   31,31,30,31,30,31;                   02528000
     INTEGER SUBROUTINE GETNUM(NUM);                                    02530000
     INTEGER NUM;                                                       02532000
     BEGIN                                                              02534000
          NUMERROR:=FALSE;                                              02536000
          SCAN SI WHILE %6440,1;  <<SUPPRESS LEADING BLANKS>>           02538000
          @SI:=TOS;                                                     02540000
          MOVE SI:=SI WHILE N,1;                                        02542000
          I:=TOS-@SI;                                                   02544000
          IF = THEN                                                     02546000
          BEGIN                                                         02548000
               NUMERROR:=TRUE;                                          02550000
               RETURN;                                                  02552000
          END;                                                          02554000
          IF I > 2 THEN  <<TOO LONG>>                                   02556000
          BEGIN                                                         02558000
               NUMERROR:=TRUE;                                          02560000
               RETURN;                                                  02562000
          END;                                                          02564000
          TOS:=SI-"0";                                                  02566000
          @SI:=@SI+1;                                                   02568000
          IF I > 1 THEN                                                 02570000
          BEGIN                                                         02572000
               TOS:=TOS*10+(SI-"0");                                    02574000
               @SI:=@SI+1;                                              02576000
          END;                                                          02578000
          I:=TOS;                                                       02580000
          NUM:=I;                                                       02582000
          SCAN SI WHILE %6440,1;                                        02584000
          @SI:=TOS;                                                     02586000
     END <<GETNUM>>;                                                    02588000
                                                                        02590000
         IF NOT PMAP THEN CONVTYPE:=ASCII'TO'JULIAN;  <<DEFAULT CONV.>> 02592000
         IF CONVTYPE = JULIAN'TO'ASCII THEN                             02594000
         BEGIN                                                          02596000
              Y:=N.(0:7);                                               02598000
              D:=N.(7:9);                                               02600000
              IF Y.(14:2) = 0 AND D >= 60 THEN D:=D-1;  <<LEAP YEAR>>   02602000
              M:=12;                                                    02604000
              DO M:=M-1 UNTIL DTAB(M) < D;  <<FIND CORRECT MONTH>>      02606000
              D:=D-DTAB(M);  <<DAY OF THE MONTH>>                       02608000
              M:=M+1; <<FIX MONTH FOR OUTPUT PURPOSES>>                 02610000
              MOVE BA:="  /  /  ";                                      02612000
              ASCII(M,BA(1),-10);                                       02614000
              ASCII(D,BA(4),-10);                                       02616000
              ASCII(Y,BA(7),-10);                                       02618000
              RETURN;                                                   02620000
         END;                                                           02622000
         @SI _ QM7;                                            <<00.01>>02624000
         SI(N) _ %15;                  <<STOPPER>>                      02626000
         GETNUM(M);           <<MONTH>>                                 02628000
         IF NUMERROR THEN GOTO ERRORL;                                  02630000
         IF SI <> "/" THEN                                              02632000
          BEGIN                        <<ILLEGAL SEPARATOR>>            02634000
ERRORL :   DATECONV:=-1;                                                02636000
           GO OUT;                                                      02638000
          END;                                                          02640000
         @SI _ @SI+1;                                                   02642000
         GETNUM(D);           <<DAY>>                                   02644000
         IF NUMERROR THEN GOTO ERRORL;                                  02646000
         IF SI <> "/" THEN GOTO ERRORL;                                 02648000
         @SI _ @SI+1;                                                   02650000
         GETNUM(Y);           <<YEAR>>                                  02652000
         IF NUMERROR THEN GOTO ERRORL;                                  02654000
         IF SI <> %15 THEN GOTO ERRORL;                                 02656000
         IF (1<=M<=12) AND (1<=D<=31) AND (Y>0) THEN                    02658000
          BEGIN                        <<RANGE SEEMS OK>>               02660000
           TOS _ D;                    <<DAY>>                          02662000
           TOS _ DIMO(M-1);            <<#DAYS IN MONTH>>               02664000
           IF (Y MOD 4=0) AND (M=2) THEN                                02666000
            TOS _ TOS+1;               <<LEAP YEAR>>                    02668000
           IF TOS > TOS THEN GOTO ERRORL;                               02670000
           TOS _D+DTAB(M-1);                                            02672000
           IF (Y MOD 4 = 0) AND (M>2) THEN TOS_TOS+1;                   02674000
           <<THIS ROUTINE WILL NOT WORK BEYOND THE YEAR 1999. IT WILL   02676000
             FUNCTION BEYOND 1999 IF THE FOLLOWING TEST IS ADDED TO     02678000
             THE ABOVE IF STATEMENT :                                   02680000
             ((Y MOD 100 > 0) OR (Y MOD 400 = 0)).                      02682000
           >>                                                           02684000
           TOS.(0:7) _ Y;                                               02686000
DEFAULT:   DATECONV:=TOS;                                               02688000
          END                                                           02690000
         ELSE                                                           02692000
          GO ERRORL;                   <<INCORRECT DATE FORMAT>>        02694000
OUT:                                                                    02696000
END << DATECONV >> ;                                                    02698000
$PAGE "HP/3000 DISC UTILITY - DISC UTILITY PROCEDURES"                  02700000
INTEGER PROCEDURE ALTTRACK(LDEV,DRTUNIT,STYPE,TRACK);                   02702000
  VALUE LDEV,DRTUNIT,STYPE,TRACK;                                       02704000
  INTEGER LDEV,DRTUNIT,STYPE,TRACK;                                     02706000
    COMMENT                                                             02708000
      FINDS THE TRACK NUMBER OF THE ALTERNATE OF THE SPECIFIED TRACK    02710000
    AND RETURNS IT. IF UNABLE TO READ THE ALTERNATE TRACK NUMBER,       02712000
    RETURNS -1;                                                         02714000
      BEGIN                                                             02716000
        INTEGER I := -1;                                                02718000
        DOUBLE SECTOR,BA;                                               02720000
        INTEGER ARRAY B(0:140) = Q;                                     02722000
          PUSH(DB);                                                     02724000
          TOS := TOS+@B;                                                02726000
          BA := TOS;  <<ABSOLUTE ADDRESS OF B>>                         02728000
          TOS:=STYPE;                                                   02730000
          ASSEMBLE(DUP,STAX);                                           02732000
          TOS := GETDISCINFO ( LPDTYPE(LDEV).DTYPEF, STYPE,    << JSC >>02734000
                               SECT'TRACK );                   << JSC >>02736000
          TOS := TRACK;                                                 02738000
          ASSEMBLE(LMPY);                                               02740000
          SECTOR := TOS;                                                02742000
          WHILE (I:=I+1) < GETDISCINFO( LPDTYPE(LDEV).DTYPEF,  << JSC >>02744000
                                        STYPE, SECT'TRACK   )  << JSC >>02746000
          DO                                                   << JSC >>02748000
            BEGIN                                                       02750000
              DISC( 4, LDEV, DRTUNIT, STYPE, B,                << JSC >>02752000
                    SECTOR+DOUBLE(I), 141);                    <<06057>>02754000
              IF B(1)=B(139) AND B(2).(3:5)=B(140).(3:5) THEN           02758000
                BEGIN  <<VALID ALTERNATE ADDRESS>>                      02760000
                  IF B(1)=-1 THEN ALTTRACK := -1                        02762000
                  ELSE IF B(1)=0 AND B(2).(3:5)=0 THEN ALTTRACK:=0      02764000
                  ELSE ALTTRACK := B(1) +                      << JSC >>02766000
                          GETDISCINFO( LPDTYPE(LDEV).DTYPEF,   << JSC >>02768000
                                       STYPE, TRACKS'CYL ) +   << JSC >>02770000
                          B(2).(3:5) -                         << JSC >>02772000
                          GETDISCINFO( LPDTYPE(LDEV).DTYPEF,   << JSC >>02774000
                                       STYPE, STARTING'HEAD ); << JSC >>02776000
                  RETURN;                                               02778000
                END;                                                    02780000
            END;                                                        02782000
          ALTTRACK := -2;  <<NO GOOD ALT TRACK READ>>                   02784000
      END <<ALTTRACK>> ;                                                02786000
$PAGE                                                          <<*GR1*>>02788000
          <<-----------------------------------                         02790000
            DISC DRIVER (DB-RELATIVE ADDRESS)                           02792000
          ----------------------------------->>                         02794000
  PROCEDURE DISC(FUNCT,LDEV,DRTUNIT,STYPE,BUF,RECORD,WORDS);   <<06057>>02796000
  VALUE FUNCT,LDEV,RECORD,WORDS,DRTUNIT,STYPE;                 <<06057>>02798000
  INTEGER FUNCT,       << 0 for read, 1 for write.          >> <<06057>>02800000
          LDEV,        << Logical device number of disc.    >> <<06057>>02802000
          DRTUNIT,     << DRT in (0:9), UNIT in (12:4).     >> <<06057>>02804000
          STYPE,       << Subtype of disc.                  >> <<06057>>02806000
          WORDS;       << Number of words to transfer.      >> <<06057>>02808000
  DOUBLE RECORD;       << Sector address.                   >> <<06057>>02810000
  ARRAY BUF;           << DB relative buffer.               >> <<06057>>02812000
                                                               <<06057>>02814000
BEGIN                                                          <<06057>>02818000
    INTEGER DISKDEV;   << Device type of disc.              >> <<06057>>02820000
    DOUBLE ABS'ADDR;   << Absolute address of buffer.       >> <<06057>>02822000
                                                               <<06057>>02824000
    CC := CCE;         << Assume successfull completion.    >> <<06057>>02826000
    IF WORDS = 0                                               <<06057>>02828000
       THEN RETURN;    << Don't do any I/O.                 >> <<06057>>02830000
    DISKDEV := LPDTYPE(LDEV).DTYPEF;                           <<06057>>02832000
                                                               <<06057>>02834000
    <<******************************************************>> <<06057>>02836000
    << For Series II/III we use DISCDRIVER, found in the RL >> <<06057>>02838000
    << to call the proper disc driver routine. For HPIB, we >> <<06057>>02840000
    << use CALL'DISCDRIVER to call the correct routine.     >> <<06057>>02842000
    << This procedure is found in SDFUTIL.                  >> <<06057>>02844000
    <<******************************************************>> <<06057>>02846000
                                                               <<06057>>02848000
$IF X1=OFF             << HPIB drivers found in SDFUTIL.    >> <<06057>>02850000
    PUSH( DB );        << Obtain absolute address of the    >> <<06057>>02852000
    TOS := TOS+@BUF;   << users buffer.                     >> <<06057>>02854000
    ABS'ADDR := TOS;                                           <<06057>>02856000
    DISC'STATUS := CALL'DISCDRIVER(DRTUNIT,DISKDEV,STYPE,FUNCT <<06057>>02858000
                                   ,RECORD,ABS'ADDR,WORDS);    <<06057>>02860000
$IF X1=ON              << Series II/III drivers found in RL.>> <<06057>>02862000
    DISC'STATUS := DISCDRIVER( LDEV, DRTUNIT, DISKDEV, STYPE,  <<06057>>02864000
                          FUNCT,RECORD,BUF,WORDS,DTT(DTTLPS)); <<06057>>02866000
$IF                                                            <<06057>>02868000
    IF DISC'STATUS <> SUCCESSFULL'IO                           <<06057>>02870000
       THEN CC := CCL; << Damn, an error occured on the I/O.>> <<06057>>02872000
END;                                                           <<01.DM>>02902000
                                                               <<06057>>02904000
PROCEDURE PRINT'DISC'ERROR(STATUS,SECTOR);                     <<06057>>02904010
VALUE STATUS,SECTOR;                                           <<06057>>02904020
INTEGER STATUS;                                                <<06057>>02904030
DOUBLE SECTOR;                                                 <<06057>>02904040
BEGIN                                                          <<06057>>02904050
INTEGER LEN;                                                   <<06057>>02904060
                                                               <<06057>>02904070
MOVE PBUF:="DISC ERROR    AT SECTOR %          ";              <<06057>>02904080
ASCII(STATUS,PBUF(11),10);                                     <<06057>>02904090
DASCII(SECTOR,8,PBUF(25));                                     <<06057>>02904100
PRINT(PBUFW,-35,CRLF);                                         <<06057>>02904110
IF STATUS = TRANFAIL THEN                                      <<06057>>02904120
   MOVE PBUF := "TRANSFER ERROR",2                             <<06057>>02904130
ELSE IF STATUS = UNITFAIL THEN                                 <<06057>>02904140
   MOVE PBUF := "UNIT FAILURE",2                               <<06057>>02904150
ELSE IF STATUS = CHANFAIL THEN                                 <<06057>>02904160
   MOVE PBUF := "I/O CHANNEL FAILURE",2                        <<06057>>02904170
ELSE                                                           <<06057>>02904180
   MOVE PBUF := "UNKNOWN DEVICE FAILURE",2;                    <<06057>>02904190
LEN := TOS - @PBUF;                                            <<06057>>02904200
PRINT(PBUF,-LEN,CRLF);                                         <<06057>>02904210
END;                                                           <<06057>>02904220
$PAGE "HP/3000 DISC UTILITY - TABLE/INFORMATION UTILITIES"     <<06057>>02904230
<<*************************************************************>>       02906000
                                                                        02908000
                                                                        02910000
INTEGER PROCEDURE CHECKSUM(FLAB);                              <<*GR1*>>02912000
LOGICAL ARRAY FLAB;                                                     02914000
BEGIN                                                                   02916000
     INTEGER X = X;  <<X REGISTER>>                                     02918000
     EQUATE                                                             02920000
          FLSKIP1 = 28,                                                 02922000
          FLSKIP2 = 34,                                                 02924000
          FLSKIP3 = 35;                                                 02926000
                                                                        02928000
     TOS:=-1;                                                           02930000
     X:=127;                                                            02932000
     DO BEGIN                                                           02934000
          IF X <> FLSKIP1 AND X <> FLSKIP2 AND X <> FLSKIP3 THEN        02936000
          TOS:=TOS XOR FLAB(X);                                         02938000
          X:=X-1;                                                       02940000
     END UNTIL <;                                                       02942000
     CHECKSUM := TOS;                                          <<01.DM>>02944000
END << CHECKSUM >>;                                                     02946000
$PAGE                                                          <<*GR1*>>02948000
<<**********************************************************>> <<*GR1*>>03110000
<< Obtain volume informaition for a particular disk.  Obtain>> <<*GR1*>>03112000
<< volume cold laod ID from word 7 of volume label (Secoor  >> <<*GR1*>>03114000
<< 1 of disk), Volume ID is found in byte 20, and Volume    >> <<*GR1*>>03116000
<< Type is found in word 6.                                 >> <<*GR1*>>03118000
<<**********************************************************>> <<*GR1*>>03120000
                                                               <<*GR1*>>03122000
PROCEDURE GETVOLINFO(LDEV,DRTUNIT,STYPE,VTYPE,VOLID,VCLID);             03124000
VALUE LDEV,DRTUNIT,STYPE;                                               03126000
INTEGER LDEV,DRTUNIT,STYPE,VTYPE,VCLID;                                 03128000
BYTE ARRAY VOLID;                                                       03130000
OPTION VARIABLE;                                                        03132000
BEGIN                                                                   03134000
     LOGICAL PMAP = Q-4;                                                03136000
                                                                        03138000
     CC:=CCE;  <<ASSUME SUCCESSFUL COMPLETION>>                         03140000
     DISC(READD,LDEV,DRTUNIT,STYPE,SECTBUF,0D,SECTLEN);        <<06057>>03142000
     IF PMAP THEN VCLID:=SECTBUF(LABCOLDLOAD);                          03144000
     IF PMAP.(14:1) THEN MOVE VOLID:=SECTBUFB(BLABVOL),(8);             03146000
     IF PMAP.(13:1) THEN VTYPE:=SECTBUF(LABTYPE);                       03148000
END << GETVOLINFO >>;                                                   03150000
$PAGE                                                          <<*GR1*>>03152000
                                                                        03154000
PROCEDURE GETDIRC'VTAB'INFO(LDEV,DRTUNIT,STYPE,DADDR,DSIZE,             03156000
   VADDR,VSIZE,CLTABLE);                                                03158000
VALUE LDEV,DRTUNIT,STYPE;                                               03160000
INTEGER LDEV,DRTUNIT,STYPE,DSIZE,VSIZE;                                 03162000
DOUBLE DADDR,VADDR;                                                     03164000
ARRAY CLTABLE;                                                          03166000
OPTION VARIABLE;                                                        03168000
BEGIN                                                                   03170000
     LOGICAL PMAP = Q-4;                                                03172000
     DEFINE                                                             03174000
          CLTABLESPEC  = PMAP#,                                         03176000
          VSIZESPEC    = PMAP.(14:1)#,                                  03178000
          VADDRSPEC    = PMAP.(13:1)#,                                  03180000
          DSIZESPEC    = PMAP.(12:1)#,                                  03182000
          DADDRSPEC    = PMAP.(11:1)#;                                  03184000
     INTEGER POINTER TABLE;                                             03188000
     DOUBLE POINTER TABLED;                                             03190000
                                                                        03192000
<<**********************************************************>> <<04827>>03194000
<< VSIZE - Size of volume table                             >> <<*GR1*>>03196000
<< VADDR - Sector address of beginning of volume table      >> <<*GR1*>>03198000
<< This procedure reads and parses Sector 28 of the system  >> <<04827>>03202000
<< which contains the Cold Load information for the disk.   >> <<*GR1*>>03204000
<< DSIZE = Directory size, maximum location of directory    >> <<*GR1*>>03206000
<< DADDR = Directory base address location                  >> <<*GR1*>>03208000
<<**********************************************************>> <<*GR1*>>03210000
                                                               <<*GR1*>>03212000
SECTBUF(0) := 0;                                               <<06057>>03212100
MOVE SECTBUF(1) := SECTBUF(0),(255);                           <<06057>>03212200
CC := CCE;                                                     <<06057>>03214000
IF PVOL'SET THEN                                               <<06057>>03216000
   BEGIN  << Private volume, get info from sector 0D.       >> <<06057>>03216100
   DISC(READD,LDEV,DRTUNIT,STYPE,SECTBUF,0D,SECTLEN);          <<06057>>03216200
   IF VSIZESPEC THEN VSIZE := SECTLEN;                         <<06057>>03217200
   IF VADDRSPEC THEN VADDR := 0D;                              <<06057>>03217300
   IF DSIZESPEC THEN DSIZE := SECTBUF(PVOL'DIRMAXLOC);         <<06057>>03217400
   IF DADDRSPEC THEN DADDR := DOUBLE(SECTBUF(PVOL'DIRBASELOC));<<06057>>03217500
   END                                                         <<06057>>03217600
ELSE                                                           <<06057>>03217700
   BEGIN                                                       <<06057>>03217800
   DISC(READD,LDEV,DRTUNIT,STYPE,SECTBUF,COLDLOADSECT,256);    <<06057>>03218000
   IF CLTABLESPEC THEN MOVE CLTABLE:=SECTBUF,(256);            <<06057>>03220000
   IF DSIZESPEC THEN DSIZE:=SECTBUF(DIRMAXLOC);                <<06057>>03222000
   IF DADDRSPEC THEN DADDR:=SECTBUFD(DIRBASELOC);              <<06057>>03224000
   @TABLE:=@TABLED:=@SECTBUF(SECTBUF(0));                      <<06057>>03226000
   IF VSIZESPEC THEN VSIZE:=TABLE(VTABMAXLOC);                 <<06057>>03228000
   IF VADDRSPEC THEN VADDR:=TABLED(VTABASELOC);                <<06057>>03230000
   END;                                                        <<06057>>03231000
END <<GETDIRC'VTAB'INFO >>;                                             03232000
$PAGE                                                          <<*GR1*>>03234000
                                                                        03236000
<<**********************************************************>> <<*GR1*>>03238000
<< Obtain the index into the volume table to insert the     >> <<*GR1*>>03240000
<< logical device number for BUILDVOLUMETABLE.  Index will  >> <<*GR1*>>03242000
<< depend on which entry into the system volume table the   >> <<*GR1*>>03244000
<< device resides.                                          >> <<*GR1*>>03246000
<<**********************************************************>> <<*GR1*>>03248000
                                                               <<*GR1*>>03250000
INTEGER PROCEDURE VTABINDEX(LDEV,DRTUNIT,STYPE);                        03252000
VALUE LDEV,DRTUNIT,STYPE;                                               03254000
INTEGER LDEV,DRTUNIT,STYPE;                                             03256000
BEGIN                                                                   03258000
     INTEGER I,LOC;                                            <<06057>>03260000
     BYTE ARRAY VOLID(0:7);                                             03262000
                                                                        03264000
     CC:=CCE;  <<ASSUME SUCCESSFUL COMPLETION>>                         03266000
     GETVOLINFO(LDEV,DRTUNIT,STYPE,,VOLID);                             03268000
                                                               <<*GR1*>>03280000
     <<*****************************************************>> <<*GR1*>>03282000
     << Read volume table from system disk, starting at     >> <<*GR1*>>03284000
     << volume table base.  Then obtain Volume Table ENTry  >> <<*GR1*>>03286000
     << SIZE from proper fields.                            >> <<*GR1*>>03288000
     <<*****************************************************>> <<*GR1*>>03290000
                                                               <<*GR1*>>03292000
     DISC(READD,SYSLDEV,SYSDU,SYSTYPE,VTABUF,VTABASE,VTABSIZE);<<06057>>03294000
     IF PVOL'SET THEN                                          <<06057>>03295000
        BEGIN  << Private volume set, search PVOL table.    >> <<06057>>03296000
        @PVOL'TABLE := @VTABUF(25);  << Skip to PVOL table. >> <<06057>>03297000
        @PVOL'TABLE'B := @PVOL'TABLE*2;                        <<06057>>03298000
                                                               <<06057>>03300000
        << Search volume table for Volume ID.               >> <<06057>>03301000
                                                               <<06057>>03302000
        FOR I:= 1 UNTIL PVOL'NUM'VOLS DO                       <<06057>>03303000
           BEGIN                                               <<06057>>03304000
           LOC := (I*PVOL'ENTRY'SIZE)*2;                       <<06057>>03305000
           IF VOLID = PVOL'TABLE'B(LOC),(8) THEN               <<06057>>03306000
              BEGIN                                            <<06057>>03307000
              VTABINDEX := I;                                  <<06057>>03308000
              I := PVOL'NUM'VOLS; << Jump out of loop!      >> <<06057>>03309000
              END;                                             <<06057>>03310000
           END;                                                <<06057>>03311000
        END                                                    <<06057>>03312000
     ELSE                                                      <<06057>>03313000
        BEGIN                                                  <<06057>>03314000
                                                               <<06057>>03316000
        << Search volume table for Volume ID                  ><<06057>>03318000
                                                               <<06057>>03319000
        FOR I:=1 UNTIL VTAB'NUM'VOLS DO                        <<06057>>03320000
           BEGIN                                               <<06057>>03321000
           LOC:=(I*VTAB'ENTRY'SIZE)*2;                         <<06057>>03322000
           IF VOLID = VTABUFB(LOC),(8) THEN                    <<06057>>03322100
              BEGIN                                            <<06057>>03322200
              VTABINDEX:=I;                                    <<06057>>03322300
              I := VTAB'NUM'VOLS;  << Terminate FOR loop.   >> <<06057>>03322400
              END;                                             <<06057>>03322500
           END;                                                <<06057>>03322600
        END;                                                   <<06057>>03322700
END << VTABINDEX >>;                                                    03324000
                                                               <<04827>>03326000
INTEGER PROCEDURE GET'DIR'BITMAP'SIZE;                         <<04827>>03328000
                                                               <<04827>>03330000
<<**********************************************************>> <<04827>>03332000
<< This procedure simply obtains the size, in sectors, of   >> <<04827>>03334000
<< the directory bit map for use by directory routines to   >> <<04827>>03336000
<< skip over the bit map to get to the Account Index Blk.   >> <<04827>>03338000
<<                                                          >> <<04827>>03340000
<< Output variables:                                        >> <<04827>>03342000
<<    GET'DIR'BITMAP'SIZE - The size of the bit map in      >> <<04827>>03344000
<<                          sectors.                        >> <<04827>>03346000
<<**********************************************************>> <<04827>>03348000
                                                               <<04827>>03350000
BEGIN                                                          <<04827>>03352000
INTEGER RETURN'VAL = GET'DIR'BITMAP'SIZE;                      <<04827>>03354000
                                                               <<04827>>03356000
DISC(READD,SYSLDEV,SYSDU,SYSTYPE,SECTBUF,DIRBASE,SECTLEN);     <<04827>>03358000
                                                               <<04827>>03360000
RETURN'VAL := (SECTBUF(0)+2+SECTLEN-1)/SECTLEN;                <<06057>>03362000
IF RETURN'VAL < 3                                              <<04827>>03364000
   THEN RETURN'VAL := 3;  << Must by >=3.                   >> <<04827>>03366000
                                                               <<04827>>03368000
END;                                                           <<04827>>03370000
$PAGE                                                          <<*GR1*>>03372000
<<**********************************************************>> <<*GR1*>>03374000
<< Obtain the volume number from the user if the volume name>> <<*GR1*>>03376000
<< found on the disk cannot be found in the volume table.   >> <<*GR1*>>03378000
<<**********************************************************>> <<*GR1*>>03380000
                                                               <<*GR1*>>03382000
INTEGER PROCEDURE GET'NEW'VTAB'INDEX;                          <<*GR1*>>03384000
                                                               <<*GR1*>>03386000
  BEGIN                                                        <<*GR1*>>03388000
                                                               <<*GR1*>>03390000
    INTEGER VOL'NUM=GET'NEW'VTAB'INDEX;                        <<*GR1*>>03392000
    LOGICAL DONE:=FALSE;                                       <<*GR1*>>03394000
                                                               <<*GR1*>>03396000
    MOVE PBUF:="Enter Volume Table Entry for LDEV:";           <<*GR1*>>03398000
    WHILE NOT DONE DO                                          <<*GR1*>>03400000
      BEGIN                                                    <<*GR1*>>03402000
        PRINT(PBUF,-34,NOCRLF);                                <<*GR1*>>03404000
        RLEN:=READ(RBUF,-2);                                   <<*GR1*>>03406000
        IF RLEN=0 THEN DONE:=TRUE;                             <<*GR1*>>03408000
        VOL'NUM:=BINARY(RBUF,RLEN);                            <<*GR1*>>03410000
        IF <> OR (VOL'NUM < SYSLDEV)OR (VOL'NUM > LDEVMAX) THEN<<*GR1*>>03412000
           BEGIN                                               <<*GR1*>>03414000
             SMESSAGE(0);                                      <<06057>>03416000
             VOL'NUM:=0;                                       <<*GR1*>>03418000
           END                                                 <<*GR1*>>03420000
        ELSE DONE:=TRUE;                                       <<*GR1*>>03422000
                                                               <<*GR1*>>03424000
      END; <<While a valid answer has not been given>>         <<*GR1*>>03426000
                                                               <<*GR1*>>03428000
  END; << GET'NEW'VTAB'INDEX>>                                 <<*GR1*>>03430000
$PAGE                                                          <<06057>>03430010
PROCEDURE CHECK'VOLUME'TABLE;                                  <<06057>>03430020
BEGIN                                                          <<06057>>03430030
INTEGER I,LEN,LOC;                                             <<06057>>03430040
                                                               <<06057>>03430050
<<**********************************************************>> <<06057>>03430060
<< This procedure checks each entry in the system or pri-   >> <<06057>>03430070
<< vate volume table to see if there exists a corresponding >> <<06057>>03430080
<< LDEV# assigned to that volume table entry.  For system   >> <<06057>>03430090
<< volume, check for LDEV number <> 0, meaning an active    >> <<06057>>03430100
<< volume, check to make sure that it is a system volume    >> <<06057>>03430110
<< set (last 8 bits of word 12 are 0) and the volume table  >> <<06057>>03430120
<< has no entry for volume.  For private volume, we check   >> <<06057>>03430130
<< for non-zero subtype and vtab index.                     >> <<06057>>03430140
<<**********************************************************>> <<06057>>03430150
                                                               <<06057>>03430160
SUBROUTINE PRINT'VOLUME'NAME(VOLID);                           <<06057>>03430170
BYTE ARRAY VOLID;                                              <<06057>>03430180
BEGIN                                                          <<06057>>03430190
MOVE PBUF := "Volume          has not been configured",2;      <<06057>>03430200
LEN := TOS - @PBUF;                                            <<06057>>03430210
MOVE PBUF(7) := VOLID(0),(8);                                  <<06057>>03430220
PRINT(PBUF,-LEN,CRLF);                                         <<06057>>03430230
END;                                                           <<06057>>03430240
                                                               <<06057>>03430250
CC := CCE;                                                     <<06057>>03430260
DISC(READD,SYSLDEV,SYSDU,SYSTYPE,VTABUF,VTABASE,VTABSIZE);     <<06057>>03430270
IF PVOL'SET THEN                                               <<06057>>03430280
   BEGIN  << Private volume set, read info from sector 0D.  >> <<06057>>03430290
   @PVOL'TABLE := @VTABUF(25);  << Skip to PVOL table.      >> <<06057>>03430300
   @PVOL'TABLE'B := @PVOL'TABLE * 2;                           <<06057>>03430310
                                                               <<06057>>03430320
   FOR I:=1 UNTIL PVOL'NUM'VOLS DO                             <<06057>>03430330
      BEGIN                                                    <<06057>>03430340
      LOC := (I*PVOL'ENTRY'SIZE)*2;                            <<06057>>03430350
      IF VTAB(I) = 0 AND PVOL'STYPE'VTABX <> 0 THEN            <<06057>>03430360
         BEGIN                                                 <<06057>>03430370
         CC := CCG;                                            <<06057>>03430380
         PRINT'VOLUME'NAME(PVOL'TABLE'B(LOC));                 <<06057>>03430390
         END;                                                  <<06057>>03430400
      END;                                                     <<06057>>03430410
   END    << of private volume set.                         >> <<06057>>03430420
ELSE                                                           <<06057>>03430430
   BEGIN  << System volume set, work from system tables.    >> <<06057>>03430440
   FOR I:=1 UNTIL VTAB'NUM'VOLS DO                             <<06057>>03430450
      BEGIN                                                    <<06057>>03430460
      LOC:=(I*VTAB'ENTRY'SIZE)*2;   << Byte offset to name. >> <<06057>>03430470
      IF VTAB(I)=0 AND  VTAB'LDEV <> 0 AND                     <<06057>>03430480
         VTAB'SYSTEM'BITS = 0 THEN                             <<06057>>03430490
         BEGIN                                                 <<06057>>03430500
         CC:=CCG;                                              <<06057>>03430510
         PRINT'VOLUME'NAME(VTABUFB(LOC));                      <<06057>>03430520
         END;                                                  <<06057>>03430530
      END;                                                     <<06057>>03430540
   END;                                                        <<06057>>03430550
END;  << Of CHECK'VOLUME'TABLE.                             >> <<06057>>03430560
                                                               <<*GR1*>>03432000
$PAGE                                                          <<*GR1*>>03434000
                                                                        03436000
<<**********************************************************>> <<*GR1*>>03438000
<< BUILDVOLUMETABLE builds the Volume TABle for ead LDEV    >> <<*GR1*>>03440000
<< configured by the user.  Each LDEV has a corresponding   >> <<*GR1*>>03442000
<< Volume number, obtained by reading the volume table and  >> <<*GR1*>>03444000
<< matching the volume name found on the disc with a volume >> <<*GR1*>>03446000
<< name found in the system volume table and assigning the  >> <<*GR1*>>03448000
<< corresponding volume number to that particular LDEV.  The>> <<*GR1*>>03450000
<< LDEV number is stored in the corresponding VTAB entry.   >> <<*GR1*>>03452000
<<**********************************************************>> <<*GR1*>>03454000
                                                               <<*GR1*>>03456000
PROCEDURE BUILDVOLUMETABLE;                                             03458000
BEGIN                                                                   03460000
INTEGER VOL'NUM,I,LOC,STYPE,LDEV,LEN;                          <<06057>>03464000
LOGICAL DRTUNIT;                                               <<06057>>03466000
                                                               <<06057>>03468000
CC := CCE;                                                     <<06057>>03470000
                                                               <<06057>>03472000
<< Giver user a message if master volume is not verified.   >> <<06057>>03474000
                                                               <<06057>>03476000
VERIFIED(SYSLDEV,SYSDU,SYSTYPE);                               <<06057>>03478000
                                                               <<06057>>03480000
<< Now, obtain the volume table information.                >> <<06057>>03482000
                                                               <<06057>>03484000
GETDIRC'VTAB'INFO(SYSLDEV,SYSDU,SYSTYPE,,,VTABASE,VTABSIZE);   <<06057>>03486000
                                                               <<06057>>03488000
<< Clear out the local copy of the volume table.            >> <<06057>>03490000
                                                               <<06057>>03492000
FOR LDEV := 0 UNTIL LDEVMAX DO VTAB(LDEV) := 0;                <<06057>>03494000
                                                               <<06057>>03496000
<<**********************************************************>> <<06057>>03498000
<< For each logical device configured, scan the appropriate >> <<06057>>03500000
<< volume table for the volume ID.                          >> <<06057>>03502000
<<**********************************************************>> <<06057>>03504000
                                                               <<06057>>03506000
FOR LDEV:=1 UNTIL LDEVMAX DO                                   <<06057>>03508000
   BEGIN                                                       <<06057>>03510000
   IF LPDT(LDEV) <> 0 THEN                                     <<06057>>03512000
      BEGIN                                                    <<06057>>03514000
      DRTUNIT := LPDT(LDEV);                                   <<06057>>03516000
      STYPE   := LPDTYPE(LDEV).STYPEF;                         <<06057>>03518000
      VOL'NUM := VTABINDEX(LDEV,DRTUNIT,STYPE);                <<06057>>03520000
                                                               <<06057>>03522000
      <<****************************************************>> <<06057>>03524000
      << If the volume ID could not be found in the volume  >> <<06057>>03526000
      << table, then ask the user for the volume number     >> <<06057>>03528000
      << associated with that ldev.                         >> <<06057>>03530000
      <<****************************************************>> <<06057>>03532000
                                                               <<06057>>03534000
      IF VOL'NUM <> 0 THEN                                     <<06057>>03536000
         VTAB(VOL'NUM) := LDEV                                 <<06057>>03538000
      ELSE                                                     <<06057>>03540000
         BEGIN                                                 <<06057>>03542000
         MOVE PBUF :=                                          <<06057>>03544000
         "Volume          for ldev    not in volume table",2;  <<06057>>03546000
         LEN := TOS - @PBUF;                                   <<06057>>03548000
         GETVOLINFO(LDEV,DRTUNIT,STYPE,,PBUF(7));              <<06057>>03550000
         ASCII(LDEV,PBUF(25),10);                              <<06057>>03552000
         PRINT(PBUF,-LEN,CRLF);                                <<06057>>03554000
         VOL'NUM := GET'NEW'VTAB'INDEX;                        <<06057>>03556000
         IF VOL'NUM = 0                                        <<06057>>03558000
            THEN CC := CCG                                     <<06057>>03560000
            ELSE VTAB(VOL'NUM) := LDEV;                        <<06057>>03562000
         END;                                                  <<06057>>03564000
      END;                                                     <<06057>>03566000
   END;                                                        <<06057>>03568000
                                                               <<06057>>03570000
<< Now check to make sure the user did not miss a volume.   >> <<06057>>03572000
                                                               <<06057>>03574000
CHECK'VOLUME'TABLE;                                            <<06057>>03576000
IF > THEN CC := CCG;                                           <<06057>>03580000
                                                               <<06057>>03582000
END << BUILDVOLUMETABLE >>;                                             03690000
$PAGE                                                          <<*GR1*>>03692000
<<**********************************************************>> <<*GR1*>>03694000
<< The Logical Pack size of a disk is retrieved and returned>> <<*GR1*>>03696000
<< by reading sector 1, word location 127 of the disk.      >> <<*GR1*>>03698000
<< If the LPS on the disc was damage, then take the default.>> <<06057>>03698100
<< CS'80 discs do not have an LPS, therefore, take default. >> <<06057>>03699000
<<**********************************************************>> <<*GR1*>>03700000
                                                               <<*GR1*>>03702000
                                                                        03704000
INTEGER PROCEDURE GETLPS(LDEV,DRTUNIT,STYPE);                           03706000
VALUE LDEV,DRTUNIT,STYPE;                                               03708000
INTEGER LDEV,DRTUNIT,STYPE;                                             03710000
BEGIN                                                                   03712000
INTEGER TYPE,LOG'PACK'SIZE;                                    <<06057>>03713000
                                                               <<06057>>03713100
CC:=CCE;             << Assume successfull completion.      >> <<06057>>03714000
TYPE := LPDTYPE(LDEV).DTYPEF;                                  <<06057>>03716000
IF TYPE = CS'80'TYPE THEN                                      <<06057>>03718000
   LOG'PACK'SIZE := GETDISCINFO(TYPE,STYPE,DEFLT'PACK'SIZE)    <<06057>>03718100
ELSE                                                           <<06057>>03718200
   BEGIN                                                       <<06057>>03718300
   DISC(READD,LDEV,DRTUNIT,STYPE,TRACKBUF,1D,SECTLEN);         <<06057>>03718400
   IF < THEN                                                   <<06057>>03718410
      BEGIN          << Disc read error, what a drag.       >> <<06057>>03718420
      CC := CCL;                                               <<06057>>03718430
      RETURN;                                                  <<06057>>03718440
      END;                                                     <<06057>>03718450
   LOG'PACK'SIZE := INTEGER(TRACKBUF(DTTLPS));                 <<06057>>03718500
   IF LOG'PACK'SIZE < 100 THEN                                 <<06057>>03718510
      LOG'PACK'SIZE := GETDISCINFO(TYPE,STYPE,DEFLT'PACK'SIZE);<<06057>>03718520
   END;                                                        <<06057>>03718600
GETLPS := LOG'PACK'SIZE;                                       <<06057>>03718700
END << GETLPS >>;                                                       03720000
$PAGE                                                          <<*GR1*>>03722000
<<**********************************************************>> <<*GR1*>>03724000
<< GETMAXADDR retrieves the maximum address for the disk    >> <<*GR1*>>03726000
<< device number sent for testing of legal sector address   >> <<*GR1*>>03728000
<< for the disk.                                            >> <<*GR1*>>03730000
<<**********************************************************>> <<*GR1*>>03732000
                                                               <<*GR1*>>03734000
                                                                        03736000
DOUBLE PROCEDURE GETMAXADDR(LDEV,DRTUNIT,STYPE);               <<06057>>03738000
VALUE LDEV,DRTUNIT,STYPE;                                               03740000
INTEGER LDEV,DRTUNIT,STYPE;                                    <<06057>>03742000
                                                               <<06057>>03744000
BEGIN                                                                   03746000
                                                               <<06057>>03748000
     INTEGER SECTRK,TRKS'CYLDR,LOG'PACK'SIZE,TYPE;             <<*GR1*>>03750000
                                                                        03752000
     TYPE:=LPDTYPE(LDEV).DTYPEF;                               <<*GR1*>>03754000
     CC:=CCE;  <<ASSUME SUCCESSFUL COMPLETION>>                         03756000
     SECTRK := GETDISCINFO( TYPE, STYPE,SECT'TRACK);           <<*GR1*>>03758000
     <<Logical Pack Size>>                                     <<*GR1*>>03760000
     LOG'PACK'SIZE:=GETLPS(LDEV,DRTUNIT,STYPE);                <<*GR1*>>03762000
                                                               <<*GR1*>>03764000
     IF < THEN  <<DISC ERROR>>                                          03766000
     BEGIN                                                              03768000
          CC:=CCL;                                                      03770000
          RETURN;                                                       03772000
     END;                                                               03774000
     TRKS'CYLDR := GETDISCINFO( TYPE, STYPE,TRACKS'CYL);       <<*GR1*>>03784000
     GETMAXADDR := (DOUBLE(TRKS'CYLDR)*DOUBLE (LOG'PACK'SIZE)* <<06057>>03786000
                    DOUBLE(SECTRK))-1D;                        <<06057>>03788000
                                                               <<06057>>03790000
END << GETMAXADDR >>;                                                   03792000
$PAGE "DISC UNTILITY - VOLUME VERIFICATION AND INITIALIZATION ROUTINES" 03794000
                                                                        03796000
LOGICAL PROCEDURE VERIFIED(LDEV,DRTUNIT,SUBTYPE,NOMSG);                 03798000
VALUE LDEV,DRTUNIT,SUBTYPE,NOMSG;                                       03800000
LOGICAL DRTUNIT,NOMSG;                                                  03802000
INTEGER LDEV,SUBTYPE;                                                   03804000
OPTION VARIABLE;                                                        03806000
BEGIN                                                                   03808000
     <<DETERMINES WHETHER A DISC VOLUME IS ALREADY INITIALIZED.         03810000
       RETURNS TRUE IF SO; FALSE OTHERWISE.                             03812000
     >>                                                                 03814000
     LOGICAL PMAP=Q-4;                                                  03816000
     INTEGER LEN;                                              <<06057>>03817000
                                                                        03818000
     IF PVOL'SET THEN                                          <<06057>>03818100
        BEGIN << Private volume sets are assumed OK.        >> <<06057>>03818200
        VERIFIED := TRUE;                                      <<06057>>03818300
        RETURN;                                                <<06057>>03818400
        END;                                                   <<06057>>03818500
     DISC(READD,LDEV,DRTUNIT,SUBTYPE,QBUF,0D,SECTLEN*2);       <<06057>>03820000
     IF BQBUF(LABSYSID) = "3000" AND                           <<*GR1*>>03822000
        (LABDISCTYPE = 0 OR LABDISCTYPE = 3) AND               <<*GR1*>>03824000
     LABDISKSUBTYPE=LOGICAL(SUBTYPE)  THEN                     <<03628>>03826000
     VERIFIED:=TRUE ELSE  <<DISC UNITIALIZED>>                          03828000
     IF NOT(PMAP LAND NOMSG) THEN                              <<06057>>03830000
        BEGIN                                                  <<06057>>03830100
        MOVE PBUF :=                                           <<06057>>03830200
        "**WARNING - LDEV    IS NOT PROPERLY INITIALIZED";     <<06057>>03830300
        LEN := TOS - @PBUF;ASCII(LDEV,PBUF(17),10);            <<06057>>03830400
        PRINT(PBUF,-LEN,CRLF);                                 <<06057>>03830500
        END;                                                   <<06057>>03830600
END << VERIFIED >>;                                                     03832000
$PAGE                                                          <<06057>>03832010
PROCEDURE CLID;                                                <<06057>>03832020
                                                               <<06057>>03832030
<<**********************************************************>> <<06057>>03832040
<< This procedure sets all the cold load ID's to the value  >> <<06057>>03832050
<< one so that Initial will not barf and tell the user that >> <<06057>>03832060
<< he needs to RELOAD (Ugh!).  It is used when the user     >> <<06057>>03832070
<< accidentally aborts Initial in the middle after some of  >> <<06057>>03832080
<< the CLID's have changed but others have not.  It changes >> <<06057>>03832090
<< the CLID in all the volumes configured, in the volume    >> <<06057>>03832100
<< table and in the cold load ID table.                     >> <<06057>>03832110
<<**********************************************************>> <<06057>>03832120
                                                               <<06057>>03832130
BEGIN                                                          <<06057>>03832140
INTEGER LDEV,DRTUNIT,STYPE,LEN;                                <<06057>>03832150
                                                               <<06057>>03832160
SUBROUTINE DISCERROR;                                          <<06057>>03832170
                                                               <<06057>>03832180
<< Inform the user that he has got problems.                >> <<06057>>03832190
                                                               <<06057>>03832200
BEGIN                                                          <<06057>>03832210
MOVE PBUF:=                                                    <<06057>>03832220
"Disc error. Check LDEV #     for possible hardware problem";  <<06057>>03832230
ASCII ( LDEV, PBUF(26), -3 );                                  <<06057>>03832240
PRINT ( PBUF, -59, CRLF );                                     <<06057>>03832250
SMESSAGE(14);                                                  <<06057>>03832260
ASSEMBLE(EXIT 0);                                              <<06057>>03832270
END;                                                           <<06057>>03832280
                                                               <<06057>>03832290
IF PVOL'SET THEN                                               <<06057>>03832300
   BEGIN                                                       <<06057>>03832310
   MOVE PBUF := "Private volumes do not have cold load IDs",2; <<06057>>03832320
   LEN := TOS - @PBUF;PRINT(PBUF,-LEN,CRLF);                   <<06057>>03832330
   SMESSAGE(14);                                               <<06057>>03832340
   RETURN;                                                     <<06057>>03832350
   END;                                                        <<06057>>03832360
                                                               <<06057>>03832370
MOVE PBUF:=                                                    <<06057>>03832380
"WARNING!! This function will rewrite all Cold Load ID's",2;   <<06057>>03832390
LEN := TOS - @PBUF;                                            <<06057>>03832400
PRINT ( PBUF, -59, CRLF );                                     <<06057>>03832410
MOVE PBUF :=                                                   <<06057>>03832420
"Are all system domain volumes mounted and ready? ";           <<06057>>03832430
PRINT ( PBUF, -49, NOCRLF );                                   <<06057>>03832440
READ ( RBUF, -5);                                              <<06057>>03832450
IF RBUF(0) <> "Y" THEN                                         <<06057>>03832460
   BEGIN                                                       <<06057>>03832470
   SMESSAGE(14);                                               <<06057>>03832480
   RETURN;    << He doesn't want to go through with it.     >> <<06057>>03832490
   END;                                                        <<06057>>03832500
                                                               <<06057>>03832510
<<**********************************************************>> <<06057>>03832520
<< First, see if he has all the volumes mounted by attempt- >> <<06057>>03832530
<< ting to build the volume table.  If this fails, than not >> <<06057>>03832540
<< all volumes are mounted or the volume table is destroyed.>> <<06057>>03832550
<<**********************************************************>> <<06057>>03832560
                                                               <<06057>>03832570
BUILDVOLUMETABLE;                                              <<06057>>03832580
IF <> THEN                                                     <<06057>>03832590
   BEGIN                                                       <<06057>>03832600
   MOVE PBUF := "  ";PRINT(PBUF,-2, CRLF);                     <<06057>>03832610
   MOVE PBUF :=                                                <<06057>>03832620
   "** Volume Table is destroyed or not all volumes mounted**";<<06057>>03832630
   PRINT(PBUF,-57,CRLF);                                       <<06057>>03832640
   MOVE PBUF := "Do you wish to continue? ";                   <<06057>>03832650
   PRINT(PBUF,-24,NOCRLF);                                     <<06057>>03832660
   READ(RBUF,-5);                                              <<06057>>03832670
   IF RBUF(0) <> "Y" THEN                                      <<06057>>03832680
      BEGIN                                                    <<06057>>03832690
      SMESSAGE(14);                                            <<06057>>03832700
      RETURN; << He doesn't want to go through with it.     >> <<06057>>03832710
      END;                                                     <<06057>>03832720
   END;                                                        <<06057>>03832730
   MOVE PBUF := "  ";PRINT(PBUF,-2,CRLF);                      <<06057>>03832740
                                                               <<06057>>03832750
<<**********************************************************>> <<06057>>03832760
<< Change the CLID in word 3 or the Volume Table and the    >> <<06057>>03832770
<< virtual memory integrity number in word 3. Obtain the    >> <<06057>>03832780
<< address of the Volume Table, read it in, change it, and  >> <<06057>>03832790
<< write it back out.                                       >> <<06057>>03832800
<<**********************************************************>> <<06057>>03832810
                                                               <<06057>>03832820
GETDIRC'VTAB'INFO(SYSLDEV,SYSDU,SYSTYPE,,,VTABASE);            <<06057>>03832830
DISC(READD,SYSLDEV,SYSDU,SYSTYPE,SECTBUF,VTABASE,SECTLEN);     <<06057>>03832840
IF < THEN DISCERROR;                                           <<06057>>03832850
SECTBUF(1):=1;         << Change the CLID to 1.             >> <<06057>>03832860
SECTBUF(3):=1;         << Virtual memory integrety number.  >> <<06057>>03832870
DISC(WRITED,SYSLDEV,SYSDU,SYSTYPE,SECTBUF,VTABASE,SECTLEN);    <<06057>>03832880
IF < THEN DISCERROR;                                           <<06057>>03832890
                                                               <<06057>>03832900
<<**********************************************************>> <<06057>>03832910
<< Update the Cold Load ID in word 10 of the cold load in-  >> <<06057>>03832920
<< formation table.                                         >> <<06057>>03832930
<<**********************************************************>> <<06057>>03832940
                                                               <<06057>>03832950
DISC(READD,SYSLDEV,SYSDU,SYSTYPE,SECTBUF,COLDLOADSECT,SECTLEN);<<06057>>03832960
IF < THEN DISCERROR;                                           <<06057>>03832970
SECTBUF(10):=1;        << CLID in cold load info table.     >> <<06057>>03832980
DISC(WRITED,SYSLDEV,SYSDU,SYSTYPE,SECTBUF,COLDLOADSECT,128);   <<06057>>03832990
IF < THEN DISCERROR;                                           <<06057>>03833000
MOVE PBUF:="Cold load ID's written in system tables",2;        <<06057>>03833010
LEN := TOS - @PBUF;                                            <<06057>>03833020
PRINT(PBUF,-LEN,CRLF);                                         <<06057>>03833030
                                                               <<06057>>03833040
<<**********************************************************>> <<06057>>03833050
<< Now, rewrite the Cold Load ID's in word 7 of each disc   >> <<06057>>03833060
<< volume that is configured.                               >> <<06057>>03833070
<<**********************************************************>> <<06057>>03833080
                                                               <<06057>>03833090
LDEV:=1;                                                       <<06057>>03833100
WHILE LDEV<=LDEVMAX DO                                         <<06057>>03833110
   BEGIN                                                       <<06057>>03833120
                                                               <<06057>>03833130
   << If the disc is configured, then change the CLID.      >> <<06057>>03833140
                                                               <<06057>>03833150
   IF LPDT(LDEV) <> 0 THEN                                     <<06057>>03833160
      BEGIN                                                    <<06057>>03833170
      DRTUNIT := LPDT(LDEV);                                   <<06057>>03833180
      STYPE:=LPDTYPE(LDEV).STYPEF;                             <<06057>>03833190
      DISC(READD,LDEV,DRTUNIT,STYPE,SECTBUF,0D,SECTLEN);       <<06057>>03833200
      IF < THEN DISCERROR;                                     <<06057>>03833210
      SECTBUF(7):=1;   << Change CLID in volume label.      >> <<06057>>03833220
      DISC(WRITED,LDEV,DRTUNIT,STYPE,SECTBUF,0D,SECTLEN);      <<06057>>03833230
      IF < THEN DISCERROR;                                     <<06057>>03833240
      MOVE PBUF:="Cold load ID written on LDEV#   ",2;         <<06057>>03833250
      LEN := TOS - @PBUF;                                      <<06057>>03833260
      ASCII ( LDEV, PBUF(29), -3 );                            <<06057>>03833270
      PRINT(PBUF,-LEN,CRLF);                                   <<06057>>03833280
      END;                                                     <<06057>>03833290
   LDEV:=LDEV + 1;                                             <<06057>>03833300
   END;                                                        <<06057>>03833310
                                                               <<06057>>03833320
                                                               <<06057>>03833330
END;                                                           <<06057>>03833340
$PAGE                                                          <<*GR1*>>03834000
                                                                        03836000
  PROCEDURE GETYESNO(NOLABEL,MESSN);                                    03838000
    VALUE NOLABEL,MESSN;                                                03840000
    INTEGER NOLABEL,    <<LABEL OF RETURN FOR "NO" RESPONSE>>           03842000
            MESSN;      <<MESSAGE NUMBER>>                              03844000
    COMMENT                                                             03846000
      OUTPUTS A MESSAGE AND LOOKS FOR A "Y" RESPONSE (NORMAL RETURN)    03848000
    OR A "N" OR CARRIAGE RETURN RESPONSE (RETURN TO NOLABEL);           03850000
      BEGIN                                                             03852000
        EQUATE BLANK = %6440;                                           03854000
                                                                        03856000
  AGAIN:  SMESSAGE(-MESSN);    <<OUTPUT MESSAGE>>              <<06057>>03858000
          RBUF(READ(RBUF,-72)) := CR;                          <<01.DM>>03860000
          SCAN RBUF WHILE BLANK,1;                                      03862000
          ASSEMBLE(DUP,DUP);                                            03864000
          MOVE * := * WHILE ANS;                                        03866000
          IF CARRY OR (BPS0="N") THEN                                   03868000
            BEGIN    <<"NO" RESPONSE>>                                  03870000
              RETURNP := NOLABEL;                                       03872000
              RETURN;                                                   03874000
            END                                                         03876000
          ELSE                                                          03878000
          IF BPS0<>"Y" THEN                                             03880000
            BEGIN    <<ERROR>>                                          03882000
              DEL;                                                      03884000
              SMESSAGE(0);  <<ILLEGAL INPUT>>                  <<06057>>03886000
              GO AGAIN;                                                 03888000
            END;                                                        03890000
                    <<FALLS THROUGH IN "Y" CASE>>                       03892000
END << GETYESNO >>;                                                     03894000
$PAGE                                                          <<*GR1*>>03896000
                                                                        03898000
  PROCEDURE GETSTR(ADDR,ERRLABEL,TERM,LEN);                             03900000
    VALUE ERRLABEL,TERM,LEN;                                            03902000
    BYTE ARRAY ADDR;    <<DESTINATION ARRAY>>                           03904000
    INTEGER ERRLABEL,   <<ERROR RETURN>>                                03906000
            LEN,        <<MAX LENGTH OF STRING>>                        03908000
            TERM;       <<TERMINATING CONTROL                           03910000
                           0 - COMMA ONLY                               03912000
                           1 - CR ONLY                                  03914000
                          -1 - CR OR COMMA(NO INPUT NOT OK)             03916000
                           2 - CR OR COMMA(NO INPUT OK)                 03918000
                           3 - CR ONLY(NO INPUT OK) >>                  03920000
    COMMENT                                                             03922000
      EXTRACTS AN UP-TO-8 CHARACTER STRING FROM THE INPUT BUFFER        03924000
    POINTED TO BY BPINBUF AND MOVES IT TO BYTE ARRAY ADDR. IF AN        03926000
    ERROR IS ENCOUNTERED EXITS TO ERRLABEL. IF TERM = 0 SETS            03928000
    CONDITION CODE AS FOLLOWS:                                          03930000
         CCG - FOLLOWED BY CARRIAGE RETURN                              03932000
         CCL - FOLLOWED BY COMMA;                                       03934000
      BEGIN                                                             03936000
        EQUATE BLANK=%6440;                                             03938000
        INTEGER CONCODE;                                                03940000
        BYTE POINTER BPINBUF;                                           03942000
                                                                        03944000
          TOS := @ADDR;       <<DESTINATION FOR FINAL MOVE>>            03946000
          @BPINBUF:=@RBUF;                                              03948000
          SCAN BPINBUF WHILE BLANK,1;  <<DELETE LEADING BLANKS>>        03950000
          IF CARRY AND (TERM=3 OR TERM=2)  THEN                         03952000
            BEGIN                                                       03954000
            CC := CCE;                                         <<*GR1*>>03956000
            RETURN;                                                     03958000
            END;                                                        03960000
          IF TERM=2 THEN TERM:=-1 ELSE                                  03962000
          IF TERM=3 THEN TERM:=1;                                       03964000
          IF BPS0<>ALPHA THEN GOTO ERROR;                               03966000
          ASSEMBLE(DUP,DDUP);                                           03968000
          MOVE * := * WHILE ANS,0;  <<UPSHIFT LOWER CASE>>              03970000
          SCAN * WHILE BLANK,1;     <<DELETE TRAILING BLANKS>>          03972000
          IF CARRY THEN CONCODE := CCG                                  03974000
          ELSE IF BPS0="," THEN CONCODE := CCL                          03976000
          ELSE GOTO ERROR;                                              03978000
          IF CONCODE=TERM THEN GOTO ERROR;                              03980000
          CC := CONCODE;  <<SET CONDITION CODE>>               <<*GR1*>>03982000
          @BPINBUF := TOS+1;  <<UPDATE BUFFER POINTER>>                 03984000
          ASSEMBLE(XCH,SUB; DUP,STAX);  <<COMPUTE LENGTH>>              03986000
          IF = OR (S0>LEN) THEN                                         03988000
            BEGIN    <<LENGTH OUT OF RANGE>>                            03990000
  ERROR:      SMESSAGE(0);                                     <<06057>>03992000
              RETURNP := ERRLABEL;                                      03994000
              RETURN;                                                   03996000
            END;                                                        03998000
          ASSEMBLE(MVB 3);   <<XFER STRING>>                            04000000
          WHILE XREG < LEN DO                                           04002000
            BEGIN    <<FILL WITH BLANKS>>                               04004000
              ADDR(XREG) := " ";                                        04006000
              XREG := XREG+1;                                           04008000
            END;                                                        04010000
END << GETSTR >>;                                                       04012000
$PAGE                                                          <<*GR1*>>04014000
                                                                        04016000
  PROCEDURE GETVNAME(CRLABEL);                                          04018000
    VALUE CRLABEL;                                                      04020000
    INTEGER CRLABEL;                                                    04022000
      BEGIN                                                             04024000
          EQUATE BLANK = %6440;                                         04026000
                                                                        04028000
  REQVNAME:                                                             04030000
          SMESSAGE(-20);  <<ENTER VOLUME NAME>>                <<06057>>04032000
          RBUF(READ(RBUF,-72)) := CR;                          <<01.DM>>04034000
          SCAN RBUF WHILE BLANK;                                        04036000
          IF CARRY THEN                                                 04038000
            BEGIN  <<CARRAIGE RETURN INPUT>>                            04040000
              RETURNP := CRLABEL;                                       04042000
              RETURN;                                                   04044000
            END;                                                        04046000
          GETSTR(VNAME,@REQVNAME,1,8);                                  04048000
END << GETVNAME >>;                                                     04050000
                                                                        04052000
DOUBLE PROCEDURE CYLINDERHEAD( TRACK, SUBTYP, TYPE );          << JSC >>04054000
  VALUE TRACK, SUBTYP, TYPE;                                   << JSC >>04056000
  INTEGER TRACK, SUBTYP, TYPE;                                 << JSC >>04058000
      BEGIN                                                             04060000
        INTEGER CYLINDER=CYLINDERHEAD+1, HEAD=CYLINDERHEAD, INDEX;      04062000
                                                                        04064000
          TOS := TRACK;                                                 04066000
          TOS := GETDISCINFO( TYPE, SUBTYP, TRACKS'CYL );      << JSC >>04068000
          ASSEMBLE(DIV);                                                04070000
          HEAD := TOS *                                        << JSC >>04072000
                  GETDISCINFO( TYPE, SUBTYP, TRACK'MULT ) +    << JSC >>04074000
                  GETDISCINFO( TYPE, SUBTYP, STARTING'HEAD );  << JSC >>04076000
          CYLINDER := TOS;  <<CYLINDER #>>                              04078000
      END <<CYLINDERHEAD>> ;                                            04080000
                                                                        04082000
  INTEGER PROCEDURE DELDTTENTRIES(TRACK);                               04084000
    VALUE TRACK;                                                        04086000
    INTEGER TRACK;                                                      04088000
      BEGIN                                                             04090000
        INTEGER COUNT=DELDTTENTRIES, I:=0;                              04092000
                                                                        04094000
          WHILE (I:=I+1) <= DTT DO                                      04096000
          IF DTT(I)&LSR(2)=TRACK THEN                                   04098000
            BEGIN                                                       04100000
  ANOTHER:    COUNT := COUNT+1;                                         04102000
              IF DTT(I:=I+1)&LSR(2)=TRACK THEN GOTO ANOTHER;            04104000
              MOVE DTT(I-COUNT) := DTT(I),(DTT-I+1);                    04106000
              COUNT := -COUNT;                                          04108000
              DTT := DTT+COUNT;                                         04110000
              RETURN;                                                   04112000
            END;                                                        04114000
      END <<DELDTTENTRIES>> ;                                           04116000
$PAGE                                                          <<*GR1*>>04118000
  INTEGER PROCEDURE ADDDTTENTRY(TRACK);                                 04154000
    VALUE TRACK;                                                        04156000
    INTEGER TRACK;                                                      04158000
      BEGIN                                                             04160000
        INTEGER I:=0;                                                   04162000
          IF DTT=120 THEN RETURN;  <<TABLE FULL>>                       04164000
          WHILE (I:=I+1) <= DTT DO                                      04166000
            BEGIN  <<FIND WHERE IT GOES>>                               04168000
              IF DTT(I)=TRACK THEN RETURN;  <<ALREADY IN TABLE>>        04170000
              IF > THEN                                                 04172000
                BEGIN  <<MAKE ROOM FOR IT>>                             04174000
                  MOVE DTT(DTT+1) := DTT(XREG:=XREG-1),(I-DTT-1);       04176000
                  GOTO ADD;                                             04178000
                END;                                                    04180000
            END;                                                        04182000
  ADD:    DTT(I) := TRACK;                                              04184000
          DTT := DTT+1;                                                 04186000
          ADDDTTENTRY := 1;                                             04188000
      END <<ADDDTTENTRY>> ;                                             04190000
$PAGE                                                          <<*GR1*>>04192000
                                                                        04262000
  INTEGER PROCEDURE INVAL(ERRLABEL);                                    04264000
    VALUE ERRLABEL;                                                     04266000
    INTEGER ERRLABEL;   <<LABEL FOR ERROR RETURN>>                      04268000
    COMMENT                                                             04270000
      CONVERTS A NUMBER POINTED TO BY BPINBUF TO BINARY. IF AN ERROR    04272000
    IS DETECTED RETURNS TO ERRLABEL. OTHERWISE RETURNS VALUE AND SETS   04274000
    CONDITION CODE AS FOLLOWS:                                          04276000
         CCE - NO VALUE INPUT                                           04278000
         CCG - FOLLOWED BY CARRIAGE RETURN                              04280000
         CCL - FOLLOWED BY COMMA;                                       04282000
      BEGIN                                                             04284000
        EQUATE BLANK=%6440;                                             04286000
        INTEGER CONCODE:=CCL;                                           04288000
        INTEGER NCHAR,I:=0,VAL=INVAL;                                   04290000
        BYTE POINTER BPINBUF;                                           04292000
                                                                        04294000
          TOS  := 0;   <<FOR BINARY RETURN VALUE>>                      04296000
          @BPINBUF:=@RBUF;                                              04298000
          SCAN BPINBUF WHILE BLANK,1;  <<DELETE LEADING BLANKS>>        04300000
          IF CARRY THEN                                                 04302000
            BEGIN       <<CARRIAGE RETURN INPUT>>                       04304000
              @BPINBUF := TOS+1;                                        04306000
              CONCODE := CCE;                                           04308000
              GOTO FIN;                                                 04310000
            END;                                                        04312000
          ASSEMBLE(DUP,DDUP);                                           04314000
          MOVE * := * WHILE N,0;   <<FIND FIRST NON-NUMERIC>>           04316000
          SCAN * WHILE BLANK,1;    <<DELETE TRAILING BLANKS>>           04318000
          IF CARRY THEN CONCODE := CCG    <<CR FOLLOWS>>                04320000
          ELSE IF BPS0<>"," THEN GOTO ERROR; <<ILLEGAL FOLLOWING CHAR>> 04322000
          @BPINBUF := TOS+1;     <<UPDATE BUFFER POINTER>>              04324000
          ASSEMBLE(XCH,SUB);     <<COMPUTE LENGTH>>                     04326000
          IF = THEN                                                     04328000
            BEGIN                                                       04330000
  ERROR:      RETURNP := ERRLABEL;     <<ERROR RETURN LABEL>>           04332000
              ASSEMBLE(EXIT 2);        <<DELETE INVAL'S VALUE>>         04334000
            END;                                                        04336000
          NCHAR := TOS;                                                 04338000
          DO                                                            04340000
            BEGIN                                                       04342000
              I := I+1;                                                 04344000
              TOS := VAL;                                               04346000
              TOS := 10;                                                04348000
              ASSEMBLE(MPYL,DELB);                                      04350000
              IF CARRY THEN GOTO ERROR;  <<TOO BIG>>                    04352000
              TOS := TOS+INTEGER(BPS1)-%60;                             04354000
              IF OVERFLOW THEN GOTO ERROR;     <<TOO BIG>>              04356000
              VAL := TOS;                                               04358000
              TOS := TOS+1;   <<BUMP CHARACTER POINTER>>                04360000
            END                                                         04362000
          UNTIL I=NCHAR;                                                04364000
  FIN:    CC := CONCODE;       <<SET CONDITION CODE>>          <<*GR1*>>04366000
      END <<INVAL>> ;                                                   04368000
$PAGE                                                          <<*GR1*>>04370000
                                                                        04372000
  INTEGER PROCEDURE GETVAL(MESSN,LLIM,ULIM,TERM);                       04374000
    VALUE MESSN,LLIM,ULIM,TERM;                                         04376000
    INTEGER MESSN,   <<MESSAGE NUMBER>>                                 04378000
            LLIM,    <<LOWER LIMIT>>                                    04380000
            ULIM,    <<UPPER LIMIT>>                                    04382000
            TERM;    <<TERMINATING CONTROL:                             04384000
                          1 - CR ONLY                                   04386000
                          0 - COMMA ONLY                                04388000
                         -1 - CR OR COMMA  >>                           04390000
    COMMENT                                                             04392000
      OUTPUTS A MESSAGE AND LOOKS FOR THE INPUT OF A NUMBER IN THE      04394000
    RANGE  LLIM <= N <= ULIM. IF THE TERMINATING CONTROL = 1, THE       04396000
    CONDITION CODE IS SET AS FOLLOWS:                                   04398000
         CCG - CARRIAGE RETURN                                          04400000
         CCL - COMMA;                                                   04402000
      BEGIN                                                             04404000
                                                                        04406000
  AGAIN:  SMESSAGE(-MESSN);       <<OUTPUT MESSAGE>>           <<06057>>04408000
          RBUF(READ(RBUF,-72)) := CR;                          <<01.DM>>04410000
          TOS := 0;                                                     04412000
          TOS := @ERROR1;                                               04414000
          TOS := INVAL(*);                                              04416000
          IF = THEN IF TERM<>2 THEN GOTO ERROR                          04418000
          ELSE                                                          04420000
            BEGIN                                                       04422000
              CC := CCE;                                       <<*GR1*>>04424000
              RETURN;                                                   04426000
            END;                                                        04428000
          PUSH(STATUS);                                                 04430000
          TOS := TOS.(6:2);                                             04432000
          CC := S0;        <<SET CONDITION CODE>>              <<*GR1*>>04434000
          IF TERM=2 THEN TERM := 1;                                     04436000
          IF TOS=TERM THEN GOTO ERROR;  <<WRONG FOLLOWING CHAR>>        04438000
          IF (LLIM<=S0<=ULIM) THEN                                      04440000
            BEGIN                                                       04442000
              GETVAL := TOS;                                            04444000
              RETURN;                                                   04446000
            END;                                                        04448000
  ERROR:  DEL;                                                          04450000
  ERROR1: SMESSAGE(0);                                         <<06057>>04452000
          GO AGAIN;                                                     04454000
      END <<GETVAL>> ;                                                  04456000
$PAGE                                                          <<*GR1*>>04458000
                                                                        04460000
  PROCEDURE LISTDTT(LDEV,DRTUNIT,SUBTYP);                               04462000
   VALUE LDEV,DRTUNIT,SUBTYP;                                           04464000
   INTEGER LDEV,SUBTYP;                                                 04466000
   LOGICAL DRTUNIT;                                                     04468000
      BEGIN                                                             04470000
        BYTE ARRAY MHEAD1(0:53)=PB:=                                    04472000
          "             FIRST     LAST                  ALTERNATE";     04474000
        BYTE ARRAY MHEAD2(0:53)=PB:=                                    04476000
          " CYL HEAD  SECTOR(%) SECTOR(%)    STATUS     CYL  HEAD";     04478000
        BYTE ARRAY FHEAD1(0:22)=PB:="         FIRST     LAST";          04480000
        BYTE ARRAY FHEAD2(0:34)=PB:=                                    04482000
          " TRACK SECTOR(%) SECTOR(%)   STATUS";                        04484000
        BYTE ARRAY STATS(0:70)=PB:="    SUSPECT     SUSPECT ALT  ",     04486000
          "    DELETED     REASSIGNED  UNREADABLE ALT";                 04488000
        INTEGER I,TRACK,DISP,ALT,INDEX;                                 04490000
      INTEGER TYPE;                                            << JSC >>04492000
                                                                        04494000
          VERIFIED(LDEV,DRTUNIT,SUBTYP);                       <<06057>>04496000
          @DTT := @XDTT;      << XDTT IS IN QBUF >>                     04498000
          IF LABDISCTYPE=MHDISCTYPE OR LABDISCTYPE=CS'80'TYPE  << JSC >>04500000
            THEN                                               << JSC >>04502000
            BEGIN  <<MOVING HEAD DISC>>                                 04504000
              TYPE := LPDTYPE(LDEV).DTYPEF;                    << JSC >>04506000
              TOS := 0;                                                 04508000
              TOS := GETDISCINFO(TYPE,SUBTYP,MAX'PACK'SIZE)    << JSC >>04510000
                   * GETDISCINFO(TYPE,SUBTYP,TRACKS'CYL)       << JSC >>04512000
                   - DTT(DTTALT);                              << JSC >>04514000
              TOS := 0;                                                 04516000
              TOS := DTT(DTTLPS);  <<LOGICAL PACK SIZE>>                04518000
              MOVE LBUF := " LOGICAL PACK SIZE = ",2;                   04520000
              I := ASCII(*,*);                                          04522000
              MOVE LBUF(21+I) := " CYLINDERS, ",2;                      04524000
              TOS := ASCII(*,*);  <<# OF AVAILABLE ALTERNATES>>         04526000
              I := TOS+I;                                               04528000
              MOVE LBUF(33+I) := " ALTERNATE TRACKS AVAILABLE";         04530000
              OUTPUT(LBUFW,60+I);                              <<01.01>>04532000
              IF DTT=0 THEN   <<NO ENTRIES IN TABLE>>                   04534000
              BEGIN                                                     04536000
                   MOVE PBUF:=" NO ENTRIES IN DTT";                     04538000
                   OUTPUT(PBUFW,18);                           <<01.01>>04540000
              END ELSE                                                  04542000
                BEGIN  <<PRINT TABLE>>                                  04544000
                  MOVE LBUF := MHEAD1,(54);                             04546000
                  OUTPUT(LBUFW,54);                            <<01.01>>04548000
                  MOVE LBUF := MHEAD2,(54);                             04550000
                  OUTPUT(LBUFW,54);                            <<01.01>>04552000
                  I := 0;                                               04554000
                  WHILE (I:=I+1)<=DTT DO                                04556000
                    BEGIN  <<LIST EACH ENTRY>>                          04558000
                      LBUF:=" "; MOVE LBUF(1) := LBUF,(57);             04560000
                      TOS := CYLINDERHEAD(TRACK:=DTT(I)&LSR(2),<< JSC >>04562000
                                          SUBTYP, TYPE );      << JSC >>04564000
                      ASSEMBLE(ZERO,XCH);                               04566000
                      ASCII(*,LBUF(1));  <<CYLINDER #>>                 04568000
                      ASSEMBLE(ZERO,XCH);                               04570000
                      ASCII(*,LBUF(6));  <<HEAD #>>                     04572000
                      TOS := 0;                                         04574000
                      TOS := TRACK;                                     04576000
                      TOS := TOS **                            << JSC >>04578000
                             LOGICAL(GETDISCINFO(TYPE,SUBTYP,  << JSC >>04580000
                                                 SECT'TRACK) );<< JSC >>04582000
                      ASSEMBLE(DDUP,DZRO; DXCH,CAB);                    04584000
                      TOS := GETDISCINFO( TYPE, SUBTYP,        << JSC >>04586000
                                          SECT'TRACK );        << JSC >>04588000
                      ASSEMBLE(DECA,DADD);  <<LAST SECTOR>>             04590000
                      DASCII(*,-8,LBUF(22));  <<LAST SECTOR>>           04592000
                      DASCII(*,-8,LBUF(12));  <<FIRST SECTOR>>          04594000
                      DISP := DTT(I).(14:2);  <<RECORD TYPE>>           04596000
                      IF DISP=0 AND TRACK=DTT(XREG:=XREG+1)&LSR(2) THEN 04598000
                        DISP := 4;  <<UNREADABLE ALTERNATE>>            04600000
                      MOVE LBUF(29) := STATS(DISP*14),(14);             04602000
                      TOS := @LBUFW;  <<FOR OUTPUT>>           <<01.01>>04604000
                      IF LOGICAL(DISP) THEN                             04606000
                        BEGIN  <<THERE IS AN ALTERNATE>>                04608000
                          ALT := ALTTRACK(LDEV,DRTUNIT,SUBTYP,TRACK);   04610000
                          IF ALT=-2 THEN                       <<C0.01>>04612000
                            BEGIN <<CAN'T READ ALTERNATE>>              04614000
                              TOS := ADDDTTENTRY(TRACK&LSL(2));         04616000
                              IF TOS=1 THEN                             04618000
                                BEGIN   <<ENTRY ADDED TO TABLE>>        04620000
                                  MOVE LBUF(30) := STATS(56),(14);      04622000
                                  DISC(WRITED,LDEV,DRTUNIT,SUBTYP,      04624000
                                                   DTT,1D,128);         04626000
                                END;                                    04628000
                              GOTO NOALT;                               04630000
                            END;                                        04632000
                          TOS := CYLINDERHEAD(ALT,SUBTYP,TYPE);<< JSC >>04634000
                          ASSEMBLE(ZERO,XCH);                           04636000
                          ASCII(*,LBUF(45)); <<ALTERNATE CYLINDER>>     04638000
                          ASSEMBLE(ZERO,XCH);                           04640000
                          ASCII(*,LBUF(51));  <<ALTERNATE HEAD>>        04642000
                          TOS := 53;  <<LINE COUNT>>                    04644000
                        END                                             04646000
                      ELSE                                              04648000
  NOALT:                    TOS := 45;                                  04650000
                      OUTPUT(*,*);                                      04652000
                      IF DTT(I+1)=TRACK&LSL(2)+3 THEN I:=I+1; <<SKIP>>  04654000
                    END;                                                04656000
                END;                                                    04658000
            END                                                         04660000
          ELSE                                                          04662000
            BEGIN  <<FIXED HEAD DISC>>                                  04664000
              IF DTT=0 THEN SMESSAGE(22)  << No entries.    >> <<06057>>04666000
              ELSE                                                      04668000
                BEGIN  <<PRINT H EADING>>                               04670000
                  MOVE LBUF := FHEAD1,(23);                             04672000
                  OUTPUT(LBUFW,23);                            <<01.01>>04674000
                  MOVE LBUF := FHEAD2,(35);                             04676000
                  OUTPUT(LBUFW,35);                            <<01.01>>04678000
                  I := 0;                                               04680000
                  WHILE (I:=I+1)<=DTT DO                                04682000
                    BEGIN  <<LIST EACH ENTRY>>                          04684000
                      LBUF:=" "; MOVE LBUF(1) := LBUF,(39);             04686000
                      TOS := DTT(I);                                    04688000
                      DISP := S0.(14:2);                                04690000
                      TRACK := TOS&LSR(2);                              04692000
                      ASCII(TRACK,LBUF(2)); <<TRACK #>>                 04694000
                      TOS := 0D;                                        04696000
                      TOS := TRACK&LSL(5);  <<STARTING SECTOR>>         04698000
                      ASSEMBLE(DUP,DZRO,CAB);                           04700000
                      TOS := TOS+31; <<LAST SECTOR>>                    04702000
                      DASCII(*,-8,LBUF(19));                            04704000
                      DASCII(*,-8,LBUF(9));  <<FIRST SECTOR>>           04706000
                      MOVE LBUF(25) := STATS(DISP*14),(14);             04708000
                      OUTPUT(LBUFW,39);                        <<01.01>>04710000
                    END;                                                04712000
                END;                                                    04714000
            END;                                                        04716000
  DONE:                                                                 04718000
      END <<LISTDTT>> ;                                                 04720000
$PAGE                                                          <<*GR1*>>04722000
<<**************************************************************>>      04724000
                                                                        04726000
                                                               <<*GR1*>>04728000
<<**********************************************************>> <<*GR1*>>04730000
<< This procedure obtains the next directory entry, based on>> <<*GR1*>>04732000
<< the current account, group and file.  The information is >> <<*GR1*>>04734000
<< stored in the following:                                 >> <<*GR1*>>04736000
<<      CECNT: Current Entry Count                          >> <<*GR1*>>04738000
<<      TECNT: Total     "     "                            >> <<*GR1*>>04740000
<<      CXCNT: Current Index   "                            >> <<*GR1*>>04742000
<<      TXCNT: Total     "     "                            >> <<*GR1*>>04744000
<<      XSIZE: IndeX SIZE                                   >> <<*GR1*>>04746000
<<      ESIZE: Entry  "                                     >> <<*GR1*>>04748000
<<      EBSIZE: Entry Block SIZE                            >> <<*GR1*>>04750000
<<      EXSIZE: Entry IndeX SIZE                            >> <<*GR1*>>04752000
<<                                                          >> <<*GR1*>>04754000
<<      It returns the address of the next entry in ADDR    >> <<*GR1*>>04756000
<<**********************************************************>> <<*GR1*>>04758000
PROCEDURE GETDIRCENTRY(TYPE,LDEV,DRTUNIT,STYPE,ADDR,FNAME,DERROR);      04760000
VALUE TYPE,LDEV,DRTUNIT,STYPE;                                          04762000
INTEGER TYPE,LDEV,DRTUNIT,STYPE,DERROR;                                 04764000
DOUBLE ADDR;                                                            04766000
BYTE ARRAY FNAME;                                                       04768000
OPTION VARIABLE;                                                        04770000
BEGIN                                                                   04772000
     <<INPUT:                                                           04774000
        ADDR = BASE ADDRESS OF DIRECTORY.                               04776000
       OUTPUT:                                                          04778000
        ADDR = (TYPE <> FTYPE) ADDRESS OF ENTRY BLOCK,                  04780000
               (TYPE = FTYPE) ADDRESS OF FILE LABEL.                    04782000
     >>                                                                 04784000
     LOGICAL PMAP = Q-4;                                                04786000
     INTEGER I,LOC,DIRERROR;                                            04788000
     DOUBLE GETADDR;                                                    04790000
     INTEGER POINTER BLOCK;                                             04792000
     DOUBLE POINTER BLOCKD;                                             04794000
     BYTE POINTER NAME;                                                 04796000
     DEFINE DIRADDR = ADDR#;                                            04798000
     DEFINE FNAMESPEC = PMAP.(14:1)#;                                   04800000
                                                                        04802000
$PAGE                                                          <<*GR1*>>04804000
<<**********************************************************>> <<*GR1*>>04806000
<< This procedure gets the following information from the   >> <<*GR1*>>04808000
<< three directory sectors pointed to by GETADDR:           >> <<*GR1*>>04810000
<<                                                          >> <<*GR1*>>04812000
<<      (1) indeXSIZE                                       >> <<*GR1*>>04814000
<<      (2) indeXBlockSIZE                                  >> <<*GR1*>>04816000
<<      (3) EntrySIZE                                       >> <<*GR1*>>04818000
<<      (4) EntryBlockSIZE                                  >> <<*GR1*>>04820000
<<                                                          >> <<*GR1*>>04822000
<<  It then moves the indeX BLOCK of the type in from the   >> <<*GR1*>>04824000
<<  TRACKBUFF.  Length is 1,2 ro 3 sectors, based on the    >> <<*GR1*>>04826000
<<  indeX SIZE of the type.                                 >> <<*GR1*>>04828000
<<**********************************************************>> <<*GR1*>>04830000
                                                               <<*GR1*>>04832000
     SUBROUTINE GETXBLOCK;                                              04834000
     BEGIN                                                              04836000
    <<Read 3 sectors from Directory for information n          <<*GR1*>>04838000
                                                               <<*GR1*>>04840000
          DISC(READD,LDEV,DRTUNIT,STYPE,TRACKBUF,GETADDR,               04842000
                 DMAXBZ&LSL(7));                                        04844000
          IF < THEN  <<DISC I/O ERROR>>                                 04846000
          BEGIN                                                         04848000
               CC:=CCL;                                                 04850000
               IF PMAP THEN DERROR:=TYPE+1;                             04852000
               ASSEMBLE(EXIT 8);                                        04854000
          END;                                                          04856000
                                                               <<*GR1*>>04858000
          <<************************************************>> <<*GR1*>>04860000
          << Obtain index from index block prefix, which is >> <<*GR1*>>04862000
          << the first 10 words, but only words 0,1, and 4  >> <<*GR1*>>04864000
          << are pertenent.  (See above comment for details)>> <<*GR1*>>04866000
          <<************************************************>> <<*GR1*>>04868000
                                                               <<*GR1*>>04870000
          IF (TXCNT(TYPE):=TRACKBUF(XCOUNTLOC)) <> 0 THEN               04872000
          BEGIN                                                         04874000
               XSIZE(TYPE):=TRACKBUF(XINFOLOC).XSIZEF;                  04876000
               XBSIZE(TYPE):=TRACKBUF(XINFOLOC).XBSIZEF&LSL(7);         04878000
               ESIZE(TYPE):=TRACKBUF(EINFOLOC).ESIZEF;                  04880000
               EBSIZE(TYPE):=TRACKBUF(EINFOLOC).EBSIZEF&LSL(7);         04882000
               TOS:=XBLOCK(TYPE);                                       04884000
               MOVE * :=TRACKBUF,(XBSIZE(TYPE));                        04886000
          END;                                                          04888000
     END <<GETXBLOCK>>;                                                 04890000
                                                                        04892000
$PAGE                                                          <<*GR1*>>04894000
<<**********************************************************>> <<*GR1*>>04896000
<< This procedure obtains the index information needed to   >> <<*GR1*>>04898000
<< properly index the Directory.  If its at the end of a    >> <<*GR1*>>04900000
<<block, it then resets the indeX XouNTS, and obtains the   >> <<*GR1*>>04902000
<< indeX infor of the next index block by calling GETXBLOCK >> <<*GR1*>>04904000
<<**********************************************************>> <<*GR1*>>04906000
                                                               <<*GR1*>>04908000
     SUBROUTINE GETINDEXINFO;                                           04910000
     BEGIN                                                              04912000
          IF CXCNT(TYPE) = TXCNT(TYPE) THEN  <<END OF INDEX BLOCK>>     04914000
          BEGIN                                                         04916000
               CXCNT(TYPE):=TXCNT(TYPE):=0;                             04918000
               WHILE TXCNT(TYPE) = 0 DO                                 04920000
               BEGIN                                                    04922000
                    GETXBLOCK;                                          04924000
                                                               <<*GR1*>>04926000
                    <<**************************************>> <<*GR1*>>04928000
                    << If Total indeX CouNT is still zero   >> <<*GR1*>>04930000
                    << after GETXBLOCK, then there are no   >> <<*GR1*>>04932000
                    <<entries for that type in the current  >> <<*GR1*>>04934000
                    << index block, so go back to the next  >> <<*GR1*>>04936000
                    << type (eg. File to Group, Group to    >> <<*GR1*>>04938000
                    << Account) and get the next entry for  >> <<*GR1*>>04940000
                    << that type, which will point to the   >> <<*GR1*>>04942000
                    << next index block for the current type>> <<*GR1*>>04944000
                    <<**************************************>> <<*GR1*>>04946000
                                                               <<*GR1*>>04948000
                    IF TXCNT(TYPE) = 0 THEN                             04950000
                    BEGIN                                               04952000
                         GETADDR:=DIRADDR;  <<PASS DIR. ADDRESS>>       04954000
                         GETDIRCENTRY(TYPE-1,LDEV,DRTUNIT,STYPE,        04956000
                                      GETADDR,,DIRERROR);               04958000
                         IF < THEN  <<DISC I/O ERROR>>                  04960000
                         BEGIN                                          04962000
                              CC:=CCL;                                  04964000
                              IF PMAP THEN DERROR:=DIRERROR;            04966000
                              ASSEMBLE(EXIT 8);                         04968000
                         END;                                           04970000
                                                               <<*GR1*>>04972000
                         <<*********************************>> <<*GR1*>>04974000
                         << End of directory has been hit,  >> <<*GR1*>>04976000
                         << return from PCALL and clean up  >> <<*GR1*>>04978000
                         << the stack.  Control will be re- >> <<*GR1*>>04980000
                         << turned to GETNEXTFLADDR.        >> <<*GR1*>>04982000
                         <<*********************************>> <<*GR1*>>04984000
                                                               <<*GR1*>>04986000
                         IF > THEN                                      04988000
                         BEGIN                                          04990000
                              CC:=CCG;                                  04992000
                              ASSEMBLE(EXIT 8);                         04994000
                         END;                                           04996000
                    END;                                                04998000
               END;                                                     05000000
          END;                                                          05002000
                                                               <<*GR1*>>05004000
<<**********************************************************>> <<*GR1*>>05006000
<< (1) Obtain the address of the first index block past the >> <<*GR1*>>05008000
<<     prefix                                               >> <<*GR1*>>05010000
<< (2) Obtain the entry block location for this index       >> <<*GR1*>>05012000
<< (3) Update Current indeX CounNT                          >> <<*GR1*>>05014000
<< (4) Obtain Entry BLOCK Pointer                           >> <<*GR1*>>05016000
<< (5) Total Entry Count located in 5th. word of Index Entry>> <<*GR1*>>05018000
<< (6) Start with zeroith Current Entry                     >> <<*GR1*>>05020000
<<**********************************************************>> <<*GR1*>>05022000
                                                               <<*GR1*>>05024000
          @BLOCK:=XBLOCK(TYPE)+PREFIXSIZE;                              05026000
          LOC:=CXCNT(TYPE)*XSIZE(TYPE)+4;                               05028000
          CXCNT(TYPE):=CXCNT(TYPE)+1;                                   05030000
          EBLOCKP:=DOUBLE(BLOCK(LOC))+DIRADDR;                          05032000
          TECNT(TYPE):=BLOCK(LOC+1);                                    05034000
          CECNT(TYPE):=0;                                               05036000
     END <<GETINDEXINFO>>;                                              05038000
                                                                        05040000
<<**********************************************************>> <<*GR1*>>05042000
<< Reads the Entry Block in from TRACKBUFFer, pointed to by >> <<*GR1*>>05044000
<< EBLOCKP, with length 2 or 3 sectors, dependant on the    >> <<*GR1*>>05046000
<< type.                                                    >> <<*GR1*>>05048000
<<**********************************************************>> <<*GR1*>>05050000
                                                               <<*GR1*>>05052000
     SUBROUTINE GETEBLOCK;                                              05054000
     BEGIN                                                              05056000
          DISC(READD,LDEV,DRTUNIT,STYPE,TRACKBUF,EBLOCKP,               05058000
                 EBSIZE(TYPE));                                         05060000
          IF < THEN  <<DISC I/O ERROR>>                                 05062000
          BEGIN                                                         05064000
               CC:=CCL;                                                 05066000
               IF PMAP THEN DERROR:=TYPE+4;                             05068000
               ASSEMBLE(EXIT 8);                                        05070000
          END;                                                          05072000
          TOS:=EBLOCK(TYPE);                                            05074000
          MOVE * :=TRACKBUF,(EBSIZE(TYPE));                             05076000
     END <<GETEBLOCK>>;                                                 05078000
                                                                        05080000
$PAGE                                                          <<*GR1*>>05082000
<<**********************************************************>> <<*GR1*>>05084000
<< This procedure obtains the Entry info. of the directory. >> <<*GR1*>>05086000
<< It updates the Current Entry Count, and returns the dir- >> <<*GR1*>>05088000
<< ectory LABel ADDRess if the type is FILE, otherwise it   >> <<*GR1*>>05090000
<< returns the entry block address.                         >> <<*GR1*>>05092000
<<**********************************************************>> <<*GR1*>>05094000
                                                               <<*GR1*>>05096000
     SUBROUTINE GETENTRYINFO;                                           05098000
     BEGIN                                                              05100000
          IF CECNT(TYPE) = 0 THEN GETEBLOCK;                            05102000
          LOC:=CECNT(TYPE)*ESIZE(TYPE);                                 05104000
          CECNT(TYPE):=CECNT(TYPE)+1;                                   05106000
          IF TYPE = FTYPE THEN  <<GET FLAB ADDRESS>>                    05108000
          BEGIN                                                         05110000
               @BLOCK:=@BLOCKD:=EBLOCK(TYPE);                           05112000
               IF LOGICAL(BLOCK(LOC+2).(0:1)) THEN <<BAD LABEL>>        05114000
               BEGIN                                                    05116000
                    CC:=CCL;                                            05118000
                    IF PMAP THEN DERROR:=BADLABEL;                      05120000
               END;                                                     05122000
                                                               <<*GR1*>>05124000
             <<*********************************************>> <<*GR1*>>05126000
             <<Obtain File Label Addr, located at the3rd.   >> <<*GR1*>>05128000
             <<double word of the File Entry, located at    >> <<*GR1*>>05130000
             <<LOC in entry block                           >> <<*GR1*>>05132000
             <<*********************************************>> <<*GR1*>>05134000
                                                               <<*GR1*>>05136000
               LOC:=(LOC+4) & LSR(1);                                   05138000
               ADDR:=BLOCKD(LOC);                                       05140000
                                                               <<*GR1*>>05142000
               <<*******************************************>> <<*GR1*>>05144000
               << If file name is requested, obtain it from >> <<*GR1*>>05146000
               << the current entry block.                  >> <<*GR1*>>05148000
               <<*******************************************>> <<*GR1*>>05150000
                                                               <<*GR1*>>05152000
               IF FNAMESPEC THEN <<RETURN FILE NAME>>                   05154000
               BEGIN                                                    05156000
                    LOC:=-8;                                            05158000
                    FOR I:=FTYPE STEP -1 UNTIL ATYPE DO                 05160000
                    BEGIN                                               05162000
                         LOC:=LOC+8;                                    05164000
                         TOS:=((CECNT(I)-1)*ESIZE(I)) & LSL(1);         05166000
                         @NAME:=(EBLOCK(I) & LSL(1))+TOS;               05168000
                         NAME(2).(0:1):=0;  <<RESET ERROR FLAG>>        05170000
                         MOVE FNAME(LOC):=NAME,(8);                     05172000
                   END;                                                 05174000
               END;                                                     05176000
                                                               <<*GR1*>>05178000
          <<************************************************>> <<*GR1*>>05180000
          << Get entry address, located in the 4th word of  >> <<*GR1*>>05182000
          << the Entry Block, address index block of next   >> <<*GR1*>>05184000
          << type.  If account entry, then get accout group >> <<*GR1*>>05186000
          << index pointer.  If group entry, get froup file >> <<*GR1*>>05188000
          << index pointer.                                 >> <<*GR1*>>05190000
          <<************************************************>> <<*GR1*>>05192000
                                                               <<*GR1*>>05194000
          END ELSE  <<GET ENTRY ADDRESS>>                               05196000
          BEGIN                                                         05198000
               @BLOCK:=EBLOCK(TYPE);                                    05200000
               ADDR:=DOUBLE(BLOCK(LOC+4))+DIRADDR;                      05202000
          END;                                                          05204000
     END <<GETENTRYINFO>>;                                              05206000
                                                                        05208000
$PAGE                                                          <<*GR1*>>05210000
<<      MAIN BLOCK of GETDIRECTORYINFO         >>              <<*GR1*>>05212000
                                                               <<*GR1*>>05214000
<<**********************************************************>> <<*GR1*>>05216000
<< It traverses thruoug the directory by scanning the curr- >> <<*GR1*>>05218000
<< ent index or entry block, based on the value of TYPE.    >> <<*GR1*>>05220000
<<                                                          >> <<*GR1*>>05222000
<<  TYPE  2=FILE, TYPE 1=GROUP, TYPE 0=ACCOUNT              >> <<*GR1*>>05224000
<<                                                          >> <<*GR1*>>05226000
<< Start with the account index blocks, which point to      >> <<*GR1*>>05228000
<< account entries.  The account entries point to group in- >> <<*GR1*>>05230000
<< dex blocks.  The group indexes point to group entry      >> <<*GR1*>>05232000
<< blocks.  The group entries in turn point to file         >> <<*GR1*>>05234000
<< index blocks.  Now, the file indexes point to file entry >> <<*GR1*>>05236000
<< blocks, which, finally, contain file label addresses. So >> <<*GR1*>>05238000
<< the directory is traversed in this matter, file entries  >> <<*GR1*>>05240000
<< to file indexes to group entries to group indexes to     >> <<*GR1*>>05242000
<< account entries to account indexes, which is located at  >> <<*GR1*>>05244000
<< DIRBASE + 3 sectors.  (See directory in tables manual    >> <<*GR1*>>05246000
<< for more details).                                       >> <<*GR1*>>05248000
<<**********************************************************>> <<*GR1*>>05250000
                                                               <<*GR1*>>05252000
     CC:=CCE;                                                           05254000
     IF PMAP THEN DERROR:=0;  <<ASSUME NO DIRECTORY ERRORS>>            05256000
                                                               <<*GR1*>>05258000
     <<*****************************************************>> <<*GR1*>>05260000
     << Obtain address of Directory (DIRADDR +3 sectors)    >> <<*GR1*>>05262000
     << which contains the Account indeX BLOCK.             >> <<*GR1*>>05264000
     <<*****************************************************>> <<*GR1*>>05266000
                                                               <<*GR1*>>05268000
     IF TYPE < 0 THEN  <<LOWEST RECURSION LEVEL - SYS ACCOUNT>>         05270000
     BEGIN                                                              05272000
          IF CXCNT(ATYPE) <> 0 THEN CC:=CCG ELSE                        05274000
          ADDR:=DIRADDR+DOUBLE(DIR'BITMAP'SIZE);               <<04827>>05276000
          RETURN;                                                       05278000
     END;                                                               05280000
     IF CECNT(TYPE) = TECNT(TYPE) THEN <<END OF BLOCK>>                 05282000
     BEGIN                                                              05284000
          GETADDR:=DIRADDR;  <<PASS DIR. BASE TO NEXT RECURSION>>       05286000
                                                               <<*GR1*>>05288000
          <<************************************************>> <<*GR1*>>05290000
          << Entry Block changes will occur only if the Disk>> <<*GR1*>>05292000
          << was condensed.  But since the COND command is  >> <<*GR1*>>05294000
          << no more, than it will never happen.            >> <<*GR1*>>05296000
          <<************************************************>> <<*GR1*>>05298000
                                                               <<*GR1*>>05300000
          IF EBLOCKCHANGES THEN <<WRITE OUT UPDATED ENTRY BLOCK>>       05302000
          BEGIN                                                         05304000
               EBLOCKCHANGES:=FALSE;                                    05306000
               @BLOCK:=EBLOCK(TYPE);                                    05308000
               DISC(WRITED,LDEV,DRTUNIT,STYPE,BLOCK,EBLOCKP,            05310000
                      EBSIZE(TYPE));                                    05312000
               IF < THEN  <<DISC I/O ERROR>>                            05314000
               BEGIN                                                    05316000
                    CC:=CCL;                                            05318000
                    IF PMAP THEN DERROR:=TYPE+4;                        05320000
                    RETURN;                                             05322000
               END;                                                     05324000
          END;                                                          05326000
                                                               <<*GR1*>>05328000
          <<************************************************>> <<*GR1*>>05330000
          << If at end of current block of type, then go    >> <<*GR1*>>05332000
          << down one more level of recursion, eg. from File>> <<*GR1*>>05334000
          << to Group, Group to Account, Account to System  >> <<*GR1*>>05336000
          << to obtain the next entry block of the next lev->> <<*GR1*>>05338000
          << el. EG, next group entry if end of file index  >> <<*GR1*>>05340000
          << or next account entry if end of group index.   >> <<*GR1*>>05342000
          <<************************************************>> <<*GR1*>>05344000
                                                               <<*GR1*>>05346000
          IF CXCNT(TYPE) = TXCNT(TYPE) THEN                             05348000
          BEGIN                                                         05350000
               GETDIRCENTRY(TYPE-1,LDEV,DRTUNIT,STYPE,GETADDR,,         05352000
                            DIRERROR);                                  05354000
               IF < THEN  <<DISC I/O ERROR>>                            05356000
               BEGIN                                                    05358000
                    CC:=CCL;                                            05360000
                    IF PMAP THEN DERROR:=DIRERROR;                      05362000
                    RETURN;                                             05364000
               END;                                                     05366000
               IF > THEN <<RECURSION FOUND END OF DIRECTORY>>           05368000
               BEGIN                                                    05370000
                    CC:=CCG;                                            05372000
                    RETURN;                                             05374000
               END;                                                     05376000
          END;                                                          05378000
                                                               <<*GR1*>>05380000
          <<Obtain the next index block for the current type>> <<*GR1*>>05382000
                                                               <<*GR1*>>05384000
          GETINDEXINFO;                                                 05386000
     END;                                                               05388000
     GETENTRYINFO;                                                      05390000
END <<GETDIRCENTRY>>;                                                   05392000
$PAGE                                                          <<*GR1*>>05394000
                                                                        05396000
<<**********************************************************>> <<*GR1*>>05398000
<< This procedure scans the system directory for the file   >> <<*GR1*>>05400000
<< name, group name and account name given.  It is called   >> <<*GR1*>>05402000
<< by SAVE when a single file name in the form FILE.GROUP.  >> <<*GR1*>>05404000
<< ACCOUNT is given.  It scans the Accounts first, looking  >> <<*GR1*>>05406000
<< for the proper account entry, then the group indexes and >> <<*GR1*>>05408000
<< entries and then the file indexes and entries.  It       >> <<*GR1*>>05410000
<< returns the File Label Address as the double return      >> <<*GR1*>>05412000
<< value of the file requested.                             >> <<*GR1*>>05414000
<<**********************************************************>> <<*GR1*>>05416000
                                                               <<*GR1*>>05418000
DOUBLE PROCEDURE DIRSCAN(LDEV,DRTUNIT,STYPE,INDEXPNTR,FNAME,GNAME,      05420000
  ANAME,GINFO,AINFO,DERROR);                                            05422000
VALUE LDEV,DRTUNIT,STYPE;                                               05424000
INTEGER LDEV,DRTUNIT,STYPE,INDEXPNTR,DERROR;                            05426000
DOUBLE GINFO,AINFO;                                                     05428000
BYTE ARRAY FNAME,GNAME,ANAME;                                           05430000
OPTION VARIABLE;                                                        05432000
BEGIN                                                                   05434000
     LOGICAL PMAP = Q-4;                                                05436000
     INTEGER I,ENUMB,ICOUNT,XCOUNT,ENSIZE,INSIZE,ENBSIZE,               05438000
             IECOUNT,INDEXADDR;                                         05440000
     LOGICAL PREVACCOUNT,PREVGROUP,EXACTMATCH;                          05442000
     LOGICAL LABELBAD:=FALSE;                                           05444000
     DOUBLE ADDR,FLABADDR,ENPOINTER;                                    05446000
     INTEGER ENPOINTER1 = ENPOINTER+1;                                  05448000
     ARRAY                                                              05450000
          ENBLOCK(*) = TRACKBUF,                                        05452000
          INBLOCK(*) = TRACKBUF(384);                                   05454000
     INTEGER POINTER                                                    05456000
          ENENTRY,                                                      05458000
          INENTRY;                                                      05460000
     BYTE POINTER                                                       05462000
          ENENTRYB,                                                     05464000
          INENTRYB;                                                     05466000
     DOUBLE POINTER ENENTRYD;                                           05468000
     DEFINE                                                             05470000
          DERRORSPEC    = PMAP       #,                                 05472000
          AINFOSPEC     = PMAP.(14:1)#,                                 05474000
          GINFOSPEC     = PMAP.(13:1)#,                                 05476000
          INDEXPNTRSPEC = PMAP.( 9:1)#;                                 05478000
                                                                        05480000
$PAGE                                                          <<*GR1*>>05482000
     SUBROUTINE CHECKSCANINFO;                                          05484000
     BEGIN                                                              05486000
          INDEXADDR:=DIR'BITMAP'SIZE;                          <<04827>>05488000
          PREVACCOUNT:=PREVGROUP:=FALSE;                                05490000
          IF DRTUNIT = SCANDRTUNIT AND STYPE = SCANSTYPE THEN           05492000
          IF ANAME = SCANANAME,(8) THEN                                 05494000
          BEGIN                                                         05496000
               PREVACCOUNT:=TRUE;                                       05498000
               IF AINFOSPEC THEN AINFO:=SCANAINFO;                      05500000
               IF GNAME = SCANGNAME,(8) THEN                            05502000
               BEGIN                                                    05504000
                    PREVGROUP:=TRUE;                                    05506000
                    IF GINFOSPEC THEN GINFO:=SCANGINFO;                 05508000
                    INDEXADDR:=SCANFINDEXADDR;                          05510000
               END ELSE INDEXADDR:=SCANGINDEXADDR;                      05512000
          END ELSE                                                      05514000
          BEGIN                                                         05516000
               SCANDRTUNIT:=DRTUNIT;                                    05518000
               SCANSTYPE:=STYPE;                                        05520000
               MOVE SCANANAME:=ANAME,(8);                               05522000
               MOVE SCANGNAME:=GNAME,(8);                               05524000
          END;                                                          05526000
     END <<CHECKSCANINFO>>;                                             05528000
                                                                        05530000
$PAGE                                                          <<*GR1*>>05532000
     SUBROUTINE GETENTRY(TYPE,NAME);                                    05534000
     VALUE TYPE; INTEGER TYPE;                                          05536000
     BYTE ARRAY NAME;                                                   05538000
     BEGIN                                                              05540000
          ICOUNT:=0;                                                    05542000
          EXACTMATCH:=FALSE;                                            05544000
          ADDR:=DOUBLE(INDEXADDR)+DIRBASE;                              05546000
          DISC(READD,LDEV,DRTUNIT,STYPE,INBLOCK,ADDR,DMAXBZ&LSL(7));    05548000
          IF < THEN  <<DISC ERROR>>                                     05550000
          BEGIN                                                         05552000
               CC:=CCL;                                                 05554000
               IF DERRORSPEC THEN DERROR:=TYPE+1;                       05556000
               RETURN;                                                  05558000
          END;                                                          05560000
          XCOUNT:=INBLOCK(XCOUNTLOC);                                   05562000
          INSIZE:=INBLOCK(XINFOLOC).XSIZEF;                             05564000
          ENSIZE:=INBLOCK(EINFOLOC).ESIZEF;                             05566000
          ENBSIZE:=INBLOCK(EINFOLOC).EBSIZEF & LSL(7);                  05568000
          @INENTRY:=@INBLOCK(PREFIXSIZE)-INSIZE;                        05570000
          FOR I:=1 UNTIL XCOUNT DO                                      05572000
          BEGIN                                                         05574000
               @INENTRY:=@INENTRY+INSIZE;                               05576000
               @INENTRYB:=@INENTRY & LSL(1);                            05578000
               IF INENTRYB <= NAME,(8) THEN                             05580000
               BEGIN                                                    05582000
                    ICOUNT:=I;                                          05584000
                    IECOUNT:=INENTRY(IECOUNTLOC);                       05586000
                    ENPOINTER:=DOUBLE(INENTRY(IEPNTRLOC));              05588000
               END ELSE                                                 05590000
               I:=XCOUNT;  <<STOP LOOP>>                                05592000
          END;                                                          05594000
          IF ICOUNT <> 0 THEN                                           05596000
          BEGIN                                                         05598000
               ENUMB:=0;                                                05600000
               ENPOINTER:=ENPOINTER+DIRBASE;                            05602000
               DISC(READD,LDEV,DRTUNIT,STYPE,ENBLOCK,ENPOINTER,         05604000
                      ENBSIZE);                                         05606000
               IF < THEN  <<DISC ERROR>>                                05608000
               BEGIN                                                    05610000
                    CC:=CCL;                                            05612000
                    IF DERRORSPEC THEN DERROR:=TYPE+4;                  05614000
                    RETURN;                                             05616000
               END;                                                     05618000
               @ENENTRY:=@ENBLOCK;                                      05620000
               IF TYPE <> FTYPE THEN INDEXADDR:=ENENTRY(IPNTRLOC);      05622000
               @ENENTRY:=@ENENTRY-ENSIZE;                               05624000
               FOR I:=0 UNTIL (IECOUNT-1) DO                            05626000
               BEGIN                                                    05628000
                    @ENENTRY:=@ENENTRY+ENSIZE;                          05630000
                    IF TYPE = FTYPE THEN                                05632000
                    IF ENENTRY(2).(0:1) = 1 THEN                        05634000
                    BEGIN                                               05636000
                         LABELBAD:=TRUE;                                05638000
                         ENENTRY(2).(0:1):=0;                           05640000
                    END;                                                05642000
                    @ENENTRYB:=@ENENTRY & LSL(1);                       05644000
                    IF ENENTRYB <= NAME,(8) THEN                        05646000
                    BEGIN                                               05648000
                         IF = THEN                                      05650000
                         BEGIN                                          05652000
                              ENUMB:=I;                                 05654000
                              EXACTMATCH:=TRUE;                         05656000
                              I:=IECOUNT;  <<STOP LOOP>>                05658000
                         END ELSE                                       05660000
                         ENUMB:=I;                                      05662000
                         IF TYPE <> FTYPE THEN                          05664000
                         BEGIN                                          05666000
                              INDEXADDR:=ENENTRY(IPNTRLOC);             05668000
                              IF TYPE = ATYPE THEN                      05670000
                              SCANGINDEXADDR:=INDEXADDR ELSE            05672000
                              SCANFINDEXADDR:=INDEXADDR;                05674000
                         END;                                           05676000
                    END ELSE                                            05678000
                    I:=IECOUNT;  <<STOP LOOP>>                          05680000
               END;                                                     05682000
               ENPOINTER:=ENPOINTER-DIRBASE;  <<ADDR. NOT DOUBLE>>      05684000
               CASE * TYPE OF                                           05686000
               BEGIN                                                    05688000
                    BEGIN                                               05690000
                         TOS:=ENUMB*ENSIZE;                             05692000
                         TOS:=ENPOINTER1;                               05694000
                         SCANAINFO:=TOS;                                05696000
                         IF AINFOSPEC THEN AINFO:=SCANAINFO;            05698000
                    END;                                                05700000
                    BEGIN                                               05702000
                         TOS:=ENUMB*ENSIZE;                             05704000
                         TOS:=ENPOINTER1;                               05706000
                         SCANGINFO:=TOS;                                05708000
                         IF GINFOSPEC THEN GINFO:=SCANGINFO;            05710000
                    END;                                                05712000
                    IF EXACTMATCH THEN                                  05714000
                    BEGIN                                               05716000
                         IF LABELBAD THEN                               05718000
                         BEGIN                                          05720000
                              CC:=CCL;                                  05722000
                              IF PMAP THEN DERROR:=BADLABEL;            05724000
                         END;                                           05726000
                         @ENENTRYD:=@ENENTRY;                           05728000
                         FLABADDR:=ENENTRYD(2);                         05730000
                    END;                                                05732000
               END  <<CASE>>;                                           05734000
          END;                                                          05736000
     END <<GETENTRY>>;                                                  05738000
$PAGE                                                          <<*GR1*>>05740000
                                                                        05742000
<< Main block of DIRectory  SCAN>>                             <<*GR1*>>05744000
                                                               <<*GR1*>>05746000
     CC:=CCE;  <<ASSUME SUCCESSFUL COMPLETION>>                         05748000
     IF PMAP THEN DERROR:=0;  <<ASSUME NO DIRECTORY ERRORS>>            05750000
     CHECKSCANINFO;                                                     05752000
     IF NOT PREVACCOUNT THEN                                            05754000
     BEGIN                                                              05756000
          GETENTRY(ATYPE,ANAME);                                        05758000
          IF NOT EXACTMATCH THEN                                        05760000
          BEGIN                                                         05762000
               CC:=CCG;                                                 05764000
               IF PMAP THEN DERROR:=7;  <<INVALID ACCOUNT>>             05766000
               RETURN;                                                  05768000
          END;                                                          05770000
     END;                                                               05772000
     IF NOT PREVGROUP THEN                                              05774000
     BEGIN                                                              05776000
          GETENTRY(GTYPE,GNAME);                                        05778000
          IF NOT EXACTMATCH THEN                                        05780000
          BEGIN                                                         05782000
               CC:=CCG;                                                 05784000
               IF PMAP THEN DERROR:=8;  <<INVALID GROUP>>               05786000
               RETURN;                                                  05788000
          END;                                                          05790000
     END;                                                               05792000
     GETENTRY(FTYPE,FNAME);                                             05794000
     IF INDEXPNTRSPEC THEN INDEXPNTR:=INDEXADDR;                        05796000
     IF EXACTMATCH THEN DIRSCAN:=FLABADDR ELSE                          05798000
     IF PMAP THEN DERROR:=9;  <<FILE NOT FOUND>>                        05800000
END <<DIRSCAN>>;                                                        05802000
$PAGE                                                          <<*GR1*>>05804000
PROCEDURE PRINT'TAPE'ERROR(STATUS);                            <<06057>>05806000
VALUE STATUS;INTEGER STATUS;                                   <<06057>>05808000
BEGIN                                                          <<06057>>05810000
INTEGER LEN;                                                   <<06057>>05810050
                                                               <<06057>>05810100
MOVE PBUF := "SERIAL DEVICE FAILURE    ",2;                    <<06057>>05810150
LEN := TOS - @PBUF;                                            <<06057>>05810160
ASCII(STATUS,PBUF(22),10);                                     <<06057>>05810200
PRINT(PBUF,-LEN,CRLF);                                         <<06057>>05810250
                                                               <<06057>>05810300
IF STATUS = CHANFAIL THEN                                      <<06057>>05810350
   MOVE PBUF := "I/O CHANNEL FAILURE ",2                       <<06057>>05810400
ELSE IF STATUS = SIOFAIL THEN                                  <<06057>>05810450
   MOVE PBUF := "SIO FAILURE",2                                <<06057>>05810500
ELSE IF STATUS = UNITFAIL THEN                                 <<06057>>05810550
   MOVE PBUF := "UNIT FAILURE",2                               <<06057>>05810600
ELSE IF STATUS = BSFAIL THEN                                   <<06057>>05810650
   MOVE PBUF := "BOT AND BACKSPACE",2                          <<06057>>05810700
ELSE IF STATUS = NORING THEN                                   <<06057>>05810750
   MOVE PBUF := "NO WRITE RING",2                              <<06057>>05810800
ELSE                                                           <<06057>>05810850
   MOVE PBUF := "UNKNOWN DEVICE FAILURE",2;                    <<06057>>05810900
LEN := TOS - @PBUF;                                            <<06057>>05810950
PRINT(PBUF,-LEN,CRLF);                                         <<06057>>05811000
END;                                                           <<06057>>05811050
$PAGE                                                          <<06057>>05812000
PROCEDURE CONTROL( CTL );                                      <<01.DM>>05814000
   VALUE CTL;                                                  <<01.DM>>05816000
   INTEGER CTL;                                                <<01.DM>>05818000
BEGIN                                                          <<01.DM>>05820000
   DOUBLE STAT;                                                <<01.DM>>05822000
   INTEGER                                                     <<01.DM>>05824000
        STATUS    = STAT,                                      <<01.DM>>05826000
        XFERCNT   = STAT+1;                                    <<01.DM>>05828000
                                                               <<01.DM>>05830000
   STAT := PERFORMIO(SERIAL'DEV,CTL,COPYBUF,0);                <<06057>>05832000
   IF <> THEN                                                  <<01.DM>>05834000
      BEGIN                                                    <<06057>>05836000
      IF STATUS <> EOT THEN                                    <<06057>>05838000
         PRINT'TAPE'ERROR(STATUS);                             <<06057>>05840000
      END;                                                     <<06057>>05854000
END;                                                           <<01.DM>>05856000
$PAGE                                                          <<*GR1*>>05858000
<<**********************************************************>> <<*GR1*>>05860000
<< Called in COPY'TO'TAPE when an end of tape occurs or when>> <<*GR1*>>05862000
<< a tape parity error or serial disk error occurs.  It     >> <<*GR1*>>05864000
<< writes a few EOF's, Rewinds and Resets the tape(or serial>> <<*GR1*>>05866000
<< disk, and requests that a new tape be mounted or that a  >> <<*GR1*>>05868000
<< new serial pack be mounted.                              >> <<*GR1*>>05870000
<<**********************************************************>> <<*GR1*>>05872000
                                                               <<*GR1*>>05874000
PROCEDURE END'OF'TAPE;                                                  05876000
BEGIN                                                                   05878000
   DOUBLE SERIAL'DISC;                                                  05880000
                                                                        05882000
   CONTROL( BACK'SPACE'FILE );   << BACKSPACE TO EOF >>        <<*GR1*>>05884000
   CONTROL( EOF );               << WRITE EOF        >>        <<*GR1*>>05886000
   CONTROL( EOF );               << WRITE EOF        >>        <<*GR1*>>05888000
   CONTROL( REWIND'UNLOAD );     << REWIND & RESET   >>        <<*GR1*>>05890000
   NO'FILES'REEL := 0; <<NO MORE FILES ON THAT REEL!>>         <<01.DM>>05892000
                                                               <<*GR1*>>05894000
$IF X1=OFF <<HPIB VERSION ONLY>>                               <<*GR1*>>05896000
                                                               <<*GR1*>>05898000
<<**********************************************************>> <<*GR1*>>05900000
<< For the HPIB version, ask the user to mount a new tape if>> <<*GR1*>>05902000
<< our serial device is a magtape.                          >> <<*GR1*>>05904000
<<**********************************************************>> <<*GR1*>>05906000
                                                               <<*GR1*>>05908000
   IF LPDTYPE.DTYPEF = MAGTAPE THEN                            <<SY.30>>05910000
   BEGIN                                                                05912000
      MOVE LBUF := "MOUNT NEXT REEL";                                   05914000
      PRINT( LBUF, -15, CRLF);                                          05916000
   END                                                                  05918000
 ELSE                                                                   05920000
                                                               <<*GR1*>>05922000
   <<*******************************************************>> <<*GR1*>>05924000
   << Request a new serial disk pack and call WAITINSERTDISC>> <<*GR1*>>05926000
   << to wait for the new serial disk to be inserted. Then, >> <<*GR1*>>05928000
   << call CHANGEDEVICE to make sure that the disk that was >> <<*GR1*>>05930000
   << inserted was a valid serial disk.                     >> <<*GR1*>>05932000
   <<*******************************************************>> <<*GR1*>>05934000
                                                               <<*GR1*>>05936000
   BEGIN                                                                05938000
      CONTROL( DEVICECLOSE);                                            05940000
TRYAGAIN:                                                               05942000
      MOVE LBUF := "MOUNT NEXT SERIAL PACK";                            05944000
      PRINT( LBUF, -22, CRLF);                                          05946000
      WAITINSERTDISC(1);                                                05948000
                                                               <<*GR1*>>05950000
        <<**************************************************>> <<*GR1*>>05952000
        << The procedure CHANGEDEVICE stores the DRT,UNIT,  >> <<*GR1*>>05954000
        << TYPE and SUBTYPE differently than does SADUTIL,  >> <<*GR1*>>05956000
        << therefore, we must send the SERIALDESCription in >> <<*GR1*>>05958000
        << the manner that it wants, DRT in word 0, (0:9),  >> <<*GR1*>>05960000
        << SUBTYPE in word 0, (9:4) , UNIT in word 0, (13:3)>> <<*GR1*>>05962000
        << and TYPE is in word 1.                           >> <<*GR1*>>05964000
        <<**************************************************>> <<*GR1*>>05966000
                                                               <<*GR1*>>05968000
      TOS := LPDT(SERIAL);                                     <<*GR1*>>05970000
      S0.(9:4):=LPDTYPE(SERIAL).STYPEF;                        <<*GR1*>>05972000
      TOS := LPDTYPE.DTYPEF;                                   <<*GR1*>>05974000
      SERIAL'DISC := TOS;                                               05976000
      CHANGEDEVICE(,SERIAL'DISC);                                       05978000
      IF <> THEN                                                        05980000
      BEGIN                                                             05982000
         SMESSAGE( 61 ); << INVALID SERIAL DEVICE >>           <<06057>>05984000
         GO TRYAGAIN;                                                   05986000
      END;                                                              05988000
   END;                                                                 05990000
$IF X1=ON                                                      <<*GR1*>>05992000
                                                               <<*GR1*>>05994000
<<**********************************************************>> <<*GR1*>>05996000
<< For Series II/III, ask the user to mount another tape and>> <<*GR1*>>05998000
<< call TAPE'READY'CHECK to wait for the tape to come on-   >> <<*GR1*>>06000000
<< line.                                                    >> <<*GR1*>>06002000
<<**********************************************************>> <<*GR1*>>06004000
                                                               <<*GR1*>>06006000
      MOVE LBUF := "MOUNT NEXT REEL";                          <<*GR1*>>06008000
      PRINT( LBUF, -15, CRLF);                                 <<*GR1*>>06010000
                                                               <<*GR1*>>06012000
      <<****************************************************>> <<*GR1*>>06014000
      << If we are running under Series III, then we must   >> <<*GR1*>>06016000
      << call this procedure to wait for the tape to come   >> <<*GR1*>>06018000
      << back on line since the Series III tape driver does >> <<*GR1*>>06020000
      << not perform this operation for us. This does not   >> <<*GR1*>>06022000
      << apply to the HP 7976 tape drive.                   >> <<*GR1*>>06024000
      <<****************************************************>> <<*GR1*>>06026000
                                                               <<*GR1*>>06028000
                                                               <<*GR1*>>06030000
      IF NOTHP7976                                             <<*GR1*>>06032000
         THEN TAPE'READY'CHECK; <<Wait for new tape on line >> <<*GR1*>>06034000
                                                               <<*GR1*>>06036000
$IF                                                            <<*GR1*>>06038000
END;                                                                    06040000
$PAGE                                                          <<*GR1*>>06042000
<<**********************************************************>> <<*GR1*>>06044000
<< BAD'TAPE'IO is called in the case of a tape parity error >> <<*GR1*>>06046000
<< or some other tape error.  It is called from COPYTOTAPE  >> <<*GR1*>>06048000
<< when the CC returned from PERFORMIO signifies a bad tape >> <<*GR1*>>06050000
<< write.  It gives the user some messages and waits for a  >> <<*GR1*>>06052000
<< new tape to be mounted.  For HPIB, the tape driver will  >> <<*GR1*>>06054000
<< do this for us.                                          >> <<*GR1*>>06056000
<<**********************************************************>> <<*GR1*>>06058000
                                                               <<*GR1*>>06060000
PROCEDURE BAD'TAPE'IO(STATUS);                                 <<*GR1*>>06062000
  VALUE STATUS;INTEGER STATUS;                                 <<*GR1*>>06064000
                                                               <<*GR1*>>06066000
  BEGIN                                                        <<*GR1*>>06068000
                                                               <<*GR1*>>06070000
    PRINT'TAPE'ERROR(STATUS);                                  <<06057>>06074000
    MOVE PBUF:="  ";PRINT(PBUF,-2,CRLF);                       <<*GR1*>>06078000
    MOVE PBUF:="The files on this tape will be saved";         <<*GR1*>>06080000
    PRINT(PBUF,-36,CRLF);                                      <<*GR1*>>06082000
    MOVE PBUF:="Place bad tape back online if it is offline";  <<*GR1*>>06084000
    PRINT(PBUF,-43,CRLF);                                      <<*GR1*>>06086000
                                                               <<*GR1*>>06088000
    MOVE PBUF:="Hit CR when unit is back online";              <<*GR1*>>06090000
    PRINT(PBUF,-31,NOCRLF);                                    <<*GR1*>>06092000
     RLEN:=READ(RBUF,-2);                                      <<*GR1*>>06094000
                                                               <<*GR1*>>06096000
    <<Now call END'OF'TAPE to treat tape like an EOF        >> <<*GR1*>>06098000
                                                               <<*GR1*>>06100000
    END'OF'TAPE;                                               <<*GR1*>>06102000
                                                               <<*GR1*>>06104000
  END;                                                         <<*GR1*>>06106000
$PAGE                                                          <<*GR1*>>06108000
                                                                        06112000
<<**********************************************************>>          06114000
<< This procedure takes the cuurent File Label Address(FLAB)>>          06116000
<< and copies the entire file to the tape or serial disk.   >>          06118000
<< The file is copied to the tape on extent at a time unless>>          06120000
<< the extent is larger than 4096 words, then it is copied  >>          06122000
<< in chunks of that size.  If a bad disk read is encountred>>          06124000
<< on an extent, the extent is read one sector at a time and>>          06126000
<< a running count is made of all the bad sectors that can't>>          06128000
<< be read.                                                 >>          06130000
<<**********************************************************>>          06132000
                                                                        06134000
PROCEDURE  COPYTOTAPE(FLAB,COMMAND,TAPECHECKED);                        06136000
  VALUE TAPECHECKED;                                                    06138000
  LOGICAL TAPECHECKED;                                                  06140000
  ARRAY FLAB;                                                           06142000
  BYTE ARRAY COMMAND;                                                   06144000
BEGIN                                                                   06146000
  DOUBLE EXTADDR,      <<Sector address of extents     >>               06148000
         SECT'OFFSET,                                                   06150000
         STAT;         <<Status returned from PERFORMIO>>               06152000
  INTEGER                                                               06154000
    BADREC,            <<Number of bad records in file >>               06156000
    LASTEXT,           <<Index of last file extent     >>               06158000
    EXT,               <<Current extent                >>               06160000
    EXTADDR0=EXTADDR,  <<First word of extent address  >>               06162000
    LDEV,              <<LDEV that the extents is in   >>               06164000
    DRTUNIT,           <<DRT and UNIT of disc to read  >>               06166000
    STYPE,             <<Subtype of disc to read       >>               06168000
    VOL,               <<Volume number of disc to read >>               06170000
    EXTLENGTH,         <<Extent size from file label   >>               06172000
    WC,                <<Word count of tape write      >>               06174000
    LOC,               <<Location in buffer for bad I/O>>               06176000
    STATUS=STAT;       <<STATUS is first word of STAT  >>               06178000
  DOUBLE ARRAY FLABD(*)=FLAB; <<Double addressing FLAB >>               06180000
  EQUATE FIRSTEXT = 22; <<22ND. Double work of FLAB    >>               06182000
$PAGE                                                                   06184000
SUBROUTINE SERIAL'IO'ERROR;                                             06186000
                                                                        06188000
<< Called when a bad status is returned from PERFORMIO.     >>          06190000
                                                                        06192000
BEGIN                                                                   06194000
IF STATUS = EOT THEN                                                    06196000
   BEGIN << EOT encountered on a write.          >>                     06198000
                                                                        06200000
   << If all one file, then declare file to be too damn big!>>          06202000
                                                                        06204000
   IF NO'FILES'REEL = 0 THEN                                            06206000
      BEGIN                                                             06208000
      MOVE PBUF(42)_" - FILE TOO LARGE";                                06210000
      OUTPUT( PBUFW,63);                                                06212000
      CONTROL(REWIND'UNLOAD);                                           06214000
      TAPECHECKED:=FALSE;                                               06216000
      END                                                               06218000
   ELSE                                                                 06220000
      BEGIN << Perform EOT functions and recopy file.       >>          06222000
      END'OF'TAPE;                                                      06224000
      COPYTOTAPE(FLAB,COMMAND,TAPECHECKED);                             06226000
      END;                                                              06228000
   END                                                                  06230000
ELSE                                                                    06232000
                                                                        06234000
   <<*******************************************************>>          06236000
   << ELSE, we have a tape parity error or serial disc      >>          06238000
   << failure and we kindly ask the user to mount another   >>          06240000
   << serial device via BAD'TAPE'IO.                        >>          06242000
   <<*******************************************************>>          06244000
                                                                        06246000
    BEGIN                                                               06248000
    BAD'TAPE'IO(STATUS); << Mount another serial media.     >>          06250000
    TAPECHECKED:=FALSE;                                                 06252000
    COPYTOTAPE(FLAB,COMMAND,TAPECHECKED); << Recopy file.   >>          06254000
    END;                                                                06256000
END;                                                                    06258000
$PAGE                                                                   06260000
BADREC:=0;                                                              06262000
                                                                        06264000
$IF X1=ON <<FOR SERIES II/III, CHECK FOR TAPE TO BE ON LINE >>          06266000
                                                                        06268000
IF NOT TAPECHECKED AND NOTHP7976 THEN                                   06270000
   BEGIN                                                                06272000
     TAPE'READY'CHECK;                                                  06274000
     TAPECHECKED:=TRUE;                                                 06276000
   END;                                                                 06278000
$IF                                                                     06280000
                                                                        06282000
<<**********************************************************>>          06284000
<< LASTEXTENT is first extent plus the number of extents,   >>          06286000
<< retreived from word 39 of the file label.                >>          06288000
<<**********************************************************>>          06290000
                                                                        06292000
LASTEXT:=FIRSTEXT + FLNUMEXTS;                                          06294000
                                                                        06296000
FOR EXT:=FIRSTEXT UNTIL LASTEXT DO                                      06298000
                                                                        06300000
   <<*******************************************************>>          06302000
   << For each extent (starting at double word 22 (word 44) >>          06304000
   << of the File Label, determine if the Volume Table Index>>          06306000
   << and Extent sector number is present in the File Label >>          06308000
   << (non-zero) for that extent.  IF so, attempt to read   >>          06310000
   << the extent from the disk starting at EXTADDR found in >>          06312000
   << the file label for the extent.                        >>          06314000
   <<*******************************************************>>          06316000
                                                                        06318000
   IF FLABD(EXT) <> 0D THEN                                             06320000
      BEGIN                                                             06322000
                                                                        06324000
     <<*****************************************************>>          06326000
     << Obtain extent address from file label forthe extent.>>          06328000
     << Next, retrieve the volume number and obtain the log->>          06330000
     << ical device number from the VTAB.                   >>          06332000
     <<*****************************************************>>          06334000
                                                                        06336000
     EXTADDR:=FLABD(EXT);                                               06338000
     VOL:=EXTADDR0.VOLF;                                                06340000
     EXTADDR0.VOLF:=0;  <<ZERO VTAB INDEX>>                             06342000
     LDEV:=VTAB(VOL);                                                   06344000
     IF LDEV = 0 THEN                                                   06346000
        BEGIN << No LDEV for the volume number    >>                    06348000
           OUTPUT(PBUFW,72);                                            06350000
           MOVE PBUF:="     Can't save file, vol";                      06352000
           MOVE PBUF(25):="ume       not mounted";                      06354000
           ASCII(VOL,PBUF(29));                                         06356000
           OUTPUT(PBUFW,46);                                            06358000
           IF NO'FILES'REEL <> 0 THEN                                   06360000
              BEGIN                                                     06362000
              CONTROL(BACK'SPACE'FILE);                                 06362100
              CONTROL(FORWARD'SPACE'FILE);                              06362200
              END                                                       06362300
           ELSE                                                         06364000
              BEGIN                                                     06366000
              CONTROL(REWIND);                                          06368000
              TAPECHECKED:=FALSE;                                       06370000
              END;                                                      06372000
           RETURN;                                                      06374000
        END;                                                            06376000
     DRTUNIT := LPDT (LDEV);                                            06378000
     STYPE:=LPDTYPE(LDEV).STYPEF;                                       06380000
                                                                        06382000
     << Obtain the extent size from FLAB(41). If this is the >>         06384000
     << last extent, then use the last extent size.          >>         06386000
                                                                        06388000
     IF EXT = LASTEXT                                                   06390000
        THEN EXTLENGTH := FLLASTEXTSIZE                                 06392000
        ELSE EXTLENGTH := FLEXTSIZE;                                    06394000
                                                                        06396000
     <<*****************************************************>>          06398000
     << Calculate serial word count.  Maximum tape write is >>          06400000
     << 4096 words.  Then, read the proper amount from the  >>          06402000
     << extent and check for errors.                        >>          06404000
     <<*****************************************************>>          06406000
                                                                        06408000
     WHILE EXTLENGTH > 0 DO                                             06410000
        BEGIN                                                           06412000
        IF EXTLENGTH < SECT'TAPE'REC                                    06414000
           THEN WC := EXTLENGTH * SECTLEN                               06416000
           ELSE WC := TAPE'REC'LEN;                                     06418000
        DISC(READD,LDEV,DRTUNIT,STYPE,COPYBUF,EXTADDR,WC);              06420000
                                                                        06422000
        <<**************************************************>>          06424000
        << If a bad disk read is encountered, one sector at >>          06426000
        << a time is read into BUF and for each bad sector  >>          06428000
        << read, all zeros are put into the sectors place   >>          06430000
        << and BADREC is incremented.                       >>          06432000
        <<**************************************************>>          06434000
                                                                        06436000
        IF < THEN                                                       06438000
           BEGIN                                                        06440000
           LOC:=0; SECT'OFFSET := 0D;                                   06442000
           WHILE WC > 0 DO                                              06444000
              BEGIN                                                     06446000
              DISC(READD,LDEV,DRTUNIT,STYPE,QBUF,                       06448000
                   EXTADDR+SECT'OFFSET,SECTLEN   );                     06450000
              IF < THEN                                                 06452000
                 BEGIN                                                  06454000
                 BADREC:=BADREC+1;                                      06456000
                 QBUF := 0;MOVE QBUF(1):=QBUF,(127);                    06458000
                 END;                                                   06460000
              MOVE  COPYBUF(LOC):=QBUF,(128);                           06462000
              SECT'OFFSET := SECT'OFFSET + 1D;                          06464000
              WC:=WC-128;    << Decrement word count.       >>          06466000
              LOC:=LOC+128;  << Increment buffer location.  >>          06468000
              END;                                                      06470000
           END;                                                         06472000
                                                                        06474000
        << Write  COPYBUFF to the serial device.            >>          06476000
        STAT := PERFORMIO( SERIAL'DEV,WRITET,COPYBUF,WC);               06478000
        IF <> THEN                                                      06480000
           BEGIN                                                        06482000
           SERIAL'IO'ERROR;  << Check on serial error.      >>          06484000
           RETURN;           << Done for this file.         >>          06486000
           END                                                          06488000
        ELSE                                                            06490000
                                                                        06492000
           <<***********************************************>>          06494000
           << Extent length is decreased by number of sects >>          06496000
           << read (WC/128) and Extent address is increased >>          06498000
           << by the same.  When entire extent is copied to >>          06500000
           << tape, EXTLENGTH goes to 0 and extent is done. >>          06502000
           <<***********************************************>>          06504000
                                                                        06506000
           BEGIN                                                        06508000
           EXTLENGTH:=EXTLENGTH-(WC/SECTLEN);                           06510000
           EXTADDR:=EXTADDR+DOUBLE(WC/SECTLEN);                         06512000
           END;                                                         06514000
        END; << While extent has not been completely copied.>>          06516000
     END;    << This extent was an allocated extent.        >>          06518000
                                                                        06520000
<<**********************************************************>>          06522000
<< File has been successfully copied,  lay down an EOF mark >>          06524000
<< and inform the user of the successfull copy and bump the >>          06526000
<< number of files counter.                                 >>          06528000
<<**********************************************************>>          06530000
                                                                        06532000
CONTROL( EOF ); << WRITE EOF >>                                         06534000
IF COMMAND="SAVE" THEN                                                  06536000
   BEGIN                                                                06538000
   IF BADREC <> 0 THEN                                                  06540000
      BEGIN                                                             06542000
      MOVE PBUF(42):=" - Lost       Sectors";                           06544000
      ASCII(BADREC,PBUF(50));                                           06546000
      END;                                                              06548000
   OUTPUT(PBUFW,63);                                                    06550000
   END                                                                  06552000
ELSE << Command is "FIND" >>                                            06554000
   BEGIN                                                                06556000
   OUTPUT(PBUFW,-72);                                                   06558000
   MOVE LBUF:=" ";MOVE LBUF(1):=LBUF(0),(80);                           06560000
   MOVE LBUF(5):=PBUF(0),(26);                                          06562000
   MOVE LBUF(32):=" was SAVED!";                                        06564000
   IF BADREC <> 0 THEN                                                  06566000
      BEGIN                                                             06568000
      MOVE LBUF(43):=" However       sectors";                          06570000
      MOVE LBUF(65):=" were lost";                                      06572000
      ASCII(BADREC,LBUF(51));                                           06574000
      END;                                                              06576000
   OUTPUT(LBUFW,75);                                                    06578000
   END;                                                                 06580000
                                                                        06582000
NO'FILES'REEL := NO'FILES'REEL+1;                                       06584000
END <<COPYTOTAPE>>;                                                     06586000
$PAGE                                                          <<06057>>06586001
LOGICAL PROCEDURE GET'FILE'SET(BUF,FNAME,GNAME,ANAME);         <<06057>>06586010
BYTE ARRAY BUF,FNAME,GNAME,ANAME;                              <<06057>>06586020
BEGIN                                                          <<06057>>06586030
INTEGER LEN;                                                   <<06057>>06586040
                                                               <<06057>>06586050
<<**********************************************************>> <<06057>>06586060
<< This procedure simple parses the input strint BUF into   >> <<06057>>06586070
<< a file, group and account name.  It returns FALSE if the >> <<06057>>06586080
<< buffer contained an illegal file character and TRUE      >> <<06057>>06586090
<< otherwise.  A "@" is permissible for any of the names.   >> <<06057>>06586100
<<**********************************************************>> <<06057>>06586110
                                                               <<06057>>06586120
GET'FILE'SET := FALSE;                                         <<06057>>06586130
SCAN BUF UNTIL %6456,1;<<Period or CR>>                        <<06057>>06586140
IF NOCARRY AND (LEN:=TOS-@BUF)>0 THEN                          <<06057>>06586150
   BEGIN                                                       <<06057>>06586160
   MOVE FNAME:=BUF,(LEN);                                      <<06057>>06586170
   MOVE BUF:=BUF(LEN+1),(RLEN-LEN);                            <<06057>>06586180
   SCAN BUF UNTIL %6456,1;                                     <<06057>>06586190
   IF NOCARRY AND (LEN:=TOS-@BUF)>0 THEN                       <<06057>>06586200
      BEGIN                                                    <<06057>>06586210
      MOVE GNAME:=BUF,(LEN);                                   <<06057>>06586220
      MOVE BUF:=BUF(LEN+1),(RLEN-LEN);                         <<06057>>06586230
      SCAN BUF UNTIL %6456,1;                                  <<06057>>06586240
      IF (LEN:=TOS-@BUF)>0 THEN                                <<06057>>06586250
         BEGIN                                                 <<06057>>06586260
         GET'FILE'SET:=TRUE;                                   <<06057>>06586270
         MOVE ANAME:=BUF,(LEN);                                <<06057>>06586280
         END;                                                  <<06057>>06586290
      END;                                                     <<06057>>06586300
   END;                                                        <<06057>>06586310
END; << Of GET'FILE'SET >>                                     <<06057>>06586320
$PAGE                                                          <<06057>>06586330
INTEGER PROCEDURE GET'DATE;                                    <<06057>>06588010
BEGIN                                                          <<06057>>06588020
                                                               <<06057>>06588030
<< Reads a valid data from the user and converts it to Julian>><<06057>>06588040
                                                               <<06057>>06588050
INTEGER LEN,DATE;                                              <<06057>>06588060
                                                               <<06057>>06588070
MOVE PBUF:=" DATE ?  ";                                        <<06057>>06588080
DATE := -1;                                                    <<06057>>06588090
DO BEGIN                                                       <<06057>>06588100
   PRINT(PBUF,-9,NOCRLF);                                      <<06057>>06588110
   LEN := READ(RBUFW,-10);                                     <<06057>>06588120
   IF LEN = 0 THEN                                             <<06057>>06588130
      DATE := 0                                                <<06057>>06588140
   ELSE                                                        <<06057>>06588150
      BEGIN  << Convert the date to julian.                 >> <<06057>>06588160
      DATE:=DATECONV(RBUF,LEN);                                <<06057>>06588170
      IF DATE=-1 THEN SMESSAGE(0);                             <<06057>>06588180
      END;                                                     <<06057>>06588190
   END                                                         <<06057>>06588200
UNTIL DATE <> -1;                                              <<06057>>06588210
GET'DATE := DATE;                                              <<06057>>06588220
END;                                                           <<06057>>06588230
$PAGE                                                          <<*GR1*>>06646000
                                                               <<*GR1*>>06648000
                                                               <<*GR1*>>06650000
<<**********************************************************>> <<*GR1*>>06652000
<<  SAVE the most importand procedure of SADUTIL.  It copes >> <<*GR1*>>06654000
<< a file from a disk by obtaining the File Label Address of>> <<*GR1*>>06656000
<< the file and copies to the tape or serial disk.  SAVE can>> <<*GR1*>>06658000
<< save individual files, or the "@" symbol can be used to  >> <<*GR1*>>06660000
<< save all the files in a group, account or system         >> <<*GR1*>>06662000
<<**********************************************************>> <<*GR1*>>06664000
                                                               <<*GR1*>>06666000
PROCEDURE SAVE;  << SAVIOUR >>                                 <<*GR1*>>06668000
BEGIN                                                          <<*GR1*>>06670000
     INTEGER I,J,DATE,SECT,LDEV,TYPE,STYPE,ERROR,DRTUNIT,VOL,  <<*GR1*>>06672000
             LEN,DERROR;                                       <<*GR1*>>06674000
     LOGICAL ALLFILES,ALLNAMES,FILE'COPIED;                    <<*GR1*>>06676000
     LOGICAL VTABERR:=FALSE,MOREFILES:=TRUE,TAPECHECKED:=FALSE;<<*GR1*>>06678000
     DOUBLE MAXADDR,FLABADDR,STAT;                             <<*GR1*>>06680000
     INTEGER                                                   <<*GR1*>>06682000
          FLABADDR0  = FLABADDR;                               <<*GR1*>>06684000
     ARRAY NAMES(0:11);                                        <<*GR1*>>06686000
     BYTE ARRAY NAMESB(*) = NAMES;                             <<*GR1*>>06688000
     BYTE ARRAY COMMAND(0:3);                                  <<*GR1*>>06690000
     BYTE ARRAY                                                <<*GR1*>>06692000
          FNAME(*) = NAMES,                                    <<*GR1*>>06694000
          GNAME(*) = NAMES(4),                                 <<*GR1*>>06696000
          ANAME(*) = NAMES(8);                                 <<*GR1*>>06698000
     BYTE ARRAY INPUT'FILE(0:7),                               <<*GR1*>>06700000
                INPUT'GROUP(0:7),                              <<*GR1*>>06702000
                INPUT'ACCOUNT(0:7);                            <<*GR1*>>06704000
                                                               <<*GR1*>>06706000
                                                               <<*GR1*>>06708000
     ARRAY FLAB(*) = QBUF;                                     <<*GR1*>>06710000
     BYTE ARRAY FLABNAMESB(*) = FLAB;                          <<*GR1*>>06712000
     BYTE ARRAY AGFTYPE(0:17)=PB:="ACCOUNT GROUP FILE";        <<*GR1*>>06714000
     INTEGER ARRAY                                             <<*GR1*>>06716000
          AGFLOC(0:2),                                         <<*GR1*>>06718000
          AGFLEN(0:2);                                         <<*GR1*>>06720000
     BYTE POINTER BUF;                                         <<*GR1*>>06722000
     DEFINE LAST'MOD'DATE = FLAB(25)#;                         <<*GR1*>>06724000
                                                               <<*GR1*>>06726000
                                                               <<*GR1*>>06728000
                                                               <<*GR1*>>06730000
$PAGE                                                          <<*GR1*>>06732000
                                                               <<*GR1*>>06734000
<<**********************************************************>> <<*GR1*>>06736000
<< This procedure simply prints any error found while the   >> <<*GR1*>>06738000
<< directory is being searched for the files specified.     >> <<*GR1*>>06740000
<<**********************************************************>> <<*GR1*>>06742000
                                                               <<*GR1*>>06744000
     SUBROUTINE PRINT'DIR'ERROR;                                        06746000
     BEGIN                                                              06748000
          IF (1<=DERROR<=9) THEN  <<FILE/GROUP/ACCOUNT ERROR>>          06750000
          BEGIN                                                         06752000
               IF DERROR < 4 THEN TYPE:=DERROR ELSE                     06754000
               IF (TYPE:=(DERROR-4)) > 2 THEN TYPE:=TYPE-3;             06756000
               LEN:=AGFLEN(TYPE)+1;                                     06758000
               IF (7<=DERROR<=9) THEN                                   06760000
               BEGIN                                                    06762000
                    MOVE PBUF(27):=" - ";                               06764000
                    MOVE PBUF(30):=AGFTYPE(AGFLOC(TYPE)),(LEN-1),2;     06766000
                    LEN:=LEN+40;                                        06768000
                    MOVE * :=" NOT FOUND";                              06770000
               END ELSE                                                 06772000
               BEGIN                                                    06774000
                    MOVE PBUF(27):=" - DIRECTORY DISC ERROR";           06776000
                    OUTPUT(PBUFW,50);                          <<01.01>>06778000
                    MOVE PBUF(1):=AGFTYPE(AGFLOC(TYPE)),(LEN-1),2;      06780000
                    LEN:=LEN+37;                                        06782000
                    IF (1<=DERROR<=3) THEN                              06784000
                    MOVE * :=" INDEX",2 ELSE MOVE * :="ENTRY",2;        06786000
                    MOVE * :=" BLOCK ACCESS ERROR - BAD TRACK";         06788000
               END;                                                     06790000
               OUTPUT(PBUFW,LEN);                              <<01.01>>06792000
          END;                                                          06794000
     END <<PRINT'DIR'ERROR>>;                                           06796000
                                                                        06798000
<<**********************************************************>> <<*GR1*>>06800000
<< Obtain the next file label address by calling the proce- >> <<*GR1*>>06802000
<< dure GETDIRECENTRY.  Called by SAVE when all the files   >> <<*GR1*>>06804000
<< in a group, account or system are being saved.           >> <<*GR1*>>06806000
<<**********************************************************>> <<*GR1*>>06808000
                                                               <<*GR1*>>06810000
     LOGICAL SUBROUTINE GETNEXTFLABADDR;                                06812000
     BEGIN                                                              06814000
          FLABADDR:=DIRBASE;                                            06816000
          GETDIRCENTRY(FTYPE,SYSLDEV,SYSDU,SYSTYPE,FLABADDR,            06818000
                       FNAME,DERROR);                                   06820000
          IF <> THEN RETURN;  <<END OF DIRECTORY REACHED/ERROR>>        06822000
          GETNEXTFLABADDR:=TRUE;                                        06824000
     END <<GETNEXTFLABADDR>>;                                           06826000
                                                                        06828000
                                                                        06830000
$PAGE                                                          <<*GR1*>>06832000
<<**********************************************************>> <<*GR1*>>06834000
<< LABELOK determines if the File Label Address obtained    >> <<*GR1*>>06836000
<< points to a proper, certified file label.  If not, it    >> <<*GR1*>>06838000
<< prints that the file label is defective and returns the  >> <<*GR1*>>06840000
<< value FALSE to SAVE so that the file is not attempted to >> <<*GR1*>>06842000
<< be copied to tape.  It also determines if the file's last>> <<*GR1*>>06844000
<< modified data is after that of the DATE given to SAVE the>> <<*GR1*>>06846000
<< files.                                                   >> <<*GR1*>>06848000
<<**********************************************************>> <<*GR1*>>06850000
                                                               <<*GR1*>>06852000
     LOGICAL SUBROUTINE LABELOK;                                        06854000
     BEGIN                                                              06856000
          VOL:=FLABADDR0.VOLF;                                          06858000
          FLABADDR0.VOLF:=0;  <<RESET VOLUME TABLE INDEX>>              06860000
          LDEV:=VTAB(VOL);                                              06862000
          MOVE PBUF := (72(" "));                                       06864000
          MOVE PBUF(32):="% ";                                          06866000
          MOVE PBUF(1):=FNAME,(8); PBUF(9):=".";                        06868000
          MOVE PBUF(10):=GNAME,(8); PBUF(18):=".";                      06870000
          MOVE PBUF(19):=ANAME,(8);                                     06872000
          ASCII(LDEV,PBUF(29));                                         06874000
          DASCII(FLABADDR,-8,PBUF(33));                                 06876000
          IF (1<=DERROR<=9) THEN  <<DISC/DIRECTORY ERROR>>              06878000
          BEGIN                                                         06880000
               PRINT'DIR'ERROR;                                         06882000
               RETURN;                                                  06884000
          END;                                                          06886000
          DRTUNIT := LPDT (LDEV);                              <<SY.30>>06888000
          STYPE:=LPDTYPE(LDEV).STYPEF;                         <<SY.30>>06890000
          DISC(READD,LDEV,DRTUNIT,STYPE,FLAB,FLABADDR,128);             06892000
          IF < THEN                                                     06894000
          BEGIN                                                         06896000
               MOVE PBUF(42):=" - BAD TRACK FOR FILE LABEL";            06898000
               OUTPUT(PBUFW,72);                               <<01.01>>06900000
               RETURN;                                                  06902000
          END;                                                          06904000
          IF NAMESB = FLABNAMESB,(24) THEN                              06906000
          BEGIN                                                         06908000
               IF DERROR = BADLABEL THEN                                06910000
               BEGIN                                                    06912000
                    MOVE PBUF(42) := " - DEFECTIVE FILE LABEL";         06914000
                    OUTPUT(PBUFW,67);                          <<01.01>>06916000
                    MOVE PBUF := " VOLUME #       ADDRESS %        ";   06918000
                    ASCII(VOL,PBUF(10));                                06920000
                    DASCII(FLABADDR,-8,PBUF(25));                       06922000
                    OUTPUT(PBUFW,34);                          <<01.01>>06924000
                    RETURN;                                             06926000
               END;                                                     06928000
                                                               <<*GR1*>>06930000
               <<Check for last modify date>>                  <<*GR1*>>06932000
                                                               <<*GR1*>>06934000
               IF LOGICAL(LAST'MOD'DATE) >= LOGICAL(DATE) THEN          06936000
               LABELOK:=TRUE;                                           06938000
          END ELSE                                                      06940000
          BEGIN                                                         06942000
               MOVE PBUF(42):=" - LABEL COMPARE FAILED";                06944000
               OUTPUT(PBUFW,67);                               <<01.01>>06946000
          END;                                                          06948000
     END <<LABELOK>>;                                                   06950000
                                                               <<06057>>06950010
                                                               <<06057>>06950020
SUBROUTINE SAVE'FILE;                                          <<06057>>06950030
BEGIN                                                          <<06057>>06950040
                                                               <<06057>>06950050
<< Determine if the current file should be saved.           >> <<06057>>06950060
                                                               <<06057>>06950070
IF (INPUT'FILE="@" OR                                          <<06057>>06950080
    FNAME=INPUT'FILE,(8)) AND                                  <<06057>>06950090
   (INPUT'GROUP="@" OR                                         <<06057>>06950100
    GNAME=INPUT'GROUP,(8)) AND                                 <<06057>>06950110
   (INPUT'ACCOUNT="@" OR                                       <<06057>>06950120
    ANAME=INPUT'ACCOUNT,(8)) THEN                              <<06057>>06950130
       BEGIN                                                   <<06057>>06950140
       IF LABELOK THEN                                         <<06057>>06950150
          BEGIN                                                <<06057>>06950160
          COPYTOTAPE(FLAB,COMMAND,TAPECHECKED);                <<06057>>06950170
          FILE'COPIED:=TRUE;                                   <<06057>>06950180
          END;                                                 <<06057>>06950190
       END;                                                    <<06057>>06950200
END;                                                           <<06057>>06950210
$PAGE                                                          <<*GR1*>>06952000
                                                                        06954000
  <<Beginning of SAVE main block>>                             <<*GR1*>>06956000
                                                               <<*GR1*>>06958000
     AGFLEN:=7; AGFLEN(1):=5; AGFLEN(2):=4;                             06960000
     AGFLOC:=0; AGFLOC(1):=8; AGFLOC(2):=14;                            06962000
                                                               <<*GR1*>>06964000
     MOVE COMMAND:="SAVE"; <<Specify SAVE for COPYTOTAPE    >> <<*GR1*>>06966000
     BUILDVOLUMETABLE;  <<ALL VOLUMES MUST BE MOUNTED>>                 06968000
     IF <> THEN VTABERR:=TRUE;                                          06970000
                                                               <<*GR1*>>06972000
  <<Obtain the Directory Volume Table information for>>        <<*GR1*>>06974000
  <<system disk>>                                              <<*GR1*>>06976000
                                                               <<*GR1*>>06978000
     GETDIRC'VTAB'INFO(SYSLDEV,SYSDU,SYSTYPE,DIRBASE);         <<06057>>06980000
     DIR'BITMAP'SIZE := GET'DIR'BITMAP'SIZE;                   <<06057>>06981000
                                                               <<*GR1*>>06982000
   <<*******************************************************>> <<*GR1*>>06984000
   <<If Sector 28 of the system disk is not available, then >> <<04827>>06986000
   << ask user for starting sector of Directory and the numb>> <<*GR1*>>06988000
   << of sectors in the Directory(Is he supposed to know?)  >> <<*GR1*>>06990000
   <<*******************************************************>> <<*GR1*>>06992000
                                                               <<*GR1*>>06994000
     IF < THEN    <<DISC ERROR>>                                        06996000
     BEGIN                                                              06998000
          MOVE PBUF:=" CAN'T READ SECTOR 28 OF SYSTEM DISC";   <<04827>>07000000
           PRINT(PBUF,-36,CRLF);                               <<01.DM>>07002000
          DIRBASE:=0D;                                                  07004000
          MOVE PBUF:=" STARTING SECTOR OF DIRECTORY? ";                 07006000
          WHILE DIRBASE = 0D DO                                         07008000
          BEGIN                                                         07010000
                PRINT(PBUF,-31,NOCRLF);                        <<01.01>>07012000
               IF (LEN:=READ(RBUF,-7)) = 0 THEN RETURN;       <<01.01>> 07014000
               DIRBASE:=DOUBLE(BINARY(RBUF,LEN));                       07016000
               IF <> THEN SMESSAGE(0);                         <<06057>>07018000
          END;                                                          07020000
         DIR'BITMAP'SIZE := 0;                                 <<04827>>07040000
         MOVE PBUF := " NO. OF SECTORS IN THE BIT MAP? ";      <<04827>>07042000
         WHILE DIR'BITMAP'SIZE = 0 DO                          <<04827>>07044000
            BEGIN                                              <<04827>>07046000
            PRINT(PBUF,-32,NOCRLF);                            <<04827>>07048000
            LEN := READ(PBUFW,-7);                             <<04827>>07050000
            DIR'BITMAP'SIZE := BINARY(RBUF,LEN);               <<04827>>07052000
            IF <> OR LEN=0 THEN SMESSAGE(0);                   <<06057>>07054000
            END;                                               <<04827>>07056000
     END;                                                               07058000
                                                               <<06057>>07060000
                                                               <<*GR1*>>07062000
  <<Initialize magnetic tape parameters and variables>>        <<*GR1*>>07064000
                                                               <<*GR1*>>07066000
     NO'FILES'REEL := 0; <<START WITH NO FILES>>               <<01.DM>>07068000
     MOVE PBUF := " READY SERIAL DEVICE FOR WRITE";            <<01.DM>>07070000
     PRINT (PBUF, -30, CRLF);                                  <<SY.02>>07072000
                                                               <<*GR1*>>07074000
$IF X1=ON <<SERIES III DRIVER NEEDS TAPE'READY'CHECK        >> <<*GR1*>>07076000
                                                               <<*GR1*>>07078000
    IF NOTHP7976                                               <<*GR1*>>07080000
       THEN TAPE'READY'CHECK;                                  <<*GR1*>>07082000
                                                               <<*GR1*>>07084000
$IF                                                            <<*GR1*>>07086000
                                                               <<*GR1*>>07088000
    TAPECHECKED:=TRUE;                                         <<*GR1*>>07090000
    IF LPDTYPE.DTYPEF = MAGTAPE                                <<*GR1*>>07092000
       AND LPDTYPE.STYPEF=ST7976 THEN <<HP7976>>               <<*GR1*>>07094000
    BEGIN   << Clear Device and Set Density >>                 <<*GR1*>>07096000
       STAT := PERFORMIO ( 2, 16<<1600>>,  COPYBUF, 0 );       <<03628>>07100000
    END;                                                       <<*GR1*>>07102000
$PAGE                                                          <<*GR1*>>07104000
                                                               <<*GR1*>>07106000
   <<Keep reading files until user stops>>                     <<*GR1*>>07108000
                                                               <<*GR1*>>07110000
     WHILE MOREFILES DO                                                 07112000
     BEGIN                                                              07114000
          MOVE PBUF:=" FILE NAME (OR LDEV#,%SECTOR ADDRESS)? ";         07116000
           PRINT(PBUF,-39,NOCRLF);                             <<01.01>>07118000
          RLEN:=READ(RBUF,-30);                               <<01.01>> 07120000
          RBUF(RLEN) := CR;                                    <<01.DM>>07122000
          IF RLEN = 0 THEN MOREFILES:=FALSE;                            07124000
          SCAN RBUF UNTIL %6454,1;  <<SCAN FOR CR AND ",">>             07126000
                                                               <<*GR1*>>07128000
         <<*************************************************>> <<*GR1*>>07130000
         << If the file name given on the read was specified>> <<*GR1*>>07132000
         << as LDEV#,Sector# then attempt to read the file  >> <<*GR1*>>07134000
         << label from device and sector address given.     >> <<*GR1*>>07136000
         <<*************************************************>> <<*GR1*>>07138000
                                                               <<*GR1*>>07140000
          IF NOCARRY THEN << "," FOUND IN FILE SPECIFICATION>>          07142000
          BEGIN                                                         07144000
            << Determine LEN of LDEV read and obtain the    >> <<*GR1*>>07146000
            <<device number>>                                  <<*GR1*>>07148000
               LEN:=TOS-@RBUF;                                          07150000
               LDEV:=BINARY(RBUF,LEN);                                  07152000
               IF <> OR LDEV=0 THEN                                     07154000
               BEGIN                                                    07156000
                    SMESSAGE(0);                               <<06057>>07158000
                    GO TO L;                                            07160000
               END;                                                     07162000
                                                               <<*GR1*>>07164000
               IF LPDT(LDEV) = 0 THEN  <<LOGICAL DEVICE NOT CONFIGURED>>07166000
               BEGIN                                                    07168000
                    MOVE PBUF:=" LDEV    NOT DEFINED";                  07170000
                    ASCII(LDEV,PBUF(6));                                07172000
                     PRINT(PBUF,-20,CRLF);                     <<01.DM>>07174000
                    GO TO L;                                            07176000
               END;                                                     07178000
                                                               <<*GR1*>>07180000
               <<*******************************************>> <<*GR1*>>07182000
               << Obtain the sector address from read, store>> <<*GR1*>>07184000
               << in FLABel ADDress and test for proper numb>> <<*GR1*>>07186000
               <<*******************************************>> <<*GR1*>>07188000
                                                               <<*GR1*>>07190000
               FLABADDR:=DBINARY(RBUF(LEN+1),(RLEN-LEN-1));             07192000
               IF <> THEN                                               07194000
               BEGIN                                                    07196000
                    SMESSAGE(0);                               <<06057>>07198000
                    GO TO L;                                            07200000
               END;                                                     07202000
               DRTUNIT := LPDT (LDEV);                         <<SY.30>>07204000
                                                               <<*GR1*>>07206000
                <<******************************************>> <<*GR1*>>07208000
                <<Get maximum address of disk and determine >> <<*GR1*>>07210000
                <<if sector address given is on disk.       >> <<*GR1*>>07212000
                <<******************************************>> <<*GR1*>>07214000
                                                               <<*GR1*>>07216000
               STYPE:=LPDTYPE(LDEV).STYPEF;                    <<SY.30>>07218000
               MAXADDR:=GETMAXADDR(LDEV,DRTUNIT,STYPE);                 07220000
               IF < THEN RETURN;                                        07222000
               IF FLABADDR >= MAXADDR THEN  <<SECTOR NOT ON DISC>>      07224000
               BEGIN                                                    07226000
                    SMESSAGE(1);  <<INVALID DISC ADDRESS>>     <<06057>>07228000
                    GO TO L;                                            07230000
               END;                                                     07232000
                                                               <<*GR1*>>07234000
          <<Read File Label Address from disk>>                <<*GR1*>>07236000
                                                               <<*GR1*>>07238000
               DISC(READD,LDEV,DRTUNIT,STYPE,FLAB,FLABADDR,128);        07240000
               IF < THEN                                                07242000
               BEGIN                                                    07244000
                    MOVE PBUF:=" BAD TRACK - CAN'T READ LABEL";         07246000
                     PRINT(PBUF,-29,CRLF);                     <<01.DM>>07248000
                    GO TO L;                                            07250000
               END;                                                     07252000
                                                               <<*GR1*>>07254000
              <<********************************************>> <<*GR1*>>07256000
              <<Build file name from File Label in the form >> <<*GR1*>>07258000
              << File.Group.Account                         >> <<*GR1*>>07260000
              <<********************************************>> <<*GR1*>>07262000
                                                               <<*GR1*>>07264000
               MOVE NAMES:=FLAB,(12);                                   07266000
               MOVE PBUF(1):=FNAME,(8); PBUF(9):=".";                   07268000
               MOVE PBUF(10):=GNAME,(8); PBUF(18):=".";                 07270000
               MOVE PBUF(19):=ANAME,(8);                                07272000
               MOVE PBUF(27):=" - CONTENTS OF LABEL";                   07274000
                PRINT(PBUF,-47,CRLF);                          <<01.DM>>07276000
               MOVE LBUF:=" RETRIEVE THIS FILE (Y/N)? ";                07278000
               PRINT(LBUF,-27,NOCRLF);                        <<01.01>> 07280000
               LEN:=READ(RBUF,-1);                            <<01.01>> 07282000
                                                               <<*GR1*>>07284000
          << If file found in file label is requested to    >> <<*GR1*>>07286000
          << be saved, then call COPYTOTAPE to save file    >> <<*GR1*>>07288000
                                                               <<*GR1*>>07290000
               IF RBUF="Y" THEN                                         07292000
               BEGIN                                                    07294000
                    MOVE PBUF(28):=PBUF(27),(40); <<BLANK END OF LINE>> 07296000
                    ASCII(LDEV,PBUF(29));                               07298000
                    DASCII(FLABADDR,-8,PBUF(34));                       07300000
                    COPYTOTAPE(FLAB,COMMAND,TAPECHECKED);      <<*GR1*>>07302000
          L:   END;                                                     07304000
$PAGE                                                          <<*GR1*>>07306000
          <<************************************************>> <<*GR1*>>07308000
          << If NOCARRY test failed, then a file name of    >> <<*GR1*>>07310000
          << some type was given.  Parse the name into its  >> <<*GR1*>>07312000
          << components, check for errors, and save the file>> <<*GR1*>>07314000
          << or files requested.                            >> <<*GR1*>>07316000
          <<************************************************>> <<*GR1*>>07318000
                                                               <<*GR1*>>07320000
          END ELSE                                                      07322000
          IF MOREFILES THEN                                             07324000
          BEGIN                                                         07326000
               IF VTABERR THEN                                          07328000
               BEGIN                                                    07330000
                    MOVE PBUF:="Some volumes are not mounted,";<<*GR1*>>07332000
                    MOVE PBUF(29):=                            <<*GR1*>>07334000
                         "will SAVE all files possible";       <<*GR1*>>07336000
                    PRINT(PBUF,-57,CRLF);                      <<*GR1*>>07338000
               END;                                                     07340000
                                                               <<*GR1*>>07342000
                 <<RBUF contains the name of the file given >> <<*GR1*>>07344000
                                                               <<*GR1*>>07346000
               TYPE:=-1;                                                07348000
               ALLFILES:=FALSE;                                         07350000
               @BUF:=@RBUF;                                             07352000
               WHILE BUF =" " DO @BUF:=@BUF+1;                          07354000
               FNAME:=" "; MOVE FNAME(1):=FNAME,(23);                   07356000
               ALLNAMES:=FALSE;                                <<*GR1*>>07358000
               ALLFILES:=FALSE;                                <<*GR1*>>07360000
               FILE'COPIED:=FALSE;                             <<*GR1*>>07362000
                                                               <<*GR1*>>07364000
               ALLNAMES := GET'FILE'SET(BUF,FNAME,GNAME,ANAME);<<06057>>07368000
$PAGE                                                          <<*GR1*>>07420000
                                                               <<*GR1*>>07422000
               << Check for @ character in file name given >>  <<*GR1*>>07424000
                                                               <<*GR1*>>07426000
               IF FNAME="@" OR GNAME="@" OR ANAME="@"          <<*GR1*>>07428000
                  THEN ALLFILES:=TRUE;                         <<*GR1*>>07430000
                                                               <<*GR1*>>07432000
               << IF @.@.@ was specified, then we are done  >> <<*GR1*>>07434000
                                                               <<*GR1*>>07436000
               IF FNAME="@" AND GNAME="@" AND ANAME="@"        <<*GR1*>>07438000
                  THEN MOREFILES:=FALSE;                       <<*GR1*>>07440000
                                                               <<*GR1*>>07442000
                                                               <<*GR1*>>07444000
               << Check if all parts were given >>             <<*GR1*>>07446000
                                                               <<*GR1*>>07448000
               IF NOT ALLNAMES THEN                            <<*GR1*>>07450000
                  BEGIN                                        <<*GR1*>>07452000
                   SMESSAGE(0); <<*INVALID*>>                  <<06057>>07454000
                   RBUF (0):="  ";                             <<*GR1*>>07456000
                   MOVE RBUF (1):=RBUF (0),(17);               <<*GR1*>>07458000
                   GO TO L;                                    <<*GR1*>>07460000
                  END;                                         <<*GR1*>>07462000
                                                               <<*GR1*>>07464000
               MOVE INPUT'FILE   :=FNAME,(8);                  <<*GR1*>>07466000
               MOVE INPUT'GROUP :=GNAME,(8);                   <<*GR1*>>07468000
               MOVE INPUT'ACCOUNT:=ANAME,(8);                  <<*GR1*>>07470000
                                                               <<*GR1*>>07472000
               DATE := GET'DATE;                               <<06057>>07476000
                                                               <<06057>>07478000
               IF ALLFILES THEN                                         07508000
               BEGIN                                                    07510000
                    FOR I:=ATYPE UNTIL FTYPE DO  <<RESET DIR. INFO>>    07512000
                    BEGIN                                               07514000
                         CECNT(I):=TECNT(I):=0;                         07516000
                         CXCNT(I):=TXCNT(I):=0;                         07518000
                    END;                                                07520000
                                                               <<*GR1*>>07522000
               <<*******************************************>> <<*GR1*>>07524000
               << For every file in the system, if the file >> <<*GR1*>>07526000
               << name meets the requirements and the file  >> <<*GR1*>>07528000
               <<label is OK, (Date, etc), then copy it  to >> <<*GR1*>>07530000
               << the tape                                  >> <<*GR1*>>07532000
               <<*******************************************>> <<*GR1*>>07534000
                                                               <<*GR1*>>07536000
                                                               <<*GR1*>>07538000
                    WHILE GETNEXTFLABADDR DO                            07540000
                       SAVE'FILE;                              <<06057>>07542000
                    IF  NOT FILE'COPIED THEN                   <<*GR1*>>07582000
                       BEGIN                                   <<*GR1*>>07584000
                         MOVE PBUF:="No files in file set";    <<*GR1*>>07586000
                         PRINT(PBUF,-20,CRLF);                 <<*GR1*>>07588000
                       END;                                    <<*GR1*>>07590000
               END ELSE                                                 07592000
                                                               <<*GR1*>>07594000
            <<**********************************************>> <<*GR1*>>07596000
            <<Otherwise, a regular file name was given and  >> <<*GR1*>>07598000
            << scanned for in the file directory, and then  >> <<*GR1*>>07600000
            <<copied to tape                                >> <<*GR1*>>07602000
            <<**********************************************>> <<*GR1*>>07604000
                                                               <<*GR1*>>07606000
               BEGIN                                                    07608000
                    RESETSCANINFO;                                      07610000
                    FLABADDR:=DIRSCAN(SYSLDEV,SYSDU,SYSTYPE,,           07612000
                                      FNAME,GNAME,ANAME,,,DERROR);      07614000
                    IF LABELOK THEN COPYTOTAPE(FLAB,COMMAND,   <<*GR1*>>07616000
                                               TAPECHECKED);   <<*GR1*>>07618000
                END; <<If more files>>                         <<*GR1*>>07620000
           END; <<If file name was given(IF NOCARRY)>>         <<*GR1*>>07622000
      END; <<WHILE MOREFILES>>                                 <<*GR1*>>07624000
     IF NO'FILES'REEL <> 0 THEN <<At least one file saved   >> <<*GR1*>>07626000
     BEGIN                                                     <<00.01>>07628000
          CONTROL( EOF ); <<WRITE LAST EOF ON TAPE>>           <<*GR1*>>07630000
          CONTROL( REWIND'UNLOAD); << RESET TAPE UNIT>>        <<*GR1*>>07632000
     END;                                                      <<00.01>>07634000
END << SAVE >>;                                                         07636000
$PAGE                                                          <<*GR1*>>07638000
                                                                        07640000
                                                                        07642000
PROCEDURE EDIT;  << DISC EDIT >>                                        07644000
BEGIN                                                                   07646000
     INTEGER I,J,LEN,WORD,LDEV,STYPE,BUFLOC,PARMLOC,NUMPARM,            07648000
             DICTLOC,DRTUNIT,NUMWORDS;                                  07650000
     LOGICAL VALERR,MODIFIED,NOTFOUND,MOREPARMS,MORECOMMANDS;           07652000
     DOUBLE DVAL,ADDR,MAXADDR,BASEADDR:=0D;                             07654000
     INTEGER BVAL = DVAL+1;                                             07656000
     BYTE ARRAY CHAR(0:1);                                              07658000
     BYTE ARRAY PROMPT(0:1);                                            07660000
     BYTE ARRAY COMMAND(0:9);                                           07662000
     BYTE ARRAY COMMDICT(0:27)=PB:=                            <<*GR1*>>07664000
          4,"OUTM",                                                     07666000
          4,"PDSK",                                                     07668000
          4,"DISC",                                                     07670000
          4,"BASE",                                                     07672000
          6,"MODIFY",                                                   07674000
          0;                                                            07676000
     INTEGER ARRAY PARM(0:19);                                          07678000
     EQUATE                                                             07680000
          COMMANDNUM = 5,                                               07682000
          COMMLENMAX = 6;                                               07684000
                                                                        07686000
     INTEGER SUBROUTINE BINARYVAL(L);                                   07688000
     VALUE L; INTEGER L;                                                07690000
     BEGIN                                                              07692000
          VALERR:=FALSE;                                                07694000
          BVAL:=BINARY(RBUF(PARM(L)),PARM(L+1));                        07696000
          IF <> THEN                                                    07698000
          BEGIN                                                         07700000
               VALERR:=TRUE;                                            07702000
               SMESSAGE(0);                                    <<06057>>07704000
               RETURN;                                                  07706000
          END;                                                          07708000
          BINARYVAL:=BVAL;                                              07710000
     END <<BINARYVAL>>;                                                 07712000
$PAGE                                                          <<*GR1*>>07714000
                                                                        07716000
     DOUBLE SUBROUTINE DBINARYVAL(L);                                   07718000
     VALUE L; INTEGER L;                                                07720000
     BEGIN                                                              07722000
                                                                        07724000
          VALERR:=FALSE;                                                07726000
          DVAL:=DBINARY(RBUF(PARM(L)),PARM(L+1));                       07728000
          IF <>  THEN                                                   07730000
          BEGIN                                                         07732000
               VALERR:=TRUE;                                            07734000
               SMESSAGE(0);                                    <<06057>>07736000
               RETURN;                                                  07738000
          END;                                                          07740000
          DBINARYVAL:=DVAL;                                             07742000
      END <<DBINARYVAL>>;                                               07744000
                                                                        07746000
     SUBROUTINE DEVNOTDEFINED(DEV);                                     07748000
     VALUE DEV; INTEGER DEV;                                            07750000
     BEGIN                                                              07752000
          MOVE PBUF:="  LDEV    NOT DEFINED";                           07754000
          ASCII(DEV,PBUF(7));                                           07756000
           PRINT(PBUF,-21,CRLF);                               <<01.DM>>07758000
     END <<DEVNOTDEFINED>>;                                             07760000
                                                                        07762000
$PAGE                                                          <<*GR1*>>07764000
     INTEGER SUBROUTINE MYCOMMAND;                                      07766000
     BEGIN                                                              07768000
          I:=0;                                                         07770000
          NOTFOUND:=TRUE;                                               07772000
          BUFLOC:=PARMLOC:=NUMPARM:=DICTLOC:=0;                         07774000
          WHILE RBUF(BUFLOC) = " " DO BUFLOC:=BUFLOC+1;                 07776000
          MOVE COMMAND:=RBUF(BUFLOC) WHILE A,0;                         07778000
          BUFLOC:=TOS-@RBUF;                                            07780000
          IF (LEN:=TOS-@COMMAND) <= COMMLENMAX THEN                     07782000
          WHILE NOTFOUND AND (I:=I+1) <= COMMANDNUM DO                  07784000
          BEGIN                                                         07786000
               MOVE CHAR:=COMMDICT(DICTLOC),(1);                        07788000
               J:=INTEGER(CHAR);                                        07790000
               IF J = LEN THEN  <<POSSIBLE MATCH>>                      07792000
               IF COMMAND = COMMDICT(DICTLOC+1),(LEN) THEN  <<MATCH>>   07794000
               BEGIN                                                    07796000
                    MYCOMMAND:=I;                                       07798000
                    NOTFOUND:=FALSE;                                    07800000
               END;                                                     07802000
               DICTLOC:=DICTLOC+J+1;                                    07804000
          END;                                                          07806000
          IF NOTFOUND THEN RETURN;  <<MYCOMMAND = 0 - ERROR>>           07808000
          MOREPARMS:=TRUE;                                              07810000
          WHILE MOREPARMS DO                                            07812000
          BEGIN                                                         07814000
               WHILE RBUF(BUFLOC) = " " DO BUFLOC:=BUFLOC+1;            07816000
               SCAN RBUF(BUFLOC) UNTIL %6454,1;                         07818000
               IF CARRY THEN MOREPARMS:=FALSE; <<CR FOUND>>             07820000
               ASSEMBLE(DUP);                                           07822000
               PARM(PARMLOC):=BUFLOC;                                   07824000
               TOS:=(TOS-@RBUF)-BUFLOC;                                 07826000
               IF (PARM(PARMLOC+1):=TOS) <> 0 THEN                      07828000
               BEGIN                                                    07830000
                    NUMPARM:=NUMPARM+1;                                 07832000
                    BUFLOC:=(TOS-@RBUF)+1;                              07834000
                    PARMLOC:=PARMLOC+2;                                 07836000
               END ELSE DELETE;                                         07838000
          END;                                                          07840000
     END <<MYCOMMAND>>;                                                 07842000
                                                                        07844000
     SUBROUTINE OUTM';                                         <<01.DM>>07846000
     BEGIN                                                     <<01.DM>>07848000
          IF NUMPARM = 0 THEN OUTPUTMODE:=CONSOLE ELSE         <<01.DM>>07850000
          BEGIN                                                <<01.DM>>07852000
               MOVE RBUF:=RBUF(PARM),(PARM(1));                <<01.DM>>07854000
               OUTM;                                           <<01.DM>>07856000
          END;                                                 <<01.DM>>07858000
     END <<OUTM'>>;                                            <<01.DM>>07860000
                                                               <<01.DM>>07862000
                                                                        07864000
$PAGE                                                          <<*GR1*>>07866000
     SUBROUTINE PDSK';                                                  07868000
     BEGIN                                                              07870000
          FDEV:=LDEV;                                                   07872000
          PDSK(BASEADDR);                                               07874000
     END <<PDSK'>>;                                                     07876000
                                                                        07878000
     SUBROUTINE DISC';                                                  07880000
     BEGIN                                                              07882000
          IF NUMPARM = 0 THEN LDEV:=1 ELSE                              07884000
          BEGIN                                                         07886000
               TOS:=BINARY(RBUF(PARM),PARM(1));                         07888000
               IF <> THEN                                               07890000
               BEGIN                                                    07892000
                    SMESSAGE(0);                               <<06057>>07894000
                    DELETE;  <<BINARY RETURN VALUE>>                    07896000
                    RETURN;                                             07898000
               END;                                                     07900000
               IF (LDEV:=TOS) =  0 THEN SMESSAGE(11) ELSE      <<06057>>07902000
               IF LPDT(LDEV) = 0 THEN DEVNOTDEFINED(LDEV) ELSE          07904000
               BEGIN                                                    07906000
                    DRTUNIT := LPDT (LDEV);                    <<SY.30>>07908000
                    STYPE:=LPDTYPE(LDEV).STYPEF;               <<SY.30>>07910000
                    MAXADDR:=GETMAXADDR(LDEV,DRTUNIT,STYPE);            07912000
               END;                                                     07914000
          END;                                                          07916000
     END <<DISC'>>;                                                     07918000
                                                                        07920000
$PAGE                                                          <<*GR1*>>07922000
     SUBROUTINE BASE;                                                   07924000
     BEGIN                                                              07926000
          IF NUMPARM = 0 THEN BASEADDR:=0D ELSE                         07928000
          BASEADDR:=DBINARYVAL(0);                                      07930000
     END <<BASE>>;                                                      07932000
                                                                        07934000
     SUBROUTINE MODIFY;                                                 07936000
     BEGIN                                                              07938000
          ADDR:=0D;                                                     07940000
          WORD:=0;                                                      07942000
          NUMWORDS:=1;                                                  07944000
          MODIFIED:=FALSE;                                              07946000
          FOR I:=0 UNTIL (NUMPARM-1) DO                                 07948000
          BEGIN                                                         07950000
               J:=I & LSL(1);                                           07952000
               CASE * I OF                                              07954000
               BEGIN                                                    07956000
                    BEGIN                                               07958000
                         ADDR:=DBINARYVAL(J);   <<RELATIVE DISC ADDR>>  07960000
                         IF VALERR THEN RETURN;                         07962000
                    END;                                                07964000
                    BEGIN                                               07966000
                         WORD:=BINARYVAL(J);    <<RELATIVE WORD LOC>>   07968000
                         IF VALERR THEN RETURN;                         07970000
                    END;                                                07972000
                    BEGIN                                               07974000
                         NUMWORDS:=BINARYVAL(J); <<NUMBER OF WORDS>>    07976000
                         IF VALERR THEN RETURN;                         07978000
                    END;                                                07980000
               END;                                                     07982000
          END;                                                          07984000
          NUMWORDS:=NUMWORDS+1;                                         07986000
          IF (ADDR:=ADDR+BASEADDR) >= MAXADDR THEN                      07988000
          BEGIN                                                         07990000
               SMESSAGE(1);  <<INVALID DISC ADDRESS>>          <<06057>>07992000
               RETURN;                                                  07994000
          END;                                                          07996000
          RBUF(1):="%";  <<FOR BINARY PROCEDURE - CONVERT FROM OCTAL>>  07998000
          MOVE LBUF:="  SECTOR %        ";                              08000000
          MOVE PBUF:="     : 000000:=";                                 08002000
          DASCII(ADDR,-8,LBUF(11));                                     08004000
          PRINT(LBUF,-18,CRLF);                                <<01.DM>>08006000
          DISC(READD,LDEV,DRTUNIT,STYPE,TRACKBUF,ADDR,128);             08008000
          IF < THEN RETURN;  <<DISC ERROR>>                             08010000
          WHILE (NUMWORDS:=NUMWORDS-1) > 0 DO                           08012000
          BEGIN                                                         08014000
          MODIFY1:                                                      08016000
               MOVE PBUF(7):="000000";                                  08018000
               ASCII(WORD,PBUF(4),-8);                                  08020000
               ASCII(TRACKBUF(WORD),PBUF(12),-8);                       08022000
                PRINT(PBUF,-15,NOCRLF);                        <<01.01>>08024000
               RLEN:=READ(RBUFW(1),-10);                       <<01.DM>>08026000
               RBUF(RLEN+2) := CR;                             <<01.DM>>08028000
               IF RBUF(2) = "/" THEN RETURN;                            08030000
               IF RLEN <> 0 THEN                                        08032000
               BEGIN                                                    08034000
                    TOS:=BINARY(RBUF(1),RLEN+1);                        08036000
                    IF <> THEN                                          08038000
                    BEGIN                                               08040000
                         DELETE;                                        08042000
                         SMESSAGE(0);                          <<06057>>08044000
                         GO TO MODIFY1;                                 08046000
                    END;                                                08048000
                    MODIFIED:=TRUE;  <<AT LEAST ONE WORD MODIFIED>>     08050000
                    TRACKBUF(WORD):=TOS;                                08052000
               END;                                                     08054000
               IF (WORD:=WORD+1) > 127 THEN                             08056000
               IF NUMWORDS <> 0 THEN                                    08058000
               BEGIN                                                    08060000
                    IF MODIFIED THEN  <<WRITE OUT MODIFIED SECTOR>>     08062000
                    BEGIN                                               08064000
                         DISC(WRITED,LDEV,DRTUNIT,STYPE,TRACKBUF,       08066000
                                ADDR,128);                              08068000
                         IF < THEN RETURN;  <<DISC ERROR>>              08070000
                    END;                                                08072000
                    WORD:=0;                                            08074000
                    ADDR:=ADDR+1D;                                      08076000
                    MOVE PBUF(2):="  ";  <<BLANK OLD WORD LOC.>>        08078000
                    DASCII(ADDR,-8,LBUF(11));                           08080000
                    PRINT(LBUF,-18,CRLF);                      <<01.DM>>08082000
                    DISC(READD,LDEV,DRTUNIT,STYPE,TRACKBUF,             08084000
                           ADDR,128);                                   08086000
                    IF < THEN RETURN;  <<DISC ERROR>>                   08088000
               END;                                                     08090000
          END;                                                          08092000
          IF MODIFIED THEN  <<WRITE OUT MODIFIED SECTOR>>               08094000
          BEGIN                                                         08096000
               DISC(WRITED,LDEV,DRTUNIT,STYPE,TRACKBUF,ADDR,128);       08098000
               IF = THEN                                                08100000
               BEGIN                                                    08102000
                    MOVE PBUF:="  WRITTEN";                             08104000
                     PRINT(PBUF,-9,CRLF);                      <<01.DM>>08106000
               END;                                                     08108000
          END;                                                          08110000
     END <<MODIFY>>;                                                    08112000
$PAGE                                                          <<*GR1*>>08114000
                                                                        08116000
     LDEV:=SYSLDEV;  <<ASSUME SYSTEM DISC INITIALLY>>                   08118000
     DRTUNIT:=SYSDU;                                                    08120000
     STYPE:=SYSTYPE;                                                    08122000
     MAXADDR:=GETMAXADDR(LDEV,DRTUNIT,STYPE);                           08124000
     IF < THEN RETURN;                                                  08126000
     MOVE PROMPT:=" >";                                                 08128000
     MORECOMMANDS:=TRUE;                                       <<*GR1*>>08130000
     WHILE MORECOMMANDS DO                                              08132000
     BEGIN                                                              08134000
          PRINT(PROMPT,-2,NOCRLF);  << PROMPT CHARACTER >>              08136000
          RBUF:=" "; MOVE RBUF(1):=RBUF,(29);                           08138000
          RLEN := READ(RBUF,-30);                              <<01.DM>>08140000
          RBUF(RLEN) := CR;                                    <<01.DM>>08142000
          IF RLEN = 0 THEN                                     <<01.DM>>08144000
             MORECOMMANDS := FALSE ELSE                        <<01.01>>08146000
          CASE * MYCOMMAND OF                                           08148000
          BEGIN                                                         08150000
               BEGIN                                                    08152000
                    MOVE PBUF:=" * INVALID COMMAND *";                  08154000
                     PRINT(PBUF,-20,CRLF);                     <<01.DM>>08156000
               END;                                                     08158000
               OUTM';                                          <<01.DM>>08160000
               PDSK';                                                   08162000
               DISC';                                                   08164000
               BASE;                                                    08166000
               MODIFY;                                                  08168000
          END;                                                          08170000
     END;                                                               08172000
END << EDIT >>;                                                         08174000
                                                                        08176000
$PAGE "HP/3000 DISC UTILITY - FUNCTION EXECUTORS: PRINT FUNCTIONS"      08178000
                                                                        08180000
PROCEDURE PDSK(BASEADDRESS); << PRINT DISC SECTORS >>                   08182000
VALUE BASEADDRESS;                                                      08184000
DOUBLE BASEADDRESS;                                                     08186000
OPTION VARIABLE;                                                        08188000
BEGIN                                                                   08190000
     LOGICAL PMAP = Q-4;                                                08192000
     INTEGER LDEV:=0;                                                   08194000
     INTEGER I,J,LOC,PLEN,TEMP,STYPE,OFFSET,DRTUNIT,           <<SY.31>>08196000
             SECTNUM,WORDADDR,ENDADDR;                                  08198000
     LOGICAL FIRSTIME:=TRUE,MOREADDRESS:=TRUE;                          08200000
     DOUBLE TEMPD,ADDRESS,MAXADDRESS;                          <<06057>>08202000
     INTEGER TEMPD1 = TEMPD+1;                                          08204000
     INTEGER ARRAY                                                      08206000
          OUTNUM(0:1),                                                  08208000
          OUTCNT(0:1);                                                  08210000
     LOGICAL OCTALOUTPUT:=TRUE,ASCIIOUTPUT:=FALSE;                      08212000
     ARRAY BLANK(0:0);                                        <<01.01>> 08214000
     ARRAY SECTORW(0:9);                                       <<01.01>>08216000
     BYTE ARRAY SECTOR(*) = SECTORW;                           <<01.01>>08218000
     EQUATE                                                             08220000
          OCTALOUT = 0,                                                 08222000
          ASCIIOUT = 1;                                                 08224000
                                                                        08226000
     SUBROUTINE SPACE(SPACENUM);                                        08228000
     VALUE SPACENUM; INTEGER SPACENUM;                                  08230000
     BEGIN                                                              08232000
          FOR I:=1 UNTIL SPACENUM DO                                    08234000
          OUTPUT(BLANK,2);                                              08236000
     END <<SPACE>>;                                                     08238000
                                                                        08240000
$PAGE                                                          <<*GR1*>>08242000
     SUBROUTINE CHECKFORMAT;                                            08244000
     BEGIN                                                              08246000
          ASCIIOUTPUT:=OCTALOUTPUT:=FALSE;                              08248000
     L:   WHILE RBUF(J) = " " DO J:=J+1;                                08250000
          IF RBUF(J) = "A" THEN ASCIIOUTPUT:=TRUE ELSE                  08252000
          IF RBUF(J) = "O" THEN OCTALOUTPUT:=TRUE;                      08254000
          IF RBUF(J:=J+1) = "," THEN                                    08256000
          BEGIN                                                         08258000
               J:=J+1;                                                  08260000
               GO TO L;                                                 08262000
          END;                                                          08264000
          IF NOT (OCTALOUTPUT LOR ASCIIOUTPUT) THEN                     08266000
          OCTALOUTPUT:=TRUE;                                            08268000
     END <<CHECKFORMAT>>;                                               08270000
                                                                        08272000
$PAGE                                                          <<*GR1*>>08274000
     SUBROUTINE FILLINE(OUTYPE);                                        08276000
     VALUE OUTYPE; INTEGER OUTYPE;                                      08278000
     BEGIN                                                              08280000
          PLEN:=OUTLEN(OUTPUTMODE)-(OUTYPE*39);                         08282000
          IF WORDADDR = 120 THEN  <<PRINT LAST LINE OF SECTOR>>         08284000
          BEGIN                                                         08286000
               PLEN:=62-(OUTYPE*39);                                    08288000
               ENDADDR:=127;                                            08290000
          END ELSE                                                      08292000
          ENDADDR:=WORDADDR+OUTNUM(OUTPUTMODE);                         08294000
          FOR I:=WORDADDR UNTIL ENDADDR DO                              08296000
          BEGIN                                                         08298000
               TEMP:=SECTBUF(I);                                        08300000
               IF OUTYPE = OCTALOUT THEN                                08302000
               BEGIN                                                    08304000
                    LOC:=((I-WORDADDR)*7)+12+OFFSET;                    08306000
                    FOR J:=1 UNTIL 6 DO                                 08308000
                    BEGIN                                               08310000
                         LBUF(LOC-J):=TEMP.(13:3)+%60;                  08312000
                         TEMP:=TEMP & LSR(3);                           08314000
                    END;                                                08316000
               END ELSE                                                 08318000
               BEGIN                                                    08320000
                    LOC:=((I-WORDADDR)&LSL(1))+6+OFFSET;                08322000
                    LBUF(LOC):=IF (%40<=TEMP.(0:8)<=%137) THEN          08324000
                               BYTE(TEMP.(0:8)) ELSE ".";               08326000
                    LBUF(LOC+1):=IF (%40<=TEMP.(8:8)<=%137) THEN        08328000
                                 BYTE(TEMP.(8:8)) ELSE ".";             08330000
               END;                                                     08332000
          END;                                                          08334000
     END <<FILLINE>>;                                                   08336000
                                                                        08338000
$PAGE                                                          <<*GR1*>>08340000
     SUBROUTINE PRINTSECTOR(OUTYPE);                                    08342000
     VALUE OUTYPE; INTEGER OUTYPE;                                      08344000
     BEGIN                                                              08346000
     IF ADDRESS > MAXADDRESS THEN                              <<06057>>08346100
        BEGIN                                                  <<06057>>08346200
        SMESSAGE(1);                                           <<06057>>08346300
        SECTNUM := 0;         << Force early exit.          >> <<06057>>08346400
        RETURN;                                                <<06057>>08346500
        END;                                                   <<06057>>08346600
     DISC(READD,LDEV,DRTUNIT,STYPE,SECTBUF,ADDRESS,SECTLEN);   <<06057>>08348000
     IF < THEN                                                 <<06057>>08350000
        BEGIN                                                  <<06057>>08350100
        SMESSAGE(63);                                          <<06057>>08350200
        RETURN;                                                <<06057>>08350300
        END;                                                   <<06057>>08350400
     DASCII(ADDRESS,-8,SECTOR(10+OFFSET));                     <<06057>>08352000
     OUTPUT(SECTORW,17+OFFSET);                                <<01.01>>08354000
     LBUF:=" "; MOVE LBUF(1):=LBUF,(120);                      <<06057>>08356000
     LBUF(4+OFFSET):=":";                                      <<06057>>08358000
     FOR WORDADDR:=0 STEP OUTCNT(OUTPUTMODE) UNTIL 120 DO      <<06057>>08360000
        BEGIN                                                  <<06057>>08362000
        ASCII(WORDADDR,LBUF(3+OFFSET),-8);                     <<06057>>08364000
        FILLINE(OUTYPE);                                       <<06057>>08366000
        OUTPUT(LBUFW,PLEN);                                    <<06057>>08368000
        END;                                                   <<06057>>08370000
     SPACE(1);                                                 <<06057>>08372000
     END <<PRINTSECTOR>>;                                               08374000
                                                                        08376000
$PAGE                                                          <<*GR1*>>08378000
     MOVE BLANK:="  ";                                                  08380000
     LDEV:=FDEV;                                                        08382000
     DRTUNIT := LPDT(FDEV);                                    <<SY.30>>08384000
     STYPE:=LPDTYPE(FDEV).STYPEF;                              <<SY.30>>08386000
     MAXADDRESS := GETMAXADDR(LDEV,DRTUNIT,STYPE);             <<06057>>08387000
     IF NOT PMAP THEN  <<NO BASE SPECIFIED>>                            08388000
     BEGIN                                                              08390000
          OFFSET:=0;                                                    08392000
          BASEADDRESS:=0D;                                              08394000
     END ELSE                                                           08396000
     OFFSET:=1;  <<OFFSET OUTPUT BY ONE COLUMN - FOR EDIT PROC.>>       08398000
     OUTNUM:=7; OUTNUM(1):=14;  <<FORMAT PARAMETERS - C/P>>             08400000
     OUTCNT:=8; OUTCNT(1):=15;  <<FORMAT PARAMETERS - C/P>>             08402000
     WHILE MOREADDRESS DO                                               08404000
     BEGIN                                                              08406000
          SECTOR:=" ";MOVE SECTOR(OFFSET):=" SECTOR %        ";<<01.DM>>08408000
          PBUF:=" "; MOVE PBUF(OFFSET):=" ENTER ADDRESS: ";             08410000
           PRINT(PBUF,-(16+OFFSET),NOCRLF);                    <<01.01>>08412000
          IF (RLEN:=READ(RBUF,-20)) = 0 THEN                  <<01.01>> 08414000
             MOREADDRESS := FALSE ELSE                         <<01.01>>08416000
          BEGIN                                                         08418000
               RBUF(RLEN) := CR;                               <<01.DM>>08420000
               J:=0; SECTNUM:=0;                                        08422000
               FOR I:=0 UNTIL RLEN DO                                   08424000
               BEGIN                                                    08426000
                    IF RBUF(I) <> SPECIAL OR RBUF(I) = "%"              08428000
                    THEN J:=J+1 ELSE                                    08430000
                    BEGIN                                               08432000
                         ADDRESS:=DBINARY(RBUF,J);                      08434000
                         IF <> THEN SECTNUM:=0 ELSE                     08436000
                         IF RBUF(I) = CR OR RBUF(I) = ";" THEN          08438000
                         BEGIN                                          08440000
                              SECTNUM:=1;                               08442000
                              IF RBUF(I) = ";" THEN  <<FORMAT SPEC>>    08444000
                              BEGIN                                     08446000
                                   J:=I+1;                              08448000
                                   CHECKFORMAT;                         08450000
                              END;                                      08452000
                         END ELSE                                       08454000
                         BEGIN                                          08456000
                              SCAN RBUF(I+1) UNTIL %6473,1;             08458000
                              IF NOCARRY THEN  <<";" FOUND>>            08460000
                              BEGIN                                     08462000
                                   ASSEMBLE(DUP);                       08464000
                                   J:=TOS-@RBUF+1;                      08466000
                                   CHECKFORMAT;                         08468000
                              END;                                      08470000
                              J:=TOS-@RBUF(I+1);                        08472000
                              IF RBUF(I) = "," THEN                     08474000
                              BEGIN                                     08476000
                                   SECTNUM:=BINARY(RBUF(I+1),J);        08478000
                              END ELSE                                  08480000
                              IF RBUF(I) = ":" THEN                     08482000
                              BEGIN                                     08484000
                                   TOS:=DBINARY(RBUF(I+1),J);           08486000
                                   IF <> THEN SECTNUM:=0 ELSE           08488000
                                   BEGIN                                08490000
                                        TEMPD:=ADDRESS - TOS;           08492000
                                        SECTNUM:=IF TEMPD > 0D AND      08494000
                                                 TEMPD < 32768D THEN    08496000
                                                 (TEMPD1+1) ELSE 0;     08498000
                                   END;                                 08500000
                              END;                                      08502000
                         END;                                           08504000
                         I:=RLEN;  <<STOP LOOP>>                        08506000
                    END;                                                08508000
               END;                                                     08510000
               ADDRESS:=ADDRESS+BASEADDRESS;                            08512000
               IF SECTNUM = 0  THEN                            <<06057>>08514000
                  SMESSAGE(0)                                  <<06057>>08515000
               ELSE                                            <<06057>>08515100
                  WHILE SECTNUM > 0 DO  <<PRINT A SECTOR>>     <<06057>>08516000
                     BEGIN                                     <<06057>>08518000
                     IF FIRSTIME THEN                          <<06057>>08520000
                        BEGIN                                  <<06057>>08522000
                        FIRSTIME := FALSE;                     <<06057>>08524000
                        PRINTINFO(LDEV,DRTUNIT,STYPE,OFFSET);  <<06057>>08526000
                        END;                                   <<06057>>08528000
                     IF OCTALOUTPUT THEN                       <<06057>>08530000
                        PRINTSECTOR(OCTALOUT);                 <<06057>>08532000
                     IF ASCIIOUTPUT THEN                       <<06057>>08534000
                        PRINTSECTOR(ASCIIOUT);                 <<06057>>08536000
                     SECTNUM := SECTNUM - 1;                   <<06057>>08538000
                     ADDRESS := ADDRESS + 1D;                  <<06057>>08540000
                     END;                                      <<06057>>08542000
                                                               <<06057>>08544000
                                                               <<06057>>08546000
          END;                                                          08548000
     END;                                                               08550000
END << PDSK >>;                                                         08552000
$PAGE                                                          <<*GR1*>>08554000
                                                                        08556000
PROCEDURE PDTT;                                                         08558000
BEGIN                                                                   08560000
     INTEGER LDEV:=0;                                                   08562000
     INTEGER STYPE,DRTUNIT;                                             08564000
                                                                        08566000
     LDEV:=FDEV;                                                        08568000
     IF LPDTYPE(LDEV).DTYPEF = CS'80'TYPE THEN                 <<03628>>08570000
        BEGIN                                                  <<03628>>08572000
          MOVE PBUF:="Command set 80 disks do not have a DTT"; <<03628>>08574000
          PRINT(PBUF,-38,CRLF);                                <<03628>>08576000
          SMESSAGE(14);                                        <<06057>>08577000
          RETURN;                                              <<03628>>08578000
        END;                                                   <<03628>>08580000
     DRTUNIT := LPDT (FDEV);                                   <<SY.30>>08582000
     STYPE:=LPDTYPE(FDEV).STYPEF;                              <<SY.30>>08584000
     PRINTSTANDARDINFO;                                                 08586000
     LISTDTT(LDEV,DRTUNIT,STYPE);                                       08588000
END << PDTT >>;                                                         08590000
$PAGE                                                          <<*GR1*>>08592000
                                                                        08594000
PROCEDURE PVOL;                                                         08596000
BEGIN                                                                   08598000
     INTEGER LDEV:=0;                                                   08600000
     INTEGER STYPE,DRTUNIT,VTYPE,VCLID;                                 08602000
     BYTE ARRAY VOLID(0:7);                                             08604000
                                                                        08606000
     LDEV:=FDEV;                                                        08608000
     DRTUNIT := LPDT (FDEV);                                   <<SY.30>>08610000
     STYPE:=LPDTYPE(FDEV).STYPEF;                              <<SY.30>>08612000
     PRINTSTANDARDINFO;                                                 08614000
     GETVOLINFO(LDEV,DRTUNIT,STYPE,VTYPE,VOLID,VCLID);                  08616000
     IF < THEN RETURN;  <<DISC ERROR>>                                  08618000
     MOVE LBUF:=" TYPE=    , SUBTYPE=    , C-L ID=      , ";            08620000
     MOVE LBUF(41):="VOL. ID=         ";                                08622000
     ASCII(VTYPE.VTYPEF,LBUF(9),-10);                                   08624000
     ASCII(VTYPE.VSTYPEF,LBUF(23),-10);                                 08626000
     ASCII(VCLID,LBUF(34));                                             08628000
     MOVE LBUF(50):=VOLID,(8);                                          08630000
     OUTPUT(LBUFW,58);                                         <<01.01>>08632000
END << PVOL >>;                                                         08634000
$PAGE                                                          <<*GR1*>>08636000
                                                                        08638000
PROCEDURE PFIL;  <<PRINT FILES IN DIRECTORY>>                           08640000
BEGIN                                                                   08642000
     INTEGER I,J,LEN,LOC,VOL,TYPE,PLOC,LIMIT,DERROR,FLABDU,FLABST,      08644000
             NAMELOC;                                                   08646000
     LOGICAL LABELBAD,NAMERROR,ATSIGNSPEC,FILENOTFOUND;                 08648000
     DOUBLE FLABADDR;                                                   08650000
     INTEGER FLABADDR0 = FLABADDR;                                      08652000
     ARRAY FLAB(*) = TRACKBUF;                                          08654000
     ARRAY                                                              08656000
          NAME(0:11),                                                   08658000
          DNAME(0:11);                                                  08660000
     BYTE ARRAY                                                         08662000
          NAMES(*) = NAME,                                              08664000
          FNAME(*) = NAME,                                              08666000
          GNAME(*) = NAME(4),                                           08668000
          ANAME(*) = NAME(8);                                           08670000
     BYTE ARRAY                                                         08672000
          DFNAME(*) = DNAME,                                            08674000
          DGNAME(*) = DNAME(4),                                         08676000
          DANAME(*) = DNAME(8);                                         08678000
     BYTE ARRAY                                                         08680000
          OLDANAME(0:7),                                                08682000
          OLDGNAME(0:7);                                                08684000
     ARRAY BLANK(0:0);                                         <<01.01>>08686000
     DEFINE                                                             08688000
          NOATSIGN  = NOT ATSIGNSPEC#,                                  08690000
          FILEFOUND = NOT FILENOTFOUND#;                                08692000
                                                                        08694000
     LOGICAL SUBROUTINE MORENAMES;                                      08696000
     BEGIN                                                              08698000
          PLOC:=1;                                                      08700000
          LEN:=LOC:=TYPE:=NAMELOC:=0;                                   08702000
          NAMERROR:=LABELBAD:=FALSE;                                    08704000
          MOVE NAMES:=3("@       ");  <<DEFAULT FILE NAME: @.@.@>>      08706000
           PRINT(PBUF,-13,NOCRLF);   << NO CR/LF >>            <<01.01>>08708000
          IF (RLEN:=READ(RBUF,-72)) = 0 THEN RETURN;          <<01.01>> 08710000
          RBUF(RLEN) := CR;                                    <<01.DM>>08712000
          FOR I:=0 UNTIL (RLEN-1) DO                                    08714000
          BEGIN                                                         08716000
               WHILE RBUF(I) = " " AND I < RLEN DO I:=I+1;              08718000
               IF RBUF(I) = SPECIAL THEN                                08720000
               BEGIN                                                    08722000
                    IF RBUF(I) = "@" THEN                               08724000
                    BEGIN                                               08726000
                         IF LOC <> NAMELOC THEN NAMERROR:=TRUE;         08728000
                    END ELSE                                            08730000
                    IF RBUF(I) = "." THEN                               08732000
                    BEGIN                                               08734000
                         LEN:=0;                                        08736000
                         LOC:=NAMELOC:=NAMELOC+8;                       08738000
                    END ELSE                                            08740000
                    IF RBUF(I) = "," THEN                               08742000
                    BEGIN                                               08744000
                         I:=I+1;                                        08746000
                         WHILE RBUF(I) = " " DO I:=I+1;                 08748000
                         TYPE:=BINARY(RBUF(I),RLEN-I);                  08750000
                         IF <> OR NOT (1<=TYPE<=2) THEN                 08752000
                         NAMERROR:=TRUE;                                08754000
                    END ELSE NAMERROR:=TRUE;                            08756000
               END ELSE                                                 08758000
               BEGIN                                                    08760000
                    IF (LEN:=LEN+1) > 8 THEN NAMERROR:=TRUE;            08762000
                    NAMES(LOC):=RBUF(I);                                08764000
                    IF NAMES(NAMELOC) <> ALPHA THEN NAMERROR:=TRUE;     08766000
                    LOC:=LOC+1;                                         08768000
               END;                                                     08770000
               IF NAMERROR THEN I:=RLEN;  <<STOP LOOP>>                 08772000
          END;                                                          08774000
          IF NAMERROR THEN                                              08776000
          BEGIN                                                         08778000
               SMESSAGE(0);                                    <<06057>>08780000
               MORENAMES;                                               08782000
          END;                                                          08784000
          ATSIGNSPEC:=IF FNAME = "@" OR GNAME = "@" OR ANAME = "@" THEN 08786000
                      TRUE ELSE FALSE;                                  08788000
          MORENAMES:=TRUE;                                              08790000
     END  <<MORENAMES>>;                                                08792000
                                                                        08794000
$PAGE                                                          <<*GR1*>>08796000
     LOGICAL SUBROUTINE MOREFILES;                                      08798000
     BEGIN                                                              08800000
          IF NOATSIGN AND FILEFOUND THEN RETURN;  <<ONE FILE FOUND>>    08806000
          IF NOATSIGN THEN  <<LOOK FOR ONE FILE ONLY>>                  08808000
          BEGIN                                                         08810000
               FILENOTFOUND:=FALSE;  <<ASSUME SINGLE FILE FOUND>>       08812000
               RESETSCANINFO;                                           08814000
               FLABADDR:=DIRSCAN(SYSLDEV,SYSDU,SYSTYPE,,                08816000
                                 FNAME,GNAME,ANAME,,,DERROR);           08818000
               IF DERROR <> 0 THEN <<FILE/GROUP/ACCOUNT NOT FOUND>>     08820000
               BEGIN                                                    08822000
                    IF DERROR = BADLABEL THEN LABELBAD:=TRUE ELSE       08824000
                    FILENOTFOUND:=TRUE;                                 08826000
                    RETURN;                                             08828000
               END;                                                     08830000
               MOVE DNAME:=NAME,(12);  <<FOR NAME COMPARISON>>          08832000
          END ELSE  <<RUN THROUGH THE DIRECTORY>>                       08834000
          BEGIN                                                         08836000
               FLABADDR:=DIRBASE;                                       08838000
               GETDIRCENTRY(FTYPE,SYSLDEV,SYSDU,SYSTYPE,FLABADDR,       08840000
                            DFNAME,DERROR);                             08842000
               IF <> THEN                                               08844000
               BEGIN                                                    08846000
                    IF > THEN RETURN;                                   08848000
                    IF DERROR = BADLABEL THEN LABELBAD:=TRUE ELSE       08850000
                    WHILE NOT MOREFILES DO;  <<GET GOOD DIR. ENTRY>>    08852000
               END;                                                     08854000
          END;                                                          08856000
          MOREFILES:=TRUE;                                              08858000
     END <<MOREFILES>>;                                                 08860000
                                                                        08862000
     SUBROUTINE SPACE(SPACENUM);                                        08864000
     VALUE SPACENUM; INTEGER SPACENUM;                                  08866000
     BEGIN                                                              08868000
          FOR I:=1 UNTIL SPACENUM DO                                    08870000
          OUTPUT(BLANK,2);                                              08872000
     END  <<SPACE>>;                                                    08874000
                                                                        08876000
$PAGE                                                          <<*GR1*>>08878000
     SUBROUTINE PRINTFULLINE(INCR,LIMITC,LIMITP);                       08880000
     VALUE INCR,LIMITC,LIMITP;                                          08882000
     INTEGER INCR,LIMITC,LIMITP;                                        08884000
     BEGIN                                                              08886000
          LIMIT:=IF OUTPUTMODE = CONSOLE THEN LIMITC ELSE               08888000
                 LIMITP;                                                08890000
          IF (PLOC:=PLOC+INCR) > LIMIT THEN  <<FULL OUTPUT LINE>>       08892000
          BEGIN                                                         08894000
               PLOC:=1;                                                 08896000
               OUTPUT(LBUFW,LIMIT);                            <<01.01>>08898000
               LBUF:=" "; MOVE LBUF(1):=LBUF,(LIMIT);                   08900000
          END;                                                          08902000
     END <<PRINTFULLINE>>;                                              08904000
                                                                        08906000
$PAGE                                                          <<*GR1*>>08908000
     SUBROUTINE PRINTFILENAME;                                          08910000
     BEGIN                                                              08912000
          IF OLDANAME <> DANAME,(8) OR OLDGNAME <> DGNAME,(8) THEN      08914000
          BEGIN  <<NEW GROUP AND/OR ACCOUNT>>                           08916000
               IF PLOC > 1 THEN                                         08918000
               BEGIN                                                    08920000
                    OUTPUT(LBUFW,PLOC+1);                      <<01.01>>08922000
                    PLOC:=1;                                            08924000
               END;                                                     08926000
               MOVE LBUF:=" ACCOUNT =           GROUP =  ";             08928000
               MOVE LBUF(11):=DANAME,(8);                               08930000
               MOVE LBUF(29):=DGNAME,(8);                               08932000
               SPACE(1);                                                08934000
               OUTPUT(LBUFW,37);                               <<01.01>>08936000
               SPACE(1);                                                08938000
               MOVE OLDANAME:=DANAME,(8);                               08940000
               MOVE OLDGNAME:=DGNAME,(8);                               08942000
               LBUF:=" "; MOVE LBUF(1):=LBUF,(120);                     08944000
          END;                                                          08946000
          MOVE LBUF(PLOC):=DFNAME,(8);                                  08948000
          IF LABELBAD THEN   <<INSERT BAD-LABEL INDICATION>>            08950000
          BEGIN                                                         08952000
               J:=8;  <<ASSUME NO BLANKS IN FILE NAME>>                 08954000
               FOR I:=1 UNTIL 7 DO IF DFNAME(I) = " " THEN J:=I;        08956000
               LBUF(PLOC+J):="*";  <<BAD LABEL CHARACTER>>              08958000
          END;                                                          08960000
       << Don't need file label information.   >>              << JSC >>08962000
          IF ( (MHDISCTYPE<=TYPE<=FHDISCTYPE) OR               << JSC >>08964000
               (TYPE = CS'80'TYPE)                ) THEN       << JSC >>08966000
          BEGIN                                                         08968000
               IF (TYPE = MHDISCTYPE)    OR                    << JSC >>08970000
                  (TYPE = CS'80'TYPE)    THEN                  << JSC >>08972000
               BEGIN                                                    08974000
                    PRINTFULLINE(10,60,100);                            08976000
               END ELSE  <<PRINT FILE NAME,DEVICE, AND DISC ADDRESS>>   08978000
               BEGIN                                                    08980000
                    LBUF(PLOC+14):="%";  <<SECTOR ADDRESS IN OCTAL>>    08982000
                    VOL:=FLABADDR0.VOLF;                                08984000
                    FLABADDR0.VOLF:=0;  <<RESET VTAB INDEX FOR DASCII>> 08986000
                    ASCII(VTAB(VOL),LBUF(PLOC+10),-10);                 08988000
                    DASCII(FLABADDR,-8,LBUF(PLOC+15));                  08990000
                    PRINTFULLINE(27,54,108);                            08992000
               END;                                                     08994000
               RETURN;                                                  08996000
          END;                                                          08998000
          IF LABELBAD THEN  <<DON'T READ FILE LABEL>>                   09000000
          BEGIN                                                         09002000
               IF TYPE = 2 THEN PRINTFULLINE(45,45,90);                 09004000
               RETURN;                                                  09006000
          END;                                                          09008000
          VOL:=FLABADDR0.VOLF;                                          09010000
          FLABADDR0.VOLF:=0;  <<RESET VTAB INDEX FOR DISC>>             09012000
          FLABDU:=LPDT(VTAB(VOL));                                      09014000
          FLABST:=LPDTYPE(VTAB(VOL)).STYPEF;                   <<SY.30>>09016000
         DISC(READD,VTAB(VOL),FLABDU,FLABST,FLAB,FLABADDR,128);<<06057>>09018000
          <<ADD CODE HERE FOR PFIL TYPES INVOLVING FILE LABEL INFO>>    09020000
          IF TYPE = 2 THEN  <<FILE NAME,CREATION AND LAST ACCESS DATES>>09022000
          BEGIN                                                         09024000
               LBUF(PLOC+19):=",";                                      09026000
               DATECONV(LBUF(PLOC+12),FLAB(23),1);  <<CREATION DATE>>   09028000
               DATECONV(LBUF(PLOC+22),FLAB(25),1);  <<LAST MOD. DATE>>  09030000
               DATECONV(LBUF(PLOC+32),FLAB(24),1);  <<LAST ACCESS DATE>>09032000
               PRINTFULLINE(45,45,90);                                  09034000
               RETURN;                                                  09036000
          END;                                                          09038000
     END <<PRINTFILENAME>>;                                             09040000
                                                                        09042000
$PAGE                                                          <<*GR1*>>09044000
     MOVE BLANK:="  ";                                                  09046000
     MOVE PBUF:=" ENTER NAME: ";                                        09048000
     BUILDVOLUMETABLE;  <<ALL VOLUMES MUST BE MOUNTED>>                 09050000
     IF <> THEN                                                         09052000
     BEGIN                                                              09054000
          IF > THEN                                            <<*GR1*>>09056000
             BEGIN                                             <<*GR1*>>09058000
               MOVE PBUF:="PFIL command not gauranteed";       <<*GR1*>>09060000
               PRINT(PBUF,-27,CRLF);                           <<*GR1*>>09062000
             END;                                              <<*GR1*>>09064000
     END;                                                               09066000
     GETDIRC'VTAB'INFO(SYSLDEV,SYSDU,SYSTYPE,DIRBASE);                  09068000
     DIR'BITMAP'SIZE := GET'DIR'BITMAP'SIZE;                   <<06057>>09080000
     MOVE PBUF:=" ENTER NAME: ";                               <<*GR1*>>09082000
     WHILE MORENAMES DO                                                 09084000
     BEGIN                                                              09086000
          FILENOTFOUND:=TRUE;                                           09088000
          OLDANAME:=OLDGNAME:=" ";                                      09090000
          IF ATSIGNSPEC THEN  <<WILL RUN THROUGH THE DIRECTORY>>        09092000
          FOR I:=ATYPE UNTIL FTYPE DO  <<RESET DIRECTORY SCAN INFO>>    09094000
          BEGIN                                                         09096000
               CECNT(I):=TECNT(I):=0;                                   09098000
               CXCNT(I):=TXCNT(I):=0;                                   09100000
          END;                                                          09102000
          WHILE MOREFILES DO                                            09104000
          BEGIN                                                         09106000
               IF ANAME = DANAME,(8) OR ANAME = "@" THEN                09108000
               IF GNAME = DGNAME,(8) OR GNAME = "@" THEN                09110000
               IF FNAME = DFNAME,(8) OR FNAME = "@" THEN                09112000
               BEGIN                                                    09114000
                    FILENOTFOUND:=FALSE;                                09116000
                    PRINTFILENAME;                                      09118000
               END;                                                     09120000
          END;                                                          09122000
          IF FILENOTFOUND THEN                                          09124000
          BEGIN                                                         09126000
               IF (7<=DERROR<=9) THEN  <<ACCOUNT/GROUP/FILE NOT FOUND>> 09128000
               BEGIN                                                    09130000
                    IF DERROR = 7 THEN MOVE LBUF:=" * ACCOUNT ",2 ELSE  09132000
                    IF DERROR = 8 THEN MOVE LBUF:=" * GROUP ",2 ELSE    09134000
                    MOVE LBUF:=" * FILE ",2;                            09136000
                    MOVE * :="NOT IN DIRECTORY *    ";                  09138000
                    PRINT(LBUF,-29,CRLF);                      <<01.DM>>09140000
               END;                                                     09142000
          END ELSE                                                      09144000
          BEGIN   <<CLEAN UP REMAINING OUTPUT - IF ANY>>                09146000
               IF PLOC > 1 THEN OUTPUT(LBUFW,PLOC+1);          <<01.01>>09148000
               SPACE(1);  <<SKIP ONE LINE>>                             09150000
          END;                                                          09152000
     END;                                                               09154000
END  << PFIL >>;                                                        09156000
$PAGE                                                          <<*GR1*>>09158000
                                                                        09160000
PROCEDURE OUTM;  << CHANGE OUTPUT MODE/DEVICE >>               <<01.DM>>09162000
BEGIN                                                          <<01.DM>>09164000
     IF RBUF = "C" THEN OUTPUTMODE:=CONSOLE ELSE               <<01.DM>>09166000
     IF RBUF = "P" THEN OUTPUTMODE:=PRINTER ELSE               <<01.DM>>09168000
     SMESSAGE(0);                                              <<06057>>09170000
END << OUTM >>;                                                <<01.DM>>09172000
$PAGE "HP/3000 DISC UTILITY - FUNCTION EXECUTORS: UTILITY FUNCTIONS"    09174000
                                                                        09176000
PROCEDURE CONF;  <<CONFIGURE LOGICAL DEVICES>>                          09178000
BEGIN                                                                   09180000
     INTEGER DRT,LDEVNUM,DRTUNIT,LEN;                          <<06057>>09182000
     LOGICAL MOREDEV:=TRUE,DONE;                               <<03628>>09184000
     DOUBLE SERIAL'DISC,DEV'DESC;                              <<*GR1*>>09186000
     LOGICAL DESC0=DEV'DESC,DESC1=DEV'DESC+1;                  <<*GR1*>>09188000
                                                                        09190000
                                                               <<*GR1*>>09192000
<<**********************************************************>> <<*GR1*>>09194000
<< For Series III, the line printer information is stored in>> <<*GR1*>>09196000
<< Absolute location 1, used by the line printer driver in  >> <<*GR1*>>09198000
<< out RL file called PUTFAST. Console info  in lowcore also>> <<03628>>09200000
<<**********************************************************>> <<*GR1*>>09202000
                                                               <<*GR1*>>09204000
     DEFINE  LPDRT = ABSOLUTE(1).(8:8)#,<<Line Printer DRT  >> <<*GR1*>>09206000
             LPTYPE= ABSOLUTE(1).(6:2)#,<<Line Printer Type >> <<*GR1*>>09208000
             LPPAGE= ABSOLUTE(1).(0:1)#;                       <<*GR1*>>09210000
     DEFINE  CON'DRTN = ABSOLUTE(4)#, <<Console DRT number  >> <<03628>>09212000
             CON'BAUD = ABSOLUTE(%10)#,<<       BAUD rate   >> <<03628>>09214000
             CON'CNFG = ABSOLUTE(%13)#,<<       CONFIGUR.   >> <<03628>>09216000
             CON'UNIT = CON'CNFG.(12:4)#,<<     UNIT number >> <<03628>>09218000
             CON'TYPE = CON'CNFG.(1:2)#; <<     TYPE        >> <<03628>>09220000
                                                               <<03628>>09222000
$PAGE                                                          <<06057>>09223000
SUBROUTINE PRINT'SPACE;                                        <<06057>>09224000
BEGIN                                                          <<06057>>09225000
PBUF := " ";PRINT(PBUF,-1,CRLF);                               <<06057>>09226000
END;                                                           <<06057>>09227000
                                                               <<06057>>09228000
SUBROUTINE LIST'IT(LDEVNUM);                                   <<06057>>09229000
VALUE LDEVNUM;                                                 <<06057>>09230000
INTEGER LDEVNUM;                                               <<06057>>09231000
                                                               <<06057>>09232000
BEGIN                                                          <<06057>>09233000
PBUF:=" "; MOVE PBUF(1):=PBUF,(30);                            <<06057>>09234000
ASCII(LDEVNUM,PBUF(3),-10);                                    <<06057>>09235000
ASCII(LPDT(LDEVNUM).DRTF,PBUF(9),-10);                         <<06057>>09236000
ASCII(LPDT(LDEVNUM).UNITF,PBUF(14),-10);                       <<06057>>09237000
ASCII(LPDTYPE(LDEVNUM).DTYPEF,PBUF(20),-10);                   <<06057>>09238000
ASCII(LPDTYPE(LDEVNUM).STYPEF,PBUF(28),-10);                   <<06057>>09239000
PRINT(PBUF,-31,CRLF);                                          <<06057>>09240000
END;                                                           <<06057>>09241000
                                                               <<06057>>09242000
SUBROUTINE LIST'HEAD;                                          <<06057>>09244000
BEGIN                                                          <<06057>>09246000
PRINT'SPACE;                                                   <<06057>>09248000
MOVE PBUF := " LDEV  DRT  UNIT  TYPE  SUBTYPE";                <<06057>>09250000
PRINT(PBUF,-31,CRLF);                                          <<06057>>09252000
MOVE PBUF := " ----  ---  ----  ----  -------";                <<06057>>09254000
PRINT(PBUF,-31,CRLF);                                          <<06057>>09256000
PRINT'SPACE;                                                   <<06057>>09258000
END;                                                           <<06057>>09260000
                                                               <<06057>>09262000
SUBROUTINE LISTLDEV;                                           <<06057>>09264000
BEGIN                                                          <<06057>>09266000
GETYESNO(@NOLIST,39);                                          <<06057>>09268000
LIST'HEAD;                                                     <<06057>>09270000
FOR LDEVNUM := 1 UNTIL LDEVMAX DO                              <<06057>>09272000
   IF LPDT(LDEVNUM) <> 0                                       <<06057>>09274000
      THEN LIST'IT(LDEVNUM);                                   <<06057>>09276000
PRINT'SPACE;                                                   <<06057>>09278000
NOLIST:                                                        <<06057>>09280000
END;                                                           <<06057>>09282000
$PAGE                                                          <<*GR1*>>09284000
  <<********************************************************>> <<*GR1*>>09286000
  << GETDEVINFO obtains device information for LDEV NUM:    >> <<*GR1*>>09288000
  <<     DRT - Device Reference Table number                >> <<*GR1*>>09290000
  <<     UNIT number for the device                         >> <<*GR1*>>09292000
  <<     TYPE numbver for the device                        >> <<*GR1*>>09294000
  <<     SubTYPE number of device                           >> <<*GR1*>>09296000
  <<********************************************************>> <<*GR1*>>09298000
                                                               <<*GR1*>>09300000
     SUBROUTINE GETDEVINFO;                                             09302000
     BEGIN                                                              09304000
          DRT := GETVAL( 35,0,511,1);                          <<*GR1*>>09306000
          IF DRT <> 0 THEN                                              09308000
          BEGIN                                                         09310000
               LPDT(LDEVNUM):=0;                               <<SY.30>>09312000
               LPDT(LDEVNUM).DRTF:=DRT;                                 09314000
               LPDT(LDEVNUM).UNITF:=GETVAL(36,0,15,1);                  09316000
               <<Do not ask type for console>>                 <<03628>>09318000
               IF LDEVNUM <> CONSLDV THEN                      <<03628>>09320000
                  LPDTYPE(LDEVNUM).DTYPEF:=GETVAL(37,0,255,1); <<03628>>09322000
               LPDTYPE(LDEVNUM).STYPEF:=GETVAL(38,0,15,1);     <<SY.30>>09324000
               IF LDEVNUM = SYSLDEV THEN <<UPDATE SYSTEM DISC INFO>>    09326000
               BEGIN                                                    09328000
                    VTABASE:=0D;  <<TRIGGER GETDIRC'VTAB'INFO CALL>>    09330000
                    SYSDU  :=LPDT (SYSLDEV);                   <<SY.30>>09332000
                    SYSTYPE:=LPDTYPE(SYSLDEV).STYPEF;          <<SY.30>>09334000
               END;                                                     09336000
                                                               <<*GR1*>>09338000
               <<*******************************************>> <<*GR1*>>09340000
               << If we are running under the HPIB version  >> <<*GR1*>>09342000
               << take advantage of IDEVTIFYDEVICE to see if>> <<*GR1*>>09344000
               << the configuration given is compatible with>> <<*GR1*>>09346000
               << the device located at the DRTUNIT number  >> <<*GR1*>>09348000
               << given.  Note:  IDENTIFYDEVICE returns the >> <<*GR1*>>09350000
               << description in the following manner:      >> <<*GR1*>>09352000
               << DRT WORD0.(0:9), SUBTYPE WORD0(9:4),      >> <<*GR1*>>09354000
               << UNIT WORD0.(13:3), AND TYPE WORD1         >> <<*GR1*>>09356000
               <<*******************************************>> <<*GR1*>>09358000
                                                               <<*GR1*>>09360000
$IF X1=OFF <HPIB VERSION>>                                     <<*GR1*>>09362000
                                                               <<*GR1*>>09364000
               <<*******************************************>> <<*GR1*>>09366000
               << Call CHANGEDEVICE with no parameters to   >> <<*GR1*>>09368000
               << initialize some very important variables, >> <<*GR1*>>09370000
               << which include address pointers for the    >> <<*GR1*>>09372000
               << DISCDRIVER channel program, PERFORMIOBASE >> <<*GR1*>>09374000
               << serial device storage .  See the procedure>> <<*GR1*>>09376000
               << for details.                              >> <<*GR1*>>09378000
               <<*******************************************>> <<*GR1*>>09380000
                                                               <<*GR1*>>09382000
               CHANGEDEVICE;                                   <<*GR1*>>09384000
                                                               <<*GR1*>>09386000
               DRTUNIT:=LPDT(LDEVNUM);                         <<*GR1*>>09388000
               IF NOT IDENTIFYDEVICE(DRTUNIT,DEV'DESC)  THEN   <<*GR1*>>09390000
                  BEGIN                                        <<*GR1*>>09392000
                    MOVE PBUF:="Invalid DRT or UNIT number";   <<*GR1*>>09394000
                    PRINT(PBUF,-26,CRLF);                      <<*GR1*>>09396000
                  END                                          <<*GR1*>>09398000
               ELSE                                            <<*GR1*>>09400000
                  IF LPDTYPE(LDEVNUM).DTYPEF<>DESC1 OR         <<*GR1*>>09402000
                     LPDTYPE(LDEVNUM).STYPEF<>DESC0.(9:4)      <<*GR1*>>09404000
                     THEN BEGIN                                <<*GR1*>>09406000
                       MOVE PBUF:="Improper TYPE or SUBTYPE";  <<*GR1*>>09408000
                       PRINT(PBUF,-24,CRLF);                   <<*GR1*>>09410000
                     END;                                      <<*GR1*>>09412000
                                                               <<*GR1*>>09414000
$IF                                                            <<*GR1*>>09416000
                                                               <<*GR1*>>09418000
      <<If DRT = 0, then clear configuration>>                 <<*GR1*>>09420000
                                                               <<*GR1*>>09422000
          END ELSE LPDT(LDEVNUM):=LPDTYPE(LDEVNUM):=0;                  09424000
     END <<GETDEVINFO>>;                                                09426000
                                                                        09428000
                                                                        09430000
<<**********************************************************>> <<03628>>09432000
<< For the Series II/III versions we can reassign the system>> <<03628>>09434000
<<  console to another termainal or to a phone modem!       >> <<03628>>09436000
<<**********************************************************>> <<03628>>09438000
                                                               <<03628>>09440000
   SUBROUTINE PRINT'CONS'INFO;                                 <<03628>>09442000
     BEGIN                                                     <<03628>>09444000
       MOVE PBUF:="  ";PRINT(PBUF,-2,CRLF);                    <<03628>>09446000
       MOVE PBUF:="CONSOLE IS CURRENTLY AT DRT#    ,UNIT#    ";<<03628>>09448000
       ASCII(CON'DRTN,PBUF(31),-10);                           <<03628>>09450000
       ASCII(CON'UNIT,PBUF(41),-10);                           <<03628>>09452000
       PRINT(PBUF,-42,CRLF);                                   <<03628>>09454000
       GETYESNO(@NOCONS,62);                                   <<03628>>09456000
       LDEVNUM:=CONSLDV;                                       <<03628>>09458000
       GETDEVINFO;                                             <<03628>>09460000
       IF LPDT(CONSLDV)<>0 THEN                                <<03628>>09462000
          BEGIN                                                <<03628>>09464000
            MOVE PBUF:="CHANGE CONSOLE TO HARDWIRE AT DRT#";   <<03628>>09466000
            MOVE PBUF(33):="     UNIT#     ?";                 <<03628>>09468000
            ASCII(LPDT(CONSLDV).DRTF,PBUF(36),-10);            <<03628>>09470000
            ASCII(LPDT(CONSLDV).UNITF,PBUF(46),-10);           <<03628>>09472000
            IF LPDTYPE(CONSLDV).STYPEF=1 OR                    <<03628>>09474000
               LPDTYPE(CONSLDV).STYPEF=3                       <<03628>>09476000
               THEN MOVE PBUF(18):="MODEM   ";                 <<03628>>09478000
            DONE:=FALSE;                                       <<03628>>09480000
            WHILE NOT DONE DO                                  <<03628>>09482000
              BEGIN                                            <<03628>>09484000
                DONE:=TRUE;                                    <<03628>>09486000
                PRINT(PBUF,-49,NOCRLF);                        <<03628>>09488000
                RLEN:=READ(RBUF,-4);                           <<03628>>09490000
                IF RLEN <> 0 THEN                              <<03628>>09492000
                  BEGIN                                        <<03628>>09494000
                   IF RBUF <> "Y" AND RBUF <> "y" THEN         <<03628>>09496000
                      BEGIN                                    <<03628>>09498000
                        IF RBUF<>"N" AND RBUF<>"n" THEN        <<03628>>09500000
                           BEGIN                               <<03628>>09502000
                             SMESSAGE(0);                      <<06057>>09504000
                             DONE:=FALSE;                      <<03628>>09506000
                           END;                                <<03628>>09508000
                      END                                      <<03628>>09510000
                   ELSE                                        <<03628>>09512000
                      BEGIN                                    <<03628>>09514000
                        CON'DRTN:=LPDT(CONSLDV).DRTF;          <<03628>>09516000
                        CON'UNIT:=LPDT(CONSLDV).UNITF;         <<03628>>09518000
                        CON'TYPE:=LPDTYPE(CONSLDV).STYPEF;     <<03628>>09520000
                        CON'BAUD:=0;                           <<03628>>09522000
                        MOVE PBUF:=PTITLE,2;                   <<03628>>09524000
                        XREG:=TOS-@PBUF;                       <<03628>>09526000
                        PRINT(PBUFW,-XREG,CRLF);               <<03628>>09528000
                      END;                                     <<03628>>09530000
                  END;                                         <<03628>>09532000
              END; <<WHILE RLEN NOT 0 >>                       <<03628>>09534000
          END;                                                 <<03628>>09536000
NOCONS:                                                        <<03628>>09538000
                                                               <<03628>>09540000
     END;                                                      <<03628>>09542000
                                                               <<03628>>09544000
$PAGE                                                          <<*GR1*>>09546000
<<**********************************************************>> <<*GR1*>>09548000
<< Beginning of CONFigure.  This procedure configures all   >> <<*GR1*>>09550000
<< the logicla devices in the system by prompting the user  >> <<*GR1*>>09552000
<< for LDEV#, DRT #, Type, Subtype and Unit # for all disks >> <<*GR1*>>09554000
<< that are to be configured in the system.  It is called at>> <<*GR1*>>09556000
<< the start of the program and can be called at any time   >> <<*GR1*>>09558000
<< during SADUTIL to add or change system devices. If it is >> <<*GR1*>>09560000
<< the first time through (FUNC=0), then clear out the LPDT >> <<*GR1*>>09562000
<< table and Volume TABle.                                  >> <<*GR1*>>09564000
<<**********************************************************>> <<*GR1*>>09566000
                                                               <<*GR1*>>09568000
  IF NOT SYSUP THEN                                            <<03628>>09570000
    BEGIN                                                      <<03628>>09572000
        LPDT := 0;                                             <<01.DM>>09574000
        MOVE LPDT(1) := LPDT,(LDEVMAX);                        <<01.DM>>09576000
        LPDTYPE := 0;                                          <<01.DM>>09578000
        MOVE LPDTYPE(1) := LPDTYPE,(LDEVMAX);                  <<01.DM>>09580000
        VTAB := 0;                                             <<01.DM>>09582000
        MOVE VTAB(1) := VTAB,(LDEVMAX);                        <<01.DM>>09584000
                                                               <<*GR1*>>09586000
        <<**************************************************>> <<*GR1*>>09588000
        << For Series III, we must request printer DRT and  >> <<*GR1*>>09590000
        << Type.  Types are designated as follows:          >> <<*GR1*>>09592000
        <<                                                  >> <<*GR1*>>09594000
        <<      Type 0 for 2607A,2613A,2617A, and 2618A     >> <<*GR1*>>09596000
        <<      Type 1 for 2610A,2614A                      >> <<*GR1*>>09598000
        <<      Type 2 for 2608A                            >> <<*GR1*>>09600000
        <<**************************************************>> <<*GR1*>>09602000
$IF X1=ON                                                      <<*GR1*>>09604000
                                                               <<*GR1*>>09606000
     TOS:=GETVAL(52,1,255,2);                                  <<*GR1*>>09608000
     IF <> THEN                                                <<*GR1*>>09610000
        BEGIN                                                  <<*GR1*>>09612000
          LPDRT:=TOS; <<Line printer DRT number initialized >> <<*GR1*>>09614000
          LPTYPE:=GETVAL(37,0,2,1); <<LP Type initialized   >> <<*GR1*>>09616000
        END;                                                   <<*GR1*>>09618000
                                                               <<*GR1*>>09620000
     <<Store serial device information for Series III in    >> <<*GR1*>>09622000
     << LPDT(0).  The DRT is stored in the SWITCH'REGISTER  >> <<*GR1*>>09624000
                                                               <<*GR1*>>09626000
     LPDT(SERIAL).UNITF:=0; <<Always unit 0                 >> <<*GR1*>>09628000
     LPDT(SERIAL).DRTF :=SWITCH'REGISTER.(8:8);                <<*GR1*>>09630000
     LPDTYPE(SERIAL).DTYPEF:= MAGTAPE; <<Always a mag tape  >> <<*GR1*>>09632000
     LPDTYPE(SERIAL).STYPEF:= IF HP7976                        <<*GR1*>>09634000
                                 THEN ST7976  <<7976 OR 7970>> <<*GR1*>>09636000
                                 ELSE ST7970;                  <<*GR1*>>09638000
                                                               <<*GR1*>>09640000
$IF  << END OF SERIES II/III ONLY CONFIGURATION>>              <<*GR1*>>09642000
                                                               <<*GR1*>>09644000
     END;                                                               09646000
ASKFORCHANGES:                                                          09648000
     IF FRDEVSPEC THEN  << CONFIGURE ONE LOGICAL DEVICE >>              09650000
        BEGIN                                                  <<06057>>09652000
        LDEVNUM:=FDEV;                                         <<06057>>09654000
        GETDEVINFO;                                            <<06057>>09656000
        END                                                    <<06057>>09658000
     ELSE                                                      <<06057>>09659000
        BEGIN                                                  <<06057>>09660000
        IF NOT SYSUP THEN                                      <<06057>>09662000
           BEGIN  << First time through CONF.               >> <<06057>>09662100
           PBUF := " ";PRINT(PBUF,-1,CRLF);                    <<06057>>09662110
           MOVE PBUF :=                                        <<06057>>09662200
           "CONFIGURE ALL DISKS IN VOLUME SET",2;              <<06057>>09662300
           LEN := TOS - @PBUF;PRINT(PBUF,-LEN,CRLF);           <<06057>>09662400
           PBUF := " ";PRINT(PBUF,-1,CRLF);                    <<06057>>09662500
           END                                                 <<06057>>09662600
        ELSE                                                   <<06057>>09662700
           BEGIN                                               <<06057>>09662800
           LISTLDEV;                                           <<06057>>09662900
           GETYESNO( @NOCHANGES,53);                           <<06057>>09664000
           END;                                                <<06057>>09664100
        MOREDEV:=TRUE;                                         <<06057>>09666000
        PVOL'SET := FALSE;                                     <<06057>>09666100
        GETYESNO(@NOPVOL,65);                                  <<06057>>09666200
        PVOL'SET := TRUE;                                      <<06057>>09666300
NOPVOL:                                                        <<06057>>09666400
        WHILE MOREDEV DO                                       <<06057>>09668000
           BEGIN                                               <<06057>>09670000
           LDEVNUM:=GETVAL(34,1,LDEVMAX,2);                    <<06057>>09672000
           IF <> THEN GETDEVINFO ELSE MOREDEV:=FALSE;          <<06057>>09674000
           END;                                                <<06057>>09676000
        END;                                                   <<06057>>09678000
     LISTLDEV;                                                          09680000
NOCHANGES:                                                              09682000
     IF LPDT(SYSLDEV) = 0 THEN                                 <<06057>>09684000
        SMESSAGE(17);  << System disc is not configured.    >> <<06057>>09686000
                                                               <<06057>>09692000
$IF X1=ON <<ONLY SERIES II/III CAN WE REASSIGN CONSOLE      >> <<03628>>09694000
     <<Ask to reassign the system console>>                    <<03628>>09696000
                                                               <<03628>>09698000
     PRINT'CONS'INFO;                                          <<03628>>09700000
                                                               <<03628>>09702000
$IF       <<ONLY SERIES II/III CAN WE REASSIGN CONSOLE      >> <<03628>>09704000
                                                                        09706000
$PAGE                                                          <<06057>>09708000
     <<*****************************************************>> <<*GR1*>>09710000
     << Accept Serial Device changes and place the informa- >> <<*GR1*>>09712000
     << tion in LPDT(0), reserved for Serial Device changes.>> <<*GR1*>>09714000
     << Then call CHANGEDEVICE, an external procedure in    >> <<*GR1*>>09716000
     << SDFUTIL that stores the serial device information in>> <<*GR1*>>09718000
     << its tables for use later when calling PERFORMIO to  >> <<*GR1*>>09720000
     << write to the serial device.  If the serial device is>> <<*GR1*>>09722000
     << a serial disk, CHANGEDEVICE checks to insure that it>> <<*GR1*>>09724000
     << is a proper serial disk.                            >> <<*GR1*>>09726000
     <<*****************************************************>> <<*GR1*>>09728000
                                                               <<*GR1*>>09730000
$IF X1=OFF << HPIB VERSIONS ONLY TAKE SERIAL DEVICE INFO    >><<<*GR1*>>09732000
     IF NOT FRDEVSPEC THEN                                     <<01.DM>>09734000
     BEGIN                                                     <<01.DM>>09736000
     GETYESNO(@LISTSER,56); << SERIAL DEVICE CHANGES?    >>    <<06057>>09738000
     LDEVNUM := SERIAL;                                        <<06057>>09740000
     GETDEVINFO;                                               <<06057>>09742000
     IF LPDT(SERIAL) <> 0 THEN                                 <<*GR1*>>09744000
        BEGIN                                                  <<01.DM>>09746000
                                                               <<*GR1*>>09748000
        <<**************************************************>> <<*GR1*>>09750000
        << The procedure CHANGEDEVICE stores the DRT,UNIT,  >> <<*GR1*>>09752000
        << TYPE and SUBTYPE differently than does SADUTIL,  >> <<*GR1*>>09754000
        << therefore, we must send the SERIALDESCription in >> <<*GR1*>>09756000
        << the manner that it wants, DRT in word 0, (0:9),  >> <<*GR1*>>09758000
        << SUBTYPE in word 0, (9:4) , UNIT in word 0, (13:3)>> <<*GR1*>>09760000
        << and TYPE is in word 1.                           >> <<*GR1*>>09762000
        <<**************************************************>> <<*GR1*>>09764000
                                                               <<*GR1*>>09766000
          TOS := LPDT(SERIAL);                                 <<*GR1*>>09768000
          S0.(9:4):=LPDTYPE(SERIAL).STYPEF;                    <<*GR1*>>09770000
          TOS := LPDTYPE(SERIAL).DTYPEF;                       <<*GR1*>>09772000
           SERIAL'DISC := TOS;                                 <<01.DM>>09774000
           CHANGEDEVICE(,SERIAL'DISC);                         <<01.DM>>09776000
           IF <> THEN                                          <<01.DM>>09778000
           BEGIN                                               <<01.DM>>09780000
              SMESSAGE( 61 ); <<INVALID SERIAL DEVICE>>        <<06057>>09782000
              GOTO NOCHANGES;                                  <<01.DM>>09784000
           END;                                                <<01.DM>>09786000
        END;                                                   <<01.DM>>09788000
LISTSER:                                                       <<06057>>09789000
     GETYESNO(@EXIT,64);                                       <<06057>>09789100
     IF LPDT(SERIAL) <> 0 THEN                                 <<06057>>09789200
        BEGIN                                                  <<06057>>09789300
        LIST'HEAD;                                             <<06057>>09789400
        LIST'IT(SERIAL);                                       <<06057>>09789500
        PRINT'SPACE;                                           <<06057>>09789600
        END;                                                   <<06057>>09789700
     END;                                                      <<01.DM>>09790000
EXIT:                                                          <<01.DM>>09792000
$IF                                                            <<*GR1*>>09794000
END << CONF >>;                                                         09796000
$PAGE                                                          <<*GR1*>>09798000
PROCEDURE DCOPY( LDEV1, LDEV2);                                <<01.DM>>09800000
   VALUE LDEV1, LDEV2;                                         <<01.DM>>09802000
   INTEGER LDEV1, LDEV2;                                       <<01.DM>>09804000
BEGIN                                                          <<01.DM>>09806000
   INTEGER                                                     <<01.DM>>09808000
      LOG'PACK'SIZE,                                           <<01.DM>>09810000
      TRK'CYL,                                                 <<01.DM>>09812000
      SEC'TRK;                                                 <<01.DM>>09814000
   ARRAY INITIAL(*) = LOG'PACK'SIZE;                           <<01.DM>>09816000
   DOUBLE                                                      <<01.DM>>09818000
      RECORD,                                                  <<01.DM>>09820000
      TRACK,                                                   <<01.DM>>09822000
      NRTRKS;                                                  <<01.DM>>09824000
   INTEGER                                                     <<01.DM>>09826000
      LENGTH,                                                  <<01.DM>>09828000
      DRTUNIT1,                                                <<01.DM>>09830000
      DRTUNIT2,                                                <<01.DM>>09832000
      TYPE1,                                                   << JSC >>09834000
      TYPE2,                                                   << JSC >>09836000
      STYPE1,                                                  <<01.DM>>09838000
      STYPE2;                                                  <<01.DM>>09840000
                                                               <<01.DM>>09842000
   TYPE1 := LPDTYPE(LDEV1).DTYPEF;                             << JSC >>09844000
   TYPE2 := LPDTYPE(LDEV2).DTYPEF;                             << JSC >>09846000
   STYPE1 := LPDTYPE(LDEV1).STYPEF;                            <<SY.30>>09848000
   STYPE2 := LPDTYPE(LDEV2).STYPEF;                            <<SY.30>>09850000
   LOG'PACK'SIZE := GETDISCINFO(TYPE1,STYPE1,DEFLT'PACK'SIZE); << JSC >>09852000
   TRK'CYL := GETDISCINFO(TYPE1,STYPE1,TRACKS'CYL);            << JSC >>09854000
   SEC'TRK := GETDISCINFO(TYPE1,STYPE1,SECT'TRACK);            << JSC >>09856000
   NRTRKS := DOUBLE(LOG'PACK'SIZE) * DOUBLE(TRK'CYL);          <<01.DM>>09858000
   LENGTH := SEC'TRK * 128;                                    <<01.DM>>09860000
   DRTUNIT1 := LPDT (LDEV1);                                   <<SY.30>>09862000
   DRTUNIT2 := LPDT (LDEV2);                                   <<SY.30>>09864000
   MOVE PBUF:="FROM DISC:"; PRINT(PBUF,-10,CRLF);              <<03628>>09866000
   PRINTINFO(LDEV1,DRTUNIT1,STYPE1,0);                         <<03628>>09868000
   MOVE PBUF:="  ";PRINT(PBUF,-2,CRLF);                        <<03628>>09870000
   MOVE PBUF:="TO DISC:"; PRINT(PBUF,-8,CRLF);                 <<03628>>09872000
   PRINTINFO(LDEV2,DRTUNIT2,STYPE2,0);                         <<03628>>09874000
   MOVE PBUF:="  "; PRINT(PBUF,-2,CRLF);                       <<03628>>09876000
                                                               <<01.DM>>09878000
   TRACK := 0D;                                                <<01.DM>>09880000
   WHILE NRTRKS > TRACK DO                                     <<01.DM>>09882000
   BEGIN                                                       <<01.DM>>09884000
      TESTCONTROLYTRAP;                                        <<03628>>09886000
      IF INTEGER(TRACK) MOD 100 = 0 THEN                       <<03628>>09888000
         BEGIN                                                 <<03628>>09890000
           MOVE PBUF:="Copying TRACK       ";                  <<03628>>09892000
           ASCII(INTEGER(TRACK),PBUF(18),-10);                 <<03628>>09894000
           PRINT(PBUF,-20,CRLF);                               <<03628>>09896000
         END;                                                  <<03628>>09898000
      RECORD := TRACK * DOUBLE( SEC'TRK);                      <<01.DM>>09900000
      DISC( READD, LDEV1, DRTUNIT1, STYPE1, TRACKBUF, RECORD, LENGTH);  09902000
      DISC( WRITED, LDEV2, DRTUNIT2, STYPE2, TRACKBUF, RECORD, LENGTH); 09904000
      TRACK := TRACK+1D;                                       <<01.DM>>09906000
   END;                                                        <<01.DM>>09908000
END;                                                           <<01.DM>>09910000
$PAGE                                                          <<*GR1*>>09912000
PROCEDURE DCOPY2( LDEV1, LDEV2);                                        09914000
   VALUE LDEV1, LDEV2;                                                  09916000
   INTEGER LDEV1, LDEV2;                                                09918000
BEGIN                                                                   09920000
   INTEGER                                                              09922000
      LOG'PACK'SIZE1,                                                   09924000
      TRK'CYL1,                                                         09926000
      SEC'TRK1;                                                         09928000
   ARRAY INITIAL1(*) = LOG'PACK'SIZE1;                                  09930000
   INTEGER                                                              09932000
      LOG'PACK'SIZE2,                                                   09934000
      TRK'CYL2,                                                         09936000
      SEC'TRK2;                                                         09938000
   ARRAY INITIAL2(*) = LOG'PACK'SIZE2;                                  09940000
   DOUBLE                                                               09942000
      TRACK1,TRACK2,                                           <<03628>>09944000
      RECORD,                                                           09946000
      NRSEC,                                                            09948000
      NRSEC1,                                                           09950000
      NRSEC2,                                                           09952000
      REM'SEC;                                                          09954000
   INTEGER                                                              09956000
      DRTUNIT1,                                                         09958000
      DRTUNIT2,                                                         09960000
      TYPE1,                                                   << JSC >>09962000
      TYPE2,                                                   << JSC >>09964000
      STYPE1,                                                           09966000
      STYPE2;                                                           09968000
                                                                        09970000
   TYPE1 := LPDTYPE(LDEV1).DTYPEF;                             << JSC >>09972000
   TYPE2 := LPDTYPE(LDEV2).DTYPEF;                             << JSC >>09974000
   STYPE1 := LPDTYPE(LDEV1).STYPEF;                            <<SY.30>>09976000
   STYPE2 := LPDTYPE(LDEV2).STYPEF;                            <<SY.30>>09978000
   LOG'PACK'SIZE1 := GETDISCINFO(TYPE1,STYPE1,DEFLT'PACK'SIZE);<< JSC >>09980000
   TRK'CYL1 := GETDISCINFO(TYPE1,STYPE1,TRACKS'CYL);           << JSC >>09982000
   SEC'TRK1 := GETDISCINFO(TYPE1,STYPE1,SECT'TRACK);           << JSC >>09984000
   LOG'PACK'SIZE2 := GETDISCINFO(TYPE2,STYPE2,DEFLT'PACK'SIZE);<< JSC >>09986000
   TRK'CYL2 := GETDISCINFO(TYPE2,STYPE2,TRACKS'CYL);           << JSC >>09988000
   SEC'TRK2 := GETDISCINFO(TYPE2,STYPE2,SECT'TRACK);           << JSC >>09990000
   NRSEC1 := DOUBLE(LOG'PACK'SIZE1) * DOUBLE(TRK'CYL1*SEC'TRK1);        09992000
   NRSEC2 := DOUBLE(LOG'PACK'SIZE2) * DOUBLE(TRK'CYL2*SEC'TRK2);        09994000
   DRTUNIT1 := LPDT (LDEV1);                                   <<SY.30>>09996000
   DRTUNIT2 := LPDT (LDEV2);                                   <<SY.30>>09998000
   MOVE PBUF:="FROM DISC:"; PRINT(PBUF,-10,CRLF);              <<03628>>10000000
   PRINTINFO(LDEV1,DRTUNIT1,STYPE1,0);                         <<03628>>10002000
   MOVE PBUF:="  ";PRINT(PBUF,-2,CRLF);                        <<03628>>10004000
   MOVE PBUF:="TO DISC:"; PRINT(PBUF,-8,CRLF);                 <<03628>>10006000
   PRINTINFO(LDEV2,DRTUNIT2,STYPE2,0);                         <<03628>>10008000
   MOVE PBUF:="  "; PRINT(PBUF,-2,CRLF);                       <<03628>>10010000
                                                                        10012000
   NRSEC := NRSEC1;                                                     10014000
   IF NRSEC1 > NRSEC2 THEN                                              10016000
   BEGIN                                                                10018000
      MOVE LBUF := ("*WARNING* REMAINING SECTORS OF FROM DISC WILL",    10020000
           " NOT BE COPIED");                                           10022000
      PRINT( LBUF, -59, CRLF);                                          10024000
      NRSEC := NRSEC2;                                                  10026000
   END;                                                                 10028000
                                                                        10030000
   TOS := NRSEC;                                                        10032000
   TOS := DOUBLE( SECT'TRACK'MAX );                                     10034000
   ASSEMBLE( DDIV );                                                    10036000
   REM'SEC := TOS;                                                      10038000
   NRSEC := TOS * DOUBLE(SECT'TRACK'MAX);                               10040000
                                                                        10042000
   RECORD := 0D;                                                        10044000
   WHILE NRSEC > RECORD DO                                              10046000
   BEGIN                                                                10048000
      TRACK1:=RECORD/DOUBLE(SEC'TRK1);                         <<03628>>10050000
      TRACK2:=RECORD/DOUBLE(SEC'TRK2);                         <<03628>>10052000
      TESTCONTROLYTRAP;                                        <<03628>>10054000
      IF INTEGER(TRACK1) MOD 100 = 0 THEN                      <<03628>>10056000
         BEGIN                                                 <<03628>>10058000
           MOVE PBUF:="Copying TRACK       TO TRACK       ";   <<03628>>10060000
           ASCII(INTEGER(TRACK1),PBUF(18),-10);                <<03628>>10062000
           ASCII(INTEGER(TRACK2),PBUF(34),-10);                <<03628>>10064000
           PRINT(PBUF,-35,CRLF);                               <<03628>>10066000
         END;                                                  <<03628>>10068000
      DISC( READD, LDEV1, DRTUNIT1, STYPE1, TRACKBUF, RECORD,           10070000
            TRACKLEN);                                                  10072000
      DISC( WRITED, LDEV2, DRTUNIT2, STYPE2, TRACKBUF, RECORD,          10074000
            TRACKLEN);                                                  10076000
      RECORD := RECORD + DOUBLE(SECT'TRACK'MAX);                        10078000
   END;                                                                 10080000
                                                                        10082000
   DISC( READD, LDEV1, DRTUNIT1, STYPE1, TRACKBUF, RECORD,              10084000
         INTEGER(REM'SEC)*128);                                         10086000
   DISC( WRITED, LDEV2, DRTUNIT2, STYPE2, TRACKBUF, RECORD,             10088000
         INTEGER(REM'SEC)*128);                                         10090000
END;                                                                    10092000
$PAGE                                                          <<*GR1*>>10094000
PROCEDURE COPY;                                                <<01.DM>>10096000
BEGIN                                                          <<01.DM>>10098000
   INTEGER                                                     <<01.DM>>10100000
      DTYPE1,                                                  << JSC >>10102000
      DTYPE2,                                                  << JSC >>10104000
      STYPE1,                                                  <<01.DM>>10106000
      STYPE2,                                                  <<01.DM>>10108000
      DRTUNIT1,                                                <<01.DM>>10110000
      DRTUNIT2,                                                <<01.DM>>10112000
      LDEV1,                                                   <<01.DM>>10114000
      LDEV2,                                                   <<01.DM>>10116000
      I;                                                       <<01.DM>>10118000
   INTEGER ARRAY                                               <<01.DM>>10120000
      DTT(0:127);                                              <<01.DM>>10122000
   LOGICAL                                                     <<01.DM>>10124000
      FROM'VER,                                                <<01.DM>>10126000
      TO'VER,                                                  <<01.DM>>10128000
      WARNED := FALSE;                                         <<01.DM>>10130000
   DEFINE STYPE     = INTEGER( LPDTYPE( LDEV).STYPEF)#;        <<*GR1*>>10132000
                                                               <<01.DM>>10134000
$PAGE                                                          <<*GR1*>>10136000
   SUBROUTINE WARN( NUM, PARM);                                <<01.DM>>10138000
      VALUE NUM, PARM;                                         <<01.DM>>10140000
      INTEGER NUM, PARM;                                       <<01.DM>>10142000
   BEGIN                                                       <<01.DM>>10144000
      WARNED := TRUE;                                          <<01.DM>>10146000
      CASE NUM OF                                              <<01.DM>>10148000
      BEGIN                                                    <<01.DM>>10150000
         BEGIN                                                 <<01.DM>>10152000
            MOVE PBUF := "*WARNING* LDEV #",2;                          10154000
            TOS := TOS+ASCII( NUM, BPS0); <<CONVERT PARM>>              10156000
            MOVE * := (" CONFIGURED SUBTYPE DOES NOT AGREE ",           10158000
                       "WITH VOLUME TABLE"),2;                          10160000
            I := TOS-@PBUF;                                             10162000
            PRINT( PBUF, -I, CRLF);                                     10164000
         END;                                                  <<01.DM>>10166000
         BEGIN                                                 <<01.DM>>10168000
            MOVE PBUF := "*WARNING* LDEV #",2;                 <<01.DM>>10170000
            TOS := TOS+ASCII( NUM, BPS0); <<CONVERT PARM>>     <<01.DM>>10172000
            MOVE * := " NOT INITIALIZED  ",2;                  <<01.DM>>10174000
            I := TOS-@PBUF;                                    <<01.DM>>10176000
            PRINT( PBUF, -I, CRLF);                            <<01.DM>>10178000
         END;                                                  <<01.DM>>10180000
         BEGIN                                                 <<01.DM>>10182000
            MOVE PBUF := "*ERROR* LDEV #",2;                   <<01.DM>>10184000
            TOS := TOS+ASCII( NUM, BPS0);  <<CONVERT PARM>>    <<01.DM>>10186000
            MOVE * := " HAS DELETED TRACKS",2;                 <<01.DM>>10188000
            I := TOS-@PBUF;                                    <<01.DM>>10190000
            PRINT( PBUF, -I, CRLF);                            <<01.DM>>10192000
         END;                                                  <<01.DM>>10194000
      END;                                                     <<01.DM>>10196000
   END;                                                        <<01.DM>>10198000
$PAGE                                                          <<*GR1*>>10200000
                                                               <<01.DM>>10202000
   LOGICAL SUBROUTINE CHECK'TYPE'STYPE(LDEV);                  <<*GR1*>>10204000
      VALUE LDEV;                                              <<01.DM>>10206000
      INTEGER LDEV;                                            <<01.DM>>10208000
   BEGIN                                                       <<01.DM>>10210000
      IF LPDTYPE(LDEV).DTYPEF<> MHDISCTYPE AND                 <<*GR1*>>10212000
         LPDTYPE(LDEV).DTYPEF<> CS'80'TYPE AND                 <<*GR1*>>10214000
         LPDTYPE(LDEV).DTYPEF<> 2          THEN                <<*GR1*>>10216000
         CHECK'TYPE'STYPE := TRUE;                             <<*GR1*>>10218000
      IF NOT( 0 <= STYPE <= 12 ) THEN                          <<01.DM>>10220000
         CHECK'TYPE'STYPE := TRUE;                             <<*GR1*>>10222000
   END;                                                        <<01.DM>>10224000
                                                               <<01.DM>>10226000
$PAGE                                                          <<*GR1*>>10228000
   SUBROUTINE MOUNT( LDEV);                                    <<01.DM>>10230000
      VALUE LDEV;                                              <<01.DM>>10232000
      INTEGER LDEV;                                            <<01.DM>>10234000
   BEGIN                                                       <<01.DM>>10236000
      MOVE PBUF := "MOUNT SCRATCH PACK ON LDEV #     ";        <<01.DM>>10238000
      ASCII( LDEV, PBUF(28), -10);                             <<01.DM>>10240000
      PRINT( PBUF, -33, CRLF);                                 <<01.DM>>10242000
      MOVE PBUF := "PRESS (CR) WHEN MOUNTED";                  <<01.DM>>10244000
      PRINT( PBUF, -23, NOCRLF);                               <<01.DM>>10246000
      READ( PBUF, -72);                                        <<01.DM>>10248000
   END;                                                        <<01.DM>>10250000
                                                               <<01.DM>>10252000
   LOGICAL SUBROUTINE DEL'TRACKS;                              <<01.DM>>10254000
   BEGIN                                                       <<01.DM>>10256000
      FOR I := 1 UNTIL XDTT DO                                 <<01.DM>>10258000
         IF XDTT(I).(14:2) = 2 THEN DEL'TRACKS := TRUE;        <<01.DM>>10260000
   END;                                                        <<01.DM>>10262000
                                                               <<01.DM>>10264000
   LOGICAL SUBROUTINE VER'VOL( LDEV, DRTUNIT, SUBTYPE);        <<01.DM>>10266000
      VALUE LDEV, DRTUNIT, SUBTYPE;                            <<01.DM>>10268000
      INTEGER LDEV, DRTUNIT, SUBTYPE;                          <<01.DM>>10270000
   BEGIN                                                       <<01.DM>>10272000
      IF VERIFIED( LDEV, DRTUNIT, SUBTYPE, TRUE) THEN          <<01.DM>>10274000
         VER'VOL := TRUE                                       <<01.DM>>10276000
    ELSE                                                       <<01.DM>>10278000
      IF BQBUF( LABSYSID) = "3000" AND                         <<03628>>10280000
         (LABDISCTYPE = MHDISCTYPE OR LABDISCTYPE = CS'80'TYPE)<<03628>>10282000
      THEN BEGIN                                               <<03628>>10284000
         WARN(0,LDEV);                                         <<01.DM>>10286000
         VER'VOL := TRUE;                                      <<01.DM>>10288000
      END                                                      <<01.DM>>10290000
    ELSE                                                       <<01.DM>>10292000
      WARN(1,LDEV);                                            <<01.DM>>10294000
$PAGE                                                          <<*GR1*>>10296000
   END;                                                        <<01.DM>>10298000
                                                               <<01.DM>>10300000
   DO LDEV1 := GETVAL( 57, 1, LDEVMAX, 1) UNTIL                <<01.DM>>10302000
      NOT CHECK'TYPE'STYPE( LDEV1);                            <<*GR1*>>10304000
                                                               <<01.DM>>10306000
   DO LDEV2 := GETVAL( 58, 1, LDEVMAX, 1) UNTIL                <<01.DM>>10308000
      NOT CHECK'TYPE'STYPE( LDEV2);                            <<*GR1*>>10310000
                                                               <<01.DM>>10312000
   DTYPE1 := LPDTYPE( LDEV1 ).DTYPEF;                          << JSC >>10314000
   DTYPE2 := LPDTYPE( LDEV2 ).DTYPEF;                          << JSC >>10316000
   STYPE1 := LPDTYPE(LDEV1).STYPEF;                            <<SY.30>>10318000
   STYPE2 := LPDTYPE(LDEV2).STYPEF;                            <<SY.30>>10320000
   DRTUNIT1 := LPDT (LDEV1);                                   <<SY.30>>10322000
   DRTUNIT2 := LPDT (LDEV2);                                   <<SY.30>>10324000
                                                               <<01.DM>>10326000
   FROM'VER := VER'VOL( LDEV1, DRTUNIT1, STYPE1);              <<01.DM>>10328000
   IF FROM'VER THEN                                            <<01.DM>>10330000
      IF DEL'TRACKS AND DTYPE1 <> CS'80'TYPE  THEN             <<03628>>10332000
      BEGIN                                                    <<01.DM>>10334000
         WARN(2,LDEV1);                                        <<01.DM>>10336000
      END;                                                     <<01.DM>>10340000
   MOVE DTT := XDTT,(128);                                     <<01.DM>>10342000
                                                               <<01.DM>>10344000
   TO'VER := VER'VOL( LDEV2, DRTUNIT2, STYPE2);                <<01.DM>>10346000
   IF TO'VER THEN                                              <<01.DM>>10348000
   BEGIN                                                       <<01.DM>>10350000
      IF DEL'TRACKS AND DTYPE2 <> CS'80'TYPE THEN              <<03628>>10352000
      BEGIN                                                    <<01.DM>>10354000
         WARN(2,LDEV2);                                        <<01.DM>>10356000
      END;                                                     <<01.DM>>10360000
      MOVE DTT := XDTT,(128);                                  <<01.DM>>10362000
   END                                                         <<01.DM>>10364000
 ELSE                                                          <<01.DM>>10366000
   BEGIN                                                       <<01.DM>>10368000
      DTT := 0;                                                <<01.DM>>10370000
      MOVE DTT(1) := DTT,(125);                                <<01.DM>>10372000
   END;                                                        <<01.DM>>10374000
                                                               <<01.DM>>10376000
   IF WARNED THEN GETYESNO( @EXIT, 59); << CONTINUE? >>        <<01.DM>>10378000
                                                               <<01.DM>>10380000
                                                               <<01.DM>>10382000
$PAGE                                                          <<*GR1*>>10384000
<< The 7906 disc is handled differently than all others.  The>><< JSC >>10386000
<< following check makes sure that neither disc is a 7906; if>><< JSC >>10388000
<< either is a 7906, the situation is handled later.         >><< JSC >>10390000
   IF NOT (    ( DTYPE1 = MHDISCTYPE LAND (10<=STYPE1<=12) )   << JSC >>10392000
           LOR ( DTYPE2 = MHDISCTYPE LAND (10<=STYPE2<=12) ) ) << JSC >>10394000
   THEN                                                        << JSC >>10396000
   BEGIN                                                       <<01.DM>>10398000
      IF DRTUNIT1 = DRTUNIT2 THEN                              <<01.DM>>10400000
      BEGIN                                                    <<01.DM>>10402000
         SMESSAGE( 60); << INVALID COPY OPERATION >>           <<06057>>10404000
         RETURN;                                               <<01.DM>>10406000
      END;                                                     <<01.DM>>10408000
                                                               <<01.DM>>10410000
      IF DTYPE1<>DTYPE2  LOR STYPE1<>STYPE2  THEN              << JSC >>10412000
      BEGIN                                                    <<01.DM>>10414000
         MOUNT( LDEV2);                                                 10416000
         DCOPY2(LDEV1,LDEV2);<<COPIES DISCS OF DIFFERENT TYPE>><<01.DM>>10418000
         RETURN;                                               <<01.DM>>10420000
      END;                                                     <<01.DM>>10422000
                                                               <<01.DM>>10424000
      MOUNT( LDEV2);                                           <<01.DM>>10426000
      DCOPY( LDEV1, LDEV2);                                    <<01.DM>>10428000
   END                                                         <<01.DM>>10430000
 ELSE                                                          <<01.DM>>10432000
   BEGIN                                                       <<01.DM>>10434000
      IF DRTUNIT1 = DRTUNIT2 THEN                              <<01.DM>>10436000
         IF STYPE1 = STYPE2 OR STYPE1 = 12 OR STYPE2 = 12 THEN <<01.DM>>10438000
         BEGIN                                                 <<01.DM>>10440000
            SMESSAGE( 60); << INVALID DCOPY OPERATION >>       <<06057>>10442000
            RETURN;                                            <<06057>>10444000
         END;                                                  <<01.DM>>10446000
                                                               <<01.DM>>10448000
      IF STYPE1 = 11 THEN  << FIXED TO REMOVABLE >>            <<01.DM>>10450000
      BEGIN                                                    <<01.DM>>10452000
         MOUNT( LDEV2);                                        <<01.DM>>10454000
         DCOPY( LDEV1, LDEV2);                                 <<01.DM>>10456000
      END                                                      <<01.DM>>10458000
    ELSE                                                       <<01.DM>>10460000
      BEGIN           << REMOVABLE TO FIXED >>                 <<01.DM>>10462000
         DCOPY( LDEV1, LDEV2);                                 <<01.DM>>10464000
      END;                                                     <<01.DM>>10466000
   END;                                                        <<01.DM>>10468000
                                                               <<01.DM>>10470000
   IF FROM'VER THEN  << WRITE DEFECTIVE TRACK TABLE BACK >>    <<01.DM>>10472000
      DISC( WRITED, LDEV2, DRTUNIT2, STYPE2, DTT, 1D, 128);    <<01.DM>>10474000
EXIT:                                                          <<01.DM>>10476000
END;                                                           <<01.DM>>10478000
                                                               <<01.DM>>10480000
$PAGE                                                          <<*GR1*>>10482000
PROCEDURE STOP;                                                <<01.DM>>10484000
BEGIN                                                                   10486000
     MOVE PBUF:="END OF PROGRAM.";                                      10488000
      PRINT(PBUF,-15,CRLF);                                    <<01.DM>>10490000
$IF X1=OFF                                                     <<*GR1*>>10492000
     FMGR(0);     << RETURN CONTROL TO FILE MANAGER >>         <<06057>>10494000
$IF X1=ON                                                      <<*GR1*>>10496000
    HARDHALT;                                                  <<*GR1*>>10498000
$IF                                                            <<*GR1*>>10500000
END << STOP >>;                                                         10502000
                                                                        10504000
                                                               <<*GR1*>>10506000
$PAGE                                                          <<*GR1*>>10508000
<<********************************************************>>   <<*GR1*>>10510000
                                                               <<*GR1*>>10512000
PROCEDURE FIND; << SCAN A VOLUME FOR ANY VALID FILE LABELS >>  <<*GR1*>>10514000
BEGIN                                                          <<*GR1*>>10516000
    LOGICAL POINTER FLAB;                                      <<*GR1*>>10518000
    INTEGER POINTER IFLAB;                                     <<*GR1*>>10520000
    BYTE POINTER FLABB,BUF;                                    <<06057>>10522000
    BYTE ARRAY                                                 <<06057>>10522100
        NAMES(0:23),                                           <<06057>>10522200
        FNAME(*)     = NAMES(0),                               <<06057>>10522300
        GNAME(*)     = NAMES(8),                               <<06057>>10522400
        ANAME(*)     = NAMES(16);                              <<06057>>10522500
    INTEGER LDEV,DRTUNIT,STYPE,I,WC,NUMTRK,SECTRK,TRACK,DATE,  <<*GR1*>>10524000
            TYPE;                                              <<*GR1*>>10526000
    LOGICAL SAVE'FILES:=FALSE,TAPECHECKED:=FALSE;              <<*GR1*>>10528000
    BYTE ARRAY COMMAND(0:3);                                   <<*GR1*>>10530000
    DOUBLE DISKADDR;                                           <<*GR1*>>10532000
                                                               <<*GR1*>>10536000
    EQUATE  FCB'VECTOR  =  27, <<File control block vector  >> <<*GR1*>>10538000
            LOCK        =  28, <<Lock bits                  >> <<*GR1*>>10540000
            CRDATE      =  23, <<Creation date              >> <<*GR1*>>10542000
            MODDATE     =  25; <<Last modification date     >> <<*GR1*>>10544000
    DEFINE  YEARF    = (0:7)#, <<Year field of creation date>> <<*GR1*>>10546000
            RWF      =(14:2)#; <<Read Write field of LOCK   >> <<*GR1*>>10548000
                                                               <<*GR1*>>10550000
                                                               <<*GR1*>>10552000
    <<******************************************************>> <<*GR1*>>10554000
    << Check the file label. If the creation date is between>> <<*GR1*>>10556000
    << 1970 and 1990 and the modify date is good and the    >> <<*GR1*>>10558000
    << file name,group and account are alphabetic and, most >> <<*GR1*>>10560000
    << importantly, the CHECKSUM is good, it is probobly a  >> <<*GR1*>>10562000
    << good file label.                                     >> <<*GR1*>>10564000
    <<******************************************************>> <<*GR1*>>10566000
                                                               <<*GR1*>>10568000
    LOGICAL SUBROUTINE GOOD'FILE'LABEL;                        <<*GR1*>>10570000
      BEGIN                                                    <<*GR1*>>10572000
        IF 70<=IFLAB(CRDATE).YEARF<=90 AND                     <<*GR1*>>10574000
           FLAB(MODDATE) >= LOGICAL(DATE) AND                  <<*GR1*>>10576000
           FLABB >= "A" AND FLABB <= "Z"  AND                  <<*GR1*>>10578000
           CHECKSUM(FLAB) = IFLAB(FLCHECKSUMX)                 <<*GR1*>>10580000
           THEN GOOD'FILE'LABEL:=TRUE;                         <<*GR1*>>10582000
       END;                                                    <<*GR1*>>10584000
                                                               <<*GR1*>>10586000
    <<******************************************************>> <<06057>>10587000
    << If the file has been purged, then the FCB vector is  >> <<*GR1*>>10588000
    << not zero, than the file is eihter purged, or it was  >> <<*GR1*>>10590000
    << left open when the system went down.  In either case,>> <<*GR1*>>10592000
    << we put a '?????' at the end of the file information  >> <<*GR1*>>10594000
    << and don't save the file if the user requested.       >> <<*GR1*>>10596000
    <<******************************************************>> <<*GR1*>>10598000
                                                               <<*GR1*>>10600000
    LOGICAL SUBROUTINE PURGED'FILE;                            <<*GR1*>>10602000
      BEGIN                                                    <<*GR1*>>10604000
        IF FLAB(FCB'VECTOR)<>0                                 <<*GR1*>>10606000
           THEN PURGED'FILE:=TRUE;                             <<*GR1*>>10608000
      END;                                                     <<*GR1*>>10610000
$PAGE                                                          <<*GR1*>>10612000
   <<*******************************************************>> <<*GR1*>>10614000
   << This routine will do with the file what the user      >> <<*GR1*>>10616000
   << requested.  That is, if the file has not been purged, >> <<*GR1*>>10618000
   << it will save it via COPYTOTAPE if the user requested  >> <<*GR1*>>10620000
   << the files to be saved.  Otherwise, it will simply     >> <<*GR1*>>10622000
   << print out the file information.  A '?????' at the end >> <<*GR1*>>10624000
   << of the file information means the file has probobly   >> <<*GR1*>>10626000
   << been purged.                                          >> <<*GR1*>>10628000
   <<*******************************************************>> <<*GR1*>>10630000
                                                               <<*GR1*>>10632000
   SUBROUTINE PRINT'OR'SAVE'FILE;                              <<*GR1*>>10634000
     BEGIN                                                     <<*GR1*>>10636000
                                                               <<*GR1*>>10638000
       MOVE COMMAND:="FIND";                                   <<*GR1*>>10640000
                                                               <<*GR1*>>10642000
                                                               <<*GR1*>>10644000
                                                               <<*GR1*>>10646000
       IF PURGED'FILE THEN                                     <<*GR1*>>10648000
          BEGIN                                                <<*GR1*>>10650000
            MOVE PBUF(74):= " ?????";                          <<*GR1*>>10652000
            OUTPUT(PBUFW,80);                                  <<*GR1*>>10654000
            MOVE LBUF(0):=" ";MOVE LBUF(1):=LBUF(0),(80);      <<*GR1*>>10656000
            MOVE LBUF(5):=PBUF(0),(26);                        <<*GR1*>>10658000
            MOVE LBUF(32):=" was either PURGED or left open";  <<*GR1*>>10660000
            OUTPUT(LBUFW,63);                                  <<*GR1*>>10662000
          END                                                  <<*GR1*>>10664000
       ELSE                                                    <<*GR1*>>10666000
          IF NOT SAVE'FILES                                    <<*GR1*>>10668000
             THEN OUTPUT(PBUFW,72)                             <<*GR1*>>10670000
             ELSE COPYTOTAPE(FLAB,COMMAND,TAPECHECKED);        <<*GR1*>>10672000
                                                               <<*GR1*>>10674000
    END;                                                       <<*GR1*>>10676000
$PAGE                                                          <<*GR1*>>10678000
                                                               <<*GR1*>>10680000
<<**********************************************************>> <<*GR1*>>10682000
<< This routine prints the header directions and asks the   >> <<*GR1*>>10684000
<< user if he wants to save the files that are found on the >> <<*GR1*>>10686000
<< disk.                                                    >> <<*GR1*>>10688000
<<**********************************************************>> <<*GR1*>>10690000
                                                               <<*GR1*>>10692000
SUBROUTINE PRINT'COMMENTS;                                     <<*GR1*>>10694000
BEGIN                                                          <<*GR1*>>10696000
                                                               <<*GR1*>>10698000
MOVE PBUF:="FIND scans for file labels";                       <<*GR1*>>10700000
PRINT(PBUF,-26,CRLF);                                          <<*GR1*>>10702000
MOVE PBUF:="There is no guarantee that the";                   <<*GR1*>>10704000
MOVE PBUF(30):=" labels or files are intact";                  <<*GR1*>>10706000
PRINT(PBUF,-57,CRLF);                                          <<*GR1*>>10708000
                                                               <<*GR1*>>10710000
MOVE PBUF:="If the files are requested to be";                 <<*GR1*>>10712000
MOVE PBUF(32):=" saved many may be bad or alread purged";      <<*GR1*>>10714000
PRINT(PBUF,-71,CRLF);                                          <<*GR1*>>10716000
                                                               <<*GR1*>>10718000
MOVE PBUF:="IF the file info ends with '?????', then";         <<*GR1*>>10720000
MOVE PBUF(40):=" the file is either already purged";           <<*GR1*>>10722000
PRINT (PBUF,-74,CRLF);                                         <<*GR1*>>10724000
MOVE PBUF:="     or it was left open when the";                <<*GR1*>>10726000
MOVE PBUF(33):=" system failed";                               <<*GR1*>>10728000
PRINT(PBUF,-47,CRLF);                                          <<*GR1*>>10730000
                                                               <<*GR1*>>10732000
MOVE PBUF:="Files listed with '?????' will not be saved";      <<*GR1*>>10734000
PRINT(PBUF,-43,CRLF);                                          <<*GR1*>>10736000
                                                               <<*GR1*>>10738000
MOVE PBUF:="   an attempt can be made to save";                <<*GR1*>>10740000
MOVE PBUF(33):=" via SAVE by LDEV# and sector address";        <<*GR1*>>10742000
PRINT(PBUF,-70,CRLF);                                          <<*GR1*>>10744000
                                                               <<*GR1*>>10746000
MOVE PBUF:="  ";PRINT(PBUF,-2,CRLF);                           <<*GR1*>>10748000
                                                               <<*GR1*>>10750000
RLEN:=0;                                                       <<*GR1*>>10752000
WHILE RLEN=0 DO                                                <<*GR1*>>10754000
  BEGIN <<Get a valid response to the question              >> <<*GR1*>>10756000
    MOVE PBUF:="Do you wish files found to be saved? ";        <<*GR1*>>10758000
    PRINT(PBUF,-37,NOCRLF);                                    <<*GR1*>>10760000
    RLEN:=READ(RBUFW,-3);                                      <<*GR1*>>10762000
    IF RBUF="Y" THEN                                           <<*GR1*>>10764000
       BEGIN                                                   <<*GR1*>>10766000
         SAVE'FILES:=TRUE; <<We are indeed to save the files>> <<*GR1*>>10768000
         NO'FILES'REEL:=0; <<Start with for files on reel   >> <<*GR1*>>10770000
         BUILDVOLUMETABLE; <<Build our in core volume table >> <<*GR1*>>10772000
         IF <> THEN                                            <<*GR1*>>10774000
            BEGIN  <<Something went wrong building the table>> <<*GR1*>>10776000
              MOVE PBUF:="Volume table incomplete, will ";     <<03628>>10778000
              MOVE PBUF(30):="save all files possible";        <<03628>>10780000
              PRINT(PBUF,-53,CRLF);                            <<03628>>10782000
            END;                                               <<*GR1*>>10784000
       END                                                     <<*GR1*>>10786000
                                                               <<*GR1*>>10788000
    ELSE                                                       <<*GR1*>>10790000
      IF RBUF <> "N" THEN                                      <<*GR1*>>10792000
         BEGIN                                                 <<*GR1*>>10794000
           SMESSAGE(0);                                        <<06057>>10796000
           RLEN:=0;                                            <<*GR1*>>10798000
         END;                                                  <<*GR1*>>10800000
                                                               <<*GR1*>>10802000
  END;                                                         <<*GR1*>>10804000
                                                               <<*GR1*>>10806000
END;                                                           <<*GR1*>>10808000
                                                               <<06057>>10808010
                                                               <<06057>>10808020
LOGICAL SUBROUTINE WANT'FILE;                                  <<06057>>10808030
BEGIN                                                          <<06057>>10808040
                                                               <<06057>>10808050
<< Determine if the current file is wanted.                 >> <<06057>>10808060
                                                               <<06057>>10808070
WANT'FILE := FALSE;                                            <<06057>>10808080
IF (FNAME = "@" OR                                             <<06057>>10808090
    FNAME = FLABB(0),(8)) AND                                  <<06057>>10808100
   (GNAME = "@" OR                                             <<06057>>10808110
    GNAME = FLABB(8),(8)) AND                                  <<06057>>10808120
   (ANAME = "@" OR                                             <<06057>>10808130
    ANAME = FLABB(16),(8))                                     <<06057>>10808140
      THEN WANT'FILE := TRUE;                                  <<06057>>10808150
END;                                                           <<06057>>10808160
$PAGE                                                          <<*GR1*>>10810000
                                                               <<*GR1*>>10812000
    << *****************************************************>> <<*GR1*>>10816000
    << Print the header comments.                           >> <<*GR1*>>10818000
    <<******************************************************>> <<*GR1*>>10820000
                                                               <<*GR1*>>10822000
    PRINT'COMMENTS;                                            <<*GR1*>>10824000
                                                               <<*GR1*>>10826000
    <<******************************************************>> <<*GR1*>>10828000
    << Ask user for the LDEV number of the volume to scan   >> <<*GR1*>>10830000
    <<******************************************************>> <<*GR1*>>10832000
                                                               <<*GR1*>>10834000
    LDEV:=0;                                                   <<*GR1*>>10836000
    WHILE LDEV=0 DO                                            <<*GR1*>>10838000
      BEGIN                                                    <<*GR1*>>10840000
        MOVE PBUF:="Enter LDEV number to scan: ";              <<*GR1*>>10842000
        PRINT(PBUFW,-27,NOCRLF);                               <<*GR1*>>10844000
        RLEN:=READ(RBUFW,-2);                                  <<*GR1*>>10846000
        LDEV:=BINARY(RBUF,RLEN);                               <<*GR1*>>10848000
        IF <> OR (LDEV < SYSLDEV) OR (LDEV>LDEVMAX)            <<*GR1*>>10850000
              OR LPDT(LDEV) = 0 THEN                           <<*GR1*>>10852000
           BEGIN                                               <<*GR1*>>10854000
             SMESSAGE(0);                                      <<06057>>10856000
             LDEV:=0;                                          <<*GR1*>>10858000
           END;                                                <<*GR1*>>10860000
       END;                                                    <<*GR1*>>10862000
                                                               <<*GR1*>>10864000
    <<******************************************************>> <<*GR1*>>10866000
    << Store device information                             >> <<*GR1*>>10868000
    <<******************************************************>> <<*GR1*>>10870000
                                                               <<*GR1*>>10872000
    DRTUNIT:=LPDT(LDEV);                                       <<*GR1*>>10874000
    STYPE:=LPDTYPE(LDEV).STYPEF;                               <<*GR1*>>10876000
    TYPE:=LPDTYPE(LDEV).DTYPEF;                                <<*GR1*>>10878000
                                                               <<*GR1*>>10880000
    << Determine file set to "FIND".                        >> <<06057>>10882000
                                                               <<06057>>10884000
    DO BEGIN                                                   <<06057>>10886000
       MOVE PBUF := "Enter file set to find: ",2;              <<06057>>10888000
       I := TOS - @PBUF;PRINT(PBUF,-I,NOCRLF);                 <<06057>>10890000
       RLEN := READ(RBUF,-30);                                 <<06057>>10892000
       RBUF(RLEN) := CR;                                       <<06057>>10894000
       IF RLEN = 0 THEN RETURN;   << He don't want nothing! >> <<06057>>10896000
       @BUF := @RBUF;                                          <<06057>>10898000
       WHILE BUF(0) = " " DO @BUF := @BUF + 1;                 <<06057>>10900000
       NAMES := " ";MOVE NAMES(1) := NAMES,(23);               <<06057>>10902000
       END                                                     <<06057>>10904000
    UNTIL GET'FILE'SET(BUF,FNAME,GNAME,ANAME);                 <<06057>>10906000
                                                               <<06057>>10908000
    <<******************************************************>> <<06057>>10909000
    << Ask for the last modify date, no files will by saved >> <<06057>>10910000
    << or listed with DATE < Last modify date.              >> <<06057>>10911000
    <<******************************************************>> <<06057>>10912000
                                                               <<06057>>10913000
    DATE := GET'DATE;                                          <<06057>>10914000
                                                               <<*GR1*>>10916000
    <<******************************************************>> <<*GR1*>>10918000
    << Tell the user some importand information. What LDEV, >> <<*GR1*>>10920000
    << modified since date, and how to break out of FIND    >> <<*GR1*>>10922000
    <<******************************************************>> <<*GR1*>>10924000
                                                               <<*GR1*>>10926000
    MOVE PBUF:="SCANNING LDEV    FOR FILE LABELS ";            <<*GR1*>>10928000
    ASCII(LDEV,PBUF(14),10);                                   <<*GR1*>>10930000
    OUTPUT(PBUFW,33);                                          <<*GR1*>>10932000
    IF OUTPUTMODE=PRINTER THEN PRINT(PBUFW,-33,0);             <<*GR1*>>10934000
    IF DATE <> 0 THEN                                          <<*GR1*>>10936000
      BEGIN                                                    <<*GR1*>>10938000
      MOVE PBUF:=" MODIFIED SINCE          ";                  <<*GR1*>>10940000
      DATECONV(PBUF(16),DATE,1);                               <<*GR1*>>10942000
      OUTPUT(PBUFW,25);                                        <<*GR1*>>10944000
      END;                                                     <<*GR1*>>10946000
                                                               <<*GR1*>>10948000
    MOVE PBUF:="  ";PRINT(PBUF,-2,CRLF);                       <<*GR1*>>10950000
    MOVE PBUF:="Hit CONTROL A or Y or BREAK to stop 'FIND'";   <<*GR1*>>10952000
    PRINT(PBUF,-42,CRLF);                                      <<*GR1*>>10954000
    MOVE PBUF:="  ";PRINT(PBUF,-2,CRLF);                       <<*GR1*>>10956000
                                                               <<*GR1*>>10958000
$IF X1=ON <<FOR SERIES II/III, CHECK TAPE FOR ON LINE       >> <<*GR1*>>10960000
                                                               <<*GR1*>>10962000
       IF SAVE'FILES AND  NOT TAPECHECKED AND  NOTHP7976 THEN  <<*GR1*>>10964000
          BEGIN                                                <<*GR1*>>10966000
            MOVE PBUF:="Place serial device on line and ";     <<*GR1*>>10968000
            MOVE PBUF(32):="prepare it for write";             <<*GR1*>>10970000
            PRINT(PBUF,-52,CRLF);                              <<*GR1*>>10972000
            TAPE'READY'CHECK;                                  <<*GR1*>>10974000
          END;                                                 <<*GR1*>>10976000
$IF <<END OF SERIES III ONLY>>                                 <<*GR1*>>10978000
       TAPECHECKED:=TRUE; <<Tape is ready to write!         >> <<*GR1*>>10980000
$PAGE                                                          <<*GR1*>>10982000
    IF TYPE <> FHDISCTYPE THEN                                 <<*GR1*>>10984000
                                                               <<*GR1*>>10986000
    <<******************************************************>> <<*GR1*>>10988000
    << Obtain disk information for searching through disk.  >> <<*GR1*>>10990000
    << Need sectors/track and number of tracks.  This is    >> <<*GR1*>>10992000
    << obtained from the procedure/array MHINFO by subtype  >> <<*GR1*>>10994000
    <<******************************************************>> <<*GR1*>>10996000
                                                               <<*GR1*>>10998000
      BEGIN << MOVING HEAD DISC >>                             <<*GR1*>>11000000
      SECTRK:=GETDISCINFO(TYPE,STYPE,SECT'TRACK);              <<*GR1*>>11002000
      WC:=SECTRK*128;                                          <<*GR1*>>11004000
      NUMTRK:=GETDISCINFO(TYPE,STYPE,DEFLT'PACK'SIZE) *        <<*GR1*>>11006000
               GETDISCINFO(TYPE,STYPE,TRACKS'CYL);             <<*GR1*>>11008000
      END                                                      <<*GR1*>>11010000
    ELSE                                                       <<*GR1*>>11012000
      BEGIN << FIXED HEAD DISC >>                              <<*GR1*>>11014000
      SECTRK:=32;                                              <<*GR1*>>11016000
      WC:=SECTRK*128;                                          <<*GR1*>>11018000
      NUMTRK:=FHINFO(STYPE);                                   <<*GR1*>>11020000
      END;                                                     <<*GR1*>>11022000
    MOVE PBUF:="SECTORS/TRACK=          ";                     <<*GR1*>>11024000
                                                               <<*GR1*>>11026000
    <<******************************************************>> <<*GR1*>>11028000
    << Inform the user of the above information and print   >> <<*GR1*>>11030000
    << header.                                              >> <<*GR1*>>11032000
    <<******************************************************>> <<*GR1*>>11034000
                                                               <<*GR1*>>11036000
    ASCII(SECTRK,PBUF(15),10);                                 <<*GR1*>>11038000
    PRINT(PBUFW,-22,CRLF);                                     <<*GR1*>>11040000
    MOVE PBUF:=" TOTAL TRACKS=          ";                     <<*GR1*>>11042000
    ASCII(NUMTRK,PBUF(15),10);                                 <<*GR1*>>11044000
    PRINT(PBUFW,-22,CRLF);                                     <<*GR1*>>11046000
    PRINTINFO(LDEV,DRTUNIT,STYPE,0);                           <<*GR1*>>11048000
    PBUF:=" "; MOVE PBUF(1):=PBUF,(79);                        <<*GR1*>>11050000
    MOVE PBUF:=" FILE NAME";                                   <<*GR1*>>11052000
    MOVE PBUF(28):="CREATED";                                  <<*GR1*>>11054000
    MOVE PBUF(38):="MODIFIED";                                 <<*GR1*>>11056000
    MOVE PBUF(48):="ACCESSED";                                 <<*GR1*>>11058000
    MOVE PBUF(61):="SECTOR";                                   <<*GR1*>>11060000
    OUTPUT(PBUFW,70);                                          <<*GR1*>>11062000
                                                               <<*GR1*>>11064000
    <<******************************************************>> <<*GR1*>>11066000
    << Now search every track of disk for what looks like a >> <<*GR1*>>11068000
    << file label.  If GOOD'FILE'LABEL, than we PRINT'OR'-  >> <<*GR1*>>11070000
    << SAVE'FILE for that file label .                      >> <<*GR1*>>11072000
    <<******************************************************>> <<*GR1*>>11074000
                                                               <<*GR1*>>11076000
    TRACK:=-1;                                                 <<*GR1*>>11078000
    WHILE (TRACK:=TRACK+1) < NUMTRK DO                         <<06057>>11080000
      BEGIN  << READ A TRACKS WORTH OF DATA >>                 <<*GR1*>>11082000
      IF TRACK MOD 100 = 0 AND                                 <<03628>>11084000
         TRACK MOD   2 = 0     THEN                            <<03628>>11086000
         BEGIN                                                 <<03628>>11088000
           MOVE PBUF:="Scanning TRACK         ";               <<03628>>11090000
           ASCII(TRACK,PBUF(22),-10);                          <<03628>>11092000
           PRINT(PBUF,-23,CRLF);                               <<03628>>11094000
         END;                                                  <<03628>>11096000
                                                               <<03628>>11098000
      DISKADDR:=DOUBLE(TRACK)*DOUBLE(SECTRK);                  <<*GR1*>>11100000
      TESTCONTROLYTRAP;  <<See if a break has been hit      >> <<*GR1*>>11102000
      DISC(READD,LDEV,DRTUNIT,STYPE,TRACKBUF,DISKADDR,WC);     <<06057>>11104000
      IF < THEN                                                <<*GR1*>>11106000
        PRINT'DISC'ERROR(DISC'STATUS,DISKADDR)                 <<06057>>11116000
      ELSE                                                     <<*GR1*>>11118000
        BEGIN                                                  <<*GR1*>>11120000
        FOR I:=0 UNTIL SECTRK-1 DO                             <<*GR1*>>11122000
          BEGIN                                                <<*GR1*>>11124000
          @FLAB:=@TRACKBUF+(I*128);                            <<*GR1*>>11126000
          @IFLAB:=@FLAB;                                       <<*GR1*>>11128000
          @FLABB:=@FLAB & LSL(1);                              <<*GR1*>>11130000
          IF GOOD'FILE'LABEL AND WANT'FILE THEN                <<06057>>11132000
             BEGIN  << Probobly a good file and is wanted.  >> <<06057>>11134000
             PBUF:=" "; MOVE PBUF(1):=PBUF,(79);               <<*GR1*>>11136000
             OUTPUT(PBUFW,2); <<Blank line!>>                  <<*GR1*>>11138000
             MOVE PBUF:=FLABB,(8);         << FILE NAME >>     <<*GR1*>>11140000
             PBUF(8):=".";                                     <<*GR1*>>11142000
             MOVE PBUF(9):=FLABB(8),(8);  <<GROUP NAME>>       <<*GR1*>>11144000
             PBUF(17):=".";                                    <<*GR1*>>11146000
             MOVE PBUF(18):=FLABB(16),(8);<< ACCNT NAME >>     <<*GR1*>>11148000
             DATECONV(PBUF(28),FLAB(23),1);<< CREAT DATE>>     <<*GR1*>>11150000
             DATECONV(PBUF(38),FLAB(25),1);<<LST MOD DTE>>     <<*GR1*>>11152000
             DATECONV(PBUF(48),FLAB(24),1);<<LST ACC DTE>>     <<*GR1*>>11154000
             PBUF(60):="%";                                    <<*GR1*>>11156000
             DASCII(DISKADDR+DOUBLE(I),8,PBUF(61));<<SEC>>     <<*GR1*>>11158000
                                                               <<*GR1*>>11160000
             <<Call PRINT'OR'SAVE'FILE   to do the work     >> <<*GR1*>>11162000
                                                               <<*GR1*>>11164000
             PRINT'OR'SAVE'FILE;                               <<*GR1*>>11166000
                                                               <<*GR1*>>11168000
             END; <<Good file label  >>                        <<*GR1*>>11170000
          END; << OF ONE SECTOR >>                             <<*GR1*>>11172000
        END; << OF ONE TRACK >>                                <<*GR1*>>11174000
     END;  << OF READING TRACKS >>                             <<*GR1*>>11176000
                                                               <<*GR1*>>11178000
     IF SAVE'FILES AND NO'FILES'REEL <> 0 THEN                 <<*GR1*>>11180000
        BEGIN <<Saved at least one file, set up tape proper >> <<*GR1*>>11182000
          CONTROL(EOF); <<Write last End file >>               <<*GR1*>>11184000
          CONTROL(REWIND'UNLOAD);                              <<*GR1*>>11186000
        END;                                                   <<*GR1*>>11188000
                                                               <<*GR1*>>11190000
END;  << FIND >>                                               <<*GR1*>>11192000
$PAGE "HP/3000 DISC UTILITY - INITIALIZATION PROCEDURES"       <<*GR1*>>11194000
<<**********************************************************>> <<*GR1*>>11196000
<< This procedure is the CONTROL Y TRAP procedure.  It is   >> <<*GR1*>>11198000
<< entered when a CONTROL Y OR A and BREAK is entered.  It  >> <<*GR1*>>11200000
<< modifies Q so that when the procedure is exited, we enter>> <<*GR1*>>11202000
<< SETUPSHOP at RESTART and the stack is ready to go and    >> <<*GR1*>>11204000
<< the ENTER FUNCTION loop is entered via FUCNTION          >> <<*GR1*>>11206000
<<**********************************************************>> <<*GR1*>>11208000
                                                               <<*GR1*>>11210000
PROCEDURE CTLY'TRAP;                                           <<*GR1*>>11212000
BEGIN                                                          <<*GR1*>>11214000
    ARRAY Q(*)=Q-0,S(*)=S-0;                                   <<*GR1*>>11216000
    DEFINE ASMB=ASSEMBLE#;                                     <<*GR1*>>11218000
    Q(-2) := SAVEP;       <<  PHONEY UP STACK MARKER  >>       <<*GR1*>>11220000
    Q(-1) := OSTAT;       << SO IT LOOKS LIKE WE GOT  >>       <<*GR1*>>11222000
    Q     := @Q-SAVEQ;    << HERE VIA A PCAL JUST IN  >>       <<*GR1*>>11224000
    ASMB                  <<FRONT OF THE LABEL "START">>       <<*GR1*>>11226000
         (  LDI  0    ;   << IN "SETUPSHOP" PROCEDURE >>       <<*GR1*>>11228000
            ADDM EXITP;                                        <<*GR1*>>11230000
            XEQ  0  ) ;   << FORCE EXIT 0 AND IMPLODE >>       <<*GR1*>>11232000
EXITP:                    <<STACK BACK TO FIRST MARKER>>       <<*GR1*>>11234000
END;  << CTLY'TRAP >>                                          <<*GR1*>>11236000
                                                               <<*GR1*>>11238000
$PAGE                                                          <<*GR1*>>11240000
                                                                        11242000
                                                               <<*GR1*>>11244000
                                                               <<*GR1*>>11246000
<<**********************************************************>> <<*GR1*>>11248000
<<  This procedure does the initialization needed to begin  >> <<*GR1*>>11250000
<< processing of commands.  It initializes some key variabls>> <<*GR1*>>11252000
<< calls CONFigure to set up the initial device configur-   >> <<*GR1*>>11254000
<< ation for the system .                                   >> <<*GR1*>>11256000
<<**********************************************************>> <<*GR1*>>11258000
                                                               <<*GR1*>>11260000
PROCEDURE SETUPSHOP;                                                    11262000
BEGIN                                                                   11264000
                                                               <<*GR1*>>11266000
    <<******************************************************>> <<*GR1*>>11268000
    << Here, we declare and reserve space for the global    >> <<*GR1*>>11270000
    << TRACKBUFF array used to read and write tracks to     >> <<*GR1*>>11272000
    << disks.  We reserve space here because the global  DB >> <<*GR1*>>11274000
    << area was getting too large, therefore we make the    >> <<*GR1*>>11276000
    << array a Q relative array that will not be deallocated>> <<*GR1*>>11278000
    << until we are totally finished.                       >> <<*GR1*>>11280000
    <<******************************************************>> <<*GR1*>>11282000
                                                               <<*GR1*>>11284000
    INTEGER LEN;                                               <<04148>>11286000
    ARRAY TRKBUF(0:TRACKLEN-1);                                <<*GR1*>>11288000
    ARRAY COPYBUF'Q(0:COPYBUFLEN-1);                           <<03628>>11290000
    ARRAY QBUF'Q(0:255);                                       <<*GR1*>>11292000
    ARRAY RBUFW'Q(0:36);                                       <<*GR1*>>11294000
    ARRAY LBUFW'Q(0:64);                                       <<*GR1*>>11296000
    ARRAY PBUFW'Q(0:39);                                       <<*GR1*>>11298000
    ARRAY Q(*)=Q-0,S(*)=S-0;                                   <<*GR1*>>11300000
    DEFINE ASMB=ASSEMBLE#;                                     <<*GR1*>>11302000
                                                               <<*GR1*>>11304000
    @TRACKBUF := @TRKBUF;                                      <<*GR1*>>11306000
    @BTRACKBUF := @TRKBUF * 2;                                 <<*GR1*>>11308000
    @COPYBUF   := @COPYBUF'Q;                                  <<03628>>11310000
    @QBUF := @QBUF'Q;                                          <<*GR1*>>11312000
    @RBUFW := @RBUFW'Q;                                        <<*GR1*>>11314000
    @LBUFW := @LBUFW'Q;                                        <<*GR1*>>11316000
    @PBUFW := @PBUFW'Q;                                        <<*GR1*>>11318000
                                                               <<*GR1*>>11320000
    @BQBUF := @QBUF'Q * 2;                                     <<*GR1*>>11322000
    @RBUF  := @RBUFW'Q * 2;                                    <<*GR1*>>11324000
    @LBUF  := @LBUFW'Q * 2;                                    <<*GR1*>>11326000
    @PBUF  := @PBUFW'Q * 2;                                    <<*GR1*>>11328000
    @XDTT  := @QBUF'Q+128;                                     <<*GR1*>>11330000
                                                               <<*GR1*>>11332000
    SAVES := @S;                                               <<*GR1*>>11334000
    SAVEP := @RESTART;                                         <<*GR1*>>11336000
    ASMB  ( LDI  0  ;         << CLEAR COND CD >>              <<*GR1*>>11338000
            DEL    );                                          <<*GR1*>>11340000
    PUSH  ( STATUS );         <<SAVE STATUS REG>>              <<*GR1*>>11342000
    OSTAT := TOS;                                              <<*GR1*>>11344000
    SAVEQ := @Q ;             << SAVE  Q-REG   >>              <<*GR1*>>11346000
    SYSDU:=0;  <<SYSTEM DISC DRT/UNIT NOT INITIALIZED>>        <<*GR1*>>11348000
    VTABASE:=DIRBASE:=0D;  <<VTAB/DIRC. GLOBALS NOT INITIZED>> <<*GR1*>>11350000
    XCONTRAP(@CTLY'TRAP,LEN  );<< SET CTL'Y TRAPS ON  >>       <<04148>>11352000
RESTART:                                                       <<*GR1*>>11354000
    TOS := SAVES;                                              <<*GR1*>>11356000
    SET ( S );                                                 <<*GR1*>>11358000
                                                               <<*GR1*>>11360000
    << Set the original output mode to console, and call   >>  <<*GR1*>>11362000
    << CLEAROFFLINE to set the flag signigying this in our >>  <<*GR1*>>11364000
    << RL file.                                            >>  <<*GR1*>>11366000
                                                               <<*GR1*>>11368000
    OUTPUTMODE:=CONSOLE;                                       <<*GR1*>>11370000
    CLEAROFFLINE;                                              <<*GR1*>>11372000
                                                               <<*GR1*>>11374000
    <<*****************************************************>>  <<*GR1*>>11376000
    <<The Switch Register is stored in absolute location   >>  <<*GR1*>>11378000
    << %771, which is Mailbox location one. It is put there>>  <<*GR1*>>11380000
    << by SDUPII, so that if we are running under the      >>  <<*GR1*>>11382000
    << Series III version, then the Switch Registar will   >>  <<*GR1*>>11384000
    << contain the DRT number of the tape in which we      >>  <<*GR1*>>11386000
    << loaded.  This is how we distinguish between the     >>  <<*GR1*>>11388000
    << 7976 and the 7970E.  This only applies if we are    >>  <<*GR1*>>11390000
    << running under Series III. (X1 is on).               >>  <<*GR1*>>11392000
    <<*****************************************************>>  <<*GR1*>>11394000
                                                               <<*GR1*>>11396000
    SWITCH'REGISTER:=ABSOLUTE(%771);                           <<*GR1*>>11398000
                                                               <<*GR1*>>11400000
    MOVE PBUF := PTITLE,2;                                     <<*GR1*>>11402000
    LEN  := TOS - @PBUF;                                       <<04148>>11404000
    MOVE PBUF(VUUFF'COL) := OFFICIAL'VUUFF;                    <<04148>>11406000
    PRINT(PBUFW, -LEN,CRLF);      << PRINT CONSOLE HEADER >>   <<04148>>11408000
    IF NOT SYSUP THEN                                          <<*GR1*>>11410000
    BEGIN << INITIAL SETUP >>                                  <<*GR1*>>11412000
        FRDEVSPEC:=FALSE;      << FOR "CONF" PROCEDURE >>      <<*GR1*>>11414000
                                                               <<*GR1*>>11416000
        CONF;                  <<INITIAL CONFIG DIALOG>>       <<*GR1*>>11418000
                                                               <<*GR1*>>11420000
                                                               <<*GR1*>>11422000
        <<**************************************************>> <<*GR1*>>11424000
        << The directory index and entry block location     >> <<06057>>11426000
        << pointers are set up to point to addresses in     >> <<*GR1*>>11428000
        << global  INDEXBLOCK and ENTRYBLOCK arrays.  Each  >> <<*GR1*>>11430000
        << type, account, group and file have different     >> <<*GR1*>>11432000
        << sizes in sectors for their entry and index blocks>> <<*GR1*>>11434000
        << of the system directory.                         >> <<*GR1*>>11436000
        <<**************************************************>> <<*GR1*>>11438000
                                                               <<*GR1*>>11440000
        XBLOCK(ATYPE):=@INDEXBLOCK;      <<3 SECTORS LONG>>    <<*GR1*>>11442000
        XBLOCK(GTYPE):=@INDEXBLOCK(384); <<1 SECTOR  LONG>>    <<*GR1*>>11444000
        XBLOCK(FTYPE):=@INDEXBLOCK(512); <<2 SECTORS LONG>>    <<*GR1*>>11446000
        EBLOCK(ATYPE):=@ENTRYBLOCK;      <<3 SECTORS LONG>>    <<*GR1*>>11448000
        EBLOCK(GTYPE):=@ENTRYBLOCK(384); <<2 SECTORS LONG>>    <<*GR1*>>11450000
        EBLOCK(FTYPE):=@ENTRYBLOCK(640); <<2 SECTORS LONG>>    <<*GR1*>>11452000
                                                               <<*GR1*>>11454000
        <<**************************************************>> <<*GR1*>>11456000
        << If the system disk has been verified to be con-  >> <<*GR1*>>11458000
        << figured, then set up the system directory volume >> <<*GR1*>>11460000
        << table information for the system disc.  Otherwise>> <<*GR1*>>11462000
        << inform the user that the system disc was not     >> <<*GR1*>>11464000
        << configured.                                      >> <<*GR1*>>11466000
        <<**************************************************>> <<*GR1*>>11468000
                                                               <<*GR1*>>11470000
        SYSUP:=TRUE;    <<TELL MSG RTN TO INDENT MESSAGES>>    <<*GR1*>>11478000
    END;  << INITIAL SETUP >>                                  <<*GR1*>>11480000
    STARTIDLE;          << TURN ON CTRL-Y TRAPS >>             <<*GR1*>>11482000
    FUNCTION;           << START EXECUTING USER COMMANDS >>    <<*GR1*>>11484000
END << SETUPSHOP >>;                                                    11486000
$PAGE "HP/3000 DISC UTILITY - COMMAND HANDLING PROCEDURES"              11488000
<<***********************************************************>>         11490000
                                                                        11492000
PROCEDURE GETFUNCTION;                                                  11494000
BEGIN                                                                   11496000
     INTEGER I:=0,FNCT:=0,DEVLEN,ENDLOC,DEVLOC:=0;                      11498000
     BYTE ARRAY DEVSTRING(0:7);                                         11500000
     EQUATE                                                             11502000
          SAVEFUNCT = 12,                                               11504000
          EDITFUNCT = 13,                                               11506000
          PFILFUNCT = 18,                                               11508000
          OUTMFUNCT = 19,                                               11510000
          CONFFUNCT = 20;                                               11512000
                                                                        11514000
                                                               <<*GR1*>>11516000
                                                               <<*GR1*>>11518000
                                                               <<*GR1*>>11520000
     SUBROUTINE DEVNOTDEFINED(DEV);                                     11522000
     VALUE DEV; INTEGER DEV;                                            11524000
     BEGIN                                                              11526000
          MOVE PBUF:=" LDEV    NOT DEFINED";                            11528000
          ASCII(DEV,PBUF(6));                                           11530000
           PRINT(PBUF,-20,CRLF);                               <<01.DM>>11532000
     END <<DEVNOTDEFINED>>;                                             11534000
                                                                        11536000
$PAGE                                                          <<*GR1*>>11538000
     FNCT:=FUNCT:=0;  <<"ERR" FUNCTION CODE - ERROR>>                   11540000
     TODEVSPEC:=FRDEVSPEC:=FALSE;                                       11542000
     RBUF:=" "; MOVE RBUF(1):=RBUF,(9);                                 11544000
     MOVE PBUF:="ENTER FUNCTION: ";                                     11546000
     WHILE FNCT = 0 DO  <<GET VALID FUNCTION NAME>>                     11548000
     BEGIN                                                              11550000
          RLEN:=0;                                                      11552000
          WHILE RLEN = 0 DO                                             11554000
          BEGIN                                                         11556000
                PRINT(PBUF,-16,NOCRLF);  <<NO CRLF>>           <<01.01>>11558000
                RLEN:=READ(RBUF,-10);                          <<01.01>>11560000
                RBUF(RLEN) := CR;                              <<01.DM>>11562000
          END;                                                          11564000
          FOR I:=4 STEP 4 UNTIL FUNCTMAX DO                             11566000
          IF RBUF = FUNCTLIST(I),(4) THEN  <<FUNCTION FOUND>>           11568000
          BEGIN                                                         11570000
               FNCT:=I & LSR(2);                                        11572000
               I:=FUNCTMAX;  <<STOP LOOP>>                              11574000
          END;                                                          11576000
          IF FNCT = 0 THEN SMESSAGE(0);   << Illegal func.  >> <<06057>>11578000
     END;                                                               11580000
     FOR I:=4 UNTIL (RLEN-1) DO  <<LOOK FOR START OF DEV. SPEC.>>       11582000
     IF RBUF(I) <> " " THEN                                             11584000
     BEGIN                                                              11586000
          DEVLOC:=I;                                                    11588000
          I:=RLEN;  <<STOP LOOP>>                                       11590000
     END;                                                               11592000
     IF DEVLOC = 0 THEN  <<NO DEV. SPEC. - TAKE DEFAULTS>>              11594000
     BEGIN                                                              11596000
          IF (FUNCT:=FNCT) = OUTMFUNCT THEN RBUF:="C" ELSE              11598000
          IF FUNCT <> CONFFUNCT THEN                                    11600000
          IF NOT (SAVEFUNCT<=FUNCT<=EDITFUNCT) THEN                     11602000
          BEGIN                                                         11604000
               TDEV:=FDEV:=SYSLDEV;  <<ASSUME SYSTEM DRIVE>>            11606000
               FRDEVSPEC:=TODEVSPEC:=TRUE;                              11608000
          END;                                                          11610000
          RETURN;                                                       11612000
     END;                                                               11614000
     IF FNCT = OUTMFUNCT THEN  <<DON'T LOOK FOR NUM. DEV. SPEC.>>       11616000
     BEGIN                                                              11618000
          FUNCT:=FNCT;                                                  11620000
          MOVE RBUF:=RBUF(DEVLOC),(1);                                  11622000
          RETURN;                                                       11624000
     END;                                                               11626000
     IF (SAVEFUNCT<=FUNCT<=EDITFUNCT) OR                       <<SY.31>>11628000
        (FNCT=PFILFUNCT) OR (FNCT>CONFFUNCT) THEN              <<SY.31>>11630000
     BEGIN  <<DEVICE SPECIFICATION NOT ALLOWED>>                        11632000
          SMESSAGE(11);                                        <<06057>>11634000
          RETURN;                                                       11636000
     END;                                                               11638000
$PAGE                                                          <<*GR1*>>11640000
     MOVE DEVSTRING:=RBUF(DEVLOC) WHILE N,0;                            11642000
     ENDLOC:=TOS-@RBUF;                                                 11644000
     DELETE;                                                            11646000
     DEVLEN:=ENDLOC-DEVLOC;                                             11648000
     DEVLOC:=ENDLOC+1;                                                  11650000
     IF RBUF(ENDLOC) = ";" THEN TODEVSPEC:=TRUE ELSE                    11652000
     IF RBUF(ENDLOC) <> " " AND RBUF(ENDLOC) <> CR THEN                 11654000
     BEGIN                                                              11656000
          SMESSAGE(12);                                        <<06057>>11658000
          RETURN;                                                       11660000
     END;                                                               11662000
     FRDEVSPEC:=TRUE;                                                   11664000
     FDEV:=BINARY(DEVSTRING,DEVLEN);                                    11666000
     IF <> OR DEVLEN = 0 OR FDEV = 0 THEN                      <<04767>>11668000
     BEGIN                                                              11670000
          SMESSAGE(12);                                        <<06057>>11672000
          RETURN;                                                       11674000
     END;                                                               11676000
     IF FNCT <> CONFFUNCT THEN                                 <<SY.31>>11678000
     IF LPDT(FDEV) = 0 THEN  <<SPECIFIED DEVICE NOT CONFIGURED>>        11680000
     BEGIN                                                              11682000
          DEVNOTDEFINED(FDEV);                                          11684000
          RETURN;                                                       11686000
     END;                                                               11688000
     FRDEVSPEC:=TRUE;                                                   11690000
     IF TODEVSPEC THEN << TO DEVICE NO LONGER VALID >>         <<SY.31>>11692000
        BEGIN                                                  <<SY.31>>11694000
             SMESSAGE(11);                                     <<06057>>11696000
             RETURN;                                           <<SY.31>>11698000
        END;                                                   <<SY.31>>11700000
     FUNCT:=FNCT;  <<VALID REQUEST: FUNCT <> 0>>                        11702000
END << GETFUNCTION >>;                                                  11704000
                                                                        11706000
$PAGE                                                          <<*GR1*>>11708000
PROCEDURE FUNCTION;                                                     11710000
BEGIN                                                                   11712000
  INTEGER LEN;                                                 <<06057>>11712100
  PBUF := " ";PRINT(PBUF,-1,CRLF);                             <<06057>>11712200
  MOVE PBUF := "Type 'HELP' for a list of commands",2;         <<06057>>11712300
  LEN := TOS - @PBUF;PRINT(PBUF,-LEN,CRLF);                    <<06057>>11712400
  PBUF := " ";PRINT(PBUF,-1,CRLF);                             <<06057>>11712500
  WHILE TRUE DO                                                <<01.DM>>11714000
  BEGIN                                                        <<01.DM>>11716000
     ENABLE; <<Enable external interrupts>>                    <<*GR1*>>11718000
     GETFUNCTION;                                                       11720000
     SETIO( 0, ATTENTION);   << RESET CONTROL Y >>             <<01.DM>>11722000
     CASE * FUNCT OF                                                    11724000
     BEGIN                                                              11726000
          ;   << ERROR >>                                               11728000
          ;                                                    <<01.DM>>11730000
          ;                                                    <<01.DM>>11732000
          ;                                                    <<01.DM>>11734000
          ;                                                    <<01.DM>>11736000
          ;                                                    <<01.DM>>11738000
          ;                                                    <<01.DM>>11740000
          ;                                                    <<01.DM>>11742000
          ;                                                    <<01.DM>>11744000
          ;                                                    <<01.DM>>11746000
          ;                                                    <<SY.31>>11748000
          ;                                                    <<01.DM>>11750000
          SAVE;  << DISC FILE SAVE >>                                   11752000
          EDIT;  << DISC EDIT >>                                        11754000
          ;                                                    <<SY.31>>11756000
          PDSK;  << PRINT DISC SECTORS >>                               11758000
          PDTT;  << PRINT DEFECTIVE TRACKS TABLE >>                     11760000
          PVOL;  << PRINT VOLUME LABEL INFORMATION >>                   11762000
          PFIL;  << PRINT FILES IN DIRECTORY >>                         11764000
          OUTM;  << OUTPUT MODE - CONSOLE OR LINE PRINTER >>   <<01.DM>>11766000
          CONF;  << CONFIGURATOR >>                                     11768000
          COPY;  << DISC COPY FUNCTION >>                      <<01.DM>>11770000
          FIND;  << SCAN FOR FILE LABELS >>                    <<*GR1*>>11772000
          STOP;  << TERMINATE THE DISC UTILITY - HALT>>        <<01.DM>>11774000
          HELP;  << HELP DEBUGER >>                            <<01.DM>>11776000
          EXPL;  << Explain procedure.                      >> <<06057>>11777000
          CLID;  << Cold Load ID patcher.                   >> <<06057>>11777100
     END <<CASE>>;                                                      11778000
  END  <<WHILE>>;                                              <<01.DM>>11780000
                                                               <<01.DM>>11782000
END  << FUNCTION >>;                                                    11784000
$PAGE                                                          <<*GR1*>>11786000
$IF X1=OFF                                                     <<*GR1*>>11788000
                                                               <<*GR1*>>11790000
<<**********************************************************>> <<*GR1*>>11792000
<<                                                          >> <<*GR1*>>11794000
<<                    ATTENTION!!!!!!!!                     >> <<*GR1*>>11796000
<<     WARNING!!!!                          WARNING!!!!     >> <<*GR1*>>11798000
<<                                                          >> <<*GR1*>>11800000
<< Below is one of the ugliest pieces of code that you will >> <<*GR1*>>11802000
<< ever want to see. It is an ultimate kludge.  Do not mess >> <<*GR1*>>11804000
<< with it or the outer block if you know what's good for   >> <<*GR1*>>11806000
<< you.                                                     >> <<*GR1*>>11808000
<<                                                          >> <<*GR1*>>11810000
<<    The HPIB version of SADUTIL runs under the control of >> <<*GR1*>>11812000
<< The Diagnostic Utility System (DUS).  When DUS and       >> <<*GR1*>>11814000
<< SADUTIL are cold loaded from the tape, DUS enters the    >> <<*GR1*>>11816000
<< outer block of SADUTIL expecting that the very first     >> <<*GR1*>>11818000
<< thing in the outer block is a call to the File Manager,  >> <<*GR1*>>11820000
<< FMGR.  However, SADUTIL executes this piece of code      >> <<*GR1*>>11822000
<< first for the following reasons.                         >> <<*GR1*>>11824000
<<                                                          >> <<*GR1*>>11826000
<<    DUS only supports one code segment, and SADUTIL con-  >> <<*GR1*>>11828000
<< sists of two code segments, SADUTIL itself and the code  >> <<*GR1*>>11830000
<< segment from its RL file, which is built from taking a   >> <<*GR1*>>11832000
<< number of routines from SDFUTIL.  Because DUS only       >> <<*GR1*>>11834000
<< supports one code segment, DUS must be tricked into      >> <<*GR1*>>11836000
<< keeping our second code segment around.  This is done in >> <<*GR1*>>11838000
<< the following manner.                                    >> <<*GR1*>>11840000
<<                                                          >> <<*GR1*>>11842000
<<    When DUS and SADUTIL are cold loaded from the tape,   >> <<*GR1*>>11844000
<< they are placed in Bank 0 in the following manner.       >> <<*GR1*>>11846000
<< DUS is placed in code segments 1 and 2, and SADUTIl is   >> <<*GR1*>>11848000
<< placed in code segment 3 and SDFUTIL in code segment 4,  >> <<*GR1*>>11850000
<< with SADUTIL's stack following everything.  Therefore,   >> <<*GR1*>>11852000
<< bank 0 looks like the following when DUS and SADUTIL are >> <<*GR1*>>11854000
<< cold loaded by TPSTOMP.                                  >> <<*GR1*>>11856000
<<                                                          >> <<*GR1*>>11858000
<<              ----------------------                      >> <<*GR1*>>11860000
<<              !                    !                      >> <<*GR1*>>11862000
<<              !     DUS, code segs !                      >> <<*GR1*>>11864000
<<              !     1 and 2        !                      >> <<*GR1*>>11866000
<<              !                    !                      >> <<*GR1*>>11868000
<<              ----------------------                      >> <<*GR1*>>11870000
<<              !                    !                      >> <<*GR1*>>11872000
<<              !     SADUTIL        !                      >> <<*GR1*>>11874000
<<              !    code segment 3  !                      >> <<*GR1*>>11876000
<<              !                    !                      >> <<*GR1*>>11878000
<<              ----------------------                      >> <<*GR1*>>11880000
<<              !                    !                      >> <<*GR1*>>11882000
<<              !     SDFUTIL        !                      >> <<*GR1*>>11884000
<<              !    code segment 4  !                      >> <<*GR1*>>11886000
<<              !                    !                      >> <<*GR1*>>11888000
<<              ----------------------                      >> <<*GR1*>>11890000
<<              !                    !                      >> <<*GR1*>>11892000
<<              !     SADUTIL's      !                      >> <<*GR1*>>11894000
<<              !      stack         !                      >> <<*GR1*>>11896000
<<              !                    !                      >> <<*GR1*>>11898000
<<              ----------------------                      >> <<*GR1*>>11900000
<<                                                          >> <<*GR1*>>11902000
<<    Now, this is where the following piece of code comes  >> <<*GR1*>>11904000
<< in.  Because DUS doesn't know about SDFUTIL, we must     >> <<*GR1*>>11906000
<< trick it into moving SDFUTIL around properly.  Upon      >> <<*GR1*>>11908000
<< execution of the outer block of SADUTIL, this procedure  >> <<*GR1*>>11910000
<< will be executed and then the call to the FMGR.  In this >> <<*GR1*>>11912000
<< procedure, we must fake DUS into thinking that our stack >> <<*GR1*>>11914000
<< is larger than it really is.  Then, when we call the     >> <<*GR1*>>11916000
<< File Manager, the file manager will load SADUTIL and its >> <<*GR1*>>11918000
<< stack into BANK 1, thus also loading SDFUTIL into bank 1 >> <<*GR1*>>11920000
<< since SDFUTIL is now part of SADUTIL's stack!  Then,     >> <<*GR1*>>11922000
<< when DUS launches SADUTIL and it's stack , which includes>> <<*GR1*>>11924000
<< SDFUTIL, into bank one, it returns to the outer block of >> <<*GR1*>>11926000
<< SADUTIL and starts execution at the OUTER BLOCK + 7 words>> <<*GR1*>>11928000
<< This is done because the call to the File Manager was    >> <<*GR1*>>11930000
<< supposed to be the first thing in the outer block, so    >> <<*GR1*>>11932000
<< DUS starts executing after what is thinks is this call to>> <<*GR1*>>11934000
<< the file manager (FMGR).  At this point, the second half >> <<*GR1*>>11936000
<< of this procedure is exected, RESTORE'CST, to get things >> <<*GR1*>>11938000
<< back in order, see the next page for comments on that.   >> <<*GR1*>>11940000
<<     Therefore after execution of SETUPCST and before the >> <<*GR1*>>11942000
<< call to the File Manager, DUS is tricked into thinking   >> <<*GR1*>>11944000
<< that the stack is bigger than it really is.  See below   >> <<*GR1*>>11946000
<< comments for details.                                    >> <<*GR1*>>11948000
<<                                                          >> <<*GR1*>>11950000
<<**********************************************************>> <<*GR1*>>11952000
                                                               <<*GR1*>>11954000
PROCEDURE SETUPCST;                                            <<01.DM>>11956000
BEGIN                                                          <<01.DM>>11958000
    ENTRY RESTORE'CST;                                         <<01.DM>>11960000
    INTEGER S7 = S-7, S9 = S-9;                                <<01.DM>>11962000
    INTEGER START'CST3;                                        <<SY.31>>11964000
    DEFINE ABS = ABSOLUTE#,   ASMB = ASSEMBLE#;                <<01.DM>>11966000
                                                               <<*GR1*>>11968000
    <<******************************************************>> <<*GR1*>>11970000
    << The value assigned to the Z registar has been deter- >> <<*GR1*>>11972000
    << mined by all the arrays declared in SETUPSHOP.  The  >> <<03628>>11974000
    << value of Z must be large enouph to encommpass all the>> <<03628>>11976000
    << Q relative arrays( which are used as global arrays)  >> <<03628>>11978000
    << declared in SETUPSHOP.  The larges of these arrays   >> <<03628>>11980000
    << are 11.5K and 4K in length.  These combined with the >> <<03628>>11982000
    << fact that we need room for stack markers determined  >> <<03628>>11984000
    << the size of Z.  In this case, any playing around     >> <<03628>>11986000
    << with the STACK parm. in PREP will have no net effect >> <<03628>>11988000
    <<******************************************************>> <<*GR1*>>11990000
                                                               <<*GR1*>>11992000
    EQUATE GOOD'Z'VALUE = 20000;                               <<*GR1*>>11994000
                                                               <<*GR1*>>11996000
                                                               <<01.DM>>11998000
                                                               <<*GR1*>>12000000
<<**********************************************************>> <<*GR1*>>12002000
<<  Reserve storage for the present CODE SEGMENT table in a >> <<*GR1*>>12004000
<< PB relative array.  Also, reserve storage for all the    >> <<*GR1*>>12006000
<< stack registers in a PB relative array.                  >> <<*GR1*>>12008000
<<                                                          >> <<*GR1*>>12010000
<<  We must also reserve space for the DST table in our     >> <<*GR1*>>12012000
<< own stack.  DUS places the DST at %1000, but that area   >. <<*GR1*>>12014000
<< will be extensively used in SDFUTIL, therefore, we must  >> <<*GR1*>>12016000
<< move it into our own DB area so that it is not trashed   >> <<*GR1*>>12018000
<< later.                                                   >> <<*GR1*>>12020000
<<**********************************************************>> <<*GR1*>>12022000
                                                               <<*GR1*>>12024000
    ARRAY CST(0:7)=PB := 8(0);                                 <<01.DM>>12026000
    INTEGER ARRAY STACK'REGS(0:5)=PB := 6(0);                           12028000
    INTEGER ARRAY DST(0:67);                                   <<*GR1*>>12030000
    INTEGER LARGE'NEG:=%100001;                                <<*GR1*>>12032000
    <<Initialize DST to all zero's>>                           <<*GR1*>>12034000
                                                               <<*GR1*>>12036000
    DST(0):=0;                                                 <<*GR1*>>12038000
    MOVE DST(1):=DST(0),(67);                                  <<*GR1*>>12040000
                                                               <<01.DM>>12042000
<<**********************************************************>> <<*GR1*>>12044000
<<  Below, we do a Move ABSolute instruction to move the    >> <<*GR1*>>12046000
<< present code segment table, segments 3 and 4 into our    >> <<*GR1*>>12048000
<< PB relative array CST.  Code segments 3 and 4 contain    >> <<*GR1*>>12050000
<< SADUTIL and SDFUTIL.                                     >> <<*GR1*>>12052000
<<**********************************************************>> <<*GR1*>>12054000
                                                               <<*GR1*>>12056000
                                                               <<*GR1*>>12058000
    TOS := 0;                                                  <<01.DM>>12060000
    TOS := ABS(ABS(0)+%17)+@CST;                               <<01.DM>>12062000
    TOS := 0;                                                  <<01.DM>>12064000
    TOS := ABS(0)+%14;                                         <<01.DM>>12066000
    TOS := 8;                                                  <<01.DM>>12068000
    ASMB( MABS );                                              <<01.DM>>12070000
                                                               <<01.DM>>12072000
<<***********************************************************>><<*GR1*>>12074000
<< Here we do a Move ABSoute to move all the stack registers >><<*GR1*>>12076000
<< into out PB array STACK'REGS.  STACK'REGS(0) contains     >><<*GR1*>>12078000
<< S reg, (1) Q reg, (2) Z reg, (3) a 0 because DL is the    >><<*GR1*>>12080000
<< same as DB (DL is DB relative), (4) a 0 representing bank >><<*GR1*>>12082000
<< 0, and (5) the absolute address of DB.  S,Q and Z are all >><<*GR1*>>12084000
<< DB relative.                                              >><<*GR1*>>12086000
<<***********************************************************>><<*GR1*>>12088000
                                                               <<*GR1*>>12090000
    PUSH( DB, DL, Q, S, Z );                                   <<01.DM>>12092000
    TOS := 0;                                                  <<01.DM>>12094000
    TOS := CST(3)+LOGICAL(@STACK'REGS);                        <<01.DM>>12096000
    PUSH( DB );                                                <<01.DM>>12098000
    TOS := @S9;                                                <<01.DM>>12100000
    ASMB( LADD );                                              <<01.DM>>12102000
    TOS := 6;                                                  <<01.DM>>12104000
    ASMB( MABS );                                              <<01.DM>>12106000
                                                               <<01.DM>>12108000
<<***********************************************************>><<*GR1*>>12110000
<< Here we move the DST table from %1000 to our DB relative  >><<*GR1*>>12112000
<< DST array. Then we put in SADUTIL'S DST into the DST and  >><<*GR1*>>12114000
<< set up the DST.                                           >><<*GR1*>>12116000
<<***********************************************************>><<*GR1*>>12118000
                                                               <<*GR1*>>12120000
    PUSH( DB );                                                <<01.DM>>12122000
    TOS := TOS+@DST;                                           <<01.DM>>12124000
    TOS := %1000D;                                             <<01.DM>>12126000
    TOS := %50;                                                <<01.DM>>12128000
    ASMB( MABS );                                              <<01.DM>>12130000
    DST := SADUTILDST;    << SADUTIL'S DST >>                  <<01.DM>>12132000
    PUSH( DB ); DELB;                                          <<01.DM>>12134000
    DST(11) := TOS+@LARGE'NEG; << KLUDGE FOR SDISC >>          <<01.DM>>12136000
    MOVE DST(SADUTILDST&LSL(2)) := DST(32),(4);                <<01.DM>>12138000
                                                               <<01.DM>>12140000
                                                               <<01.DM>>12142000
<<***********************************************************>><<*GR1*>>12144000
<< This is the most important part of all. Here we make the  >><<*GR1*>>12146000
<< size of SADUTIL's stack, which is the 10th. entry into the>><<*GR1*>>12148000
<< present DST, located at %1000, large enouph to accomodate >><<*GR1*>>12150000
<< SDFUTIL.  We do this by adding it's present size with that>><<*GR1*>>12152000
<< of SDFUTIL's code segment.  The size of SDFUTIL's code    >><<*GR1*>>12154000
<< segment is stored in bits (4:12) of the first word of     >><<*GR1*>>12156000
<< code segment entry 4, which is now in our array CST.      >><<*GR1*>>12158000
<<  We then make the call to the file manager!               >><<*GR1*>>12160000
<<***********************************************************>><<*GR1*>>12162000
                                                               <<*GR1*>>12164000
    ABS(%1040).(3:13) := ABS(%1040).(3:13)+CST(4).(4:12);      <<01.DM>>12166000
                                                               <<01.DM>>12168000
    FMGR(5,PREAMBLE);                                          <<01.DM>>12170000
                                                               <<01.DM>>12172000
$PAGE                                                          <<*GR1*>>12174000
<<**********************************************************>> <<*GR1*>>12176000
<< When SADUTIL is reentered at word 7 of the outer block,  >> <<*GR1*>>12178000
<< RESTORECST is the first thing that is exectued.  Now,    >> <<*GR1*>>12180000
<< when DUS launched SADUTIL and its stack, which contained >> <<*GR1*>>12182000
<< SDFUTIL into bank 1, it also did the following.  It kept >> <<*GR1*>>12184000
<< SADUTIL's stack in bank 0, because SADUTIL will operated >> <<*GR1*>>12186000
<< with its stack in bank 0.  The stack that was placed into>> <<*GR1*>>12188000
<< bank one is acutually not ever used (that is, the DB part>> <<*GR1*>>12190000
<< we use SDFUTIL, of course, which is part of SADUTIL's    >> <<*GR1*>>12192000
<< stack when it is moved into bank 1).  So, DUS moves      >> <<*GR1*>>12194000
<< SADUTIL's stack up to the bottom of code segment 2(part  >> <<*GR1*>>12196000
<< of DUS). However, with this stack is SDFUTIL, which we   >> <<*GR1*>>12198000
<< do not want to be part of SADUTIL'S stack in bank 0      >> <<*GR1*>>12200000
<< anymore.  Therefore we do the following to straighten    >> <<*GR1*>>12202000
<< this whole mess out.                                     >> <<*GR1*>>12204000
<<**********************************************************>> <<*GR1*>>12206000
                                                               <<*GR1*>>12208000
RESTORE'CST:                                                   <<01.DM>>12210000
                                                               <<*GR1*>>12212000
<<**********************************************************>> <<*GR1*>>12214000
<< First we do a Move ABSolute to move SADUTIL's true stack,>> <<*GR1*>>12216000
<< without SDFUTIL, up to where DUS placed what he thought  >> <<*GR1*>>12218000
<< was SADUTIL's stack, but which actually contained        >> <<*GR1*>>12220000
<< SDFUTIL first and then SADUTIL's stack.  Therefore,  the >> <<*GR1*>>12222000
<< DB registar is set to where we want it to be, directly   >> <<*GR1*>>12224000
<< after DUS's code segment 2.  So we have to move SADUTIL's>> <<*GR1*>>12226000
<< true stack.  SADUTIL's true stack is located at DB plus  >> <<*GR1*>>12228000
<< the size of SDFUTIL.  Therefore we do a MABS, with the   >> <<*GR1*>>12230000
<< following parameters:                                    >> <<*GR1*>>12232000
<<      Destination source is DB, located in bank zero.     >> <<*GR1*>>12234000
<<      Source of the move is DB plus the length of            <<*GR1*>>12236000
<<            SDFUTIL, which is still stored in our         >> <<*GR1*>>12238000
<<            handy PB CST array.                           >> <<*GR1*>>12240000
<<      The length of the move is the old Z register, since >> <<*GR1*>>12242000
<<            we are moving the entire stack up! Z, remember>> <<*GR1*>>12244000
<<            is DB relative, so the length works out good! >> <<*GR1*>>12246000
<<**********************************************************>> <<*GR1*>>12248000
                                                               <<*GR1*>>12250000
    PUSH(DB);         << Destination >>                        <<SY.01>>12252000
    PUSH(DB);         << Calc. Source >>                       <<SY.01>>12254000
    TOS := CST(4).(4:12) & LSL(2);                             <<SY.01>>12256000
    TOS := TOS + TOS;                                          <<SY.01>>12258000
    TOS := STACK'REGS(2);    << Count >>                       <<*GR1*>>12260000
    ASMB ( MABS );                                             <<SY.01>>12262000
                                                               <<SY.01>>12264000
                                                               <<*GR1*>>12266000
<<**********************************************************>> <<*GR1*>>12268000
<< Here, we reset the old Z, Q, and S registars, stored in  >> <<*GR1*>>12270000
<< our handy, dandy array.                                  >> <<*GR1*>>12272000
<<**********************************************************>> <<*GR1*>>12274000
                                                               <<*GR1*>>12276000
    TOS := STACK'REGS;                                         <<SY.01>>12278000
    TOS := STACK'REGS(1);                                      <<SY.01>>12280000
    TOS := GOOD'Z'VALUE;                                       <<*GR1*>>12282000
    SET ( Z, Q, S );                                           <<SY.01>>12284000
                                                               <<SY.01>>12286000
                                                               <<*GR1*>>12288000
<<**********************************************************>> <<*GR1*>>12290000
<< Now, we set up the code segment table for SDFUTIL.       >> <<*GR1*>>12292000
<< Becuase DUS didn't know about SDFUTIL, it didn't set up  >> <<*GR1*>>12294000
<< the CST, so we do it ourselves.  First we store the size >> <<*GR1*>>12296000
<< from our handy CST array into the first work of CST entry>> <<*GR1*>>12298000
<< 4, which is SDFUTIL's.  Then we place PB, which is       >> <<*GR1*>>12300000
<< calculated by adding SADUTIL'S PB with the size of       >> <<*GR1*>>12302000
<< SADUTIL's code segment.   The bank of SDFUTIL is 1 !!!   >> <<*GR1*>>12304000
<<**********************************************************>> <<*GR1*>>12306000
                                                               <<*GR1*>>12308000
    ABS(ABS(0)+16) := CST(4);                                  <<SY.01>>12310000
    ABS(ABS(0)+18) := 1;     << Bank >>                        <<SY.01>>12312000
    ABS(ABS(0)+19) := (CST(0).(4:12)&LSL(2))+ABS(ABS(0)+15);   <<SY.01>>12314000
                                                               <<SY.01>>12316000
<<**********************************************************>> <<*GR1*>>12318000
<< Now we store the bank number and value of SADUTIL'S      >> <<*GR1*>>12320000
<< DB , which is currently in DB, into the DST at SADUTIL's >> <<*GR1*>>12322000
<< DST entry, which is %17.   We also must store the base   >> <<*GR1*>>12324000
<< of the DST into ABSOLUTE location 2.  The absoute loc.   >> <<*GR1*>>12326000
<< is simply the present value DB plus the DB offset of our >> <<*GR1*>>12328000
<< DST array DST!!                                          >> <<*GR1*>>12330000
<<**********************************************************>> <<*GR1*>>12332000
                                                               <<*GR1*>>12334000
    PUSH(DB);                                                  <<SY.01>>12336000
    TOS := LOGICAL(TOS) + LOGICAL(@DST);                       <<*GR1*>>12338000
    ABS(2) := TOS;                                             <<SY.01>>12340000
    PUSH(DB);                                                  <<SY.01>>12342000
    ABS((ABS(2)+SADUTILDST*4+3)) := TOS;                       <<SY.01>>12344000
    ABS(X:=X-1) := TOS;  << BANK NO. >>                        <<*GR1*>>12346000
                                                               <<01.DM>>12348000
    TOS := 0;                                                  <<01.DM>>12350000
<<**********************************************************>> <<*GR1*>>12352000
<< Finally, we set up the stack marker for execution        >> <<*GR1*>>12354000
<< starting at the CONTINUE Point in the outer block.       >> <<*GR1*>>12356000
<< We set up the index reg to be 0, the PB offset to be     >> <<*GR1*>>12358000
<< the address of CONTINUEP, the STATUS reg, and delta Q.   >> <<*GR1*>>12360000
<<**********************************************************>> <<*GR1*>>12362000
                                                               <<*GR1*>>12364000
    TOS := CONTINUEP;                                          <<01.DM>>12366000
    PUSH( STATUS );                                            <<01.DM>>12368000
    TOS := 4;                                                  <<01.DM>>12370000
    PUSH( S ); SET( Q );                                       <<01.DM>>12372000
$PAGE                                                          <<*GR1*>>12374000
<<**********************************************************>> <<*GR1*>>12376000
<<                                                          >> <<*GR1*>>12378000
<< After we have executed RESTORE'CST, memory is set up in  >> <<*GR1*>>12380000
<<  the following way:                                      >> <<*GR1*>>12382000
<<                                                          >> <<*GR1*>>12384000
<<                   BANK 0                                 >> <<*GR1*>>12386000
<<                                                          >> <<*GR1*>>12388000
<<               -------------------                        >> <<*GR1*>>12390000
<<               !                 !                        >> <<*GR1*>>12392000
<<               !      DUS        !                        >> <<*GR1*>>12394000
<<               !   CST- 1 and 2  !                        >> <<*GR1*>>12396000
<<               !                 !                        >> <<*GR1*>>12398000
<<               -------------------                        >> <<*GR1*>>12400000
<<               !                 !                        >> <<*GR1*>>12402000
<<               !    SADUTIL's    !                        >> <<*GR1*>>12404000
<<               !    STACK        !                        >> <<*GR1*>>12406000
<<               !                 !                        >> <<*GR1*>>12408000
<<               -------------------                        >> <<*GR1*>>12410000
<<                                                          >> <<*GR1*>>12412000
<<                   BANK 1                                 >> <<*GR1*>>12414000
<<                                                          >> <<*GR1*>>12416000
<<  %4000 ------>-------------------                        >> <<*GR1*>>12418000
<<               !                 !                        >> <<*GR1*>>12420000
<<               !    SADUTIL      !                        >> <<*GR1*>>12422000
<<               !     CST 3       !                        >> <<*GR1*>>12424000
<<               !                 !                        >> <<*GR1*>>12426000
<<               -------------------                        >> <<*GR1*>>12428000
<<               !                 !                        >> <<*GR1*>>12430000
<<               !    SDFUTIL      !                        >> <<*GR1*>>12432000
<<               !     CST 4       !                        >> <<*GR1*>>12434000
<<               !                 !                        >> <<*GR1*>>12436000
<<               -------------------                        >> <<*GR1*>>12438000
<<                                                          >> <<*GR1*>>12440000
<<**********************************************************>> <<*GR1*>>12442000
                                                               <<*GR1*>>12444000
END;                                                           <<01.DM>>12446000
$IF                                                            <<*GR1*>>12448000
                                                                        12450000
$PAGE "HP/3000 DISC UTILITY - OUTER BLOCK"                              12452000
<<******************* O-U-T-E-R  B-L-O-C-K ************************>>   12454000
                                                                        12456000
<<**********************************************************>> <<03628>>12458000
<<  WARNING!!!!  ATTENTION!!!!  WARNING!!!! ATTENTION!!!!   >> <<03628>>12460000
<<                                                          >> <<03628>>12462000
<< The outer block MUST not contain any extra code and      >> <<03628>>12464000
<< cannot contain any SUBROUTINES.  In other words, the     >> <<03628>>12466000
<< entry point of the outer block (OB') must be zero(0)!    >> <<03628>>12468000
<< This is because when DUS enters SADUTIL for the second   >> <<03628>>12470000
<< time at the outer block + 7 words, it is actually        >> <<03628>>12472000
<< entering the beginning of SADUTIL's code segment + 7     >> <<03628>>12474000
<< words.  It cannot determine the entry point into OB',    >> <<03628>>12476000
<< in fact, it simply enters at the seventh word of the     >> <<03628>>12478000
<< code segment, WHEREVER THAT MAY BE!.  Therefore, one     >> <<03628>>12480000
<< must be carefull to be sure that the first thing in the  >> <<03628>>12482000
<< code segment is the outerblock (OB' on the PMAP) and that>> <<03628>>12484000
<< the outer blocks entry point is at 0 of the SADUTIL's    >> <<03628>>12486000
<< code segment (code segment 3 mentioned in the discussion >> <<03628>>12488000
<< above.  This is the reason that we cannot use $COPYRIGHT >> <<03628>>12490000
<<**********************************************************>> <<03628>>12492000
                                                               <<03628>>12494000
                                                               <<*GR1*>>12496000
<<**********************************************************>> <<*GR1*>>12498000
<< Upon entrance into the outer block, we disable traps, set>> <<*GR1*>>12500000
<< up the address of out continuation point, which we will  >> <<*GR1*>>12502000
<< come back to after executing RESTORE'CST, and then we    >> <<*GR1*>>12504000
<< call SETUPCST before we call the file manager.  See that >  <<*GR1*>>12506000
<< procedure a discussion of what goes on.  Upon return     >> <<*GR1*>>12508000
<< from the file manager, we disable traps again and call   >> <<*GR1*>>12510000
<< RESTORE'CST to straighten things out.                    >> <<*GR1*>>12512000
<<**********************************************************>> <<*GR1*>>12514000
                                                               <<*GR1*>>12516000
$IF X1=OFF                                                     <<*GR1*>>12518000
   PUSH( STATUS );  TOS.(2:1):=0;  SET( STATAS ); <<DISABLE TRAPS>>     12520000
   CONTINUEP := @CONTINUE;                                     <<01.DM>>12522000
   SETUPCST;  << SAVE CST 3 & 4, THEN HAVE FM SAVE PROG >>     <<01.DM>>12524000
   << PADD OUT WHAT WOULD HAVE BEEN THE NORNAL FM CALL >>      <<01.DM>>12526000
                                                               <<*GR1*>>12528000
<<**********************************************************>> <<*GR1*>>12530000
<< This is where the File Manager will re-enter SADUTIL at  >> <<*GR1*>>12532000
<< after executing SETUP'CST and the call to the File Mana- >> <<*GR1*>>12534000
<< ger in that procedure.  This point is executed after  GO >> <<*GR1*>>12536000
<< and SADUTIL is entered in response to running DUS.       >> <<*GR1*>>12538000
<<**********************************************************>> <<*GR1*>>12540000
                                                               <<*GR1*>>12542000
   ASSEMBLE(NOP;NOP);                                          <<01.DM>>12544000
   ASSEMBLE( NOP );  << RESERVED FOR HALT INSTRUCTION >>       <<01.DM>>12546000
                                                               <<01.DM>>12548000
   PUSH( STATUS );  TOS.(2:1):=0;  SET( STATAS ); <<DISABLE TRAPS>>     12550000
   RESTORE'CST;                                                <<01.DM>>12552000
                                                               <<*GR1*>>12554000
<<**********************************************************>> <<*GR1*>>12556000
<< We return to this point from RESTORE'CST, and everything >> <<*GR1*>>12558000
<< is finally set up correctly.  We call INITIALIZE global  >> <<*GR1*>>12560000
<< to set up some very important variables in SDFUTIL, and  >> <<*GR1*>>12562000
<< the we call SETUPSHOP to begin SADTUTIL.                 >> <<*GR1*>>12564000
<<**********************************************************>> <<*GR1*>>12566000
                                                               <<*GR1*>>12568000
CONTINUE:                                                      <<01.DM>>12570000
                                                               <<01.DM>>12572000
   INITIALIZEGLOBAL(,,SADUTILDST,SADUTILDST);                  <<01.DM>>12574000
                                                               <<*GR1*>>12576000
$IF                                                            <<*GR1*>>12578000
<<**********************************************************>> <<*GR1*>>12580000
<< ENABLE external interupts and call SETUPSHOP to do all   >> <<*GR1*>>12582000
<< the setting up needed.                                   >> <<*GR1*>>12584000
<<**********************************************************>> <<*GR1*>>12586000
                                                               <<*GR1*>>12588000
SYSUP:=FALSE; <<System is not up yet >>                        <<*GR1*>>12590000
ENABLE;                                                        <<*GR1*>>12592000
SETUPSHOP;                                                     <<*GR1*>>12594000
                                                               <<*GR1*>>12596000
<<**********************************************************>> <<*GR1*>>12598000
<< After reading all the comments, if you are not totally   >> <<*GR1*>>12600000
<< confused, you must be quite inteligent                    >><<*GR1*>>12602000
<<                                                          >> <<*GR1*>>12604000
<<  Below is the end of this very SAD UTILity!!!            >> <<*GR1*>>12606000
<<**********************************************************>> <<*GR1*>>12608000
                                                               <<*GR1*>>12610000
END.                                                           <<01.DM>>12612000
