$CONTROL USLINIT,ADR,MAP,PRIVILEGED,UNCALLABLE                          00010000
BEGIN                                                                   00012000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00014000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00016000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00018000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00020000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00022000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00024000
                                                                        00026000
$THIRTY                                                                 00028000
                                                                        00030000
$SET X3=OFF   << FOR DFSM DEBUG >>                                      00032000
INTEGER s0=s-0;                                                         00034000
INTEGER x=x;                                                            00036000
                                                                        00038000
DEFINE LOG=LOGICAL#;                                                    00040000
DEFINE INT=INTEGER#;                                                    00042000
DEFINE DBL=DOUBLE#;                                                     00044000
                                                                        00046000
                                                                        00048000
   INTEGER  fn        << filenumber of $stdlist >>                      00050000
           ,ldev:=0  << want all ldevs >>                               00052000
           ;                                                            00054000
   EQUATE mvtabsir = 27;                                       <<03757>>00056000
   EQUATE pvmsgset = 15;                                       <<03757>>00058000
                                                                        00060000
   LOGICAL all:=true;  << print for all LDEVs >>                        00062000
   ARRAY ptitle(0:22);                                         <<04296>>00064000
   BYTE ARRAY ptitle'(*) = ptitle;                             <<04296>>00066000
   BYTE ARRAY fdesg(0:9);                                               00068000
   EQUATE vufpos = 6;                                          <<04296>>00070000
$INCLUDE INCLVUF                                               <<04296>>00072000
   DEFINE id =                                                          00074000
         "FREE2         (C) HEWLETT-PACKARD CO., 1976"#;       <<04296>>00076000
                                                                        00078000
                                                                        00080000
INTRINSIC    fopen,fwrite,fclose,terminate,print'file'info              00082000
            ,debug,print,dascii,ascii,quit                              00084000
            ;                                                           00086000
$PAGE  "   DISC LABEL/DEFECTIVE TRACKS TABLE DEFINITIONS"               00088000
$INCLUDE INCDISC1                                                       00090000
$PAGE  "   DFSM DST DEFINITIONS"                                        00092000
$INCLUDE INCLDFS1                                                       00094000
$PAGE                                                                   00096000
$INCLUDE INCLDFS2                                                       00098000
$PAGE  "   EXTERNAL PROCEDURE DEFINITIONS"                              00100000
LOGICAL PROCEDURE getsir(sirnum);                                       00102000
   VALUE sirnum;                                                        00104000
   INTEGER sirnum;                                                      00106000
   OPTION EXTERNAL;                                                     00108000
                                                                        00110000
PROCEDURE relsir(sirnum,a);                                             00112000
   VALUE sirnum,a;                                                      00114000
   INTEGER sirnum;                                                      00116000
   LOGICAL a;                                                           00118000
   OPTION EXTERNAL;                                                     00120000
                                                                        00122000
LOGICAL PROCEDURE setcritical;                                          00124000
   OPTION EXTERNAL;                                                     00126000
                                                                        00128000
PROCEDURE resetcritical(i);                                             00130000
   VALUE i;                                                             00132000
   LOGICAL i;                                                           00134000
   OPTION EXTERNAL;                                                     00136000
                                                                        00138000
LOGICAL PROCEDURE Lock'Dfs'Data'Seg(ldev);                              00140000
   VALUE ldev;                                                          00142000
   INTEGER ldev;                                                        00144000
   OPTION EXTERNAL;                                                     00146000
                                                                        00148000
PROCEDURE Unlock'Dfs'Data'Seg;                                          00150000
   OPTION EXTERNAL;                                                     00152000
                                                                        00154000
LOGICAL PROCEDURE Scan'Page;                                            00156000
   OPTION EXTERNAL;                                                     00158000
                                                                        00160000
LOGICAL PROCEDURE Get'Page(page);                                       00164000
   VALUE page;                                                          00166000
   INTEGER page;                                                        00168000
   OPTION EXTERNAL;                                                     00170000
                                                                        00172000
PROCEDURE checkdisc(ldn,stat);                                          00174000
   VALUE ldn;                                                           00176000
   INTEGER ldn;                                                         00178000
   LOGICAL stat;                                                        00180000
   OPTION EXTERNAL;                                                     00182000
                                                                        00184000
                                                               <<03757>>00186000
INTEGER PROCEDURE GENMSG (SETNO,MSGNO,MASK,PARM1,PARM2,        <<03757>>00188000
   PARM3,PARM4,PARM5,DEST,REPLY,OFFSET,DST,IOTYPE);            <<03757>>00190000
VALUE SETNO,MSGNO,MASK,PARM1,PARM2,PARM3,PARM4,PARM5,          <<03757>>00192000
      DEST,REPLY,OFFSET,DST,IOTYPE;                            <<03757>>00194000
INTEGER SETNO, MSGNO,DEST,DST;                                 <<03757>>00196000
LOGICAL MASK,PARM1,PARM2,PARM3,PARM4,PARM5,REPLY,OFFSET,       <<03757>>00198000
        IOTYPE;                                                <<03757>>00200000
OPTION EXTERNAL,VARIABLE;                                      <<03757>>00202000
                                                               <<03757>>00204000
$PAGE "   PROCEDURE PFRE"                                               00206000
$INCLUDE INCLFREE                                                       00208000
$PAGE                                                                   00210000
                                                                        00212000
<<===================================================                   00214000
                                                                        00216000
      Main procedure for FREE2. Procedure which does all the            00218000
      setting up. Opens up the print file and passes the filenumber     00220000
      to PFRE, who does all the work.                                   00222000
                                                                        00224000
   Parameters:                                                          00226000
      none                                                              00228000
                                                                        00230000
   Returns:                                                             00232000
      If error is encountered, it will terminate                        00234000
                                                                        00236000
   Intrinsics:                                                          00238000
      fopen,print'file'info,terminate,fwrite,fclose                     00240000
                                                                        00242000
   Changes:                                                             00244000
                                                                        00246000
====================================================>>                  00248000
                                                                        00250000
                                                                        00252000
   MOVE fdesg:="free2out  ";                                            00254000
   fn:=fopen(fdesg,%414,%1,-80);<< cctl,STDLIST,ascii,new/wronly >>     00256000
   IF <> THEN                                                           00258000
      BEGIN                                                             00260000
         print'file'info(fn);                                           00262000
         terminate;                                                     00264000
      END                                                               00266000
   ELSE                                                                 00268000
      BEGIN                                                             00270000
         MOVE ptitle' := id;                                   <<04296>>00272000
         MOVE ptitle'(vufpos) := official'vuuff;               <<04296>>00274000
         FWRITE(fn,ptitle,-43,%40);                            <<04296>>00276000
         IF <> THEN                                                     00278000
            BEGIN                                                       00280000
               print'file'info(fn);                                     00282000
               terminate;                                               00284000
            END;                                                        00286000
      END;                                                              00288000
                                                                        00290000
   pfre( fn,all,ldev<< no ldev>> );                                     00292000
                                                                        00294000
   fclose(fn,0,0);                                                      00296000
   IF <> THEN                                                           00298000
      BEGIN                                                             00300000
         print'file'info(fn);                                           00302000
         terminate;                                                     00304000
      END;                                                              00306000
                                                                        00308000
END.   << free2  >>                                                     00310000
$PAGE "HEWLETT-PACKARD   SUBROUTINE REL'MVTAB"                 <<04352>>00312000
SUBROUTINE rel'mvtab;                                          <<04352>>00314000
BEGIN                                                          <<04352>>00316000
   IF have'mvtab'sir THEN                                      <<04352>>00318000
      BEGIN                                                    <<04352>>00320000
      relsir (mvtabsir,mvtab'sir'flag);                        <<04352>>00322000
      have'mvtab'sir := FALSE;                                 <<04352>>00324000
      END;                                                     <<04352>>00326000
   IF lcrit'set THEN                                           <<04352>>00328000
      BEGIN                                                    <<04352>>00330000
      resetcritical(lcrit);                                    <<04352>>00332000
      lcrit'set := FALSE;                                      <<04352>>00334000
      END;                                                     <<04352>>00336000
END;                                                           <<04352>>00338000
rel'mvtab;                                                     <<04352>>00340000
rel'mvtab;                                                     <<04352>>00342000
              rel'mvtab;                                       <<04352>>00344000
         rel'mvtab;                                            <<04352>>00348000
         rel'mvtab;                                            <<04352>>00350000
      rel'mvtab;                                               <<04352>>00354000
