         << LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION >>     00000001
 EQUATE  BITMAP2  = %12,     << SERIES II,III (SIO MACHINES)>> <<T1777>>00160000
         BITMAP3  = %764,    << HPIB MACHINES >>               <<T1777>>00165000
         BITMAP5  = %776,    << TAPES USING AMIGO HPIB&II'III>><<T1777>>00170000
         BITMAP7  = %740;    << ICF55 AND SERIES-37,45,35   >> <<W1963>>00175000
                                                               <<T1777>>00180000
                                                               <<T1777>>00185000
                                                               <<T1777>>00190000
                                                               <<T1777>>00195000
          MAXLDEV   =  1024, <<MAX # OF CONFIGURED LDEVS>>     <<L9395>>00225000
          MAXUNIT   =   127, << MAX ALLOWABLE UNITS     >>     <<L9395>>00230000
          LDTSIZE   =     7, <<LOGICAL DEVICE TABLE ENTRY>>    <<L9395>>00235000
          LDTXSIZE  =     5, <<LDT EXTENSION>>                 <<L9395>>00240000
          LPDTSIZE  =     4, <<LPDT ENTRY SIZE>>               <<L9395>>00245000
          DVRSIZE   =     7, <<DRIVER TABLE ENTRY SIZE>>       <<L9395>>00250000
          VTABSIZE  =    14, <<VOLUME TABLE ENTRY SIZE>>       <<L9395>>00255000
          PERPORTMAX=    99, <<MAX.  NO. TBUFS/PORT>>          <<L9395>>00260000
          LIDTABSIZE=    33, <<LOGGING ID TABLE ENTRY SIZE>>   <<L9395>>00261000
          CTAB0SIZE =   128, <<CONFIGURATION INFO TABLE SIZE>> <<L9395>>00265000
          NCORESIZES=    60, <<# MEM SIZES>>                   <<L9395>>00270000
          CTABSIZE  =   128, <<CORESIZE-RELATED INFO SIZE>>    <<L9395>>00275000
          COMMSIZE  =   128,                                   <<L9395>>00280000
          INFOSIZE  =   256, <<DISC COLD LOAD INFO TABLE>>     <<L9395>>00285000
          NCST      =    32, <<# OF TEMPORARY CST ENTRIES>>    <<L9395>>00290000
          TCSTSIZE  = NCST*4,<<SIZE OF TEMPORARY CST>>         <<L9395>>00295000
          CSDVRSIZE =     4, <<CS ADDITIONAL DVRS>>            <<L9395>>00300000
          CSDRIVERS =    32, <<MAX CS ADDITIONAL DVRS>>        <<L9395>>00305000
          MERLIN =  6,  << SUBTYPE MERLIN>>                    <<L1364>>00501000
         SERIES'33 =      2,                                   <<W1963>>00660000
         SERIES'III=      3,                                   <<W1963>>00665000
         SERIES'37 =      6,                                   <<T1777>>00680000
         SERIES'45 =      7,                                   <<W1963>>00681000
         SERIES'35 =      8;                                   <<W1963>>00682000
  DEFINE POSTSERIES3    = BITMAP3&CSR(CPUTYPE)#,               <<T1777>>00685000
         SERIESII'III   = BITMAP2&CSR(CPUTYPE)#,               <<T1777>>00690000
                                                               <<T1777>>00720000
                                                               <<T1777>>00725000
  DEFINE CLTAPE'SIO      = BITMAP2&CSR(CPUTYPE)#,              <<T1777>>00730000
         CLTAPE'AMIGO    = BITMAP5&CSR(CPUTYPE)#;              <<T1777>>00735000
                                                               <<T1777>>00740000
           LASTLOADOPT    = 28,                                         00961000
          LOGFILENUM'    = 40,                                 <<02228>>00985000
          BACKUP'DATE    = 41;   << DATE OF LAST SYSDUMP >>    <<02228>>00986000
EQUATE NSYSPROG  = 34, <<#SYSTEM PROGS COMMON TO BOTH>>        <<c9139>>02325000
       NSYSPROG'33=40,  <<#SYSTEM PROGS UNIQUE TO SERIES'33>>  << 2532>>02335000
$EDIT VOID=02340000                                            <<01145>>02340000
       NDATACOMM = 50,  <<#SYS  PRGS THAT NEED NOT BE PRESENT>><< 2532>>02340500
       NSYSPROG'ALL=NSYSPROG+NSYSPROG'2+NSYSPROG'33+NDATACOMM; <<01145>>02345000
                                                               <<01145>>02350000
          ODIEETYPE  =   42, << ODIEE TYPE FOR ADV DS >>       <<O9734>>02461000
   STORE'FILES'LEN       = 240, <<length of STORE'FILES'>>     <<01439>>03910000
   PUTJCWFAIL            =  10;  <<PARM WHEN QUIT IF PUTJCW>>  <<L1439>>03911000
                                 <<BEING INVOKED FAILS>>       <<L1439>>03912000
      "HIOFLOP0","HIOMDSC1","PVINIT  ",                        <<c9139>>04130000
$EDIT VOID=04165000                                                     04165000
      "MPECHECK","HIOLPRT2","HIOPPRT0",                        <<c9139>>04170000
      "STORE   ","DEVDATA ","HIOTAPE2",                        <<c9139>>04180000
      "DEFDATA ";                                              <<c9139>>04185000
$EDIT VOID=04190000                                                     04190000
BYTE ARRAY SYSPROG'33(0:NSYSPROG'33*8-1):=<<NSYSPROG'33 @2335>><< 2532>>04225000
$EDIT VOID=4276000                                             << 2532>>04226000
      << WCS FILES                              >>             << 2532>>04228000
      "SYSWCS64","SYSWCS37","WCSLE1  ","WCSLE2  ",             << 2532>>04230000
      << SOFTDUMP FACILITY FILES                >>             << 2532>>04232000
      "SDFLOAD ","SDFCOM  ","SDFCHECK","SDFGEN  ",             << 2532>>04234000
                                                               << 2532>>04236000
      << DRIVERS                                >>             << 2532>>04238000
      "HIOTERM1","HIOTERM2","HIOASLP0","HIOASLP2",             << 2532>>04240000
      "HIOCDRD0","HIOCTAP1","HIOCTAP2","HIOASNP0",             << 2532>>04242000
                                                               << 2532>>04244000
      << VERTICAL FORMS CONTROL                 >>             << 2532>>04246000
      "VFCPCL  ","VFC31B7 ","VFC31B8 ",                        << 2532>>04248000
                                                               << 2532>>04250000
      << TERMINAL TYPE NO ESCAPE FILES          >>             << 2532>>04252000
      "TT10NOEC","TT18NOEC",                                   << 2532>>04254000
      << TERMINAL TYPE DESCRIPTOR FILES         >>             << 2532>>04256000
      "TT4     ","TT6     ","TT9     ","TT10    ",             << 2532>>04258000
      "TT12    ","TT13    ","TT15    ","TT16    ",             << 2532>>04260000
      "TT18    ","TT19    ","TT20    ","TT21    ",             << 2532>>04262000
      "TT22    ","TT26    ","TT31    ",                        << 2532>>04264000
                                                               << 2532>>04274000
      << TERMINAL TYPE PRINTER CONTROL LANGUAGE >>             << 2532>>04276000
      "TTPCL18 ","TTPCL19 ","TTPCL22 ","TTPCL26 ";             << 2532>>04278000
                                                               << 2532>>04280000
$EDIT VOID=04285000                                            <<01145>>04285000
BYTE ARRAY DATACOMM(0:NDATACOMM*8-1):=  << NDATACOMM @ 2340.5>><< 2532>>04285555
      "AUTOINST","INSTCAT ","IFHPIBFS",  << INSTALLER FILES>>  <<01145>>04285560
      "NLSDEF  ","CHRDEF01","CHRDEF02",  << NATIVE LANG SUP>>  << 1227>>04285570
      "CHRDEF03","CHRDEF04","CHRDEF05",                        << 1227>>04285580
      "CHRDEF06",                                              << 1227>>04285590
      "NMFILE  ","NMLOGMON","LINKMGR ",  << NETWORK MONITOR>>  <<01145>>04285611
                            "PCMANAGE",                        <<d9550>>04285666
      "NMCAT   ","NMCAT000","NMCAT001",                        <<c9139>>04285722
      "NMCAT002","NMCAT003","NMCAT004",                        <<c9139>>04285777
      "NMCAT005","NMCAT006","NMCAT007",                        <<c9139>>04285833
      "NMCAT008","NMCAT009","NMCAT010",                        <<c9139>>04285888
      "NMCAT011","NMCAT012","NMCAT013",                        <<c9139>>04285944
      "NMCAT014",                                              <<c9139>>04286000
      "CSDUMMY ","IODS0   ","IODSTRM0",  << DATACOMM FILES >>  <<01145>>04286111
      "IODSTRMX","IODSX   ","IOINP0  ",                        <<c9139>>04286222
      "IOM3270 ","IOMCONS0","IOMPNLP0",                        <<c9139>>04286333
      "IOMRDR0 ","IOMRJE0 ","IOMRJE1 ",                        <<c9139>>04286444
      "IOPAD0  ","IOPAD1  ","IONRDR0 ",                        <<c9139>>04286555
      "IOMPS0  ","IOMPLP0 ","IOMPTRM0",                        <<A9734>>04286777
      "IOVTERM0","IOLAN0  ";                                   << 2532>>04286778
                                                               << 2532>>04289800
    3200, 3328, 3456, 3584, 3712, 3840, 3968, 4096,            <<09307>>04330000
    4608, 5120, 5632, 6144, 6656, 7168, 7680, 8192,            <<09307>>04330100
    8704, 9216, 9728,10240,10752,11264,11776,12288,            <<09307>>04330200
   12800,13312,13824,14336,14848,15360,15872,16384;            <<09307>>04330300
   M138    = 138,                                              <<D9192>>05576000
   M139    = 139,                                              <<D9192>>05577000
   M279    = 279,                                              <<01314>>05715010
   M280    = 280,                                              <<01314>>05715020
   M281    = 281,                                              <<01314>>05715030
   M282    = 282,                                              <<01314>>05715040
   M283    = 283,                                              <<01314>>05715050
   M284    = 284,                                              <<01314>>05715060
   M285    = 285,                                              <<01314>>05715070
   M460    = 460,                                              <<L1056>>05905010
   M461    = 461,                                              <<L1056>>05905020
   M462    = 462,                                              <<L1056>>05905030
   M2473   = 2473,                                             << 9428>>07011000
   M2474   = 2474,                                             << 9428>>07012000
   M2475   = 2475,                                             << 9428>>07013000
   M2476   = 2476,                                             <<01314>>07013010
   M2477   = 2477,                                             <<01314>>07013020
   M2478   = 2478,                                             <<01314>>07013030
   M2479   = 2479,                                             <<01314>>07013040
   PUTJCW,                                                     <<L1439>>07481000
INTEGER PROCEDURE XRETPMASK(N1,N2,N3,N4,PMASKHI,PMASKLO);      <<A9734>>09235000
   BYTE ARRAY N1,N2,N3,N4;                                     <<A9734>>09245000
INTEGER PROCEDURE XRETJTENTRY (N1,N2,N3,N4,SIZE,INFO);         <<L1056>>09251000
INTEGER SIZE ;                                                 <<L1056>>09252000
INTEGER ARRAY INFO ;                                           <<L1056>>09253000
BYTE ARRAY N1,N2,N3,N4;                                        <<L1056>>09254000
OPTION EXTERNAL;                                               <<L1056>>09254100
        EQUATE                                                          10581000
          JCWFATAL    =   %100000; <<CAUSE JOB ABORTED>>       <<01301>>10582000
                                                                        10583000
          SETJCW (JCWFATAL); <<CAUSE JOB ABORTED,CIERROR SET>> <<01301>>10811000
                                                               <<01659>>14220000
          IF INTEGER(BPS0)="*" OR INTEGER(BPS0)="#"            <<01659>>14255000
             OR INTEGER(BPS0)="/" OR INTEGER(BPS0)=SPEC        <<01659>>14255100
             OR INTEGER(BPS0)=" "                              <<01659>>14255200
          IF CARRY THEN                                        <<01659>>14285100
             BEGIN                                             <<01659>>14285200
  NOBLANK:      ASSEMBLE(DECA);                                <<01659>>14285300
                IF INTEGER(BPS0)=SPACE THEN GOTO NOBLANK       <<01659>>14285400
                ELSE ASSEMBLE(INCA);                           <<01659>>14285500
             END                                               <<01659>>14285600
          ELSE                                                 <<01659>>14290000
   SUBTYP <> LINUS AND SUBTYP <> BUFFALO AND                   <<L1364>>14580000
   SUBTYP <> MERLIN THEN                                       <<L1364>>14581000
$EDIT VOID=14678750                                            <<S9278>>14677500
                                                               <<s9134>>14679000
      TYPE=DISC3 THEN                                          <<S9278>>14695000
$EDIT                                                          <<S9278>>14697500
                MOVE BINBUF(12) :="I/O,C";                     <<O9734>>17976000
   fwrite(listfnum,inbuf,-78,0);                               <<w9424>>18300000
   fwrite(listfnum,inbuf,-78,0);                               <<w9424>>18310000
   fwrite(listfnum,inbuf,-78,0);                               <<w9424>>18325000
   fwrite(listfnum,inbuf,-78,0);                               <<w9424>>18340000
            fwrite(listfnum,inbuf,-78,0);                      <<w9424>>18645000
      fwrite(listfnum,inbuf,-78,0);                            <<w9424>>18680000
   fwrite(listfnum,inbuf,0,%61);                               <<w9424>>18700000
      temp'dev,                                                <<09272>>20560000
      old'ldev,                                                << 9123>>20562500
   old'ldev := ldev;    <<save for reseting tables>>           << 9123>>20622500
            temp'dev:=tempclass'w(temp'first'ldev+dev'counter);<<09272>>20705000
            get'ldev'entries(temp'dev);                        <<09272>>20710000
            put'ldev'entries(temp'dev);                        <<09272>>20725000
         get'ldev'entries( old'ldev);   <<refresh tables>>     << 9123>>20802500
<< ----------------------------------------------------- >>    <<O9734>>22145000
<<                DETERMINE CLASS TYPE                   >>    <<O9734>>22146000
<< ----------------------------------------------------- >>    <<O9734>>22150000
PROCEDURE DETERMCTYP( ERRLABEL, DCT, ASKIO);                   <<O9734>>22151000
   VALUE ERRLABEL, DCT, ASKIO;                                 <<O9734>>22152500
   INTEGER ERRLABEL;                                           <<O9734>>22154000
   POINTER DCT;                                                <<O9734>>22155000
   LOGICAL ASKIO;                                              <<O9734>>22157000
                                                               <<O9734>>22158500
   << -------------------------------------------------- >>    <<O9734>>22160000
   << This procedure determines the type of the class to >>    <<O9734>>22161500
   << which DCT points to in the device class table...   >>    <<O9734>>22163000
   << Most importantly, it determines if the  different  >>    <<O9734>>22165000
   << types of access combinations possible in each class>>    <<O9734>>22166000
   << are legal or illegal.  The following table explains>>    <<O9734>>22167500
   << the value of the CASE statement ACCESS'COMBINATION >>    <<O9734>>22169000
   << used below:                                        >>    <<O9734>>22170000
   << CASE VALUE      ACCESS COMBINATIONS     ACCESS TYPE>>    <<O9734>>22172000
   << ----------      -------------------     ----------->>    <<O9734>>22173500
                                                               <<O9734>>22175000
   <<    0            uninitialized             illegal  >>    <<O9734>>22176500
   <<    1            normal all DA             legal    >>    <<O9734>>22178000
   <<    2            normal all SERINPUT       legal    >>    <<O9734>>22180000
   <<    3            DA, SERINPUT              illegal  >>    <<O9734>>22181000
   <<    4            normal all CONIO          legal    >>    <<O9734>>22182500
   <<    5            DA, CONIO                 illegal  >>    <<O9734>>22184000
   <<    6            SERINPUT, CONIO           legal    >>    <<O9734>>22185000
   <<    7            DA, SERINPUT, CONIO       illegal  >>    <<O9734>>22187000
   <<    8            normal all NONCONIO       legal    >>    <<O9734>>22188500
   <<    9            DA, NONCONIO,             illegal  >>    <<O9734>>22190000
   <<   10            SERINPUT, NONCONIO        legal    >>    <<O9734>>22191500
   <<   11            DA, SERINPUT, NONCONIO    illegal  >>    <<O9734>>22193000
   <<   12            CONIO, NONCONIO           legal    >>    <<O9734>>22195000
   <<   13            DA, CONIO, NONCONIO       illegal  >>    <<O9734>>22196000
   <<   14            SERINPUT, NONCONIO        legal    >>    <<O9734>>22197500
   <<   15            DA, SERINPUT, NONCONIO    illegal  >>    <<O9734>>22199000
   <<   16            normal all SEROUTPUT      legal    >>    <<O9734>>22200000
   <<   17            SEROUTPUT, DA             illegal  >>    <<O9734>>22202000
   <<   18            SEROUTPUT, SERINPUT       illegal  >>    <<O9734>>22203500
   <<   19            SEROUTPUT,SERINPUT, DA    illegal  >>    <<O9734>>22205000
   <<   20            SEROUTPUT, CONIO          legal    >>    <<O9734>>22206500
   <<   21            SEROUTPUT, CONIO, DA      illegal  >>    <<O9734>>22208000
   <<   22            SEROUTPUT,CONIO,SERINPUT  illegal  >>    <<O9734>>22210000
   <<   23            SEROUT,SERIN,CONIO,DA     illegal  >>    <<O9734>>22211000
   <<   24            SEROUTPUT, NONCONIO       legal    >>    <<O9734>>22212500
   <<   25            SEROUTPUT, NONCONIO, DA   illegal  >>    <<O9734>>22214000
   <<   26            SEROUTPUT,NONCONIO,SERIN  illegal  >>    <<O9734>>22215000
   <<   27            SEROUT,NONCONIO,DA,SERIN  illegal  >>    <<O9734>>22217000
   <<   28            SEROUTPUT, NONCONIO,CONIO legal    >>    <<O9734>>22218500
   <<   29            SEROUT,NCONIO,CONIO,DA    illegal  >>    <<O9734>>22220000
   <<   30            SEROUT,NCONIO,CONIO,SERIN illegal  >>    <<O9734>>22221500
   <<   31            all access combinations   illegal  >>    <<O9734>>22223000
   <<   32            out of bounds precaution  illegal  >>    <<O9734>>22225000
   << -------------------------------------------------- >>    <<O9734>>22226000
                                                               <<O9734>>22227500
                                                               <<O9734>>22229000
   BEGIN                                                       <<O9734>>22230000
                                                               <<O9734>>22235000
   INTEGER                                                     <<O9734>>22240000
      I,                                                       <<O9734>>22241000
      ACCESS'COMBINATION,                                      <<O9734>>22242500
      ACCESS'RANGE1,                                           <<O9734>>22244000
      ACCESS'RANGE2,                                           <<O9734>>22245000
      CURRENT'CLASS'ACCESS'TYPE,                               <<O9734>>22247000
      DEVICE'TYPE1,                                            <<O9734>>22250000
      NUM'DEVICES,                                             <<O9734>>22253000
      SUBTYPE,                                                 <<O9734>>22255000
      TYPE;                                                    <<O9734>>22256000
                                                               <<O9734>>22257500
   BYTE POINTER                                                <<O9734>>22259000
      DCT'B;                                                   <<O9734>>22260000
                                                               <<O9734>>22262000
   LOGICAL                                                     <<O9734>>22265000
      VALID'RESPONSE   :=TRUE,                                 <<O9734>>22270000
      ALL'SAME'TYPE    :=TRUE,                                 <<O9734>>22271000
      ALL'SAME'RANGE   :=TRUE,                                 <<O9734>>22272500
      CANBESERIAL      :=TRUE;                                 <<O9734>>22274000
                                                               <<O9734>>22275000
   SUBROUTINE PROMPT'C'NC;                                     <<O9734>>22277000
                                                               <<O9734>>22278500
      BEGIN                                                    <<O9734>>22280000
                                                               <<O9734>>22281500
      << ----------------------------------------------- >>    <<O9734>>22283000
      << This subroutine is called when the acess type is>>    <<O9734>>22285000
      << is concurrent but we need to verify whether it  >>    <<O9734>>22286000
      << is NON-concurrent or concurrent I/O...          >>    <<O9734>>22287500
      << ----------------------------------------------- >>    <<O9734>>22289000
                                                               <<O9734>>22290000
     VALID'RESPONSE := FALSE;                                  <<O9734>>22292000
     IF DCT'ACCESS'TYPE = LDT'IO'CONCURRENT   OR               <<O9734>>22293500
        DCT'ACCESS'TYPE = LDT'IO'2'CONCURRENT THEN            <<<O9734>>22295000
        DO                                                     <<O9734>>22296500
          BEGIN                                                <<O9734>>22298000
          MESSAGE(-M2351); << CONCURRENT OR NON-CONCURRENT >>  <<O9734>>22300000
          READINPUT;                                           <<O9734>>22301000
          GETSTR(@PROMPT'C'NC, BTYP, 1,"A",2);                 <<O9734>>22302500
          IF BTYP  = "NC"   OR                                 <<O9734>>22304000
             BTYP  = "C"    OR                                 <<O9734>>22305000
             BTYP  = "C "   OR                                 <<O9734>>22307000
             BTYP  = "CO"   THEN                               <<O9734>>22308500
             VALID'RESPONSE := TRUE;                           <<O9734>>22310000
          IF NOT VALID'RESPONSE                                <<O9734>>22311500
             THEN MESSAGE(M2453)     << ILLEGAL INPUT >>       <<O9734>>22313000
          ELSE IF BTYP = "NC" THEN                             <<O9734>>22315000
               DCT'CLASS'ACC'TYPE := LDT'IO'NONCONCUR & LSL(3);<<O9734>>22316000
          END                                                  <<O9734>>22317500
       UNTIL VALID'RESPONSE;                                   <<O9734>>22319000
   END;  << SUBROUTINE PROMPT'C'NC >>                          <<O9734>>22320000
                                                               <<O9734>>22322000
   SUBROUTINE PROMPT'IN'OUT;                                   <<O9734>>22323500
                                                               <<O9734>>22325000
      BEGIN                                                    <<O9734>>22326500
                                                               <<O9734>>22328000
      << ------------------------------------------------- >>  <<O9734>>22330000
      << This subroutine is called when the access type is >>  <<O9734>>22331000
      << concurrent but we need to verify whether it is IN,>>  <<O9734>>22332500
      << OUT, or IN/OUT...                                 >>  <<O9734>>22334000
      << ------------------------------------------------- >>  <<O9734>>22335000
                                                               <<O9734>>22337000
      VALID'RESPONSE := FALSE;                                 <<O9734>>22338500
      DO                                                       <<O9734>>22340000
         BEGIN                                                 <<O9734>>22341500
         MESSAGE(-M2350);  << IN, OUT, OR IN/OUT? >>           <<O9734>>22343000
         READINPUT;                                            <<O9734>>22344000
         GETSTR(@PROMPT'IN'OUT, BTYP,1,"/",6);                 <<O9734>>22345000
         IF BTYP = "IN    "   OR                               <<O9734>>22346000
            BTYP = "OUT   "   OR                               <<O9734>>22347500
            BTYP = "IN/OUT"   OR                               <<O9734>>22349000
            BTYP = "IO    "   THEN                             <<O9734>>22350000
            VALID'RESPONSE := TRUE;                            <<O9734>>22352000
         IF NOT VALID'RESPONSE THEN                            <<O9734>>22353500
            MESSAGE(M2453)       << ILLEGAL INPUT >>           <<O9734>>22355000
         ELSE IF BTYP = "IN    " THEN                          <<O9734>>22356500
              DCT'CLASS'ACC'TYPE := LDT'SERIAL'IN & LSL(3)     <<O9734>>22358000
         ELSE IF BTYP = "OUT   " THEN                          <<O9734>>22360000
              DCT'CLASS'ACC'TYPE := LDT'SERIAL'OUT & LSL(3);   <<O9734>>22361000
         END                                                   <<O9734>>22362500
       UNTIL VALID'RESPONSE;                                   <<O9734>>22364000
                                                               <<O9734>>22365000
      IF BTYP = "IN/OUT" OR                                    <<O9734>>22367000
         BTYP = "IO    " THEN PROMPT'C'NC;                     <<O9734>>22368500
                                                               <<O9734>>22370000
      END; << SUBROUTINE PROMPT'IN'OUT >>                      <<O9734>>22371500
                                                               <<O9734>>22373000
                                                               <<O9734>>22375000
   SUBROUTINE DIRECT'ACCESS'CHECK;                             <<O9734>>22376000
                                                               <<O9734>>22377500
      BEGIN                                                    <<O9734>>22379000
                                                               <<O9734>>22380000
      << ----------------------------------------------- >>    <<O9734>>22382000
      << This subroutine verifies if a direct access type>>    <<O9734>>22383500
      << (0-7) can be a serial or foreign device in which>>    <<O9734>>22385000
      << case we update the device class access type.    >>    <<O9734>>22386500
      << If its not a serial or foreign device all       >>    <<O9734>>22388000
      << we really care about is that the access field   >>    <<O9734>>22390000
      << contain the value (0) irregardless of the type  >>    <<O9734>>22391000
      << ----------------------------------------------- >>    <<O9734>>22392500
                                                               <<O9734>>22394000
      IF CURRENT'CLASS'ACCESS'TYPE <> LDT'SERIAL'DISC AND      <<O9734>>22395000
         CURRENT'CLASS'ACCESS'TYPE <> LDT'FOREIGN'DISC THEN    <<O9734>>22397000
         IF ALL'SAME'TYPE THEN                                 <<O9734>>22398500
            DCT'CLASS'ACC'TYPE := DEVICE'TYPE1                 <<O9734>>22400000
         ELSE DCT'CLASS'ACC'TYPE := LDT'DIRECT'ACCESS;         <<O9734>>22401500
                                                               <<O9734>>22403000
      IF CANBESERIAL AND ASKIO THEN                            <<O9734>>22405000
         IF YESANSWER(M2327)       << SERIAL DISC CLASS ? >>   <<O9734>>22406000
            THEN DCT'CLASS'ACC'TYPE := LDT'SERIAL'DISC         <<O9734>>22407500
         ELSE IF YESANSWER(M2334)  << FOREIGN DISC CLASS? >>   <<O9734>>22409000
                 THEN DCT'CLASS'ACC'TYPE := LDT'FOREIGN'DISC;  <<O9734>>22410000
                                                               <<O9734>>22412000
      END; << SUBROUTINE DIRECT'ACCESS'CHECK >>                <<O9734>>22413500
                                                               <<O9734>>22415000
   SUBROUTINE SERIAL'INPUT'CHECK;                              <<O9734>>22416500
                                                               <<O9734>>22418000
      BEGIN                                                    <<O9734>>22420000
                                                               <<O9734>>22421000
      << ----------------------------------------------- >>    <<O9734>>22422500
      << This subroutine simply checks to see if all the >>    <<O9734>>22424000
      << ldevs in a class entry are the same type.  If so>>    <<O9734>>22425000
      << it assigns it the type of the first ldev. Other->>    <<O9734>>22427000
      << wise if they are all serial input type then the >>    <<O9734>>22428500
      << type is assigned the first type in this range...>>    <<O9734>>22430000
      << type = 8...                                     >>    <<O9734>>22431500
      << ----------------------------------------------- >>    <<O9734>>22433000
                                                               <<O9734>>22435000
      IF ALL'SAME'TYPE THEN                                    <<O9734>>22436000
         DCT'CLASS'ACC'TYPE := DEVICE'TYPE1                    <<O9734>>22437500
      ELSE IF ALL'SAME'RANGE OR ASKIO THEN                     <<O9734>>22439000
              DCT'CLASS'ACC'TYPE := LDT'SERIAL'IN & LSL(3);    <<O9734>>22440000
                                                               <<O9734>>22442000
      END;  << SUBROUTINE SERIAL'INPUT'CHECK >>                <<O9734>>22443500
                                                               <<O9734>>22445000
   SUBROUTINE CONIO'ACCESS'CHECK;                              <<O9734>>22446500
                                                               <<O9734>>22448000
      BEGIN                                                    <<O9734>>22450000
                                                               <<O9734>>22451000
      << ----------------------------------------------- >>    <<O9734>>22452500
      << This subroutine verifies the input/output con-  >>    <<O9734>>22454000
      << currency of the device type.  Note, the class   >>    <<O9734>>22455000
      << access type is assigned the first type in this  >>    <<O9734>>22457000
      << range... type = 16                              >>    <<O9734>>22458500
      << ----------------------------------------------- >>    <<O9734>>22460000
                                                               <<O9734>>22461500
      IF ALL'SAME'TYPE THEN                                    <<O9734>>22463000
         DCT'CLASS'ACC'TYPE := DEVICE'TYPE1                    <<O9734>>22465000
      ELSE IF ALL'SAME'RANGE THEN                              <<O9734>>22466000
           DCT'CLASS'ACC'TYPE := LDT'IO'CONCURRENT & LSL(3);   <<O9734>>22467500
                                                               <<O9734>>22469000
      IF ASKIO THEN                                            <<O9734>>22470000
         PROMPT'IN'OUT;                                        <<O9734>>22472000
                                                               <<O9734>>22473500
      END; << SUBROUTINE CONIO'ACCESS'CHECK >>                 <<O9734>>22475000
                                                               <<O9734>>22476500
   SUBROUTINE NONCONIO'ACCESS'CHECK;                           <<O9734>>22478000
      BEGIN                                                    <<O9734>>22480000
                                                               <<O9734>>22482500
      << ---------------------------------------------- >>     <<O9734>>22485000
      << This subroutine simply assigns the class access>>     <<O9734>>22486000
      << type the first type in this range ...type = 24;>>     <<O9734>>22487000
      << and if necessary verifies in/out concurrency.  >>     <<O9734>>22488500
      << ---------------------------------------------- >>     <<O9734>>22490000
                                                               <<O9734>>22491500
      IF ALL'SAME'TYPE THEN                                    <<O9734>>22493000
         DCT'CLASS'ACC'TYPE := DEVICE'TYPE1                    <<O9734>>22495000
      ELSE IF ALL'SAME'RANGE THEN                              <<O9734>>22496000
              DCT'CLASS'ACC'TYPE := LDT'IO'NONCONCUR & LSL(3); <<O9734>>22497500
      IF ASKIO THEN PROMPT'IN'OUT;                             <<O9734>>22499000
                                                               <<O9734>>22500000
      END; << SUBROUTINE NONCONIO'ACCESS'CHECK >>              <<O9734>>22502000
                                                               <<O9734>>22503500
   SUBROUTINE SERIAL'OUTPUT'CHECK;                             <<O9734>>22505000
                                                               <<O9734>>22506500
      BEGIN                                                    <<O9734>>22508000
                                                               <<O9734>>22510000
      << ---------------------------------------------- >>     <<O9734>>22511000
      << This subroutine simply assigns the access type >>     <<O9734>>22512500
      << the device type of the first ldev in the class >>     <<O9734>>22514000
      << entry if all the ldevs are of the same type.   >>     <<O9734>>22515000
      << Otherwise, it assigns the class access type the>>     <<O9734>>22517000
      << first type in this range ... type = 32         >>     <<O9734>>22518500
      << ---------------------------------------------- >>     <<O9734>>22520000
                                                               <<O9734>>22521500
      IF ALL'SAME'TYPE THEN                                    <<O9734>>22523000
         DCT'CLASS'ACC'TYPE := DEVICE'TYPE1                    <<O9734>>22525000
      ELSE IF ALL'SAME'RANGE OR ASKIO THEN                     <<O9734>>22526000
              DCT'CLASS'ACC'TYPE := LDT'SERIAL'OUT & LSL(3);   <<O9734>>22530000
      END; << SUBROUTINE SERIAL'OUTPUT'CHECK >>                <<O9734>>22530500
                                                               <<O9734>>22532000
   SUBROUTINE CLASS'ACCESS'ERROR;                              <<O9734>>22533500
                                                               <<O9734>>22535000
      BEGIN                                                    <<O9734>>22536500
                                                               <<O9734>>22538000
      << ---------------------------------------------- >>     <<O9734>>22540000
      << This subroutine first checks if all the devices>>     <<O9734>>22541000
      << are of the same type.  If not, it prints out an>>     <<O9734>>22542500
      << error message and returns control to calling   >>     <<O9734>>22544000
      << procedure.                                     >>     <<O9734>>22545000
      << ---------------------------------------------- >>     <<O9734>>22547000
                                                               <<O9734>>22548500
      IF ALL'SAME'TYPE THEN                                    <<O9734>>22550000
         DCT'CLASS'ACC'TYPE := DEVICE'TYPE1                    <<O9734>>22551500
      ELSE IF ASKIO THEN                                       <<O9734>>22553000
              BEGIN                                            <<O9734>>22555000
              << ------------------------------------- >>      <<O9734>>22556000
              << Illegal type combinations in class ...>>      <<O9734>>22557500
              << ------------------------------------- >>      <<O9734>>22560000
              MESSAGE(M123,,,,,DEVCLASS);                      <<O9734>>22565000
              RETURNP := ERRLABEL;                             <<O9734>>22568000
              END;                                             <<O9734>>22570000
      RETURN;                                                  <<O9734>>22571000
      END; << SUBROUTINE CLASS'ACCESS'ERROR >>                 <<O9734>>22572500
                                                               <<O9734>>22574000
 << ------------------------------------------------------ >>  <<O9734>>22575000
 << Initialize the main device type and access range using >>  <<O9734>>22577000
 << the first logical device # in the given device class   >>  <<O9734>>22578500
 << entry pointed to by DCT.  Note: since we opened up a   >>  <<O9734>>22580000
 << second range of concurrent IO (device types 40-47), we >>  <<O9734>>22581500
 << default the access type to the old range = 2.  The same>>  <<O9734>>22583000
 << mechanism may be used when we decide to use up the     >>  <<O9734>>22585000
 << access ranges 6 and 7...                               >>  <<O9734>>22586000
 << ------------------------------------------------------ >>  <<O9734>>22587500
                                                               <<O9734>>22589000
 I := -1;                                                      <<O9734>>22590000
 NUM'DEVICES := DCT'NUM'DEVICES;                               <<O9734>>22592000
 ACCESS'COMBINATION := 0;                                      <<O9734>>22593500
 CURRENT'CLASS'ACCESS'TYPE := DCT'CLASS'ACC'TYPE;              <<O9734>>22595000
 GET'LDEV'ENTRIES(DCT (DCT'FIRST'LDEV));                       <<O9734>>22596500
 DEVICE'TYPE1 := LDT'DEVICE'TYPE;                              <<O9734>>22598000
 ACCESS'RANGE1 := IF LDT'ACCESS'TYPE = LDT'IO'2'CONCURRENT     <<O9734>>22600000
                     THEN LDT'IO'CONCURRENT                    <<O9734>>22601000
                     ELSE LDT'ACCESS'TYPE;                     <<O9734>>22602500
                                                               <<O9734>>22604000
<< --------------------------------------------------------- >><<O9734>>22605000
<< Now compare device types and access types with other devic>><<O9734>>22607000
<< in the same class and then check for all possible combina->><<O9734>>22608500
<< tions of access types.  See the chart above for a descrip->><<O9734>>22610000
<< tion of legal and illegal combinations.                   >><<O9734>>22611500
<< --------------------------------------------------------- >><<O9734>>22613000
                                                               <<O9734>>22615000
WHILE (I:= I+1) < INTEGER(DCT'NUM'DEVICES) DO                  <<O9734>>22616000
   BEGIN                                                       <<O9734>>22617500
   GET'LDEV'ENTRIES(DCT(DCT'FIRST'LDEV + I));                  <<O9734>>22619000
   TYPE := LDT'DEVICE'TYPE;                                    <<O9734>>22620000
   SUBTYPE := LPDT'SUBTYPE;                                    <<O9734>>22623500
   IF DEVICE'TYPE1 <> TYPE                                     <<O9734>>22625000
      THEN ALL'SAME'TYPE := FALSE;                             <<O9734>>22626500
   ACCESS'RANGE2 := IF LDT'ACCESS'TYPE = LDT'IO'2'CONCURRENT   <<O9734>>22628000
                       THEN LDT'IO'CONCURRENT                  <<O9734>>22630000
                       ELSE LDT'ACCESS'TYPE;                   <<O9734>>22631000
   IF ACCESS'RANGE1 <> ACCESS'RANGE2                           <<O9734>>22632500
      THEN ALL'SAME'RANGE := FALSE;                            <<O9734>>22634000
                                                               <<O9734>>22635000
   CASE ACCESS'RANGE2 OF                                       <<O9734>>22637000
      BEGIN                                                    <<O9734>>22638500
                                                               <<O9734>>22640000
<<0>> BEGIN                                                    <<O9734>>22641500
      ACCESS'COMBINATION.DIRACC := 1;  <<set bit 15:1>>        <<O9734>>22643000
      IF NOT SDISC'TYPE(TYPE, SUBTYPE)                         <<O9734>>22645000
         THEN CANBESERIAL := FALSE;                            <<O9734>>22646000
      END;                                                     <<O9734>>22647500
                                                               <<O9734>>22649000
<<1>> ACCESS'COMBINATION.SERINP := 1;  <<set bit 14:1>>        <<O9734>>22650000
<<2>> ACCESS'COMBINATION.CONIO  := 1;  <<set bit 13:1>>        <<O9734>>22652000
<<3>> ACCESS'COMBINATION.NCONIO := 1;  <<set bit 12:1>>        <<O9734>>22653500
<<4>> ACCESS'COMBINATION.SEROUT := 1;  <<set bit 11:1>>        <<O9734>>22655000
                                                               <<O9734>>22656500
      END; << OF CASE >>                                       <<O9734>>22658000
   END;  << OF WHILE >>                                        <<O9734>>22659000
                                                               <<O9734>>22660000
   CASE ACCESS'COMBINATION OF                                  <<O9734>>22661000
      BEGIN                                                    <<O9734>>22662500
                                                               <<O9734>>22664000
<<0>>   CLASS'ACCESS'ERROR;                                    <<O9734>>22665000
<<1>>   DIRECT'ACCESS'CHECK;                                   <<O9734>>22667000
<<2>>   SERIAL'INPUT'CHECK;                                    <<O9734>>22668500
<<3>>   CLASS'ACCESS'ERROR;                                    <<O9734>>22670000
<<4>>   CONIO'ACCESS'CHECK;                                    <<O9734>>22671500
<<5>>   CLASS'ACCESS'ERROR;                                    <<O9734>>22673000
<<6>>   SERIAL'INPUT'CHECK;                                    <<O9734>>22675000
<<7>>   CLASS'ACCESS'ERROR;                                    <<O9734>>22676000
<<8>>   NONCONIO'ACCESS'CHECK;                                 <<O9734>>22677500
<<9>>   CLASS'ACCESS'ERROR;                                    <<O9734>>22679000
<<10>>  SERIAL'INPUT'CHECK;                                    <<O9734>>22680000
<<11>>  CLASS'ACCESS'ERROR;                                    <<O9734>>22682000
<<12>>  NONCONIO'ACCESS'CHECK;                                 <<O9734>>22683500
<<13>>  CLASS'ACCESS'ERROR;                                    <<O9734>>22685000
<<14>>  SERIAL'INPUT'CHECK;                                    <<O9734>>22686500
<<15>>  CLASS'ACCESS'ERROR;                                    <<O9734>>22688000
<<16>>  SERIAL'OUTPUT'CHECK;                                   <<O9734>>22690000
<<17>>  CLASS'ACCESS'ERROR;                                    <<O9734>>22691000
<<18>>  CLASS'ACCESS'ERROR;                                    <<O9734>>22692500
<<19>>  CLASS'ACCESS'ERROR;                                    <<O9734>>22694000
<<20>>  SERIAL'OUTPUT'CHECK;                                   <<O9734>>22695000
<<21>>  CLASS'ACCESS'ERROR;                                    <<O9734>>22697000
<<22>>  CLASS'ACCESS'ERROR;                                    <<O9734>>22698500
<<23>>  CLASS'ACCESS'ERROR;                                    <<O9734>>22700000
<<24>>  SERIAL'OUTPUT'CHECK;                                   <<O9734>>22701500
<<25>>  CLASS'ACCESS'ERROR;                                    <<O9734>>22703000
<<26>>  CLASS'ACCESS'ERROR;                                    <<O9734>>22705000
<<27>>  CLASS'ACCESS'ERROR;                                    <<O9734>>22706000
<<28>>  SERIAL'OUTPUT'CHECK;                                   <<O9734>>22707500
<<29>>  CLASS'ACCESS'ERROR;                                    <<O9734>>22709000
<<30>>  CLASS'ACCESS'ERROR;                                    <<O9734>>22709100
<<31>>  CLASS'ACCESS'ERROR;                                    <<O9734>>22709200
<<32>>  CLASS'ACCESS'ERROR;                                    <<O9734>>22709300
                                                               <<O9734>>22709400
        END; << OF GIGANTIC CASE STATEMENT >>                  <<O9734>>22709500
END; << OF DETERMCTYP VERSION 2 >>                             <<O9734>>22710000
      CHECK DEVICE TABLE FOR NON-EXISTENT OUTPUT DEVICES,      <<D9192>>23620000
    MORE THAN ONE DDUMP DEVICE CLASS CONFIGURED, DUPLICATELY   <<D9192>>23622000
                                                               <<O9734>>23876000
        LOGICAL SUBROUTINE CONCURRENT'RANGES;                  <<O9734>>23877000
                                                               <<O9734>>23878000
        BEGIN                                                  <<O9734>>23879000
                                                               <<O9734>>23879100
        IF (LDT'ACCESS'TYPE = LDT'IO'CONCURRENT) AND           <<O9734>>23879200
           (K = LDT'IO'2'CONCURRENT)             OR            <<O9734>>23879300
           (LDT'ACCESS'TYPE = LDT'IO'2'CONCURRENT) AND         <<O9734>>23879400
           (K = LDT'IO'CONCURRENT) THEN                        <<O9734>>23879500
           CONCURRENT'RANGES := TRUE                           <<O9734>>23879600
        ELSE CONCURRENT'RANGES := FALSE;                       <<O9734>>23879700
                                                               <<O9734>>23879800
        END; << SUBROUTINE CONCURRENT'RANGES >>                <<O9734>>23879900
                                                               <<O9734>>23879910
                 ELSE IF TYPE = TERMDEVTYPE OR                <<<O9734>>24770000
                         TYPE = ODIEETYPE   THEN               <<O9734>>24771000
                         TYPE2 = ODIEETYPE    OR               <<O9734>>24781000
                         TYPE2 = ODIEETYPE   OR                <<O9734>>24816000
              IF DCTB'CLASS'NAME = "DDUMP   "  THEN            <<D9192>>24927000
                BEGIN                                          <<D9192>>24927050
                  IF DCT'NUM'DEVICES > 1 THEN                  <<D9192>>24927060
                    BEGIN                                      <<D9192>>24927070
                      MESSAGE(M139); <<MORE THAN ONE DEVICE>>  <<D9192>>24927080
                              <<CONFIGURED WITH CLASS DDUMP>>  <<D9192>>24927085
                      ERRORS := TRUE;                          <<D9192>>24927090
                    END;                                       <<D9192>>24927100
                END;                                           <<D9192>>24927110
              THEN K := LDT'DIRECT'ACCESS                      <<O9734>>24950000
                 K=LDT'IO'CONCURRENT OR                        <<O9734>>24985000
                 K = LDT'IO'2'CONCURRENT THEN                  <<O9734>>24986000
                  IF LDT'ACCESS'TYPE <> K AND                  <<O9734>>25010000
                     NOT CONCURRENT'RANGES THEN                <<O9734>>25011000
                     AND (LDEVRANGE <> LDT'IO'2'CONCURRENT)    <<O9734>>25221000
         FILENUM:=FOPEN(FULLNAME,%(2)10000000011,%(2)11010000);<<T2251>>29835000
              X:=-8;                                           <<c9139>>29865125
              I:=0;                                            <<c9139>>29865250
              DO BEGIN   <<CHECK IF FULLNAME IS A>>            <<c9139>>29867625
                         <<DATACOMM FILE>>                     <<c9139>>29867750
                 IF FILENAME=DATACOMM(X:=X+8),(8)              <<c9139>>29867875
                    THEN RETURN  <<DON'T ADD TO NOT DUMPED>>   <<c9139>>29868000
                                 <<LIST>>                      <<c9139>>29868125
                 END                                           <<c9139>>29868250
              UNTIL (I:=I+1) = NDATACOMM;                      <<c9139>>29868375
      NRENT'BETWEEN'WCS64 = CMD'TAB(8)#,                       << 2404>>31465000
   WCS'RECS'TO'SKIP,          << # WCS RECS AFTER SYSWCS64>>   << 2404>>31516000
      WCSTABPNTR,            <<CURRENT WCSTAB ENTRY POINTER>>  << 2404>>31531000
   EQUATE                                                      << 2404>>31545010
         << TAPE WCS TABLE FORMAT >>                           << 2404>>31545020
      NR'ENTRIES        = 32,                                  << 2404>>31545030
      WCS'ENTRY'SIZE    = 4,                                   << 2404>>31545040
      WCSTAB'SIZE       = NR'ENTRIES*WCS'ENTRY'SIZE,           << 2404>>31545050
                                                               << 2404>>31545060
         << TAPE WCS TABLE ENTRY FORMAT >>                     << 2404>>31545070
      RECS'TO'WCS       = 0, <<TABLE REL. ADDR TO WCS FILE>>   << 2404>>31545080
      RECS'OF'WCS       = 1, <<# OF WCS RECS IN WCS FILE  >>   << 2404>>31545090
      RECS'AFTER'WCS    = 2, <<TOTAL RECS AFTER WCS FILE  >>   << 2404>>31545100
      WCSRECSIZE        = 3, <<NEGATIVE RECORD SIZE       >>   << 2404>>31545110
                                                               << 2404>>31545120
         << ALLOCATION OF ENTRIES IN WCS TABLE >>              << 2404>>31545130
      S64'TAB'X         = 4,                                   << 2404>>31545140
      EXTRA'CP'LEN      = 2;                                   << 2404>>31545150
   INTEGER ARRAY WCSTAB(*)  = STT;                             << 2404>>31546000
                                                               << 2404>>32459000
Comment begin                                                           32459100
  The CT array is the Channel program record Table.  The                32459110
table begins at CMD'TAB(%50).  Each entry is two words.                 32459120
The first word is the record number in the channel program              32459130
file.  The second word is the length of channel program                 32459140
words in the record.                                                    32459150
                                                                        32459160
            Channel program record Table(CT Array)                      32459170
+------+--------+--------+---------+---------+--------+--------+        32459180
|Memory|Last    |Last    |Last S/64|Last S/64|Coldload|Coldload|        32459190
|Offset|WCS     |WCS     |WCS      |WCS      |Record  |Record  |        32459200
|Table |Record+2|Record+1|Record+2 |Record+1 |   1    |  0     |        32459210
+------+--------+--------+---------+---------+--------+--------+        32459220
                                                                        32459230
|<-   NRENT'AFTER'WCS  ->| NRENT'BETWEEN'WCS | NRENT'BEFORE'WCS|        32459240
                                                                        32459250
Comment end;                                                            32459260
                                                                        32459270
   SAVE'IT(FALSE,CPSIZE);  <<CP REC AS MEMORY OFFSET TABLE>>   << 2404>>32545000
   SAVE'IT(FALSE,CPSIZE);  <<CP REC AT LAST WCS REC + 2>>      << 2404>>32595000
   SAVE'IT(FALSE,128);     <<CP REC AT LAST WCS REC + 1>>      << 2404>>32650000
BUILD'AMIGO'SKIP:                                              << 2404>>32680000
   <<This IF statement adds a channel program after dumping >> << 2404>>32680100
   <<SYSWCS64 to tape.  The WCS Lookup Table is modified to >> << 2404>>32680200
   <<reflect the RECS'TO'WCS file pointers for files dumped >> << 2404>>32680300
   <<after SYSWCS64.  The channel program is needed to fool >> << 2404>>32680400
   <<Series 6X/70 systems into believing there are no more  >> << 2404>>32680500
   <<WCS records to skip.  This is important when Series 6X >> << 2404>>32680600
   <<systems are coldloaded using HP7976 tape drive.  More  >> << 2404>>32680700
   <<than 3 WCS files on tape causes the Series 6X/70 to    >> << 2404>>32680800
   <<timeout during MPL.                                    >> << 2404>>32680900
                                                               << 2404>>32681000
   IF WCSTAB(S64'TAB'X*WCS'ENTRY'SIZE+RECS'OF'WCS)<>0 THEN     << 2404>>32681100
      BEGIN   << ADD CHANNEL PROGRAM BEHIND SYSWCS64>>         << 2404>>32681200
      @CTPNTR := @CMD'TAB(BEG'OF'STACK                         << 2404>>32681300
         +(NRENT'AFTER'WCS+NRENT'BETWEEN'WCS)*2);              << 2404>>32681400
      BASE := BASE2;                                           << 2404>>32681500
      MOVE LBUF := CHAN'PGM'BASE,(CPBASE'STD'LEN),2;           << 2404>>32681600
      @CPPNTR := TOS;                                          << 2404>>32681700
      LBUF(CPBASE'STAT'X) := BASE+CPBASE'STAT'BUF;             << 2404>>32681800
                                                               << 2404>>32681900
      WCS'RECS'TO'SKIP:=0;                                     << 2404>>32682000
      @WCSTABPNTR := @WCSTAB;                                  << 2404>>32682100
      WHILE @WCSTABPNTR <> @WCSTAB(WCSTAB'SIZE) DO             << 2404>>32682200
        BEGIN                                                  << 2404>>32682300
        IF @WCSTABPNTR<>@WCSTAB(S64'TAB'X*WCS'ENTRY'SIZE) THEN << 2404>>32682400
           WCS'RECS'TO'SKIP:=                                  << 2404>>32682500
                WCS'RECS'TO'SKIP+WCSTABPNTR(RECS'OF'WCS);      << 2404>>32682600
        @WCSTABPNTR:=@WCSTABPNTR(WCS'ENTRY'SIZE);              << 2404>>32682700
        END;                                                   << 2404>>32682800
                                                               << 2404>>32682900
      TOS:=WCS'RECS'TO'SKIP;                                   << 2404>>32683000
      IF <> THEN SKIP(WCS'RECS'TO'SKIP);                       << 2404>>32683100
      READ(0,BASE1,128,BASE1+CPBASE'ENTRY);                    << 2404>>32683200
      CPSIZE := @CPPNTR-@LBUF;                                 << 2404>>32683300
      SAVE'IT(TRUE,CPSIZE);<<CP REC AT LAST SYSWCS64 REC + 2>> << 2404>>32683400
                                                               << 2404>>32683500
      BASE := BASE1;                                           << 2404>>32683600
      ZEROBUF(LBUF,128);      << ZERO LBUF >>                  << 2404>>32683700
      MOVE LBUF := CHAN'PGM'BASE,(CPBASE'FST'LEN),2;           << 2404>>32683800
      @CPPNTR := TOS;                                          << 2404>>32683900
      LBUF(CPBASE'STAT'X) := BASE+CPBASE'STAT'BUF;             << 2404>>32684000
      READ(0,BASE2,CPSIZE,BASE2+CPBASE'ENTRY);                 << 2404>>32684100
      LBUF := CHECKSUM(LBUF,128,SEED);                         << 2404>>32684200
      SAVE'IT(TRUE,128);   <<CP REC AT LAST SYSWCS64 REC + 1>> << 2404>>32684300
                                                               << 2404>>32684400
      <<Calling SAVE'IT twice has made NRENT'BEFORE'WCS and >> << 2404>>32684500
      <<NR'RECS larger(by 2), than desired.  So, now they   >> << 2404>>32684600
      <<are corrected below.                                >> << 2404>>32684700
      NR'RECS:=NR'RECS-EXTRA'CP'LEN;                           << 2404>>32684800
      NRENT'BEFORE'WCS:=NRENT'BEFORE'WCS-EXTRA'CP'LEN;         << 2404>>32684900
      NRENT'BETWEEN'WCS64:=EXTRA'CP'LEN;                       << 2404>>32685000
      END;    << ADD CHANNEL PROGRAM BEHIND SYSWCS64>>         << 2404>>32685100
                                                               << 2404>>32685200
   @CTPNTR:=@CMD'TAB(BEG'OF'STACK                              << 2404>>32689000
   +(NRENT'AFTER'WCS+NRENT'BETWEEN'WCS64+NRENT'BEFORE'WCS)*2); << 2404>>32690000
$EDIT VOID=36915000                                            <<T1777>>35725000
INTEGER PROCEDURE COMPUTE'WCS'SIZE(CMD'TAB);                   << 2404>>35729000
INTEGER ARRAY                      CMD'TAB;                    << 2404>>35730000
BEGIN                                                          <<T1777>>35733000
EQUATE                                                         <<T1777>>35737000
      << TAPE WCS TABLE FORMAT >>                              <<T1777>>35741000
   NR'ENTRIES        = 32,                                     <<T1777>>35745000
   ENTRY'SIZE        = 4,                                      <<T1777>>35749000
   WCSTAB'SIZE       = NR'ENTRIES*ENTRY'SIZE,                  <<T1777>>35753000
                                                               <<T1777>>35757000
      << TAPE WCS TABLE ENTRY FORMAT >>                        <<T1777>>35761000
   RECS'TO'WCS       = 0,  << TABLE REL. ADDR TO WCS FILE    >><<T1777>>35765000
   RECS'OF'WCS       = 1,  << # OF WCS RECS IN WCS FILE      >><<T1777>>35769000
   RECS'AFTER'WCS    = 2,  << TOTAL # OF RECS AFTER WCS FILE >><<T1777>>35773000
   WCSRECSIZE        = 3,  << NEGATIVE RECORD SIZE           >><<T1777>>35777000
                                                               <<T1777>>35781000
      << ALLOCATION OF ENTRIES IN WCS TABLE >>                 <<T1777>>35785000
   S64'TAB'X         = 4,                                      <<T1777>>35789000
   S37'TAB'X         = 5,                                      <<T1777>>35793000
   S45'TAB'X         = 6,                                      <<W1963>>35797000
   S35'TAB'X         = 7,                                      <<W1963>>35801000
                                                               <<T1777>>35805000
      << ALLOCATION OF DISC WCS POINTER ENTRIES >>             <<T1777>>35809000
   S64'WCS'DISC'X    = 0,                                      <<T1777>>35813000
   S37'WCS'DISC'X    = 1,                                      <<T1777>>35817000
   S45'WCS'DISC'X    = 2,                                      <<W1963>>35821000
   S35'WCS'DISC'X    = 3,                                      << 2404>>35825000
                                                               << 2404>>35828100
   EXTRA'CP'LEN      = 2;  <<Lgth of CP following SYSWCS64>>   << 2404>>35828200
                                                               <<T1777>>35829000
DOUBLE ARRAY DISCWCSTAB(*)     = LBUF(%25);                    <<T1777>>35833000
                                                               <<T1777>>35837000
INTEGER                                                        <<T1777>>35841000
   FNUM,                                                       <<T1777>>35845000
   ERRNR,                                                      <<T1777>>35849000
   LEN,                                                        <<T1777>>35853000
   REC,                                                        <<T1777>>35857000
   TOTAL'WCS'RECS = COMPUTE'WCS'SIZE,                          <<T1777>>35861000
   WCSTAPERECSIZE, << IML(S/64) MICROCODE LIMITS THE      >>   <<T1777>>35865000
                   << RECORD SIZES TO 1024,2048,3072,4096 >>   <<T1777>>35869000
   TEMP,                                                       <<T1777>>35873000
   S0 = S-0,                                                   <<T1777>>35877000
   X = X;                                                      <<T1777>>35881000
                                                               <<T1777>>35885000
DOUBLE DISCADDRESS;                                            <<T1777>>35889000
                                                               <<T1777>>35893000
ENTRY DUMP'WCS; <<called after writing WCS Table to tape>>     <<T1777>>35897000
                                                               <<T1777>>35901000
INTEGER POINTER                                                << 2404>>35905000
   WCSTABPNTR,        << POINTS TO CURRENT WCSTAB ENTRY >>     << 2404>>35905100
   CTPNTR;            << POINTS TO CURRENT CT ENTRY     >>     << 2404>>35905200
                                                               <<T1777>>35909000
BYTE ARRAY FILENAME(0:8);                                      <<T1777>>35913000
                                                               <<T1777>>35917000
INTEGER ARRAY REC0(*)    = LBUF(4096);                         <<T1777>>35921000
INTEGER ARRAY WCSTAB(*)  = STT;                                <<T1777>>35925000
INTEGER ARRAY WCSFNUM(*) = STT(WCSTAB'SIZE);                   <<T1777>>35929000
                                                               <<T1777>>35933000
   <<      S/64 WCS CONSTANTS       >>                         <<T1777>>35937000
DOUBLE ARRAY DREC0(*) = REC0;                                  <<T1777>>35941000
                                                               <<T1777>>35945000
DEFINE                                                         <<T1777>>35949000
   NR'WCS'LOCS       = DREC0(2)#,                              <<T1777>>35953000
   NR'LUT'LOCS       = DREC0(3)#;                              <<T1777>>35957000
                                                               <<T1777>>35961000
BYTE ARRAY S64WCSNAME(0:8);  << S/64 >>                        <<T1777>>35965000
                                                               <<T1777>>35969000
   <<  Low End Family WCS Constants >>                         <<T1777>>35973000
DEFINE                                                         <<T1777>>35977000
   NR'SLOW'WCS       = DREC0(2)#,                              <<T1777>>35981000
   NR'FAST'WCS       = DREC0(3)#;                              <<T1777>>35985000
                                                               <<T1777>>35989000
BYTE ARRAY S37WCSNAME(0:8),  << S/37 >>                        <<T1777>>35993000
           S45WCSNAME(0:8),  << S/45 >>                        <<W1963>>35997000
           S35WCSNAME(0:8);  << S/35 >>                        <<W1963>>36001000
DEFINE                                                         << 2404>>36005000
   CMD'FNUM              = CMD'TAB#,                           << 2404>>36005100
   NEXT'REC              = CMD'TAB(1)#,                        << 2404>>36005200
   REC'BEFORE'INITIAL    = CMD'TAB(2)#,                        << 2404>>36005300
   NRENT'AFTER'WCS       = CMD'TAB(3)#,                        << 2404>>36005400
   NRENT'BEFORE'WCS      = CMD'TAB(4)#,                        << 2404>>36005500
   AMIGO'REC'1           = CMD'TAB(5)#,                        << 2404>>36005600
   AMIGO'REC'2           = CMD'TAB(6)#,                        << 2404>>36005700
   WCS'REC'BEFORE'INIT   = CMD'TAB(7)#,                        << 2404>>36005800
   NRENT'BETWEEN'WCS64   = CMD'TAB(8)#,                        << 2404>>36005900
   AMIGO'REC'BEFORE'INIT = CMD'TAB(9)#,                        << 2404>>36006000
   BEG'OF'STACK          = 40#,                                << 2404>>36006100
   REC'CT                = CTPNTR#,                            << 2404>>36006200
   LEN'CT                = CTPNTR(1)#;                         << 2404>>36006300
                                                               << 2404>>36006400
SUBROUTINE DUMP'IT(WORDS);                                     <<T1777>>36009000
   VALUE           WORDS;                                      <<T1777>>36013000
   DOUBLE          WORDS;                                      <<T1777>>36017000
BEGIN                                                          <<T1777>>36021000
WHILE WORDS > 0D DO                                            <<T1777>>36025000
   BEGIN                                                       <<T1777>>36029000
   LEN := IF WORDS > DOUBLE(WCSTAPERECSIZE) THEN               <<T1777>>36033000
          WCSTAPERECSIZE ELSE LOGICAL(WORDS);                  <<T1777>>36037000
   FREADDIR(FNUM,LBUF,LEN,DOUBLE(REC));                        <<T1777>>36041000
   IF <> THEN FERROR(FNUM,FULLNAME);                           <<T1777>>36045000
   WRITETAPE(LBUF,LEN,0);                                      <<T1777>>36049000
   WORDS := WORDS-DOUBLE(LEN);                                 <<T1777>>36053000
   REC := REC+(LEN+127)/128;                                   <<T1777>>36057000
   END;                                                        <<T1777>>36061000
END;    << Subroutine DUMP'IT >>                               <<T1777>>36065000
                                                               <<T1777>>36069000
SUBROUTINE UPDATE'SECT0(WCS'DISC'X);                           <<T1777>>36073000
   VALUE                WCS'DISC'X;                            <<T1777>>36077000
   INTEGER              WCS'DISC'X;                            <<T1777>>36081000
BEGIN                                                          <<T1777>>36085000
BLOCKN := BLOCKN+1;                                            <<T1777>>36089000
TEMP := FINDSDISCGAP(SDISCLDEV,BLOCKN,DISCADDRESS);            <<T1777>>36093000
IF TEMP <> 0 THEN FERROR(TAPEFNUM,TAPEFILE);                   <<T1777>>36097000
TOS := P'ATTACHIO(SDISCLDEV,0,0,@LBUF,0,128,0,0,1);            <<T1777>>36101000
IOERRCHECK(*,*);                                               <<T1777>>36105000
DISCWCSTAB(WCS'DISC'X) := L'PADR(DISCADDRESS);                 <<T1777>>36109000
TOS := P'ATTACHIO(SDISCLDEV,0,0,@LBUF,11,128,0,0,1);           <<T1777>>36113000
IOERRCHECK(*,*);                                               <<T1777>>36117000
END;    << Subroutine UPDATE'SECT0 >>                          <<T1777>>36121000
                                                               <<T1777>>36125000
SUBROUTINE LE'WCS'SIZE(LE'TAB'X,LE'WCSNAME);                   <<T1777>>36129000
   VALUE               LE'TAB'X;                               <<T1777>>36133000
   INTEGER             LE'TAB'X;                               <<T1777>>36137000
   BYTE ARRAY                   LE'WCSNAME;                    <<T1777>>36141000
                                                               <<T1777>>36145000
<< The subroutine calculates the number of record from   >>    <<T1777>>36149000
<< the WCS table to a WCS file, the number of records in >>    <<T1777>>36153000
<< the WCS file and it's record size.  The record size   >>    <<T1777>>36157000
<< is in 2's complement form.  These values are saved in >>    <<T1777>>36161000
<< the WCS Table.  The Records after WCS is filled in by >>    <<T1777>>36165000
<< the section of code marked "FILL IN RECORDS AFTER....">>    <<T1777>>36169000
                                                               <<T1777>>36173000
BEGIN   << SUBROUTINE LE'WCS'SIZE >>                           <<T1777>>36177000
@WCSTABPNTR := @WCSTAB(LE'TAB'X*ENTRY'SIZE);                   <<T1777>>36181000
MOVE FILENAME := LE'WCSNAME,(9);                               <<T1777>>36185000
SEARCH'SYSFILE(FILENAME);                                      <<T1777>>36189000
FNUM := FOPEN(FULLNAME,3,%420);                                <<T1777>>36193000
IF <> THEN                                                     <<T1777>>36197000
   BEGIN                                                       <<T1777>>36201000
   FCHECK(FNUM,ERRNR);                                         <<T1777>>36205000
   IF ERRNR <> 52 THEN FERROR(FNUM,FULLNAME);                  <<T1777>>36209000
   END                                                         <<T1777>>36213000
ELSE                                                           <<T1777>>36217000
   BEGIN                                                       <<T1777>>36221000
   FREAD(FNUM,REC0,128);                                       <<T1777>>36225000
   IF < THEN FERROR(WCSFNUM,FULLNAME);                         <<T1777>>36229000
   IF > THEN FCLOSE(FNUM,0,0)                                  <<T1777>>36233000
   ELSE                                                        <<T1777>>36237000
      BEGIN                                                    <<T1777>>36241000
      WCSTABPNTR(RECS'TO'WCS) := TOTAL'WCS'RECS;               <<W2254>>36245000
      TOS := (NR'SLOW'WCS*4D+DOUBLE(WCSTAPERECSIZE)-1D)/       <<T1777>>36249000
         DOUBLE(WCSTAPERECSIZE) + (NR'FAST'WCS*4D+             <<T1777>>36253000
         DOUBLE(WCSTAPERECSIZE)-1D)/DOUBLE(WCSTAPERECSIZE);    <<T1777>>36257000
      IF <> THEN TOS := TOS+1; << RECORD 0 >>                  <<T1777>>36261000
      WCSTABPNTR(RECS'OF'WCS) := S0;                           <<T1777>>36265000
                                                               <<T1777>>36269000
<< IF WCSTAPRECSIZE=4096 THEN WCSTABPNTR(WCSRECSIZE)=%170000 >><<T1777>>36273000
      WCSTABPNTR(WCSRECSIZE) := -WCSTAPERECSIZE;               <<T1777>>36277000
      TOTAL'WCS'RECS := TOTAL'WCS'RECS+TOS;                    <<T1777>>36281000
      DEL;                                                     <<T1777>>36285000
      WCSFNUM(LE'TAB'X) := FNUM;                               <<T1777>>36289000
      END;                                                     <<T1777>>36293000
   END;                                                        <<T1777>>36297000
END;    << SUBROUTINE LE'WCS'SIZE >>                           <<T1777>>36301000
                                                               <<T1777>>36305000
SUBROUTINE DUMP'LE'WCS(LE'TAB'X,LE'WCS'DISC'X,LE'WCSNAME);     <<T1777>>36309000
   VALUE               LE'TAB'X,LE'WCS'DISC'X;                 <<T1777>>36313000
   INTEGER             LE'TAB'X,LE'WCS'DISC'X;                 <<T1777>>36317000
   BYTE ARRAY                                 LE'WCSNAME;      <<T1777>>36321000
                                                               <<T1777>>36325000
<<  This subroutine copies REC 0 from the SYSWCS file onto >>  <<T1777>>36329000
<< the dumptape.  It then writes out SLOW WCS followed by  >>  <<T1777>>36333000
<< FAST WCS. Finally, it writes an END-OF-CONTIGUOUS-BLOCK >>  <<T1777>>36337000
<< mark.  For cartridge tapes, the gap table is updated.   >>  <<T1777>>36341000
                                                               <<T1777>>36345000
BEGIN   << DUMP'LE'WCS >>                                      <<T1777>>36349000
MOVE FILENAME := LE'WCSNAME,(9);                               <<T1777>>36353000
SEARCH'SYSFILE(FILENAME);                                      <<T1777>>36357000
FNUM := WCSFNUM(LE'TAB'X);                                     <<T1777>>36361000
IF FNUM <> 0 THEN                                              <<T1777>>36365000
   BEGIN                                                       <<T1777>>36369000
   FREADDIR(FNUM,REC0,128,0D);                                 <<T1777>>36373000
   IF <> THEN FERROR(FNUM,FULLNAME);                           <<T1777>>36377000
   FWRITE(TAPEFNUM,REC0,128,%1001);  << RECORD 0 >>            <<T1777>>36381000
   IF <> THEN FERROR(TAPEFNUM,TAPEFILE);                       <<T1777>>36385000
   REC := 1;                                                   <<T1777>>36389000
   DUMP'IT(NR'SLOW'WCS&DLSL(2));    << SLOW WCS >>             <<T1777>>36393000
   DUMP'IT(NR'FAST'WCS&DLSL(2));    << FAST WCS >>             <<T1777>>36397000
   FWRITE(TAPEFNUM,REC0,0,%2001);    << END CONTIG BLK >>      <<T1777>>36401000
   IF <> THEN FERROR(TAPEFNUM,TAPEFILE);                       <<T1777>>36405000
   FCLOSE(FNUM,0,0);                                           <<T1777>>36409000
$EDIT VOID=36410000                                            <<W2254>>36410000
   IF NOT MAGTAPE THEN                                         <<T1777>>36413000
      UPDATE'SECT0(LE'WCS'DISC'X);                             <<T1777>>36417000
   END;                                                        <<T1777>>36421000
END;    << DUMP'LE'WCS >>                                      <<T1777>>36425000
                                                               <<T1777>>36429000
                                                               <<T1777>>36433000
<< ROUND TAPERECSIZE TO 1024,2048,3072,4096 DUE TO S/64 UCODE>><<T1777>>36437000
WCSTAPERECSIZE := LOGICAL(TAPERECSIZE) LAND %16000;            <<T1777>>36441000
ZEROBUF(WCSFNUM,NR'ENTRIES);                                   <<T1777>>36445000
ZEROBUF(WCSTAB,WCSTAB'SIZE);                                   <<T1777>>36449000
                                                               <<T1777>>36453000
MOVE S64WCSNAME := "SYSWCS64 ";  << S/64 >>                    <<T1777>>36457000
MOVE S37WCSNAME := "SYSWCS37 ";  << S/37 >>                    <<T1777>>36461000
MOVE S45WCSNAME := "WCSLE1   ";  << S/45 >>                    <<W1963>>36465000
MOVE S35WCSNAME := "WCSLE2   ";  << S/35 >>                    <<W1963>>36469000
                                                               <<T1777>>36473000
<<    S/64 WCS SIZE                                >>          <<T1777>>36477000
                                                               <<T1777>>36481000
@WCSTABPNTR := @WCSTAB(S64'TAB'X*ENTRY'SIZE);                  <<T1777>>36485000
MOVE FILENAME := S64WCSNAME,(9);                               <<T1777>>36489000
SEARCH'SYSFILE(FILENAME);                                      <<T1777>>36493000
FNUM := FOPEN(FULLNAME,3,%420);                                <<T1777>>36497000
IF <> THEN                                                     <<T1777>>36501000
   BEGIN                                                       <<T1777>>36505000
   FCHECK(FNUM,ERRNR);                                         <<T1777>>36509000
   IF ERRNR <> 52 THEN FERROR(FNUM,FULLNAME);                  <<T1777>>36513000
   END                                                         <<T1777>>36517000
ELSE                                                           <<T1777>>36521000
   BEGIN   << Successful FOPEN >>                              <<T1777>>36525000
   FREAD(FNUM,REC0,128);                                       <<T1777>>36529000
   IF < THEN FERROR(WCSFNUM,FULLNAME);                         <<T1777>>36533000
   IF > THEN FCLOSE(FNUM,0,0)                                  <<T1777>>36537000
   ELSE                                                        <<T1777>>36541000
      BEGIN   << Successful FREAD >>                           <<T1777>>36545000
      WCSTABPNTR(RECS'TO'WCS) := TOTAL'WCS'RECS;               <<T1777>>36549000
      TOS := (NR'WCS'LOCS*4D+DOUBLE(WCSTAPERECSIZE)-1D)/       <<T1777>>36553000
         DOUBLE(WCSTAPERECSIZE) + (NR'LUT'LOCS*2D+             <<T1777>>36557000
         DOUBLE(WCSTAPERECSIZE)-1D)/DOUBLE(WCSTAPERECSIZE);    <<T1777>>36561000
      IF <> THEN TOS := TOS+1; << RECORD 0 >>                  <<T1777>>36565000
      WCSTABPNTR(RECS'OF'WCS) := S0;                           <<T1777>>36569000
      WCSTABPNTR(WCSRECSIZE) := -WCSTAPERECSIZE;               <<T1777>>36573000
      TOTAL'WCS'RECS := TOTAL'WCS'RECS+TOS+EXTRA'CP'LEN;       << 2404>>36577000
      DEL;                                                     <<T1777>>36581000
      WCSFNUM(S64'TAB'X) := FNUM;                              <<T1777>>36585000
      END;    << Successful FREAD >>                           <<T1777>>36589000
   END;    << Successful FOPEN >>                              <<T1777>>36593000
                                                               <<T1777>>36597000
<<***************************************************>>        <<T1777>>36601000
<<            Low End Family WCS Size                >>        <<T1777>>36605000
<<***************************************************>>        <<T1777>>36609000
                                                               <<T1777>>36613000
LE'WCS'SIZE(S37'TAB'X,S37WCSNAME);                             <<T1777>>36617000
LE'WCS'SIZE(S45'TAB'X,S45WCSNAME);                             <<W1963>>36621000
LE'WCS'SIZE(S35'TAB'X,S35WCSNAME);                             <<W1963>>36625000
                                                               <<T1777>>36629000
<<**************************************************>>         <<T1777>>36633000
<<    FILL IN RECORDS AFTER WCS IN WCS TABLE        >>         <<T1777>>36637000
<<**************************************************>>         <<T1777>>36641000
@WCSTABPNTR := @WCSTAB;                                        <<T1777>>36645000
WHILE @WCSTABPNTR <> @WCSTAB(WCSTAB'SIZE) DO                   <<T1777>>36649000
   BEGIN                                                       <<T1777>>36653000
   WCSTABPNTR(RECS'AFTER'WCS) :=                               << 2404>>36656000
      IF @WCSTABPNTR=@WCSTAB(S64'TAB'X*ENTRY'SIZE)             << 2404>>36657000
         AND WCSTABPNTR(RECS'OF'WCS)<>0 THEN                   << 2404>>36658000
         0 <<A channel program follows SYSWCS64>>              << 2404>>36659000
      ELSE                                                     << 2404>>36660000
         TOTAL'WCS'RECS-WCSTABPNTR(RECS'TO'WCS)                << 2404>>36661000
         -WCSTABPNTR(RECS'OF'WCS);                             << 2404>>36662000
   @WCSTABPNTR := @WCSTABPNTR(ENTRY'SIZE);                     <<T1777>>36665000
   END;                                                        <<T1777>>36669000
                                                               <<T1777>>36673000
<< ADD IN LENGTH OF WCS TABLE >>                               <<T1777>>36677000
TOTAL'WCS'RECS := TOTAL'WCS'RECS+1;                            <<T1777>>36681000
                                                               <<T1777>>36685000
RETURN;                                                        <<T1777>>36689000
                                                               <<T1777>>36693000
$PAGE                                                          <<T1777>>36697000
DUMP'WCS:   << WCS DUMP ENTRY POINT >>                         <<T1777>>36701000
                                                               <<T1777>>36705000
<< ROUND TAPERECSIZE TO 1024,2048,3072,4096 >>                 <<T1777>>36709000
WCSTAPERECSIZE := LOGICAL(TAPERECSIZE) LAND %16000;            <<T1777>>36713000
                                                               <<T1777>>36717000
<< Re-initialize arrays, because we entered thru DUMP'WCS >>   <<T1777>>36721000
MOVE S64WCSNAME := "SYSWCS64 ";  << S/64 >>                    <<T1777>>36725000
MOVE S37WCSNAME := "SYSWCS37 ";  << S/37 >>                    <<T1777>>36729000
MOVE S45WCSNAME := "WCSLE1   ";  << S/45 >>                    <<W1963>>36733000
MOVE S35WCSNAME := "WCSLE2   ";  << S/35 >>                    <<W1963>>36737000
                                                               <<T1777>>36741000
<<***************************************************>>        <<T1777>>36745000
<<   WRITE WCS FILES TO TAPE/SERIAL DISC             >>        <<T1777>>36749000
<<***************************************************>>        <<T1777>>36753000
                                                               <<T1777>>36757000
IF MAGTAPE THEN                                                <<T1777>>36761000
   BEGIN                                                       <<T1777>>36765000
   FWRITE(TAPEFNUM,WCSTAB,WCSTAB'SIZE,0); << WCS TABLE >>      <<T1777>>36769000
   IF <> THEN FERROR(TAPEFNUM,TAPEFILE);                       <<T1777>>36773000
   END;                                                        <<T1777>>36777000
                                                               <<T1777>>36781000
<<***************************************************>>        <<T1777>>36785000
<<     DUMP S/64 WCS TO TAPE/SERIAL DISC             >>        <<T1777>>36789000
<<***************************************************>>        <<T1777>>36793000
                                                               <<T1777>>36797000
MOVE FILENAME := S64WCSNAME,(9);                               <<T1777>>36801000
SEARCH'SYSFILE(FILENAME);                                      <<T1777>>36805000
FNUM := WCSFNUM(S64'TAB'X);                                    <<T1777>>36809000
IF FNUM <> 0 THEN                                              <<T1777>>36813000
   BEGIN                                                       <<T1777>>36817000
   FREADDIR(FNUM,REC0,128,0D);                                 <<T1777>>36821000
   IF <> THEN FERROR(FNUM,FULLNAME);                           <<T1777>>36825000
   FWRITE(TAPEFNUM,REC0,128,%1001);  << RECORD 0 >>            <<T1777>>36829000
   IF <> THEN FERROR(TAPEFNUM,TAPEFILE);                       <<T1777>>36833000
   REC := 1;                                                   <<T1777>>36837000
   DUMP'IT(NR'WCS'LOCS&DLSL(2));                               <<T1777>>36841000
   DUMP'IT(NR'LUT'LOCS&DLSL(1));    << LUT >>                  <<T1777>>36845000
   FWRITE(TAPEFNUM,REC0,0,%2001);    << END CONTIG BLK >>      <<T1777>>36849000
   IF <> THEN FERROR(TAPEFNUM,TAPEFILE);                       <<T1777>>36853000
   FCLOSE(FNUM,0,0);                                           <<T1777>>36857000
   IF NOT MAGTAPE THEN                                         <<T1777>>36861000
      UPDATE'SECT0(S64'WCS'DISC'X);                            <<T1777>>36865000
                                                               << 2404>>36865100
   <<*****************************************************>>   << 2404>>36865200
   <<Write 2 channes program records behind SYSWCS64. This>>   << 2404>>36865300
   <<prevents the DCU from timing out while MPL is loading>>   << 2404>>36865400
   <<SYSWCS64 and skipping all other WCS records.         >>   << 2404>>36865500
   <<*****************************************************>>   << 2404>>36865600
   @CTPNTR := @CMD'TAB(BEG'OF'STACK                            << 2404>>36865700
              +(NRENT'AFTER'WCS+NRENT'BETWEEN'WCS64)*2);       << 2404>>36865800
                                                               << 2404>>36865900
   TOS := NRENT'BETWEEN'WCS64;                                 << 2404>>36866000
   WHILE <> DO                                                 << 2404>>36866100
      BEGIN                                                    << 2404>>36866200
      @CTPNTR := @CTPNTR(-2);                                  << 2404>>36866300
      FREADDIR(CMD'FNUM,LBUF,LEN'CT,DOUBLE(REC'CT));           << 2404>>36866400
      WRITETAPE(LBUF,LEN'CT,1);                                << 2404>>36866500
      TOS := TOS-1;                                            << 2404>>36866600
      END;                                                     << 2404>>36866700
   END;                                                        <<T1777>>36869000
                                                               <<T1777>>36873000
<<***************************************************>>        <<T1777>>36877000
<<   DUMP LE WCS Family files to TAPE/SERIAL DISC    >>        <<T1777>>36881000
<<***************************************************>>        <<T1777>>36885000
                                                               <<T1777>>36889000
DUMP'LE'WCS(S37'TAB'X,S37'WCS'DISC'X,S37WCSNAME);              <<T1777>>36893000
DUMP'LE'WCS(S45'TAB'X,S45'WCS'DISC'X,S45WCSNAME);              <<W1963>>36897000
DUMP'LE'WCS(S35'TAB'X,S35'WCS'DISC'X,S35WCSNAME);              <<W1963>>36901000
END;    << COMPUTE'WCS'SIZE >>                                 <<T1777>>36905000
      ERRNUM := XRETPMASK(DESIG(DESIG'POS),DUMMY,DUMMY,DUMMY,  <<A9734>>40490000
$EDIT VOID=41175200                                                     41175100
                                                                        41175300
INTEGER PROCEDURE CHECKLABEL;                                  <<L1056>>41176000
                                                               <<L1056>>41176200
<<PROCEDURE TO CALL  PROCEDURE XRETJTENTRY OF JOBTABLE TO >>   <<L1056>>41176400
<<OBTAIN LABELLED TAPE INFO  IF IT'S DECLARED IN THE FILE  >>  <<L1056>>41176600
<<EQUATION FOR SYSDUMP. THIS INFO IS FOUND IN THE PMASK WORD >><<L1056>>41176800
<<OF JFEQ. IF LABELLED TAPE  IS FOUND, THEN SYSDUMP WILL  >>   <<L1056>>41177000
<<BE ABORTED.   >>                                             <<L1056>>41177200
                                                                        41177300
BEGIN                                                          <<L1056>>41177400
INTEGER PMASK2,                                                <<L1056>>41178200
        SIZE;                                                  <<L1056>>41179000
                                                               <<L1056>>41179200
INTEGER FOUND;                                                 <<L1056>>41179400
                                                               <<L1056>>41179600
DEFINE     PMASK'INDEX = INFO(0).(8:8)+2#,                     <<L1056>>41179700
           << PMASK INDEX OBTAINED BY THE SIZE OF FILENAME   >><<L1056>>41179710
           << PLUS THE FIRST WORD OF JFEQ TABLE PLUS THE     >><<L1056>>41179720
           << FIRST WORD OF PMASK ITSELF. WE WANT THE 2ND    >><<L1056>>41179730
           << WORD OF PMASK                                  >><<L1056>>41179740
           LABEL'MASK = PMASK2.(1:1)# ; <<BIT 1 OF THE 2ND   >><<L1056>>41179750
                                        <<WORD OF PMASK      >><<L1056>>41179760
INTEGER ARRAY INFO(0:49); <<FOR INFO OF JFEQ. TABLE >>         <<L1056>>41179800
BYTE ARRAY BINFO(*)=INFO;                                      <<L1056>>41180000
BYTE ARRAY DTAPE(0:7);    <<CONTAIN FILENAME "DUMPTAPE">>      <<L1056>>41180200
                                                               <<L1056>>41180400
BYTE ARRAY DUMMY(0:1);                                         <<L1056>>41180600
                                                               <<L1056>>41180800
MOVE DTAPE:= "DUMPTAPE";                                       <<L1056>>41181000
MOVE DUMMY := "  " ;                                           <<L1056>>41181200
FOUND := XRETJTENTRY(DTAPE,DUMMY,DUMMY,DUMMY,SIZE,INFO);       <<L1056>>41181800
IF FOUND = 0 THEN                                              <<L1056>>41182000
   BEGIN                                                       <<L1056>>41182200
   PMASK2 := INFO(PMASK'INDEX);  <<LOOK AT WORD 2 OF PMASK>>   <<L1056>>41183000
   CHECKLABEL:= LABEL'MASK;                                    <<L1056>>41183400
   END                                                         <<L1056>>41183600
ELSE IF FOUND = 1 THEN  <<ENTRY GIVEN CANNOT BE FOUND>>        <<L1056>>41183800
   CHECKLABEL:= 2                                              <<L1056>>41184000
ELSE  << FOUND IS 2 >> <<ENTRY POINTING TO NON_EXISTING ENTRY>><<L1056>>41184200
   CHECKLABEL:= 3;                                             <<L1056>>41184400
                                                               <<L1056>>41184600
END; <<END OF CHECKLABEL>>                                     <<L1056>>41184800
CHECK2,                                                        <<L1056>>41280100
CHECK2 := CHECKLABEL ; <<CHECK LABELLED TAPE>>                 <<L1056>>41465100
IF CHECK2 = 1 THEN <<IF FOUND LABELLED TAPE THEN ABORT>>       <<L1056>>41465200
   BEGIN                                                       <<L1056>>41465300
   MESSAGE(M460);  << " LABELLED TAPE NOT ALLOWED." >>         <<L1056>>41465400
   QUIT(0);       << SYSDUMP ABORTED  >>                       <<L1056>>41465500
   END                                                         <<L1056>>41465600
ELSE IF CHECK2 = 2 THEN                                        <<L1056>>41465700
   BEGIN                                                       <<L1056>>41465800
   MESSAGE (461);<< "DUMPTAPE" CANNOT BE FOUND>>               <<L1056>>41465900
   QUIT(0);                                                    <<L1056>>41466000
   END                                                         <<L1056>>41466100
ELSE IF CHECK2 = 3 THEN                                        <<L1056>>41466200
   BEGIN                                                       <<L1056>>41466300
   MESSAGE (462);<<ENTRY POINTING TO NON_EXISTING ENTRY>>      <<L1056>>41466400
   QUIT(0);                                                    <<L1056>>41466500
   END;                                                        <<L1056>>41466600
          CTABFNUM := FOPEN(CTABFILE,1,%60);                   << 9112>>42195000
             RELSIR( RINSIR, RSIR);                            <<01123>>42521000
             MESSAGE(353);  << GETDSEG FAILURE >>              <<01123>>42525000
             RELSIR( RINSIR, RSIR);                            <<01123>>42551000
             MESSAGE(354);  << ALTDSEG FAILURE >>              <<01123>>42555000
$EDIT VOID=43785000                                            <<T1777>>43770000
            IF POSTSERIES3 THEN                                <<T1777>>43790000
          GETNEWVAL(M2007,TEMP,256,8192);  <<MEMORY SIZE = XXXX<<01300>>43865000
                phone = bcsldtx,                               <<09308>>44045000
                bmess'ptr;                                     <<09308>>44046000
                                                               <<09308>>44047000
TTFERRS:    MESSAGE(m2453);  << illegal input >>               <<09308>>44665000
                                                               <<09308>>45786000
            move bmess := " ";                                 <<09308>>45787000
            move bmess(1) := bmess, (71);     << blank >>      <<09308>>45788000
               if tl'term'type <> %37   then                   <<09308>>45815000
                  if tl'term'type <> %37   then                <<09308>>45859000
                     move * := " , ", 2;                       <<09308>>45860000
                  << add file name >>                          <<09308>>45861000
                  @bmess'ptr :  = tos;                         <<09308>>45862000
                  move bmess'ptr := tl'entb(name'ptr),(8), 2;  <<09308>>45865000
                  scan bmess'ptr until " ", 1;                 <<09308>>45867000
                  move * := ".", 2;                            <<09308>>45868000
                  << add group name >>                         <<09308>>45870000
                  move * := tl'entb(name'ptr + 8), (8), 2;     <<09308>>45871000
                  @bmess'ptr := tos - 8;                       <<09308>>45875000
                  scan bmess'ptr until " ", 1;                 <<09308>>45877000
                  move * := ".", 2;                            <<09308>>45878000
                  << add account name >>                       <<09308>>45880000
                  move * := tl'entb(name'ptr + 16), (8), 2;    <<09308>>45882000
                  @bmess'ptr := tos - 8;                       <<09308>>45883000
                  scan bmess'ptr until " ", 1;                 <<09308>>45885000
                    IF 0<=S0<=999 THEN                         <<09561>>46760000
          << THIS PREVENTS CS DEVICE DAT FROM CHANGING TO 16>> <<09276>>49142000
          IF NOT ( CSDEV)   THEN                               <<09276>>49143000
             DETERMCTYP(@SAMEPLACE,DCT,FALSE);                 <<09276>>49145000
          MOVE DEVCLASS := 16(%40) ;                           <<01673>>50411000
          IF = AND NOT LAST THEN GO REQACLS ;                  <<01673>>50421000
          <<DETECT IF CLASSNAME IS INPUTTED JUST BY A CR>>     <<01673>>50422000
COMMENT                                                        <<01299>>50574100
                 Device Class Table/Terminal Descriptor Table           50574110
                                                                        50574120
                         DST %50    SIR %50                             50574130
            ____      _______________________                           50574140
Low Memory  ^        |      Segment Size     |  0  DCTH'SEGMENT'SIZE    50574150
               D     |-----------------------|                          50574160
               C     |  DCT Entry Size (VAR.)|  1  DCTH'ENTRY'SIZE = 1  50574170
               T     |-----------------------|                          50574180
                     |   # of DCT entries    |  2  DCTH'NUM'DCT'ENTRIES 50574190
               H     |-----------------------|                          50574200
               E     | DCT Base seg relative |  3  DCTH'DCT'BASE = 6    50574210
               A     |-----------------------|                          50574220
               D     |   # of TDT entries    |  4  DCTH'NUM'DCT'ENTRIES 50574230
               E     |-----------------------|                          50574240
            v  R     | TDT Base seg relative |  5  DCTH'TDT'BASE        50574250
            ----     |-----------------------|                          50574260
                     |                       |  6                       50574270
                     |         ASCII         |  7                       50574280
                     |       Class Name      | 10                       50574290
                     |                       | 11                       50574300
                     |-----------------------|                          50574310
                     | cyl ptr    | acc type | 12                       50574320
DCT'NEXT'ENTRY =     |-----------------------|                          50574330
DCT'NUM'DEVICES + 6  |     # of devices      | 13  DCT'NUM'DEVICES      50574340
                     |-----------------------|                          50574350
                     |         ldev          | 14  DCT'FIRST'LDEV       50574360
                     :                       :                          50574370
                     :                       :                          50574380
                     |                       |                          50574390
                     |  Last DCT Entry ldev  |                          50574400
                     |***********************|     Base of TDT or the   50574410
                     |                       |  0  beginning of the     50574420
                     |       File Name       |  1  Volume Table.  The   50574430
                     |                       |  2  TDT is not required. 50574440
                     |                       |  3                       50574450
                     |-----------------------|                          50574460
                     |                       |  4                       50574470
                     |       Group Name      |  5                       50574480
                     |                       |  6                       50574490
                     |                       |  7                       50574500
                     |-----------------------|                          50574510
                     |                       | 10                       50574520
                     |       Account Name    | 11                       50574530
                     |                       | 12                       50574540
                     |                       | 13                       50574550
TDT'NEXT'ENTRY =     |-----------------------|                          50574560
TDT'NUM'DEVICES + 13 | # of devices in class | 14                       50574570
                     |-----------------------|                          50574580
                     |        ldev           | 15                       50574590
                     :                       :                          50574600
                     :                       :                          50574610
                     | Last TDT Entry Ldev   |                          50574620
High Memory          |-----------------------|                          50574630
END OF COMMENT;                                                         50574640
                                                                        50574650
                                                                        50584100
          <<  I is a count of the number of ldevs entered.  >> <<01299>>50584200
                                                               <<01299>>50598100
          <<  Push ldev onto TOS.  TOS will be used as an   >> <<01299>>50598200
          <<  integer array "IAS0" later on.                >> <<01299>>50598300
                                                               <<01299>>50674100
          << Search thru the device classes to see if the   >> <<01299>>50674110
          << entered name matches an existing name.  If     >> <<01299>>50674120
          << there is a match, jump to OLDENT.  Otherwise   >> <<01299>>50674130
          << @DCT will be pointing to the next location     >> <<01299>>50674140
          << for the new class name.                        >> <<01299>>50674150
                                                               <<01299>>50708100
          <<  Now we want to increase the table by one      >> <<01299>>50708200
          <<  entry size, plus space for all the ldevs      >> <<01299>>50708300
          <<  with the class name.                          >> <<01299>>50708400
                                                               <<01299>>50714100
          << @DCT currently points to the beginning of the  >> <<01299>>50714200
          << TDT.  MOVEDLTABLES moves all the tables below  >> <<01299>>50714300
          << DCT down. To make room for the new entry, we   >> <<01299>>50714400
          << need to adjust the pointer to point at the     >> <<01299>>50714500
          << new end of the the Device Class Table.         >> <<01299>>50714600
                                                               <<01299>>50724100
          <<  Fill the entry's header information.          >> <<01299>>50724200
                                                               <<01299>>50748100
          <<  TOS will now point to the 1st ldev location.  >> <<01299>>50748200
                                                               <<01299>>50754100
          << Use X as subscript variable for IAS0 array.    >> <<01299>>50754200
                                                               <<01299>>50758100
          <<  Put ldevs from TOS to entry's ldevs location  >> <<01299>>50758200
          <<  Increment TOS to point to next ldev location  >> <<01299>>50758300
                                                               <<01299>>50784100
          <<  Update the DCT Header.                        >> <<01299>>50784200
          << Check each ldev entered to see if it matches   >> <<01299>>50819100
          << any previously existing ldev for this class.   >> <<01299>>50819200
          << M is the counter for existing ldevs. K is the  >> <<01299>>50819300
          << counter for the entered ldevs.                 >> <<01299>>50819400
                                                               <<01299>>50903100
          << DEST points to the beginning of the TDT - 1.   >> <<01299>>50903200
          << This is the last location of the hole created  >> <<01299>>50903300
          << for additional ldevs to be added.  SOURCE      >> <<01299>>50903400
          << points to the last ldev of the last class.     >> <<01299>>50903500
          << Count is the number of words between the last  >> <<01299>>50903600
          << ldev of the target class and the last ldev     >> <<01299>>50903700
          << of the last class.  MOVE copies everything     >> <<01299>>50903800
          << from SOURCE thru the last ldev of the target   >> <<01299>>50903900
          << class to DEST. This creates a hole after the   >> <<01299>>50904000
          << last ldev of the target class.                 >> <<01299>>50904100
          @DEST := (@DCT'HEAD + DCTH'TDT'BASE) + I - 1;        <<01299>>50915000
          << Put the ldevs entered on TOS into the class    >> <<01299>>50934100
          << entry.  TOS is used as an integer array IAS0   >> <<01299>>50934200
          << and a pointer PS0 at the same time.  PS0 is    >> <<01299>>50934300
          << location to put the value of IAS0(X).          >> <<01299>>50934400
                                                               <<01299>>50967100
          << Update the DCT Header information.             >> <<01299>>50967200
                                                               <<01299>>50983100
          << Reset TOS by putting the number of items to POP>> <<01299>>50983200
          << off on TOS and then removing them using SUBS 0.>> <<01299>>50983300
           TOS := I + 1;                                        << DCT>>50983400
           ASSEMBLE( SUBS 0);                                   << DCT>>50983500
      REPNUM,                                                  << 9122>>51675000
                                                               << 9122>>51946000
      << Creating new CATALOG file:                         >> << 9122>>51947000
      << 1) Purge temporary file whose name is CATALOG.     >> << 9122>>51948000
      << 2) Create and Activate MAKECAT.PUB.SYS             >> << 9122>>51949000
      << 3) If MAKECAT is successful, a new temporary file  >> << 9122>>51950000
      <<    is created.  If unsuccessful, no temporary file >> << 9122>>51951000
      <<    called CATALOG will exist.                      >> << 9122>>51952000
      << 4) Check if a new temporary file CATALOG was made. >> << 9122>>51953000
      << 5) If in interactive mode and not found, loop back.>> << 9122>>51954000
      << 6) Else in batch mode, then abort.                 >> << 9122>>51955000
      REPNUM := FOPEN( CATALOGFILE'REP,2); << open as temp >>  << 9122>>51956000
      IF = THEN                                                << 9122>>51957000
         FCLOSE( REPNUM, 4, 0); << Purge if it exists >>       << 9122>>51958000
                                                               << 9122>>51980000
                                                               << 9122>>51985000
      REPNUM := FOPEN( CATALOGFILE'REP,2); << open as temp >>  << 9122>>51990000
      IF <> THEN   << Unable to open the new CATALOG file >>   << 9122>>51995000
                                                               << 9122>>52015000
        IF NOT LOGICAL(MODE) THEN                              << 9122>>52020000
           REPNUM := FOPEN( SDFCOMFILE'REP,2);                 << 9122>>52161000
           IF = THEN                                           << 9122>>52162000
              FCLOSE( REPNUM, 4, 0);  << PURGE IF IT EXISTS>>  << 9122>>52163000
                                                               << 9122>>52164000
                                                               <<09275>>52170000
              message( m2719);                                 <<09275>>52220000
              if not logical(mode)   then                      <<09275>>52225000
     INTEGER INPUT'VAL ;                                       <<01674>>52496000
     DOUBLE  VDSLEN,     << V.M. LENGTH IN SECTORS >>          <<01674>>52500000
             DBL'LDIRC1, << TEMPORARY DOUBLE FOR LDIRC1 >>     <<02230>>52500100
             DBL'LDIRC2, << TEMPORARY DOUBLE FOR LDIRC2 >>     <<02230>>52500200
             TEMP'DIRSIZE, << TEMPORARY DOUBLE DIRSECT >>      <<02230>>52500400
             DINPUT'VAL ; << DOUBLE VALUE FOR VIRTUAL >>       <<01674>>52501000
                         << MEMORY RETURNED BY INVAL>>         <<01674>>52502000
     OWN BYTE ARRAY BBUF(0:10) := 9,"FOR LDEV# ";              <<01674>>52521000
     EQUATE                                                    <<01674>>52536000
             VMIND1 = 1 ,                                      <<01674>>52537000
             VMIN   = 0 ,                                      <<01674>>52538000
             VMAX   = 255;                                     <<01674>>52539000
          DBL'LDIRC1 := DOUBLE( LDIRC1 );                      <<02230>>52605100
          DBL'LDIRC2 := DOUBLE( LDIRC2 );                      <<02230>>52605200
          TEMP'DIRSIZE := DOUBLE( CTAB(DIRSECT'));             <<02230>>52605300
          GETNEWVAL'DOUB(M2551,TEMP'DIRSIZE,                   <<02230>>52610000
                DBL'LDIRC2,65000D,DBL'LDIRC1);                 <<02230>>52615000
          CTAB(DIRSECT') := LOGICAL(TEMP'DIRSIZE);             <<02230>>52616000
  MESSAGE(-M2217,VMAX);                                        <<01674>>53000000
  << ENTER VOLUME,SIZE IN KILOSECTORS >>                       <<01674>>53001000
      LDEV := GETLDEV (VOLUME);                                <<01674>>53121000
$EDIT VOID=53200000                                            <<01674>>53200000
    INPUT'VAL := INVAL(@WRONG,,TRUE);                          <<01674>>53205000
    DINPUT'VAL := DOUBLE(INPUT'VAL);                           <<01674>>53210100
    IF (LDEV=1) AND (INPUT'VAL=VMIN) THEN                      <<01674>>53211000
         BEGIN                                                 <<01674>>53212000
         MESSAGE ( M2458,VMIND1,VMAX,LDEV,,BBUF) ;             <<01674>>53213000
         GO TO REDO ;                                          <<01674>>53214000
         END                                                   <<01674>>53214100
    ELSE IF (LDEV=1) AND (INPUT'VAL > VMAX) THEN               <<01674>>53214110
         BEGIN                                                 <<01674>>53214120
         MESSAGE( M2458,VMIND1,VMAX,LDEV,,BBUF);               <<01674>>53214130
         GO TO REDO;                                           <<01674>>53214140
         END                                                   <<01674>>53214150
    ELSE IF (INPUT'VAL < VMIN) OR (INPUT'VAL > VMAX) THEN      <<01674>>53214200
         BEGIN                                                 <<01674>>53214300
         MESSAGE( M2458,VMIN,VMAX,LDEV,,BBUF);                 <<01674>>53214400
         GO TO REDO ;                                          <<01674>>53214500
         END;                                                  <<01674>>53214600
    VDSLEN := DINPUT'VAL * 1024D;                              <<01674>>53215000
          GETNEWVAL(M2354,CTAB0(EXTSSECT'),128,32764);         <<09274>>53295000
          I:=-1;                                               <<c9139>>53722500
          X:=-8;                                               <<c9139>>53722625
          WHILE (I:=I+1) < NDATACOMM DO <<CHECK IF DC>>        <<c9139>>53722750
            BEGIN                                              <<c9139>>53722875
              IF DATACOMM(X:=X+8)=PROGNAME,(8)                 <<c9139>>53723000
                 THEN GOTO GETNEWP;                            <<c9139>>53723125
            END;                                               <<c9139>>53723250
$EDIT VOID=53820030                                            <<01145>>53820010
                                                               <<01145>>53820040
          << SEARCH THROUGH THE I/O CONFIGURATION TABLE AND >> <<01145>>53820050
          << SEE IF PROGNAME MATCHES ANY OF THE DRIVER NAMES>> <<01145>>53820060
                                                               <<01145>>53820070
        OWN BYTE ARRAY TEST'SPEC'CHAR(0:1) := "_",CR;          <<G1562>>54060500
        INTEGER SPEC'CHAR,PATCHSIZE;                           <<G1562>>54065000
          SCAN BPINBUF UNTIL TEST'SPEC'CHAR;                   <<G1562>>54535100
          IF CARRY THEN                                        <<G1562>>54535200
             SPEC'CHAR := "'"                                  <<G1562>>54535300
          ELSE SPEC'CHAR := "_";                               <<G1562>>54535400
          IF I<0 THEN GETSTR(*,*,1,SPEC'CHAR,15)               <<G1562>>54540000
              GETSTR(*,*,0,SPEC'CHAR,15);                      <<G1562>>54555000
            TOS := @BPINBUF;                                   <<02229>>57975010
            ASSEMBLE(DUP);                                     <<02229>>57975100
  SCAN1:    SCAN * WHILE BLANK,1;                              <<02229>>57975200
            MOVE * := * WHILE ANS,0;                           <<02229>>57975300
            IF INTEGER(BPS0)=" " THEN                          <<02229>>57976000
                 GOTO SCAN1                                    <<02229>>57976200
            ELSE IF INTEGER(BPS0) = CR THEN                    <<02229>>57976500
                    MOVE * := *,(1),3                          <<02229>>57976600
                 ELSE BEGIN                                    <<02229>>57976700
                           MOVE * := *,(1),1;                  <<02229>>57976800
                           GOTO SCAN1;                         <<02229>>57976900
                      END;                                     <<02229>>57977000
            IF CARRY THEN                                      <<B9455>>57985000
               BEGIN                                           <<B9455>>57985500
               CONTINUE := FALSE;                              <<B9455>>57986000
               << DELETE TRAILING BLANKS >>                    <<B9455>>57986500
               X := -1;                                        <<B9455>>57987000
               WHILE BPS0(X) = " " DO X := X-1;                <<B9455>>57987500
               TOS := TOS+X+1;                                 <<B9455>>57988000
               BPS0 := CR;                                     <<B9455>>57988500
               END                                             <<B9455>>57989000
   LAST'FULL'BACKUP,<< DATE RETRIEVED FROM COLD LOAD EXT %30 >><<02228>>58359000
$EDIT VOID=58620000                                            << 9183>>58425000
      NRENT'BETWEEN'WCS64 = CMD'TAB(8)#,                       << 2404>>58735000
   MAGTAPE := DEVTYPE.RBITE = MAGTAPETYPE;                     <<01124>>58910000
$EDIT VOID=58960000                                            <<01124>>58915000
      MAX'RECSIZE := 8192                                      <<S1611>>58985000
          INITFNUM := FOPEN(FULLNAME,%(2)10000000011,          <<T2251>>59370000
             REC'BEFORE'INITIAL := REC'BEFORE'INITIAL          << 2404>>60345000
                                   +COMPUTE'WCS'SIZE(CMD'TAB); << 2404>>60346000
             <<***********************************>>           << 2404>>60376000
             <<WRITE RECS 0 AND 1 OF COLDLOAD TAPE>>           << 2404>>60378000
             <<***********************************>>           << 2404>>60379000
             @CTPNTR := @CMD'TAB(BEG'OF'STACK                  << 2404>>60380000
             +(NRENT'BEFORE'WCS+NRENT'BETWEEN'WCS              << 2404>>60385000
               +NRENT'AFTER'WCS64)*2);                         << 2404>>60386000
                                                               << 2404>>60429000
             <<*******************************************>>   << 2404>>60429100
             <<Write all the WCS files found on the system>>   << 2404>>60429200
             <<*******************************************>>   << 2404>>60429300
             DUMP'WCS(CMD'TAB);                                << 2404>>60430000
                                                               << 2404>>60430500
             <<***********************************>>           << 2404>>60431000
             <<WRITE THE 3 CHANNEL PROGRAM RECS   >>           << 2404>>60432000
             <<FOLLOWING THE WCS FILES            >>           << 2404>>60433000
             <<***********************************>>           << 2404>>60434000
                                                               <<02228>>60761000
          << Save the most recent FULLBACKUP date in the   >>  <<02228>>60761100
          << COMM array word %51.  This date is stored in  >>  <<02228>>60761200
          << the cold load extension sector(%40) when the  >>  <<02228>>60761300
          << tape is used for reloading.  SR# 5000-093823  >>  <<02228>>60761400
                                                               <<02228>>60761500
          IF AUTO'BKUP = FULL'BKUP   THEN                      <<02228>>60761600
             COMM(BACKUP'DATE) := DATE                         <<02228>>60761700
          ELSE                                                 <<02228>>60761800
             BEGIN                                             <<02228>>60761900
             << 0=READ, 24=word %30 of sector %40 >>           <<02228>>60762000
             PROCESS'COLD'LOAD'INFO(0,24,LAST'FULL'BACKUP);    <<02228>>60762100
             COMM(BACKUP'DATE) := LAST'FULL'BACKUP;            <<02228>>60762200
             END;                                              <<02228>>60762300
                                                               <<02228>>60762400
                                                               << 9183>>60905000
$EDIT VOID=60930000                                            << 9183>>60910000
                                                               << 9183>>60936000
$EDIT VOID=61005000                                            << 9183>>60950000
                COMPUTE'WCS'SIZE(CMD'TAB);                     << 2404>>61445000
                DUMP'WCS(CMD'TAB);                             << 2404>>61450000
                                                               <<L9395>>61706000
   << --------------------------------------------------- >>   <<L9395>>61707000
   << Begin dumping out the Logging ID table...           >>   <<L9395>>61708000
   << --------------------------------------------------- >>   <<L9395>>61709000
   IF ( NEWLIDTABLEN := CTAB (NLOGPROCS) * LIDTABSIZE +        <<L9395>>61710000
                        LIDTABSIZE)  >   LIDTABLEN THEN        <<L9395>>61715000
      << ------------------------------------------------ >>   <<L9395>>61725000
      << table is being made larger...compute size change >>   <<L9395>>61730000
      << ------------------------------------------------ >>   <<L9395>>61735000
      LIDTABINCR := NEWLIDTABLEN - LIDTABLEN;                  <<L9395>>61740000
      MOVEDLTABLES;                                            <<L9395>>61745000
      << ------------------------------------------------ >>   <<09560>>61750000
      << Initialize the table past the old max # entries  >>   <<09560>>61755000
      << ------------------------------------------------ >>   <<09560>>61760000
                                                               <<09560>>61761000
      I := 1;                                                  <<09560>>61762000
      DO                                                       <<09560>>61763000
        LIDTAB(LIDTABLEN + I * LIDTABSIZE - 1) := -1           <<09560>>61764000
      UNTIL (LIDTABLEN + (I:=I+1)* LIDTABSIZE) > NEWLIDTABLEN; <<09560>>61765000
      END;                                                     <<09560>>61766000
                                                               <<09560>>61767000
    << ----------------------------------------------------- >><<09560>>61768000
    << In case the table has contracted and we do a reload   >><<09560>>61769000
    << from this tape, make sure the Logging ID table is     >><<09560>>61770000
    << cleaned up and the we update the max # of entries...  >><<09560>>61771000
    << ----------------------------------------------------- >><<09560>>61772000
                                                               <<09560>>61773000
    IF NEWLIDTABLEN < LIDTABLEN THEN                           <<09560>>61774000
       BEGIN                                                   <<09560>>61775000
       I := 1;                                                 <<09560>>61776000
       DO                                                      <<09560>>61777000
         LIDTAB(LIDTABSIZE + I * LIDTABSIZE - 1) := -1         <<09560>>61778000
      UNTIL (LIDTABSIZE + (I:=I+1)* LIDTABSIZE) > NEWLIDTABLEN;<<09560>>61779000
      END;                                                     <<09560>>61779100
                                                               <<09560>>61779200
    LIDTAB(1) := CTAB(NLOGPROCS);                              <<09560>>61780000
    WRITETAPE(LIDTAB,NEWLIDTABLEN,0);                          <<09560>>61781000
          X:=-8;                                               <<c9139>>61942500
          I:=0;                                                <<c9139>>61942625
          DO BEGIN                                             <<c9139>>61942750
               MOVE SEGMENT:=DATACOMM(X:=X+8),(8);             <<c9139>>61942875
               FDUMP(SEGMENT);                                 <<c9139>>61943000
             END                                               <<c9139>>61943125
          UNTIL (I:=I+1)=NDATACOMM;                            <<c9139>>61943250
$EDIT VOID=62105000                                            <<01145>>62055000
          J:=0;                                                <<c9139>>62227500
          X:=-8;                                               <<c9139>>62227625
          DO BEGIN  <<CHECK FOR DATACOMM FILES>>               <<c9139>>62227750
               DUPLICATE;                                      <<c9139>>62227875
               IF * = DATACOMM(X:=X+8),(8) THEN GOTO NEXTDP;   <<c9139>>62228000
             END                                               <<c9139>>62228125
          UNTIL (J:=J+1)=NDATACOMM;                            <<c9139>>62228250
             FCONTROL(TAPEFNUM,5,I);                           <<P2173>>62585000
$EDIT VOID=62600000                                            <<P2173>>62595000
          LOGICAL JCWVAL;                                      <<L1439>>62755100
                                                                        62755200
          EQUATE    WARN0  =  %40000 ,                         <<L1439>>62756000
                                                                        62757000
$EDIT VOID=62757100                                                     62757100
$EDIT VOID=62757200                                                     62757200
                   JCWFATAL = %100000;                         <<L1439>>62758000
                                                                        62805100
              JCWVAL := GETJCW ;                               <<L1439>>62805200
              IF JCWVAL <> JCWFATAL THEN                       <<L1439>>62805300
              <<JCW IS SET TO WARN0 ONLY IF JCW IS NOT SET >>  <<L1439>>62805400
              << TO FATAL DURING STORE PROCESS         >>      <<L1439>>62805500
              SETJCW ( WARN0 ) ;  << SET JCW TO WARN0 IF SYS.>><<L1439>>62806000
                                  << PROG. ARE MISSING >>      <<L1439>>62807000
      MAXNAME     = 52,                                        <<R1503>>63026000
      INFO'LEN    = 464,      <<# chars in INFO' array>>       <<F2130>>63030000
      MAX'ITEM    = 10;       <<maximum # of items>>           <<01439>>63035000
$EDIT VOID=63036000                                                     63036000
                          <<MEANS NO ERROR (CR OR FUTURE DATE>><<L1439>>63037000
      EQUATE                                                            63041000
         JCWFATAL    =  %100000 ;  <<FATAL,CAUSE JOB ABORTED>> <<01301>>63042000
      VIRT'LDEV   := 0,       <<non-zero if remote sysdump>>   <<R1503>>63086000
      STAT,                   << STATUS SET BY PUTJCW >>       <<L1439>>63091000
  LOGICAL                                                      <<L1439>>63106000
          NOERR := 0 ;                                         <<L1439>>63107000
                                                                        63108000
      NODE'NAME(0:MAXNAME-1),       <<holds remote node name>> <<R1503>>63111000
$EDIT VOID=63165000                                                     63165000
      LDEV'OPTION = 50#,      <<FFILEINFO item# for LDEV>>     <<R1503>>63170000
      VIRT'OPTION = 51#,      <<FFILEINFO item# for VIRT>>     <<R1503>>63171000
      NODE'OPTION = 61#,      <<FFILEINFO item# for NODE>>     <<R1503>>63172000
      GOOD           = 1,     <<OVERALL STATUS OF STORE>>      <<L1383>>63191000
                               <<RETURNS GOOD>>                <<L1383>>63192000
$EDIT VOID=63332000                                                     63331000
                                                                        63333000
                                                                        63351000
      SETJCW(JCWFATAL); <<CAUSE CIERROR SET BY CI BEFORE JOB>> <<01301>>63352000
                        <<ABORTED>>                            <<01301>>63352100
                                                                        63353000
      FILL' (NODE'NAME, MAXNAME, " ");                         <<R1503>>63416000
                             LDEV'OPTION, LDEV,                <<R1503>>63435000
                             VIRT'OPTION, VIRT'LDEV,           <<R1503>>63436000
                             NODE'OPTION, NODE'NAME);          <<R1503>>63437000
      <<  APPEND NUMBER OF SECONDARY STORAGE USED FOR  >>      <<F2130>>63545100
      <<  SYSTEM FILES.  SR# 4700087106                >>      <<F2130>>63545200
                                                               <<F2130>>63545300
    IF REELNUM > 1 THEN                                        <<P2173>>63545310
      BEGIN                                                    <<P2173>>63545320
      MOVE PT := "REELNUM=",2;                                 <<F2130>>63545400
      @PT := TOS;                                              <<F2130>>63545500
      @PT := @PT+ASCII (REELNUM, 10, PT);                      <<P2173>>63545600
      PT := ";";                                               <<F2130>>63545700
      @PT := @PT(1);                                           <<F2130>>63545800
      END;                                                     <<P2173>>63545810
                                                               <<F2130>>63545900
         IF VIRT'LDEV <> 0 THEN                                <<R1503>>63756000
                                                               <<R1503>>63757000
             << append remote node name...if non-zero...>>     <<R1503>>63758000
                                                               <<R1503>>63759000
            BEGIN                                              <<R1503>>63759100
            MOVE PT :=",",2;                                   <<R1503>>63759200
            MOVE *  :=NODE'NAME,(MAXNAME),2;                   <<R1503>>63759300
            @PT     :=TOS;                                     <<R1503>>63759400
            END;                                               <<R1503>>63759500
      IF (STORE'FILES' <> "NOFILES-NOFILES") THEN              <<L1439>>64226000
      <<CASE OF CR AND FUTURE DATE, RESET STOREJCW TO 0>>      <<L1439>>64227000
          BEGIN                                                <<L1439>>64228000
          IF REPLY'MSG (MAIL'OVERALL) <> GOOD THEN             <<01439>>64230000
             IF REPLY'MSG (MAIL'WHY) = WHY'SYNTAX THEN         <<01439>>64235000
                FAIL (S'ERR'SYNTAX, 0)                         <<01439>>64240000
             ELSE                                              <<01439>>64245000
                FAIL (S'ERR'STORE'FAILED, REPLY'MSG(MAIL'WHY));<<01439>>64250000
          END  <<OF IF STORE'FILES' <> NOFILES-NOFILES>>       <<L1439>>64256000
      ELSE                                                              64257000
          BEGIN                                                         64258000
          PUTJCW ( STOREJCW',NOERR,STAT );                     <<L1439>>64259000
          <<RESET STOREJCW TO 0 IN CASE OF CR OR FUTURE DATE>> <<L1439>>64259100
          IF STAT <> 0 THEN                                             64259200
              QUIT(PUTJCWFAIL) ;                               <<L1439>>64259300
          END;                                                 <<L1439>>64259400
                                                               <<02228>>64630000
                                                               <<02228>>64645000
         << DATE is assigned during proc. INITIALIZATION.  >>  <<02228>>64649100
         << Write DATE to sector %40, word %30 which is the>>  <<02228>>64649200
         << cold load information extension sector.        >>  <<02228>>64649300
         << For FULLBACKUP, DATE is save in the COMM array.>>  <<02228>>64649400
         << For all other backups, the value in the cold   >>  <<02228>>64649500
         << load information extension sector is saved in  >>  <<02228>>64649600
         << the COMM array word %51.  SR# 5000-093823      >>  <<02228>>64649700
         PROCESS'COLD'LOAD'INFO(1,24,DATE);                    <<02228>>64650000
            MOVE STORE'FILES':=("NOFILES-NOFILES",CR);         <<01313>>64920000
