$CONTROL USLINIT,MAP,CODE,DEFINE,LIST                          <<03635>>00010000
<< INITIAL -- MODULE 00 >>                                     <<00873>>00012000
<< HP32002C MPE SOURCE C.00.00 >>                                       00014000
$SET X1=OFF                                                    <<03002>>00016000
<< COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980.           >>  00020000
<<     THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A       >>  00022000
<<     TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR     >>  00024000
<<     STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION >>  00026000
<<     OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED   >>  00028000
<<     WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.>>  00030000
<< **** Note - Dollar Copyright cannot be used with this module *** >>  00032000
$TP                                                            <<00888>>00034000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>00036000
$CONTROL MAIN=INITIAL'II'III,PRIVILEGED                        <<00888>>00038000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>00040000
$CONTROL MAIN=INITIAL'33,PRIVILEGED                            <<00888>>00042000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>00044000
<<----------------------------------------------------------------------00046000
             M P E   I N I T I A L I Z A T I O N   P R O G R A M        00048000
---------------------------------------------------------------------->>00050000
COMMENT   INITIAL PROGRAM CST MAP                              <<03002>>00052000
                                                               <<03002>>00054000
LOGICAL     PHYSICAL     SEGMENT NAME                          <<03002>>00056000
CST         CST                                                <<03002>>00058000
=======     ========     ============                          <<03002>>00060000
                                                               <<03002>>00062000
   0           1           ININ         (CORE RESIDENT)        <<03603>>00064000
   1           2           BOOTSTRAP    (CORE RESIDENT)        <<03603>>00066000
   2           3           RESIDENT     (CORE RESIDENT)        <<03603>>00068000
                                                               <<03603>>00070000
   3           4           MAINSEG1     (NON CORE-RES BUT      <<03603>>00072000
   4           5           MAINSEG1A     PRESENT IN CORE       <<03603>>00074000
   5           6           CONFIGURE     AT COMPLETION         <<03603>>00076000
   6           7           DEFTRACKS     OF COLD LOAD)         <<03603>>00078000
   7          10           SETUP                               <<03603>>00080000
  10          11           TAPEIO                              <<03603>>00082000
  11          12           FILEIO                              <<03603>>00084000
  12          13           DISKSPACE                           <<03603>>00086000
                                                               <<03603>>00088000
  13          14           DIRECTORY1   (NOT PRESENT AT THE    <<03603>>00090000
  14          15           DIRECTORY2    COMPLETION OF THE     <<03603>>00092000
  15          16           SL PROGRAM    COLD LOAD)            <<03603>>00094000
  16          17           PROCESS                             <<03603>>00096000
  17          20           MAINSEG1B                           <<03603>>00098000
  20          21           MAINSEG2                            <<03603>>00100000
  21          22           MAINSEG3                            <<03603>>00102000
  22          23           MAINSEG4                            <<03603>>00104000
                                      END-COMMENT;             <<03002>>00106000
                                                               <<03002>>00108000
                                                                        00110000
BEGIN                                                                   00114000
$PAGE "CONSTANT DEFINITION"                                             00116000
   DEFINE EXT'DCL = GLOBAL #; << GLOBAL VARIABLES >>           <<SY>>   00118000
EQUATE LIST = TRUE;                                            <<01103>>00120000
          <<--------------                                              00122000
            INITIAL INFO                                                00124000
          -------------->>                                              00126000
  EQUATE  NCORRESSEG=    3, <<# OF CORE-RESIDENT INITIAL SEGS>><<03603>>00128000
          NSTARTSEG =    11,<<# OF SEGMENTS INITIALLY IN CORE>><<03603>>00130000
          SWAPDSIZE =    5,          <<SWAP DESCRIPTOR SIZE>>           00132000
          NCORESIZES = 36, << # OF LEGAL MEMORY SIZES>>        <<03603>>00134000
          NTCST     =    32,         <<# OF ENTRIES IN TEMP CST TABLE>> 00136000
          TCSTSIZE  =    4*NTCST,    <<SIZE OF TEMPORARY CST TABLE>>    00138000
          EXPTABLES =    13,         <<# OF EXPANDABLE TABLES>><<00.06>>00140000
          MAXSWAPSEG=    15,         <<# OF SEGS WHICH SWAP>>  <<03603>>00142000
          NR'MPE'BANKS=   4,         <<# BANKS RESERVED FOR >> <<03603>>00144000
                                     <<USE BY MPE ONLY      >> <<03603>>00146000
          INITSTACKEXTRA=15140; <<SIZE STACK MAY GROW>>        <<03675>>00148000
          EQUATE CORE256X = 7; <<INDEX OF 256K >>              <<03603>>00150000
                                                                        00152000
          <<------------>>                                     <<02510>>00154000
          <<  CPU INFO  >>                                     <<02510>>00156000
          <<------------>>                                     <<02510>>00158000
   EQUATE BITMAP1 = %13,                                       <<02510>>00160000
          BITMAP2 = %64;                                       <<02510>>00162000
   DEFINE SERIESII'III     = BITMAP1&LSR(THISCPU)#,            <<02510>>00164000
          POST'SERIES3     = BITMAP2&LSR(THISCPU)#;            <<02510>>00166000
   DEFINE ICF55              = (THISCPU = 5)#;                 <<03002>>00168000
                                                               <<02510>>00170000
          <<-------------------                                         00172000
            TABLE ENTRY SIZES                                           00174000
          ------------------->>                                         00176000
  EQUATE  LDTSIZE   =    5,          <<LOGICAL DEVICE TABLE>>           00178000
          LDTXSIZE  =    5,          <<LDT EXTENSION>>         <<00.06>>00180000
          LPDTSIZE  =    2,          <<LOGICAL-PHYSICAL DEV TABLE>>     00182000
          DVRSIZE   =    6,          <<DRIVER TABLE>>                   00184000
          VTABSIZE  =    14,         <<VOLUME TABLE>>                   00186000
          DRTSIZE   =    4,          <<DEVICE REFERENCE TABLE>>         00188000
          CSTSIZE   =    4,          <<CODE SEGMENT TABLE>>             00190000
          ASS'SIZE  =    7,   << ASSOCIATE TABLE ENTRY SIZE >> <<01648>>00192000
          PCBSIZE   =    16,         <<PROCESS CONTROL BLOCK TALBE>>    00194000
          IOQSIZE   =    11,         <<I/O QUEUE>>                      00196000
          DISCREQSIZE=  16,                                    <<MPEIV>>00198000
         SECDISC=15,                                           <<01639>>00200000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>00202000
          TBUFSIZE  =    16,         <<TERMINAL BUFFERS>>      <<00888>>00204000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>00206000
          TBUFSIZE =     32, <<33 TERMINAL BUFFERS>>           <<00888>>00208000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>00210000
          SBUFSIZE  =    129,        <<SYSTEM BUFFERS>>                 00212000
          SWAPTABSIZE=  5,                                     <<MPEIV>>00214000
                                                               <<MPEIV>>00216000
       MONBUFSIZE=1024,                                        <<MPEIV>>00218000
          SIRSIZE   =    2,          <<SIR TABLE>>                      00220000
          NSIR      =    40,         <<# OF SIRS>>                      00222000
          MSGTABSIZE=   5,                                     <<MPEIV>>00224000
       SRTSIZE=5,                                              <<MPEIV>>00226000
       SRTNUM=20,                                              <<MPEIV>>00228000
       PRIMMSGTABNUM=25,                                       <<MPEIV>>00230000
       MSGHARBORLENGTH=5,                                      <<MPEIV>>00232000
          MEASINFOTABSIZE=80,                                  <<MPEIV>>00234000
          TRLSIZE   =    4,          <<TIMER REQUEST LIST>>             00236000
          PPCTSIZE  =    2,          <<PROCESS-PROCESS COMMUNICATION>>  00238000
          MAXIDDSIZE =   127 ,<<MAX # SECTORS FOR IDD>>        <<01963>>00240000
          INITIDDSIZE=   8,   <<# SECTORS IDD CREATED WITH>>            00242000
          JMATSIZE  =    26,         <<JOB MASTER TABLE>>               00244000
          MAXJMATSIZE =  48,  <<MAX # SECTORS JMAT CAN BE>>             00246000
          INITJMATSIZE=  2,   <<# SECTORS JMAT CREATED WITH>>           00248000
          MAXODDSIZE =   127 ,<<MAX # SECTORS FOR ODD>>        <<01963>>00250000
          JCUTSIZE  =    3,          <<JOB CUTOFF TABLE>>               00252000
          MVTABSIZE =    21,         <<MOUNTED VOL TABLE>>     <<RV.PV>>00254000
          TLTSIZE  =    10,          <<TAPE LABEL TABLE>>      <<TL.02>>00256000
          MAXSTOPSIZE =   12,        <<MAX STOP ENTRY SIZE>>   <<MPEIV>>00258000
          MINSTOPSIZE =   5,         <<MIN STOP ENTRY SIZE>>   <<MPEIV>>00260000
          UCRQSIZE    =   2;         <<UCOP REQUEST QUEUE>>             00262000
                                                                        00264000
          <<-------------                                               00266000
            TABLE SIZES                                                 00268000
          ------------->>                                               00270000
  EQUATE  LPDTTSIZE =    256*LPDTSIZE,<<LOGICAL-PHYSICAL DEV TABLE>>    00272000
          LDTTSIZE  =    256*LDTSIZE,<<LOGICAL DEVICE TABLE>>           00274000
          LDTXTSIZE =    256*LDTXSIZE,<<LOGICAL DEVICE TABLE>> <<00.06>>00276000
          DVCLTSIZE =    1536,       <<DEVICE CLASS TABLE>>             00278000
          VTABTSIZE =    64*VTABSIZE,<<VOLUME TABLE>>                   00280000
          LDTSECT   =    (LDTTSIZE+127)/128,                            00282000
          LDTXSECT  =    (LDTXTSIZE+127)/128,                  <<00.06>>00284000
          TBUFLIMIT   =  255,   <<MAX. NO. OF TBUFS      >>    <<03004>>00286000
          PERPORTMAX  =  99,    <<MAX. NO. OF TBUFS/PORT >>    <<03004>>00288000
          JMATTSIZE   =  INITJMATSIZE*128,   <<JMAT SIZE>>              00290000
          MAXJMSIZE   =  MAXJMATSIZE*128,                               00292000
          IDDTSIZE    =  INITIDDSIZE*128,                               00294000
          MAXIDDTSIZE =  MAXIDDSIZE*128,                                00296000
          MAXODDTSIZE =  MAXODDSIZE*128,                                00298000
          ODDTSIZE    =  IDDTSIZE,                                      00300000
          MVTABMAX    =  16,         <<MAX MOUNTED VS'S>>      <<RV.PV>>00302000
          MVTABTSIZE  =  MVTABMAX*MVTABSIZE,                   <<RV.PV>>00304000
          PVUSERTSIZE =  128,        <<INITIAL PV USER TAB >>  <<01439>>00306000
          MAXPVUSERTSIZE=4096,       <<MAX PV USER TAB SIZE >> <<01439>>00308000
          LPDTSECT  =    (LPDTTSIZE+127)/128,                           00310000
          VTABSECT  =    (VTABTSIZE+127)/128,                           00312000
          DVCLSECT  =    (DVCLTSIZE+127)/128,                           00314000
          CTABSIZE  =    128,        <<CORESIZE-RELATED CONFIGURATION>> 00316000
          CTABTSIZE =    (CORE256X+1)*CTABSIZE,                <<00888>>00318000
          CTAB0SIZE =    128,        <<STD CONFIGURATION TABLE>>        00320000
          SEGT'SIZE =    %2642,   << LOADER SEGMENT TABLE >>   <<03551>>00322000
          DIRSPSIZE =    384,        <<DIRECTORY SPACE DATA SEGMENT>>   00328000
          DIRSPHDR  =    10,          <<DSD HEADER INFO>>      <<DE>>   00330000
          DIRSPSIZE'=    DIRSPSIZE+20,<<ACTUAL DIRSP SEG SIZE>><<DE>>   00332000
          LOGONDSTSIZE=  1000,   <<MAX SIZE OF WELCOME MESSAGE>>        00334000
          CSTABTSIZE=    2048,       <<CS DATA SEGMENT>>                00336000
          CSDEFSIZE =    256,        <<DEFAULT LINE DESCRIPTORS>>       00338000
          CSDVRSIZE =    4,          <<EXTRA DRIVERS>>                  00340000
          CSDRIVERS =    32,         <<MAX # OF EXTRA DRIVERS>>         00342000
          CSDVRTSIZE=    CSDRIVERS*CSDVRSIZE,                           00344000
          CSTABSECT =    (CSTABTSIZE+127)/128,                          00346000
          SJDTSIZE  =    %34,        <<INITIAL SIZE OF SYS JDT>>        00348000
          MAXSJDTSIZE=   %1000;      <<MAX SIZE OF SYS JDT>>   <<00888>>00350000
                                                               <<03668>>00354000
          << DISCSIOBUFSIZE IS THE MAXIMUM CHANNEL PROGRAM >>  <<03668>>00356000
          << OR SIO PROGRAM SIZE OF ALL THE DISC DRIVERS.  >>  <<03668>>00358000
          << CURRENTLY, CS80'DRIVER USES THE LARGEST       >>  <<03668>>00360000
          << CHANNEL PROGRAM.                              >>  <<03668>>00362000
                                                               <<03668>>00364000
  EQUATE  DISCSIOBUFSIZE = 98, <<SIO PROGRAM BUFFER FOR DISC>> <<03668>>00366000
$IF X1=OFF  << ******** SERIES II,III UNIQUE ******** >>       <<02510>>00368000
         TERMSIOBUFSIZE= 0, <<TERM SIO AREA NECCESSARY >>      <<02510>>00370000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******** >>             <<02510>>00372000
          TERMSIOBUFSIZE=%53,<<CHANPROG. BUFFER FOR CONSOLE>>  <<03003>>00374000
$IF        << ****** RETURN TO COMMON CODE ******* >>          <<02510>>00376000
          TAPESIOBUFSIZE=100, <<SIO PROGRAM BUFFER FOR TAPE>>  <<00888>>00378000
          SIOBUFSIZE=DISCSIOBUFSIZE+TERMSIOBUFSIZE+TAPESIOBUFSIZE;      00380000
                                                                        00384000
          <<-------------------                                         00386000
            CST CONFIGURATION                                           00388000
          ------------------->>                                         00390000
  EQUATE  ININCSTN  =    1,          <<CST FOR INTERNAL INTERRUPTS>>    00392000
          FREECSTN  =    2;          <<FIRST FREE ENTRY>>               00394000
                                                                        00396000
          <<----------------------------                                00398000
          CST EXTENSION CONFIGURATION                                   00400000
          --------------------------->>                                 00402000
  EQUATE  FREECSTXN =    1;          <<FIRST FREE ENTRY>>               00404000
                                                                        00406000
          <<-------------------                                         00408000
            DST CONFIGURATION                                           00410000
          ------------------->>                                         00412000
  EQUATE  CSTDSTN   =    1,          <<CODE SEGMENT TABLE>>             00414000
          DSTDSTN   =    2,          <<DATA SEGMENT TABLE>>             00416000
          PCBDSTN   =    3,          <<PROCESS CONTROL BLOCK>>          00418000
          CSTXDSTN  =    4,          <<CST EXTENSION>>                  00420000
          SYSDSTN   =    5,          <<SYSTEM GLOBAL AREA>>             00422000
          COREDSTN  =    6,          <<CORE (SPECIAL)>>                 00424000
          ICSDSTN   =    7,          <<INTERRUPT CONTROL STACK>>        00426000
          SBUFDSTN  =    8,          <<SYSTEM BUFFERS>>                 00428000
          UCRQDSTN  =    9,          <<UCOP REQUEST QUEUE>>             00430000
          PPCTDSTN  =    10,         <<PROCESS-PROCESS COM>>            00432000
          IOQDSTN   =    11,         <<I/O QUEUE>>                      00434000
          TBUFDSTN  =    12,         <<TERMINAL BUFFERS>>               00436000
          LPDTDSTN  =    13,         <<LOGICAL-PHYSICAL DEVICE>>        00438000
          LDTDSTN   =    14,         <<LOGICAL DEVICE TABLE>>           00440000
          DLTDSTN   =    15,         <<DRIVER LINKAGE TABLE>>           00442000
          RESQDSTN  =    16,         <<BUSY, HEAD AND TAIL TABLES>>     00444000
          SECMSGTABDSTN = 17,       << SECONDARY MSG TABLE >>  <<03554>>00446000
          SEGTDSTN  =    18,         <<SEGMENT TABLE>>                  00448000
          TRLDSTN   =    19,         <<TIMER REQUEST LIST>>             00450000
          DIRDSTN   =    20,         <<DIRECTORY>>                      00452000
          DIRSPDSTN =    21,         <<DIRECTORY SPACE>>                00454000
          RINTDSTN  =    22,         <<RESOURCE IDENTITY NUMBER TABLE>> 00456000
          SWAPTABDSTN=   23,                                   <<MPEIV>>00458000
          JPCTDSTN  =    24,         <<JOB PROCESS COUNT TABLE>>        00460000
          JMATDSTN  =    25,         <<JOB MASTER TABLE>>               00462000
          TLTDSTN  =    26,         <<TAPE LABEL TABLE>>       <<TL.02>>00464000
          LOGDST  =  27,                                       <<00506>>00466000
          RITDSTN   =    28,         <<REPLY INFORMATION TABLE>>        00468000
          VTABDSTN  =    29,         <<VOLUME TABLE>>                   00470000
          STOPDSTN  =    30,         <<BREAKPOINT TABLE>>               00472000
          LOG1DSTN  =    31,         <<LOG BUFFER 1>>                   00474000
          LOG2DSTN  =    32,         <<LOG BUFFER 2>>                   00476000
          LIDDST  =  33,                                       <<00506>>00478000
          ASS'DST=34,          <<ASSOCIATE TABLE DST #>>     <<OP.01>>  00480000
          CSTBLKDSTN=    35,         <<CST BLOCK TABLE>>                00482000
          JCUTDSTN  =    36,         <<JOB CUTOFF TABLE>>               00484000
          SJITDSTN  =    37,         <<SYSTEM JIT>>                     00486000
       SPECREQTABDSTN=38,  <<SPECIAL REQUEST TABLE>>           <<MPEIV>>00488000
          VDSMDSTN  =    39,         <<VM MANAGMENT TABLE >>   <<MPEIV>>00490000
          ARSBMTABDSTN=  41,                                   <<MPEIV>>00492000
          ILTDITDSTN=    42,         <<INTERRUPT LINKAGE AND DEV INFO>> 00494000
          SIRDSTN   =    43,         <<SIR TABLE>>                      00496000
          LOGONDSTN1=    47,      <<WELCOME MESSAGE DST>>               00498000
          LOGONDSTN2=    48,      <<WELCOMR MESSAGE DST>>               00500000
          CSDSTN    =    49,         <<CS DST>>                         00502000
          FMAVTDSTN =    44, <<FILE MULTI-ACCESS VECTOR TABLE>>         00504000
          IDDDSTN   =    45,         <<IDD DST>>                        00506000
          ODDDSTN   =    46,          <<ODD DST>>                       00508000
          JPXREFDSTN=    50,         <<JOB-PROCESS CROSS REF TABLE>>    00510000
          SJDTDSTN  =    51,         <<SYSTEM JDT>>                     00512000
          CILOGDSTN =    52,         <<C.I. LOG ON DST>>       <<0+.04>>00514000
          MVTABDSTN =    53,         <<MOUNTED VOL TABLE>>     <<RH.PV>>00516000
          PVUSERDSTN=    54,         <<PV USER TABLE>>         <<RH.PV>>00518000
          ARLDTABDSTN=   55,                                   <<MPEIV>>00520000
          DISCREQTABDSTN=56,                                   <<MPEIV>>00522000
       MSGHARBORTABDSTN=57,  <<MESSSAGE HARBOR TABLE>>         <<MPEIV>>00524000
       PRIMMSGTABDSTN=58, <<PRIMARY MESSAGE TABLE>>            <<MPEIV>>00526000
          MEASINFOTABDSTN=59,                                  <<MPEIV>>00528000
          FREEDSTN = 60;   << FIRST FREE DST >>                <<03554>>00532000
                                                                        00534000
          <<-------------------                                         00536000
            PCB CONFIGURATION                                           00538000
          ------------------->>                                         00540000
  EQUATE  PROGPCBN  =    1,                                    <<MPEIV>>00542000
          FREEPCBN  =    2;                                    <<MPEIV>>00544000
                                                                        00546000
          <<----------------------------------                          00548000
            SYSTEM GLOBAL AREA CONFIGURATION                            00550000
          ---------------------------------->>                          00552000
  EQUATE  SYSBASE   =    %1000,      <<STARTING ADDRESS OF SYSTEM AREA>>00554000
          SYSSIZE=%400,  <<SYS GLOBAL SIZE>>                   <<00101>>00556000
          SYSEXTSIZE=%200,<<SYS GLOBAL EXTENSION SIZE>>        <<00101>>00558000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>00560000
          FIRMWARESIZE=%104,<<AREA FOR FIRMWARE>>              <<02517>>00562000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>00564000
          FIRMWARESIZE=%330,<<RESERVED FOR SOFTDUMP FIRMWARE>> <<02510>>00566000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>00568000
          CSTIX     =    1,          <<CST TABLE>>                      00570000
          SYSCST    =    SYSBASE+CSTIX,                                 00572000
          DSTIX     =    2,          <<DST TABLE>>                      00574000
          SYSDST    =    SYSBASE+DSTIX,                                 00576000
          PCBIX     =    3,          <<PCB TABLE>>                      00578000
          SYSPCB    =    SYSBASE+PCBIX,                                 00580000
          ARSBMIX   =    4,                                    <<MPEIV>>00582000
          SYSARSBM  =    SYSBASE+ARSBMIX,                      <<MPEIV>>00584000
          IOQIX     =    5,          <<I/O QUEUE>>                      00586000
          SYSIOQ    =    SYSBASE+IOQIX,                                 00588000
          SBUFIX    =    6,          <<SYSTEM BUFFERS>>                 00590000
          SYSSBUF   =    SYSBASE+SBUFIX,                                00592000
       ICSIX=7,                                                <<MPEIV>>00594000
       SYSICS=SYSBASE+ICSIX,                                   <<MPEIV>>00596000
          LPDTIX    =    %10,        <<LOGICAL-PHYSICAL DEVICE TABLE>>  00598000
          SYSLPDT   =    SYSBASE+LPDTIX,                                00600000
          TABIX     =    LPDTIX,     <<TEMPORARY TABLE PTR>>            00602000
          TABLEPTR  =    SYSBASE+TABIX,                                 00604000
          STOPSIX   =    %11,        <<BREAKPOINT TABLE>>               00606000
          SYSSTOPS  =    SYSBASE+STOPSIX,                               00608000
          TRLIX     =    %12,        <<TIMER REQUEST LIST>>             00610000
          SYSTRL    =    SYSBASE+TRLIX,                                 00612000
          JCUTIX    =    %13,        <<JOB CUTOFF TABLE>>               00614000
          SYSJCUT   =    SYSBASE+JCUTIX,                                00616000
          SIRIX     =    %14,        <<SIR TABLE>>                      00618000
          SYSSIR    =    SYSBASE+SIRIX,                                 00620000
          DITIX     =    SIRIX,      <<DEVICE INFO TABLE (TEMP)>>       00622000
          DITPTR    =    SYSBASE+DITIX,                                 00624000
          JPCNTIX   =    %15,        <<JOB PROCESS COUNT TABLE>>        00626000
          SYSJPCNT  =    SYSBASE+JPCNTIX,                               00628000
          TBUFIX    =    %16,        <<TERMINAL BUFFERS>>               00630000
          SYSTBUF   =    SYSBASE+TBUFIX,                                00632000
          MONBUFIX  =    %17,        <<MONITORING BUFFER>>              00634000
          SYSMONBUF =    SYSBASE+MONBUFIX,                              00636000
          ILTIX     =    MONBUFIX,   <<ILTERRUPT LINKAGE TABLE (TEMP)>> 00638000
          ILTPTR    =    SYSBASE+ILTIX,                                 00640000
          DLTIX     =    %20,         <<DRIVER LINKAGE (TEMP)>><<0+.04>>00642000
          DLTPTR    =    SYSBASE+DLTIX,                        <<0+.04>>00644000
          SWAPTABIX =    %25,                                  <<MPEIV>>00646000
          SYSSWAPTAB=    SYSBASE+SWAPTABIX,                    <<MPEIV>>00648000
          VDSMTABIX =    %26,        <<VM MANAGEMENT TABLE >>  <<MPEIV>>00650000
          SYSVDSMTAB=    SYSBASE+VDSMTABIX,                    <<MPEIV>>00652000
          DISCREQTABIX=  %31,                                  <<MPEIV>>00654000
          SYSDISCREQTAB= SYSBASE+DISCREQTABIX,                 <<MPEIV>>00656000
          DFC       =    SYSBASE+%32,<<@CST-@DST>>                      00658000
          DFS       =    SYSBASE+%33,<<@CSTX-@DST>>                     00660000
          SYSDIT8   =    SYSBASE+%35,<<WORD 8 OF SYSTEM DISC DIT>>      00662000
          VDSENTRYIX=    %40,        <<VM ENTRY PTR >>         <<MPEIV>>00664000
          SYSVDSENTRY=   SYSBASE+VDSENTRYIX,                   <<MPEIV>>00666000
          VDSMAPIX  =    %41,        <<VM BITMAP PTR >>        <<MPEIV>>00668000
          SYSVDSMAP=     SYSBASE+VDSMAPIX,                     <<MPEIV>>00670000
       SPECREQTABIX=%42,                                       <<MPEIV>>00672000
       SYSSPECREQTAB=SYSBASE+SPECREQTABIX,                     <<MPEIV>>00674000
          ARLDIX    =    %44,                                  <<MPEIV>>00676000
          SYSARLD   =    SYSBASE+ARLDIX,                       <<MPEIV>>00678000
          NBANKSIX  =    %47,                                  <<MPEIV>>00680000
          NBANKS    =    SYSBASE+NBANKSIX,                     <<MPEIV>>00682000
          MAXAVAILREGIX= %45,                                  <<MPEIV>>00684000
          CSTBLKIX  =    %51,        <<CST BLOCK TABLE>>                00686000
          SYSCSTBLK =    SYSBASE+CSTBLKIX,                              00688000
          SYSANTICW =    SYSBASE+%52,  <<ANTICIPATORY WRITES>> <<00588>>00690000
          BUSYIX    =    %55,        <<BUSY TABLE>>                     00692000
          SYSBUSY   =    SYSBASE+BUSYIX,                                00694000
          HEADIX    =    %56,        <<HEAD TABLE>>                     00696000
          SYSHEAD   =    SYSBASE+HEADIX,                                00698000
          TAILIX    =    %57,        <<TAIL TABLE>>                     00700000
          SYSTAIL   =    SYSBASE+TAILIX,                                00702000
          STDIX     =    %60,                                           00704000
          STDPTR    =    SYSBASE+STDIX,                                 00706000
          CONTIX    =    %61,                                           00708000
          CONTPTR   =    SYSBASE+CONTIX,                                00710000
          HSYSDRT   =    SYSBASE+%71,<<HIGHEST DRT>>                    00712000
          CONSLDEV  =    SYSBASE+%74,<<CONSOLE LOGICAL DEVICE #>>       00714000
          COLD'LOAD'ID=  SYSBASE+%75,<<COLD LOAD ID>>                   00716000
                                                                        00718000
          MAXSSECT  =    SYSBASE+%100,<<FIRST OF MAX SPOOL SECTORS>>    00720000
          MAXSSECT1 =    MAXSSECT+1,                                    00722000
          NUMSSECT  =    SYSBASE+%102,                                  00724000
          NUMSSECT1 =    NUMSSECT+1,                                    00726000
          EXTSSECT  =    SYSBASE+%104,<<# SECTORS/SPOOLFILE EXT>>       00728000
          MAXCODESEG=    SYSBASE+%105,<<MAX CODE SEGMENT SIZE>>         00730000
          MAXSEGPROC=    SYSBASE+%106,<<MAX # OF CODE SEGS PER PROCESS>>00732000
          MAXDATA   =    SYSBASE+%107,<<MAX STACK SIZE (DL-Z)>>         00734000
          STDSTACK  =    SYSBASE+%110,<<DEFAULT STACK SIZE>>            00736000
          MAXXTRADSEG=   SYSBASE+%111,<<MAX XTRA DATA SEG SIZE>>        00738000
          MAXDSEGPROC=   SYSBASE+%112,<<MAX # OF DATA SEGS PER PROCESS>>00740000
                                                                        00742000
          CIWSP     =    SYSBASE+%113,<<W S PTR FOR COMMAND INTERP>>    00744000
          UPDATEL   =    SYSBASE+%114,<<UPDATE LEVEL>>                  00746000
          FIXL      =    SYSBASE+%115,<<FIX LEVEL>>                     00748000
          VERSION   =    SYSBASE+%116,<<VERSION>>                       00750000
          CPUTIME   =    SYSBASE+%117,<<DEFAULT CPU TIME LIMIT>>        00752000
          LOGONLIM  =    SYSBASE+%120,<<# OF SECONDS TO LOG ON>>        00754000
                                                                        00756000
          MAXSYSDST  =    SYSBASE+%124, <<LAST ALLOC SYS DST>> <<WH.20>>00758000
          MAXSYSCST  =    SYSBASE+%125, <<LAST ALLOC SYS CST>> <<WH.20>>00760000
          SLDISCADR1=    SYSBASE+%126,<<SL.PUB.SYS DISC ADDRESS>>       00762000
          SLDISCADR2=    SLDISCADR1+1,                                  00764000
          DIRDISCADR1=   SYSBASE+%130,<<DIRECTORY DISC ADDRESS>>        00766000
          DIRDISCADR2=   DIRDISCADR1+1,                                 00768000
          INITEXTLAB=    SYSBASE+%122, <<INITIATE EXTERNAL LABEL>>      00770000
          INITINTLAB=    SYSBASE+%123, <<INITIATE INTERNAL LABEL>>      00772000
                                                                        00774000
        CONSHOWCOM'LAB=SYSBASE+%133,<<EXT LABEL FOR>>          <<01165>>00776000
                                    <<SHOWCOM      >>          <<01165>>00778000
          CSIOWLAB  =    SYSBASE+%135,<<EXTERNAL LABEL FOR CSIOWAIT>>   00780000
          CCLOSELAB =    SYSBASE+%140,<<EXTERNAL LABEL FOR CCLOSE>>     00782000
          LPROCTAB  =    SYSBASE+%141,<<LOGICAL PROCESS TABLE>>         00784000
                                                                        00786000
          TERMEXTLAB=    SYSBASE+%155,<<TERMINATE EXTERNAL LABEL>>      00788000
          TERMINTLAB=    SYSBASE+%156,<<TERMINATE INTERNAL LABEL>>      00790000
          CIEXTLAB  =    SYSBASE+%157,<<COMMANDINTERP EXTERNAL LABEL>>  00792000
          CIINTLAB  =    SYSBASE+%160,<<COMMANDINTERP INTERNAL LABEL>>  00794000
          TRACEEXTLAB=   SYSBASE+%162,<<TRACE0' EXTERNAL LABEL>>        00796000
          TRACEINTLAB=   SYSBASE+%163,<<TRACE0' INTERNAL LABEL>>        00798000
          SPOOLINEXTLAB= SYSBASE+%161,<<SPOOLIN EXTERNAL LABEL>>        00800000
          SPOOLININTLAB= SYSBASE+%164,<<SPOOLIN INTERNAL LABEL>>        00802000
          SPOOLOUTEXTLAB=SYSBASE+%165,<<SPOOLOUT EXTERNAL LABEL>>       00804000
          SPOOLOUTINTLAB=SYSBASE+%166,<<SPOOLOUT INTERNAL LABEL>>       00806000
                                                                        00808000
          LOGBITS'  =    SYSBASE+%167,<<WHICH RECORDS TO LOG>>          00810000
          LOGBUF1   =    SYSBASE+%172,<<LOGGING BUFFER 1>>              00812000
          LOGBUF2   =    SYSBASE+%173,<<LOGGING BUFFER 2>>              00814000
          LOGRECSIZE'=   SYSBASE+%174,<<BUFFER SIZE IN SECTORS>>        00816000
          LOGFILESIZE'=  SYSBASE+%204,<<LOG FILE SIZE IN BLOCKS>>       00818000
          LOGFILENUM=    SYSBASE+%205,<<LOG FILE NUMBER>>               00820000
          MEASINFOTABIX= %261,                                 <<MPEIV>>00822000
          SYSMEASINFOTAB=SYSBASE+MEASINFOTABIX,                <<MPEIV>>00824000
          DISPQHEADIX=   %271,                                 <<MPEIV>>00826000
          SYSDISPQHEAD=  SYSBASE+DISPQHEADIX,                  <<MPEIV>>00828000
          DISPQTAILIX=   %272,                                 <<MPEIV>>00830000
          SYSDISPQTAIL=  SYSBASE+DISPQTAILIX,                  <<MPEIV>>00832000
          DSTLOGON  =    SYSBASE+%277,<<ACTIVE WELCOME DST>>            00834000
                                                                        00836000
          NPROCSTOP =    SYSBASE+%302,<<# OF WORDS IN STOP TABLE>>      00838000
          DEVRECSTOP=    SYSBASE+%304,<<DEVREC STOP ENTRY>>             00840000
          UCOPSTOP  =    SYSBASE+%306,<<UCOP STOP ENTRY>>               00842000
          LOGSTOP   =    SYSBASE+%310,<<LOGGING STOP ENTRY>>            00844000
          IOMESSSTOP=    SYSBASE+%312,<<I/O MESSAGE STOP ENTRY>>        00846000
          SDSLDEVLAB=    SYSBASE+%323,<<EXT LABEL FOR SDSLDEV>><<0+.04>>00848000
          MAXQUEUE  =   SYSBASE+%333,<<MAX JOB PRIORITY>>               00850000
          DEFAULTJOBPRI=200,                                   <<00.EB>>00852000
          DEFAULTQUEUE= SYSBASE+%334,<<DEFUALT JOB PRIORITY>>           00854000
           MEMLGSTOP =     SYSBASE+%314,<<MEMLOGP STOP ENTRY>>          00856000
          DSCHECKLAB=    SYSBASE+%335,<<DSCHECK EXTERNAL LABEL>>        00858000
          DSOPENLAB =    SYSBASE+%336,<<EXTERNAL LABEL FOR DSOPEN>>     00860000
          DSCLOSELAB=    SYSBASE+%337,<<EXTERNAL LABEL FOR DSCLOSE>>    00862000
          MWRITECONVLAB= SYSBASE+%340,<<EXT LABEL FOR MANAGEWRITECONV>> 00864000
          CONSDSLINE'LAB=SYSBASE+%341,<<EXT LABEL FOR CONSDSLINE'>>     00866000
          CONSMPLINE'LAB=SYSBASE+%374,<<EXT LABEL FOR CONSMPLINE'>>     00868000
          CONSMRJE'LAB=  SYSBASE+%375,<<EXT LABEL FOR CONSMRJE>><<MRJE>>00870000
          CXREMOTELAB=   SYSBASE+%342,<<EXT LABEL FOR CXREMOTE>>        00872000
          CXDSLINELAB=   SYSBASE+%343,<<EXT LABEL FOR CXDSLINE>>        00874000
          CXRFALAB  =    SYSBASE+%344,<<EXTERNAL LABEL FOR CXRFA>>      00876000
          DSIMAGELAB=    SYSBASE+%345,<<EXTERNAL LABEL FOR DSIMAGE>>    00878000
         AVR       =  SYSBASE+%346,                            <<TL.02>>00880000
          INITTCP=       SYSBASE+%347,<<TERMINAL>>             <<00888>>00882000
          <<INITIALIZATION CHANNEL PROGRAM>>                   <<00888>>00884000
          <<SEE "INITTCP'" IN ILT DESCRIPTION>>                <<00888>>00886000
          DSBREAKLAB=    SYSBASE+%360,<<EXTERNAL LABEL FOR DSBR<<RH.PV>>00888000
          LASTBANKIX=    %361,                                 <<MPEIV>>00890000
          SYSLASTBANK=   SYSBASE+LASTBANKIX,                   <<MPEIV>>00892000
          LASTBASEIX=    %362,                                 <<MPEIV>>00894000
          SYSLASTBASE=   SYSBASE+LASTBASEIX,                   <<MPEIV>>00896000
          VMOUNTINFO=sysbase+%365, <<PV CONTROL WORD>>         <<WH.01>>00898000
          SYSEXTPTR=SYSBASE+%377; <<PTR TO SYSGLOB EXT>>       <<00101>>00900000
EQUATE    CONS3270'LAB= %73,  << SYSGLOBEXT INDEX >>           <<00838>>00902000
          GLOBMITVERSION = %74, << MIT VERSION >>              <<00931>>00904000
          GLOBMITUPDATE  = %75, << MIT UPDATE  >>              <<00931>>00906000
          GLOBMITFIX     = %76, << MIT FIX     >>              <<00931>>00908000
          SYSEXTPTR'DB= %377;                                  <<00838>>00910000
POINTER   SYSGLOBEXT  = SYSEXTPTR'DB;  << LST/SST INSTR. >>    <<00838>>00912000
                                                                        00914000
          <<----------------                                            00916000
            PCB DEFINITION                                              00918000
          ---------------->>                                            00920000
DEFINE  ABSDBFLAG=(0:1)#,                                      <<MPEIV>>00922000
   <<   STOVRALLFLAG=(1:1)#,             >>                    <<03635>>00924000
        STACKFIELD=(1:10)#,                                    <<MPEIV>>00926000
   <<   STK=(1:10)#,                     >>                    <<03635>>00928000
   <<   JUNKWAITFLAG=(7:1)#,             >>                    <<03635>>00930000
   <<   FATHERWAITFLAG=(11:1)#,          >>                    <<03635>>00932000
        MEMWAITFLAG=(15:1)#,                                   <<MPEIV>>00934000
        FATHERPINFIELD=(0:8)#,                                 <<MPEIV>>00936000
        SONPINFIELD=(8:8)#,                                    <<MPEIV>>00938000
        BROTHERPINFIELD=(0:8)#,                                <<MPEIV>>00940000
        DISPQFLAG=(0:1)#,                                      <<MPEIV>>00942000
        PRIFIELD=(8:8)#,                                       <<MPEIV>>00944000
        PSIMFIELD=(0:3)#,                                      <<MPEIV>>00946000
        LIVFLAG=(0:1)#,                                        <<MPEIV>>00948000
        PROCESSTYPEFIELD=(6:3)#,                               <<MPEIV>>00950000
        PROCRESIDENTFLAG=(6:1)#,                               <<MPEIV>>00952000
        LQFLAG=(1:1)#,                                         <<MPEIV>>00954000
        SARFLAG=(0:1)#;                                        <<MPEIV>>00956000
                                                               <<MPEIV>>00958000
EQUATE  ACTIVE =0,                                             <<MPEIV>>00960000
        JUNKWAIT=7,                                            <<MPEIV>>00962000
        FATHERWAIT=11;                                         <<MPEIV>>00964000
                                                               <<MPEIV>>00966000
INTEGER LASTBANK=DB+LASTBANKIX, <<DB ACCESS TO SYSGLOB CELLS>> <<MPEIV>>00968000
        LASTBASE=DB+LASTBASEIX,                                <<MPEIV>>00970000
        SWAPTABSYSBASEINX=DB+SWAPTABIX;                        <<MPEIV>>00972000
                                                               <<MPEIV>>00974000
<<SEGMENT TABLE DESCRIPTORS>>                                  <<MPEIV>>00976000
<< INTEGER ARRAY SEGDESC00(*)=DB+0,         >>                 <<03552>>00978000
   <<         SEGDESC01(*)=DB+1,            >>                 <<03552>>00980000
   <<         SEGDESC02(*)=DB+2,            >>                 <<03552>>00982000
   <<         SEGDESC03(*)=DB+3;            >>                 <<03552>>00984000
                                                               <<MPEIV>>00986000
DEFINE<<SEGDESCFIRMINFO=SEGDESC00(X)#,      >>                 <<03552>>00988000
    <<  ABSENTFLAG=(0:1)#,                  >>                 <<03552>>00990000
    <<  PRIVMODEFLAG=(1:1)#,                >>                 <<03552>>00992000
    <<  REFERENCEDFLAG=(2:1)#,              >>                 <<03552>>00994000
    <<  DATASIZEFIELD=(3:13)#,              >>                 <<03552>>00996000
    <<  CODESIZEFIELD=(4:12)#,              >>                 <<03552>>00998000
    <<  SEGDESCFLAGS=SEGDESC01(X)#,         >>                 <<03552>>01000000
        SEGRESIDENTFLAG=(7:1)#,                                <<MPEIV>>01002000
        SYSTEMFLAG=(6:1)#,                                     <<MPEIV>>01004000
    <<  SEGDESCBANK=SEGDESC02(X)#,          >>                 <<03552>>01006000
    <<  SEGDESCHODA=SEGDESC02(X)#,          >>                 <<03552>>01008000
    <<  SEGDESCADDR=SEGDESC03(X)#,          >>                 <<03552>>01010000
    <<  SEGDESCLODA=SEGDESC03(X)#,          >>                 <<03552>>01012000
        DISCCOPYVALIDFLAG=(0:1)#,                              <<MPEIV>>01014000
       VMALLOC=(9:7)#,                                         <<MPEIV>>01016000
       STKFLAG=(3:1)#;                                         <<MPEIV>>01018000
                                                                        01020000
          <<-------------------------                                   01022000
            PCB EXTENSION EQUATIONS                                     01024000
          ------------------------->>                                   01026000
  EQUATE  PXGLOB    =    8,          <<GLOBAL AREA SIZE>>               01028000
          PXFIXCRSIZE=   80,         <<RES FIXED AREA SIZE>>   <<01798>>01030000
          PXFIXLKSIZE=   80,                                   <<01556>>01032000
          PXFILE    =    200,        <<FILE AREA SIZE>>        <<MPEIV>>01034000
          PXLINK    =    4,          <<LINK AREA SIZE>>        <<MPEIV>>01036000
          PCBXLKSIZE=    PXGLOB+PXFIXLKSIZE+PXFILE+PXLINK,     <<MPEIV>>01038000
          PCBXCRSIZE=    PXGLOB+PXFIXCRSIZE+PXLINK;                     01040000
                                                                        01042000
          <<----------------------                                      01044000
            LOGICAL DEVICE TABLE                                        01046000
          ---------------------->>                                      01048000
  EQUATE  DCFIRST   =    1,          <<POINTER TO FIRST CLASS>>         01050000
          DCNUM     =    2,          <<NUMBER OF DEVICE CLASSES>>       01052000
          ONEK      =    1000,                                          01054000
          DCSIZE    =    3,          <<SIZE OF DEVICE CLASS TABLE>>     01056000
          LDT1      =    1,          <<2ND WORD OF TABLE>>              01058000
          LDT2      =    2,          <<3RD WORD OF ENTRY>>              01060000
          LDT3      =    3,          <<4TH WORD OF ENTRY>>              01062000
          LDT4      =    4;          <<5TH WORD OF ENTRY>>              01064000
  DEFINE  VOL       =    (0:8)#,     <<VOLUME TABLE INDEX>>             01066000
          RECW      =    (0:8)#,     <<PHYSICAL RECORD WIDTH>>          01068000
          RANGE     =    (10:3)#,    <<TYPE RANGE>>                     01070000
          TYP       =    (10:6)#,    <<TYPE>>                           01072000
          TERMTYP    =    (0:7)#,       <<TERMINAL  TYPE>>              01074000
          SPOOLST   =    (0:2)#,     <<SPOOLING STATE>>                 01076000
          FILEBIT   =    (2:1)#,     <<DEVICE BELONGS TO FILE SYSTEM>>  01078000
          OUTCL     =    (7:1)#,     <<OUTPUT DEVICE IS CLASS INDEX>>   01080000
          CSBIT     =    (8:1)#,   <<CS DEVICE>>                        01082000
          OUTDEV    =    (8:8)#;     <<OUTPUT DEVICE>>                  01084000
                                                               <<00071>>01086000
          <<------------>>                                     <<00071>>01088000
          <<DEVICE TYPES>>                                     <<00071>>01090000
          <<------------>>                                     <<00071>>01092000
  EQUATE DISC0=0, <<MOVING HEAD DISC>>                         <<00071>>01094000
         DISC1=1, <<FIXED HEAD DISC>>                                   01096000
         DISC2=2, <<FLOPPY DISC>>                              <<03550>>01098000
         DISC3=3; <<CS'80 DISC>>                               <<03550>>01100000
                                                               <<00071>>01102000
                                                                        01104000
          <<--------------------------------                            01106000
            LOGICAL DEVICE TABLE EXTENSION                              01108000
          -------------------------------->>                            01110000
  DEFINE  LDTX'SA   =    (0:1)#,     <<SEEKAHEAD FLAG>>        <<01853>>01112000
          TERMSPEED =    (10:6)#;                              <<01853>>01114000
  EQUATE  LDTX2     =  2;                                      <<03004>>01116000
  DEFINE<<TERMPROTOCOL  =  (8:8)#, >><< TERMINAL PROTOCOL,  >> <<03708>>01118000
                                     << RESERVED FOR FUTURE >> <<03708>>01120000
          TERMBOARD     =  (0:1)#;  << TERM. BOARD TYPE  >>    <<03004>>01122000
  EQUATE  LYNX'TERM     =  1,       << TERM. IS ON LYNX  >>    <<03004>>01124000
          ADCC'TERM     =  0;       << TERM. IS ON ADCC  >>    <<03004>>01126000
                                                               <<00.06>>01128000
          <<--------------------                                        01130000
            DEVICE CLASS TABLE                                          01132000
          -------------------->>                                        01134000
                                                                        01136000
  EQUATE  DIRACCESS =    0,  <<DIRECT ACCESS>>                          01138000
          SERINPUT  =    1,  <<SERIAL INPUT>>                           01140000
          CONINOUT  =    2,  <<CONCURRENT I/O>>                         01142000
          NCONINOUT =    3,  <<NON CONCURRENT I/O>>                     01144000
          SEROUTPUT =    4,  <<SERIAL OUTPUT>>                          01146000
          TERMDEVTYPE=   16; <<TERMINAL DEVICE TYPE>>                   01148000
  DEFINE  DIRACC    =    (15:1)#,                                       01150000
          SERINP    =    (14:1)#,                                       01152000
          CONIO     =    (13:1)#,                                       01154000
          NCONIO    =    (12:1)#,                                       01156000
          SEROUT    =    (11:1)#;                                       01158000
                                                                        01160000
          <<-------------------------------                             01162000
            LOGICAL-PHYSICAL DEVICE TABLE                               01164000
          ------------------------------->>                             01166000
  EQUATE  LPDT1     =    1;          <<2ND WORD OF ENTRY>>              01168000
  DEFINE  AJOBS     =    (2:1)#,     <<ACCEPT JOBS>>                    01170000
          ADATA     =    (3:1)#,     <<ACCEPT DATA>>                    01172000
          NSDV      =    (4:1)#,     <<NON-SYS DOMAIN DRIVE>>  <<RH.PV>>01174000
          DUPLIC    =    (5:1)#,     <<DUPLICATIVE>>                    01176000
          INTRACT   =    (6:1)#,     <<INTERACTIVE>>                    01178000
          SUBTYPE   =    (12:4)#;    <<DEVICE SUBTYPE>>                 01180000
                                                                        01182000
  EQUATE  MAXSUBTYPES     = 16,  <<MAX. SUBTYPES PER TYPE>>    <<03550>>01184000
          MAXSUBTYPESP1   = MAXSUBTYPES+1;                     <<03550>>01186000
                                                               <<03550>>01188000
  EQUATE  TAPETYPE  =    24;   << DEVICE TYPE FOR MAG TAPE >>  <<03635>>01190000
                                                               <<03635>>01192000
                                                               <<03635>>01194000
                                                               <<03635>>01196000
          <<-----------------                                           01198000
            CS DATA SEGMENT                                             01200000
          ----------------->>                                           01202000
EQUATE     <<CS DATA SEGMENT INFO SECTION>>                             01204000
     COMSYSLEN    = 0,                                         <<01165>>01206000
     CSLDTXENTNUM = 1,                                                  01208000
<<   CSLDTXENTPTR = 2,  >>                                     <<01165>>01210000
     GROUPENTPTR  = 4,                                                  01212000
     DRIVERENTNUM = 5,                                                  01214000
     DRIVERENTPTR = 6;                                                  01216000
                                                                        01218000
DEFINE     << CSLDTX (CS DATA SEGMENT) FIELDS >>                        01220000
     CSLDTXENTRYSIZE     = CSLDTX          #,                  <<01165>>01222000
     CSLDTXDRCHANGEABLE  = CSLDTX( 1).(0: 1)#,                          01224000
     CSLDTXHSI'CHAN      = CSLDTX(1).(1:4)#,                            01226000
     CSLDTXEXP           = CSLDTX( 1).(5:1)#,                  <<01165>>01228000
     CSLDTX'DEV'OPENED   = CSLDTX( 1).(6:1)#,                  <<01165>>01230000
  << CSLDTXEXP1          = CSLDTX( 1).(7:1)#, >>               <<01165>>01232000
     CSLDTXPROTOCOL      = CSLDTX( 1).(8: 8)#,                          01234000
     CSLDTXMODE          = CSLDTX( 2).(6: 4)#,                          01236000
     CSLDTXCODE          = CSLDTX( 2).(10:6)#,                          01238000
<<   CSLDTXMISC          = CSLDTX( 3).(0: 8)#,>>               <<01165>>01240000
     CSLDTXDUAL'SPEED    = CSLDTX( 3).(0: 1)#,                          01242000
     CSLDTXHALF'SPEED    = CSLDTX( 3).(1: 1)#,                          01244000
     CSLDTXXMSN'MODE     = CSLDTX( 3).(2: 2)#,                          01246000
     CSLDTXSPEEDCHNGBLE  = CSLDTX( 3).(4: 1)#,                          01248000
     CSLDTXANSWER        = CSLDTX( 3).(5: 2)#,                          01250000
     CSLDTXDIAL          = CSLDTX( 3).(7: 1)#,                          01252000
     CSLDTXAUTO'DIAL'LDN = CSLDTX( 3).(8:8)#,                  <<01165>>01254000
     CSLDTXDOPTIONS      = CSLDTX( 4)       #,                          01256000
     CSLDTXRECV'TIMEOUT  = CSLDTX( 5)       #,                          01258000
     CSLDTXLOCAL'TIMEOUT = CSLDTX( 6)       #,                          01260000
     CSLDTXCONCT'TIMEOUT = CSLDTX( 7)       #,                          01262000
     CSLDTXINSPEED       = DCSLDTX(4)       #,  << 2 WORDS >>           01264000
     CSLDTXOUTSPEED      = DCSLDTX(5)       #,  << 2 WORDS >>           01266000
     CSLDTXPBUFFSIZE     = CSLDTX(12)       #,                          01268000
     CSLDTXLDEV          = CSLDTX(13).(0:8) #,                 <<00.06>>01270000
     CSLDTXDRINDEX       = CSLDTX(13).(8:8) #,                 <<00.06>>01272000
     CSLDTXCONTPTR       = CSLDTX(14)       #,                          01274000
     CSLDTXIDLISTPTR     = CSLDTX(15)       #,                          01276000
     CSLDTXPHLISTPTR     = CSLDTX(16)       #,                 <<01165>>01278000
<<   CSLDTXSHOWCOM       = CSLDTX(17)       #,>>               <<01165>>01280000
<<   CSLDTXDUMP'DATE     = CSLDTX(32)       #,>>               <<01165>>01282000
     CSLDTX'DEV'DUMPED   = CSLDTX(33).(0: 1)#,                 <<01165>>01284000
<<   CSLDTXCUR'DUMP'NUM  = CSLDTX(33).(8: 8)#,>>               <<01165>>01286000
     CSLDTXMAX'DUMPS     = CSLDTX(34)       #;                 <<01165>>01288000
                                                                        01290000
DEFINE     << DRIVER ENTRY (CS DATA SEGMENT) FIELDS >>                  01292000
     DRENTRYSIZE         = DRIVERENTRY           #,                     01294000
     DRNAME              = DRIVERENTRY(1)        #,  << 4 WORDS >>      01296000
     DRDLTP              = DRIVERENTRY(5)        #,                     01298000
     DRLCMPLABEL         = DRIVERENTRY(5)        #,                     01300000
     DRSLCPLABEL         = DRIVERENTRY(6)        #,                     01302000
     DRPHYSDVRPLABEL     = DRIVERENTRY(7)        #,                     01304000
     DREDITORPLABEL      = DRIVERENTRY(8)        #,                     01306000
     DRIHPLABEL          = DRIVERENTRY(9)        #,                     01308000
     DRCAPSECTSIZE       = DRIVERENTRY(10)       #,                     01310000
     DRRETRIES'FLAGS     = DRIVERENTRY(11)       #,                     01312000
     DRRETRIES           = DRIVERENTRY(11).(0: 8)#,                     01314000
     DRLCN               = DRIVERENTRY(15)       #;                     01316000
                                                                        01318000
DEFINE     << DLT  FIELDS >>                                            01320000
     LCM'PLABEL          = DLT(1)           #,                          01322000
     CSSLC'PLABEL        = DLT(2)           #,                          01324000
     PHYS'DVR'PLABEL     = DLT(3)           #,                          01326000
     CSIH'PLABEL         = DLT(4)           #,                          01328000
     EDITOR'PLABEL       = DLT(6)           #;                          01330000
                                                                        01332000
DEFINE     << POINTERS SECTION OF DIT >>                                01334000
     CONTROLP            = DIT(9) #;                           <<01025>>01336000
                                                                        01338000
DEFINE     << CS STANDARD DIT FIELDS >>                                 01340000
     CSSUBTYPE           = STANDARD( 2).(0: 4)#,                        01342000
     CSDEVTYPE           = STANDARD( 2).(4: 6)#,                        01344000
     CSLCN               = STANDARD( 2).(10:6)#,                        01346000
     CSMODE              = STANDARD( 6).(6: 4)#,                        01348000
     CSCODE              = STANDARD( 6).(10:6)#,                        01350000
     CSPROTOCOL          = STANDARD( 7).(0: 8)#,                        01352000
     CSDOPTIONS          = STANDARD( 8)       #,                        01354000
     CSHSI'CHAN          = STANDARD( 9).(3: 4)#,                        01356000
     CSDUAL'SPEED        = STANDARD( 9).(8: 1)#,                        01358000
     CSHALF'SPEED        = STANDARD( 9).(9: 1)#,                        01360000
     CSXMSN'MODE         = STANDARD( 9).(10:2)#,                        01362000
     CSSPEED'CHNGBLE     = STANDARD( 9).(12:1)#,                        01364000
     CSANSWER            = STANDARD( 9).(13:2)#,                        01366000
     CSDIAL              = STANDARD( 9).(15:1)#,                        01368000
     CSRECV'TIMEOUT      = STANDARD(11)       #,                        01370000
     CSLOCAL'TIMEOUT     = STANDARD(12)       #,                        01372000
     CSCONCT'TIMEOUT     = STANDARD(13)       #,                        01374000
     CSINSPEED           = STANDARD(14)       #,     << 2 WORDS >>      01376000
     CSOUTSPEED          = STANDARD(16)       #,     << 2 WORDS >>      01378000
<<   CSTRACEINFO          = STANDARD(31)       #,>>            <<01165>>01380000
<<   CSTRACEALL           = STANDARD(31).(0: 1)#,>>            <<01165>>01382000
<<   CSTRACEMASK          = STANDARD(31).(1: 7)#,>>            <<01165>>01384000
<<   CSTRACENTNUM         = STANDARD(31).(8: 8)#,>>            <<01165>>01386000
     CSMAXRETRIES        = STANDARD(32).(0: 8)#;               <<01025>>01388000
                                                                        01390000
          DEFINE                                               <<00506>>01392000
          RECLOGPLABEL      =    SYSBASE+ABSOLUTE(SYSEXTPTR)+%62#,      01394000
          RECLOGDELTAP      =    SYSBASE+ABSOLUTE(SYSEXTPTR)+%63#,      01396000
          ULOGPLABEL        =    SYSBASE+ABSOLUTE(SYSEXTPTR)+%60#,      01398000
          ULOGDELTAP        =    SYSBASE+ABSOLUTE(SYSEXTPTR)+%61#,      01400000
          ULOGRSTARTDELTAP  =    SYSBASE+ABSOLUTE(SYSEXTPTR)+%64#,      01402000
          ULOGRSTARTPLABEL  =    SYSBASE+ABSOLUTE(SYSEXTPTR)+%65#;      01404000
  EQUATE  DRINFOSIZE=    11,         <<DRIVER TABLE STD SIZE>>          01406000
          LCMP      =    10,         <<POINTER SECTION OF DIT>>         01408000
          MPESTDSIZE=    13,         <<MPE DIT STD SIZE>>               01410000
          CSSTDSIZE =    70,         <<CS DIT STD SIZE>>       <<01165>>01412000
          INTCOMDELAY=   1, <<INTERCOMPONENT DELAY>>                    01414000
          CIRPDELAY =    2, <<CIRCULAR POLL DELAY >>                    01416000
          CONTRSTART=    35,<<CONTROL TRIBUTARY >>             <<01165>>01418000
                            <<SECTION START     >>             <<01165>>01420000
          CSSHOWCOMLEN=  18,                                   <<01165>>01422000
          CSSHOWCOMINFO= 17,<<SHOWCOMINFO START IN >>          <<01165>>01424000
                            <<CSLDTX               >>          <<01165>>01426000
          MANLANSWER=    1,      <<MANUAL ANSWER>>                      01428000
          AUTOANSWER=    2,      <<AUTOMATIC ANSWER>>                   01430000
          NUMSEQ    =    2,      <<NUMBER OF SEQUENCES>>                01432000
          CSXSTART  =    7,      <<CSLDTX STARTS IN CSTAB>>             01434000
          CONSEQSTART=   5;      <<COMPOENCE SEQUENCE>>        <<01025>>01436000
                              <<START FOR CONTROL SECTION>>    <<01025>>01438000
  EQUATE  CSDEV17 =17,     <<LOWEST LEGAL CS DEVICE TYPE>>     <<00888>>01440000
          CSDEV18 =18,                                         <<00888>>01442000
          CSDEV19 =19;     <<HIGHEST LEGAL CS DEVICE TYPE>>    <<00888>>01444000
  DEFINE  REMOSTAT      = 4).(0:8#,    <<REMOTE STATIONS>>              01446000
          NUMCOMP       = 4).(8:8#,  <<# OF COMPONENTS>>               01448000
          FIRSTCOMP     = 3).(0:8#,                                     01450000
          SWITCHED  =    (LPDT(LDEV&LSL(1)+LPDT1).SUBTYPE MOD 4)=0#,    01452000
          NONSWITCHED=   1<=(LPDT(LDEV&LSL(1)+LPDT1).SUBTYPE MOD 4)<=4#,01454000
          MODEM      =   0<=(LPDT(LDEV&LSL(1)+LPDT1).SUBTYPE MOD 4)<=2#,01456000
          HARDWIRED =    3<=(LPDT(LDEV&LSL(1)+LPDT1).SUBTYPE MOD 4)<=4#,01458000
          SUPERVISED=    3<=CSLDTXMODE<=4#,                             01460000
          CSDEVICE  =    CSDEV17<=LDTENT(LDT2).TYP<=CSDEV19#,  <<00888>>01462000
          CSDEV     =    CSDEV17<=TYPE<=CSDEV19#,              <<00888>>01464000
          CSPRESENT =    CSTAB(CSLDTXENTNUM)>0#,                        01466000
          CONTENTION=    1<=CSLDTXMODE<=2#,                             01468000
          CONTROLST =    CSLDTXMODE=3#,                                 01470000
          TRIBUTARY =    CSLDTXMODE=4#;                                 01472000
                                                                        01474000
          <<--------------                                              01476000
            DRIVER TABLE                                                01478000
          -------------->>                                              01480000
  EQUATE  DVR1      =    1,          <<2ND WORD OF ENTRY>>              01482000
          DVR2      =    2;          <<3RD WORD OF ENTRY>>              01484000
  DEFINE  CRBIT     =    (0:1)#,     <<DRIVER IS CORE RESIDENT>>        01486000
          DVRCHAN   =      (1:3)#,       <<CHANNEL #>>                  01488000
          DSBIT     =    (7:1)#,                               <<03002>>01490000
          DSDRTN    =      (8:8)#,       <<LDEV # DS DEV LINKED TO>>    01492000
          DRTFIELD  =    (0:9)#,                               <<03002>>01494000
          UNITFIELD =    (9:7)#;                               <<03002>>01496000
                                                                        01498000
          <<--------------                                              01500000
            VOLUME TABLE                                                01502000
          -------------->>                                              01504000
  EQUATE  VTABCOLDLOADID=1,          <<COLD LOAD ID IN FIRST ENTRY>>    01506000
          VTABSYSVOLNUM =2,          <<NUMB. OF SYS. ENTRIES>> <<RH.PV>>01508000
          VMINTEGRITY   =3,          << VM DATA INTERGITY WRD>><<MPEIV>>01510000
          VTAB8     =     8,         << VTAB ENTRY WORD 8  >>  <<MPEIV>>01512000
          VTAB9     =     9,         << VTAB ENTRY WORD 9  >>  <<MPEIV>>01514000
          VTAB10    =    10,         << VTAB ENTRY WORD 10 >>  <<MPEIV>>01516000
          VTAB11    =    11,         << VTAB ENTRY WORD 11 >>  <<MPEIV>>01518000
          VTAB12    =    12;         << VTAB ENTRY WORD 12 >>  <<MPEIV>>01520000
  DEFINE  VTABLDEV  =    (0:8)#,     << LOGICAL DEVICE #>>     <<MPEIV>>01522000
          VMS       =    (12:1)#;    << VIR. MEM. SUPPORTING >><<MPEIV>>01524000
                                                                        01526000
          <<-------------------------------->>                 <<MPEIV>>01528000
          <<  VIRTUAL MEM MANAGEMENT TABLE  >>                 <<MPEIV>>01530000
          <<-------------------------------->>                 <<MPEIV>>01532000
                                                               <<MPEIV>>01534000
$INCLUDE INCLVMLD                                              <<MPEIV>>01536000
EQUATE BMOFFSET   = 16;  << VDSMTAB ENTRY HEADER SIZE >>       <<MPEIV>>01538000
  DEFINE L'         = LOGICAL#,                                <<MPEIV>>01540000
         D'         = DOUBLE#;                                 <<MPEIV>>01542000
                                                               <<MPEIV>>01544000
          <<---------------------                                       01546000
            CONFIGURATION TABLE                                         01548000
          --------------------->>                                       01550000
  EQUATE  CORESIZE  =    0,          <<CORE SIZE IN K WORDS>>           01552000
          COREX'    =    1,          <<CORE SIZE INDEX>>                01554000
          SSS       =    2,          <<STD STACK SIZE>>                 01556000
          DRTNUM    =    3,          <<HIGHEST DRT #>>                  01558000
    <<    TERMPRI   =    4,     >>   <<TERMINAL BOUND PRIOR>>  <<03635>>01560000
    <<    NORMPRI   =    5,     >>   <<NORMAL PRIORITY>>       <<03635>>01562000
    <<    CPUPRI    =    6,     >>   <<CPU BOUND PRIORITY>>    <<03635>>01564000
          LOGON     =    7,          <<NUMBER OF SECONDS TO LOGON>>     01566000
          LOGRECSIZE=    8,          <<LOG FILE RECORD SIZE>>           01568000
          LOGFILESIZE=   9,          <<LOG FILE SIZE IN RECORDS>>       01570000
          LOGFILENUM'=   10,         <<LOG FILE NUMBER>>                01572000
          LOGBITS   =    11,         <<WHAT IS BEING LOGGED>>           01574000
          CPULIM    =    16,         <<DEFAULT CPU TIME LIMIT>>         01576000
          FILESDUMPED=   17,         <<USER FILES ON TAPE>>             01578000
          HLDEV'    =    18,         <<HIGHEST LOGICAL DEVICE #>>       01580000
          HVOL'     =    19,         <<HIGHEST VOLUME NUMBER>>          01582000
          DVCLSIZE' =    20,         <<DEVICE CLASS TABLE SIZE>>        01584000
          FIXLEVEL' =    21,         <<MPE FIX LEVEL>>                  01586000
          COLDLOADID'=   22,         <<COLD LOAD COUNT>>                01588000
          MAXINITSEG'=   23,         <<MAX INITIAL SEGMENT SIZE>>       01590000
          DISCENTRY'=    24,         <<DISC COLD LOAD ENTRY POINT>>     01592000
          OLDVTABSIZE=   25,         <<SIZE OF OLD VOLUME TABLE>>       01594000
          OLDINFOSIZE=   26,         <<SIZE OF OLD INFO TABLE>>         01596000
    <<    TSLICE    =    27,    >>  <<TIME QUANTUM>>           <<03635>>01598000
          MAXSPOOLF =    28,         <<MAX OPEN SPOOFLES>>              01600000
          CSTABSIZE =    29,         <<CS DATA SEGMENT>>                01602000
          NUMADVRS  =    32,         <<# OF ADDITIONAL CS DRIVERS>>     01604000
          KILOSECTS =    15,        <<DOUBLE INDEX FOR MAX              01606000
                                    SPOOLFILE KILOSECTORS>>             01608000
          EXTSSECT' =    33,        <<SECTORS/SPOOLFILE EXT>>           01610000
          UPDATEL'  =    34,        <<UPDATE LEVEL>>                    01612000
          VERSION'  =    35,        <<VERSION>>                <<SD.00>>01614000
          SERIALDISCLOAD'=36,        <<TAPELOAD FROM SDISC>>   <<00931>>01616000
          MITVERSION =   37,         <<MIT VERSION>>           <<00931>>01618000
          MITUPDATE  =   38,         <<MIT UPDATE >>           <<00931>>01620000
          MITFIX     =   39,         <<MIT FIX    >>           <<03002>>01622000
          ID0        =   40,        << 4 CONVERSION     >>     <<03002>>01624000
          ID1        =   41,        << IDENTIFICATION   >>     <<03002>>01626000
          ID2        =   42,        << WORDS            >>     <<03002>>01628000
          ID3        =   43,                                   <<03603>>01630000
          TAPERECSIZE' = 44;        <<SYSTEM PORTION REC SIZE>><<03603>>01632000
                                                               <<03002>>01634000
          << CONVERSION BITS FOR CTAB0 WORDS 40-43 >>          <<03002>>01636000
  DEFINE  DRTCNVRT   = (0:1)#, <<ID0; 0=7 BIT DRT, 1= 9 BIT >> <<03002>>01638000
          LYNXCNVRT  = (1:1)#; <<ID0; 1= NO. OF TBUFS       >> <<03002>>01640000
                               << (CTAB(TBUFNUM)) CONVERTED >> <<03002>>01642000
                                                               <<03002>>01644000
  DEFINE  LOADTYPE=(15:1)#, <<SET IF>>                         <<00678>>01646000
                            <<SYSDUMP WAS TO A SERIAL DISC>>   <<00678>>01648000
          LOADDATE=(14:1)#; <<SET IF>>                         <<00678>>01650000
                            <<SYSDUMP WAS A FUTURE'DATE DUMP>> <<00678>>01652000
                                                                        01654000
  EQUATE  CSTNUM    =    0,      <<# OF CST ENTRIES>>                   01656000
          DSTNUM    =    1,      <<# OF DST ENTRIES>>                   01658000
          PCBNUM    =    2,      <<# OF PCB ENTRIES>>                   01660000
          IOQNUM    =    3,      <<# OF IOQ ENTRIES>>                   01662000
          TBUFNUM   =    4,      <<# OF TERMINAL BUFFERS>>              01664000
          CSTXNUM   =    5,      <<# OF CST EXTENSION ENTRIES>>         01666000
          ICSSIZE   =    6,      <<# OF WORDS ON ICS>>                  01668000
          UCRQNUM   =    7,      <<# OF UCOP REQ QUEUE ENTRIES>>        01670000
          STOPNUM   =    8,          <<# OF BREAKPOINT TABLE ENTRIES>>  01672000
          TRLNUM    =    9,      <<# OF TIMER REQUEST LIST ENTRIES>>    01674000
          RINS'     =    10,         <<# OF RINS>>                      01676000
          GRINS'    =    11,         <<MAX # OF GLOBAL RINS>>           01678000
          SBUFNUM   =    12,         <<# OF SYSTEM BUFFERS>>            01680000
          CONPROGNUM=    13,         <<# OF CONCURRENT PROGRAMS>>       01682000
          << TYPEBUF (WORD 15) IS RESERVED FOR FUTURE USE >>   <<03708>>01686000
    <<    TYPEBUF   =    15,     << TYPE-AHEAD BUFFER SIZE >>  <<03708>>01688000
          VIRMEMSECT'=   20,     <<SIZE OF VIRTUAL MEMORY>>             01690000
          DIRSECT'  =    21,         <<SIZE OF DIRECTORY IN SECTORS>>   01692000
          MCSS      =    30,     <<MAY CODE SEG SIZE>>                  01694000
          MCSP      =    31,         <<MAX CODE SEGS/PROCESS>>          01696000
          MSTACK    =    32,         <<MAX STACK SIZE>>                 01698000
          MXDSS     =    33,     <<MAX EXTRA DATA SEG SIZE>>            01700000
          MXDSP     =    34,         <<MAX XTRA DATA SEGS/PROCESS>>     01702000
          MAXRSES   =    40,         <<MAX # OF RUNNING SESSION>>       01704000
          MAXRJOB  =  41,                                      <<00506>>01706000
          NLOGPROCS'  =  42,                                   <<00506>>01708000
          LOGIDS'=43,                                          <<01639>>01710000
        DISCREQTABLE=44,            <<DISQ REQUEST TABLE LENGTH>>       01712000
        SPECIALREQTABLE=45,         <<SPECIAL REQUEST TABLE LENGTH>>    01714000
        PRIMARYMSGTABLE=46,         <<PRIMARY REQUEST TABLE LENGTH>>    01716000
        SECNDRYMSGTABLE=48,                                    <<03707>>01718000
        SWAPTABLE=47;               <<SWAP TABLE LENGTH>>      <<01639>>01720000
                                                                        01722000
          <<------------                                                01724000
            DISC LABEL                                                  01726000
          ------------>>                                                01728000
  DEFINE  LABDTYPE  =    (6:6)#,     <<DISC TYPE>>                      01730000
          LABDSUBTYPE=   (12:4)#;    <<DISC SUBTYPE>>                   01732000
  EQUATE  LAB6      =    6,          <<7TH WORD OF ENTRY>>              01734000
          LABSYSID  =    16,         <<SYSTEM ID (BYTE)>>               01736000
          LABVOL    =    10,         <<VOLUME NAME>>                    01738000
          LABVOLB   =    20,         <<VOLUME NAME (BYTE)>>             01740000
          LABCOLDLOADID= 7;          <<COLD LOAD ID>>                   01742000
                                                                        01744000
          <<------------------------------------                        01746000
            MOVING HEAD DISC INFORMATION TABLE                          01748000
          ------------------------------------>>                        01750000
  EQUATE  MHINFOSIZE=    7,          <<ENTRY SIZE>>            <<25.02>>01752000
          MHDEFLPS  =    0,          <<DEFAULT LOGICAL PACK SIZE>>      01754000
          MHMAXLPS  =    1,          <<MAX LOGICAL PACK SIZE>>          01756000
          MHTRKCYL  =    2,          <<TRACKS/CYLINDER>>                01758000
          MHSECTRK  =    3,          <<SECTORS/TRACK>>                  01760000
          MHTRKMULT =    4,          <<TRACK MULTIPLIER>>               01762000
          MHSTHEAD  =    5;          <<STARTING HEAD #>>       <<03550>>01764000
       << MHFRSPCSCT=    6;       SECTORS IN FREE SPACE   >>   <<03550>>01766000
       <<                         TABLE--NO LONGER USED   >>   <<03550>>01768000
                                                                        01770000
          <<------------------------                                    01772000
            DEFECTIVE TRACKS TABLE                                      01774000
          ------------------------>>                                    01776000
  EQUATE  DTTALT    =    126,        <<NEXT AVAILABLE ALTERNATE>>       01778000
          DTTLPS    =    127;        <<LOGICAL PACK SIZE>>              01780000
  EQUATE  MAXDTT    =    120;        <<MAX# DTT ENTRIES>>      <<00463>>01782000
                                                               <<03549>>01784000
               <<------------------------>>                    <<03549>>01786000
               << DEFECTIVE SECTOR TABLE >>                    <<03549>>01788000
               <<------------------------>>                    <<03549>>01790000
                                                               <<03549>>01792000
  EQUATE  DSCT'NUM'ENTRIES = 0,   <<INDEX TO NO. OF ENTRIES>>  <<03549>>01794000
          DSCT'FIRST'ENTRY = 1,   <<INDEX TO FIRST ENTRY>>     <<03549>>01796000
          DSCT'ENTRY'SIZE  = 2,   <<INDEX TO ENTRY SIZE>>      <<03549>>01798000
          DSCT'MAX'ENTRIES = 3,   <<INDEX TO MAX. ENTRIES>>    <<03549>>01800000
          MAX'DSCT         = 61;  <<MAX. NO. OF ENTRIES>>      <<03549>>01802000
                                                               <<03549>>01804000
          <<-------------------------                                   01806000
            DRT ENTRY CONFIGURATION                                     01808000
          ------------------------->>                                   01810000
  EQUATE  MAXUNIT   =    127;                                  <<03002>>01812000
  INTEGER MAXDRT;                                              <<03002>>01814000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>01816000
  EQUATE                                                       <<01025>>01818000
          PI        =    1,   <<INTERRUPT CODE POINTER>>                01820000
          DBI       =    2,   <<INTERRUPT DATA POINTER>>                01822000
          LOWESTDRT =    4,   <<FIRST USABLE DRT #>>           <<00071>>01824000
          ONUNIT = 3; <<ONUNIT IS INDEX OF # OF UNITS IN DRT>> <<01300>>01826000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>01828000
  EQUATE  IOPROGENT =    0,   <<IO PROGRAM POINTER>>           <<00888>>01830000
          DBI       =    1,   <<INTERRUPT DATA POINTER>>       <<00888>>01832000
          PI        =    2,   <<INTERRUPT CODE POINTER>>       <<00888>>01834000
          LOWESTDRT =    8;   <<FIRST USABLE DRT #>>           <<02510>>01836000
$IF  <<***** RETURN TO COMMON CODE *****>>                     <<03002>>01840000
  DEFINE  NUNIT     =    (8:8)#, <<# OF UNITS ON CONTROLLER>>  <<00888>>01842000
          NINTH     =    (0:8)#;<<#OF INTRPT HANDLERS FOR DRT>><<00888>>01844000
  EQUATE  DEVPERCHAN=    8; <<NUMBER OF DEV'S PER CHANNEL>>    <<02510>>01848000
  EQUATE  GHOSTEXTLAB=%105401;<<INT'S FROM UNCONFIGURED DRT'S>><<03603>>01850000
  EQUATE  CHANSTAT  =    3;   <<CHANNEL STATUS OFFSET>>        <<03002>>01852000
                                                                        01854000
          <<----------------------                                      01856000
            DRIVER LINKAGE TABLE                                        01858000
          ---------------------->>                                      01860000
  DEFINE  DPROC     =    0#,                                            01862000
          QNUMB     =    (0:8)#,     <<RESOURCE QUEUE NUMBER>>          01864000
          CORERES   =    (10:1)#,    <<CORE RESIDENT>>                  01866000
          DRVRTYPE  =    (14:2)#,    <<DRIVER TYPE>>                    01868000
          DMNTR     =    1#,         <<MONITOR PLABEL>>                 01870000
          DINIT     =    2#,         <<INITIATOR PLABEL>>               01872000
          DCOMP     =    3#,         <<COMPLETOR PLABEL>>               01874000
          DINTP     =    4#,         <<INTERRUPT PLABEL>>               01876000
          DTYPE     =    5#,                                            01878000
          DEDITOR   =    6#,         <<EDITOR PLABEL>>                  01880000
          DINTPL    =    7#,         <<INITIALIZATION PLABEL>> <<0+.04>>01882000
          DITSIZE'  =    (0:8)#,     <<DIT SIZE>>                       01884000
          DEVTYPE   =    (8:8)#,     <<DEVICE TYPE>>                    01886000
          DLTSIZE   =    8#;         <<ENTRY SIZE>>            <<0+.04>>01888000
                                                                        01890000
          <<-------------------------                                   01892000
            INTERRUPT LINKAGE TABLE                                     01894000
          ------------------------->>                                   01896000
  DEFINE  ISRQL     =    6#,         <<SERIAL REQUEST LENGTH>> <<00888>>01900000
          ICNTRL    =    7#,                                   <<00888>>01902000
          MCHAN     =    (0:1)#,     <<ON CHANNEL WITH OTHER CNTRLRS>>  01904000
          CHANQUE   =    (1:6)#,     <<CHANNEL RESOURCE QUEUE>><<00888>>01906000
          DRTN'     =    (7:9)#,     <<DRT NUMBER>>            <<03002>>01908000
          ISIOP     =    8#,         <<SIO AREA POINTER>>      <<00888>>01910000
          ISTAP     =    9#,       <<POINTER TO STATUS RETURN>><<00888>>01912000
          IUNIT     =    10#,      <<UNIT EXTRACT INSTRUCTION>><<00888>>01914000
          IQUEUE    =    12#,                                  <<00888>>01916000
          IFLAG     =    13#,        <<FLAG WORD OF ILT>>      <<00888>>01918000
          RUNWAIT   =    (0:1)#, <<DVR REQUIRES IDLE I/O PROG>><<00888>>01920000
          HCUNIT    =    (9:7)#,     <<HIGHEST CONFIG UNIT #>> <<03022>>01922000
          RUNWAIT'  =    (11:1)#,    <<RUNWAIT BIT IN DVR OB>> <<00888>>01924000
          SIOPSIZE  =    (0:8)#,     <<SIO PROGRAM AREA SIZE>> <<00888>>01926000
          CNTRLRQ   =    (8:8)#,     <<CONTROLLER RESOURCE QUEUE>>      01928000
          STRETSIZE =    (8:8)#, <<SIZE OF STATUS RETURN AREA>><<00888>>01930000
          IDITP     =    14#,        <<POINTER TO FIRST DIT>>  <<00888>>01932000
          DVR'GLOBAL'VARS=6#,        <<5 VARIABLES+SEEKMASK>>  <<01962>>01934000
          ILTSIZE   =    14#;        <<SIZE OF ILT>>           <<00888>>01936000
  EQUATE                                                       <<MPEIV>>01938000
          DVRDB2    =    2,                                    <<00888>>01940000
          DVRDB3    =    3,                                    <<00888>>01942000
          DVRDB4    =    4;                                    <<00888>>01944000
  EQUATE  HARDRES'SIOAREA = 46;  << SIZE OF HARDRES SIOAREA >> <<01384>>01946000
  DEFINE                                                       <<00888>>01948000
          INITTCP'=DVRDB4+DITSIZE+SIOSIZE+1#;                  <<00888>>01950000
          <<A SPECIAL INITIALIZATION PROGRAM FOR TERMINALS>>   <<00888>>01952000
          <<WAS NEEDED TO SOLVE A PFAIL PROBLEM.  ONLY ONE>>   <<00888>>01954000
          <<IS NEEDED AS ALL TERMINALS WILL USE IT.  THE  >>   <<00888>>01956000
          <<LENGTH IN WORDS IS LOCATED IN THE DB AREA OF  >>   <<00888>>01958000
          <<THE DRIVER IMMEDIATELY AFTER THE SIO PROGRAM  >>   <<00888>>01960000
          <<AREA WITH THE INIT PROGRAM IMMEDIATELY AFTER  >>   <<00888>>01962000
          <<THAT.  THIS SPECIAL PROGRAM WILL BE MADE CORE >>   <<00888>>01964000
          <<RESIDENT AND A SYSDB-RELATIVE POINTER TO IT   >>   <<00888>>01966000
          <<WILL BE PLACED IN THE INITTCP CELL OF SYSDB.  >>   <<00888>>01968000
                                                                        01972000
          <<--------------------------                                  01974000
            DEVICE INFORMATION TABLE                                    01976000
          -------------------------->>                                  01978000
  DEFINE  DFLAG     =    0#,                                            01980000
          DISCFLAG  =    (1:1)#,     <<DEVICE IS A DISC>>      <<MPEIV>>01982000
          TERM'     =    (0:1)#,     <<DEVICE IS TERMINAL>>             01984000
          SPECIH    =    (4:1)#,     <<SPECIAL INTERRUPT HANDLER>>      01986000
          MUNIT     =    (5:1)#,     <<MULTI-UNIT CONTROLLER>>          01988000
          DLDEV     =    3#,         <<LDEV AND UNIT NUMBERS>>          01990000
          DDLTP     =    4#,         <<DLT POINTER>>                    01992000
          DILTP     =    5#,         <<ILT POINTER>>                    01994000
          DPCBN     =    8#;         <<PROCESS PIN>>                    01996000
                                                                        01998000
          <<------------                                                02000000
            I/O TABLES                                                  02002000
          ------------>>                                                02004000
  EQUATE  IOHEADSIZE=    8,          <<TABLE HEADER>>                   02006000
          SECTBUF   =    8,          <<RESERVED TBUF PORTION>>          02008000
          SECSBUF   =    2,          <<RESERVED SBUF PORTION>>          02010000
          SECIOQ    =    6,          <<RESERVED IOQ PORTION>>           02012000
          IOPROCSIZE=    10,         <<TEMPORARY PROCESS TABLE>>        02014000
          INTRSIZE  =    3;          <<TEMPORARY INTERRUPT TABLE>>      02016000
                                                                        02018000
          <<------------------                                          02020000
            MEMORY MANAGEMENT                                           02022000
          ------------------->>                                         02024000
                                                               <<MPEIV>>02026000
  <<MEMORY REGION HEADERS AND TRAILERS>>                       <<MPEIV>>02028000
  EQUATE<<RBTOPTSRSDISP  =  -22,                          >>   <<03552>>02030000
    <<    RBTOPTRASDISP  =  -21,                          >>   <<03552>>02032000
    <<    RBTOPTRSDISP  =  -20,                           >>   <<03552>>02034000
          RBTORASDISP  =  -19,                                 <<MPEIV>>02036000
    <<    RBTORSDISP  =  -18,                             >>   <<03552>>02038000
    <<    RBTOIOCNTDISP  =  -17,                          >>   <<03552>>02040000
    <<    RBTOINITMSGDISP  =  -16,                        >>   <<03552>>02042000
    <<    RBTOINITINFODISP  =  -15,                       >>   <<03552>>02044000
          RBTOPLDISP  =  -15,                                  <<MPEIV>>02046000
    <<    RBTOCOMPMSGDISP  =  -14,                        >>   <<03552>>02048000
    <<    RBTOMPDQHDISP  =  -13,                          >>   <<03552>>02050000
    <<    RBTONLDISP  =  -13,                             >>   <<03552>>02052000
    <<    RBTORWRDCNTDISP  =  -12,                        >>   <<03552>>02054000
    <<    RBTOSRSDISP  =  -10,                            >>   <<03552>>02056000
    <<    RBTOWDDISP  =  -9,                              >>   <<03552>>02058000
    <<    RBTOWREQPDISP  =  -8,                           >>   <<03552>>02060000
    <<    RBTOSEGIDENTDISP  =  -7,                        >>   <<03552>>02062000
    <<    RBTOLKFZCNTDISP  =  -6,                         >>   <<03552>>02064000
    <<    RBTOIOFZCNTDISP  =  -5,                         >>   <<03552>>02066000
    <<    RBTOHODADISP  =  -4,                            >>   <<03552>>02068000
    <<    RBTOLODADISP  =  -3,                            >>   <<03552>>02070000
          PLTONLDISP  =  2,                                    <<MPEIV>>02072000
          NLTORBDISP  =  13,                                   <<MPEIV>>02074000
          PLTORBDISP  =  15,                                   <<MPEIV>>02076000
    <<    SEGIDENTTOPTRSDISP  =  -14,                     >>   <<03552>>02078000
    <<    SRSTOSEGIDENTDISP  =  3,                        >>   <<03552>>02080000
    <<    RASTOPTRASDISP  =  -2,                          >>   <<03552>>02082000
          TRASTOTSSDISP  =  -1,                                <<MPEIV>>02084000
          RASTOSSDISP  =  9,                                   <<MPEIV>>02086000
          SSTOPTRASDISP  =  -11,                               <<MPEIV>>02088000
    <<    RASTOPTSSDISP  =  -3,  << TRAILER SUBSIZE >>         <<03552>>02090000
    <<    RASTORSDISP  =  1,  << REGION SIZE DISP >>           <<03552>>02092000
    <<    RSTOSEGIDENTDISP  =  11,                        >>   <<03552>>02094000
          PTRSTORHDISP  =  1;                                  <<MPEIV>>02096000
                                                               <<MPEIV>>02098000
  DEFINE  REGASSIGNEDFLAG  =  (0:1)#,                          <<MPEIV>>02100000
          REGRESERVEDFLAG  =  (1:1)#,                          <<MPEIV>>02102000
          REGAVAILABLEFLAG  =  (2:1)#,                         <<MPEIV>>02104000
          REGCLEAREDFLAG  =  (3:1)#,                           <<MPEIV>>02106000
          REGFZFLAG  =  (6:1)#;                                <<MPEIV>>02108000
                                                               <<MPEIV>>02110000
  EQUATE  PAGEPOWER  =  7, <<8>>                               <<MPEIV>>02112000
          MMPAGESIZE  =  128, <<256>>                          <<MPEIV>>02114000
          HEADERLENGTH  =  19,                                 <<MPEIV>>02116000
          MAXHOLESIZE  =  512,                                 <<MPEIV>>02118000
          ARSBMLENGTH  =  MAXHOLESIZE/16+1,                    <<MPEIV>>02120000
          ARLDLENGTH  =  MAXHOLESIZE*2+2,                      <<MPEIV>>02122000
          LOCALITYCOUNT=5, <<SLL'S PER PCB>>                   <<01927>>02124000
          MSGHARBORTABSIZE  =  17,                             <<MPEIV>>02126000
          MSGHARBORTABCNT  =  3,                               <<MPEIV>>02128000
          DISCREQCOUNT  =  100,                                <<MPEIV>>02130000
          NWORDPAGE =    512,        <<# OF WORDS PER PAGE>>            02132000
          WELMESPAGES=   (LOGONDSTSIZE+NWORDPAGE-1)/NWORDPAGE, <<MPEIV>>02134000
          JMATPAGES  =   (MAXJMSIZE+NWORDPAGE-1)/NWORDPAGE,    <<MPEIV>>02136000
          IDDPAGES   =   (MAXIDDTSIZE+NWORDPAGE-1)/NWORDPAGE,  <<MPEIV>>02138000
          ODDPAGES   =   (MAXODDTSIZE+NWORDPAGE-1)/NWORDPAGE,  <<MPEIV>>02140000
          NSECTPAGE =    NWORDPAGE/128; <<# OF SECTORS PER PAGE>>       02142000
                                                                        02144000
          <<-----                                                       02146000
            ICS                                                         02148000
          ----->>                                                       02150000
  EQUATE  ICSQMINUS =    64,          <<SIZE OF Q MINUS AREA>> <<MPEIV>>02152000
          SDST      =    16,         <<STACK DST #>>                    02154000
          PSTA      =    15,         <<PSUEDO INTERRUPT STATUS>>        02156000
          PADDR     =    14,         <<PSEUDO INTERRUPT STARTING ADDR>> 02158000
          JCUT'     =    11,         <<ABSOLUTE ADDRESS OF JCUT>>       02160000
          XP        =    10,         <<CURRENT PROCESS PCB>>            02162000
          PCBX'     =    9,          <<ABSOLUTE STACK ADDRESS>>         02164000
          Z'        =    8,          <<STACK DB RELATIVE Z>>            02166000
          DL'       =    7,          <<STACK DB RELATIVE DL>>           02168000
          S'        =    6,          <<STACK DB RELATIVE S>>            02170000
          SBANK'    =    5,          <<STACK BANK>>                     02172000
          STDB'     =    4;          <<STACK DB>>                       02174000
                                                                        02176000
          <<----------------                                            02178000
            SYSTEM DEVICES                                              02180000
          ---------------->>                                            02182000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>02184000
  EQUATE  CONSOLEDRT=    7,          <<SYSTEM CONSOLE/CLOCK>>           02186000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>02188000
  EQUATE  CONSOLEDRT=    8,          <<SYSTEM CONSOLE>>        <<00888>>02190000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>02192000
          SYSDISC   =    1;          <<SYSTEM DISC LDEV #>>    <<MPEIV>>02194000
          << ----------- >>                                    <<02510>>02198000
          << FIXED CELLS >>                                    <<02510>>02200000
          << ----------- >>                                    <<02510>>02202000
  EQUATE  CSTP      =    0,    <<CST POINTER>>                 <<02510>>02204000
          CSTXP     =    1,    <<CST EXTENSION POINTER>>       <<02510>>02206000
          DSTP      =    2,    <<DST POINTER>>                 <<02510>>02208000
          PCBP      =    3,    <<PROCESS CONTROL>>             <<02510>>02210000
                               <<BLOCK POINTER>>               <<02510>>02212000
          CPCB      =    4,    <<CURRENT PROCESS >>            <<02510>>02214000
                               <<CONTROL BLOCK>>               <<02510>>02216000
          QI        =    5,    <<Q FOR ICS>>                   <<02510>>02218000
          ZI        =    6,    <<Z FOR ICS>>                   <<02510>>02220000
          DRTBANK   =    8,    <<BANK FOR DEV REF TAB>>        <<02510>>02222000
          DRTADDR   =    9,    <<ADDR FOR DEV REF TAB>>        <<02510>>02224000
          DBBANK    =   10,    <<DBBANK FOR INITIAL'S STACK>>  <<02510>>02226000
          DB        =   11;    <<DB FOR INITIAL'S STACK>>      <<02510>>02228000
  EQUATE  SDTYPE    =    1;    <<FOR BOOTSTRAP-SYS-DISC TYPE>> <<02510>>02230000
                               <<DEVICE TYPE OF SYSTEM DISC>>  <<02510>>02232000
                               <<NEEDED DURING COOLSTART/ >>   <<02510>>02234000
                               <<WARMSTART BOOTSTRAP AND>>     <<02510>>02236000
                               <<READTAPES OF UPDATE>>         <<02510>>02238000
                                                               <<02510>>02240000
                               <<12-18 ARE FREE TO INITIAL>>   <<02510>>02244000
                               <<19-23 ARE USED BY THE >>      <<02510>>02246000
                               <<  MICRO-CODE FOR SYSTEM >>    <<02510>>02248000
                               <<  AND PROCESS CLOCKS>>        <<02510>>02250000
                               <<24 IS FREE TO INITIAL>>       <<02510>>02252000
                                                               <<02510>>02254000
  EQUATE  SPEEDCODE = %1420;  <<ADCC CODE FOR CONSOLE SPEED>>  <<03003>>02258000
$IF      << ******** RETURNING TO COMMON CODE ********* >>     <<03603>>02260000
                                                               <<02510>>02262000
  EQUATE  SIOPROG   =  %1410;  <<SIO PROGRAM BUFFER>>          <<02510>>02264000
                                                               <<02510>>02268000
  EQUATE  TEMP'CPVA =  %1400,  <<THRU %1407 TEMPORARY >>       <<02510>>02270000
                               <<CHAN PROG VARIABLE AREA>>     <<02510>>02272000
          CHANPROG  =  %1410,  <<DISC CHAN PROG BUFFER>>       <<02510>>02274000
          TERMCHANPROG=%1411,  <<CHAN PROG BUF FOR CONSOLE>>   <<03603>>02276000
          TAPECHANPROG=%1412;  <<CHAN PROG BUF FOR TAPE>>      <<02510>>02278000
                                                               <<02510>>02280000
  EQUATE  ABSFLAGS  =  %1421;  <<FLAGS FOR INITIAL>>           <<02510>>02282000
          <<  BIT 15 - STARFISH >>                             <<02510>>02284000
          <<  BIT 14 - 7976 MAGTAPE >>                         <<03672>>02286000
          <<  BIT 12 - HP26XX, USED BY TERMINAL DRIVER >>      <<03672>>02288000
          <<  BIT 11 - CS80'LOCK, USED BY CS80'DRIVER >>       <<03672>>02290000
            <<---------------------------------->>             <<03003>>02292000
            << SYSTEM CONSOLE DRIVER PARAMETERS >>             <<03003>>02294000
            <<---------------------------------->>             <<03003>>02296000
  DEFINE  BAUDRATE =   << BAUDRATE CODE FOR HARDWARE >>        <<03003>>02298000
                     ABSOLUTE( SPEEDCODE)#,                    <<03003>>02300000
          CHARCNT  =   << CURRENT COUNT FOR WRITECHAR >>       <<03003>>02302000
                     ABSOLUTE( %1422)#,                        <<03003>>02304000
          HP26XX   =   << TRUE IF CONSOLE IS A 26XX >>         <<03003>>02306000
                     ABSOLUTE( ABSFLAGS).(12:1)#,              <<03003>>02308000
          CONSPEED =   << CONSOLE BAUD RATE  >>                <<03003>>02310000
                     ABSOLUTE( %1423)#;                        <<03003>>02312000
                                                               <<03003>>02314000
          <<-----------------------                                     02318000
            LOGICAL PROCESS TABLE                                       02320000
          ----------------------->>                                     02322000
  EQUATE  PROGPROC  =    0,          <<PROGENITOR>>                     02324000
          UCOPPROC  =    2,          <<USER CONTROLLER>>                02328000
          PFAILPROC =    3,          <<POWER FAIL>>                     02330000
          DEVRECPROC=    4,          <<DEVICE RECOGNITION>>             02332000
<<*********************    #5 IS FREE     *******************>><<00.EB>>02334000
<<*********************    #6 IS FREE     *******************>><<00.EB>>02336000
          LOGPROC   =    7,          <<LOGGING>>                        02338000
          LOADPROC  =    8,          <<LOADER>>                         02340000
          IOMESSPROC=    9,          <<I/O MESSAGES AND LOGGING>>       02342000
           SIOPROC   =     10,          <<SYSTEM I/O PROCESS>>          02344000
           MEMLGPROC =     11;          <<MEMLOGP>>                     02346000
                                                                        02348000
          <<--------------------                                        02350000
            PROCESS STACKSIZES                                          02352000
          -------------------->>                                        02354000
  EQUATE  PROGSTACK  =   1536,       <<PROGENITOR STACK>>      <<00071>>02356000
          CRIOSTACK =    388,        <<RESIDENT I/O STACK>>    <<00181>>02358000
          LKIOSTACK =   1024,        <<LINKED I/O STACK>>      <<01735>>02360000
          DEVRECSTACK=   800,        <<DEVICE RECOGNITION>>             02364000
          UCOPSTACK =    512,        <<USER CONTROLLER STACK>>          02366000
          PFAILSTACK=    256,        <<POWER FAIL STACK>>               02368000
          LOGSTACK  =    1536,     << Logging >>               <<03551>>02370000
        IOMESSSTACK=   1302,    <<IO messages stack>>          <<02807>>02372000
          LOADSTACK =    1000,       <<LOAD PROCESS STACK>>             02374000
          MEMLGSTACK =   1856,     << MEMLOGP STACK >>         <<03551>>02376000
          PVSTACK   =    512;        <<PV PROCESS STACK>>      <<RH.PV>>02378000
                                                                        02380000
          <<--------------------                                        02382000
            PROCESS PRIORITIES                                          02384000
          -------------------->>                                        02386000
  EQUATE                                                       <<03552>>02388000
          PFAILPRI  =    10,         <<POWER FAIL RESTART>>             02390000
          PROGPRI   =    49,         <<PROGENITOR>>                     02392000
          LOGPRI    =    50,         <<LOGGING>>                        02394000
          IOPRI     =    50,         <<I/O PROCESSES>>                  02396000
        IOMESSPRI =    120,   <<IO messages and logging>>      <<02807>>02398000
          UCOPPRI   =    125,        <<USER CONTROLLER>>                02400000
          DEVRECPRI =    125,        <<DEVICE RECOGNITION>>             02402000
          MEMLGPRI  =    125,        <<MEMLOGP>>                        02404000
          PVPRI     =    125,        <<PV PROCESS PRI>>        <<RH.PV>>02406000
          LOADPRI   =    142;        <<LOAD PROCESS>>                   02408000
                                                                        02410000
          <<-----------                                                 02412000
            STOP BITS                                                   02414000
          ----------->>                                                 02416000
  EQUATE  UCOPSBIT  =    0,          <<UCOP STOP BIT>>                  02418000
          LOGSBIT   =    1,          <<LOG STOP BIT>>                   02420000
          DEVRECSBIT=    2,          <<DEVREC STOP BIT>>                02422000
           IOMESSSBIT=     3,           <<I/O MESSAGE>>                 02424000
           MEMLGSBIT =     4;           <<MEMLOGP>>                     02426000
                                                                        02428000
          <<---------------                                             02430000
            SEGMENT TABLE                                               02432000
          --------------->>                                             02434000
  EQUATE  SEGDIRLEN =    201,        <<LENGTH OF DIRECTORY>>            02436000
          SEGTPDB   =    25,         <<PRIMARY DB AREA SIZE>>           02438000
          SEGTABMAX =    12280,     <<MAX DATA SEG SIZE>>      <<04655>>02440000
          SLTYP     =    1;          <<SL ENTRY TYPE>>         <<01025>>02442000
                                                                        02444000
          <<--------------------                                        02446000
            CONFIGURATION FILE                                          02448000
          -------------------->>                                        02450000
  DEFINE  DVRRECNUM =    9D#,        <<DRIVER TABLE RECORD>>            02452000
          CSDVRRECNUM=   21D#,       <<CS EXTRA DRIVERS>>               02454000
          CSDEFRECNUM=   22D#,       <<DEFAULT LINE DESCRIPTORS>>       02456000
          CTAB0RECNUM=   0D#,        <<STD CONFIGURATION RECORD>>       02458000
          CTABRECNUM=    1D#;        <<CORESIZE-RELATED CONFIG. REC>>   02460000
                                                                        02462000
          <<--------------                                              02464000
            SIO COMMANDS                                                02466000
          -------------->>                                              02468000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>02470000
  EQUATE  SIORES    =    %10000,     <<RETURN RESIDUE>>                 02472000
          SIOBANK   =    %14000,     <<SET BANK REGISTER>>              02474000
          SIOEND    =    %30000,     <<END>>                            02476000
          SIOENDINT =    %34000,     <<END WITH INTERRUPT>>             02478000
          SIOCNTRL  =    %40000,     <<CONTROL>>                        02480000
          SIOWRITE  =    %60000,     <<WRITE>>                          02482000
          SIOREAD   =    %70000;     <<READ>>                           02484000
$IF << ****** RETURNING TO COMMON CODE ****** >>               <<02510>>02486000
  EQUATE  CHANWAIT  =    %1000,      <<WAIT>>                  <<02510>>02490000
          DISCSEEK  =    %1000;      <<SEEK ORDER>>            <<00888>>02492000
                                                                        02496000
          <<--------------->>                                  <<02510>>02498000
          <<  IMB ADAPTER  >>                                  <<02510>>02500000
          <<--------------->>                                  <<02510>>02502000
  DEFINE  MB0        = ABSOLUTE(%770)#,                        <<02510>>02504000
          MB1        = ABSOLUTE(%771)#,                        <<02510>>02506000
          MB2        = ABSOLUTE(%772)#,                        <<02510>>02508000
          MB3        = ABSOLUTE(%773)#,                        <<02510>>02510000
          MB4        = ABSOLUTE(%774)#;                        <<02510>>02512000
  EQUATE  ADAPTERDRT = %175;                                   <<02510>>02514000
  DEFINE  STARFISH   = ABSOLUTE(ABSFLAGS).(15:1)#;             <<02510>>02516000
                                                               <<02510>>02518000
          <<------------------------                                    02520000
            DISC TYPES AND SUBTYPES                                     02522000
          ------------------------->>                                   02524000
  EQUATE  MHDISCTYPE=    0,          <<MOVING HEAD DISC>>               02526000
          FHDISCTYPE=    1,          <<FIXED HEAD DISC>>                02528000
          NMHSUBTYPES = 14,     <<# OF MOVING HEAD SUBTYPES>>  <<00904>>02530000
          NFHSUBTYPES =  3;     <<# OF FIXED HEAD SUBTYPES >>  <<03550>>02532000
  EQUATE  UH7900    =   0,          <<UPPER HALF OF 7900 SUBTYPE>>      02538000
          UH7905    =   4,           <<SUBTYPE 7905 UP. HALF>> <<RH.PV>>02540000
          S7920     =   8,           <<SUBTYPE 7920>>          <<RH.PV>>02542000
          S7925     =   9;           <<SUBTYPE 7925>>          <<25.03>>02544000
  EQUATE  UH7906    =   10,      <<UPPER HALF OF 7906 SUBTYPE>><<00071>>02546000
          LH7906    =   11,      <<LOWER HALF OF 7906 SUBTYPE>><<00071>>02548000
          S7910     =   13,   <<SUBTYPE 7910--NOT SUPPORTED>>  <<03550>>02550000
        << ******** TYPE 3 (CS'80) SUBTYPES ******** >>        <<03550>>02552000
          LINUS     =   0,    << SUBTYPE OF LINUS >>           <<03550>>02554000
    <<    S7911     =   1, >> << SUBTYPE OF 7911 >>            <<03635>>02556000
    <<    S7912     =   2, >> << SUBTYPE OF 7912 >>            <<03635>>02558000
          S7935     =   8;    << SUBTYPE OF 7935 >>            <<03550>>02560000
                                                                        02562000
          <<---------------                                             02564000
            TAPE COMMANDS                                               02566000
          --------------->>                                             02568000
  EQUATE REWUNLOAD =    1, <<REWIND AND UNLOAD THE TAPE>>      <<00678>>02570000
         FWDSPFILE =    2, <<FORWARD SPACE FILE>>              <<00678>>02572000
         TAPEREADY =    3, <<WAIT FOR TAPE TO BE READIED>>     <<00678>>02574000
         REWIND    =    4; <<ONLY USED FOR SERIAL DISCS>>      <<00678>>02576000
          <<------------                                                02578000
            TAPE LABEL                                                  02580000
          ------------>>                                                02582000
  DEFINE  LABELTEXT =    "STORE/RESTORE LABEL-HP/3000."#,               02584000
          XFIELD    =    LBUF(21)#,  <<FILE CONTINUED ON NEXT TAPE>>    02586000
          ZFIELD    =    LBUF(22)#,  <<END OF TAPE SET>>                02588000
          REELNUM   =    LBUF(23)#,  <<REEL NUMBER>>                    02590000
          CHDATE    =    LBUF(24)#,  <<DATE>>                           02592000
          CHHHMM    =    LBUF(25)#;  <<HOURS AND MINUTES>>     <<01025>>02594000
                                                                        02596000
          <<----------------------------------                          02598000
            DISC COLD LOAD INFORMATION TABLE                            02600000
          ---------------------------------->>                          02602000
  EQUATE  INFOSIZE  =    256,        <<TABLE SIZE>>                     02604000
          INFOSECTOR=    28,         <<SECTOR NUMBER IN MPE2B>><<00.DL>>02606000
          TABPTR    =    0,          <<PTR TO TABLE INFORMATION>>       02608000
          TCSTPTR   =    1,          <<PTR TO TCST INFO>>               02610000
          NREAD     =    2,          <<# OF ENTRIES TO READ>>           02612000
          NUTCST'   =    3,          <<NUMBER OF ENTRIES IN TCST AREA>> 02614000
          INITDB    =    4,          <<DB FOR INITIAL>>                 02616000
          INITDL    =    5,          <<DL FOR INITIAL>>                 02618000
          INITZ     =    6,          <<Z FOR INITIAL>>                  02620000
          INITQ     =    7,          <<Q FOR INITIAL>>                  02622000
          INITS     =    8,          <<S FOR INITIAL>>                  02624000
          DISCTST   =    9,          <<SYS DISC TYPE & SUBTYPE>>        02626000
          COLD'LOAD'ID'= 10,         <<COLD LOAD ID>>                   02628000
          LOG'FILE'NUM'= 11,         <<LOG FILE NUMBER>>                02630000
          DIRADR    =    6,          <<DIRECTORY ADDRESS (DOUBLE)>>     02632000
          VIRMEMADR =    7,          <<VIRTUAL MEMORY ADDRESS (DOUBLE)>>02634000
          NLOGPROCS   =   16,                                  <<00506>>02636000
          LOGIDS      =   17,                                  <<00506>>02638000
          RINADR    =    9,          <<RIN TABLE ADDRESS (DOUBLE)>>     02640000
          DIRSECT   =    20,         <<DIRECTORY SIZE>>                 02642000
          VIRMEMSECT=    21,         <<VIRTUAL MEMORY SIZE>>            02644000
          RINSECT   =    23,         <<RIN TABLE SIZE>>                 02646000
          RINS      =    24,         <<# OF RINS>>                      02648000
          GRINS     =    25,         <<# OF GLOBAL RINS>>               02650000
          LOADMODE  =    26,         <<TYPE OF COLD LOAD>>              02652000
          H'VOL'    =    27,         <<HIGHEST VOLUME #>>               02654000
          DISCENTRY =    28,         <<DISC COLD LOAD ENTRY POINT>>     02656000
          SYSDISCDRT'=   29,         <<SYSTEM DISC DRT #>>              02658000
          JMATLOC   =    15,      <<JMAT DISC ADDRESS>>                 02660000
          IDDLOC    =    16,      <<IDD DISC ADDRESS>>                  02662000
          ODDLOC    =    17,      <<ODD DISC ADDRESS>>                  02664000
          LOGONLOC1 =    18,      <<DISC ADDRESS OF WELCOME DST>>       02666000
          LOGONLOC2 =    19,      <<DISC ADDR OF WELCOME DST>>          02668000
          LOGIDADDR   =   20,                                  <<00506>>02670000
          LOGTABADDR  =   21,                                  <<00506>>02672000
          LOGIDSECT   =   44,                                  <<00506>>02674000
          LOGTABSECT  =   45,                                  <<00506>>02676000
          LOWINFOWORDS=   46,                                  <<00506>>02678000
          NTABLES   =    12,         <<# OF ENTRIES IN TABLE AREA>>     02680000
          DVRINFOX  =    0,          <<DRIVER TABLE>>                   02682000
          CTAB0INFOX=    2,          <<STD CONFIGURATION>>              02684000
          CTABINFOX =    4,          <<CORESIZE-RELATED CONFIGURATION>> 02686000
          CSDVRINFOX=    6,          <<EXTRA CS DRIVERS>>               02688000
          CSDEFINFOX=    8,          <<DEFAULT LINE DESCRIPTORS>>       02690000
          CSTABINFOX=    10,         <<CS DATA SEGMENT>>                02692000
          LPDTINFOX =    12,         <<LOG-PHYS DEVICE TABLE>>          02694000
          LDTINFOX  =    14,         <<LOGICAL DEVICE TABLE>>           02696000
          DVCLINFOX =    16,         <<DEVICE CLASS TABLE>>             02698000
          VTABINFOX =    18,         <<VOLUME TABLE>>                   02700000
          LDTXINFOX =    20,         <<LOG. DEV. TABLE EXTENSION>>      02702000
          STACKINFOX=    22;         <<STACK FOR INITIAL>>     <<00.06>>02704000
  DEFINE  INFODTYPE =    (6:6)#,     <<SYSTEM DISC TYPE>>               02706000
          INFODSUBTYPE=  (12:4)#,    <<SYSTEM DISC SUBTYPE>>            02708000
          TLMODE    =    (13:1)#,    <<COLD LOAD FROM TAPE>>            02710000
          RLMODE    =    (14:1)#,    <<RELOAD>>                         02712000
          RYMODE    =    (15:1)#;    <<RECOVERY>>                       02714000
                                                                        02716000
          <<----------------                                            02720000
            BOOTSTRAP INFO                                              02722000
          ---------------->>                                            02724000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>02726000
  EQUATE  LCSIZE    =    12,         <<LOW CORE AREA SIZE>>             02728000
          BOOTSTACKSIZE= 128,        <<STACK FOR BOOTSTRAP SIZE>>       02730000
          BOOTQI    =    18,         <<QI FOR BOOTSTRAP>>      <<03603>>02732000
          INFOCOREADR=   %3000,      <<CORE ADDRESS FOR INFO TABLE>>    02734000
          SIOCOREADR=    %1000;      <<SIO PROGRAM CORE ADDRESS<<02510>>02736000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>02738000
  EQUATE  LCSIZE    =    12,         <<LOW CORE AREA SIZE>>    <<00888>>02740000
          BOOTSTACKSIZE= 128,        <<STACK FOR BOOTSTRAP SIZE<<00888>>02742000
          BOOTQI    =    18,         <<QI FOR BOOTSTRAP>>      <<03603>>02744000
          INFOCOREADR=   %3000,      <<CORE ADDRESS FOR INFO TABLE>>    02746000
          SIOCOREADR=    %1000,<<CHANPROGRAM CORE ADDRESS>>    <<00888>>02748000
          SIOCOREADR'1=  SIOCOREADR+1;                         <<00888>>02750000
  EQUATE  BOOTIOPSTART=  29,      <<BOOTSTRAP PROGRAM INDEX>>  <<00888>>02752000
          BOOTIOPSTART'1=BOOTIOPSTART+1;                       <<00888>>02754000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>02756000
  DEFINE  ININ'HALT = ASSEMBLE( HALT 1 )#;                     <<03603>>02758000
                                                                        02760000
          <<-----------------------                                     02762000
            CONFIGURATION OPTIONS                                       02764000
          ----------------------->>                                     02766000
  EQUATE  WARM      =    0,          <<WARMSTART>>                      02768000
          COOL      =    1,          <<COOLSTART>>                      02770000
          COLD      =    2,          <<COLDSTART>>                      02772000
          UP        =    3,          <<UPDATE>>                         02774000
          REL       =    4,          <<RELOAD>>                         02776000
          SPRD      =    4,          <<SPREAD>>                         02778000
          REST      =    6,          <<RESTORE>>                        02780000
          NRELOPTS  =    5,          <<# OF RELOAD OPTIONS>>            02782000
          NOPT      =    3;          <<NUMBER OF OPTIONS>>              02784000
  DEFINE  SPREAD    =    (OPT=SPRD)#,   <<SPREAD,ACC,NULL>>    <<03714>>02786000
          RESTORING =    (OPT>SPRD)#,   <<COMPACT,RESTORE>>    <<03714>>02788000
          UPDATE    =    (OPT=UP)#,     << UPDATE >>           <<03714>>02790000
          RESTORE   =    (OPT=REST)#,   << RESTORE >>          <<03714>>02792000
          WARMSTART =    (OPT=WARM)#;   << WARM >>             <<03714>>02794000
                                                                        02796000
          <<------------------------                                    02798000
            DIRECTORY DATA SEGMENT                                      02800000
          ------------------------>>                                    02802000
  EQUATE  DIRMAXENTZ=    54,                                   <<RV.PV>>02804000
          DIRX      =    22,                                            02806000
          DIRY      =    16+2,                                 <<RV.PV>>02808000
          DIRZ      =    139,                                  <<38.PV>>02810000
          DSAIBZ    =    3,                                             02812000
          DAUIBZ    =    1,                                             02814000
          DAGIBZ    =    1,                                             02816000
          DGVSIBZ   =    1,                                    <<RV.PV>>02818000
          DGFIBZ    =    2,                                             02820000
          DAEBZ     =    3,                                             02822000
          DUEBZ     =    2,                                             02824000
          DGEBZ     =    2,                                             02826000
          DFEBZ     =    2,                                             02828000
          DVSEBZ    =    1,                                    <<RV.PV>>02830000
          DMAXBZ    =    3,                                             02832000
          DIRLEN    =    ((2*DIRX+DIRY+DIRZ+256*DMAXBZ+DIRMAXENTZ+3)/4) 02834000
                           *4;                                          02836000
                                                                        02838000
 DEFINE  << FILE LABEL DEFINITION >>                                    02840000
 FLFILECODE  =FLAB(26)#,       << FILE CODE >>                          02842000
 FLFCBVECT   =FLAB(27)#,       << FCB VECTOR >>                         02844000
 FLFLIM      =FLABDBL(15)#,    << FILE LIMIT >>                         02846000
 FLPVINFO    =FLAB (33) #,     << PVINFO WORD >>               <<00468>>02848000
 FLCHECKSUM  =FLAB (34)#,      <<CHECKSUM OF FLAB CONTENTS>>            02850000
                      <<EXCLUDING FLCHECKSUM,FLCLID & MISC INDICES>>    02852000
 FLCLID      =FLAB(35)#,       << COLD LOAD ID >>                       02854000
 FLFOPTIONS  =FLAB(36)#,       << FOPTIONS >>                           02856000
 FLRECSIZE   =FLAB(37)#,       << RECORD SIZE >>                        02858000
 FLBLKSIZE   =FLAB(38)#,       << BLOCK SIZE >>                         02860000
 FLSECTOFF   =FLAB(39).(0:8)#, << SECTOR OFFSET TO DATA >>              02862000
 FLNUMEXTS   =FLAB(39).(11:5)#,<<NUMBER OF EXTENTS>>                    02864000
 FLNEXTWORD  =FLAB(39)#,                                                02866000
 FLLASTEXTSIZE=FLAB(40)#,      <<SIZE OF LAST EXTENT>>                  02868000
 FLEXTSIZE   =FLAB(41)#,       << EXTENT SIZE >>                        02870000
FLCLASS     =FLAB(124)#,      <<FILE DISC CLASS>>                       02872000
FLCLASSB    =BFLAB(248)#,                                               02874000
 FLEOF       =FLABDBL(21)#,    << END-OF-DATA POINTER >>                02876000
 FLEXT0      =FLABDBL(22)#,    <<1ST EXTENT>>                           02878000
EXT0        =22#,                                                       02880000
 FLEXTMAP    =FLAB(44)#;       << ORIGIN OF EXTENT MAP >>               02882000
                                                                        02884000
 DEFINE                                                                 02886000
 CHECKSUM    =                                                          02888000
     X := 127;                                                          02890000
     TOS := -1;                                                         02892000
     DO BEGIN                                                           02894000
            IF X <> FLCHECKSUMX AND                                     02896000
              X <> FLMISCX AND X<> FLCLIDX THEN                         02898000
              TOS:=TOS XOR LOGICAL (FLAB (X));                          02900000
            X:=X-1;                                                     02902000
        END UNTIL <#,                                                   02904000
 FLMISCX     =28#,             <<LOAD,READ,ETC INDEX>>                  02906000
 FLCHECKSUMX =34#,             <<CHECKSUM INDEX>>                       02908000
 FLCLIDX     =35#;             <<COLD LOAD ID INDEX>>                   02910000
  EQUATE  FCBSIZE   =    72,                                            02912000
          FCBDSIZE  =    36,                                            02914000
          FCBEXTMAP =    0,                                             02916000
          FCBLDEV   =    64,                                            02918000
          FCBEXTSIZE=    65,                                            02920000
          FCBNEXTWORD=   66,                                            02922000
          FCBEOF    =    34,                                            02924000
          FCBFILESIZE=   35;                                            02926000
  DEFINE  FCBSECTOFF=    66).(0:8#;                                     02928000
                                                                        02930000
  EQUATE  FILETYPE  =    0,                                             02932000
          GRPTYPE   =    %10,                                           02934000
          ACCTYPE   =    %20,                                           02936000
          USERTYPE  =    %30;                                           02938000
                                                               <<03672>>02940000
  DEFINE  CS80'LOCK = << TRUE IF RELEASE TIMEOUT IS         >> <<03672>>02942000
                      << CURRENTLY DISABLED ON CS'80 DEVICES>> <<03672>>02944000
                      ABSOLUTE(ABSFLAGS).(11:1)#;              <<03672>>02946000
                                                               <<03672>>02948000
                                                                        02950000
          <<------------------------------->>                  <<03672>>02952000
          <<     DISC DRIVER FUNCTIONS     >>                  <<03672>>02954000
          <<------------------------------->>                  <<03672>>02956000
                                                               <<03672>>02958000
  EQUATE  READ      =    0,                                             02960000
          NON'FATAL'READ=6,                                    <<01889>>02962000
          WRITE     =    1,                                    <<RH.PV>>02964000
          RSTAT     =    5,     <<REQUEST STATUS>>             <<03550>>02966000
          INIT'DEV  =    7,     <<Initialize Device>>          <<03598>>02968000
          UNLOCK'DEV=   12,     << ENABLE RELEASE TIMEOUT >>   <<03715>>02970000
                                << --CS80'DRIVER ONLY     >>   <<03672>>02972000
          LOCK'DEV  =   11;     << DISABLE RELEASE TIMEOUT  >> <<03672>>02974000
                                << --CS80'DRIVER ONLY       >> <<03672>>02976000
                                                                        02978000
          <<-----------------                                           02980000
            CONDITION CODES                                             02982000
          ----------------->>                                           02984000
  EQUATE  CCG       =    0,          <<GREATER>>                        02986000
          CCL       =    1,          <<LESS>>                           02988000
          CCE       =    2;          <<EQUAL>>                          02990000
                                                               <<03004>>02992000
$IF X1=ON  << *********** SERIES 33,44,55 UNIQUE ********** >> <<03004>>02994000
          <<------------------------------>>                   <<03004>>02996000
          << CHANNEL IDENTIFICATION CODES >>                   <<03004>>02998000
          <<------------------------------>>                   <<03004>>03000000
  EQUATE  LYNX'BOARD   = %17,  << 4-BIT CODES RETURNED ON   >> <<03004>>03002000
          ADCC'BOARD   = %1;   << CHANNEL IDENTIFY INSTRUCT.>> <<03004>>03004000
                                                               <<03004>>03006000
$IF        << ******* RETURNING TO COMMON CODE ************ >> <<03004>>03008000
                                                                        03010000
          <<--------------                                              03012000
            I/O COMMANDS                                                03014000
          -------------->>                                              03016000
  DEFINE  TIO0      =    BEGIN                                 <<01103>>03018000
                         ASSEMBLE( TIO 0 );                    <<01103>>03020000
                         IF < THEN ERRMESSAGE(M1,S0);          <<01103>>03022000
                         END#,                                 <<01103>>03024000
          CIO1      =    BEGIN                                 <<01103>>03026000
                         ASSEMBLE( CIO 1 );                    <<01103>>03028000
                         IF < THEN ERRMESSAGE(M1,S1);          <<01103>>03030000
                         END#,                                 <<01103>>03032000
          CIO2      =    BEGIN                                 <<01103>>03034000
                         ASSEMBLE( CIO 2 );                    <<01103>>03036000
                         IF < THEN ERRMESSAGE(M1,S2);          <<01103>>03038000
                         END#,                                 <<01103>>03040000
          RIO0      =    DO BEGIN                              <<01103>>03042000
                            ASSEMBLE( RIO 0 );                 <<01103>>03044000
                            IF < THEN ERRMESSAGE(M1,S0);       <<01103>>03046000
                            IF > THEN DEL;                     <<01103>>03048000
                            END UNTIL =#,                      <<01103>>03050000
          WIO1      =    DO BEGIN                              <<01103>>03052000
                            ASSEMBLE( WIO 1 );                 <<01103>>03054000
                            IF < THEN ERRMESSAGE(M1,S1);       <<01103>>03056000
                            IF > THEN DEL;                     <<01103>>03058000
                            END UNTIL =#,                      <<01103>>03060000
          WIO2      =    DO BEGIN                              <<01103>>03062000
                            ASSEMBLE( WIO 2 );                 <<01103>>03064000
                            IF < THEN ERRMESSAGE(M1,S2);       <<01103>>03066000
                            IF > THEN DEL;                     <<01103>>03068000
                            END UNTIL =#,                      <<02510>>03070000
          SIO1      =    DO BEGIN                              <<02510>>03072000
                            ASSEMBLE( SIO 1 );                 <<02510>>03074000
                            IF < THEN ERRMESSAGE(M1,S2);       <<02510>>03076000
                            IF > THEN DEL;                     <<02510>>03078000
                            END UNTIL =#;                      <<02510>>03080000
DEFINE    RIOA      =    CON %20302; CON %13#;                 <<03002>>03082000
                         <<COMPLIER DOESNT KNOW RIOA YET>>     <<03002>>03084000
DEFINE    WIOA      =    CON %20302; CON %14#;                 <<03004>>03086000
                         <<COMPILER DOESN'T KNOW WIOA YET>>    <<03004>>03088000
                                                                        03090000
  EQUATE  ROLLCALL  =    %120000;  <<ROLL CALL CODE FOR RIOC>> <<02707>>03092000
  DEFINE  D'L       =    DOUBLE(LOGICAL#;                               03094000
                                                                        03096000
  DEFINE  LBITE     =    (0:8)#,     <<LEFT BYTE>>                      03098000
          RBITE     =    (8:8)#;     <<RIGHT BYTE>>                     03100000
  DEFINE  DUPLICATE =    TOS:=S0#;                                      03102000
  EQUATE  BLANK     =    %6440;                                         03104000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>03106000
  EQUATE NPROTECTED=    11;                                    <<04547>>03108000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>03110000
  EQUATE NPROTECTED=    15;                                    <<04547>>03112000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>03114000
                                                                        03116000
           <<---------------                                            03118000
             SPOOLING TABLES                                            03120000
            ---------------- >>                                         03122000
  EQUATE XDDSUBSIZE=    30,    <<XDD SUBENTRY SIZE>>                    03124000
          ERRORSTATE=    %50,                                           03126000
          WAITING   =    %40,                                           03128000
          INITIALIZING=  %60,                                           03130000
          SUSPENDED =    4,                                    <<01.00>>03132000
          EXECUTING =    2,                                             03134000
          OPENED    =    2,                                             03136000
          READY     =    1,                                             03138000
          ACTIV     =    0,                                             03140000
          CHAINEND  =    0,                                             03142000
          NULL      =    0,                                             03144000
          FLABADR1  =    20,                                            03146000
          LINKW     =    25,                                            03148000
          NUMEXT    =    22,                                            03150000
          LASTEXT   =    23,   <<LAST EXTENT SIZE>>                     03152000
          XDDEOF    =    26,                                            03154000
          JMATSUBSIZE=   26;                                   <<01025>>03156000
   DEFINE STATEFLD  =    (0:6)#,                                        03158000
          SPSTATE   =    24).(0:1#,                                     03160000
          MAINPIN   =    22).(0:8#,                                     03162000
          GAU       =    (8:3)#,                                        03164000
          RESTART   =    24).(1:1#,                                     03166000
          XDDSTATE  =    (1:2)#,                                        03168000
          JOBNUM    =    1).(2:14#,                                     03170000
          IDDREST   =    24).(2:1#,                                     03172000
          VDVFLD    =    22).(8:8#,                                     03174000
          SQUEEZE  =    24).(0:1#,                             <<00.+4>>03176000
          OUTFENCE  =    4).(12:4#,                                     03178000
          DEFAULTEOF=    128D#,                                         03180000
          XDDINDEX  =    (8:8)#,                                        03182000
          XDDHEADX  =    19).(8:8#,                                     03184000
          JOBID     =    18).(1:15#,                                    03186000
          SPOOLQUE  =    (7:1)#;                                        03188000
   EQUATE SCHEDHEADP=    3,                                             03190000
          SCHEDTAILP=    4,                                             03192000
          SUBAREAP   =    2,                                            03194000
          XDDHEADSIZE=   4;                                             03196000
EQUATE  << MESSAGE NUMBER EQUATES >>                           <<01103>>03200000
   M0      = 0,                                                <<01103>>03202000
   M1      = 1,                                                <<01103>>03204000
   M2      = 2,                                                <<01103>>03206000
   M3      = 3,                                                <<01103>>03208000
   M4      = 4,                                                <<01103>>03210000
   M5      = 5,                                                <<01103>>03212000
   M6      = 6,                                                <<01103>>03214000
   M7      = 7,                                                <<01103>>03216000
   M8      = 8,                                                <<01103>>03218000
   M9      = 9,                                                <<01103>>03220000
   M10     = 10,                                               <<01103>>03222000
   M11     = 11,                                               <<01103>>03224000
   M12     = 12,                                               <<01103>>03226000
   M13     = 13,                                               <<01103>>03228000
   M14     = 14,                                               <<01103>>03230000
   M15     = 15,                                               <<01103>>03232000
   M16     = 16,                                               <<01103>>03234000
   M17     = 17,                                               <<01103>>03236000
   M18     = 18,                                               <<01103>>03238000
   M19     = 19,                                               <<01103>>03240000
   M20     = 20,                                               <<01103>>03242000
   M21     = 21,                                               <<01103>>03244000
   M22     = 22,                                               <<01103>>03246000
   M23     = 23,                                               <<01103>>03248000
   M24     = 24,                                               <<01103>>03250000
   M25     = 25,                                               <<01103>>03252000
   M26     = 26,                                               <<01103>>03254000
   M27     = 27,                                               <<01103>>03256000
   M28     = 28,                                               <<01103>>03258000
   M29     = 29,                                               <<02707>>03260000
   M30     = 30,                                               <<03550>>03262000
   M31     = 31,                                               <<03550>>03264000
   M32     = 32,                                               <<03550>>03266000
   M33     = 33,                                               <<03550>>03268000
   M34     = 34,                                               <<03550>>03270000
   M100    = 100,                                              <<01103>>03272000
   M101    = 101,                                              <<01103>>03274000
   M102    = 102,                                              <<01103>>03276000
   M103    = 103,                                              <<01103>>03278000
   M104    = 104,                                              <<01103>>03280000
   M105    = 105,                                              <<01103>>03282000
   M106    = 106,                                              <<01103>>03284000
   M107    = 107,                                              <<01103>>03286000
   M108    = 108,                                              <<01103>>03288000
   M109    = 109,                                              <<01103>>03290000
   M110    = 110,                                              <<01103>>03292000
   M111    = 111,                                              <<01103>>03294000
   M112    = 112,                                              <<01103>>03296000
   M113    = 113,                                              <<01103>>03298000
   M114    = 114,                                              <<01103>>03300000
   M115    = 115,                                              <<01103>>03302000
   M116    = 116,                                              <<01103>>03304000
   M117    = 117,                                              <<01103>>03306000
   M118    = 118,                                              <<01103>>03308000
   M119    = 119,                                              <<01103>>03310000
   M120    = 120,                                              <<01103>>03312000
   M121    = 121,                                              <<01103>>03314000
   M122    = 122,                                              <<01103>>03316000
   M123    = 123,                                              <<01103>>03318000
   M124    = 124,                                              <<01103>>03320000
   M125    = 125,                                              <<01103>>03322000
   M126    = 126,                                              <<01103>>03324000
   M127    = 127,                                              <<01103>>03326000
   M128    = 128,                                              <<03002>>03328000
   M129    = 129,                                              <<03002>>03330000
   M130    = 130,                                              <<03004>>03332000
   M131    = 131,                                              <<03004>>03334000
   M132    = 132,                                              <<03004>>03336000
   M133    = 133,                                              <<03004>>03338000
   M134    = 134,                                              <<03004>>03340000
   M135    = 135,                                              <<02707>>03342000
   M136    = 136,                                              <<02707>>03344000
   M200    = 200,                                              <<01103>>03346000
   M201    = 201,                                              <<01103>>03348000
   M202    = 202,                                              <<01103>>03350000
   M203    = 203,                                              <<01103>>03352000
   M204    = 204,                                              <<01103>>03354000
   M205    = 205,                                              <<01103>>03356000
   M225    = 225,                                              <<01103>>03358000
   M226    = 226,                                              <<01103>>03360000
   M227    = 227,                                              <<01103>>03362000
   M228    = 228,                                              <<01103>>03364000
   M229    = 229,                                              <<01103>>03366000
   M230    = 230,                                              <<01103>>03368000
   M231    = 231,                                              <<01103>>03370000
   M232    = 232,                                              <<01103>>03372000
   M233    = 233,                                              <<03550>>03374000
   M234    = 234,                                              <<03550>>03376000
   M235    = 235,                                              <<03550>>03378000
   M236    = 236,                                              <<03612>>03380000
   M237    = 237,                                              <<03613>>03382000
   M250    = 250,                                              <<01103>>03384000
   M251    = 251,                                              <<01103>>03386000
   M252    = 252,                                              <<01103>>03388000
   M253    = 253,                                              <<01103>>03390000
   M254    = 254,                                              <<01103>>03392000
   M275    = 275,                                              <<01103>>03394000
   M276    = 276,                                              <<01103>>03396000
   M277    = 277,                                              <<01103>>03398000
   M300    = 300,                                              <<01103>>03400000
   M301    = 301,                                              <<01103>>03402000
   M302    = 302,                                              <<01103>>03404000
   M303    = 303,                                              <<01103>>03406000
   M304    = 304,                                              <<01103>>03408000
   M305    = 305,                                              <<01103>>03410000
   M325    = 325,                                              <<01103>>03412000
   M326    = 326,                                              <<01103>>03414000
   M327    = 327,                                              <<01103>>03416000
   M328    = 328,                                              <<01442>>03418000
   M329    = 329,                                              <<01442>>03420000
   M330    = 330,                                              <<MPEIV>>03422000
   M331    = 331,                                              <<03551>>03424000
   M332    = 332,                                              <<03551>>03426000
   M333    = 333,                                              <<03551>>03428000
   M334    = 334,                                              <<03550>>03430000
   M335    = 335,                                              <<03550>>03432000
   M350    = 350,                                              <<01103>>03434000
   M351    = 351,                                              <<01103>>03436000
   M352    = 352,                                              <<01103>>03438000
   M374    = 374,                                              <<01103>>03440000
   M375    = 375,                                              <<01103>>03442000
   M376    = 376,                                              <<01103>>03444000
   M377    = 377,                                              <<01103>>03446000
   M378    = 378,                                              <<01103>>03448000
   M379    = 379,                                              <<01103>>03450000
   M400    = 400,                                              <<01103>>03452000
   M401    = 401,                                              <<03551>>03454000
   M450    = 450,                                              <<03603>>03456000
   M451    = 451,                                              <<03603>>03458000
   M452    = 452,                                              <<03603>>03460000
   M500    = 500,                                              <<03550>>03462000
   M501    = 501,                                              <<03550>>03464000
   M2000   = 2000,                                             <<01103>>03466000
   M2001   = 2001,                                             <<01103>>03468000
   M2002   = 2002,                                             <<01103>>03470000
   M2003   = 2003,                                             <<01103>>03472000
   M2004   = 2004,                                             <<01103>>03474000
   M2005   = 2005,                                             <<01103>>03476000
   M2006   = 2006,                                             <<01103>>03478000
   M2007   = 2007,                                             <<01103>>03480000
   M2008   = 2008,                                             <<01103>>03482000
   M2009   = 2009,                                             <<01103>>03484000
   M2010   = 2010,                                             <<01103>>03486000
   M2011   = 2011,                                             <<01103>>03488000
   M2012   = 2012,                                             <<01103>>03490000
   M2013   = 2013,                                             <<01103>>03492000
   M2014   = 2014,                                             <<01103>>03494000
   M2015   = 2015,                                             <<01103>>03496000
   M2016   = 2016,                                             <<01103>>03498000
   M2017   = 2017,                                             <<01103>>03500000
   M2018   = 2018,                                             <<01103>>03502000
   M2019   = 2019,                                             <<01103>>03504000
   M2020   = 2020,                                             <<01103>>03506000
   M2021   = 2021,                                             <<01103>>03508000
   M2022   = 2022,                                             <<01103>>03510000
   M2023   = 2023,                                             <<01103>>03512000
   M2024   = 2024,                                             <<01103>>03514000
   M2025   = 2025,                                             <<01103>>03516000
   M2026   = 2026,                                             <<01103>>03518000
   M2027   = 2027,                                             <<01103>>03520000
   M2028   = 2028,                                             <<01103>>03522000
   M2029   = 2029,                                             <<01853>>03524000
   M2100   = 2100,                                             <<01103>>03526000
   M2101   = 2101,                                             <<01103>>03528000
   M2102   = 2102,                                             <<01103>>03530000
   M2103   = 2103,                                             <<01103>>03532000
   M2104   = 2104,                                             <<01103>>03534000
   M2105   = 2105,                                             <<01103>>03536000
   M2106   = 2106,                                             <<01103>>03538000
   M2107   = 2107,                                             <<01103>>03540000
   M2108   = 2108,                                             <<01103>>03542000
   M2109   = 2109,                                             <<01103>>03544000
   M2110   = 2110,                                             <<01103>>03546000
   M2111   = 2111,                                             <<01103>>03548000
   M2112   = 2112,                                             <<01103>>03550000
   M2113   = 2113,                                             <<01103>>03552000
   M2114   = 2114,                                             <<01103>>03554000
   M2115   = 2115,                                             <<01103>>03556000
   M2116   = 2116,                                             <<01103>>03558000
   M2117   = 2117,                                             <<01103>>03560000
   M2118   = 2118,                                             <<01103>>03562000
   M2119   = 2119,                                             <<01103>>03564000
   M2120   = 2120,                                             <<01103>>03566000
   M2121   = 2121,                                             <<01103>>03568000
   M2122   = 2122,                                             <<01103>>03570000
   M2123   = 2123,                                             <<01103>>03572000
   M2124   = 2124,                                             <<01103>>03574000
   M2125   = 2125,                                             <<01103>>03576000
   M2126   = 2126,                                             <<01103>>03578000
   M2127   = 2127,                                             <<01103>>03580000
   M2128   = 2128,                                             <<01103>>03582000
   M2129   = 2129,                                             <<01103>>03584000
   M2130   = 2130,                                             <<01103>>03586000
   M2131   = 2131,                                             <<01103>>03588000
   M2140   = 2140,                                             <<01103>>03590000
   M2141   = 2141,                                             <<01103>>03592000
   M2150   = 2150,                                             <<01103>>03594000
   M2151   = 2151,                                             <<01103>>03596000
   M2200   = 2200,                                             <<01103>>03598000
   M2201   = 2201,                                             <<01103>>03600000
   M2202   = 2202,                                             <<01103>>03602000
   M2203   = 2203,                                             <<01103>>03604000
   M2204   = 2204,                                             <<01103>>03606000
   M2205   = 2205,                                             <<01103>>03608000
   M2206   = 2206,                                             <<01103>>03610000
   M2207   = 2207,                                             <<01103>>03612000
   M2208   = 2208,                                             <<01103>>03614000
   M2210   = 2210,                                             <<01103>>03618000
   M2211   = 2211,                                             <<01103>>03620000
   M2215   = 2215,                                             <<MPEIV>>03622000
   M2216   = 2216,                                             <<MPEIV>>03624000
   M2217   = 2217,                                             <<MPEIV>>03626000
   M2218   = 2218,                                             <<MPEIV>>03628000
   M2219   = 2219,                                             <<MPEIV>>03630000
   M2220   = 2220,                                             <<01682>>03632000
   M2225   = 2225,                                             <<01103>>03634000
   M2226   = 2226,                                             <<01103>>03636000
   M2227   = 2227,                                             <<01103>>03638000
   M2228   = 2228,                                             <<01103>>03640000
   M2229   = 2229,                                             <<01103>>03642000
   M2230   = 2230,                                             <<01103>>03644000
   M2231   = 2231,                                             <<01103>>03646000
   M2232   = 2232,                                             <<01103>>03648000
   M2233   = 2233,                                             <<01103>>03650000
   M2234   = 2234,                                             <<01103>>03652000
   M2235   = 2235,                                             <<01103>>03654000
   M2236   = 2236,                                             <<01103>>03656000
   M2237   = 2237,                                             <<01103>>03658000
   M2238   = 2238,                                             <<01103>>03660000
   M2239   = 2239,                                             <<01103>>03662000
   M2240   = 2240,                                             <<01103>>03664000
   M2241   = 2241,                                             <<01103>>03666000
   M2242   = 2242,                                             <<01103>>03668000
   M2243   = 2243,                                             <<01103>>03670000
   M2244   = 2244,                                             <<01103>>03672000
   M2245   = 2245,                                             <<01103>>03674000
   M2246   = 2246,                                             <<01103>>03676000
   M2247   = 2247,                                             <<03613>>03678000
   M2248   = 2248,                                             <<03613>>03680000
   M2250   = 2250,                                             <<03612>>03682000
   M2275   = 2275,                                             <<01103>>03684000
   M2276   = 2276,                                             <<01103>>03686000
   M2277   = 2277,                                             <<01103>>03688000
   M2278   = 2278,                                             <<01103>>03690000
   M2279   = 2279,                                             <<01103>>03692000
   M2280   = 2280,                                             <<01103>>03694000
   M2281   = 2281,                                             <<01103>>03696000
   M2282   = 2282,                                             <<01103>>03698000
   M2283   = 2283,                                             <<01103>>03700000
   M2284   = 2284,                                             <<01103>>03702000
   M2285   = 2285,                                             <<03550>>03704000
   M2286   = 2286,                                             <<03668>>03706000
   M2287   = 2287,                                             <<03668>>03708000
   M2288   = 2288,                                             <<03668>>03710000
   M2289   = 2289,                                             <<03668>>03712000
   M2290   = 2290,                                             <<03668>>03714000
   M2300   = 2300,                                             <<01103>>03716000
   M2301   = 2301,                                             <<01103>>03718000
   M2302   = 2302,                                             <<01103>>03720000
   M2303   = 2303,                                             <<01103>>03722000
   M2304   = 2304,                                             <<01103>>03724000
   M2305   = 2305,                                             <<01103>>03726000
   M2306   = 2306,                                             <<01103>>03728000
   M2307   = 2307,                                             <<01103>>03730000
   M2308   = 2308,                                             <<01103>>03732000
   M2325   = 2325,                                             <<01103>>03734000
   M2326   = 2326,                                             <<01103>>03736000
   M2327   = 2327,                                             <<01103>>03738000
   M2328   = 2328,                                             <<01103>>03740000
   M2329   = 2329,                                             <<01103>>03742000
   M2330   = 2330,                                             <<01103>>03744000
   M2331   = 2331,                                             <<01103>>03746000
   M2332   = 2332,                                             <<01103>>03748000
   M2333   = 2333,                                             <<01103>>03750000
   M2334   = 2334,                                             <<01115>>03752000
   M2350   = 2350,                                             <<01103>>03754000
   M2351   = 2351,                                             <<01103>>03756000
   M2352   = 2352,                                             <<01103>>03758000
   M2353   = 2353,                                             <<01103>>03760000
   M2354   = 2354,                                             <<01103>>03762000
   M2355   = 2355,                                             <<01103>>03764000
   M2356   = 2356,                                             <<01103>>03766000
   M2357   = 2357,                                             <<02834>>03768000
   M2400   = 2400,                                             <<01103>>03770000
   M2401   = 2401,                                             <<01103>>03772000
   M2402   = 2402,                                             <<01103>>03774000
   M2403   = 2403,                                             <<01103>>03776000
   M2404   = 2404,                                             <<01103>>03778000
   M2405   = 2405,                                             <<01103>>03780000
   M2406   = 2406,                                             <<01103>>03782000
   M2407   = 2407,                                             <<01103>>03784000
   M2408   = 2408,                                             <<01103>>03786000
   M2409   = 2409,                                             <<01103>>03788000
   M2410   = 2410,                                             <<01103>>03790000
   M2411  = 2411,                                              <<03002>>03792000
   M2412  = 2412,                                              <<03002>>03794000
   M2450   = 2450,                                             <<01103>>03796000
   M2451   = 2451,                                             <<01103>>03798000
   M2452   = 2452,                                             <<01103>>03800000
   M2453   = 2453,                                             <<01103>>03802000
   M2454   = 2454,                                             <<01103>>03804000
   M2455   = 2455,                                             <<01103>>03806000
   M2456   = 2456,                                             <<01103>>03808000
   M2457  = 2457,                                              <<03002>>03810000
   M2458   = 2458,                                             <<03550>>03812000
   M2500   = 2500,                                             <<03550>>03814000
   M2501   = 2501,                                             <<03550>>03816000
   M2502   = 2502,                                             <<03550>>03818000
   M2503   = 2503,                                             <<03630>>03820000
   M2504   = 2504,                                             <<03630>>03822000
   M2505   = 2505,                                             <<03630>>03824000
   M2506   = 2506;                                             <<03630>>03826000
$PAGE "VARIABLE DECLARATIONS"                                  <<01103>>03828000
  INTEGER ARRAY TABLEPTRS(0:EXPTABLES)=DB; <<PTRS TO EXPANDING TABLES>> 03830000
  EXT'DCL << Pointers used in INITIAL subprogram >>            <<SY>>   03832000
  INTEGER POINTER DIRSP=TABLEPTRS,   <<DIRECTORY SPACE TABLE>>          03834000
                  DIR=TABLEPTRS+1,   <<DIRECTORY DATA SEGMENT>>         03836000
                  SEGT = TABLEPTRS+2,   << SEGMENT TABLE >>    <<03551>>03838000
                  CSTAB=TABLEPTRS+3, <<CS DATA SEGMENT>>                03840000
                  DVRTAB=TABLEPTRS+4,<<DRIVER TABLE>>                   03842000
                  LPDT   =TABLEPTRS+5,<<LOG-PHYS DEV TABLE>>            03844000
                  LDT    =TABLEPTRS+6,<<LOGICAL DEVICE TABLE>>          03846000
                  LDTX=TABLEPTRS+8,  <<LDT EXTENSION>>         <<00.06>>03848000
                  VTAB=TABLEPTRS+9,  <<VOLUME TABLE>>          <<00.06>>03850000
                  OLDVTAB=TABLEPTRS+10,<<OLD VOLUME TABLE>>    <<00.06>>03852000
                  OLDINFO=TABLEPTRS+11,<<OLD INFO TABLE>>      <<00.06>>03854000
                  CTAB=TABLEPTRS+12, <<CORESIZE-RELATED CONFIGURATION>> 03856000
                  CTAB0=TABLEPTRS+13;<<STD CONFIGURATION>>     <<00.06>>03858000
  BYTE POINTER DVCLTAB=TABLEPTRS+7;  <<DEVICE CLASS TABLE>>             03860000
  INTEGER ARRAY TABLEINCRS(0:EXPTABLES-1)=DB:=EXPTABLES(0);             03862000
  INTEGER DIRSPINCR = TABLEINCRS,                              <<03675>>03864000
          DIRINCR   = TABLEINCRS+1,                            <<03675>>03866000
          SEGTINCR  = TABLEINCRS+2,                            <<03675>>03868000
          CSTABINCR=TABLEINCRS+3,    <<CS DATA SEGMENT>>       <<03675>>03870000
          DVRTABINCR=TABLEINCRS+4,   <<DRIVER TABLE>>                   03872000
          LPDTINCR=TABLEINCRS+5,     <<LOG-PHYS DEV TABLE>>             03874000
          LDTINCR=TABLEINCRS+6,      <<LOGICAL DEVICE TABLE>>           03876000
          DVCLTABINCR=TABLEINCRS+7,  <<DEVICE CLASS TABLE>>             03878000
          LDTXINCR   =TABLEINCRS+8,  <<LDTX EXTENSION>>        <<00.06>>03880000
          VTABINCR   =TABLEINCRS+9,  <<VOLUME TABLE>>          <<00.06>>03882000
          OLDINFOINCR=TABLEINCRS+11, <<OLD INFO TABLE>>        <<00.06>>03884000
          CTABINCR=TABLEINCRS+12; <<CONFIGURATION TABLE>>      <<00.06>>03886000
  DOUBLE  POINTER ARLD=DB+ARLDIX;                              <<MPEIV>>03888000
  INTEGER POINTER CST=CSTIX,         <<CODE SEGMENT TABLE>>             03890000
                  DST=DSTIX,         <<DATA SEGMENT TABLE>>             03892000
                  PCB=PCBIX,         <<PROCESS CONTROL BLOCK TABLE>>    03894000
                  TRL=TRLIX,         <<TIMER REQUEST LIST>>             03896000
                  JCUT=JCUTIX,       <<JOB CUTOFF TABLE>>               03898000
                  JPCNT=JPCNTIX,     <<JOB PROCESS COUNT TABLE>>        03900000
                  STOPS=STOPSIX,     <<BREAKPOINT TABLE>>               03902000
                  ILT=ILTIX,         <<INTERRUPT LINKAGE TABLE>>        03904000
                  DIT=DITIX,         <<DEVICE INFORMATION TABLE>>       03906000
                  DLT=DLTIX,         <<DRIVER LINKAGE TABLE>>           03908000
                  JMAT,              <<JOB TABLE>>             <<01384>>03910000
                  XDD;               <<DEVICE DIRECTORY>>      <<MPEIV>>03912000
  LOGICAL POINTER VDSMTAB=VDSMTABIX, << VM MGT TABLE >>        <<MPEIV>>03914000
                  VDSENTRY=VDSENTRYIX,<<CURRENT VM BITMAP >>   <<MPEIV>>03916000
                  VDSMAP=VDSMAPIX;   <<CURRENT VM ENTRY >>     <<MPEIV>>03918000
  INTEGER POINTER ARSBM=ARSBMIX,                               <<MPEIV>>03920000
                  SWAPTAB=SWAPTABIX,                           <<MPEIV>>03922000
                  DISCREQTAB=DISCREQTABIX,                     <<MPEIV>>03924000
                  SYSGLOBEXT'=%377,                            <<MPEIV>>03926000
                  CSTBLK=CSTBLKIX,   <<CST BLOCK TABLE>>                03928000
                  BUSY=BUSYIX,       <<BUSY TABLE>>                     03930000
                  HEAD=HEADIX,       <<HEAD TABLE>>                     03932000
                  TAIL=TAILIX,       <<TAIL TABLE>>                     03934000
                  STANDARD   =    STDIX,       <<STANDARD TABLE>>       03936000
                  ICS=ICSIX;        <<INTERRUPT CONTROL STACK>><<03603>>03938000
                                                               <<MPEIV>>03940000
  DEFINE  FIRSTMEMBANK=SYSGLOBEXT'(1)#,                        <<MPEIV>>03942000
          FIRSTMEMBASE=SYSGLOBEXT'(2)#,                        <<MPEIV>>03944000
          MEMORYPAGESIZE=SYSGLOBEXT'(5)#;                      <<MPEIV>>03946000
                                                               <<MPEIV>>03948000
  INTEGER POINTER TCST = 0,          <<TEMPORARY CST TABLE>>   <<03603>>03952000
                  RIN,               <<RIN TABLE>>                      03956000
                  CTABCC,            <<CURRENT CORESIZE CONFIGURATION>> 03958000
                  CTABNC=RIN,        <<NEW CORESIZE CONFIGURATION>>     03960000
                  DVRENT,            <<DRIVER TABLE ENTRY>>             03962000
                  CSDEF,             <<DEFAULT LINE DESCRIPTORS>>       03964000
                  CSDVR,             <<EXTRA CS DRIVERS>>               03966000
                  CSDVRAREA,         <<CS DRIVER TABLE WORKAREA>>       03968000
                  DRIVERENTRY,       <<CURRENT CS DRIVER ENTRY>>        03970000
                  CSLDTX,            <<CURRENT CS LINE DESCRIPTOR>>     03972000
                  LDTENT,            <<LOGICAL DEVICE TABLE ENTRY>>     03974000
                  LDTXENT,           <<LOG-DEV TABLE EXTENSION ENTRY>>  03976000
                  LPDTENT,           <<LOG-PHYS DEVICE TABLE ENTRY>>    03978000
                  IOPROC,            <<IO PROCESS TABLE>>               03980000
                  TAPEBUF,           <<SYS TAPE BUF>>          <<03603>>03982000
                  DLT',              <<TEMPORARY DRIVER LINKAGE TABLE>> 03984000
                  SEGXFORM,          <<SEGMENT TRANSFORM TABLE>>        03988000
                  SEGENTTAB,         <<SEGMENT ENTRY TABLE>>            03990000
                  SEGREF,            <<SEGMENT REFERENCE TABLE>>        03992000
                  SEGDIR,            <<SEGMENT DIRECTORY>>              03994000
                  LOGTAB,                                      <<00506>>03996000
                  LIDTAB;                                      <<03551>>03998000
                                                               <<MPEIV>>04002000
                                                               <<MPEIV>>04006000
<<>>                                                           <<MPEIV>>04008000
<<PCB WORDS AND FIELDS>>                                       <<MPEIV>>04010000
<<>>                                                           <<MPEIV>>04012000
                                                               <<MPEIV>>04014000
LOGICAL ARRAY PCBRESABORTINFO(*)=DB+0,                         <<MPEIV>>04016000
              PCBSLLPTR(*)=DB+1,                               <<MPEIV>>04018000
              PCBDBXDSINFO(*)=DB+2,                            <<MPEIV>>04020000
              PCBSTKINFO(*)=DB+3,                              <<MPEIV>>04022000
              PCBWAKEMASK(*)=DB+4,                             <<MPEIV>>04024000
              PCBFATHERSONINFO(*)=DB+5,                        <<MPEIV>>04026000
              PCBBROTHERINFO(*)=DB+6,                          <<MPEIV>>04028000
   <<         PCBPIMPPINBKLINK(*)=DB+7,     >>                 <<03552>>04030000
   <<         PCBEVENTFLAGS(*)=DB+%12,      >>                 <<03552>>04032000
              PCBPROCSTATE(*)=DB+%11,                          <<MPEIV>>04034000
              PCBPIINFONIMPPIN(*)=DB+%10,                      <<MPEIV>>04036000
   <<         PCBMSGHARBORPTR(*)=DB+%13,    >>                 <<03552>>04038000
              PCBPBX(*)=DB+%14,                                <<MPEIV>>04040000
              PCBQUEUEINGINFO(*)=DB+%15,                       <<MPEIV>>04042000
   <<         PCBNQPTR(*)=DB+%16,           >>                 <<03552>>04044000
              PCBPQPTR(*)=DB+%17;                              <<MPEIV>>04046000
                                                               <<MPEIV>>04048000
DEFINE RESABORTINFO=PCBRESABORTINFO(X)#,                       <<MPEIV>>04050000
       SLLPTR=PCBSLLPTR(X)#,                                   <<MPEIV>>04052000
       DBXDSINFO=PCBDBXDSINFO(X)#,                             <<MPEIV>>04054000
       STKINFO=PCBSTKINFO(X)#,                                 <<MPEIV>>04056000
       WAKEMASK=PCBWAKEMASK(X)#,                               <<MPEIV>>04058000
       FATHERSONINFO=PCBFATHERSONINFO(X)#,                     <<MPEIV>>04060000
       BROTHERINFO=PCBBROTHERINFO(X)#,                         <<MPEIV>>04062000
   <<  PIMPPINBKLINK=PCBPIMPPINBKLINK(X)#,  >>                 <<03552>>04064000
   <<  EVENTFLAGS=PCBEVENTFLAGS(X)#,        >>                 <<03552>>04066000
       PROCSTATE=PCBPROCSTATE(X)#,                             <<MPEIV>>04068000
       PIINFONIMPPIN=PCBPIINFONIMPPIN(X)#,                     <<MPEIV>>04070000
   <<  MSGHARBORPTR=PCBMSGHARBORPTR(X)#,    >>                 <<03552>>04072000
       PBX=PCBPBX(X)#,                                         <<MPEIV>>04074000
       QUEUEINGINFO=PCBQUEUEINGINFO(X)#,                       <<MPEIV>>04076000
   <<  NQPTR=PCBNQPTR(X)#,                  >>                 <<03552>>04078000
       PQPTR=PCBPQPTR(X)#;                                     <<MPEIV>>04080000
                                                               <<MPEIV>>04082000
EQUATE RESABORTINFOWORDNUM=0,                                  <<MPEIV>>04084000
   <<  SLLIXWORDNUM=1,                      >>                 <<03552>>04086000
   <<  DBXDSINFOWORDNUM=2,                  >>                 <<03552>>04088000
   <<  STKINFOWORDNUM=3,                    >>                 <<03552>>04090000
   <<  WAKEMASKWORDNUM=4,                   >>                 <<03552>>04092000
   <<  FATHERSONINFOWORDNUM=5,              >>                 <<03552>>04094000
   <<  BROTHERINFOWORDNUM=6,                >>                 <<03552>>04096000
   <<  PIMPPINBKLINKWORDNUM=7,              >>                 <<03552>>04098000
   <<  EVENTFLAGSWORDNUM=%12,               >>                 <<03552>>04100000
   <<  PROCSTATEWORDNUM=%11,                >>                 <<03552>>04102000
   <<  PIINFONIMPPINWORDNUM=%10,            >>                 <<03552>>04104000
   <<  PBXWORDNUM=%14,                      >>                 <<03552>>04106000
   <<  QUEUEINGINFOWORDNUM=%15,             >>                 <<03552>>04108000
   <<  NQPTRWORDNUM=%16,                    >>                 <<03552>>04110000
       PQPTRWORDNUM=%17;                                       <<MPEIV>>04112000
                                                               <<MPEIV>>04114000
                                                               <<MPEIV>>04116000
<<>>                                                           <<MPEIV>>04118000
<<LOCALITY LISTS>>                                             <<MPEIV>>04120000
<<>>                                                           <<MPEIV>>04122000
                                                               <<MPEIV>>04124000
LOGICAL ARRAY SLLHEAD00(*)=DB+0,                               <<MPEIV>>04126000
              SLLHEAD01(*)=DB+1,                               <<MPEIV>>04128000
    <<        SLLHEAD02(*)=DB+2,          >>                   <<03635>>04130000
              SLLHEAD03(*)=DB+3,                               <<MPEIV>>04132000
              SLLHEAD04(*)=DB+4,                               <<MPEIV>>04134000
    <<        SLLENTRY00(*)=DB+0,         >>                   <<03635>>04136000
    <<        SLLENTRY01(*)=DB+1,         >>                   <<03635>>04138000
    <<        SLLENTRY02(*)=DB+2,         >>                   <<03635>>04140000
              SLLENTRY03(*)=DB+3,                              <<MPEIV>>04142000
              SLLENTRY04(*)=DB+4;                              <<MPEIV>>04144000
                                                               <<MPEIV>>04146000
DEFINE SLLSCHEDTOIOMSG=SLLHEAD00(X)#,                          <<MPEIV>>04148000
       SLLFIRSTINX=SLLHEAD01(X)#,                              <<MPEIV>>04150000
   <<  SLLCURRINX=SLLHEAD02(X)#,          >>                   <<03635>>04152000
       SLLMEMREQINX=SLLHEAD03(X)#,                             <<MPEIV>>04154000
       SLLSEGCNT=SLLHEAD04(X)#,                                <<MPEIV>>04156000
   <<  SLLMPDQLINK=SLLENTRY00(X)#,        >>                   <<03635>>04158000
   <<  SLLNEXTINX=SLLENTRY01(X)#,         >>                   <<03635>>04160000
   <<  SLLPREVINX=SLLENTRY02(X)#,         >>                   <<03635>>04162000
       SLLSEGIDENT=SLLENTRY03(X)#,                             <<MPEIV>>04164000
       SLLFLAGS=SLLENTRY04(X)#;                                <<MPEIV>>04166000
                                                               <<MPEIV>>04168000
DEFINE << SLLSWAPIPFLAG=(0:1)#,             >>                 <<03552>>04170000
       SLLSWAPREQFLAG=(1:1)#,                                  <<MPEIV>>04172000
   <<  SLLHASMEMFLAG=(2:1)#,                >>                 <<03552>>04174000
   <<  SLLIOCOMPTOAWAKECNT=(8:8)#,          >>                 <<03552>>04176000
   <<  SLLREFFLAG=(0:1)#,                   >>                 <<03552>>04178000
       SLLSTKENTRYFLAG=(1:1)#,                                 <<MPEIV>>04180000
       SLLSEGALLOCFLAG=(6:1)#;                                 <<MPEIV>>04182000
                                                               <<MPEIV>>04184000
<< EQUATE SLLSWAPIPBIT=0,                   >>                 <<03552>>04186000
   <<  SLLHASMEMBIT=3,                      >>                 <<03552>>04188000
   <<  SLLSWAPREQBIT=1;                     >>                 <<03552>>04190000
                                                               <<MPEIV>>04192000
<< EQUATE                                   >>                 <<03552>>04194000
   <<  SLLSTKENTRYBIT=1,                    >>                 <<03552>>04196000
   <<  SLLBKLKBIT=4,                        >>                 <<03552>>04198000
   <<  SLLFZBIT=5,                          >>                 <<03552>>04200000
   <<  SLLSEGALLBIT=6,                      >>                 <<03552>>04202000
   <<  SLLLKBIT=3;                          >>                 <<03552>>04204000
                                                               <<MPEIV>>04206000
<< DEFINE SEGIDENTCODEFLAG=(0:1)#,          >>                 <<03552>>04208000
   <<  SEGIDENTBLKFLAG=(1:1)#;              >>                 <<03552>>04210000
                                                               <<MPEIV>>04212000
  DOUBLE POINTER TCSTDISC,           <<INITIAL'S SEGS DISC ADDRS>>      04214000
                 TABLEINFO,          <<INFO TABLE AREA>>                04216000
                 TCSTINFO,           <<INFO TEMPORARY CST AREA>>        04218000
                 OLDINFOD=OLDINFO,   <<OLD INFO TABLE>>                 04220000
                 OLDTABLEINFO,       <<OLDINFO TABLE AREA>>             04222000
                 OLDTCSTINFO,        <<OLDINFO TEMPORARY CST AREA>>     04224000
                 ENTRE,              <<EXTENT POINTER>>                 04226000
          DCTAB0=CTAB0,                                                 04230000
                 DCSLDTX = CSLDTX;                             <<03551>>04232000
  INTEGER POINTER ENTRE0 = ENTRE;                                       04236000
  BYTE POINTER BPINBUF,              <<INPUT BUFFER POINTER>>           04238000
               INTR,                 <<INTERRUPT PROCEDURES' STT'S>>    04240000
               DVRNAME,              <<DRIVER NAME>>                    04242000
               DISCLASS;             <<PTR TO DEVICE CLASS DISC>>       04244000
  BYTE ARRAY PROCNAMES(0:71) :=                                <<03552>>04246000
    <<  0>>  "ININ    ",                                       <<03552>>04248000
    <<  8>>  "PROGEN  ",                                       <<03552>>04252000
    << 16>>  "UCOP    ",                                       <<03552>>04254000
    << 24>>  "PFAIL   ",                                       <<03552>>04256000
    << 32>>  "LOAD    ",                                       <<03552>>04258000
    << 40>>  "DEVREC  ",                                       <<03552>>04260000
    << 48>>  "LOG     ",                                       <<03552>>04262000
    << 56>>  "MEMLOGP ",                                       <<03552>>04264000
    << 64>>  "PVPROC  ";                                       <<03552>>04266000
BYTE ARRAY BYTEMISCARRAY(0:157):=                              <<00.DL>>04268000
        <<00>>  "CONFDATA ",0,                                 <<00.DL>>04270000
        <<10>>  "SL      ",                                    <<00.DL>>04272000
        <<18>>  "CSDUMMY ",                                    <<00.DL>>04274000
        <<26>>  "7TRACE0'",                                    <<00.DL>>04276000
        <<34>>  "=COMMANDINTERP",                              <<00.DL>>04278000
        <<48>>  "9TERMINATE",                                  <<00.DL>>04280000
        <<58>>  "9PSEUDOINT",                                  <<00.DL>>04282000
<<68>> "3DSP",                                                 <<MPEIV>>04284000
        <<72>>  ":IOMESSPROC",0,                               <<00.DL>>04286000
        <<84>> "3GIP",                                         <<00.DL>>04288000
        <<88>> "4TICK ",                                       <<00.DL>>04290000
        <<94>> "9SYSIOPROC      ",                             <<00.DL>>04292000
        <<110>> "8INITIATE",0,                                 <<00.DL>>04294000
        <<120>> "6CCLOSE",0,                                   <<00.DL>>04296000
        <<128>> "8CSIOWAIT",0;                                 <<00.DL>>04298000
DEFINE  CTABFILE     = BYTEMISCARRAY#,                         <<00.DL>>04300000
        SLFILE       = BYTEMISCARRAY(10)#,                     <<00.DL>>04302000
        CSDUMMY      = BYTEMISCARRAY(18)#,                     <<00.DL>>04304000
        TRACENAME    = BYTEMISCARRAY(26)#,                     <<00.DL>>04306000
        CINAME       = BYTEMISCARRAY(34)#,                     <<00.DL>>04308000
        TERMNAME     = BYTEMISCARRAY(48)#,                     <<00.DL>>04310000
        PSINTNAME    = BYTEMISCARRAY(58)#,                     <<00.DL>>04312000
DISPATCHNAME=BYTEMISCARRAY(68)#,                               <<MPEIV>>04314000
        IOMESSNAME   = BYTEMISCARRAY(72)#,                     <<00.DL>>04316000
        GIPNAME      = BYTEMISCARRAY(84)#,                     <<00.DL>>04318000
        CLOCKNAME    = BYTEMISCARRAY(88)#,                     <<00.DL>>04320000
        SYSIOPROC    = BYTEMISCARRAY(94)#,                     <<00.DL>>04322000
        INITNAME     = BYTEMISCARRAY(110)#,                    <<00.DL>>04324000
        CCLOSENAME   = BYTEMISCARRAY(120)#,                    <<00.DL>>04326000
        CSIOWAITNAME = BYTEMISCARRAY(128)#;                    <<00.DL>>04328000
  DEFINE ININFILE    = PROCNAMES#,                             <<03552>>04330000
         PROGFILE    = PROCNAMES(8)#,                          <<03552>>04334000
         UCOPFILE    = PROCNAMES(16)#,                         <<03552>>04336000
         PFAILFILE   = PROCNAMES(24)#,                         <<03552>>04338000
         LOADFILE    = PROCNAMES(32)#,                         <<03552>>04340000
         DEVRECFILE  = PROCNAMES(40)#,                         <<03552>>04342000
         LOGFILE     = PROCNAMES(48)#,                         <<03552>>04344000
         MEMLGFILE   = PROCNAMES(56)#,                         <<03552>>04346000
         PVPROCFILE  = PROCNAMES(64)#;                         <<03552>>04348000
    LOGICAL ARRAY CSDRTN (0:31);                               <<03002>>04350000
        <<BIT ARRAY OF DRT'S, BIT IS SET IF DRT OF CS DEVICE>>          04352000
  BYTE ARRAY PROTECTED(0:NPROTECTED*8-1) := "CONFDATA","SYSDUMP ",      04354000
                     "SEGDVR  ","SEGPROC ","LOG     ","LOADMAP ",       04356000
                     "MAKECAT ","CATALOG ","INITIAL ",         <<03745>>04358000
                     "PVINIT  ","STORE   "                     <<04547>>04360000
$IF X1=ON  << ADDITIONAL SERIES 33 PROGRAMS >>                 <<00888>>04362000
                ,"SDFLOAD ","SDFCHECK","SDFCOM  ","SDFGEN  "   <<00888>>04364000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>04366000
                 ;                                             <<00888>>04368000
  INTEGER ARRAY PAGES(0:2):=JMATPAGES,IDDPAGES,ODDPAGES;       <<MPEIV>>04370000
  INTEGER ARRAY SYSINFO(0:25) := 0,0,%177607,%713,0,0,         <<02836>>04372000
"        ",0,0,%77777,-1,0,0,%77777,-1,0,0,%77777,-1,          <<2B.00>>04374000
          [2/2,2/1,2/1,2/1,2/2,2/1],150,0,0;                   <<RV.PV>>04376000
INTEGER ARRAY PUBINFO(0:36):=0,"        ",0,0,%77777,-1,0,0,   <<14.PV>>04378000
          %77777,-1,0,0,%77777,-1,                             <<02836>>04380000
          [2/0,5/16,5/6,4/3], [1/0,5/6,5/16,5/6],              <<02836>>04382000
          %713,0,0,"        ","        ","        ",0,0,0;     <<02836>>04384000
  INTEGER ARRAY MANAGERINFO(0:14) := %177607,%713,0,0,         <<02836>>04386000
          "        ","PUB     ",0,150,0;                                04388000
  INTEGER ARRAY SYSACCT(0:3) := "SYS     ";                             04390000
  INTEGER ARRAY PUBGRP(0:3) := "PUB     ";                              04392000
  INTEGER ARRAY MANUSER(0:3) := "MANAGER ";                             04394000
  INTEGER ARRAY NULLNAME(0:3) := "        ";                            04396000
  INTEGER ARRAY FHTABSIZE(0:2):=4,6,8;                                  04398000
                                                               <<25.02>>04400000
  << TO ADD NEW 13037-COMPATIBLE MOVING HEAD DISC SUBTYPES  >> <<25.03>>04402000
  << (MUST BE <= 15):                                       >> <<25.03>>04404000
  <<   1.  MODIFY NMHSUBTYPES (NUMBER OF MOVING HEAD        >> <<25.02>>04406000
  << SUBTYPES),                                             >> <<25.02>>04408000
  <<   2.  ADD THE APPROPRIATE SUBTYPE ENTRIES TO MHINFO.   >> <<25.02>>04410000
  << EACH SUBTYPE CONSISTS OF SEVEN ENTRIES (ONE LINE) IN   >> <<25.02>>04412000
  << MHINFO.  SEE ENTRY DESCRIPTIONS IN THE MOVING HEAD     >> <<25.02>>04414000
  << DISC INFORMATION TABLE (STARTS AT MHINFOSIZE),         >> <<25.02>>04416000
  <<   3.  ADD ENTRIES TO ARRAYS "FILEMASK", "SEC'CYL" AND  >> <<25.02>>04418000
  << "HEADBASE" IN PROCEDURE MH7905,                        >> <<25.02>>04420000
  <<   4.  ADD ENTRIES TO ARRAYS "SCTPERHD" AND "HDBASE" IN >> <<25.02>>04422000
  << PROCEDURE SIOREADENT.                                  >> <<25.02>>04424000
  <<   NOTE:  DO NOT TRY TO GATHER THE VARIOUS ARRAYS IN    >> <<25.02>>04426000
  << MH7905, MHDISC AND SIOREADENT INTO MHINFO.  IT DOESN'T >> <<25.02>>04428000
  << WORK BECAUSE THOSE PROCEDURES RUN IN STRANGE           >> <<25.02>>04430000
  << DB RELATIVE PLACES THAT DON'T KNOW ABOUT MHINFO.       >> <<25.02>>04432000
  <<   5.  MODIFY SUBROUTINE "INITIALIZE" OF MH7905, IF     >> <<25.03>>04434000
  << REQUIRED, SO THAT AN ENTIRE TRACK IS INITIALIZED.      >> <<25.03>>04436000
                                                               <<25.03>>04438000
  INTEGER ARRAY MHINFO (0:NMHSUBTYPES*MHINFOSIZE - 1) :=       <<25.00>>04440000
            200,203, 1,48,2,0,12,  << 7900, REMOVABLE CART. >> <<25.02>>04442000
            200,203, 1,48,2,2,12,  << 7900, FIXED PLATTER   >> <<25.02>>04444000
            200,203, 2,48,2,0,16,  << 7900, BOTH PLATTERS   >> <<25.02>>04446000
            400,406,20,23,1,0,32,  << ISS DISC              >> <<25.02>>04448000
            400,411, 2,48,1,0,20,  << 7905, REMOVABLE CART. >> <<25.02>>04450000
            400,411, 1,48,1,2,16,  << 7905, FIXED PLATTER   >> <<25.02>>04452000
            400,411, 3,48,1,0,24,  << 7905, BOTH PLATTERS   >> <<25.02>>04454000
            120,125, 3,48,1,0,16,  << 7905, FH DISC RPLCMNT >> <<25.02>>04456000
            815,823, 5,48,1,0,32,  << 7920                  >> <<25.02>>04458000
            815,823, 9,64,1,0,64,  <<7925                   >> <<01359>>04460000
      400,411,2,48,1,0,20,   <<STYPE 10, 7906, RMOVEABLE CART>><<00888>>04462000
      400,411,2,48,1,2,20,   <<STYPE 11, 7906, FIXED PLATTER>> <<00888>>04464000
      400,411,4,48,1,0,32,   <<STYPE 12, 7906, BOTH PLATTERS>> <<00904>>04466000
      735,748,2,32,1,0,20;   <<STYPE 13, 7910         >>       <<00904>>04468000
  INTEGER ARRAY FHINFO(0:2):=128,256,512;                               04470000
  INTEGER ARRAY FHVOLS(-1:MAXSUBTYPES-1):=MAXSUBTYPESP1(1);    <<03550>>04472000
  INTEGER ARRAY MHVOLS(-1:MAXSUBTYPES-1):=MAXSUBTYPESP1(1);    <<03550>>04474000
  INTEGER ARRAY CS80VOLS(-1:MAXSUBTYPES-1):=MAXSUBTYPESP1(1);  <<03550>>04476000
INTEGER ARRAY LINE(0:35) := 36("  ");                          <<00888>>04478000
BYTE ARRAY BLINE(*) = LINE;                                    <<00888>>04480000
   INTEGER ARRAY FLAB(0:127),   <<FILE LABEL>>                 <<00888>>04482000
                FCB(0:215),          <<FILE CONTROL BLOCK>>             04484000
                INFO(0:INFOSIZE-1),  <<DISC COLD LOAD INFO TABLE>>      04486000
                LBUF(0:1023),        <<LARGE BUFFER>>                   04488000
                BUF(0:511),          <<I/O BUFFER>>                     04490000
                DTT(*)=LBUF(128),    <<DEFECTIVE TRACKS TABLE>>         04492000
                DSCT(*)=LBUF(128),   <<DEFECTIVE SECTOR TABLE>><<03550>>04494000
                SLREC0(*)=LBUF,      <<SL FILE RECORD 0>>               04496000
                SLREC1(*)=LBUF(128), <<SL FILE RECORD 1>>               04498000
                REFTAB(0:127),       <<SL REFERENCE TABLE>>             04500000
                EXTLIST(*)=LBUF(256),<<EXTERNAL LIST>>                  04502000
                STT(*)=LBUF(512),    <<SEGMENT TRANSFER TABLE>>         04504000
                PREC0(*)=LBUF(896),  <<PROGRAM FILE RECORD 0>>          04506000
                EXTBUF(*)=BUF,       <<PROGRAM EXTERNAL BUFFER>>        04508000
                EXTSAT(*)=BUF(256),  <<SATISFIED EXTERNAL LIST>>        04510000
                REC0(*)=LBUF,        <<PROGRAM FILE RECORD 0>>          04512000
                DBINFO(*)=LBUF(128),  <<DRIVER DB AREA>>                04514000
                OBINFO(*)=LBUF(512),  <<DRIVER OUTER BLOCK>>            04516000
                DVREXT(*)=LBUF(768),  <<DRIVER EXTERNALS>>              04518000
                INBUF(0:35),         <<INPUT BUFFER>>                   04520000
                VNAMEI(0:3),         <<VOLUME NAME>>                    04526000
                SWAPD(0:(MAXSWAPSEG-1)*SWAPDSIZE),             <<01683>>04528000
                << SWAPPING DESCRIPTOR TABLE >>                <<01683>>04530000
                REFSEG(0:15);        <<REFERENCED SEGMENT BITMAP>>      04532000
  INTEGER ARRAY INTHS'UNITS(0:511):=512(0); <<# OF IH'S & U'S>><<03002>>04536000
                             <<AND # OF UNITS FOR CONTROLLER>> <<00888>>04538000
  LOGICAL ARRAY MHINFOL(*)=MHINFO;                                      04542000
   BYTE ARRAY BBUF(*)=BUF,                                     <<00888>>04544000
             BFLAB(*)=FLAB,                                             04546000
             BINBUF(*)=INBUF,                                           04548000
             BEXTLIST(*)=EXTLIST,                                       04550000
             VNAME(*)=VNAMEI,                                           04552000
          BTYP(*)=VNAME,                                                04554000
             BDNAME(*)=VNAME,                                           04556000
             BLBUF(*)=LBUF,                                             04558000
             DEVCLASS(0:8),          <<DEVICE CLASS NAME>>              04560000
             IOPROCNAME(0:15),       <<I/O PROCESS NAME>>               04562000
             BPREC0(*)=PREC0;                                           04564000
                                                               <<03557>>04566000
                                                               <<03549>>04568000
  EQUATE  MAX'REASS = 150;   << MAX. NO. OF DISC AREAS WHICH>> <<03549>>04570000
                             <<   LOST DATA DURING SPARING  >> <<03549>>04572000
  INTEGER ARRAY                     << SPARED AREAS OF DISC >> <<03549>>04574000
     REASSIGNED(0:(MAX'REASS+1)*5-1);  << WHICH LOST DATA   >> <<03714>>04576000
                                                               <<03549>>04578000
  DEFINE NREASS = REASSIGNED(0)#;   <<CURRENT NO. OF ENTRIES>> <<03714>>04580000
                                    <<  IN 'REASSIGNED'     >> <<03714>>04582000
  DOUBLE ARRAY FCBDBL(*)=FCB,        <<FILE CONTROL BLOCK>>             04584000
               EXTSIZES(0:31),       <<EXTENT SIZES>>                   04590000
               SEGDISCADR(0:20),     <<INITIAL'S SEGMENTS DISC ADDRS>>  04592000
               INFOD(*)=INFO,                                           04594000
               FLABDBL(*)=FLAB;      <<FILE LABEL>>                     04596000
  INTEGER ARRAY TCLASS(*)=LBUF;     <<TEMPORARY CLASS TABLE>>           04598000
  BYTE ARRAY TEMPCLASS(*)=TCLASS; <<TEMPORARY CLASS TABLE>>             04600000
  INTEGER ARRAY IAS0(*)=S-0;                                            04602000
  DOUBLE  STTADR,                    <<DISC ADDRESS OF STT>>            04604000
          SECTORS=STTADR,            <<# OF SECTORS IN FILE>>           04606000
          DTEMP,                     <<TEMPORARY>>                      04608000
          DIRDISCADR,                <<DIRECTORY DISC ADDRESS>>         04614000
          LOADMAPADR;                <<DISC ADDR. OF LOADMAP>> <<03557>>04618000
  INTEGER DIRDISCADDR1 = DIRDISCADR,  << HODA >>               <<01384>>04620000
          DIRDISCADDR2 = DIRDISCADR+1;  << LODA >>             <<01384>>04622000
   INTEGER COREX,              <<CORE SIZE INDEX>>             <<00888>>04624000
ADRBASE, <<BASE ADR OF CHAN SEEK COMMAND FOR BOOTSTRAP PROG>>  <<00888>>04628000
          CLRSW,                     << CL. VALUE OF SW. REG.>><<02510>>04634000
          OPT,                       <<OPTION>>                         04636000
          DVCLSIZE,                  <<SIZE OF DEVICE CLASS TABLE>>     04640000
          NSWAPSEG,                  <<NUMBER OF SWAPPING SEGMENTS>>    04648000
          SYSVOL,                    <<SYSTEM DISC VOLUME NUMBER>>      04654000
          COLDLOADID,                <<COLD LOAD ID>>                   04656000
          NVOL,                      <<VOLUME TABLE COUNTS>>   <<RH.PV>>04664000
          ALT,                       <<ALTERNATE TRACK>>                04670000
          SYSDISCTYPE,               <<TYPE OF SYSTEM DISC>>            04672000
          SYSDISCSUBTYPE,            <<SYSTEM DISC SUBTYPE>>            04674000
          NDISCDEV,                  <<# OF DEVICES IN CLASS DISC>>     04676000
          DISCLDEV:=0,               <<CURRENT DISC CLASS INDEX>>       04678000
          NNODISC,                   <<# OF FILES WITH NO DISC SPACE>>  04680000
          LEN,                       <<LENGTH OF MAG TAPE RECORD>>      04682000
          TAPERECSIZE,                                         <<03603>>04684000
          NBLKS,                     <<# OF BLOCKS READ>>               04686000
          BLOCKSWRITTEN,             <<# OF BLOCKS WRITTEN SO FAR>>     04688000
          DRTN,                      <<DRT #>>                          04694000
          HIDRT,                     <<HIGHEST ALLOCATED DRT>> <<02707>>04696000
          LDEV,                      <<LOGICAL DEVICE #>>               04698000
          HLDEV,                     <<HIGHEST LOGICAL DEVICE>>         04700000
          NUSERFILES,                <<# OF USER FILES IN DIRECTORY>>   04704000
          MEMLOC,                    <<CURRENT CORE POINTER>>           04706000
          MEMSEG,                    <<LENGTH OF SEGMENT>>              04710000
          LCMEMLOC,                  <<LOW CORE MEMORY POINTER>>        04712000
          FCBHD,                     <<HEAD OF FCB FREE LIST>>          04714000
          CTABFNUM,                  <<CONFIGURATION FILE NUMBER>>      04716000
          SLFNUM,                    <<SL FILE NUMBER>>                 04718000
          STTLDEV,                   <<LOG DEV # FOR CURRENT STT>>      04720000
          STTINDEX,                  <<POINTER TO PL>>                  04722000
          STTADR1=STTADR,            <<FIRST WORD OF STT DISC ADDRESS>> 04724000
          STTADR2=STTADR+1,          <<2ND WORD OF STT DISC ADDRESS>>   04726000
          NPROCQ=LEN,                <<# OF I/O PROCESS QUEUES>>        04728000
          NCNTRLQ=NBLKS,             <<# OF CONTROLLER QUEUES>>         04730000
          NIOPROC=BLOCKSWRITTEN,     <<# OF I/O PROCESSES>>             04732000
          NDLT,                      <<# OF DLT ENTRIES>>      <<03714>>04734000
          DVRFNUM,                   <<DRIVER FILE NUMBER>>    <<02510>>04738000
          INTRINDEX,                 <<INDEX INTO INTERRUPT TAB<<02510>>04752000
          DLTINDEX=NUSERFILES,       <<INDEX INTO DLT>>                 04754000
          DVRTYPE=NNODISC,           <<DRIVER TYPE>>                    04756000
          NRESQ=DISCLDEV,            <<#0OF RESOURCE QUEUES>>           04758000
          RELPRI=NDISCDEV,           <<RELATIVE PRIORITY>>              04760000
          ABSPRI=ALT,                <<ABSOLUTE PRIORITY>>              04762000
          NCHANQ=ALT,                <<# OF MULTI-CONTROLLER CHANNELS>> 04764000
          LPDTBASE,                  <<ADDR OF LPDT>>                   04766000
          MONBUFBASE,                <<ADDR OF MONITORING BUFFER>>      04768000
          SIRBASE,                   <<ADDR OF SIR TABLE>>              04770000
          SAGL,                      <<STARTING ADDRESS OF GARBAGE>>    04774000
          HCST,                      <<HIGHEST CST NUMBER>>             04776000
          DLTPTR',                   <<POINTER TO DLT>>                 04778000
          SEGTLEN,                   <<SEGMENT TABLE LENGTH>>           04780000
          RTNUM,                     <<# OF REFERENCE TABLE ENTRIES>>   04782000
          CSTN,                      <<CURRENT CST NUMBER>>             04784000
          CSTINDEX,                  <<CST NUMBER OF PROGRAM>>          04786000
          DSTINDEX,                  <<DST NUMBER OF STACK>>            04788000
          PROCSTART,                 <<ENTRY POINT FOR PROGRAM>>        04790000
          GLOB,                      <<SIZE OF DB AREA>>                04792000
          DBVALUE,                   <<LOCATION OF DB>>                 04794000
          DLVALUE,                   <<SIZE OF DL AREA>>                04796000
          SVALUE,                    <<RELATIVE LOCATION OF S>>         04798000
          ZVALUE,                    <<RELATIVE LOCATION OF Z>>         04800000
          QVALUE,                    <<RELATIVE VALUE OF Q>>            04802000
          MAXD,                      <<MAXDATA>>                        04804000
          BANK0,                     <<BANK0 DEP.MEM SIZE>>    <<01299>>04806000
          LOGONLOC := 0,     <<ACTIVE LOGON MESSAGE DST>>               04808000
          CSDVRAREASIZE,             <<SIZE OF DRIVER WORK AREA>>       04810000
          LDMAPFNUM,                 <<LOADMAP FILE #>>                 04812000
          INDEX;                     <<TABLE INDEX>>                    04814000
LOGICAL MAXSTACKSIZE;   <<STACK SIZE LIMIT>>                   <<04261>>04816000
  INTEGER POINTER SIOPNTR;                                     <<03557>>04818000
  DEFINE NREADYF = (14:1)#;  <<VOLUME ON-LINE/OFF-LINE>>       <<RH.PV>>04820000
                                                               <<RH.PV>>04822000
  DEFINE                                                       <<RH.PV>>04824000
          MVOL = NVOL.(0:8)#,        <<MAX VOLS IN VTAB>>      <<RH.PV>>04826000
          HVOL = NVOL.(8:8)#;        <<SYS VOLS IN VTAB>>      <<RH.PV>>04828000
                                                               <<RH.PV>>04830000
                                                               <<RH.PV>>04834000
  INTEGER I,J,K,L,M,N,TEMP;        <<TEMPORARIES>>             <<02510>>04836000
   INTEGER POINTER RESTOREBUF:=0;<<RESTORE FILE BUFFER>>       <<KS.88>>04838000
   BYTE POINTER BRESTOREBUF;                                   <<KS.88>>04840000
INTEGER LASTLOADMODE=TEMP;                                     <<00888>>04844000
                                                               <<RH.PV>>04846000
  INTEGER DTEMP2=DTEMP+1;                                      <<MPEIV>>04848000
                                                               <<RH.PV>>04850000
INTEGER DISPQHEAD=DB+DISPQHEADIX,                              <<MPEIV>>04856000
        DISPQTAIL=DB+DISPQTAILIX,                              <<MPEIV>>04858000
        MAXAVAILREG=DB+MAXAVAILREGIX,                          <<MPEIV>>04860000
        SYSBANKCOUNT=DB+NBANKSIX;                              <<MPEIV>>04862000
   LOGICAL MORE,               <<MORE DEVICE CLASS ENTRIES>>   <<00888>>04864000
          LINKED,                    <<SEGMENT IN LINKED MEMORY>>       04866000
          LOGGING,                   <<LOGGING ENABLED>>                04868000
          RECOVERY,                  <<RECOVERING DISC SPACE>>          04870000
          VALID=MORE,                <<LABEL IS A VALID ONE>>           04872000
          FLAGGED=LINKED,            <<TRACK IS FLAGGED DEFECTIVE>>     04874000
          ACCTSONLY,                 <<RELOAD ACCOUNTS ONLY>>           04876000
          RELOAD,                    <<RELOAD OPTION>>                  04878000
          DATAFLAG,                  <<DATA IN TAPE BUFFER>>            04880000
          LOADMAP,                   <<TRUE IF LOADMAP DESIRED>>        04882000
          CHANGES,                   <<TRUE IF CONFIGURATION CHANGES>>  04884000
          SECONDPASS,                <<SECOND PASS THRU CONFIGURATION>> 04886000
          CNT,                       <<SECTOR COUNT>>                   04888000
          NN=SECONDPASS,                                                04890000
          MM,                                                           04892000
          SECTORSLEFT=MORE,          <<# OF SECTORS LEFT IN EXTENT>>    04894000
          FIRST=MORE,                <<FIRST DIT>>                      04896000
          NEWDLT=SECONDPASS,         <<NEW ENTRY ADDED TO DLT>>         04898000
          RESIDENT=CNT,              <<DRIVER IS CORE RESIDENT>>        04900000
          INITLOGONDST := FALSE,<<INITIALIZE LOGON MESSAGE>>            04904000
          HEADING'PRINTED,  << USED IN PROCEDURE PRINTFNR >>   <<01442>>04906000
          HCLIMIT,                   <<LAST AVAIL. WORD BANK 0><<03603>>04908000
          LOADFROMTAPE:=TRUE;        <<COLD LOAD IS FROM TAPE>>         04912000
           INTEGER CSDUMMYINDEX;                                        04914000
  INTEGER X=X;                       <<X REGISTER>>                     04916000
  INTEGER S0=S-0,S1=S-1,S2=S-2,S3=S-3,S4=S-4,S5=S-5,S6=S-6,S7=S-7;      04918000
  DOUBLE DS0=S-1,DS1=S-1,DS3=S-3,DS5=S-5,DS6=S-6;              <<MPEIV>>04920000
  INTEGER POINTER PS0=S-0,PS1=S-1;  <<<TOP OF STACK POINTERS>>          04922000
  BYTE POINTER BPS0=S-0,BPS1=S-1;    <<TOP OF STACK BYTE POINTERS>>     04924000
  BYTE BS0 = S-0, BS1 = S-1;                                   <<03603>>04926000
DEFINE ABS = ABSOLUTE#;                                        <<03603>>04928000
  LOGICAL STAT=Q-1;                  <<STATUS WORD IN MARKER>>          04930000
  LOGICAL STATUS = Q-1;                                        <<MPEIV>>04932000
  LOGICAL RETURNP=Q-2;               <<RETURN ADDRESS IN MARKER>>       04934000
LOGICAL CONVERTOLOG;                                                    04936000
EQUATE LDMAP'SIZE = 3200;                                      <<03668>>04938000
                                                               <<03668>>04940000
<< LDMAPBUF IS USED TO HOLD, IN ORDER OF THEIR OCCURRENCE: >>  <<03744>>04942000
<< (1) THE LIST OF FILES WHICH LOST DATA DURING SPARING    >>  <<03744>>04944000
<< THAT THE USER WILL BE GIVEN THE OPPORTUNITY TO SAVE     >>  <<03744>>04946000
<< AFTER RECOVER LOST DISC SPACE, (2) THE DRT TABLE WHEN   >>  <<03744>>04948000
<< IT MUST BE MOVED, (3) THE LOADMAP, WHICH IS EVENTUALLY  >>  <<03744>>04950000
<< COPIED TO THE FILE LOADMAP.PUB.SYS                      >>  <<03744>>04952000
                                                               <<03744>>04954000
ARRAY LDMAPBUF(0:LDMAP'SIZE-1);                                <<03668>>04956000
EQUATE MAXBANKS          = 64,                                 <<01756>>04958000
       BANKSIZE          = 64, << K WORDS OF MEMORY >>         <<01384>>04960000
       CORERES'          = 0,                                  <<01384>>04962000
       ABSENT'           = 2;                                  <<03635>>04964000
                                                               <<01384>>04970000
DEFINE  MEMORYSIZE       = LOGICAL(CTAB0(CORESIZE))#,          <<01384>>04972000
        NUM'BANKS        = LOGICAL(CTAB0(CORESIZE)+63)&LSR(6)#;<<01384>>04980000
ARRAY   ADDRESS(0:MAXBANKS-1) := MAXBANKS(HEADERLENGTH);       <<MPEIV>>04982000
        << PTRS TO AVAILABLE SPACE, SAVE ROOM FOR HEADERS>>    <<MPEIV>>04984000
                                                               <<SY>>   04986000
                                                               <<SY>>   04988000
<< ******************************************************** >> <<SY>>   04990000
<<      G L O B A L    V A R I A B L E    D E C L .         >> <<SY>>   04992000
<< ******************************************************** >> <<SY>>   04994000
   EXT'DCL INTEGER POINTER                                     <<SY>>   04996000
                   BUF'     =  BUF,  << I/O BUFFER    >>       <<SY>>   04998000
                   LBUF'    =  LBUF, << LARGE BUFFER  >>       <<SY>>   05000000
                   FLAB'    =  FLAB, << FILE LABEL    >>       <<SY>>   05002000
                   MHINFO'  =  MHINFO,                         <<SY>>   05004000
                   REASSIGNED' = REASSIGNED;                   <<SY>>   05006000
                                                               <<SY>>   05008000
   EXT'DCL LOGICAL LISTPURGE;                                  <<SY>>   05010000
<< MISCELLANEOUS DECLARATIONS >>                                        05014000
   DEFINE  ASMB      = ASSEMBLE#,                              <<MPEIV>>05016000
           PDISABLE  = ASSEMBLE(NOP,NOP)#,                     <<MPEIV>>05018000
           PENABLE   = ASSEMBLE(NOP,NOP)#;                     <<MPEIV>>05020000
   INTEGER                                                              05022000
      XREG = X;                                                         05024000
INTEGER DELTAQ = Q-0;                                                   05026000
   LOGICAL                                                              05028000
      LS0 = S-0,                                                        05030000
      LS1 = S-1;                                               <<03552>>05032000
   INTEGER POINTER                                                      05040000
      PS4 = S-4;                                                        05042000
   DEFINE                                                               05044000
      CARRYX = STAT.(5:1) #,                                            05046000
      CCFLD = (6:2) #,                                         <<MPEIV>>05048000
      CC = STAT.(6:2) #;                                                05050000
   POINTER S0PNTR = S-0;                                                05052000
   DOUBLE POINTER                                                       05054000
      DPS0 = S-0,                                                       05056000
      DPS2 = S-2;                                                       05058000
   INTEGER POINTER S0IPNTR = S-0;                                       05060000
   INTEGER S0I     = S-0;                                               05062000
   INTEGER REEL;<<RELOAD TAPE REEL COUNTER TO BE USED>>        <<00.06>>05064000
                <<IN CASE OF PARITY ERROR WHILE READING>>      <<00.06>>05066000
                <<TAPE TRAILER LABEL>>                         <<00.06>>05068000
   LOGICAL HEDLABP;<<FLAG TO DENOTE THAT REEL NUMBER AND>>     <<00.06>>05070000
                   <<CREATION DATE ARE AVAILABLE FROM>>        <<00.06>>05072000
                   <<HEADER LABEL--ONLY USED WHEN NOT>>        <<00.06>>05074000
                   <<AVAILABLE FROM TRAILER LABEL>>            <<00.06>>05076000
   INTEGER ARRAY ITMP(0:2);<<THREE WORD ARRAY TO HOLD>>        <<00.06>>05078000
           <<CREATION DATE FROM HEADER LABEL OF RESTORE>>      <<00.06>>05080000
           <<TAPE>>                                            <<00.06>>05082000
                                                               <<03000>>05084000
  <<---------------------------->>                             <<03000>>05086000
  <<      WCS PARAMETERS        >>                             <<03000>>05088000
  <<---------------------------->>                             <<03000>>05090000
                                                               <<03000>>05092000
  DOUBLE ARRAY DISCWCSTAB(*) = LBUF(%25);                      <<03000>>05094000
  EQUATE NR'WCS'FILES = 1;                                     <<03000>>05096000
  ARRAY WCSNAMES(0:NR'WCS'FILES*6-1) :=                        <<03000>>05098000
     <<  NAME  >> << PROTECT MAP >> << WCS TABLE INDEX >>      <<03000>>05100000
     "SYSWCS64",           %40,               0;               <<03062>>05102000
                                                               <<03598>>05106000
        <<*********************>>                              <<03598>>05108000
        <<SERIAL DISC INTERFACE>>                              <<03598>>05110000
        <<*********************>>                              <<03598>>05112000
                                                               <<03598>>05114000
             <<ERRORCODES>>                                    <<03598>>05116000
                                                               <<03598>>05118000
EQUATE  SDERR17 = 17, <<OUT OF SYNC WITH GAPTABLE ON READ>>    <<03598>>05120000
        SDERR23 = 23, <<CURRENTBUFFINDEX OUTSIDE OF RECBUFF>>  <<03598>>05122000
        SDERR24 = 24, <<ATTEMPTED TO BSF BEYOND BOT>>          <<03598>>05124000
        SDERR28 = 28, <<NOT A COLDLOADABLE SDISC TYPE>>        <<03598>>05126000
        SDERR30 = 30, <<LEADING AND TRAILING RECLENS DIFFER>>  <<03598>>05128000
        SDERR31 = 31; <<FINDGAP FAIL-TRIED TO OVERFILL RECBUF>><<03598>>05130000
                                                               <<03598>>05132000
INTEGER ARRAY DBINT(0:28):=29(0);                              <<03598>>05134000
LOGICAL ARRAY DBLOG(*)=DBINT;                                  <<03598>>05136000
                                                               <<03598>>05138000
DEFINE  SYSTAPELDEV    = DBINT( 0)#,     <<LDEV# OF THE SDISC>><<03598>>05140000
        SYSTAPEDRTUNIT = DBINT( 1)#,        <<DRT# & UNIT#>>   <<03598>>05142000
        SYSTAPEDRT     = DBINT( 1).DRTFIELD#,   <<DRT>>        <<03598>>05144000
        SYSTAPEUNIT    = DBINT( 1).UNITFIELD#,  <<UNIT>>       <<03598>>05146000
        SYSTAPETYPE    = DBINT( 2)#,           << TYPE >>      <<03598>>05148000
        SYSTAPESTYPE   = DBINT( 3)#,           <<SUBTYPE>>     <<03598>>05150000
        SDISCREEL      = DBINT( 4)#,                           <<03598>>05152000
        SDISCDATE      = DBINT( 5)#,                           <<03598>>05154000
        SDISCTIME1     = DBINT( 6)#,                           <<03598>>05156000
        SDISCTIME2     = DBINT( 7)#,                           <<03598>>05158000
        SDISCSECTLEN   = DBINT( 8)#,                           <<03598>>05160000
        SDISCBOT       = DBINT( 9)#,                           <<03598>>05162000
        RECBUFINDEX    = DBINT(10)#,                           <<03598>>05164000
        WORDSINRECBUF  = DBINT(11)#,                           <<03598>>05166000
        TZTBUFINDEX    = DBINT(12)#,                           <<03598>>05168000
        TZTSECTOR      = DBINT(13)#,                           <<03598>>05170000
        SD'FLAGS       = DBLOG(14)#,                           <<03598>>05172000
        SD'ONLINE      = SD'FLAGS.(0:1)#,                      <<03598>>05174000
        END'OF'TAPE    = SD'FLAGS.(1:1)#,                      <<03598>>05176000
        END'OF'FIL     = SD'FLAGS.(2:1)#,                      <<03598>>05178000
        FUTURE'DATE    = SD'FLAGS.(3:1)#,                      <<03598>>05180000
        SERIALDISCLOAD = SD'FLAGS.(4:1)#,                      <<03598>>05182000
        NEXTRECINBUF   = SD'FLAGS.(5:1)#,                      <<03598>>05184000
        TZT'TYPE       = DBINT(14).(13:3)#,                    <<03598>>05186000
        SYSD'NSECTS    = DBINT(15)#;                           <<03598>>05188000
                                                               <<03598>>05190000
                                                               <<03598>>05192000
                                                               <<03551>>05194000
DEFINE                                                         <<03551>>05196000
            NUTCST = DBINT(16)#,     <<# OF USED TEMP CSTS >>  <<03551>>05198000
            TCST1 = DBINT(17)#,      << FIRST TEMP CST >>      <<03551>>05200000
            RECSIZE = DBINT(18)#,    << SIZE OF RESTORE BLOCKS <<03551>>05202000
            DLSAVE = DBINT(19)#,       << OLD DL VALUE >>      <<03551>>05204000
            CONSOLELDEV = DBINT(20)#,  << LDEV # OF SYS CONSOLE<<03551>>05206000
            LLSWAP = DBINT(21)#,       << LEAST LIKELY SEG TO  <<03551>>05208000
            MLSWAP = DBINT(22)#,       << MOST LIKELY SEG TO   <<03551>>05210000
            SYSDISCDRT = DBINT(23)#;   << DRT FOR SYS DISC >>  <<03551>>05212000
                                                               <<SD.00>>05214000
                                                               <<SD.00>>05216000
                                                               <<SD.00>>05218000
                                                               <<SD.00>>05220000
                                                               <<SD.00>>05222000
                                                               <<SD.00>>05226000
                                                               <<SD.00>>05228000
                                                               <<SD.00>>05230000
                                                               <<SD.00>>05232000
                                                               <<03598>>05236000
DOUBLE  ARRAY DBDOUB(0:10):=11(0D);                            <<03598>>05238000
                                                               <<03598>>05240000
DEFINE  EOTSECTR       = DBDOUB( 0)#, << LBL 17&18    EOT >>   <<03598>>05242000
        EODSECTR       = DBDOUB( 1)#, << LBL 19&20    EOD >>   <<03598>>05244000
        SYSD'TZTBASE   = DBDOUB( 2)#, <<ADDRS OF TZT ON DISC>> <<03598>>05246000
        SD'SECTR       = DBDOUB( 3)#, <<SECT# OF NEXT BLOCK>>  <<03598>>05248000
                                      <<CURENTLY IN RECBUFF>>  <<03598>>05250000
        DISCINRECBUF   = DBDOUB( 9)#, <<SECT OF STRT OF BLK>>  <<03598>>05252000
        TZT'ADDR       = DBDOUB(10)#; <<Addrs of Next Entry>>  <<03598>>05254000
                                                               <<03598>>05256000
                                                               <<03598>>05258000
                                                               <<03551>>05260000
   << ===========================================>>            <<03551>>05262000
                                                               <<03551>>05264000
   << Definitions for disc free space management >>            <<03551>>05266000
                                                               <<03551>>05268000
   <<============================================>>            <<03551>>05270000
                                                               <<03551>>05272000
   << The following are constants declared on INCLDFS2, >>     <<03551>>05274000
   << but the include file can't be used because it     >>     <<03551>>05276000
   << would overflow the symbol table.                  >>     <<03551>>05278000
                                                               <<03551>>05280000
   EQUATE                                                      <<03551>>05282000
      sector'size = 128,   << Size of disc sector in words >>  <<03551>>05284000
      page'size = 1,       << Bit map page size in sectors >>  <<03551>>05286000
                                                               <<03551>>05288000
      << Words of data per bit map page (less checksum) >>     <<03551>>05290000
                                                               <<03551>>05292000
      words'per'page = (page'size * sector'size) - 1,          <<03551>>05294000
                                                               <<03551>>05296000
      << Words per bit map page, including checksum word >>    <<03551>>05298000
                                                               <<03551>>05300000
      actual'words'per'page = page'size * sector'size,         <<03551>>05302000
                                                               <<03551>>05304000
      bits'per'word = 16,   << HP/3000 word size >>            <<03551>>05306000
                                                               <<03551>>05308000
      << Number of bits of data per page >>                    <<03551>>05310000
                                                               <<03551>>05312000
      bits'per'page = bits'per'word * words'per'page,          <<03551>>05314000
                                                               <<03551>>05316000
      << Index of the checksum word in a page (last word) >>   <<03551>>05318000
                                                               <<03551>>05320000
      check'sum'word = words'per'page,                         <<03551>>05322000
                                                               <<03551>>05324000
      dt'entry'size = 3,  << Size of descriptor table entry >> <<03551>>05326000
                                                               <<03551>>05328000
      << Value placed in descriptor table entry to indicate >> <<03551>>05330000
      << that the page has been flaged as bad.              >> <<03551>>05332000
                                                               <<03551>>05334000
      bad'page = -1;                                           <<03551>>05336000
                                                               <<03551>>05338000
      DEFINE DBL = DOUBLE#;                                    <<03551>>05340000
                                                               <<03551>>05342000
   << The following equate should be set to the maximum >>     <<03551>>05344000
   << number of disc drives that can be configured on   >>     <<03551>>05346000
   << any system.                                       >>     <<03551>>05348000
                                                               <<03551>>05350000
   EQUATE max'disc'drives = 32;                                <<03551>>05352000
                                                               <<03551>>05354000
   << This array has ldevs of disc drives whose free    >>     <<03551>>05356000
   << space map has been accessed. Empty entries are    >>     <<03551>>05358000
   << marked with a -1.  The index that get you to the  >>     <<03551>>05360000
   << ldev will get you to info about that ldev in all  >>     <<03551>>05362000
   << the following arrays. This is the ldev-index.     >>     <<03551>>05364000
                                                               <<03551>>05366000
   INTEGER ARRAY ldev'index'to'ldev (0:max'disc'drives-1);     <<03551>>05368000
                                                               <<03551>>05370000
   << This array has the disc address of the bit map    >>     <<03551>>05372000
   << for each accessed disc.                           >>     <<03551>>05374000
                                                               <<03551>>05376000
   DOUBLE ARRAY bit'map'disc'address (0:max'disc'drives-1);    <<03551>>05378000
                                                               <<03551>>05380000
   << This array has the disc address of the descriptor >>     <<03551>>05382000
   << table for each accessed disc.                     >>     <<03551>>05384000
                                                               <<03551>>05386000
   DOUBLE ARRAY dt'disc'address (0:max'disc'drives-1);         <<03551>>05388000
                                                               <<03551>>05390000
   << This array has the size of the last block         >>     <<03551>>05392000
   << allocated for each accessed disc, or if not known >>     <<03551>>05394000
   << then it is set to the size of the disc.           >>     <<03551>>05396000
                                                               <<03551>>05398000
   DOUBLE ARRAY size'of'last'allocation (0:max'disc'drives-1); <<03551>>05400000
                                                               <<03551>>05402000
   << This array has the page num corresponding to the  >>     <<03551>>05404000
   << above allocated blocks.                           >>     <<03551>>05406000
                                                               <<03551>>05408000
   INTEGER ARRAY last'page'allocated'from(0:max'disc'drives-1);<<03551>>05410000
                                                               <<03551>>05412000
   << This array has the page num of the first page     >>     <<03551>>05414000
   << space, or a -1. if the page is not known. It is   >>     <<03551>>05416000
   << only used for reloads.                            >>     <<03551>>05418000
                                                               <<03551>>05420000
   INTEGER ARRAY first'page'with'space (0:max'disc'drives-1);  <<03551>>05422000
                                                               <<03551>>05424000
   << This array contains the page number of the last   >>     <<03551>>05426000
   << page of the map for each accessed disc ldev.      >>     <<03551>>05428000
                                                               <<03551>>05430000
   INTEGER ARRAY last'page'of'map (0:max'disc'drives-1);       <<03551>>05432000
                                                               <<03551>>05434000
   << This array contains the size of the disc in       >>     <<03551>>05436000
   << sectors for each accessed disc drive.             >>     <<03551>>05438000
                                                               <<03551>>05440000
   DOUBLE ARRAY disc'size (0:max'disc'drives-1);               <<03551>>05442000
                                                               <<03551>>05444000
   << This array indicates certain problem conditions   >>     <<03551>>05446000
   << involving the free space map. If the entry is in  >>     <<03551>>05448000
   << use it can have the following values: zero - all  >>     <<03551>>05450000
   << is normal, 1 - there are some bad pages in the    >>     <<03551>>05452000
   << map and the descriptor table will have to be      >>     <<03551>>05454000
   << checked each time a page is read. -1 - the map    >>     <<03551>>05456000
   << has been flaged as bad in the disc label and no   >>     <<03551>>05458000
   << space may be allocated on this disc.              >>     <<03551>>05460000
                                                               <<03551>>05462000
   INTEGER ARRAY dfs'map'problems (0:max'disc'drives-1);       <<03551>>05464000
                                                               <<03551>>05466000
                                                               <<03551>>05468000
   << This is the buffer for the descriptor table.  The >>     <<03551>>05470000
   << table is looked at in sector pages since INITIAL  >>     <<03551>>05472000
   << does a shitty job of handling memory.             >>     <<03551>>05474000
                                                               <<03551>>05476000
   INTEGER ARRAY dt'buffer (0:sector'size-1);                  <<03551>>05478000
                                                               <<03551>>05480000
   << This contains the ldev of the disc whose          >>     <<03551>>05482000
   << descriptor table page is in the above buffer, or  >>     <<03551>>05484000
   << a -1 if the buffer is empty.                             <<03551>>05486000
                                                               <<03551>>05488000
   INTEGER ldev'of'dt'page'in'buffer;                          <<03551>>05490000
                                                               <<03551>>05492000
   << This contains the disc address of the page of the >>     <<03551>>05494000
   << descriptor table in the above buffer.             >>     <<03551>>05496000
                                                               <<03551>>05498000
   DEFINE add'of'dt'page'in'buffer = DBDOUB (4)#;              <<03551>>05500000
                                                               <<03551>>05502000
                                                               <<03551>>05504000
   << This buffer is used to hold a page of a bit map.  >>     <<03551>>05506000
   << The symbol "ds'page'ptr" is defined for the use   >>     <<03551>>05508000
   << routines that are common with INITIAL and the     >>     <<03551>>05510000
   << system.                                           >>     <<03551>>05512000
                                                               <<03551>>05514000
   ARRAY bit'map'buffer (0:actual'words'per'page-1);           <<03551>>05516000
   ARRAY ds'page'ptr (*) = bit'map'buffer;                     <<03551>>05518000
                                                               <<03551>>05520000
   << This contains the ldev of the map page that is    >>     <<03551>>05522000
   << currently in the buffer, on -1 if empty.          >>     <<03551>>05524000
                                                               <<03551>>05526000
   INTEGER ldev'of'map'in'buffer;                              <<03551>>05528000
                                                               <<03551>>05530000
   << This contains the page number of the page that    >>     <<03551>>05532000
   << is currently in the buffer.                       >>     <<03551>>05534000
                                                               <<03551>>05536000
   DEFINE page'of'map'in'buffer = DBINT(24)#;                  <<03551>>05538000
                                                               <<03551>>05540000
   << This contains the disc address of the page of the >>     <<03551>>05542000
   << bit map that is currently in the buffer.          >>     <<03551>>05544000
                                                               <<03551>>05546000
   DEFINE add'of'map'page'in'buffer = DBDOUB (5)#;             <<03551>>05548000
                                                               <<03551>>05550000
   << The following are scratch variables used by the   >>     <<03551>>05552000
   << various disc space management routines.           >>     <<03551>>05554000
                                                               <<03551>>05556000
   DEFINE ds'disc'address = DBDOUB(6)#;                        <<03551>>05558000
   DEFINE ds'page'number = DBINT(25)#;                         <<03551>>05560000
   DEFINE ds'word'number = DBINT(26)#;                         <<03551>>05562000
   INTEGER ds'bit'number;                                      <<03551>>05564000
   INTEGER ds'bit'count;                                       <<03551>>05566000
   DEFINE ds'starting'word'number = DBINT(27)#;                <<03551>>05568000
   DEFINE ds'starting'bit'number = DBINT(28)#;                 <<03551>>05570000
                                                               <<03551>>05572000
   << This equate defines the amount of space, in       >>     <<03551>>05574000
   << sectors, that is reserved at the beginning of     >>     <<03551>>05576000
   << each system disc.                                 >>     <<03551>>05578000
                                                               <<03551>>05580000
   EQUATE ldev'1'reserved'area'size = 400;                     <<03551>>05582000
   EQUATE other'disc'reserved'area'size = 10;                  <<03551>>05584000
                                                               <<03551>>05586000
   << = = = = End of disc free space definitions = = = = >>    <<03551>>05588000
                                                               <<03551>>05590000
                                                               <<03549>>05592000
  << BOOTSPACEMAP IS A BIT MAP DEFINING FREE SPACE IN THE >>   <<03549>>05594000
  <<    RESERVED AREA                                     >>   <<03549>>05596000
                                                               <<03549>>05598000
  EQUATE BOOTSPACE'SECTOR = 4;  <<DISC ADDR. OF BOOTSPACEMAP>> <<03714>>05600000
                                                               <<03714>>05602000
  INTEGER ARRAY BOOTSPACEMAP(0:(LDEV'1'RESERVED'AREA'SIZE      <<03549>>05604000
                                              +15)/16 - 1);    <<03549>>05606000
                                                               <<03598>>05610000
<<Note>><<- Do Not re-locate these two array declarations ->>  <<03598>>05612000
        <<- They should be the last DB stuff allocated to ->>  <<03598>>05614000
        <<- Make it simpler when INITIAL eliminates them. ->>  <<03598>>05616000
                                                               <<03598>>05618000
EQUATE  RECBUFLEN     = 4095,                                  <<03598>>05620000
        TZTBUFLEN     = 255;                                   <<03598>>05622000
                                                               <<03598>>05624000
ARRAY   RECBUF(0:RECBUFLEN),                                   <<03598>>05626000
        TZTBUF(0:TZTBUFLEN);                                   <<03598>>05628000
                                                               <<03598>>05630000
ENTRY   TAPELOAD,          <<Entry Point for Load From Tape>>  <<03598>>05632000
        DISCBOOT;          <<Entry Point for Load From Tape>>  <<03598>>05634000
                                                               <<03598>>05636000
        <<*********************>>                              <<03598>>05638000
        <<FORWARD  DECLARATIONS>>                              <<03598>>05640000
        <<*********************>>                              <<03598>>05642000
                                                               <<03598>>05644000
LOGICAL PROCEDURE GET'RESERVED( DADDR , SIZE );                <<03598>>05646000
   VALUE SIZE;                                                 <<03598>>05648000
   DOUBLE DADDR;                                               <<03598>>05650000
   INTEGER SIZE;                                               <<03598>>05652000
   OPTION FORWARD;                                             <<03598>>05654000
                                                               <<03598>>05656000
PROCEDURE RELEASE'RESERVED( DADDR , SIZE );                    <<03598>>05658000
   VALUE DADDR,SIZE;                                           <<03598>>05660000
   DOUBLE DADDR;                                               <<03598>>05662000
   INTEGER SIZE;                                               <<03598>>05664000
   OPTION FORWARD;                                             <<03598>>05666000
                                                               <<03598>>05668000
                                                               <<03598>>05670000
PROCEDURE BOOTSTRAP;                                           <<03603>>05672000
   OPTION FORWARD;                                             <<03603>>05674000
PROCEDURE MAKEPRESENT;                                         <<03603>>05676000
   OPTION FORWARD;                                             <<03603>>05678000
LOGICAL PROCEDURE ON'ICS;                                      <<03603>>05680000
   OPTION FORWARD;                                             <<03603>>05682000
PROCEDURE CHECKMEM;                                            <<01384>>05684000
  OPTION FORWARD;                                              <<01384>>05686000
INTEGER PROCEDURE THISCPU;                                     <<03603>>05688000
   OPTION FORWARD;                                             <<03603>>05690000
                                                               <<01384>>05692000
  PROCEDURE FREAD(FILENUM,RECORD,BUF,WORDS);                            05694000
    VALUE FILENUM,RECORD,WORDS;                                         05696000
    INTEGER FILENUM,WORDS;                                              05698000
    DOUBLE RECORD;                                                      05700000
    ARRAY BUF;                                                          05702000
    OPTION FORWARD;                                                     05704000
  PROCEDURE FREAD'(FILENUM,RECORD,COREADR,WORDS);                       05706000
    VALUE FILENUM,RECORD,COREADR,WORDS;                                 05708000
    INTEGER FILENUM,WORDS;                                              05710000
    DOUBLE RECORD,COREADR;                                              05712000
    OPTION FORWARD;                                                     05714000
                                                               <<03715>>05716000
DOUBLE PROCEDURE GETDISCSPACE(LDEV,NSECT);                     <<03715>>05718000
VALUE LDEV,NSECT;                                              <<03715>>05720000
INTEGER LDEV;                                                  <<03715>>05722000
DOUBLE NSECT;                                                  <<03715>>05724000
OPTION FORWARD;                                                <<03715>>05726000
                                                               <<03715>>05728000
PROCEDURE RETDISCSPACE(LDEV,NSECT,DADDR);                      <<03715>>05730000
VALUE LDEV,NSECT,DADDR;                                        <<03715>>05732000
INTEGER LDEV;                                                  <<03715>>05734000
DOUBLE NSECT,DADDR;                                            <<03715>>05736000
OPTION FORWARD;                                                <<03715>>05738000
                                                               <<03715>>05740000
  LOGICAL PROCEDURE GETEXTLEN(I);                                       05742000
    VALUE I;                                                            05744000
    INTEGER I;                                                          05746000
    OPTION FORWARD;                                                     05748000
INTEGER PROCEDURE COLD'LOAD'MEDIA(FUNC,BUF,WORDC,RTN);         <<00678>>05750000
VALUE FUNC,WORDC,RTN;                                          <<00678>>05752000
INTEGER FUNC,WORDC;                                            <<00678>>05754000
LOGICAL RTN;                                                   <<00678>>05756000
ARRAY BUF;                                                     <<00678>>05758000
OPTION VARIABLE,FORWARD;                                       <<00678>>05760000
                                                               <<SD.00>>05762000
PROCEDURE SDISCCTRL(FUNC);                                     <<SD.00>>05764000
VALUE FUNC;                                                    <<SD.00>>05766000
INTEGER FUNC;                                                  <<SD.00>>05768000
OPTION FORWARD;                                                <<SD.00>>05770000
                                                               <<SD.00>>05772000
  PROCEDURE EXCHANGEDB(DSTN);                                           05774000
    VALUE DSTN;                                                         05776000
    INTEGER DSTN;                                                       05778000
    OPTION FORWARD;                                                     05780000
                                                                        05782000
  PROCEDURE HELP;                                                       05784000
    OPTION FORWARD;                                                     05786000
                                                                        05788000
PROCEDURE MESSAGE(MSGNR,NUM1,NUM2,NUM3,NUM4,STRING1,STRING2);  <<01103>>05790000
   VALUE MSGNR, NUM1, NUM2, NUM3, NUM4;                        <<01103>>05792000
   INTEGER MSGNR;                                              <<01103>>05794000
   LOGICAL NUM1, NUM2, NUM3, NUM4;                             <<01103>>05796000
   BYTE ARRAY STRING1, STRING2;                                <<01103>>05798000
   OPTION VARIABLE, FORWARD;                                   <<01103>>05800000
                                                               <<01103>>05802000
PROCEDURE ERRMESSAGE(MSGNR,NUM1,NUM2,NUM3,NUM4,STRING1,        <<01103>>05804000
   STRING2);                                                   <<01103>>05806000
   VALUE MSGNR, NUM1, NUM2, NUM3, NUM4;                        <<01103>>05808000
   INTEGER MSGNR;                                              <<01103>>05810000
   LOGICAL NUM1, NUM2, NUM3, NUM4;                             <<01103>>05812000
   BYTE ARRAY STRING1, STRING2;                                <<01103>>05814000
   OPTION VARIABLE, FORWARD;                                   <<01103>>05816000
                                                                        05818000
  PROCEDURE MOVEDLTABLES;                                               05820000
    OPTION FORWARD;                                                     05822000
LOGICAL PROCEDURE WRITECHAR(CHAR);                             <<03003>>05824000
    VALUE CHAR;                                                <<01101>>05826000
    INTEGER CHAR;                                              <<01101>>05828000
    OPTION FORWARD;                                            <<01101>>05830000
  INTEGER PROCEDURE ALTTRACK(LDEV,TRACK);                               05832000
    VALUE LDEV,TRACK;                                                   05834000
    INTEGER LDEV,TRACK;                                                 05836000
    OPTION FORWARD;                                                     05838000
INTEGER PROCEDURE READCHAR( WAITMS);                           <<03003>>05840000
  VALUE WAITMS;                                                <<03003>>05842000
  LOGICAL WAITMS;                                              <<03003>>05844000
  OPTION FORWARD, VARIABLE;                                    <<03003>>05846000
PROCEDURE PRINT( BUF, LENGTH, CONTROL);                        <<00888>>05848000
   VALUE LENGTH, CONTROL;                                      <<00888>>05850000
   ARRAY BUF;                                                  <<00888>>05852000
   INTEGER LENGTH, CONTROL;                                    <<00888>>05854000
   OPTION FORWARD;                                             <<00888>>05856000
PROCEDURE READINPUT( BUFFER);                                  <<00888>>05858000
   INTEGER ARRAY BUFFER;                                       <<00888>>05860000
   OPTION FORWARD, VARIABLE;                                   <<00888>>05862000
                                                               <<MPEIV>>05864000
  LOGICAL PROCEDURE GOOD'DSCT(DSCT);                           <<03668>>05866000
  INTEGER ARRAY DSCT;                                          <<03668>>05868000
  OPTION FORWARD;                                              <<03668>>05870000
                                                               <<03668>>05872000
  LOGICAL PROCEDURE ADD'BADFILE(FNAME);                        <<03668>>05874000
  ARRAY FNAME;                                                 <<03668>>05876000
  OPTION FORWARD;                                              <<03668>>05878000
                                                               <<03668>>05880000
  PROCEDURE REMOVE'BADFILE(FNAME);                             <<03668>>05882000
  ARRAY FNAME;                                                 <<03668>>05884000
  OPTION FORWARD;                                              <<03668>>05886000
                                                               <<03668>>05888000
  PROCEDURE RETURNDELETES( LDEV);                              <<03549>>05892000
  VALUE LDEV;                                                  <<03549>>05894000
  LOGICAL LDEV;                                                <<03549>>05896000
  OPTION FORWARD;                                              <<03549>>05898000
                                                               <<MPEIV>>05900000
  PROCEDURE REM'RET'REASS(RETRN,LDEV,DTT);                     <<03549>>05904000
  VALUE RETRN,LDEV;                                            <<03549>>05906000
  LOGICAL RETRN;                                               <<03549>>05908000
  INTEGER LDEV;                                                <<03549>>05910000
  INTEGER ARRAY DTT;                                           <<03549>>05912000
  OPTION FORWARD;                                              <<03549>>05914000
                                                               <<03549>>05916000
  LOGICAL PROCEDURE GET'AREA(AREA'LIST,ENTRY',MAX'ENTRIES,     <<03549>>05918000
                           LDEV,DISC'ADDR,LENGTH);             <<03549>>05920000
  VALUE ENTRY',MAX'ENTRIES;                                    <<03549>>05922000
  INTEGER ARRAY AREA'LIST;                                     <<03549>>05924000
  INTEGER ENTRY',MAX'ENTRIES,LDEV;                             <<03549>>05926000
  DOUBLE DISC'ADDR,LENGTH;                                     <<03549>>05928000
  OPTION FORWARD;                                              <<03549>>05930000
                                                               <<03549>>05932000
  PROCEDURE ZEROBUF(BUF,LEN);                                  <<03549>>05934000
  VALUE LEN;                                                   <<03549>>05936000
  ARRAY BUF;                                                   <<03549>>05938000
  INTEGER LEN;                                                 <<03549>>05940000
  OPTION FORWARD;                                              <<03549>>05942000
                                                               <<03549>>05944000
  LOGICAL PROCEDURE SDISC'TYPE( TYPE, SUBTYP);                 <<03550>>05946000
  VALUE TYPE, SUBTYP;                                          <<03550>>05948000
  INTEGER TYPE, SUBTYP;                                        <<03550>>05950000
  OPTION FORWARD;                                              <<03550>>05952000
                                                               <<03550>>05954000
  LOGICAL PROCEDURE SYSDISC'TYPE(TYPE,SUBTYP);                 <<03550>>05956000
  VALUE TYPE,SUBTYP;                                           <<03550>>05958000
  INTEGER TYPE,SUBTYP;                                         <<03550>>05960000
  OPTION FORWARD;                                              <<03550>>05962000
                                                               <<03550>>05964000
                                                               <<03022>>05966000
  PROCEDURE SIOP( DEVNR, CHANADR);                             <<03022>>05968000
  VALUE DEVNR, CHANADR;                                        <<03022>>05970000
  INTEGER DEVNR, CHANADR;                                      <<03022>>05972000
  OPTION FORWARD;                                              <<03022>>05974000
                                                               <<03022>>05976000
  PROCEDURE WIOC( DRT, COMMAND, DATAWORD);                     <<03022>>05978000
  VALUE DRT, COMMAND, DATAWORD;                                <<03022>>05980000
  INTEGER DRT, COMMAND, DATAWORD;                              <<03022>>05982000
  OPTION FORWARD;                                              <<03022>>05984000
                                                               <<03022>>05986000
  INTEGER PROCEDURE RIOC( DRT, PARM);                          <<03022>>05988000
  VALUE DRT, PARM;                                             <<03022>>05990000
  INTEGER DRT, PARM;                                           <<03022>>05992000
  OPTION FORWARD;                                              <<03022>>05994000
                                                               <<03022>>05996000
  PROCEDURE INIT( CHANNR);                                     <<03022>>05998000
  VALUE CHANNR;                                                <<03022>>06000000
  INTEGER CHANNR;                                              <<03022>>06002000
  OPTION FORWARD;                                              <<03022>>06004000
                                                               <<04546>>06006000
PROCEDURE UNLOCK'CS80;                                         <<04546>>06008000
  OPTION FORWARD;                                              <<04546>>06010000
                                                               <<04546>>06012000
$PAGE "EXTERNAL PROCEDURE DECLARATIONS"                        <<SY>>   06014000
        <<***********************>>                            <<SY>>   06016000
        << EXTERNAL DECLARATIONS >>                            <<SY>>   06018000
        <<***********************>>                            <<SY>>   06020000
                                                               <<SY>>   06022000
                                                               <<SY>>   06024000
                                                               <<SY>>   06026000
PROCEDURE DIRSET (WHICH);                                      <<SY>>   06028000
   VALUE   WHICH;                                              <<SY>>   06030000
   INTEGER WHICH;                                              <<SY>>   06032000
   OPTION  EXTERNAL;                                           <<SY>>   06034000
                                                               <<SY>>   06036000
PROCEDURE DIRXXXLOCATE (PNTRIN, PPSIZE, SETTO);                <<SY>>   06038000
   VALUE   PNTRIN, PPSIZE, SETTO;                              <<SY>>   06040000
   LOGICAL PNTRIN, SETTO;                                      <<SY>>   06042000
   INTEGER PPSIZE;                                             <<SY>>   06044000
   OPTION  EXTERNAL;                                           <<SY>>   06046000
                                                               <<SY>>   06048000
LOGICAL PROCEDURE DIRALLOCATE (PPSIZE);                        <<SY>>   06050000
   VALUE   PPSIZE;                                             <<SY>>   06052000
   INTEGER PPSIZE;                                             <<SY>>   06054000
   OPTION  EXTERNAL;                                           <<SY>>   06056000
                                                               <<SY>>   06058000
PROCEDURE DIRDEALLOCATE (PNTR, PPSIZE);                        <<SY>>   06060000
   VALUE   PNTR, PPSIZE;                                       <<SY>>   06062000
   LOGICAL PNTR;                                               <<SY>>   06064000
   INTEGER PPSIZE;                                             <<SY>>   06066000
   OPTION  EXTERNAL;                                           <<SY>>   06068000
                                                               <<SY>>   06070000
PROCEDURE DIRWRITE (WHICH);                                    <<SY>>   06072000
   VALUE   WHICH;                                              <<SY>>   06074000
   LOGICAL WHICH;                                              <<SY>>   06076000
   OPTION  EXTERNAL;                                           <<SY>>   06078000
                                                               <<SY>>   06080000
LOGICAL PROCEDURE DIRNEWINDEX (IBSIZE,ILEVEL,EBSIZE,ESIZE);    <<SY>>   06082000
   VALUE   IBSIZE, ILEVEL, EBSIZE, ESIZE;                      <<SY>>   06084000
   INTEGER IBSIZE, ILEVEL, EBSIZE, ESIZE;                      <<SY>>   06086000
   OPTION  EXTERNAL;                                           <<SY>>   06088000
                                                               <<SY>>   06090000
DOUBLE PROCEDURE DIRECNULL (NUMSECT);                          <<SY>>   06092000
   VALUE   NUMSECT;                                            <<SY>>   06094000
   INTEGER NUMSECT;                                            <<SY>>   06096000
   OPTION  EXTERNAL;                                           <<SY>>   06098000
                                                               <<SY>>   06100000
INTEGER PROCEDURE DIRSCAN (ENTRYNAME, TYPE'WHICH);             <<SY>>   06102000
   VALUE   TYPE'WHICH;                                         <<SY>>   06104000
   ARRAY   ENTRYNAME;                                          <<SY>>   06106000
   LOGICAL TYPE'WHICH;                                         <<SY>>   06108000
   OPTION  EXTERNAL;                                           <<SY>>   06110000
                                                               <<SY>>   06112000
DOUBLE PROCEDURE DIRINSERT (INDEXPOINTER);                     <<SY>>   06114000
   VALUE   INDEXPOINTER;                                       <<SY>>   06116000
   LOGICAL INDEXPOINTER;                                       <<SY>>   06118000
   OPTION  EXTERNAL;                                           <<SY>>   06120000
                                                               <<SY>>   06122000
DOUBLE PROCEDURE DIRFIND (INDEXPOINTER);                       <<SY>>   06124000
   VALUE   INDEXPOINTER;                                       <<SY>>   06126000
   LOGICAL INDEXPOINTER;                                       <<SY>>   06128000
   OPTION  EXTERNAL;                                           <<SY>>   06130000
                                                               <<SY>>   06132000
PROCEDURE DIRREMOVE (ELEMENT, WHICH);                          <<SY>>   06134000
   VALUE   WHICH;                                              <<SY>>   06136000
   LOGICAL WHICH;                                              <<SY>>   06138000
   ARRAY   ELEMENT;                                            <<SY>>   06140000
   OPTION  EXTERNAL;                                           <<SY>>   06142000
                                                               <<SY>>   06144000
PROCEDURE DIRRESET (NUMSECTS);                                 <<SY>>   06146000
   VALUE   NUMSECTS;                                           <<SY>>   06148000
   DOUBLE  NUMSECTS;                                           <<SY>>   06150000
   OPTION  EXTERNAL;                                           <<SY>>   06152000
                                                               <<SY>>   06154000
DOUBLE PROCEDURE DIRSTARTOFF (PARR,NUMSECTS,RECIP, PARMS);     <<SY>>   06156000
   VALUE   NUMSECTS, PARMS;                                    <<SY>>   06158000
   ARRAY   PARR;                                               <<SY>>   06160000
   DOUBLE  NUMSECTS;                                           <<SY>>   06162000
   INTEGER PROCEDURE RECIP;                                    <<SY>>   06164000
   INTEGER PARMS;                                              <<SY>>   06166000
   OPTION  VARIABLE, EXTERNAL;                                 <<SY>>   06168000
                                                               <<SY>>   06170000
DOUBLE PROCEDURE DIRECINSERT (TYPE, INDEXP, ANAME, GUNAME,     <<SY>>   06172000
                              FNAME, INSERT);                  <<SY>>   06174000
   VALUE   TYPE, INDEXP;                                       <<SY>>   06176000
   LOGICAL TYPE, INDEXP;                                       <<SY>>   06178000
   ARRAY   ANAME, GUNAME, FNAME, INSERT;                       <<SY>>   06180000
   OPTION  EXTERNAL;                                           <<SY>>   06182000
                                                               <<SY>>   06184000
DOUBLE PROCEDURE DIRECINSERTFILE (NUMSECTS, ANAME, GNAME,      <<SY>>   06186000
                             FNAME, FADDR);                    <<SY>>   06188000
   VALUE   NUMSECTS, FADDR;                                    <<SY>>   06190000
   DOUBLE  NUMSECTS, FADDR;                                    <<SY>>   06192000
   ARRAY   ANAME, GNAME, FNAME;                                <<SY>>   06194000
   OPTION  EXTERNAL;                                           <<SY>>   06196000
                                                               <<SY>>   06198000
DOUBLE PROCEDURE DIRECFIND (TYPE, INDEXP, ANAME, GUNAME,       <<SY>>   06200000
                            FNAME, PRETURN);                   <<SY>>   06202000
   VALUE   TYPE, INDEXP;                                       <<SY>>   06204000
   INTEGER TYPE, INDEXP;                                       <<SY>>   06206000
   ARRAY   ANAME, GUNAME, FNAME, PRETURN;                      <<SY>>   06208000
   OPTION  EXTERNAL;                                           <<SY>>   06210000
                                                               <<SY>>   06212000
DOUBLE PROCEDURE DIRECFINDFILE (TYPE, INDEXP, ANAME,           <<SY>>   06214000
                            GNAME, FNAME, PRETURN);            <<SY>>   06216000
   VALUE   TYPE, INDEXP;                                       <<SY>>   06218000
   LOGICAL TYPE, INDEXP;                                       <<SY>>   06220000
   ARRAY   ANAME, GNAME, FNAME, PRETURN;                       <<SY>>   06222000
   OPTION  EXTERNAL;                                           <<SY>>   06224000
                                                               <<SY>>   06226000
DOUBLE PROCEDURE DIRECPURGE (TYPE, INDEXP, ANAME, GUNAME,      <<SY>>   06228000
                             FNAME);                           <<SY>>   06230000
   VALUE   TYPE, INDEXP;                                       <<SY>>   06232000
   INTEGER TYPE, INDEXP;                                       <<SY>>   06234000
   ARRAY   ANAME, GUNAME, FNAME;                               <<SY>>   06236000
   OPTION  EXTERNAL;                                           <<SY>>   06238000
                                                               <<SY>>   06240000
DOUBLE PROCEDURE DIRECPURGEFILE (TYPE, INDEXP, ANAME, GNAME,   <<SY>>   06242000
                             FNAME);                           <<SY>>   06244000
   VALUE   TYPE, INDEXP;                                       <<SY>>   06246000
   INTEGER TYPE, INDEXP;                                       <<SY>>   06248000
   ARRAY   ANAME, GNAME, FNAME;                                <<SY>>   06250000
   OPTION  EXTERNAL;                                           <<SY>>   06252000
                                                               <<SY>>   06254000
DOUBLE PROCEDURE DIRECADJUST (NUMSECTS, ANAME, GNAME);         <<SY>>   06256000
   VALUE   NUMSECTS;                                           <<SY>>   06258000
   DOUBLE  NUMSECTS;                                           <<SY>>   06260000
   ARRAY   ANAME, GNAME;                                       <<SY>>   06262000
   OPTION  EXTERNAL;                                           <<SY>>   06264000
                                                               <<SY>>   06266000
LOGICAL PROCEDURE DIRDOENTRY (ELEMENT, LEAFLEVEL, RECIP,       <<SY>>   06268000
                              PARMS, GETSIRRESULT);            <<SY>>   06270000
   VALUE   LEAFLEVEL, PARMS, GETSIRRESULT;                     <<SY>>   06272000
   ARRAY   ELEMENT;                                            <<SY>>   06274000
   INTEGER LEAFLEVEL, PARMS, GETSIRRESULT;                     <<SY>>   06276000
   INTEGER PROCEDURE  RECIP;                                   <<SY>>   06278000
   OPTION  EXTERNAL;                                           <<SY>>   06280000
                                                               <<SY>>   06282000
PROCEDURE DIRSCANTREE (INDEX, LEAFLEVEL, RECIP, PARMS,         <<SY>>   06284000
                       GETSIRRESULT);                          <<SY>>   06286000
   VALUE   INDEX, LEAFLEVEL, PARMS, GETSIRRESULT;              <<SY>>   06288000
   INTEGER INDEX, LEAFLEVEL, PARMS, GETSIRRESULT;              <<SY>>   06290000
   INTEGER PROCEDURE RECIP;                                    <<SY>>   06292000
   OPTION  EXTERNAL;                                           <<SY>>   06294000
                                                               <<SY>>   06296000
DOUBLE PROCEDURE DIRECSCAN (TYPE, INDEXP, ANAME, GUNAME,       <<SY>>   06298000
                            FNAME, RECIP, PARMS);              <<SY>>   06300000
   VALUE   TYPE, INDEXP;                                       <<SY>>   06302000
   INTEGER TYPE, INDEXP;                                       <<SY>>   06304000
   INTEGER PROCEDURE RECIP;                                    <<SY>>   06306000
   ARRAY   ANAME, GUNAME, FNAME, PARMS;                        <<SY>>   06308000
   OPTION  EXTERNAL;                                           <<SY>>   06310000
                                                               <<SY>>   06312000
INTEGER PROCEDURE DIRECTORYCLEAN (ELEMENT, LEVEL, PARMS,       <<SY>>   06314000
                                  GARBAGE);                    <<SY>>   06316000
   VALUE   LEVEL, PARMS, GARBAGE;                              <<SY>>   06318000
   ARRAY   ELEMENT;                                            <<SY>>   06320000
   INTEGER LEVEL, PARMS;                                       <<SY>>   06322000
   DOUBLE  GARBAGE;                                            <<SY>>   06324000
   OPTION  EXTERNAL;                                           <<SY>>   06326000
                                                               <<SY>>   06328000
INTEGER PROCEDURE USERCLEAN (ELEMENT, LEVEL, PARMS, GARBAGE);  <<SY>>   06330000
   VALUE   LEVEL, PARMS, GARBAGE;                              <<SY>>   06332000
   ARRAY   ELEMENT;                                            <<SY>>   06334000
   INTEGER LEVEL, PARMS;                                       <<SY>>   06336000
   DOUBLE  GARBAGE;                                            <<SY>>   06338000
   OPTION  EXTERNAL;                                           <<SY>>   06340000
                                                               <<SY>>   06342000
INTEGER PROCEDURE SET'1'MGR (ELEMENT, LEVEL, PARMS, GARBAGE);  <<SY>>   06344000
   VALUE   LEVEL, PARMS, GARBAGE;                              <<SY>>   06346000
   ARRAY   ELEMENT;                                            <<SY>>   06348000
   INTEGER LEVEL, PARMS;                                       <<SY>>   06350000
   DOUBLE  GARBAGE;                                            <<SY>>   06352000
   OPTION  EXTERNAL;                                           <<SY>>   06354000
                                                               <<SY>>   06356000
INTEGER PROCEDURE VSDCLEAN (ELEMENT, LEVEL, PARMS, GARBAGE);   <<SY>>   06358000
   VALUE   LEVEL, PARMS, GARBAGE;                              <<SY>>   06360000
   ARRAY   ELEMENT;                                            <<SY>>   06362000
   INTEGER LEVEL, PARMS;                                       <<SY>>   06364000
   DOUBLE  GARBAGE;                                            <<SY>>   06366000
   OPTION  EXTERNAL;                                           <<SY>>   06368000
                                                               <<SY>>   06370000
INTEGER PROCEDURE FILEPURGE (ELEMENT, LEVEL, PARMS, GARBAGE);  <<SY>>   06372000
   VALUE   LEVEL, PARMS, GARBAGE;                              <<SY>>   06374000
   ARRAY   ELEMENT;                                            <<SY>>   06376000
   INTEGER LEVEL, PARMS;                                       <<SY>>   06378000
   DOUBLE  GARBAGE;                                            <<SY>>   06380000
   OPTION  EXTERNAL;                                           <<SY>>   06382000
$PAGE "DUMMY CODE SEGMENTATION PROCEDURES"                     <<SY>>   06384000
COMMENT                                                                 06386000
  THESE PROCEDURES PERFORM TWO FUNCTIONS. THE FIRST IS TO ORDER         06388000
INITIAL'S SEGMENTS SO THAT WHEN IT IS PREPARED, THE BOOTSTRAP           06390000
SEGMENT WILL HAVE THE HIGHEST LOGICAL CST NUMBER, FOLLOWED IN DESCENDING06392000
ORDER BY OTHER CORE RESIDENT SEGMENTS, THE SEGMENT FROM WHICH           06394000
CODE SWAPPING IS STARTED (MAINSEG1), NON-RESIDENT SEGMENTS              06396000
WHICH MUST BE IN CORE WHEN EXECUTION STARTS (I.E. THOSE                 06398000
NEEDED BEFORE WE START SWAPPING), AND FINALLY THOSE SEGMENTS            06400000
NOT NEEDED UNTIL AFTER CODE SWAPPING HAS BEGUN. THE                     06402000
SECOND FUNCTION IS TO PROVIDE A PCAL TO HELP SO THAT ITS                06404000
LABEL WILL BE IN THE STT OF EACH SEGMENT;                               06406000
                                                                        06408000
$CONTROL SEGMENT=MAINSEG4                                      <<03603>>06412000
   PROCEDURE MAINSEG4HELP; HELP;                               <<03603>>06414000
                                                               <<03603>>06416000
$CONTROL SEGMENT=MAINSEG3                                      <<03603>>06418000
   PROCEDURE MAINSEG3HELP; HELP;                               <<03603>>06420000
                                                               <<03603>>06422000
$CONTROL SEGMENT=MAINSEG2                                      <<03603>>06424000
   PROCEDURE MAINSEG2HELP; HELP;                               <<03603>>06426000
                                                               <<03603>>06428000
$CONTROL SEGMENT=MAINSEG1B                                     <<03603>>06430000
   PROCEDURE MAINSEG1BHELP; HELP;                              <<03603>>06432000
                                                               <<03603>>06434000
$CONTROL SEGMENT=PROCESS                                       <<03603>>06436000
   PROCEDURE PROCESSHELP; HELP;                                <<03603>>06438000
                                                               <<03603>>06440000
$CONTROL SEGMENT=SL'PROGRAM                                    <<03603>>06442000
   PROCEDURE SL'PROGRAMHELP; HELP;                             <<03603>>06444000
                                                               <<03603>>06446000
$CONTROL SEGMENT=DIRECTORY2                                    <<03603>>06448000
   PROCEDURE DIRECTORY2HELP; HELP;                             <<03603>>06450000
                                                               <<03603>>06452000
$CONTROL SEGMENT=DIRECTORY1                                    <<03603>>06454000
   PROCEDURE DIRECTORY1HELP; HELP;                             <<03603>>06456000
                                                               <<03603>>06458000
$CONTROL SEGMENT=DISCSPACE                                     <<03603>>06460000
   PROCEDURE DISCSPACEHELP; HELP;                              <<03603>>06462000
                                                               <<03603>>06464000
$CONTROL SEGMENT=FILEIO                                        <<03603>>06466000
   PROCEDURE FILEIOHELP; HELP;                                 <<03603>>06468000
                                                               <<03603>>06470000
$CONTROL SEGMENT=TAPEIO                                        <<03603>>06472000
   PROCEDURE TAPEIOHELP; HELP;                                 <<03603>>06474000
                                                               <<03603>>06476000
$CONTROL SEGMENT=SETUP                                         <<03603>>06478000
   PROCEDURE SETUPHELP; HELP;                                  <<03603>>06480000
                                                               <<03603>>06482000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03603>>06484000
   PROCEDURE DEFECTRACKSHELP; HELP;                            <<03603>>06486000
                                                               <<03603>>06488000
$CONTROL SEGMENT=CONFIGURE                                     <<03603>>06490000
   PROCEDURE CONFIGUREHELP; HELP;                              <<03603>>06492000
                                                               <<03603>>06494000
$CONTROL SEGMENT=MAINSEG1A                                     <<03603>>06496000
   PROCEDURE MAINSEG1AHELP; HELP;                              <<03603>>06498000
                                                               <<03603>>06500000
$CONTROL SEGMENT=MAINSEG1                                      <<03603>>06502000
   PROCEDURE MAINSEG1HELP; HELP;                               <<03603>>06504000
                                                               <<03603>>06506000
$CONTROL SEGMENT=RESIDENT                                      <<03603>>06508000
   PROCEDURE RESIDENTHELP; HELP;                               <<03603>>06510000
                                                               <<03603>>06512000
$CONTROL SEGMENT=BOOTSTRAP                                     <<03603>>06514000
   PROCEDURE BOOTSTRAPHELP; HELP;                              <<03603>>06516000
                                                               <<03603>>06518000
$CONTROL SEGMENT=ININ                                          <<03603>>06520000
   PROCEDURE ININHELP; HELP;                                   <<03603>>06522000
$PAGE "INTERNAL INTERRUPT HANDLER"                             <<03603>>06526000
$CONTROL SEGMENT=ININ                                          <<03603>>06528000
<<       The order of the following procedures        >>       <<03603>>06530000
<<       must not be changed.  Neither may any        >>       <<03603>>06532000
<<       procedure be added or deleted.  We are       >>       <<03603>>06534000
<<       depending on the order, to construct         >>       <<03603>>06536000
<<       the STT in such a way that the entry         >>       <<03603>>06538000
<<       points will be correct for the hardware.     >>       <<03603>>06540000
PROCEDURE CL'DISC;                                             <<03603>>06542000
   OPTION INTERRUPT;                                           <<03603>>06544000
BEGIN                                                          <<03603>>06546000
   <<  This procedure will be executed for disc boots >>       <<03603>>06548000
   <<  only.  INITIAL will change STT %44 to point to >>       <<03603>>06550000
   <<  this procedure before segment ININ to writtern >>       <<03603>>06552000
   <<  to disc.                                       >>       <<03603>>06554000
                                                               <<03603>>06556000
   PUSH( Q ); SET( DL ); << BECAUSE OF A 33 MICROCODE BUG >>   <<03603>>06558000
   BOOTSTRAP;                                                  <<03603>>06560000
END;                                                           <<03603>>06562000
PROCEDURE COLD'LOAD;                                           <<03603>>06564000
   OPTION INTERRUPT;                                           <<03603>>06566000
BEGIN                                                          <<03603>>06568000
   LOGICAL                                                     <<03603>>06570000
      USERS'S   = Q-6,                                         <<03603>>06572000
      SAVED'S   = Q-10;                                        <<03603>>06574000
   <<  The cold load trap destroys QI-6 so SYSDUMP  >>         <<03603>>06576000
   <<  stores what QI-6 should be in QI-10.         >>         <<03603>>06578000
   <<  This is the entry point for tape boots.      >>         <<03603>>06580000
                                                               <<03603>>06582000
   USERS'S := SAVED'S;                                         <<03603>>06584000
END;                                                           <<03603>>06586000
PROCEDURE PWR'ON;                                              <<03603>>06588000
   OPTION  INTERRUPT;                                          <<03603>>06590000
BEGIN                                                          <<03603>>06592000
   TOS := %43;                                                 <<03603>>06594000
   ININ'HALT;                                                  <<03603>>06596000
END;                                                           <<03603>>06598000
PROCEDURE DATA'ABSENT;                                         <<03603>>06600000
BEGIN                                                          <<03603>>06602000
   TOS := %42;                                                 <<03603>>06604000
   ININ'HALT;                                                  <<03603>>06606000
END;                                                           <<03603>>06608000
PROCEDURE STT'UNCALLABLE;                                      <<03603>>06610000
BEGIN                                                          <<03603>>06612000
   TOS := %41;                                                 <<03603>>06614000
   ININ'HALT;                                                  <<03603>>06616000
END;                                                           <<03603>>06618000
PROCEDURE TRACE;                                               <<03603>>06620000
BEGIN                                                          <<03603>>06622000
   TOS := %40;                                                 <<03603>>06624000
   ININ'HALT;                                                  <<03603>>06626000
END;                                                           <<03603>>06628000
PROCEDURE CODE'ABSENT;                                         <<03603>>06630000
BEGIN                                                          <<03603>>06632000
   MAKEPRESENT;                                                <<03603>>06634000
END;                                                           <<03603>>06636000
PROCEDURE TRAP36;                                              <<03603>>06638000
BEGIN                                                          <<03603>>06640000
   TOS := %36;                                                 <<03603>>06642000
   ININ'HALT;                                                  <<03603>>06644000
END;                                                           <<03603>>06646000
PROCEDURE TRAP35;                                              <<03603>>06648000
BEGIN                                                          <<03603>>06650000
   TOS := %35;                                                 <<03603>>06652000
   ININ'HALT;                                                  <<03603>>06654000
END;                                                           <<03603>>06656000
PROCEDURE TRAP34;                                              <<03603>>06658000
BEGIN                                                          <<03603>>06660000
   TOS := %34;                                                 <<03603>>06662000
   ININ'HALT;                                                  <<03603>>06664000
END;                                                           <<03603>>06666000
PROCEDURE TRAP33;                                              <<03603>>06668000
BEGIN                                                          <<03603>>06670000
   TOS := %33;                                                 <<03603>>06672000
   ININ'HALT;                                                  <<03603>>06674000
END;                                                           <<03603>>06676000
PROCEDURE TRAP32;                                              <<03603>>06678000
BEGIN                                                          <<03603>>06680000
   TOS := %32;                                                 <<03603>>06682000
   ININ'HALT;                                                  <<03603>>06684000
END;                                                           <<03603>>06686000
PROCEDURE USER'TRAPS;                                          <<03603>>06688000
BEGIN                                                          <<03603>>06690000
   TOS := %31;                                                 <<03603>>06692000
   ININ'HALT;                                                  <<03603>>06694000
END;                                                           <<03603>>06696000
PROCEDURE STK'OVERF;                                           <<03603>>06698000
   OPTION INTERRUPT;                                           <<03603>>06700000
BEGIN                                                          <<03603>>06702000
   TOS := %30;                                                 <<03603>>06704000
   ININ'HALT;                                                  <<03603>>06706000
END;                                                           <<03603>>06708000
PROCEDURE TRAP27;                                              <<03603>>06710000
BEGIN                                                          <<03603>>06712000
   TOS := %27;                                                 <<03603>>06714000
   ININ'HALT;                                                  <<03603>>06716000
END;                                                           <<03603>>06718000
PROCEDURE TRAP26;                                              <<03603>>06720000
BEGIN                                                          <<03603>>06722000
   TOS := %26;                                                 <<03603>>06724000
   ININ'HALT;                                                  <<03603>>06726000
END;                                                           <<03603>>06728000
PROCEDURE PRIV'VOIL;                                           <<03603>>06730000
BEGIN                                                          <<03603>>06732000
   TOS := %25;                                                 <<03603>>06734000
   ININ'HALT;                                                  <<03603>>06736000
END;                                                           <<03603>>06738000
PROCEDURE STK'UNDERF;                                          <<03603>>06740000
BEGIN                                                          <<03603>>06742000
   TOS := %24;                                                 <<03603>>06744000
   ININ'HALT;                                                  <<03603>>06746000
END;                                                           <<03603>>06748000
PROCEDURE DST'VIOL;                                            <<03603>>06750000
BEGIN                                                          <<03603>>06752000
   TOS := %23;                                                 <<03603>>06754000
   ININ'HALT;                                                  <<03603>>06756000
END;                                                           <<03603>>06758000
PROCEDURE CST'VIOL;                                            <<03603>>06760000
BEGIN                                                          <<03603>>06762000
   TOS := %22;                                                 <<03603>>06764000
   ININ'HALT;                                                  <<03603>>06766000
END;                                                           <<03603>>06768000
PROCEDURE STT'VIOL;                                            <<03603>>06770000
BEGIN                                                          <<03603>>06772000
   TOS := %21;                                                 <<03603>>06774000
   ININ'HALT;                                                  <<03603>>06776000
END;                                                           <<03603>>06778000
PROCEDURE UNIMP'INST;                                          <<03603>>06780000
BEGIN                                                          <<03603>>06782000
   TOS := %20;                                                 <<03603>>06784000
   ININ'HALT;                                                  <<03603>>06786000
END;                                                           <<03603>>06788000
PROCEDURE TRAP17;                                              <<03603>>06790000
BEGIN                                                          <<03603>>06792000
   TOS := %17;                                                 <<03603>>06794000
   ININ'HALT;                                                  <<03603>>06796000
END;                                                           <<03603>>06798000
PROCEDURE TRAP16;                                              <<03603>>06800000
BEGIN                                                          <<03603>>06802000
   TOS := %16;                                                 <<03603>>06804000
   ININ'HALT;                                                  <<03603>>06806000
END;                                                           <<03603>>06808000
PROCEDURE TRAP15;                                              <<03603>>06810000
BEGIN                                                          <<03603>>06812000
   TOS := %15;                                                 <<03603>>06814000
   ININ'HALT;                                                  <<03603>>06816000
END;                                                           <<03603>>06818000
PROCEDURE TRAP14;                                              <<03603>>06820000
BEGIN                                                          <<03603>>06822000
   TOS := %14;                                                 <<03603>>06824000
   ININ'HALT;                                                  <<03603>>06826000
END;                                                           <<03603>>06828000
PROCEDURE TRAP13;                                              <<03603>>06830000
BEGIN                                                          <<03603>>06832000
   TOS := %13;                                                 <<03603>>06834000
   ININ'HALT;                                                  <<03603>>06836000
END;                                                           <<03603>>06838000
PROCEDURE TRAP12;                                              <<03603>>06840000
BEGIN                                                          <<03603>>06842000
   TOS := %12;                                                 <<03603>>06844000
   ININ'HALT;                                                  <<03603>>06846000
END;                                                           <<03603>>06848000
PROCEDURE PWR'FAIL;                                            <<03603>>06850000
   OPTION INTERRUPT;                                           <<03603>>06852000
BEGIN                                                          <<03603>>06854000
   TOS := %11;                                                 <<03603>>06856000
   << FLUSH THE CACHE IF AN ICF/55 >>                          <<03603>>06858000
   IF ICF55 THEN ASSEMBLE( CON %20104; CON 5 );                <<03603>>06860000
   ININ'HALT;                                                  <<03603>>06862000
END;                                                           <<03603>>06864000
PROCEDURE TRAP10;                                              <<03603>>06866000
BEGIN                                                          <<03603>>06868000
   TOS := %10;                                                 <<03603>>06870000
   ININ'HALT;                                                  <<03603>>06872000
END;                                                           <<03603>>06874000
PROCEDURE MOD'INT;                                             <<03603>>06876000
   OPTION INTERRUPT;                                           <<03603>>06878000
BEGIN                                                          <<03603>>06880000
   TOS := 7;                                                   <<03603>>06882000
   ININ'HALT;                                                  <<03603>>06884000
END;                                                           <<03603>>06886000
PROCEDURE DATA'PARITY;                                         <<03603>>06888000
   OPTION INTERRUPT;                                           <<03603>>06890000
BEGIN                                                          <<03603>>06892000
   TOS := 6;                                                   <<03603>>06894000
   ININ'HALT;                                                  <<03603>>06896000
END;                                                           <<03603>>06898000
PROCEDURE ADR'PARITY;                                          <<03603>>06900000
   OPTION INTERRUPT;                                           <<03603>>06902000
BEGIN                                                          <<03603>>06904000
   TOS := 5;                                                   <<03603>>06906000
   ININ'HALT;                                                  <<03603>>06908000
END;                                                           <<03603>>06910000
PROCEDURE SYS'PARITY;                                          <<03603>>06912000
   OPTION INTERRUPT;                                           <<03603>>06914000
BEGIN                                                          <<03603>>06916000
   TOS := 4;                                                   <<03603>>06918000
   ININ'HALT;                                                  <<03603>>06920000
END;                                                           <<03603>>06922000
PROCEDURE NON'RESP'MOD;                                        <<03603>>06924000
BEGIN COMMENT                                                  <<03603>>06926000
   The function of this procedure is to allow INITIAL          <<03603>>06928000
   to recover from the non-responding-module interrupt         <<03603>>06930000
   generated because a disc device is configured, but          <<03603>>06932000
   the GIC is not physically present.  Also to recover         <<03603>>06934000
   from the non-responding-module interrupt generated          <<03603>>06936000
   from a user giving us an invalid memory size.               <<03603>>06938000
   ;                                                           <<03603>>06940000
   EQUATE                                                      <<03603>>06942000
      I'O'INSTR = %20302, << If the non-responding-module   >> <<03603>>06944000
                          << interrupt is due to a missing  >> <<03603>>06946000
                          << GIC, this will be in the X-REG >> <<03603>>06948000
      LSEA      = %20340, << If the non-responding-module   >> <<03603>>06950000
      SSEA      = %20341; << interrupt is due to a missing  >> <<03603>>06952000
                          << memory controller, this will   >> <<03603>>06954000
                          << be in the X-REG---see test of  >> <<03603>>06956000
                          << memsize in MAINSEG1            >> <<03603>>06958000
   IF X = I'O'INSTR THEN                                       <<03603>>06960000
      BEGIN                                                    <<03603>>06962000
      CC := CCL; << Return CCL to the code which originated >> <<03603>>06964000
                 << the SIOP to inform it that something    >> <<03603>>06966000
                 << went wrong.                             >> <<03603>>06968000
      END                                                      <<03603>>06970000
ELSE                                                           <<03603>>06972000
   << Different series respond differently to illmemadr >>     <<03603>>06974000
   << Series II/III do blind LSEA but trap on SSEA      >>     <<03603>>06976000
   << Series 33,44,55 will trap prior to LSEA on SSEA   >>     <<03603>>06978000
   IF X <> LSEA AND X <> SSEA THEN                             <<03603>>06980000
      ERRMESSAGE( M400); << NON-RESPONDING-MODULE INTERRUPT >> <<03603>>06982000
END;                                                           <<03603>>06984000
PROCEDURE ILL'ADR;                                             <<03603>>06986000
BEGIN                                                          <<03603>>06988000
   TOS := 2;                                                   <<03603>>06990000
   ININ'HALT;                                                  <<03603>>06992000
END;                                                           <<03603>>06994000
PROCEDURE BNDS'VOIL;                                           <<03603>>06996000
BEGIN                                                          <<03603>>06998000
   TOS := 1;                                                   <<03603>>07000000
   ININ'HALT;                                                  <<03603>>07002000
END;                                                           <<03603>>07004000
$CONTROL SEGMENT=RESIDENT                                      <<03001>>07008000
  PROCEDURE HELP;                                              <<03001>>07010000
    COMMENT                                                    <<03001>>07012000
   STAND-ALONE DEBUGGING PROCEDURE FOR DEBUGING INITIAL.       <<03001>>07014000
   INTERFACES THRU THE CONSOLE PART OF THE SYSTEM CLOCK        <<03001>>07016000
   BOARD. EACH SEGMENT WHERE IT IS TO BE USED MUST CONTAIN     <<03001>>07018000
   A PCAL TO HELP;                                             <<03001>>07020000
                                                               <<03001>>07022000
      BEGIN                                                    <<03001>>07024000
                                                               <<03001>>07026000
ENTRY HELP'MAKE'PRESENT;                                       <<03001>>07028000
      <<A SPECIAL ENRTY POINT - CALLED FROM MAKE'PRESENT>>     <<03001>>07030000
      <<WHENEVER A NEW CODE SEGMENT IS MADE PRESENT IN CORE>>  <<03001>>07032000
ENTRY HELP'MAKE'ABSENT;                                        <<03001>>07034000
ENTRY HELP'INIT'BPTAB;    <<ENTRY TO INITIALIZE BRKPT-TABLE>>  <<03001>>07036000
                                                               <<03001>>07038000
DEFINE                                                         <<03001>>07040000
        DISABLE = ASMB(SED 0)#,                                <<03001>>07042000
        CST'SIZE = 4#,                                         <<03001>>07044000
        F = ABSOLUTE#,                                         <<03001>>07046000
        BANKS'CONFIGURED = F(%1047)#;                          <<03001>>07050000
                                                               <<03001>>07052000
                                                               <<03001>>07054000
EQUATE BANK'BITS = 3;                                          <<03001>>07056000
                                                               <<03001>>07058000
EQUATE  MAX'BRKPTS = 10,                                       <<03001>>07060000
        BPT'ENTRY'SIZE = 3,     <<3 WORDS PER ENTRY>>          <<03001>>07062000
        BPT'TBL'SIZE = MAX'BRKPTS * BPT'ENTRY'SIZE,            <<03001>>07064000
        BPT'COPY'SIZE = BPT'TBL'SIZE + 2;  <<NUMBP + DEBUG>>   <<03001>>07066000
                                                               <<03001>>07068000
DEFINE  NUM'BRKPTS = BPTAB( BPT'TBL'SIZE )#;                   <<03001>>07070000
DEFINE  BP'DEBUG = BPTAB(BPT'TBL'SIZE+1)#;                     <<03001>>07072000
                                                               <<03001>>07074000
                                                               <<03001>>07076000
EQUATE  EMPTY'BRKPT = 0,      <<ENTRY IS AVAILABLE>>           <<03001>>07078000
        USER'BRKPT  = 1,      <<USER SET BRKPT>>               <<03001>>07080000
        FAKE'BRKPT  = 2,      <<FAKE BRKPT>>                   <<03001>>07082000
        ABSENT'BRKPT= 3;      <<SEGMENT IS ABSENT BRKPT>>      <<03001>>07084000
                                                               <<03001>>07086000
EQUATE  BP'TYPE'CST = 0,      <<  TYPE-CST  WORD-0 >>          <<03001>>07088000
        BP'ADDR     = 1,      <<    P       WORD-1 >>          <<03001>>07090000
        BP'INSTR    = 2;      <<  INSTR     WORD-2 >>          <<03001>>07092000
                                                               <<03001>>07094000
DEFINE  BP'TYPE = (0:8)#,     << FIELD FOR BRKPT-TYPE>>        <<03001>>07096000
        BP'CST  = (8:8)#;     << FIELD FOR BRKPT-CST >>        <<03001>>07098000
                                                               <<03001>>07100000
                                                               <<03001>>07102000
DEFINE EMPTY'FAKE'BRKPT = %1000#;    <<TYPE=FAKE,CST=0>>       <<03001>>07104000
                                                               <<03001>>07106000
EQUATE NUM'ZEROS = BPT'TBL'SIZE -1;  <<INITIALIZED ZEROS>>     <<03001>>07108000
                                                               <<03001>>07110000
ARRAY PB'REL'BRKPT'TBL(*)=PB:=EMPTY'FAKE'BRKPT,NUM'ZEROS(0),   <<03001>>07112000
                              0,0;                             <<03001>>07114000
 COMMENT                                                       <<03001>>07116000
   THIS ARRAY HOLDS THE INFORMATION REQUIRED FOR BREAKPOINTS.  <<03001>>07118000
   EACH ENTRY IN THE TABLE IS 3 WORDS LONG. THE TABLE IS       <<03001>>07120000
   ENDED WITH A -1. IT MAY BE EXTENDED BY  CHANGING THE NUMBER <<03001>>07122000
   OF INITIALIZATION ZEROS IN THE ABOVE DECLARATION. THE WORDS <<03001>>07124000
   IN  A TABLE ENTRY ARE USED AS FOLLOWS:                      <<03001>>07126000
                                                               <<03001>>07128000
   WORD0.(0:8) =  0    EMPTY TABLE ENTRY                       <<03001>>07130000
                  1    USER SET BREAKPOINT                     <<03001>>07132000
                  2    "FAKE" BREAKPOINT                       <<03001>>07134000
                  3    ABSENT BREAKPOINT                       <<03001>>07136000
                                                               <<03001>>07138000
   WORD0.(8:8) =       CST FOR THE BREAKPOINT. IF ZERO THEN    <<03001>>07140000
                       THIS TABLE ENTRY IS FREE.               <<03001>>07142000
                                                               <<03001>>07144000
   WORD1       =       PB RELATIVE ADDRESS FOR THE BREAKPOINT. <<03001>>07146000
                       IF ZERO THEN THE ENTRY IS FREE.         <<03001>>07148000
                                                               <<03001>>07150000
   WORD2       =       SAVED INSTRUCTION IF A BRKPOINT IS SET. <<03001>>07152000
                                                               <<03001>>07154000
END COMMENT;                                                   <<03001>>07156000
                                                               <<03001>>07158000
                                                               <<03001>>07160000
INTEGER ARRAY  DB'BPTAB(*) = DB+0;  << BREAKPOINT TABLE >>     <<03001>>07162000
INTEGER ARRAY BPTAB(0:BPT'TBL'SIZE+1) = Q;  <<Q-REL COPY>>     <<03001>>07164000
     <<SEE SUBROUTINE COPY'BRKPT'TABLE >>                      <<03001>>07166000
                                                               <<03001>>07168000
                                                               <<03001>>07170000
INTEGER ARRAY WRDIO(0:35);     << OUTPUT BUFFER >>             <<04306>>07172000
BYTE ARRAY IO(*) = WRDIO;                                      <<04306>>07174000
                                                               <<03001>>07176000
INTEGER ARRAY INBUF(0:35);                                     <<04306>>07178000
BYTE ARRAY BINBUF(*) = INBUF;                                  <<04306>>07180000
                                                               <<03001>>07182000
                                                               <<03001>>07184000
INTEGER BUFX;                                                  <<03001>>07186000
                                                               <<03001>>07188000
EQUATE NUM'CMDS = 8;                                           <<03001>>07190000
                                                               <<03001>>07192000
            <<ORDER IS IMPORTANT-SEE MAINLINE CASE STATMENT>>  <<03001>>07194000
            <<---------------------------------------------->> <<03001>>07196000
INTEGER ARRAY  COMM(*) = PB := %102,   <<B BREAK>>             <<03001>>07198000
                               %103,   <<C CLEAR>>             <<03001>>07200000
                               %104,   <<D DUMP>>              <<03001>>07202000
                               %114,   <<L LIST>>              <<03001>>07204000
                               %115,   <<M MODIFY>>            <<03001>>07206000
                               %122,   <<R RESUME>>            <<03001>>07208000
                               %124,   <<T TRACE>>             <<03001>>07210000
                               %75;    <<= EXPR>>              <<03001>>07212000
<< OCTAL VALUES OF THE CHARACTER COMMANDS >>                   <<03001>>07214000
                                                               <<03001>>07216000
                                                               <<03001>>07218000
EQUATE    OCTAL'MODE   = 0,                                    <<03001>>07220000
          DECIMAL'MODE = 1,                                    <<03001>>07222000
          HEX'MODE     = 2,                                    <<03001>>07224000
          ASCII'MODE   = 3,                                    <<03001>>07226000
          BINARY'MODE  = 4;                                    <<03001>>07228000
                                                               <<03001>>07230000
EQUATE NUM'MODES       = 5;                                    <<03001>>07232000
                                                               <<03001>>07234000
INTEGER ARRAY MODES(*)=PB:=  %117,   <<O OCTAL>>               <<03001>>07236000
                             %111,   <<I DECIMAL>>             <<03001>>07238000
                             %110,   <<H HEX>>                 <<03001>>07240000
                             %101,   <<A ASCII>>               <<03001>>07242000
                             %102;   <<B BINARY>>              <<03001>>07244000
                                                               <<03001>>07246000
INTEGER ARRAY  REL(*) = PB := %74,%75,%76,%43;                 <<03001>>07248000
<<  THE ABOVE ARE THE ALLOWABLE RELATIONAL OPERATORS >>        <<03001>>07250000
                                                               <<03001>>07252000
INTEGER ARRAY  PRE(*) = PB := "HELP    . ";                    <<03001>>07254000
                                                               <<03001>>07256000
INTEGER ARRAY CHARS(*) = PB :=  %60,%61,%62,%63,%64,%65,       <<03001>>07258000
    %66,%67,%70,%71,%101,%102,%103,%104,%105,%106;             <<03001>>07260000
<<CHARS FOR HEX CONVERSION:  0,1,2,..9,A,B,C,D,E,F >>          <<03001>>07262000
                                                               <<03001>>07264000
DOUBLE  P1, P2,   << PARAMETERS FOR COMMANDS >>                <<03001>>07266000
        OLDDB,    << CALLERS DB >>                             <<03001>>07268000
        SAVEDB,   << DB FOR BRKPT-TBL IN CODE>>                <<03001>>07270000
        K,  << TEMPORARY VARIABLE >>                           <<03001>>07272000
        CUR'VALUE,    <<TEMP VALUE FOR DUMP,MODIFY>>           <<03001>>07274000
        BRKPT'ADDR,   <<ABS ADDR FOR BRKPT>>                   <<03001>>07276000
        DS4 = S-4,   << S RELATIVE TEMPS >>                    <<03001>>07278000
        DS5 = S-5,                                             <<03001>>07280000
        DS1 = S-1;                                             <<03001>>07282000
                                                               <<03001>>07284000
LOGICAL  P2F,   << SET IF 2ND PARAMETER EXISTS >>              <<03001>>07286000
         REG,   << REGISTER USE FLAG >>                        <<03001>>07288000
         A'SPECIAL'ENTRY;   <<TRUE IF HELP IS >>               <<03001>>07290000
             <<ENTERED AT SPECIAL MAKE-PRESENT ENTRY PT>>      <<03001>>07292000
                                                               <<03001>>07294000
                                                               <<03001>>07296000
INTEGER  X = X,   << DEFINE REGISTERS AND TOS VARIABLES >>     <<03001>>07298000
         S0 = S-0,                                             <<03001>>07300000
         S1 = S-1,                                             <<03001>>07302000
         S2 = S-2,                                             <<03001>>07304000
         S3 = S-3,                                             <<03001>>07306000
         S4 = S-4,                                             <<03001>>07308000
         S5 = S-5,                                             <<03001>>07310000
         S6 = S-6,                                             <<03001>>07312000
         S7 = S-7,                                             <<03001>>07314000
         TOKEN,  << OUTPUT OF CHAR SUBROUTINE >>               <<03001>>07316000
         BRKPT'INSTR,  <<INSTRUCTION TO REPLACE>>              <<03001>>07318000
         BRKPT'TYPE,   <<TYPE OF BREAKPOINT>>                  <<03001>>07320000
         BRKPT'INX,    <<INDEX INTO BPTAB >>                   <<03001>>07322000
         ENTRY'BRKPT'INX,  <<INDEX OF USER BRKPT AT ENTRY>>    <<03001>>07324000
         ENTRY'CST,        <<SEGMENT OF THE ENTRY BRKPT>>      <<03001>>07326000
         ENTRY'P,          <<ADDR OF THE ENTRY BRKPT>>         <<03001>>07328000
         I, J, L,  << TEMPORARY VARIABLES >>                   <<03001>>07330000
         OLDS,  << S VALUE TO RESET IN FAIL >>                 <<03001>>07332000
         COM,  << COMMAND # >>                                 <<03001>>07334000
         CST,  << CST VALUE FOR B AND C COMMANDS >>            <<03001>>07336000
         P,  << P VALUE FOR ABOVE >>                           <<03001>>07338000
         PIN,                                                  <<03001>>07340000
         WIDTH,                                                <<03001>>07342000
         MODE,                                                 <<03001>>07344000
         SMP = Q-2,  << P FROM STACK MARKER >>                 <<03001>>07346000
         SMSTA = Q-1,  << STATUS FROM STACK MARKER >>          <<03001>>07348000
         SPECIAL'FUNCTION = Q - 5,   <<0=CLEAR  1 =PRSENT>>    <<03001>>07350000
         NEW'PRESENT'SEG = Q-4;    <<SPECIAL PARAMETER>>       <<03001>>07352000
            <<PUSHED ON TOS PRIOR TO CALL TO HELP BY>>         <<03001>>07354000
            <<MAKE'PRESENT WHEN A NEW SEGMENT HAS BEEN>>       <<03001>>07356000
            <<MADE PRESENT IN CORE>>                           <<03001>>07358000
                                                               <<03001>>07360000
$PAGE "HELP         BRKPT'TABLE SETUP"                         <<03001>>07362000
DOUBLE SUBROUTINE CST'ADDR( CST );                             <<03001>>07364000
<<===============================>>                            <<03001>>07366000
   VALUE CST; INTEGER CST;                                     <<03001>>07368000
                                                               <<03001>>07370000
<<COMPUTES THE BASE ADDRESS FOR A SEGMENT GIVEN THE CST. >>    <<03001>>07372000
                                                               <<03001>>07374000
   BEGIN                                                       <<03001>>07376000
   IF  F(F(0)) < CST  THEN  ASMB(HALT 1);  << ILLEGAL CST >>   <<03001>>07378000
   X := X+CST*CST'SIZE;                                        <<03001>>07380000
   IF  F(X) < 0  THEN  ASMB(HALT 2);  << ABSENT, ERROR >>      <<03001>>07382000
   TOS := F(X:=X+2);  << GET BANK >>                           <<03001>>07384000
   TOS := F(X:=X+1);  << GET ADDRESS IN THE BANK >>            <<03001>>07386000
   DS5 := TOS;  << RETURN THE VALUE >>                         <<03001>>07388000
   END;                                                        <<03001>>07390000
                                                               <<03001>>07392000
                                                               <<03001>>07394000
SUBROUTINE COPY'BRKPT'TABLE;                                   <<03001>>07396000
<<=========================>>                                  <<03001>>07398000
BEGIN                                                          <<03001>>07400000
    TOS := ABS(DBBANK);  <<AIM DB AT STACK>>                   <<03001>>07402000
    TOS := ABS(DB);                                            <<03001>>07404000
    ASMB(DDUP);   <<COPY FOR DEST CALC. FOR MABS>>             <<03001>>07406000
    ASMB(XCHD);                                                <<03001>>07408000
    OLDDB := TOS;        <<SAVE ORIG USER'S DB >>              <<03001>>07410000
    TOS := TOS +@BPTAB;   <<CALC. FINAL DEST IN STACK>>        <<03001>>07412000
                                                               <<03001>>07414000
    TOS := 0D;   <<FOR RETURN VALUE FROM CST'ADDR(*) >>        <<03001>>07416000
    PUSH(STATUS);                                              <<03001>>07418000
    TOS:=TOS.(8:8);    <<GRAB SEG NUMBER OF HELP>>             <<03001>>07420000
    TOS := CST'ADDR(*);   <<ABS ADDRESS>>                      <<03001>>07422000
    TOS := TOS + @PB'REL'BRKPT'TBL;  <<SRC FOR MABS>>          <<03001>>07424000
    ASMB (DDUP);  SAVEDB:= TOS;  <<SAVE SEG ADDR OF BPTAB>>    <<03001>>07426000
                                                               <<03001>>07428000
    TOS := BPT'COPY'SIZE;  <<LEN FOR MABS>>                    <<03001>>07430000
                                                               <<03001>>07432000
    ASMB( MABS);  <<MAKE A Q-REL COPY OF BPTAB FROM CODE SEG>> <<03001>>07434000
END;                                                           <<03001>>07436000
                                                               <<03001>>07438000
                                                               <<03001>>07440000
SUBROUTINE SAVE'BRKPT'TABLE;                                   <<03001>>07442000
<<=========================>>                                  <<03001>>07444000
BEGIN                                                          <<03001>>07446000
    TOS := SAVEDB;   <<ADDR IN SEG OF BPTAB>>                  <<03001>>07448000
                     <<DST FOR MABS>>                          <<03001>>07450000
                                                               <<03001>>07452000
    TOS := ABS(DBBANK);                                        <<03001>>07454000
    TOS := ABS(DB);                                            <<03001>>07456000
    TOS := TOS +@BPTAB;  <<SRC FOR MABS>>                      <<03001>>07458000
                                                               <<03001>>07460000
    TOS := BPT'COPY'SIZE;  <<LEN>>                             <<03001>>07462000
                                                               <<03001>>07464000
    ASMB(MABS);  <<COPY BACK FROM STACK TO SEG>>               <<03001>>07466000
                                                               <<03001>>07468000
                                                               <<03001>>07470000
    TOS := OLDDB;                                              <<03001>>07472000
    SET(DB);     <<RESTORE DB BACK TO CALLERS ORIG DB>>        <<03001>>07474000
END;                                                           <<03001>>07476000
                                                               <<03001>>07478000
$PAGE "HELP          IO ROUTINES"                              <<03001>>07480000
SUBROUTINE PRINTLINE (CNTL);                                   <<03001>>07482000
<<=======================>>                                    <<03001>>07484000
    VALUE CNTL; INTEGER CNTL;                                  <<03001>>07486000
    << 0 = CR-LF   1 = STAY ON SAME LINE >>                    <<03001>>07488000
    <<PRINTS THE CONTENTS OF THE "IO" BUFFER>>                 <<03001>>07490000
    <<BUFX POINTS TO NEXT FREE BYTE, AND THEREFORE>>           <<03001>>07492000
    <<EQUALS THE NUMBER OF LOADED BYTES>>                      <<03001>>07494000
BEGIN                                                          <<03001>>07496000
   PRINT(WRDIO,-BUFX,CNTL);                                    <<03001>>07498000
   BUFX := 0;  <<RESET THE BUFFER INDEX>>                      <<03001>>07500000
END;                                                           <<03001>>07502000
SUBROUTINE  CHAR;                                              <<03001>>07504000
<<===============>>                                            <<03001>>07506000
<<THIS PLACES THE NEXT BYTE IN BINBUF INTO TOKEN>>             <<03001>>07508000
<<AND ADVANCES PIN- THE INPUT BUFFER INDEX>>                   <<03001>>07510000
   BEGIN                                                       <<03001>>07512000
   DO BEGIN                                                    <<03001>>07514000
      TOKEN := BINBUF(PIN);                                    <<03001>>07516000
      PIN := PIN+1;                                            <<03001>>07518000
      END UNTIL TOKEN <> " ";                                  <<03001>>07520000
   END;                                                        <<03001>>07522000
                                                               <<03001>>07524000
SUBROUTINE  NUMOUT( N, L, S );                                 <<03001>>07526000
<<============================>>                               <<03001>>07528000
   VALUE  N,L,S;                                               <<03001>>07530000
   DOUBLE N;                                                   <<03001>>07532000
   INTEGER L,S;                                                <<03001>>07534000
<<N IS THE NUMBER TO PRINT. >>                                 <<03001>>07536000
<<L IS THE LOCATION IN "IO" TO PLACE IT>>                      <<03001>>07538000
<<S IS THE SIZE IN CHARACTERS FOR THE CONVERTED NUMBER.>>      <<03001>>07540000
   BEGIN                                                       <<03001>>07542000
   X := L+S;  << SET UP THE INDEX >>                           <<03001>>07544000
   TOS := N;  << GET NUMBER >>                                 <<03001>>07546000
   DO                                                          <<03001>>07548000
      BEGIN  << CONVERT ONE DIGIT >>                           <<03001>>07550000
      X := X-1;                                                <<03001>>07552000
      DUPLICATE;                                               <<03001>>07554000
      IO(X) := (TOS LAND 7) LOR %60;                           <<03001>>07556000
      TOS := TOS&DASR(3);                                      <<03001>>07558000
      END                                                      <<03001>>07560000
   UNTIL  S4 = X;                                              <<03001>>07562000
   DDEL;  << DELETE N'S REMAINS >>                             <<03001>>07564000
   END;                                                        <<03001>>07566000
                                                               <<03001>>07568000
                                                               <<03001>>07570000
DOUBLE SUBROUTINE DLSEA (ADDR);                                <<03001>>07572000
<<============================>>                               <<03001>>07574000
   VALUE ADDR; DOUBLE ADDR;                                    <<03001>>07576000
                                                               <<03001>>07578000
   <<GETS THE VALUE AT ADDR, AND CONVERTS IT TO A>>            <<03001>>07580000
   <<DOUBLE VALUE, WITH HI PART = 0>>                          <<03001>>07582000
BEGIN                                                          <<03001>>07584000
   TOS := ADDR;                                                <<03001>>07586000
   ASMB (LSEA);  <<GET THE VALUE>>                             <<03001>>07588000
   S7 := 0;  <<RETURN A 0 FOR HI PART>>                        <<03001>>07590000
   S6 := TOS;  <<RETURN LO PART>>                              <<03001>>07592000
   DDEL;     <<CUT ADDRESS FOR LSEA OFF>>                      <<03001>>07594000
END;                                                           <<03001>>07596000
                                                               <<03001>>07598000
                                                               <<03001>>07600000
                                                               <<03001>>07602000
SUBROUTINE BLANKOUT ( SPACES);                                 <<03001>>07604000
<<===========================>>                                <<03001>>07606000
    VALUE SPACES; INTEGER SPACES;                              <<03001>>07608000
BEGIN                                                          <<03001>>07610000
    WHILE SPACES > 0 DO                                        <<03001>>07612000
    BEGIN                                                      <<03001>>07614000
        IO(BUFX) := " ";    <<LOAD A BLANK>>                   <<03001>>07616000
        BUFX := BUFX + 1;                                      <<03001>>07618000
        SPACES := SPACES - 1;                                  <<03001>>07620000
    END;                                                       <<03001>>07622000
END;                                                           <<03001>>07624000
                                                               <<03001>>07626000
                                                               <<03001>>07628000
                                                               <<03001>>07630000
SUBROUTINE OCTNUMOUT (NUM, WIDTH);                             <<03001>>07632000
<<===============================>>                            <<03001>>07634000
   VALUE NUM,WIDTH; DOUBLE NUM; INTEGER WIDTH;                 <<03001>>07636000
    <<LOADS "IO" BUFFER AT CURRENT POSITION OF BUFX>>          <<03001>>07638000
    <<ONLY WIDTH BYTES OF OCTAL CONVERSION ARE LOADED>>        <<03001>>07640000
    <<BUFX IS ADVANCED TO NEXT FREE BYTE>>                     <<03001>>07642000
BEGIN                                                          <<03001>>07644000
    NUMOUT( NUM,BUFX,WIDTH);                                   <<03001>>07646000
    BUFX := BUFX + WIDTH;      <<ADVANCE BUFX >>               <<03001>>07648000
END;                                                           <<03001>>07650000
                                                               <<03001>>07652000
SUBROUTINE BYTESOUT (NUM);                                     <<03001>>07654000
<<=======================>>                                    <<03001>>07656000
    VALUE NUM; DOUBLE NUM;                                     <<03001>>07658000
BEGIN                                                          <<03001>>07660000
    TOS := NUM;                                                <<03001>>07662000
    DELB;                     <<KILL HI PART- LEAVE LO >>      <<03001>>07664000
    OCTNUMOUT( DOUBLE(S0.(0:8)),3);  <<LEFT BYTE>>             <<03001>>07666000
    BLANKOUT( 1 );            <<LOAD SPACE BETWEEN BYTES>>     <<03001>>07668000
    OCTNUMOUT( DOUBLE(TOS.(8:8)),3);  <<RIGHT BYTE>>           <<03001>>07670000
END;                                                           <<03001>>07672000
                                                               <<03001>>07674000
                                                               <<03001>>07676000
SUBROUTINE ASCIINUMOUT (NUM);                                  <<03001>>07678000
<<=========================>>                                  <<03001>>07680000
    VALUE NUM; DOUBLE NUM;                                     <<03001>>07682000
    <<LOADS THE TWO BYTES IN THE LO PORTION OF NUM>>           <<03001>>07684000
    <<INTO THE "IO" BUFFER, AND ADVANCES BUFX>>                <<03001>>07686000
BEGIN                                                          <<03001>>07688000
                                                               <<03001>>07690000
    TOS := NUM;                 <<COPY OF NUM>>                <<03001>>07692000
    DELB;                       <<CHUCK HI PART>>              <<03001>>07694000
    DUPLICATE;                  <<NOW 2 COPIES OF LO PART>>    <<03001>>07696000
                                                               <<03001>>07698000
    TOS := TOS.(0:8);           <<GRAB LEFT BYTE>>             <<03001>>07700000
    IF S0 < %40 OR S0 > %176    <<NON-PRINTABLE>>              <<03001>>07702000
    THEN S0 := %56;             <<USE A PERIOD>>               <<03001>>07704000
    IO(BUFX) := TOS;            <<LOAD BYTE INTO IO-BUF>>      <<03001>>07706000
    BUFX:=BUFX + 1;             <<ADVANCE TO NEXT BYTE>>       <<03001>>07708000
                                                               <<03001>>07710000
    TOS := TOS.(8:8);           <<GRAB RIGHT BYTE>>            <<03001>>07712000
    IF S0 < %40 OR S0 > %176    <<NON-PRINTABLE>>              <<03001>>07714000
    THEN S0 := %56;             <<USE A PERIOD>>               <<03001>>07716000
    IO(BUFX) := TOS;            <<LOAD BYTE INTO IO-BUF>>      <<03001>>07718000
    BUFX:=BUFX + 1;             <<ADVANCE TO NEXT BYTE>>       <<03001>>07720000
END;  <<SUBROUTINE ASCIINUMOUT>>                               <<03001>>07722000
                                                               <<03001>>07724000
                                                               <<03001>>07726000
SUBROUTINE BITSOUT( NUM);                                      <<03001>>07728000
<<======================>>                                     <<03001>>07730000
    VALUE NUM; DOUBLE NUM;                                     <<03001>>07732000
BEGIN                                                          <<03001>>07734000
    TOS := NUM; DELB;     << S1 = NUMBER>>                     <<03001>>07736000
    TOS := 0;             << S0 = COUNT (0-15) >>              <<03001>>07738000
    DO BEGIN                                                   <<03001>>07740000
        IF (S0-1) MOD 3 = 0                                    <<03001>>07742000
        THEN BLANKOUT( 1 );  <<LOAD A SPACE>>                  <<03001>>07744000
        IO(BUFX) := CHARS( S1.(0:1));   <<LOAD "0" OR "1" >>   <<03001>>07746000
        BUFX := BUFX + 1;                                      <<03001>>07748000
        S1 := S1&LSL(1);                                       <<03001>>07750000
        S0 := S0 + 1;                                          <<03001>>07752000
    END UNTIL S0 > 15;   <<LOAD ALL 16 BITS>>                  <<03001>>07754000
    DDEL;                                                      <<03001>>07756000
END;  <<SUBROUTINE BITSOUT>>                                   <<03001>>07758000
                                                               <<03001>>07760000
                                                               <<03001>>07762000
SUBROUTINE ADDROUT (ADDR);                                     <<03001>>07764000
<<======================>>                                     <<03001>>07766000
    VALUE ADDR; DOUBLE ADDR;                                   <<03001>>07768000
BEGIN                                                          <<03001>>07770000
                                                               <<03001>>07772000
    TOS := ADDR&DLSR(16);       <<BANK NUMBER>>                <<03001>>07774000
    OCTNUMOUT(*,BANK'BITS);     <<LOAD BANK NUMBER>>           <<03001>>07776000
    MOVE IO(BUFX) := " @";      <<BANK NOTATION>>              <<03001>>07778000
    BUFX := BUFX + 2;           <<ADVANCE BUFX>>               <<03001>>07780000
                                                               <<03001>>07782000
    TOS := ADDR&DLSL(16);       <<SHIFT BANK PART OUT>>        <<03001>>07784000
    TOS := TOS&DLSR(16);        <<SHIFT ADDR BACK IN>>         <<03001>>07786000
    OCTNUMOUT(*,6);             <<LOAD ADDR PART>>             <<03001>>07788000
    MOVE IO(BUFX) := ": ";      <<LOAD COLON,SPACE>>           <<03001>>07790000
    BUFX := BUFX + 2;                                          <<03001>>07792000
END;                                                           <<03001>>07794000
                                                               <<03001>>07796000
$PAGE "HELP          SYNTAX PARSING ROUTNES"                   <<03001>>07798000
                                                               <<03001>>07800000
                                                               <<03001>>07802000
SUBROUTINE  FAIL;                                              <<03001>>07804000
<<===============>>                                            <<03001>>07806000
<<THIS IS CALLED ON A COMMAND FAILURE. IT CUTS THE STACK>>     <<03001>>07808000
<<BACK AS NEEDED AND RETURNS TO THE COMMAND INPUT LOOP.>>      <<03001>>07810000
    BEGIN                                                      <<03001>>07812000
    WRDIO := "??";                                             <<03001>>07814000
    BUFX := 2;   <<LENGTH = 2 BYTES>>                          <<03001>>07816000
    PRINTLINE (0);  <<OUTPUT ERROR, CRLF>>                     <<03001>>07818000
    TOS := OLDS;  << RESET S AS REQUIRED >>                    <<03001>>07820000
    SET (  S  );                                               <<03001>>07822000
    GO COMIN;                                                  <<03001>>07824000
    END;                                                       <<03001>>07826000
                                                               <<03001>>07828000
LOGICAL SUBROUTINE ABSENT'CST ( CST);                          <<03001>>07830000
<<==================================>>                         <<03001>>07832000
    VALUE CST; INTEGER CST;                                    <<03001>>07834000
BEGIN                                                          <<03001>>07836000
    <<RETURNS TRUE IF SEGMENT "CST" IS ABSENT >>               <<03001>>07838000
                                                               <<03001>>07840000
    IF F(F(0)) < CST                                           <<03001>>07842000
    THEN BEGIN                                                 <<03001>>07844000
        MOVE IO := "ILLEGAL CST";                              <<03001>>07846000
        BUFX := 11;                                            <<03001>>07848000
        PRINTLINE (0);                                         <<03001>>07850000
        RETURN;                                                <<03001>>07852000
     END;                                                      <<03001>>07854000
                                                               <<03001>>07856000
    X := X+CST*CST'SIZE;                                       <<03001>>07858000
    IF F(X) < 0    <<SEGMENT IS ABSENT>>                       <<03001>>07860000
    THEN ABSENT'CST := TRUE                                    <<03001>>07862000
    ELSE ABSENT'CST := FALSE;                                  <<03001>>07864000
END;                                                           <<03001>>07866000
                                                               <<03001>>07868000
                                                               <<03001>>07870000
DOUBLE SUBROUTINE OCTINT;                                      <<03001>>07872000
<<========================>>                                   <<03001>>07874000
<<COMPUTES AND RETURNS AN OCTAL INTEGER. THE INTEGER MUST>>    <<03001>>07876000
<<HAVE BETWEEN 1 AND 6 DIGITS INCLUSIVE>>                      <<03001>>07878000
   BEGIN                                                       <<03001>>07880000
   L := 0;  << ZERO THE DIGIT COUNTER >>                       <<03001>>07882000
   TOS := 0D;  << INITIAL VALUE OF OCTINT >>                   <<03001>>07884000
   WHILE  %60 <= TOKEN <= %67  DO                              <<03001>>07886000
      BEGIN  << GET A DIGIT >>                                 <<03001>>07888000
      L := L+1;                                                <<03001>>07890000
      TOS := TOS&DCSL(3);                                      <<03001>>07892000
      TOS := 0;   << FORM DOUBLE VALUE FOR NEW DIGIT >>        <<03001>>07894000
      TOS := TOKEN-%60;                                        <<03001>>07896000
      ASMB( DADD );                                            <<03001>>07898000
      CHAR;  << GET THE NEXT CHARACTER >>                      <<03001>>07900000
      END;                                                     <<03001>>07902000
   IF  NOT( 1 <= L <= 6 )  THEN  FAIL;                         <<03001>>07904000
      <<TOO FEW OR TOO MANY>>                                  <<03001>>07906000
   DS4 := TOS;  << RETURN THE VALUE >>                         <<03001>>07908000
   END;                                                        <<03001>>07910000
                                                               <<03001>>07912000
DOUBLE SUBROUTINE NUMBER;                                      <<03001>>07914000
<<======================>>                                     <<03001>>07916000
<<COMPUTES A SIGNED NUMBER >>                                  <<03001>>07918000
                                                               <<03001>>07920000
   IF  TOKEN = "-"  THEN                                       <<03001>>07922000
      BEGIN                                                    <<03001>>07924000
      CHAR;  << GET NEXT >>                                    <<03001>>07926000
      NUMBER := -OCTINT;                                       <<03001>>07928000
      END                                                      <<03001>>07930000
   ELSE                                                        <<03001>>07932000
      BEGIN                                                    <<03001>>07934000
      IF  TOKEN = "+"  THEN  CHAR;  << IGNORE IT >>            <<03001>>07936000
      NUMBER := OCTINT;                                        <<03001>>07938000
      END;                                                     <<03001>>07940000
                                                               <<03001>>07942000
                                                               <<03001>>07944000
                                                               <<03001>>07946000
DOUBLE SUBROUTINE PRI';                                        <<03001>>07948000
<<====================>>                                       <<03001>>07950000
                                                               <<03001>>07952000
<<COMPUTES A PRI, SEE DOCUMENTATION FOR DEFINITION >>          <<03001>>07954000
                                                               <<03001>>07956000
   IF  "D" <= TOKEN <= "Z"  THEN                               <<03001>>07958000
      BEGIN << A REGISTER IS GIVEN >>                          <<03001>>07960000
      REG := TRUE;                                             <<03001>>07962000
      PUSH(SBANK);  << GET THE STACK BANK >>                   <<03001>>07964000
      PUSH( DB );                                              <<03001>>07966000
      DELB;   << GET RID OF DB BANK >>                         <<03001>>07968000
      IF  TOKEN = "D"  THEN                                    <<03001>>07970000
         BEGIN  << DL OR DB >>                                 <<03001>>07972000
         CHAR;  << GET THE B OR L >>                           <<03001>>07974000
         IF  TOKEN = "B"  THEN                                 <<03001>>07976000
            BEGIN  << DB >>                                    <<03001>>07978000
            DDEL;  << CUT DB AND SBANK >>                      <<03001>>07980000
            TOS := OLDDB;                                      <<03001>>07982000
            TOS := 0;   << DB REL DB >>                        <<03001>>07984000
            END                                                <<03001>>07986000
         ELSE  IF  TOKEN  = "L"  THEN  PUSH( DL )              <<03001>>07988000
         ELSE  FAIL;  << ILLEGAL REGISTER GIVEN >>             <<03001>>07990000
         END                                                   <<03001>>07992000
      ELSE                                                     <<03001>>07994000
         BEGIN                                                 <<03001>>07996000
         IF  TOKEN = "Q"  THEN                                 <<03001>>07998000
            BEGIN  << Q >>                                     <<03001>>08000000
            PUSH( Q );  << GET Q >>                            <<03001>>08002000
            TOS := TOS+TOS;   << MAKE ABSOLUTE Q >>            <<03001>>08004000
            ASMB(LSEA);  << GET DELTA Q FROM MARKER >>         <<03001>>08006000
            TOS := -TOS;  << BUILD USER'S Q >>                 <<03001>>08008000
            END                                                <<03001>>08010000
         ELSE  IF  TOKEN = "S"  THEN                           <<03001>>08012000
            BEGIN  << S >>                                     <<03001>>08014000
            PUSH( Q );                                         <<03001>>08016000
            TOS := TOS-4;                                      <<03001>>08018000
            END                                                <<03001>>08020000
         ELSE  IF  TOKEN = "Z"  THEN  PUSH( Z )                <<03001>>08022000
         ELSE  FAIL;                                           <<03001>>08024000
         END;                                                  <<03001>>08026000
      CHAR;  << SCAN OFF THE REGISTER >>                       <<03001>>08028000
      TOS := TOS+TOS;   << CHANGE DB REL TO ABS >>             <<03001>>08030000
      DS4 := TOS;  << RETURN THE VALUE >>                      <<03001>>08032000
      END                                                      <<03001>>08034000
   ELSE                                                        <<03001>>08036000
      PRI' := NUMBER;                                          <<03001>>08038000
                                                               <<03001>>08040000
DOUBLE SUBROUTINE FACTOR;                                      <<03001>>08042000
<<=====================>>                                      <<03001>>08044000
    <<COMPUTES A FACTOR:    >>                                 <<03001>>08046000
    <<FACTOR ::= PRI' ! FACTOR * PRI' >>                       <<03001>>08048000
BEGIN                                                          <<03001>>08050000
   TOS := PRI';   <<GET A PRIMARY>>                            <<03001>>08052000
L: IF TOKEN = "*" THEN                                         <<03001>>08054000
      BEGIN                                                    <<03001>>08056000
      CHAR;  <<SCAN OFF THE - >>                               <<03001>>08058000
      TOS := PRI';                                             <<03001>>08060000
      IF REG                                                   <<03001>>08062000
      THEN ASMB(DELB,MPY)                                      <<03001>>08064000
      ELSE ASMB(DMUL);                                         <<03001>>08066000
      GO L;                                                    <<03001>>08068000
      END;                                                     <<03001>>08070000
   DS4 := TOS;                                                 <<03001>>08072000
END;                                                           <<03001>>08074000
                                                               <<03001>>08076000
                                                               <<03001>>08078000
DOUBLE SUBROUTINE SEXP;                                        <<03001>>08080000
<<=====================>>                                      <<03001>>08082000
<< COMPUTES A <SEXP> >>                                        <<03001>>08084000
   BEGIN                                                       <<03001>>08086000
   TOS := FACTOR;                                              <<03001>>08088000
L: IF  TOKEN = "+"  THEN                                       <<03001>>08090000
      BEGIN                                                    <<03001>>08092000
      CHAR;  << SCAN OFF + >>                                  <<03001>>08094000
      TOS := FACTOR;                                           <<03001>>08096000
      IF REG THEN ASMB(DELB,ADD) ELSE ASMB(DADD);              <<03001>>08098000
      GO L;                                                    <<03001>>08100000
      END;                                                     <<03001>>08102000
   IF  TOKEN = "-"  THEN                                       <<03001>>08104000
      BEGIN                                                    <<03001>>08106000
      CHAR;  << SCAN OFF THE - >>                              <<03001>>08108000
      TOS := FACTOR;                                           <<03001>>08110000
      IF REG THEN ASMB(DELB,SUB) ELSE ASMB(DSUB);              <<03001>>08112000
      GO L;                                                    <<03001>>08114000
      END;                                                     <<03001>>08116000
   IF (TOKEN="I") OR (TOKEN=":") THEN                          <<03001>>08118000
      BEGIN  << INDIRECT >>                                    <<03001>>08120000
      CHAR;  << SCAN OFF THE I >>                              <<03001>>08122000
      ASMB(LSEA);  << GET THE ADDRESS' CONTENTS >>             <<03001>>08124000
      DELB; DELB;  << CUT ADDRESS >>                           <<03001>>08126000
      IF REG THEN ASMB(LDD OLDDB; CAB,ADD) ELSE                <<03001>>08128000
      ASMB( ZERO,XCH );  << FORM A DOUBLE >>                   <<03001>>08130000
      GO L;                                                    <<03001>>08132000
      END;                                                     <<03001>>08134000
   DS4 := TOS;                                                 <<03001>>08136000
   END;                                                        <<03001>>08138000
                                                               <<03001>>08140000
                                                               <<03001>>08142000
                                                               <<03001>>08144000
DOUBLE SUBROUTINE  EXP;                                        <<03001>>08146000
<<====================>>                                       <<03001>>08148000
<< COMPUTES A <EXP>  >>                                        <<03001>>08150000
   BEGIN                                                       <<03001>>08152000
   REG := FALSE;                                               <<03001>>08154000
   TOS := SEXP;                                                <<03001>>08156000
   IF  TOKEN = "."  THEN                                       <<03001>>08158000
      BEGIN                                                    <<03001>>08160000
      DUPLICATE;                                               <<03001>>08162000
      CST := S0;                                               <<03001>>08164000
      CHAR;                                                    <<03001>>08166000
      IF ABSENT'CST(CST)                                       <<03001>>08168000
      THEN BEGIN   <<SEG IS ABSENT- ABS ADDR NOT POSSIBLE>>    <<03001>>08170000
          DDEL; DEL;   <<CLEAN UP STACK>>                      <<03001>>08172000
          TOS := EXP;  <<GET OFFSET IN SEG>>                   <<03001>>08174000
          P := S0;     <<SAVE P>>                              <<03001>>08176000
          S1 := CST;   <<FORM  S1=CST, S0=P(OFFSET) PAIR>>     <<03001>>08178000
          END                                                  <<03001>>08180000
      ELSE BEGIN  <<SEG PRESENT- FORM ABSOLUTE ADDR>>          <<03001>>08182000
         TOS := CST'ADDR(*);                                   <<03001>>08184000
         TOS := SEXP;                                          <<03001>>08186000
         P := S0;                                              <<03001>>08188000
         IF P<0 THEN FAIL;                                     <<03001>>08190000
         ASMB(DADD);                                           <<03001>>08192000
        END;  <<SEG IS PRESENT>>                               <<03001>>08194000
                                                               <<03001>>08196000
      END                                                      <<03001>>08198000
   ELSE IF TOKEN = "@"                                         <<03001>>08200000
        THEN BEGIN                                             <<03001>>08202000
            DELB;                                              <<03001>>08204000
            CHAR;                                              <<03001>>08206000
            TOS := SEXP;                                       <<03001>>08208000
            DELB;                                              <<03001>>08210000
         END;                                                  <<03001>>08212000
                                                               <<03001>>08214000
   DS4 := TOS;                                                 <<03001>>08216000
   END;                                                        <<03001>>08218000
                                                               <<03001>>08220000
SUBROUTINE GETP1;                                              <<03001>>08222000
<<==============>>                                             <<03001>>08224000
    <<LOADS GLOBAL P1 WITH AN EXP>>                            <<03001>>08226000
BEGIN                                                          <<03001>>08228000
    P1 := EXP;      <<LOAD P1 WITH EXP>>                       <<03001>>08230000
END;                                                           <<03001>>08232000
                                                               <<03001>>08234000
SUBROUTINE GETP2;                                              <<03001>>08236000
<<==============>>                                             <<03001>>08238000
    <<LOADS GLOBAL P2 WITH OPTIONAL EXP>>                      <<03001>>08240000
BEGIN                                                          <<03001>>08242000
    IF TOKEN =","  <<DOES IT LOOK LIKE WE HAVE ANOTHER>>       <<03001>>08244000
    THEN BEGIN                                                 <<03001>>08246000
       CHAR;       <<SCAN OFF THE COMMA>>                      <<03001>>08248000
       P2 := EXP;  <<LOAD P2 WITH AN EXP>>                     <<03001>>08250000
       P2F := TRUE;                                            <<03001>>08252000
    END;                                                       <<03001>>08254000
END;                                                           <<03001>>08256000
                                                               <<03001>>08258000
SUBROUTINE GETWIDTH;                                           <<03001>>08260000
<<=================>>                                          <<03001>>08262000
    <<LOADS GLOBAL WIDTH WITH AN INTEGER EXP>>                 <<03001>>08264000
BEGIN                                                          <<03001>>08266000
    IF TOKEN = ","                                             <<03001>>08268000
    THEN BEGIN                                                 <<03001>>08270000
       CHAR;       <<SCAN OFF THE COMMA>>                      <<03001>>08272000
       TOS := EXP;    <<GET DOUBLE EXP>>                       <<03001>>08274000
       DELB;          <<CHUCK HI PART>>                        <<03001>>08276000
       WIDTH := TOS;  <<STORE IN GLOBAL WIDTH>>                <<03001>>08278000
    END;                                                       <<03001>>08280000
END;                                                           <<03001>>08282000
                                                               <<03001>>08284000
SUBROUTINE GETMODE;                                            <<03001>>08286000
<<================>>                                           <<03001>>08288000
    <<CHECKS FOR OPTIONAL MODE PARAMETER:"0,I,H,A,B">>         <<03001>>08290000
    <<FOR OUTPUT MODES:OCTAL,DECIMAL,HEX,ASCII,BINARY>>        <<03001>>08292000
BEGIN                                                          <<03001>>08294000
    IF TOKEN = ","                                             <<03001>>08296000
    THEN BEGIN                                                 <<03001>>08298000
        CHAR;       <<SCAN OFF THE COMMA>>                     <<03001>>08300000
        X := NUM'MODES -1;                                     <<03001>>08302000
        MODE := OCTAL'MODE;   <<DEFAULT>>                      <<03001>>08304000
                                                               <<03001>>08306000
        DO BEGIN                                               <<03001>>08308000
           IF TOKEN = MODES(X)                                 <<03001>>08310000
           THEN BEGIN                                          <<03001>>08312000
              MODE := X;                                       <<03001>>08314000
              GO FND;                                          <<03001>>08316000
            END;                                               <<03001>>08318000
           X := X - 1;                                         <<03001>>08320000
        END UNTIL <;                                           <<03001>>08322000
                                                               <<03001>>08324000
        PIN := PIN -2;   <<TRICKY!! BACK UP 2 BYTES>>          <<03001>>08326000
           <<NEGATE THE EFFECT OF OUR PREV CHAR PEEK>>         <<03001>>08328000
           <<GAMES WITH PTR TO INPUT BUFFER>>                  <<03001>>08330000
                                                               <<03001>>08332000
FND:    CHAR;   <<IF FOUND,SCAN OFF THE MODE>>                 <<03001>>08334000
                <<IF NOT FOUND,RESET TOKEN TO ORIG COMMA>>     <<03001>>08336000
    END;  <<IF TOKEN = COMMA>>                                 <<03001>>08338000
END;  <<SUBROUTINE GETMODE>>                                   <<03001>>08340000
                                                               <<03001>>08342000
                                                               <<03001>>08344000
$PAGE "HELP          BREAKPOINT ROUTINES"                      <<03001>>08346000
SUBROUTINE  IMPCST;                                            <<03001>>08348000
<<===============>>                                            <<03001>>08350000
<<CHECKS FOR AN IMPLIED CST IN THE C OR B COMMANDS>>           <<03001>>08352000
   IF  CST = 0  THEN                                           <<03001>>08354000
      BEGIN  << IMPLIED CST >>                                 <<03001>>08356000
      CST := SMSTA.(8:8);                                      <<03001>>08358000
      TOS := P1;  DELB;  P := TOS;                             <<03001>>08360000
      IF P<0 THEN FAIL;                                        <<03001>>08362000
      END;                                                     <<03001>>08364000
                                                               <<03001>>08366000
                                                               <<03001>>08368000
INTEGER SUBROUTINE FIND'BRKPT(TYPE,CST,P);                     <<03001>>08370000
<<=====================================>>                      <<03001>>08372000
   VALUE TYPE,CST,P;  INTEGER TYPE,CST,P;                      <<03001>>08374000
                                                               <<03001>>08376000
BEGIN                                                          <<03001>>08378000
                                                               <<03001>>08380000
  <<THIS ROUTINE IS USED TO FIND ENTRIES IN THE BP'TAB>>       <<03001>>08382000
  <<IF TYPE,CST, AND P MATCH STORED BRKPT ENTRY VALUES>>       <<03001>>08384000
  <<THEN FIND'BRKPT RETURNS AS THE INDEX OF THE FIRST>>        <<03001>>08386000
  <<WORD OF THE ENTRY IN THE BP'TAB, OTHERWISE AS -1 >>        <<03001>>08388000
                                                               <<03001>>08390000
  I := 0;   <<START OF TABLE>>                                 <<03001>>08392000
  FIND'BRKPT := -1;   <<ASSUME THE WORST>>                     <<03001>>08394000
                                                               <<03001>>08396000
  DO                                                           <<03001>>08398000
    IF BPTAB (I+BP'TYPE'CST).BP'CST = CST AND                  <<03001>>08400000
       BPTAB (I+BP'TYPE'CST).BP'TYPE = TYPE AND                <<03001>>08402000
       BPTAB (I+BP'ADDR) = P                                   <<03001>>08404000
    THEN BEGIN                                                 <<03001>>08406000
       FIND'BRKPT := I;  <<RETURN INDEX>>                      <<03001>>08408000
       RETURN;                                                 <<03001>>08410000
     END                                                       <<03001>>08412000
  UNTIL (I:=I+BPT'ENTRY'SIZE) = BPT'TBL'SIZE;                  <<03001>>08414000
END;                                                           <<03001>>08416000
                                                               <<03001>>08418000
                                                               <<03001>>08420000
                                                               <<03001>>08422000
                                                               <<03001>>08424000
LOGICAL SUBROUTINE CHECK'BRKPT'INSTRUCTION;                    <<03001>>08426000
<<========================================>>                   <<03001>>08428000
BEGIN                                                          <<03001>>08430000
    <<THIS ROUTINE EXAMINES THE CODE INSTRUCTION >>            <<03001>>08432000
    <<CONTAINED IN GLOBAL VARIABLE: "BRKPT'INSTR">>            <<03001>>08434000
    <<IF THE INSTR CAN BE REPLACED BY A BRKPT,   >>            <<03001>>08436000
    <<THEN RETURNS TRUE ELSE FALSE.              >>            <<03001>>08438000
                                                               <<03001>>08440000
  CHECK'BRKPT'INSTRUCTION := FALSE;  <<ASSUME FAILURE>>        <<03001>>08442000
  IF BRKPT'INSTR.(0:4) = %14  <<BRANCHES>>                     <<03001>>08444000
  THEN RETURN;                                                 <<03001>>08446000
  IF BRKPT'INSTR.(0:4) = 3  AND                                <<03001>>08448000
     1 <= BRKPT'INSTR.(4:4) <= 4                               <<03001>>08450000
  THEN RETURN;                                                 <<03001>>08452000
  IF BRKPT'INSTR.(0:4) = 1                                     <<03001>>08454000
  THEN BEGIN                                                   <<03001>>08456000
     TOS := BRKPT'INSTR;                                       <<03001>>08458000
     TOS := %117001703D;                                       <<03001>>08460000
     TOS := TOS&DCSL(S2.(5:5));                                <<03001>>08462000
     IF <                                                      <<03001>>08464000
     THEN BEGIN                                                <<03001>>08466000
       DDEL; <<DELETE MAGIC CONSTANT>>                         <<03001>>08468000
       DEL;  <<DELETE INSTRUCTION>>                            <<03001>>08470000
       RETURN;                                                 <<03001>>08472000
      END;                                                     <<03001>>08474000
     DDEL;  <<DELETE MAGIC CONSTANT>>                          <<03001>>08476000
     DEL;   <<DELETE INSTRUCTION>>                             <<03001>>08478000
   END;                                                        <<03001>>08480000
                                                               <<03001>>08482000
   CHECK'BRKPT'INSTRUCTION := TRUE;                            <<03001>>08484000
      <<GETTING THIS FAR IMPLIES IT IS O.K.>>                  <<03001>>08486000
END;  <<SUBROUTINE CHECK'BRKPT'INSTR>>                         <<03001>>08488000
                                                               <<03001>>08490000
                                                               <<03001>>08492000
                                                               <<03001>>08494000
SUBROUTINE PUT'BRKPT'INTO'CODE;                                <<03001>>08496000
<<============================>>                               <<03001>>08498000
BEGIN                                                          <<03001>>08500000
                                                               <<03001>>08502000
  <<ASUMES THE FOLLOWING GLOBALS ARE LOADED:   >>              <<03001>>08504000
  <<   BRKPT'ADDR    ABS ADDR OF THE INSTR     >>              <<03001>>08506000
  <<   CST           SEGMENT NUMBER            >>              <<03001>>08508000
  <<   P             PB RELATIVE ADDR OF INSTR >>              <<03001>>08510000
  <<                                           >>              <<03001>>08512000
  <<LOADS A BRKPT INTO THE CODE                >>              <<03001>>08514000
                                                               <<03001>>08516000
                                                               <<03001>>08518000
   TOS := BRKPT'ADDR -                                         <<03001>>08520000
     DOUBLE(P)+DOUBLE(F(F(0)+CST*CST'SIZE).(4:12)*4)-1D;       <<03001>>08522000
   << THE ABOVE MONSTER IS THE ADDRESS OF PL >>                <<03001>>08524000
   << CHECK FOR P IN BOUNDS >>                                 <<03001>>08526000
   IF  BRKPT'ADDR > DS1                                        <<03001>>08528000
   THEN BEGIN                                                  <<03001>>08530000
      MOVE IO := "ADDRESS OUT OF BOUNDS";                      <<03001>>08532000
      BUFX := 21;                                              <<03001>>08534000
      PRINTLINE(0);                                            <<03001>>08536000
      DDEL;                                                    <<03001>>08538000
      RETURN;                                                  <<03001>>08540000
   END;                                                        <<03001>>08542000
                                                               <<03001>>08544000
   ASMB(LSEA);  << GET STT SIZE >>                             <<03001>>08546000
   X := TOS.(8:8);                                             <<03001>>08548000
   J :=  I := 0;  << INITIAL PL VALUES >>                      <<03001>>08550000
   DO                                                          <<03001>>08552000
      BEGIN  << SEARCH THE STT >>                              <<03001>>08554000
      I := I+1;                                                <<03001>>08556000
      S0 := S0-1;  << BACK UP ADDRESS POINTER >>               <<03001>>08558000
      ASMB(LSEA);  << GET THE LABEL >>                         <<03001>>08560000
      IF  TOS = @HELP  THEN  J := I;  << FOUND IT >>           <<03001>>08562000
      END                                                      <<03001>>08564000
   UNTIL  DXBZ;                                                <<03001>>08566000
   PUSH(STATUS);  IF  TOS.(8:8) = CST  THEN  J := @HELP.(1:7); <<03001>>08568000
   IF  J = 0                                                   <<03001>>08570000
   THEN BEGIN                                                  <<03001>>08572000
      MOVE IO:="BRKPT NOT SET";                                <<03001>>08574000
      BUFX := 13;                                              <<03001>>08576000
      PRINTLINE(0);                                            <<03001>>08578000
      DDEL;                                                    <<03001>>08580000
      RETURN;                                                  <<03001>>08582000
    END;                                                       <<03001>>08584000
                                                               <<03001>>08586000
   DDEL;  << GET RID OF THE ADDRESS INTO THE STT >>            <<03001>>08588000
                                                               <<03001>>08590000
   TOS := BRKPT'ADDR;   <<ABS ADDR OF INSTRUCTION TO REPLACE>> <<03001>>08592000
   TOS := J+%031000;    <<FORM THE PCAL TO HELP>>              <<03001>>08594000
   ASMB (SSEA);         <<STORE IT>>                           <<03001>>08596000
   DDEL;                <<GET RID OF THE ADDRESS>>             <<03001>>08598000
                                                               <<03001>>08600000
END;  <<SUBROUTINE PUT'BRKPT'INTO'CODE>>                       <<03001>>08602000
                                                               <<03001>>08604000
                                                               <<03001>>08606000
SUBROUTINE SET'BRKPT(TYPE'OF'BRKPT);                           <<03001>>08608000
<<===============================>>                            <<03001>>08610000
   VALUE TYPE'OF'BRKPT; INTEGER TYPE'OF'BRKPT;                 <<03001>>08612000
BEGIN                                                          <<03001>>08614000
  <<IF ROOM EXISTS IN THE BREAKPOINT TABLE, THIS WILL SET>>    <<03001>>08616000
  <<A BREAKPOINT AT A SPECIFIED "CST" AND "P".           >>    <<03001>>08618000
  <<AT ENTRY, THE FOLLOWING GLOBALS SHOULD BE LOADED:    >>    <<03001>>08620000
  <<   "CST"    THE CST FOR THE BREAKPOINT               >>    <<03001>>08622000
  <<   "P"      PB RELATIVE ADDRESS FOR THE BREAKPOINT   >>    <<03001>>08624000
  <<                                                     >>    <<03001>>08626000
  << IF THE CST IS PRESENT, THEN A  BREAKPOINT WILL      >>    <<03001>>08628000
  << BE SET, AND THE BREAK PUT INTO THE CODE SEGMENT .   >>    <<03001>>08630000
  << IF THE CST IS ABSENT, THEN AN ABSENT-BREAKPOINT WILL>>    <<03001>>08632000
  << BE LOADED INTO THE BREAKPOINT TABLE, AND AS SOON AS >>    <<03001>>08634000
  << THE SEGMENT IS MADE PRESENT, THE ACTUAL BREAK WILL  >>    <<03001>>08636000
  << BE LOADED INTO THE CODE.                            >>    <<03001>>08638000
                                                               <<03001>>08640000
                                                               <<03001>>08642000
                         <<MAKE SURE WE HAVE ROOM IN TABLE>>   <<03001>>08644000
                         <<-------------------------------->>  <<03001>>08646000
                                                               <<03001>>08648000
  IF NUM'BRKPTS >= MAX'BRKPTS -1 <<NO ROOM IN BREAKPOINT TBL>> <<03001>>08650000
  THEN BEGIN                                                   <<03001>>08652000
     MOVE IO := "FULL";                                        <<03001>>08654000
     BUFX := 4;                                                <<03001>>08656000
     PRINTLINE (0);                <<PRINT FULL ERROR>>        <<03001>>08658000
     RETURN;                                                   <<03001>>08660000
   END;                                                        <<03001>>08662000
                                                               <<03001>>08664000
                         <<TRY TO LOCATE EXISTING BREAKPOINT>> <<03001>>08666000
                         <<--------------------------------->> <<03001>>08668000
                                                               <<03001>>08670000
  BRKPT'INX := FIND'BRKPT( TYPE'OF'BRKPT,CST,P); <<EXISTING?>> <<03001>>08672000
  IF BRKPT'INX <> -1     <<IF IT EXISTS,THEN ERROR>>           <<03001>>08674000
  THEN BEGIN                                                   <<03001>>08676000
    MOVE IO := "ALREADY SET";                                  <<03001>>08678000
    BUFX := 11;                                                <<03001>>08680000
    PRINTLINE (0);                 <<PRINT ALREADY SET ERROR>> <<03001>>08682000
    RETURN;                                                    <<03001>>08684000
   END;                                                        <<03001>>08686000
                                                               <<03001>>08688000
                        <<GET FREE ENTRY FROM BRKPT-TABLE>>    <<03001>>08690000
                        <<------------------------------->>    <<03001>>08692000
                                                               <<03001>>08694000
  TOS := (IF TYPE'OF'BRKPT = FAKE'BRKPT                        <<03001>>08696000
          THEN FAKE'BRKPT     <<ALLOC THE FAKE>>               <<03001>>08698000
          ELSE EMPTY'BRKPT);  <<EMPTY BRKPT>>                  <<03001>>08700000
                                                               <<03001>>08702000
  BRKPT'INX := FIND'BRKPT( S0 <<TYPE>>,0,0); <<ALLOC A BRKPT>> <<03001>>08704000
  IF BRKPT'INX = -1    <<SOMETHING SCREWED UP WITH COUNT>>     <<03001>>08706000
  THEN BEGIN                                                   <<03001>>08708000
    DEL;    <<DELETE THE TYPE>>                                <<03001>>08710000
    MOVE IO := "FULL";                                         <<03001>>08712000
    BUFX := 4;                                                 <<03001>>08714000
    PRINTLINE(0);                                              <<03001>>08716000
    RETURN;                                                    <<03001>>08718000
  END;                                                         <<03001>>08720000
  DEL;   <<DELETE THE TYPE>>                                   <<03001>>08722000
                                                               <<03001>>08724000
                         <<CHECK TO SEE IF SEGMENT IS ABSENT>> <<03001>>08726000
                         <<--------------------------------->> <<03001>>08728000
                                                               <<03001>>08730000
  IF ABSENT'CST( CST )    <<IS SEGMENT ABSENT? >>              <<03001>>08732000
  THEN BEGIN                                                   <<03001>>08734000
    BRKPT'TYPE := USER'BRKPT;   <<WILL SET ABSENT-BRKPT>>      <<03001>>08736000
     <<WE WILL ALWAYS CHECK TO SEE IF SEG IS STILL PRESENT>>   <<03001>>08738000
    BRKPT'INSTR := -1;             <<DONT CARE ABOUT INSTR>>   <<03001>>08740000
    MOVE IO := "BRKPT SET FOR ABSENT SEGMENT";                 <<03001>>08742000
    BUFX := 24;                                                <<03001>>08744000
    PRINTLINE (0);                                             <<03001>>08746000
    END                                                        <<03001>>08748000
  ELSE BEGIN    <<SEGMENT IS IN CORE>>                         <<03001>>08750000
    BRKPT'TYPE := TYPE'OF'BRKPT;   <<USER OR FAKE BRKPT>>      <<03001>>08752000
                                                               <<03001>>08754000
    BRKPT'ADDR := CST'ADDR( CST) + DOUBLE(P);                  <<03001>>08756000
                <<DETERMINE ABS ADDR OF INSTRUCTION>>          <<03001>>08758000
                                                               <<03001>>08760000
    TOS := BRKPT'ADDR;    <<ABS ADDR OF INSTR TO REPLACE>>     <<03001>>08762000
    ASMB (LSEA);          <<GET THE INSTRUCTION>>              <<03001>>08764000
    BRKPT'INSTR := TOS;    <<SAVE THE INSTR>>                  <<03001>>08766000
    DDEL;                 <<DELETE ADDR OF INSTR>>             <<03001>>08768000
                                                               <<03001>>08770000
                          <<CAN WE SET BREAKPOINT AT THIS>>    <<03001>>08772000
                          <<PARTICULAR INSTR IN THE CODE>>     <<03001>>08774000
                          <<IF NOT PRINT ERROR>>               <<03001>>08776000
    IF TYPE'OF'BRKPT = USER'BRKPT  AND   <<ON USER BP >>       <<03001>>08778000
       NOT CHECK'BRKPT'INSTRUCTION    <<CHECK OUT INSTR>>      <<03001>>08780000
    THEN BEGIN                                                 <<03001>>08782000
      MOVE IO := "BAD INSTR FOR BRKPT AT: ";                   <<03001>>08784000
      BUFX := 24;                                              <<03001>>08786000
      OCTNUMOUT(DOUBLE(CST),2);                                <<03001>>08788000
      MOVE IO(BUFX) := ".";                                    <<03001>>08790000
      BUFX := BUFX + 1;                                        <<03001>>08792000
      OCTNUMOUT(DOUBLE(P),5);                                  <<03001>>08794000
      PRINTLINE (0);      <<PRINT ERROR>>                      <<03001>>08796000
      RETURN;                                                  <<03001>>08798000
    END;                                                       <<03001>>08800000
                                                               <<03001>>08802000
                         <<PUT BREAKPOINT INTO CODE SEGMENT>>  <<03001>>08804000
                         <<-------------------------------->>  <<03001>>08806000
                                                               <<03001>>08808000
    PUT'BRKPT'INTO'CODE;                                       <<03001>>08810000
                                                               <<03001>>08812000
 END;  <<SEGMENT IS IN CORE>>                                  <<03001>>08814000
                                                               <<03001>>08816000
                         <<LOAD BREAKPOINT TABLE ENTRY>>       <<03001>>08818000
                         <<--------------------------->>       <<03001>>08820000
                                                               <<03001>>08822000
 BPTAB( BRKPT'INX + BP'TYPE'CST).BP'TYPE := BRKPT'TYPE;        <<03001>>08824000
                         <<LOAD TYPE OF BREAKPOINT>>           <<03001>>08826000
                                                               <<03001>>08828000
 BPTAB( BRKPT'INX + BP'TYPE'CST).BP'CST := CST;                <<03001>>08830000
                         <<LOAD CST FOR BREAKPOINT>>           <<03001>>08832000
                                                               <<03001>>08834000
 BPTAB( BRKPT'INX + BP'ADDR) := P;                             <<03001>>08836000
                         <<LOAD P FOR BREAKPOINT>>             <<03001>>08838000
                                                               <<03001>>08840000
 BPTAB( BRKPT'INX + BP'INSTR) := BRKPT'INSTR;                  <<03001>>08842000
                         <<LOAD REPLACED INSTR>>               <<03001>>08844000
                                                               <<03001>>08846000
 NUM'BRKPTS := NUM'BRKPTS + 1;   <<ONE LESS FREE ENTRY>>       <<03001>>08848000
                                                               <<03001>>08850000
END;  <<SUBROUTINE BREAK>>                                     <<03001>>08852000
                                                               <<03001>>08854000
                                                               <<03001>>08856000
SUBROUTINE CLEAR'BRKPT( TYPE'OF'BRKPT);                        <<03001>>08858000
<<===================================>>                        <<03001>>08860000
   VALUE TYPE'OF'BRKPT; INTEGER TYPE'OF'BRKPT;                 <<03001>>08862000
BEGIN                                                          <<03001>>08864000
                                                               <<03001>>08866000
  <<THIS ROUTINE WILL CLEAR A BREAKPOINT.                >>    <<03001>>08868000
  <<AT ENTRY, THE FOLLOWING GLOBALS SHOULD BE LOADED:    >>    <<03001>>08870000
  <<   "CST"    THE CST FOR THE BRKPT TO BE CLEARED      >>    <<03001>>08872000
  <<   "P"      PB RELATIVE ADDRESS FOR THE BREAKPOINT   >>    <<03001>>08874000
  <<                                                     >>    <<03001>>08876000
  << IF THE SEGMENT IS STILL PRESENT, THEN THE REPLACED  >>    <<03001>>08878000
  << INSTRUCTION WILL BE RESTORED, AND THE ENTRY IN THE  >>    <<03001>>08880000
  << BREAKPOINT TABLE WILL BE CLEARED.                   >>    <<03001>>08882000
  << IF THE CST IS ABSENT, THEN THE ENTRY IN THE TABLE   >>    <<03001>>08884000
  << WILL BE CLEARED. WHEN THE SEMENT IS LATER MADE      >>    <<03001>>08886000
  << PRESENT, IT WILL BE BROUGHT INTO CORE IN ITS        >>    <<03001>>08888000
  << ORIGINAL  (BREAKPOINT-LESS) CONDITION.              >>    <<03001>>08890000
                                                               <<03001>>08892000
  BRKPT'INX := FIND'BRKPT( TYPE'OF'BRKPT,CST,P);               <<03001>>08894000
  IF BRKPT'INX = -1    <<NOT FOUND>>                           <<03001>>08896000
  THEN BEGIN                                                   <<03001>>08898000
     MOVE IO := "NOT FOUND";                                   <<03001>>08900000
     BUFX := 9;                                                <<03001>>08902000
     PRINTLINE (0);                                            <<03001>>08904000
     RETURN;                                                   <<03001>>08906000
   END;                                                        <<03001>>08908000
                                                               <<03001>>08910000
  IF NOT ABSENT'CST(CST)    <<HAS SEGMENT BEEN SWAPPED>>       <<03001>>08912000
  THEN BEGIN                                                   <<03001>>08914000
                 <<BRKPT IS SET IN CODE-REPLACE INSTR>>        <<03001>>08916000
     TOS := CST'ADDR(CST) + DOUBLE (P);                        <<03001>>08918000
                 <<ABSOLUTE ADDR OF INSTR TO REPLACE>>         <<03001>>08920000
                                                               <<03001>>08922000
     TOS := BPTAB(BRKPT'INX+BP'INSTR);  <<INSTRUCTION>>        <<03001>>08924000
     ASMB (SSEA);   <<RESTORE ORIGINAL INSTRUCTION>>           <<03001>>08926000
     DDEL;          <<DELETE ADDRESS>>                         <<03001>>08928000
   END;                                                        <<03001>>08930000
                                                               <<03001>>08932000
         <<IF WE CLEAR THE FAKE BREAKPOINT, THEN WE MUST>>     <<03001>>08934000
         <<LEAVE THE TYPE AS FAKE'BRKPT, SINCE THE FAKE >>     <<03001>>08936000
         <<MUST REMAIN AS THE FIRST ENTRY, USED OR NOT  >>     <<03001>>08938000
                                                               <<03001>>08940000
  BPTAB(BRKPT'INX+BP'TYPE'CST).BP'TYPE :=                      <<03001>>08942000
     ( IF TYPE'OF'BRKPT = FAKE'BRKPT                           <<03001>>08944000
       THEN FAKE'BRKPT                                         <<03001>>08946000
       ELSE EMPTY'BRKPT );                                     <<03001>>08948000
                                                               <<03001>>08950000
  BPTAB(BRKPT'INX+BP'TYPE'CST).BP'CST := EMPTY'BRKPT;          <<03001>>08952000
  BPTAB(BRKPT'INX+BP'ADDR)     := EMPTY'BRKPT;                 <<03001>>08954000
  BPTAB(BRKPT'INX+BP'INSTR) := <<EMPTY'BRKPT>> %5555;          <<03001>>08956000
         <<CLEAR TYPE,CST,ADDR, & INSTR IN BREAKPOINT TBL>>    <<03001>>08958000
                                                               <<03001>>08960000
  NUM'BRKPTS := NUM'BRKPTS -1 ;  <<FREE THE ENTRY>>            <<03001>>08962000
                                                               <<03001>>08964000
END;                                                           <<03001>>08966000
                                                               <<03001>>08968000
                                                               <<03001>>08970000
                                                               <<03001>>08972000
SUBROUTINE BRKPT'MAKE'PRESENT;                                 <<03001>>08974000
<<===========================>>                                <<03001>>08976000
BEGIN                                                          <<03001>>08978000
  <<PROCEDURE MAKE'PRESENT PUSHED THE NEW SEG NUMBER>>         <<03001>>08980000
  <<PRIOR TO CALLING HELP.  NEW'PRESENT'SEG = Q-4     >>       <<03001>>08982000
  << ALL BREAKPOINT ENTRIES (FOR THE PREV ABSENT SEG) >>       <<03001>>08984000
  << IN THE BREAKPOINT TABLE WHICH ARE SET FOR THAT   >>       <<03001>>08986000
  << SEGMENT  (USER OR ABSENT) WILL BE RESET FOR THIS >>       <<03001>>08988000
  << FRESH NEW SEGMENT OF THE CODE                    >>       <<03001>>08990000
                                                               <<03001>>08992000
                                                               <<03001>>08994000
  CST := NEW'PRESENT'SEG;    <<PASSED BY MAKE'PRESENT>>        <<03001>>08996000
         <<LOCATED AT Q-4>>                                    <<03001>>08998000
                                                               <<03001>>09000000
                                                               <<03001>>09002000
IF BP'DEBUG = 1                                                <<03001>>09004000
THEN BEGIN                                                     <<03001>>09006000
MOVE IO:="SEG: ";                                              <<03001>>09008000
BUFX :=5;                                                      <<03001>>09010000
OCTNUMOUT(DOUBLE(CST),2);                                      <<03001>>09012000
PRINTLINE(0);        <<   DEBUGGING !!!!!!!!    >>             <<03001>>09014000
END;                                                           <<03001>>09016000
                                                               <<03001>>09018000
  BRKPT'INX := 0;    <<START AT BEGINNING OF BPTAB>>           <<03001>>09020000
                                                               <<03001>>09022000
  DO BEGIN           <<SEARCH THE BREAKPOINT TABLE>>           <<03001>>09024000
                                                               <<03001>>09026000
     TOS := BRKPT'INX;     <<SAVE THE GLOBAL INDEX>>           <<03001>>09028000
                                                               <<03001>>09030000
     IF BPTAB(BRKPT'INX+BP'TYPE'CST).BP'CST=CST <<SAME SEG?>>  <<03001>>09032000
        AND BPTAB(BRKPT'INX+BP'TYPE'CST).BP'TYPE<>FAKE'BRKPT   <<03001>>09034000
     THEN BEGIN    <<FOUND ONE TO CORRECT>>                    <<03001>>09036000
                                                               <<03001>>09038000
        P := BPTAB(BRKPT'INX + BP'ADDR);  <<GET ADDR>>         <<03001>>09040000
                                                               <<03001>>09042000
        IF BP'DEBUG = 1   <<DEBUGGING>>                        <<03001>>09044000
        THEN BEGIN                                             <<03001>>09046000
        MOVE IO := "    BRKPT AT P: ";                         <<03001>>09048000
        BUFX := 16;                                            <<03001>>09050000
        OCTNUMOUT(DOUBLE(P),5);                                <<03001>>09052000
        PRINTLINE(0);                                          <<03001>>09054000
          END;                                                 <<03001>>09056000
                                                               <<03001>>09058000
                                                               <<03001>>09060000
        BPTAB (BRKPT'INX +BP'TYPE'CST) := EMPTY'BRKPT;         <<03001>>09062000
        BPTAB (BRKPT'INX +BP'ADDR)     := EMPTY'BRKPT;         <<03001>>09064000
        NUM'BRKPTS := NUM'BRKPTS - 1;                          <<03001>>09066000
           <<WE CANT USE CLEAR-BRKPT ROUTINE SINCE SEG >>      <<03001>>09068000
           <<IS PRESENT AND WE MIGHT ATTEMPT TO REPLACE>>      <<03001>>09070000
           <<THE ORIGINAL INSTRUCTION>>                        <<03001>>09072000
          <<CLEAR OUT THE OLD ENTRY IN THE TABLE>>             <<03001>>09074000
          <<WE WILL SET A NEW ONE>>                            <<03001>>09076000
                                                               <<03001>>09078000
        SET'BRKPT (USER'BRKPT);    <<SET A NEW BREAKPOINT>>    <<03001>>09080000
           <<WE KNOW SEG IS PRESENT, AND TABLE HAS ROOM>>      <<03001>>09082000
           <<FOR THIS NEW ENRTY>>                              <<03001>>09084000
           <<WE HOPE IT IS A LEGAL INSTR FOR A BRKPT>>         <<03001>>09086000
                                                               <<03001>>09088000
      END;  <<WE FOUND AN ENRTY IN SEG TO CORRECT>>            <<03001>>09090000
                                                               <<03001>>09092000
    BRKPT'INX := TOS + BPT'ENTRY'SIZE;                         <<03001>>09094000
         <<RESTORE AND ADVANCE THE TABLE INDEX>>               <<03001>>09096000
                                                               <<03001>>09098000
  END UNTIL BRKPT'INX = BPT'TBL'SIZE;                          <<03001>>09100000
                                                               <<03001>>09102000
END;  <<SUBROUTINE BRKPT'MAKE'PRESENT>>                        <<03001>>09104000
                                                               <<03001>>09106000
                                                               <<03001>>09108000
                                                               <<03001>>09110000
SUBROUTINE BRKPT'MAKE'ABSENT;                                  <<03001>>09112000
<<===========================>>                                <<03001>>09114000
BEGIN                                                          <<03001>>09116000
   <<INITIAL WRITES ITSELF TO DISC, HOPEFULLY WITHOUT BRKPTS>> <<03001>>09118000
   <<THREFORE IT CALL BRKPT-MAKE-ABSENT TO CLEAN UP A COPY>>   <<03001>>09120000
   <<OF A SEG MENT BEFORE WRITING IT TO DISC>>                 <<03001>>09122000
   << AT ENTRY:   Q-5 = 0   (FOR BRKPT MAKE ABSENT) >>         <<03001>>09124000
   <<             Q-4 = SEGMENT NUMBER TO CLEAR>>              <<03001>>09126000
                                                               <<03001>>09128000
                                                               <<03001>>09130000
                                                               <<03001>>09132000
  CST := NEW'PRESENT'SEG;    <<PASSED BY MAKE'PRESENT>>        <<03001>>09134000
         <<LOCATED AT Q-4>>                                    <<03001>>09136000
                                                               <<03001>>09138000
IF BP'DEBUG=1 THEN BEGIN <<DEBUGGING>>                         <<03001>>09140000
MOVE IO:="CLEARING SEG: ";                                     <<03001>>09142000
BUFX :=14;                                                     <<03001>>09144000
OCTNUMOUT(DOUBLE(CST),2);                                      <<03001>>09146000
PRINTLINE(0);        <<   DEBUGGING !!!!!!!!    >>             <<03001>>09148000
END;  <<DEBUGGING>>                                            <<03001>>09150000
  BRKPT'INX := 0;    <<START AT BEGINNING OF BPTAB>>           <<03001>>09152000
                                                               <<03001>>09154000
  DO BEGIN           <<SEARCH THE BREAKPOINT TABLE>>           <<03001>>09156000
                                                               <<03001>>09158000
     TOS := BRKPT'INX;     <<SAVE THE GLOBAL INDEX>>           <<03001>>09160000
                                                               <<03001>>09162000
     IF BPTAB(BRKPT'INX+BP'TYPE'CST).BP'CST=CST <<SAME SEG?>>  <<03001>>09164000
        AND BPTAB(BRKPT'INX+BP'TYPE'CST).BP'TYPE=USER'BRKPT    <<03001>>09166000
     THEN BEGIN    <<FOUND ONE TO CLEAR>>                      <<03001>>09168000
                                                               <<03001>>09170000
        P := BPTAB(BRKPT'INX + BP'ADDR);  <<GET ADDR>>         <<03001>>09172000
        IF BP'DEBUG=1 THEN BEGIN  <<DEBUGGING>>                <<03001>>09174000
        MOVE IO := "    BRKPT AT P: ";                         <<03001>>09176000
        BUFX := 16;                                            <<03001>>09178000
        OCTNUMOUT(DOUBLE(P),5);  END; <<DEBUGGING>>            <<03001>>09180000
        IF NOT ABSENT'CST(CST)                                 <<03001>>09182000
        THEN BEGIN                                             <<03001>>09184000
           TOS := CST'ADDR(CST) +DOUBLE(P);                    <<03001>>09186000
           TOS := BPTAB(BRKPT'INX+BP'INSTR);  <<ORIG INSTR>>   <<03001>>09188000
           ASMB(SSEA);  DDEL;                                  <<03001>>09190000
         END;                                                  <<03001>>09192000
      END; <<FOUND ONE TO CLEAR>>                              <<03001>>09194000
    BRKPT'INX := TOS + BPT'ENTRY'SIZE;                         <<03001>>09196000
         <<RESTORE AND ADVANCE THE TABLE INDEX>>               <<03001>>09198000
  END UNTIL BRKPT'INX = BPT'TBL'SIZE;                          <<03001>>09200000
                                                               <<03001>>09202000
END;  <<SUBROUTINE BRKPT'MAKE'ABSENT>>                         <<03001>>09204000
                                                               <<03001>>09206000
$PAGE "HELP          MISC. SERVICE ROUTINES"                   <<03001>>09208000
                                                               <<03001>>09210000
SUBROUTINE DUMPER( ADDR, COUNT, WIDTH, MODE );                 <<03001>>09212000
<<===========================================>>                <<03001>>09214000
   VALUE ADDR,COUNT,WIDTH,MODE;                                <<03001>>09216000
   DOUBLE ADDR,COUNT;  INTEGER WIDTH,MODE;                     <<03001>>09218000
                                                               <<03001>>09220000
BEGIN                                                          <<03001>>09222000
   CASE MODE OF   <<NUMBER OF OUTPUT VALUES PER LINE>>         <<03001>>09224000
   BEGIN   <<BASED ON THE WIDTH OF OUTPUT AND TERMINAL WIDTH>> <<03001>>09226000
      <<0 OCTAL>>    L := 8;                                   <<03001>>09228000
      <<1 DEC  >>    L := 8;                                   <<03001>>09230000
      <<2 HEX  >>    L := 10;                                  <<03001>>09232000
      <<3 ASCII>>    L := 30;                                  <<03001>>09234000
      <<4 BINARY>>   L := 1;                                   <<03001>>09236000
   END;                                                        <<03001>>09238000
                                                               <<03001>>09240000
                                                               <<03001>>09242000
   DO BEGIN  <<DUMP ALL REQUESTED>>                            <<03001>>09244000
     J := 1;  <<RESET WIDTH COUNTER>>                          <<03001>>09246000
     DO BEGIN  <<DUMP A WIDTH'S WORTH>>                        <<03001>>09248000
                                                               <<03001>>09250000
        IF J = 1   <<FIRST PASS FOR WIDTHS WORTH>>             <<03001>>09252000
        THEN ADDROUT (ADDR)   <<OUTPUT THE START ADDRESS>>     <<03001>>09254000
        ELSE BLANKOUT ( 10 + BANK'BITS);  <<OUTPUT BLANKS>>    <<03001>>09256000
                                                               <<03001>>09258000
        IF MODE= ASCII'MODE                                    <<03001>>09260000
        THEN BEGIN                                             <<03001>>09262000
           IO(BUFX) := %42;   <<LOAD LEADING " >>              <<03001>>09264000
           BUFX := BUFX + 1;                                   <<03001>>09266000
        END;                                                   <<03001>>09268000
                                                               <<03001>>09270000
        I := 1;  <<RESET COUNTER FOR LINE>>                    <<03001>>09272000
        DO BEGIN  <<DUMP A LINES WORTH, "L" ENTRIES>>          <<03001>>09274000
           CUR'VALUE := DLSEA( ADDR );  <<GET VALUE FROM MEM>> <<03001>>09276000
           ADDR := ADDR + 1D;       <<READY FOR NEXT>>         <<03001>>09278000
           COUNT := COUNT -1D;      <<1 LESS TO DUMP>>         <<03001>>09280000
           J := J + 1;         << COUNTER FOR WIDTH >>         <<03001>>09282000
           I := I + 1;         << COUNTER FOR LINE >>          <<03001>>09284000
                                                               <<03001>>09286000
           CASE MODE OF                                        <<03001>>09288000
           BEGIN                                               <<03001>>09290000
             <<0 OCTAL>>  BEGIN                                <<03001>>09292000
                            OCTNUMOUT (CUR'VALUE,6);           <<03001>>09294000
                            BLANKOUT(2);                       <<03001>>09296000
                          END;                                 <<03001>>09298000
                                                               <<03001>>09300000
             <<1 DEC  >>  ;                                    <<03001>>09302000
             <<2 HEX  >>  ;                                    <<03001>>09304000
                                                               <<03001>>09306000
             <<4 ASCII>>  ASCIINUMOUT (CUR'VALUE);             <<03001>>09308000
                                                               <<03001>>09310000
             <<4 BINARY>> BEGIN                                <<03001>>09312000
                            OCTNUMOUT( CUR'VALUE,6);           <<03001>>09314000
                            BLANKOUT(3);                       <<03001>>09316000
                                                               <<03001>>09318000
                            BYTESOUT( CUR'VALUE);              <<03001>>09320000
                            BLANKOUT(3);                       <<03001>>09322000
                                                               <<03001>>09324000
                            BITSOUT (CUR'VALUE);               <<03001>>09326000
                          END;                                 <<03001>>09328000
                                                               <<03001>>09330000
           END;  <<CASE>>                                      <<03001>>09332000
          END  <<DUMP A LINES WORTH>>                          <<03001>>09334000
        UNTIL (I>L) OR (J>WIDTH)  OR (COUNT = 0D);             <<03001>>09336000
                                                               <<03001>>09338000
        IF MODE = ASCII'MODE                                   <<03001>>09340000
        THEN BEGIN                                             <<03001>>09342000
           IO(BUFX) := %42;  <<LOAD TRAILING " >>              <<03001>>09344000
           BUFX := BUFX + 1;                                   <<03001>>09346000
        END;                                                   <<03001>>09348000
                                                               <<03001>>09350000
        PRINTLINE(0);  <<OUTPUT THE BUFFER,CR-LF, RESET BUFX>> <<03001>>09352000
                                                               <<03001>>09354000
     END UNTIL (J>WIDTH) <<WIDTHS WORTH>> OR (COUNT=0D);       <<03001>>09356000
  END UNTIL COUNT = 0D;  <<REQUESTED AMOUNT DUMPED>>           <<03001>>09358000
                                                               <<03001>>09360000
END;  <<SUBROUTINE DUMPER>>                                    <<03001>>09362000
                                                               <<03001>>09364000
                                                               <<03001>>09366000
SUBROUTINE MODIFIER (ADDR,COUNT);                              <<03001>>09368000
<<==============================>>                             <<03001>>09370000
    VALUE ADDR,COUNT;  DOUBLE ADDR,COUNT;                      <<03001>>09372000
BEGIN                                                          <<03001>>09374000
                                                               <<03001>>09376000
    WHILE COUNT > 0D DO                                        <<03001>>09378000
    BEGIN                                                      <<03001>>09380000
        ADDROUT( ADDR);   <<SHOW ADDRESS>>                     <<03001>>09382000
                                                               <<03001>>09384000
        CUR'VALUE := DLSEA(ADDR);  <<GET EXISTING VALUE>>      <<03001>>09386000
        OCTNUMOUT (CUR'VALUE,6);   <<PRINT IT>>                <<03001>>09388000
        MOVE IO(BUFX) := " _"; <<MODIFY PROMPT>>               <<03001>>09390000
        BUFX := BUFX + 2;      <<BUMP BUFX>>                   <<03001>>09392000
        PRINTLINE ( 1 );    <<STAY ON SAME LINE >>             <<03001>>09394000
                                                               <<03001>>09396000
        TOS := OLDDB;                                          <<03001>>09398000
        ASMB(XCHD);                                            <<03001>>09400000
        READINPUT(INBUF);                                      <<03001>>09402000
        PIN := 0;                                              <<03001>>09404000
        SET (DB);                                              <<03001>>09406000
        CHAR;                                                  <<03001>>09408000
                                                               <<03001>>09410000
        TOS := ADDR;           <<PUSH ADDRESS>>                <<03001>>09412000
        TOS := EXP;            <<GET NEW VALUE>>               <<03001>>09414000
        DELB;                  <<SHORTEN IT>>                  <<03001>>09416000
        ASMB( SSEA);           <<STORE IT>>                    <<03001>>09418000
        DDEL;                  <<DELETE ADDRESS>>              <<03001>>09420000
                                                               <<03001>>09422000
        ADDR := ADDR + 1D;     <<BUMP TO NEXT WORD>>           <<03001>>09424000
        COUNT := COUNT-1D;     <<ONE LESS TO GO>>              <<03001>>09426000
    END;  <<WHILE COUNT > 0>>                                  <<03001>>09428000
END;  <<SUBROUTINE MODIFIER>>                                  <<03001>>09430000
                                                               <<03001>>09432000
                                                               <<03001>>09434000
                                                               <<03001>>09436000
SUBROUTINE  EXIT;                                              <<03001>>09438000
<<==============>>                                             <<03001>>09440000
     <<RETURNS TO THE USER PROGRAM >>                          <<03001>>09442000
 BEGIN                                                         <<03001>>09444000
   P := ENTRY'P;   <<RESTORE ENTRY VALUES FOR P,CST>>          <<03001>>09446000
   CST := ENTRY'CST;                                           <<03001>>09448000
                                                               <<03001>>09450000
      <<WE WERE POSSIBLY STOPPED AT A USER BREAKPOINT>>        <<03001>>09452000
      <<WHEN WE FIRST ENTERED HELP, AND SHOULD RESTORE>>       <<03001>>09454000
      <<THE ORIG INSTRUCTION.  HOWEVER, DURING THE LAST>>      <<03001>>09456000
      <<SESSION OF USER INTERACTION, THAT VERY BRKPT>>         <<03001>>09458000
      <<COULD HAVE BEEN CLEARED, SO WE MUST CHECK NOW>>        <<03001>>09460000
                                                               <<03001>>09462000
   ENTRY'BRKPT'INX := FIND'BRKPT(USER'BRKPT,CST,P);            <<03001>>09464000
   IF ENTRY'BRKPT'INX <> -1                                    <<03001>>09466000
   THEN BEGIN  <<YES, A USER BRKPT>>                           <<03001>>09468000
                                                               <<03001>>09470000
      <<WE MUST RESTORE THE INSTRUCTION SO EXECUTION CAN >>    <<03001>>09472000
      <<BE RESUMED "THRU" THE BRKPT. WE WILL SET A FAKE >>     <<03001>>09474000
      <<BRKPT AT P+1 (THE NEXT INSTR), AND WHEN WE BREAK>>     <<03001>>09476000
      <<THERE, REINSERT THE USER BRKPT AT P.            >>     <<03001>>09478000
                                                               <<03001>>09480000
      TOS := CST'ADDR( CST) + DOUBLE(P);                       <<03001>>09482000
      TOS := BPTAB(ENTRY'BRKPT'INX + BP'INSTR);                <<03001>>09484000
             <<RESTORE INSTRUCTION AT THE USER-BRKPT>>         <<03001>>09486000
      ASMB(SSEA);  DDEL;                                       <<03001>>09488000
      P := P+1;  << SET A FAKE BREAKPOINT >>                   <<03001>>09490000
      SET'BRKPT(FAKE'BRKPT);                                   <<03001>>09492000
    END;  <<USER BREKPOINT AT ENRTY>>                          <<03001>>09494000
                                                               <<03001>>09496000
   SAVE'BRKPT'TABLE;   <<COPY FROM Q-REL BACK INTO CODE SEG>>  <<03001>>09498000
                                                               <<03001>>09500000
   ASMB( EXIT 0 );                                             <<03001>>09502000
   END;                                                        <<03001>>09504000
                                                               <<03001>>09506000
SUBROUTINE LIST;                                               <<03001>>09508000
<<=============>>                                              <<03001>>09510000
    <<LIST USER SET BREAKPOINTS>>                              <<03001>>09512000
BEGIN                                                          <<03001>>09514000
                                                               <<03001>>09516000
   I := BRKPT'INX := 0;                                        <<03001>>09518000
   DO                                                          <<03001>>09520000
     IF BPTAB(BRKPT'INX+BP'TYPE'CST).BP'TYPE = USER'BRKPT      <<03001>>09522000
     THEN BEGIN                                                <<03001>>09524000
        CST := BPTAB(BRKPT'INX+BP'TYPE'CST).BP'CST;            <<03001>>09526000
        OCTNUMOUT( DOUBLE(CST),3);                             <<03001>>09528000
        MOVE IO(BUFX) := ".";                                  <<03001>>09530000
        BUFX := BUFX+1;                                        <<03001>>09532000
        TOS := DOUBLE(BPTAB(BRKPT'INX+BP'ADDR));               <<03001>>09534000
        OCTNUMOUT( *,5);                                       <<03001>>09536000
        IF ABSENT'CST (CST)                                    <<03001>>09538000
        THEN BEGIN                                             <<03001>>09540000
           MOVE IO(BUFX) := " A";                              <<03001>>09542000
           BUFX := BUFX + 2;                                   <<03001>>09544000
         END;                                                  <<03001>>09546000
        PRINTLINE (0);                                         <<03001>>09548000
        END                                                    <<03001>>09550000
     UNTIL (BRKPT'INX:=BRKPT'INX+BPT'ENTRY'SIZE)=BPT'TBL'SIZE; <<03001>>09552000
END;                                                           <<03001>>09554000
                                                               <<03001>>09556000
                                                               <<03001>>09558000
                                                               <<03001>>09560000
SUBROUTINE STACKTRACE;                                         <<03001>>09562000
<<===================>>                                        <<03001>>09564000
BEGIN                                                          <<03001>>09566000
    PUSH(SBANK);       <<GET STACK BANK>>                      <<03001>>09568000
    PUSH(DB);                                                  <<03001>>09570000
    DELB;              <<DELETE DB-BANK>>                      <<03001>>09572000
    PUSH(Q);           <<DB RELATIVE Q>>                       <<03001>>09574000
    TOS := TOS+TOS;    <<ABS ADDR OF Q>>                       <<03001>>09576000
    K := TOS;          <<KEEP IN DOUBLE K>>                    <<03001>>09578000
                                                               <<03001>>09580000
    DO BEGIN                                                   <<03001>>09582000
        DUMPER(K-3D,4D,4,OCTAL'MODE);   <<DUMP A MARKER>>      <<03001>>09584000
        K := K - DLSEA(K);   <<LINK BACK>>                     <<03001>>09586000
    END UNTIL DLSEA(K) =0D;                                    <<03001>>09588000
END;                                                           <<03001>>09590000
                                                               <<03001>>09592000
                                                               <<03001>>09594000
SUBROUTINE EXPRESSION;                                         <<03001>>09596000
<<===================>>                                        <<03001>>09598000
BEGIN                                                          <<03001>>09600000
   CASE MODE OF                                                <<03001>>09602000
   BEGIN                                                       <<03001>>09604000
     <<0 OCTAL>>  BEGIN                                        <<03001>>09606000
                    OCTNUMOUT (P1,6);                          <<03001>>09608000
                    BLANKOUT(2);                               <<03001>>09610000
                  END;                                         <<03001>>09612000
                                                               <<03001>>09614000
     <<1 DEC  >>  ;                                            <<03001>>09616000
     <<2 HEX  >>  ;                                            <<03001>>09618000
                                                               <<03001>>09620000
     <<4 ASCII>>  ASCIINUMOUT (P1);                            <<03001>>09622000
                                                               <<03001>>09624000
     <<4 BINARY>> BEGIN                                        <<03001>>09626000
                    OCTNUMOUT( P1,6);                          <<03001>>09628000
                    BLANKOUT(3);                               <<03001>>09630000
                                                               <<03001>>09632000
                    BYTESOUT( P1);                             <<03001>>09634000
                    BLANKOUT(3);                               <<03001>>09636000
                                                               <<03001>>09638000
                    BITSOUT (P1);                              <<03001>>09640000
                  END;                                         <<03001>>09642000
    END;  <<CASE>>                                             <<03001>>09644000
    PRINTLINE(0);                                              <<03001>>09646000
END;                                                           <<03001>>09648000
                                                               <<03001>>09650000
                                                               <<03001>>09652000
SUBROUTINE BREAK'COMMAND;                                      <<03001>>09654000
<<=====================>>                                      <<03001>>09656000
BEGIN                                                          <<03001>>09658000
    GETP1;                                                     <<03001>>09660000
    IF TOKEN <> %15 THEN FAIL;                                 <<03001>>09662000
    IMPCST;   <<SET UP CST AND P >>                            <<03001>>09664000
    SET'BRKPT( USER'BRKPT);                                    <<03001>>09666000
                                                               <<03001>>09668000
END;                                                           <<03001>>09670000
                                                               <<03001>>09672000
SUBROUTINE CLEAR'COMMAND;                                      <<03001>>09674000
<<======================>>                                     <<03001>>09676000
BEGIN                                                          <<03001>>09678000
    GETP1;                                                     <<03001>>09680000
    IF TOKEN <> %15 THEN FAIL;                                 <<03001>>09682000
    IMPCST;    <<SET UP CST AND P >>                           <<03001>>09684000
    CLEAR'BRKPT(USER'BRKPT);                                   <<03001>>09686000
END;                                                           <<03001>>09688000
                                                               <<03001>>09690000
SUBROUTINE DUMP'COMMAND;                                       <<03001>>09692000
<<====================>>                                       <<03001>>09694000
BEGIN                                                          <<03001>>09696000
    P2 := 1D;  <<DEFAULT TO DUMP LENGTH=1>>                    <<03001>>09698000
    WIDTH := 8;  MODE := OCTAL'MODE;                           <<03001>>09700000
    GETP1;                                                     <<03001>>09702000
    GETP2;                                                     <<03001>>09704000
                                                               <<03001>>09706000
    GETMODE;                                                   <<03001>>09708000
    GETWIDTH;                                                  <<03001>>09710000
    GETMODE;                                                   <<03001>>09712000
    IF TOKEN <> %15 THEN FAIL;                                 <<03001>>09714000
                                                               <<03001>>09716000
    DUMPER (P1,P2, WIDTH,MODE);                                <<03001>>09718000
END;                                                           <<03001>>09720000
                                                               <<03001>>09722000
SUBROUTINE LIST'COMMAND;                                       <<03001>>09724000
<<====================>>                                       <<03001>>09726000
BEGIN                                                          <<03001>>09728000
    IF TOKEN <> %15 THEN FAIL;                                 <<03001>>09730000
    LIST;                                                      <<03001>>09732000
END;                                                           <<03001>>09734000
                                                               <<03001>>09736000
SUBROUTINE MODIFY'COMMAND;                                     <<03001>>09738000
<<=======================>>                                    <<03001>>09740000
BEGIN                                                          <<03001>>09742000
    P2 := 1D;   <<DEFAULT TO MODIFY LENGTH = 1>>               <<03001>>09744000
    GETP1;                                                     <<03001>>09746000
    GETP2;                                                     <<03001>>09748000
    IF TOKEN <> %15 THEN FAIL;                                 <<03001>>09750000
                                                               <<03001>>09752000
    MODIFIER(P1,P2);                                           <<03001>>09754000
END;                                                           <<03001>>09756000
                                                               <<03001>>09758000
SUBROUTINE EXIT'COMMAND;                                       <<03001>>09760000
<<=====================>>                                      <<03001>>09762000
BEGIN                                                          <<03001>>09764000
    IF TOKEN <> %15 THEN FAIL;                                 <<03001>>09766000
    EXIT;                                                      <<03001>>09768000
END;                                                           <<03001>>09770000
                                                               <<03001>>09772000
SUBROUTINE TRACE'COMMAND;                                      <<03001>>09774000
<<======================>>                                     <<03001>>09776000
BEGIN                                                          <<03001>>09778000
    IF TOKEN <> %15 THEN FAIL;                                 <<03001>>09780000
    STACKTRACE;                                                <<03001>>09782000
END;                                                           <<03001>>09784000
                                                               <<03001>>09786000
                                                               <<03001>>09788000
SUBROUTINE EXPRESSION'COMMAND;                                 <<03001>>09790000
<<===========================>>                                <<03001>>09792000
BEGIN                                                          <<03001>>09794000
    MODE := OCTAL'MODE;                                        <<03001>>09796000
    GETP1;                                                     <<03001>>09798000
    GETMODE;                                                   <<03001>>09800000
    IF TOKEN <> %15 THEN FAIL;                                 <<03001>>09802000
    EXPRESSION;                                                <<03001>>09804000
END;                                                           <<03001>>09806000
                                                               <<03001>>09808000
$PAGE "HELP          MAIN PROGRAM BODY"                        <<03001>>09810000
                                                               <<03001>>09812000
<<=============  START OF THE MAIN PROGRAM ==============>>    <<03001>>09814000
A'SPECIAL'ENTRY := FALSE;    <<NORMAL ENTRY>>                  <<03001>>09816000
                                                               <<03001>>09818000
GOTO NORMAL'ENTRY;      <<SKIP SPECIAL MAKE'PRESENT ENTRY>>    <<03001>>09820000
                                                               <<03001>>09822000
HELP'INIT'BPTAB:    <<ENTER HERE TO INITIALIZE BPTAB>>         <<03001>>09824000
<<=============>>                                              <<03001>>09826000
    COPY'BRKPT'TABLE;                                          <<03001>>09828000
    BPTAB := EMPTY'FAKE'BRKPT;                                 <<03001>>09830000
    BPTAB(1) := EMPTY'BRKPT;                                   <<03001>>09832000
    MOVE BPTAB(2) := BPTAB(1),(NUM'ZEROS-1);                   <<03001>>09834000
    NUM'BRKPTS := 0;                                           <<03001>>09836000
    BP'DEBUG := 0;  <<CLEAR DEBUGGING FLAG>>                   <<03001>>09838000
    SAVE'BRKPT'TABLE;   <<SAVE CLEARED BPTAB INTO CODE>>       <<03001>>09840000
    RETURN;                                                    <<03001>>09842000
                                                               <<03001>>09844000
HELP'MAKE'PRESENT: <<ENTER HERE WHEN NEW SEG IS MADE PRESENT>> <<03001>>09846000
<<===============>>                                            <<03001>>09848000
HELP'MAKE'ABSENT:   <<ENTER HERE TO RESTORE INSTR INTO A SEG>> <<03001>>09850000
<<===============>>                                            <<03001>>09852000
                                                               <<03001>>09854000
  A'SPECIAL'ENTRY := TRUE;                                     <<03001>>09856000
                                                               <<03001>>09858000
NORMAL'ENTRY:                                                  <<03001>>09860000
                                                               <<03001>>09862000
                                                               <<03001>>09864000
DISABLE;  << TURN OFF INTERRUPTS >>                            <<03001>>09866000
TOS := 0D;  <<FOR RETURN VALUE FROM CST'ADDR(*) >>             <<03001>>09868000
PUSH(STATUS);                                                  <<03001>>09870000
TOS.(2:1) := 0;  SET(STATUS);  << TURN OFF THE TRAPS >>        <<03001>>09872000
                                                               <<03001>>09874000
COPY'BRKPT'TABLE;    <<SAVE THE CALLERS DB AND MAKE A COPY>>   <<03001>>09876000
      <<OF THE BRKPT-TABLE (FROM THE CODE SEG) TO AN EASILY>>  <<03001>>09878000
      <<ACCESSIBLE Q-REL ARRAY>>                               <<03001>>09880000
                                                               <<03001>>09882000
      <<SET DB TO INITIALS STACK,  ALLOWS BYTE ADDRESSING,IO>> <<03001>>09884000
P := SMP-1;  << GET P FROM STACK MARKER >>                     <<03001>>09886000
CST := SMSTA.(8:8);  << GET SEG FROM THE STATUS >>             <<03001>>09888000
ENTRY'P := P;   <<SAVE ENTRY VALUES FOR P AND CST>>            <<03001>>09890000
ENTRY'CST := CST;                                              <<03001>>09892000
                                                               <<03001>>09894000
                                                               <<03001>>09896000
      <<WERE WE CALLED FROM MAKE-PRESENT>>                     <<03001>>09898000
      <<================================>>                     <<03001>>09900000
IF A'SPECIAL'ENTRY                                             <<03001>>09902000
THEN BEGIN                                                     <<03001>>09904000
    IF SPECIAL'FUNCTION = 0 THEN BRKPT'MAKE'ABSENT             <<03001>>09906000
                            ELSE BRKPT'MAKE'PRESENT;           <<03001>>09908000
    SAVE'BRKPT'TABLE;    RETURN;                               <<03001>>09910000
  END;                                                         <<03001>>09912000
      <<ARE WE AT A FAKE BREAKPOINT >>                         <<03001>>09914000
      <<============================>>                         <<03001>>09916000
BRKPT'INX := FIND'BRKPT(FAKE'BRKPT, CST,P);                    <<03001>>09918000
IF BRKPT'INX <> -1   <<FOUND A FAKE BRKPT>>                    <<03001>>09920000
THEN BEGIN                                                     <<03001>>09922000
      <<THIS FAKE BRKPT ALLOWS US TO PUT THE BRKPT BACK>>      <<03001>>09924000
      <<INTO THE CODE AT ADDR P-1. WE HAD TO RESTORE THE>>     <<03001>>09926000
      <<ORIG INSTR TO ALLOW THE USER TO RESUME EXECUTION>>     <<03001>>09928000
                                                               <<03001>>09930000
   TOS := CST'ADDR(CST) + DOUBLE(P);                           <<03001>>09932000
   ASMB(LSEA);  <<GRAB PCAL TO HELP>>                          <<03001>>09934000
   S1 := S1-1;  <<BACK ADDR UP TO USER BRKPT>>                 <<03001>>09936000
   ASMB(SSEA);  <<RESTORE ORIG USER BRKPT>>                    <<03001>>09938000
   DDEL;        <<DELETE THE ADDR>>                            <<03001>>09940000
                                                               <<03001>>09942000
   CLEAR'BRKPT(FAKE'BRKPT);   <<CLEAR THE FAKE BRKPT>>         <<03001>>09944000
                                                               <<03001>>09946000
   SAVE'BRKPT'TABLE;  <<COPY FROM Q-REL BACK TO CODE SEG>>     <<03001>>09948000
                                                               <<03001>>09950000
   SMP := P;    <<DECREMENT THE RETURN ADDR>>                  <<03001>>09952000
   RETURN;      <<FAKE BRKPTS ARE INVISIBLE TO USER>>          <<03001>>09954000
END;  <<IN THE BREAKPOINT TABLE>>                              <<03001>>09956000
                                                               <<03001>>09958000
                                                               <<03001>>09960000
       <<ARE WE LOCATED AT A USER BREAKPOINT >>                <<03001>>09962000
       <<====================================>>                <<03001>>09964000
ENTRY'BRKPT'INX := FIND'BRKPT( USER'BRKPT,CST,P);              <<03001>>09966000
IF ENTRY'BRKPT'INX <> -1   <<WE ARE AT A USER BRKPT>>          <<03001>>09968000
THEN BEGIN                                                     <<03001>>09970000
    SMP := P;    <<DECREMENT THE EXIT ADDRESS>>                <<03001>>09972000
        <<WE WILL HAVE TO RESTORE THE ORIG INSTR LATER>>       <<03001>>09974000
        <<AS WELL AS SET A FAKE BRKPT WHEN WE EXIT >>          <<03001>>09976000
  END;   <<AT A USER BRKPT>>;                                  <<03001>>09978000
                                                               <<03001>>09980000
                                                               <<03001>>09982000
         <<PRINT WELCOME MSG, PROMPT, PROCESS COMMANDS>>       <<03001>>09984000
         <<===========================================>>       <<03001>>09986000
                                                               <<03001>>09988000
<< PRINT THE WELCOME MESSAGE >>                                <<03001>>09990000
BUFX := 0;   <<INITIALZE THE INDEX INTO OUTPUT BUFFER>>        <<03001>>09992000
PRINTLINE (0);       <<NEW LINE>>                              <<03001>>09994000
MOVE IO := "HELP      ";                                       <<03001>>09996000
BUFX := 10;                                                    <<03001>>09998000
OCTNUMOUT (DOUBLE(ENTRY'CST),3);    <<LOAD CST>>               <<03001>>10000000
MOVE IO(BUFX) := ".";                                          <<03001>>10002000
BUFX := BUFX + 1;                                              <<03001>>10004000
OCTNUMOUT (DOUBLE(ENTRY'P),5);    <<LOAD P >>                  <<03001>>10006000
PRINTLINE (0);       <<PRINT WELCOME, CRLF>>                   <<03001>>10008000
                                                               <<03001>>10010000
PUSH( S );  OLDS := TOS;  << SAVE FOR FAIL >>                  <<03001>>10012000
                                                               <<03001>>10014000
WIDTH := 8;   <<DEFAULT OUTPUT WIDTH>>                         <<03001>>10016000
<< COMMAND INPUT LOOP >>                                       <<03001>>10018000
                                                               <<03001>>10020000
COMIN:                                                         <<03001>>10022000
                                                               <<03001>>10024000
   IO := "-";     <<LOAD PROMPT>>                              <<03001>>10026000
   BUFX := 1;     <<1 BYTE PROMPT>>                            <<03001>>10028000
   PRINTLINE (1); <<PRINT THE PROMPT, STAY ON SAME LINE>>      <<03001>>10030000
                                                               <<03001>>10032000
   PIN := CST := 0;                                            <<03001>>10034000
   READINPUT( INBUF);                                          <<03001>>10036000
   CHAR;                                                       <<03001>>10038000
   X := NUM'CMDS -1;                                           <<03001>>10040000
   DO                                                          <<03001>>10042000
      BEGIN                                                    <<03001>>10044000
      IF  COMM(X) = TOKEN  THEN  GO FND;                       <<03001>>10046000
      X := X-1;                                                <<03001>>10048000
      END                                                      <<03001>>10050000
   UNTIL <;                                                    <<03001>>10052000
   FAIL;  << ILLEGAL COMMAND >>                                <<03001>>10054000
                                                               <<03001>>10056000
   FND:  << LEGAL COMMAND IF YOU GET HERE >>                   <<03001>>10058000
                                                               <<03001>>10060000
   COM := X;  << SAVE THE COMMAND >>                           <<03001>>10062000
   CHAR;  << SCAN OFF THE COMMAND >>                           <<03001>>10064000
                                                               <<03001>>10066000
   P2 := 0D;  P2F := FALSE;                                    <<03001>>10068000
                                                               <<03001>>10070000
                                                               <<03001>>10072000
   BUFX := 0;                                                  <<03001>>10074000
                                                               <<03001>>10076000
   CASE  *COM  OF                                              <<03001>>10078000
      BEGIN                                                    <<03001>>10080000
                 <<NOTE: SEE ORDER OF CHARS IN COMM>>          <<03001>>10082000
      << 0 B >>  BREAK'COMMAND;                                <<03001>>10084000
      << 1 C >>  CLEAR'COMMAND;                                <<03001>>10086000
      << 2 D >>  DUMP'COMMAND;                                 <<03001>>10088000
      << 3 L >>  LIST'COMMAND;                                 <<03001>>10090000
      << 4 M >>  MODIFY'COMMAND;                               <<03001>>10092000
      << 5 R >>  EXIT'COMMAND;   <<RESUME>>                    <<03001>>10094000
      << 6 T >>  TRACE'COMMAND;                                <<03001>>10096000
      << 7 = >>  EXPRESSION'COMMAND;                           <<03001>>10098000
      END;                                                     <<03001>>10100000
GO COMIN;                                                      <<03001>>10102000
                                                               <<03001>>10104000
END <<HELP>> ;                                                 <<03001>>10106000
<<  $CONTROL NOLIST >>                                         <<03001>>10108000
$CONTROL SEGMENT=RESIDENT                                      <<04306>>10110000
        <<---------------------------------------->>           <<04306>>10112000
        <<  CONVERT BYTE ADDRESS TO WORD ADDRESS  >>           <<04306>>10114000
        <<---------------------------------------->>           <<04306>>10116000
INTEGER PROCEDURE WORDADDRESS(BYTEADDRESS);                    <<04306>>10118000
VALUE BYTEADDRESS;                                             <<04306>>10120000
BYTE POINTER                                                   <<04306>>10122000
   BYTEADDRESS;     << BYTE POINTER TO BE CONVERTED >>         <<04306>>10124000
COMMENT                                                        <<04306>>10126000
THIS PROCEDURE RETURNS THE GIVEN BYTE ADDRESS CONVERTED TO     <<04306>>10128000
A WORD ADDRESS.  IT WORKS NO MATTER WHERE THE ADDRESS IS       <<04306>>10130000
LOCATED -- IN DB+ OR DB- AREA.                                 <<04306>>10132000
;                                                              <<04306>>10134000
BEGIN                                                          <<04306>>10136000
INTEGER                                                        <<04306>>10138000
   TEMP,    << TEMP. VARIABLE >>                               <<04306>>10140000
   ZREG;    << TEMP. FOR Z-REGISTER >>                         <<04306>>10142000
                                                               <<04306>>10144000
TEMP := WORDADDRESS := @BYTEADDRESS&LSR(1);                    <<04306>>10146000
PUSH(Z);                                                       <<04306>>10148000
ZREG := TOS;                                                   <<04306>>10150000
IF TEMP > ZREG THEN           << IF WORDADDRESS > Z    >>      <<04306>>10152000
   WORDADDRESS.(0:1) := 1;    << MUST BE A DB- ADDRESS >>      <<04306>>10154000
END;   << WORDADDRESS >>                                       <<04306>>10156000
$CONTROL SEGMENT=RESIDENT                                      <<04306>>10158000
        <<---------------------------------------->>           <<04306>>10160000
        <<  CONVERT WORD ADDRESS TO BYTE ADDRESS  >>           <<04306>>10162000
        <<---------------------------------------->>           <<04306>>10164000
INTEGER PROCEDURE BYTEADDRESS(WORDADDRESS);                    <<04306>>10166000
VALUE WORDADDRESS;                                             <<04306>>10168000
POINTER                                                        <<04306>>10170000
   WORDADDRESS;    << POINTER TO BE CONVERTED >>               <<04306>>10172000
COMMENT                                                        <<04306>>10174000
THIS PROCEDURE RETURNS THE GIVEN WORD ADDRESS CONVERTED TO     <<04306>>10176000
A BYTE ADDRESS.  IT WORKS NO MATTER WHERE THE ADDRESS IS       <<04306>>10178000
LOCATED -- IN DB+ OR DB- AREA.                                 <<04306>>10180000
;                                                              <<04306>>10182000
BEGIN                                                          <<04306>>10184000
BYTEADDRESS := @WORDADDRESS&LSL(1);                            <<04306>>10186000
END;   << BYTEADDRESS >>                                       <<04306>>10188000
$CONTROL SEGMENT=BOOTSTRAP                                     <<02510>>10190000
INTEGER PROCEDURE THISCPU;                                     <<02510>>10192000
   BEGIN                                                       <<02510>>10194000
   << THIS PROCEDURE DETECTS THE CURRENT TYPE  >>              <<02510>>10196000
   << OF CPU IN EXECUTION AND RETURNS A VALUE  >>              <<02510>>10198000
   <<        0  IF SERIES I                    >>              <<02510>>10200000
   <<        1  IF SERIES II                   >>              <<02510>>10202000
   <<        2  IF SERIES 33                   >>              <<02510>>10204000
   <<        3  IF SERIES III                  >>              <<02510>>10206000
   <<        4  IF ICF/44                      >>              <<02510>>10208000
   <<        5  IF ICF/55                      >>              <<02510>>10210000
                                                               <<02510>>10212000
   INTEGER ARRAY PHYLOGCPU(1:8)=PB :=                          <<02510>>10214000
      1,3,4,5,-1,-1,-1,2;                                      <<02510>>10216000
   INTEGER X=X, S0=S-0;                                        <<02510>>10218000
   ASSEMBLE( DZRO,NOT); << INITIALIZE RETURN (SERIES I) >>     <<02510>>10220000
                        << TEST FLAG - ILLEGAL BANK #   >>     <<02510>>10222000
   PUSH( DB );          << 1 WORD ON SERIES I           >>     <<02510>>10224000
                        << 2 WORD ON SERIES II/33       >>     <<02510>>10226000
   DEL;                 << DON'T NEED DB ADDRESS        >>     <<02510>>10228000
   IF TOS <> -1 THEN    << WAS BANK # PUSHED?           >>     <<02510>>10230000
      BEGIN             << YES - NOT SERIES I           >>     <<02510>>10232000
      ASSEMBLE( PCN );  << GET MICROCODE CPU #          >>     <<02510>>10234000
      X := TOS;         << SETUP FOR RANGE CHECK        >>     <<02510>>10236000
      DDEL;             << DELETE TEST FLAG             >>     <<02510>>10238000
                        << DELETE RETURN VALUE          >>     <<02510>>10240000
      IF NOT(1 <= X <= 8) THEN ASSEMBLE( HALT 0 );             <<02510>>10242000
      TOS := PHYLOGCPU(X);                                     <<02510>>10244000
      IF < THEN ASSEMBLE( HALT 0 );<< CPU NOT SUPPORTED >>     <<02510>>10246000
      END;                                                     <<02510>>10248000
   THISCPU := TOS;  << RETURN VALUE >>                         <<02510>>10250000
   END;  << END THISCPU >>                                     <<02510>>10252000
LOGICAL PROCEDURE ON'ICS;                                      <<03603>>10254000
BEGIN                                                          <<03603>>10256000
   PUSH( DB, Z);                                               <<03603>>10258000
   ASSEMBLE( CAB, LADD);                                       <<03603>>10260000
   PUSH( SBANK );                                              <<03603>>10262000
   S2 := TOS;                                                  <<03603>>10264000
   IF TOS = D'L(ABS(ZI))) THEN ON'ICS := TRUE;                 <<03603>>10266000
END;                                                           <<03603>>10268000
PROCEDURE MABS( DBANK, DADDRESS, SBANK, SADDRESS, COUNT);      <<02517>>10270000
   VALUE DBANK, DADDRESS, SBANK, SADDRESS, COUNT;              <<02517>>10272000
   INTEGER DBANK, DADDRESS, SBANK, SADDRESS, COUNT;            <<02517>>10274000
BEGIN                                                          <<02517>>10276000
   DOUBLE                                                      <<02517>>10278000
      DESTINATION = DBANK,                                     <<02517>>10280000
      SOURCE      = SBANK;                                     <<02517>>10282000
                                                               <<02517>>10284000
   TOS := DESTINATION;                                         <<02517>>10286000
   TOS := SOURCE;                                              <<02517>>10288000
   TOS := COUNT;                                               <<02517>>10290000
   ASSEMBLE( MABS );                                           <<02517>>10292000
END;                                                           <<02517>>10294000
$CONTROL SEGMENT=RESIDENT                                      <<01103>>10296000
PROCEDURE DNTOA (NUM,BASE,BA);                                 <<01103>>10298000
   VALUE NUM,BASE;                                             <<01103>>10300000
   DOUBLE NUM; INTEGER BASE; BYTE ARRAY BA;                    <<01103>>10302000
   BEGIN                                                       <<01103>>10304000
   BA(0) := "0";                                               <<01103>>10306000
   WHILE NUM <> 0D DO                                          <<01103>>10308000
      BEGIN                                                    <<01103>>10310000
      ASSEMBLE(ZERO; LOAD NUM; LOAD BASE; LDIV;                <<01103>>10312000
               LDD NUM; DELB; LOAD BASE; LDIV;                 <<01103>>10314000
               ADDI %60);                                      <<01103>>10316000
      BA(XREG) := TOS;                                         <<01103>>10318000
      NUM := TOS;                                              <<01103>>10320000
      XREG := XREG-1                                           <<01103>>10322000
      END                                                      <<01103>>10324000
   END;                                                        <<01103>>10326000
PROCEDURE NTOA (NUM,BASE,BA);                                  <<01103>>10328000
   VALUE NUM,BASE;                                             <<01103>>10330000
   INTEGER NUM,BASE;                                           <<01103>>10332000
   BYTE ARRAY BA;                                              <<01103>>10334000
   DNTOA(DOUBLE(LOGICAL(NUM)),BASE,BA);                        <<01103>>10336000
$CONTROL SEGMENT=CONFIGURE                                     <<03550>>10338000
       <<---------------------------------->>                  <<03550>>10340000
       <<      SEE IF LDEV EXISTS          >>                  <<03550>>10342000
       <<---------------------------------->>                  <<03550>>10344000
LOGICAL PROCEDURE LDEV'EXISTS( LDEV);                          <<03550>>10346000
VALUE LDEV;                                                    <<03550>>10348000
INTEGER LDEV;   << LDEV TO BE CHECKED >>                       <<03550>>10350000
COMMENT                                                        <<03550>>10352000
THIS PROCEDURE RETURNS TRUE IF THE GIVEN LDEV IS               <<03550>>10354000
ACTUALLY CONFIGURED, FALSE OTHERWISE.                          <<03550>>10356000
;                                                              <<03550>>10358000
BEGIN                                                          <<03550>>10360000
IF 1 <= LDEV <= HLDEV AND                                      <<03550>>10362000
   (DVRTAB(LDEV*DVRSIZE).DRTFIELD <> 0 OR                      <<03550>>10364000
    DVRTAB(LDEV*DVRSIZE+DVR1).DSBIT = 1) THEN                  <<03550>>10366000
   LDEV'EXISTS := TRUE                                         <<03550>>10368000
ELSE                                                           <<03550>>10370000
   LDEV'EXISTS := FALSE;                                       <<03550>>10372000
END;  << LDEV'EXISTS >>                                        <<03550>>10374000
$CONTROL SEGMENT=CONFIGURE                                     <<03550>>10376000
      <<----------------------------------------->>            <<03550>>10378000
      << SEE IF LDEV EXISTS AND IS NOT DS DEVICE >>            <<03550>>10380000
      <<----------------------------------------->>            <<03550>>10382000
LOGICAL PROCEDURE NON'DS'LDEV(LDEV);                           <<03550>>10384000
VALUE LDEV;                                                    <<03550>>10386000
INTEGER LDEV;   << LDEV TO BE CHECKED >>                       <<03550>>10388000
COMMENT                                                        <<03550>>10390000
THIS PROCEDURE RETURNS TRUE IF THE GIVEN LDEV IS ACTUALLY      <<03550>>10392000
CONFIGURED AND IS NOT A DS DEVICE.  IT RETURNS FALSE           <<03550>>10394000
OTHERWISE.                                                     <<03550>>10396000
;                                                              <<03550>>10398000
BEGIN                                                          <<03550>>10400000
IF 1 <= LDEV <= HLDEV AND                                      <<03550>>10402000
   DVRTAB(LDEV*DVRSIZE+DVR1).DSBIT = 0 AND                     <<03550>>10404000
   DVRTAB(LDEV*DVRSIZE).DRTFIELD <> 0 THEN                     <<03550>>10406000
   NON'DS'LDEV := TRUE                                         <<03550>>10408000
ELSE                                                           <<03550>>10410000
   NON'DS'LDEV := FALSE;                                       <<03550>>10412000
END;  << NON'DS'LDEV >>                                        <<03550>>10414000
$CONTROL SEGMENT=RESIDENT                                      <<03668>>10416000
   INTEGER PROCEDURE LDNTOA(NUM, BASE, BA);                    <<01103>>10418000
      VALUE NUM, BASE;                                         <<01103>>10420000
      DOUBLE NUM;                                              <<01103>>10422000
      INTEGER BASE;                                            <<01103>>10424000
      BYTE ARRAY BA;                                           <<01103>>10426000
   BEGIN                                                       <<01103>>10428000
      BYTE ARRAY BUF(0:11)=Q;                                  <<01103>>10430000
                                                               <<01103>>10432000
      XREG := 12;                                              <<01103>>10434000
      DO BEGIN                                                 <<01103>>10436000
         ASSEMBLE(ZERO; LOAD NUM; LOAD BASE; LDIV;             <<01103>>10438000
                  LDD NUM; DELB; LOAD BASE; LDIV;              <<01103>>10440000
                  ADDI %60);                                   <<01103>>10442000
         BUF(XREG:=XREG-1) := TOS;                             <<01103>>10444000
         NUM := TOS;                                           <<01103>>10446000
         END UNTIL NUM=0D;                                     <<01103>>10448000
      MOVE BA := BUF(XREG),(LDNTOA:=12-XREG);                  <<01103>>10450000
   END;                                                        <<01103>>10452000
   INTEGER PROCEDURE LNTOA( NUM, BASE, BA);                    <<01103>>10454000
      VALUE NUM, BASE;                                         <<01103>>10456000
      INTEGER NUM, BASE;                                       <<01103>>10458000
      BYTE ARRAY BA;                                           <<01103>>10460000
      LNTOA := LDNTOA(DOUBLE(LOGICAL(NUM)),BASE,BA);           <<01103>>10462000
INTEGER PROCEDURE ASCII( NUM, BUF);                            <<01103>>10464000
   VALUE NUM;                                                  <<01103>>10466000
   INTEGER NUM;                                                <<01103>>10468000
   BYTE ARRAY BUF;                                             <<01103>>10470000
ASCII := LDNTOA(DOUBLE(LOGICAL(NUM)),10,BUF);                  <<01103>>10472000
$CONTROL SEGMENT=CONFIGURE                                     <<03668>>10474000
            <<------------------------------------>>           <<02707>>10476000
            << RETURN THE MAXIMUM OF TWO INTEGERS >>           <<02707>>10478000
            <<------------------------------------>>           <<02707>>10480000
INTEGER PROCEDURE MAX( A, B);                                  <<02707>>10482000
VALUE A, B;                                                    <<02707>>10484000
INTEGER A,      << FIRST INTEGER >>                            <<02707>>10486000
        B;      << SECOND INTEGER >>                           <<02707>>10488000
COMMENT                                                        <<02707>>10490000
   THIS PROCEDURE RETURNS THE MAXIMUM OF A OR B.               <<02707>>10492000
   ;                                                           <<02707>>10494000
   BEGIN                                                       <<02707>>10496000
   MAX := IF A > B THEN A                                      <<02707>>10498000
                   ELSE B;                                     <<02707>>10500000
   END;   << MAX >>                                            <<02707>>10502000
$CONTROL SEGMENT=RESIDENT                                      <<03550>>10504000
           <<-------------------------------->>                <<03550>>10506000
           <<  RETURN CURRENT PROCESS CLOCK  >>                <<03550>>10508000
           <<-------------------------------->>                <<03550>>10510000
LOGICAL PROCEDURE RCLK;                                        <<03550>>10512000
COMMENT                                                        <<03550>>10514000
THIS PROCEDURE DOES AN RCLK INTRUCTION AND RETURNS             <<03550>>10516000
THE CURRENT CLOCK VALUE IT LEAVES ON THE STACK.                <<03550>>10518000
WARNING:  THIS CLOCK DOES NOT INCREMENT WHEN YOU'RE            <<03550>>10520000
RUNNING ON THE ICS.                                            <<03550>>10522000
;                                                              <<03550>>10524000
BEGIN                                                          <<03550>>10526000
ASSEMBLE(RCLK);    << GET THE CLOCK >>                         <<03550>>10528000
RCLK := TOS;       << RETURN IT     >>                         <<03550>>10530000
END;   << RCLK >>                                              <<03550>>10532000
$CONTROL SEGMENT=RESIDENT                                      <<03550>>10534000
INTEGER PROCEDURE MOVEAN( TO'BUF, FROM'BUF, MAX'COUNT);        <<01103>>10536000
   VALUE MAX'COUNT;                                            <<01103>>10538000
   BYTE ARRAY TO'BUF, FROM'BUF;                                <<01103>>10540000
   INTEGER MAX'COUNT;                                          <<01103>>10542000
BEGIN                                                          <<01103>>10544000
   X := 0;                                                     <<01103>>10546000
   WHILE FROM'BUF(X) <> SPECIAL AND X < MAX'COUNT DO           <<01103>>10548000
      BEGIN                                                    <<01103>>10550000
      TO'BUF(X) := FROM'BUF(X);                                <<01103>>10552000
      X := X+1;                                                <<01103>>10554000
      END;                                                     <<01103>>10556000
   MOVEAN := X;                                                <<01103>>10558000
END;                                                           <<01103>>10560000
                                                               <<03002>>10562000
$CONTROL SEGMENT=BOOTSTRAP                                     <<03002>>10564000
  INTEGER PROCEDURE GETDRT(DRT,OFFSET);                        <<03002>>10566000
  <<=================================>>                        <<03002>>10568000
      VALUE DRT,OFFSET;                                        <<03002>>10570000
      INTEGER DRT,OFFSET;                                      <<03002>>10572000
                                                               <<03002>>10574000
      COMMENT: USE FIXED LOW CORE CELLS "DRTBANK","DRTADDR"    <<03002>>10576000
        TO GET DEVICE REF TABLE START ADDRESS, THEN INDEX      <<03002>>10578000
        TO THE DESIRED "DRT" ENTRY (4 WORD), AND USE           <<03002>>10580000
        "OFFSET" TO SPECIFY THE DESIRED WORD.                  <<03002>>10582000
        GETDRT RETURNS AS THE VALUE OF THAT WORD IN THE TABLE; <<03002>>10584000
                                                               <<03002>>10586000
  BEGIN                                                        <<03002>>10588000
    TOS := ABSOLUTE(DRTBANK);                                  <<03002>>10590000
    TOS := ABSOLUTE(DRTADDR)+DRT &LSL(2) + OFFSET;             <<03002>>10592000
    ASSEMBLE(LSEA);                                            <<03002>>10594000
    PUSH(STATUS);                                              <<03002>>10596000
    TOS := TOS.(6:2);                                          <<03002>>10598000
    CC := TOS;  <<SET CC FOR FUTURE TEST>>                     <<03002>>10600000
       <<ORIG CODE ASSIGNMENT SET THE CC>>                     <<03002>>10602000
    GETDRT:= TOS;                                              <<03002>>10604000
  END;                                                         <<03002>>10606000
                                                               <<03002>>10608000
  PROCEDURE PUTDRT(DRT,OFFSET,NUM);                            <<03002>>10610000
  <<==============================>>                           <<03002>>10612000
      VALUE DRT,OFFSET,NUM;                                    <<03002>>10614000
      INTEGER DRT,OFFSET,NUM;                                  <<03002>>10616000
                                                               <<03002>>10618000
      COMMENT: USE FIXED LOW CORE CELLS "DRTBANK","DRTADDR"    <<03002>>10620000
        TO GET DEVICE REF TABLE START ADDRESS, THEN INDEX      <<03002>>10622000
        TO THE DESIRED "DRT" ENTRY (4 WORD), AND USE           <<03002>>10624000
        "OFFSET" TO SPECIFY THE DESIRED WORD.                  <<03002>>10626000
        LOAD THE VALUE "NUM" INTO THAT WORD IN THE TABLE;      <<03002>>10628000
                                                               <<03002>>10630000
  BEGIN                                                        <<03002>>10632000
    TOS := ABSOLUTE(DRTBANK);                                  <<03002>>10634000
    TOS := ABSOLUTE(DRTADDR) + DRT &LSL(2) + OFFSET;           <<03002>>10636000
    TOS := NUM;                                                <<03002>>10638000
    ASSEMBLE(SSEA);                                            <<03002>>10640000
  END;                                                         <<03002>>10642000
                                                               <<03002>>10644000
  PROCEDURE INITDRT( DRT );                                    <<03002>>10646000
  <<=====================>>                                    <<03002>>10648000
     VALUE DRT; INTEGER DRT;                                   <<03002>>10650000
  BEGIN                                                        <<03002>>10652000
     PUTDRT(DRT,0,0);                                          <<03002>>10654000
     PUTDRT(DRT,PI,0);                                         <<03002>>10656000
     PUTDRT(DRT,DBI,TEMP'CPVA);                                <<03002>>10658000
     PUTDRT(DRT,CHANSTAT,0);                                   <<03002>>10660000
  END;                                                         <<03002>>10662000
$PAGE "CONSOLE DRIVER"                                         <<01103>>10664000
$CONTROL SEGMENT=CONFIGURE                                              10666000
          <<----------------------------                                10668000
            DETERMINE SPEED OF CONSOLE                                  10670000
          ---------------------------->>                                10672000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>10674000
PROCEDURE SPEEDSENSE;                                          <<01101>>10676000
BEGIN COMMENT                                                  <<01101>>10678000
                                                               <<01101>>10680000
     WILL TRY FOR AN AUTOMATIC SPEED SENSE IF POSSIBLE, THIS   <<01101>>10682000
  WORKS ONLY FOR THE HP26XX TYPE TERMINALS.  IF THIS FAILS     <<01101>>10684000
  WILL HOOK UP UNIT 0 TO THE DIAGNOSTIC CHANNELS AT 5          <<01101>>10686000
  DIFFERENT SPEEDS AND WAIT FOR A CARRIAGE RETURN TO BE        <<01101>>10688000
  INPUT TO DETERMINE THE SPEED.  THE CORRECT BAUD RATE         <<01101>>10690000
  PARAMETER IS STORED IN BAUDRATE;                             <<01101>>10692000
                                                               <<01101>>10694000
   INTEGER ARRAY BRPARAM(0:5) = PB := <<BAUD RATE PARAMETERS>> <<01101>>10696000
            %5,    <<2400>>                                    <<01101>>10698000
           %13,    <<1200>>                                    <<01101>>10700000
           %27,    <<600>>                                     <<01101>>10702000
           %57,    <<300>>                                     <<01101>>10704000
          %137,    <<150>>                                     <<01101>>10706000
          %202;    <<110>>                                     <<01101>>10708000
   ARRAY TIME(0:5) = PB := 10, 18, 30, 70, 130, 200;           <<01101>>10710000
   ARRAY SPEEDS(0:5) = PB := 240, 120, 60, 30, 15, 10;         <<01101>>10712000
   EQUATE ENQ=5, ACK=6, CR=13;                                 <<01101>>10714000
   INTEGER CHAR,UNIT,I;                                        <<01101>>10716000
   LOGICAL WAITMS;                                             <<01101>>10718000
                                                               <<01101>>10720000
   SUBROUTINE SETRECSPEED;                                     <<01101>>10722000
      BEGIN                                                    <<01101>>10724000
      TOS := CONSOLEDRT;                                       <<01101>>10726000
      TOS := BAUDRATE+%131000; <<ENABLE INTS,ECHO,REC>>        <<01101>>10728000
      IF BAUDRATE = %202 THEN TOS.(7:1) := 1;                  <<01101>>10730000
      WIO1;  << SET BAUDRATE >>                                <<01101>>10732000
      TOS := 2;  << UNIT 0 >>                                  <<01101>>10734000
      CIO1;  << SEND TO CHANNEL >>                             <<01101>>10736000
      DEL;                                                     <<01101>>10738000
      END;                                                     <<01101>>10740000
                                                               <<01101>>10742000
   SUBROUTINE READCHAR;                                        <<01101>>10744000
   BEGIN                                                       <<01101>>10746000
      CHAR := 0;                                               <<01101>>10748000
      TOS := 0;                                                <<01101>>10750000
      ASSEMBLE( SCLK );                                        <<01101>>10752000
      TOS := CONSOLEDRT;                                       <<01101>>10754000
      DO BEGIN                                                 <<01101>>10756000
         TIO0;                                                 <<01101>>10758000
         IF TOS.(4:1) THEN  <<COMPLETION>>                     <<01101>>10760000
            BEGIN                                              <<01101>>10762000
            TIO0;                                              <<01101>>10764000
            IF NOT TOS.(5:1) THEN << RECEIVE? >>               <<01101>>10766000
               BEGIN                                           <<01101>>10768000
               RIO0;                                           <<01101>>10770000
               UNIT := S0.(0:5);                               <<01101>>10772000
               CHAR := TOS.(9:7);                              <<01101>>10774000
               END;                                            <<01101>>10776000
            TOS := 1;                                          <<01101>>10778000
            CIO1;   <<ACK INT>>                                <<01101>>10780000
            END;                                               <<01101>>10782000
         ASSEMBLE( RCLK );                                     <<01101>>10784000
         END UNTIL TOS > WAITMS OR CHAR <> 0;                  <<01101>>10786000
      DEL;  <<DEVICE NUMBER>>                                  <<01101>>10788000
   END;  << READCHAR >>                                        <<01101>>10790000
                                                               <<01101>>10792000
   CHARCNT := 0;     <<INIT. CHAR COUNT FOR WRITECHAR>>        <<03003>>10794000
   TOS := CONSOLEDRT;                                          <<01101>>10796000
   TOS := %100000;                                             <<01101>>10798000
   CIO1;   <<MASTER CLEAR -- READY THE BOARD>>                 <<01101>>10800000
   HP26XX := FALSE;                                            <<01101>>10802000
                                                               <<01101>>10804000
   <<  * * *   AUTOMATIC SPEED SENSE   * * *  >>               <<01101>>10806000
                                                               <<01101>>10808000
   I := 0;                                                     <<01101>>10810000
   DO BEGIN                                                    <<01101>>10812000
      BAUDRATE := BRPARAM(I);                                  <<01101>>10814000
      CONSPEED := SPEEDS(I);                                   <<01101>>10816000
      WAITMS := TIME(I);                                       <<01101>>10818000
      SETRECSPEED;                                             <<01101>>10820000
      WRITECHAR( ENQ);                                         <<01101>>10822000
      READCHAR;                                                <<01101>>10824000
      IF UNIT = 0 AND CHAR = ACK THEN HP26XX := TRUE;          <<01101>>10826000
      I := I+1;                                                <<01101>>10828000
      END UNTIL I > 5 OR HP26XX;                               <<01101>>10830000
   IF HP26XX THEN RETURN ELSE BAUDRATE := 0;                   <<01101>>10832000
                                                               <<01101>>10834000
   <<  * * *   MUST NOT BE A 26XX TERMINAL   * * *   >>        <<01101>>10836000
   <<  * * *   SET UP DIAGNOSTIC CHANNELS    * * *   >>        <<01101>>10838000
                                                               <<01101>>10840000
   TOS := [1/1,1/0,    <<OUTPUT RECIEVE PARAMETERS>>           <<01101>>10842000
           1/1,        <<INTERRUPTS ENABLED>>                  <<01101>>10844000
           1/0,        <<ECHO OFF>>                            <<01101>>10846000
           1/0,        <<NO DATA TO AUX CHANNELS>>             <<01101>>10848000
           3/2,        <<10 BIT CHARACTER>>                    <<01101>>10850000
           8/0];       <<BAUD RATE>>                           <<01101>>10852000
   TOS := S0+BRPARAM;   <<2400 BAUD>>                          <<01101>>10854000
   TOS.(4:1) := 1;  <<SEND DATA TO AUX CHANNELS>>              <<01101>>10856000
   WIO2;                                                       <<01101>>10858000
   TOS := 2;                                                   <<01101>>10860000
   CIO2;   <<SEND TO UNIT 0>>                                  <<01101>>10862000
   UNIT := 16;                                                 <<01101>>10864000
   DO BEGIN  <<CONFIGURE DIAGNOSTIC CHANNELS>>                 <<01101>>10866000
      TOS := S0+BRPARAM(UNIT-15);                              <<01101>>10868000
      IF BRPARAM(X)=%202 THEN TOS.(7:1) := 1; <<11 BIT CHAR>>  <<01101>>10870000
      WIO2;                                                    <<01101>>10872000
      TOS := UNIT&LSL(9)+2;   <<CONTROL WORD>>                 <<01101>>10874000
      CIO2;   <<SEND TO PROPER UNIT>>                          <<01101>>10876000
      UNIT := UNIT+1;                                          <<01101>>10878000
      END UNTIL UNIT=21;  <<LAST DIAGNOSTIC CHANNEL>>          <<01101>>10880000
   DEL;   <<CONTROL WORD>>                                     <<01101>>10882000
                                                               <<01101>>10884000
   WAITMS := -1;                                               <<01101>>10886000
   DO BEGIN                                                    <<01101>>10888000
      READCHAR;                                                <<01101>>10890000
      IF CHAR = CR AND NOT(1 <= UNIT <= 15) THEN               <<01101>>10892000
         BEGIN   << GOT A CARRIAGE RETURN >>                   <<01101>>10894000
         X := IF UNIT = 0 THEN 0 ELSE UNIT-15;                 <<01101>>10896000
         BAUDRATE := BRPARAM(X);                               <<01101>>10898000
         CONSPEED := SPEEDS(X);                                <<01101>>10900000
         END;                                                  <<01101>>10902000
      END UNTIL BAUDRATE <> 0;                                 <<01101>>10904000
                                                               <<01101>>10906000
   TOS := %100000; << MASTER CLEAR--STOP DIAG CHANNELS>>       <<01101>>10908000
   CIO1;                                                       <<01101>>10910000
END;   <<SPEEDSENSE>>                                          <<01101>>10912000
$IF         << ********** RETURNING TO COMMON CODE ******** >> <<03004>>10916000
$CONTROL SEGMENT=RESIDENT                                      <<03715>>10918000
         <<-------------------------------------->>            <<03715>>10920000
         <<  DELAY FOR A NUMBER OF MILLISECONDS  >>            <<03715>>10922000
         <<-------------------------------------->>            <<03715>>10924000
PROCEDURE DELAY( WAIT'TIME);                                   <<03715>>10926000
VALUE WAIT'TIME;                                               <<03715>>10928000
DOUBLE                                                         <<03715>>10930000
   WAIT'TIME;         << NO. OF MILLISECONDS TO DELAY >>       <<03715>>10932000
                                                               <<03715>>10934000
COMMENT                                                        <<03715>>10936000
THIS PROCEDURE DELAYS (WAITS) FOR THE NUMBER OF MILLISECONDS   <<03715>>10938000
SPECIFIED BY "WAIT'TIME".  IT USES THE PROCESS CLOCK TO        <<03715>>10940000
TIME THE DELAY (RCLK INSTRUCTION).  SINCE THIS CLOCK DOES NOT  <<03715>>10942000
INCREMENT WHEN RUNNING ON THE ICS, THIS PROCEDURE WILL RETURN  <<03715>>10944000
IMMEDIATELY IN THAT CASE.  WE CANNOT RELY ON THE WAY           <<03715>>10946000
THAT RCLK ROLLS OVER, SO WE KEEP A SEPARATE COUNTER THAT       <<03715>>10948000
COUNTS CHANGES IN RCLK.                                        <<03715>>10950000
;                                                              <<03715>>10952000
BEGIN                                                          <<03715>>10954000
LOGICAL                                                        <<03715>>10956000
   NEW'RCLK,             << LATEST VALUE OF RCLK >>            <<03715>>10958000
   LAST'RCLK;            << PREVIOUS VALUE OF RCLK >>          <<03715>>10960000
DOUBLE                                                         <<03715>>10962000
   CURTIME;              << CURRENT TIMEOUT CLOCK VALUE >>     <<03715>>10964000
                                                               <<03715>>10966000
IF ON'ICS THEN         << IF RUNNING ON ICS, RCLK DOES NOT >>  <<03715>>10968000
   RETURN;             <<    INCREMENT, SO JUST RETURN     >>  <<03715>>10970000
                                                               <<03715>>10972000
CURTIME := 0D;         << SET INITIAL TIMEOUT CLOCK >>         <<03715>>10974000
LAST'RCLK := RCLK;     << GET INITIAL RCLK >>                  <<03715>>10976000
                                                               <<03715>>10978000
DO                                                             <<03715>>10980000
   BEGIN    << WAIT FOR SPECIFIED NO. OF MILLISECONDS >>       <<03715>>10982000
   NEW'RCLK := RCLK;                                           <<03715>>10984000
   IF NEW'RCLK <> LAST'RCLK THEN     << INCREMENT CLOCK IF >>  <<03715>>10986000
      CURTIME := CURTIME + 1D;       <<    RCLK HAS TICKED >>  <<03715>>10988000
   LAST'RCLK := NEW'RCLK;                                      <<03715>>10990000
                                                               <<03715>>10992000
   END                                                         <<03715>>10994000
UNTIL CURTIME > WAIT'TIME;                                     <<03715>>10996000
END;  << DELAY >>                                              <<03715>>10998000
$PAGE                                                          <<03004>>11000000
$IF X1=ON   << ********* SERIES 33,44,55 UNIQUE ********** >>  <<03004>>11002000
$CONTROL SEGMENT=CONFIGURE                                     <<03004>>11004000
           <<----------------------------->>                   <<03004>>11006000
           <<    DETERMINE BOARD TYPE     >>                   <<03004>>11008000
           <<----------------------------->>                   <<03004>>11010000
  INTEGER PROCEDURE GETBOARDTYPE( DRT);                        <<03004>>11012000
  VALUE DRT;                                                   <<03004>>11014000
  LOGICAL DRT;     << DRT NUMBER OF DEVICE >>                  <<03004>>11016000
  COMMENT                                                      <<03004>>11018000
     THIS PROCEDURE RETURNS THE BOARD IDENTIFICATION           <<03004>>11020000
     FOUND ON A PARTICULAR CHANNEL IN THE LOW-ORDER            <<03004>>11022000
     4 BITS.  IF NO BOARD RESPONDS, IT RETURNS NEGATIVE.       <<03004>>11024000
     CAUTION:  THIS PROCEDURE INITIALIZES THE DRT SO NO        <<03004>>11026000
     CHANNEL PROGRAM MAY BE ACTIVE WHEN IT IS CALLED;          <<03004>>11028000
                                                               <<03004>>11030000
     BEGIN                                                     <<03004>>11032000
     EQUATE RE   = %(16)E;                                     <<03004>>11034000
     INTEGER TEMP;                                             <<03022>>11036000
     LOGICAL READ'COMMAND := 0,                                <<03004>>11038000
             REG'NUMB     := RE;                               <<03004>>11040000
     DRT := DRT LAND %770;  << STRIP OFF DEVICE NO. >>         <<03004>>11042000
     INITDRT( DRT);  << INITIALIZE DRT, ESPECIALLY SO THAT >>  <<03004>>11044000
                     << BIT 2 OF 4TH WORD OF DRT = 0       >>  <<03004>>11046000
                                                               <<03022>>11050000
     << READ BOARD IDENTIFICATION >>                           <<03022>>11052000
     TEMP := RIOC( DRT, READ'COMMAND CAT REG'NUMB(4:12:4));    <<03022>>11054000
                                                               <<03022>>11056000
     IF < THEN     << BOARD DID NOT RESPOND >>                 <<03004>>11058000
        GETBOARDTYPE := -1                                     <<03004>>11060000
     ELSE                                                      <<03004>>11062000
        GETBOARDTYPE := TEMP.(12:4);                           <<03022>>11064000
     END;  << GETBOARDTYPE >>                                  <<03004>>11066000
$IF X1=OFF   << ********** SERIES II,III UNIQUE *********** >> <<03003>>11068000
$CONTROL SEGMENT=RESIDENT                                      <<03003>>11070000
          <<---------------------------->>                     <<03003>>11072000
          <<WRITE A CHARACTER ON CONSOLE>>                     <<03003>>11074000
          <<---------------------------->>                     <<03003>>11076000
  LOGICAL PROCEDURE WRITECHAR(CHAR);                           <<03003>>11078000
    VALUE CHAR;                                                <<03003>>11080000
    INTEGER CHAR;  <<CHARACTER TO BE OUTPUT>>                  <<03003>>11082000
    COMMENT                                                    <<03003>>11084000
      OUTPUTS A CHARACER TO THE CONSOLE;                       <<03003>>11086000
      BEGIN                                                    <<03003>>11088000
          EQUATE  ENQ=5, ACK=6;                                <<03003>>11090000
          TOS := CONSOLEDRT;                                   <<03003>>11092000
          TOS := BAUDRATE+%161000; <<ENABLE INTS-SEND PARAM.>> <<03003>>11094000
          IF BAUDRATE=%202 THEN TOS.(7:1) := 1; <<11 BIT CHAR>><<03003>>11096000
          WIO1;                                                <<03003>>11098000
          TOS := 2;    <<UNIT 0>>                              <<03003>>11100000
          CIO1;  <<SEND TO CHANNEL>>                           <<03003>>11102000
          TOS := CHAR.(9:7)+%43400;  <<CHARACTER TO SEND>>     <<03003>>11104000
          WIO1;                                                <<03003>>11106000
          TOS := 2;                                            <<03003>>11108000
          CIO1;  <<SEND TO UNIT 0>>                            <<03003>>11110000
  WAIT:   DO TIO0 UNTIL TOS.(4:1) <> 0; <<WAIT FOR COMPLETION>><<03003>>11112000
          TIO0;                                                <<03003>>11114000
          IF NOT TOS.(5:1) THEN                                <<03003>>11116000
            BEGIN  <<WRONG DIRECTION>>                         <<03003>>11118000
  WRONGUNIT:  TOS := 1;                                        <<03003>>11120000
              CIO1;                                            <<03003>>11122000
              GO WAIT;                                         <<03003>>11124000
            END;                                               <<03003>>11126000
          RIO0;                                                <<03003>>11128000
          IF TOS.(0:5)<>0 THEN GO WRONGUNIT;                   <<03003>>11130000
          TOS := 1;  <<ACK INT>>                               <<03003>>11132000
          CIO1;                                                <<03003>>11134000
          IF HP26XX THEN                                       <<03003>>11136000
             IF (CHARCNT:=CHARCNT+1) >= 79 THEN                <<03003>>11138000
                BEGIN                                          <<03003>>11140000
                CHARCNT := 0; << ZERO CHARACTER COUNTER >>     <<03003>>11142000
                WRITECHAR( ENQ);                               <<03003>>11144000
                DO UNTIL READCHAR.(9:7)=ACK; <<WAIT FOR ACK>>  <<03003>>11146000
                END;                                           <<03003>>11148000
      END <<WRITECHAR>> ;                                      <<03003>>11150000
$PAGE                                                          <<03003>>11152000
$CONTROL SEGMENT=RESIDENT                                      <<03003>>11154000
          <<----------------------------->>                    <<03003>>11156000
          <<READ A CHARACTER FROM CONSOLE>>                    <<03003>>11158000
          <<----------------------------->>                    <<03003>>11160000
  INTEGER PROCEDURE READCHAR( WAITMS);                         <<03003>>11162000
  VALUE WAITMS;                                                <<03003>>11164000
  LOGICAL WAITMS;     <<DUMMY PARAMETER>>                      <<03003>>11166000
  OPTION VARIABLE;                                             <<03003>>11168000
     COMMENT                                                   <<03003>>11170000
     THIS PROCEDURE CAN BE CALLED WITH AN OPTIONAL             <<03003>>11172000
     PARAMETER WHICH IS NOT USED.  IT IS THERE TO MAKE         <<03003>>11174000
     THE PROCEDURE THE SAME AS READCHAR FOR THE SERIES 33,     <<03003>>11176000
     WHICH USES THE PARAMETER AS A READ TIMEOUT FOR AUTO-      <<03003>>11178000
     MATIC SPEED SENSING.  THIS TIMEOUT IS IMPLEMENTED         <<03003>>11180000
     IN PROCEDURE SPEEDSENSE FOR THE SERIES II/III;            <<03003>>11182000
      BEGIN                                                    <<03003>>11184000
          TOS := CONSOLEDRT;                                   <<03003>>11186000
          TOS := BAUDRATE+%131000; <<ENABLE INTS,ECHO>>        <<03003>>11188000
          IF BAUDRATE=%202 THEN TOS.(7:1) := 1; <<11 BIT CHAR>><<03003>>11190000
          WIO1;  <<SET BAUDRATE>>                              <<03003>>11192000
          TOS := 2;    <<UNIT 0>>                              <<03003>>11194000
          CIO1;  <<SEND TO CHANNEL>>                           <<03003>>11196000
  WRONGUNIT:  <<COME HERE IF WRONG UNIT USED>>                 <<03003>>11198000
          DO TIO0 UNTIL TOS.(4:1) <> 0;                        <<03003>>11200000
          TIO0;                                                <<03003>>11202000
          IF TOS.(5:1) THEN                                    <<03003>>11204000
            BEGIN  <<WRONG DIRECTION>>                         <<03003>>11206000
              TOS := 1;                                        <<03003>>11208000
              CIO1;  <<ACK INT>>                               <<03003>>11210000
              GO WRONGUNIT;                                    <<03003>>11212000
            END;                                               <<03003>>11214000
          TOS := 1;                                            <<03003>>11216000
          CIO1;   <<ACK INT>>                                  <<03003>>11218000
          RIO0;    <<READ CHARACTER>>                          <<03003>>11220000
          IF S0.(0:5)<>0 THEN                                  <<03003>>11222000
            BEGIN  <<WRONG UNIT>>                              <<03003>>11224000
              DEL;                                             <<03003>>11226000
              GO WRONGUNIT;                                    <<03003>>11228000
            END;                                               <<03003>>11230000
          READCHAR := TOS.(9:7);  <<RETURN CHARACTER>>         <<03003>>11232000
      END <<READCHAR>> ;                                       <<03003>>11234000
$PAGE                                                          <<03003>>11236000
$IF      <<**********RETURNING TO COMMON CODE************>>    <<03003>>11238000
$CONTROL SEGMENT = RESIDENT                                    <<03003>>11240000
         <<------------------------------->>                   <<03003>>11242000
         << PRINT A LINE ON THE CONSOLE   >>                   <<03003>>11244000
         <<------------------------------->>                   <<03003>>11246000
PROCEDURE PRINT( BUFF, LENGTH, CONTROL);                       <<03003>>11248000
VALUE LENGTH, CONTROL;                                         <<03003>>11250000
ARRAY BUFF;        << OUTPUT BUFFER >>                         <<03003>>11252000
INTEGER LENGTH,  << LENGTH OF TRANSFER, +WORDS OR -BYTES>>     <<03003>>11254000
        CONTROL; << LINE SPACE CONTROL WORD             >>     <<03003>>11256000
                                                               <<03003>>11258000
   COMMENT                                                     <<03003>>11260000
   PRINTS A LINE OF OUTPUT ON THE SYSTEM CONSOLE.              <<03003>>11262000
   IF "CONTROL" IS A ZERO, FOLLOWS WITH CR-LF;                 <<03003>>11264000
                                                               <<03003>>11266000
BEGIN                                                          <<03003>>11268000
   EQUATE CR = %15, LF = %12;                                  <<03003>>11270000
   INTEGER CHAR,         << TEMP. FOR 2 CURRENT CHARS. >>      <<03003>>11272000
           CHARCOUNT := 0;   << CURRENT CHAR. COUNT    >>      <<03003>>11274000
                                                               <<03003>>11276000
   << CONVERT LENGTH TO POSITIVE NO. OF BYTES >>               <<03003>>11278000
   TOS := LENGTH;                                              <<03003>>11280000
   LENGTH := IF > THEN TOS&LSL(1)                              <<03003>>11282000
             ELSE -TOS;                                        <<03003>>11284000
                                                               <<03003>>11286000
   WHILE CHARCOUNT < LENGTH DO     << WRITE OUT BUFFER >>      <<03003>>11288000
      BEGIN                                                    <<03003>>11290000
                                                               <<03003>>11292000
      << IN CASE DB IS NOT POINTING TO THE STACK,      >>      <<03003>>11294000
      << GRAB THE BUFFER A WORD AT A TIME.  IF BUFF    >>      <<03003>>11296000
      << IF NOT WITHIN  32K BYTES OF THE STACK, BYTE   >>      <<03003>>11298000
      << ADDRESSING WOULD NOT WORK.                    >>      <<03003>>11300000
                                                               <<03003>>11302000
      CHAR := BUFF( CHARCOUNT&LSR(1));                         <<03003>>11304000
                                                               <<03003>>11306000
      << IF CHARCOUNT IS EVEN GET LEFT BYTE, ELSE RIGHT  >>    <<03003>>11308000
      WRITECHAR( IF LOGICAL( CHARCOUNT) THEN CHAR.(8:8)        <<03003>>11310000
                                        ELSE CHAR.(0:8));      <<03003>>11312000
      CHARCOUNT := CHARCOUNT + 1;                              <<03003>>11314000
      END;                                                     <<03003>>11316000
                                                               <<03003>>11318000
   IF CONTROL = 0 THEN                                         <<03003>>11320000
      BEGIN                                                    <<03003>>11322000
      WRITECHAR(CR);     << CARRIAGE RETURN >>                 <<03003>>11324000
      WRITECHAR(LF);     << LINE FEED       >>                 <<03003>>11326000
      END;                                                     <<03003>>11328000
END;       << PRINT >>                                         <<03003>>11330000
$CONTROL SEGMENT = RESIDENT                                    <<03003>>11332000
          <<-------------------->>                             <<03003>>11334000
          <<READ A LINE OF INPUT>>                             <<03003>>11336000
          <<-------------------->>                             <<03003>>11338000
  PROCEDURE READINPUT(BUFFER);                                 <<03003>>11340000
  INTEGER ARRAY BUFFER;                                        <<03003>>11342000
  OPTION VARIABLE;                                             <<03003>>11344000
    COMMENT                                                    <<03003>>11346000
      READS A LINE OF INPUT FROM THE SYSTEM CONSOLE INTO THE   <<03003>>11348000
    BUFFER INBUF, UNLESS ANOTHER BUFFER IS SPECIFIED;          <<03003>>11350000
      BEGIN                                                    <<03003>>11352000
        EQUATE CTRLH=%10,CTRLX=%30,LF=%12,CR=%15;              <<03003>>11354000
        INTEGER I:=0,CHAR,PARMS=Q-4;                           <<03003>>11356000
        LOGICAL PREV'H := FALSE; <<LAST CHAR WAS A CTL H>>     <<03003>>11358000
        DOUBLE DELETED := "!!! ";                              <<03003>>11360000
        POINTER WPBUFFER;                                      <<04306>>11362000
        BYTE POINTER BPBUFFER;                                 <<03003>>11364000
        CHARCNT := 0; <<ZERO HP26XX COUNTER>>                  <<03003>>11366000
READAGAIN:                                                     <<03003>>11368000
        IF PARMS.(15:1)=0 THEN                                 <<03003>>11370000
          BEGIN <<USE INBUF>>                                  <<03003>>11372000
          @WPBUFFER := @INBUF;                                 <<04306>>11374000
          @BPBUFFER:=@INBUF&LSL(1);                            <<03003>>11376000
          @BPINBUF := @INBUF&LSL(1);                           <<03003>>11378000
          END                                                  <<03003>>11380000
        ELSE                                                   <<03003>>11382000
          BEGIN                                                <<04306>>11384000
          @WPBUFFER := @BUFFER;                                <<04306>>11386000
          @BPBUFFER:=@BUFFER&LSL(1);                           <<03003>>11388000
          END;                                                 <<04306>>11390000
  NEXTCHAR:                                                    <<03003>>11392000
          CHAR := READCHAR.(9:7);                              <<03003>>11394000
          IF CHAR=0 OR <<NULL>>                                <<03003>>11396000
             CHAR=%23 OR  <<X-OFF>>                            <<03003>>11398000
             CHAR=%12 OR  <<LF>>                               <<03003>>11400000
             CHAR=%177 THEN GO NEXTCHAR;  <<RUBOUT>>           <<03003>>11402000
          IF CHAR=CTRLH THEN                                   <<03003>>11404000
            BEGIN   <<BACKSPACE>>                              <<03003>>11406000
              IF I=0 THEN     << NO CHARACTERS ON LINE >>      <<03003>>11408000
                 IF HP26XX THEN                                <<03003>>11410000
                    WRITECHAR(" ")                             <<03003>>11412000
                 ELSE                                          <<03003>>11414000
                    WRITECHAR("/")                             <<03003>>11416000
              ELSE                                             <<03003>>11418000
                 BEGIN                                         <<03003>>11420000
                 I := I-1;   << DECREMENT CHARACTER COUNT >>   <<03003>>11422000
                 IF HP26XX THEN                                <<03003>>11424000
                    BEGIN                                      <<03003>>11426000
                    IF NOT PREV'H THEN WRITECHAR(LF);          <<03003>>11428000
                    PREV'H := TRUE;                            <<03003>>11430000
                    END                                        <<03003>>11432000
                 ELSE                                          <<03003>>11434000
                    WRITECHAR("/");                            <<03003>>11436000
                 END;                                          <<03003>>11438000
              GOTO NEXTCHAR;                                   <<03003>>11440000
            END;                                               <<03003>>11442000
          IF CHAR=CTRLX THEN                                   <<03003>>11444000
            BEGIN   <<DELETE LINE>>                            <<03003>>11446000
              I := 0;                                          <<03003>>11448000
              PRINT(DELETED,-3,0); << "!!!" >>                 <<03003>>11450000
              GO NEXTCHAR;                                     <<03003>>11452000
            END;                                               <<03003>>11454000
          BPBUFFER(I) := CHAR;                                 <<03003>>11456000
          IF CHAR=CR THEN                                      <<03003>>11458000
            BEGIN   <<CARRIAGE RETURN>>                        <<03003>>11460000
              WRITECHAR(LF);   <<OUTPUT A LINE FEED>>          <<03003>>11462000
              IF BPBUFFER = ("?",13) THEN                      <<03003>>11464000
                 BEGIN                                         <<03003>>11466000
                 HELP;                                         <<03003>>11468000
                 MOVE BPBUFFER := "READ PENDING";              <<03003>>11470000
                 PRINT(WPBUFFER,-12,0);                        <<04306>>11472000
                 I := 0;                                       <<03003>>11474000
                 GO READAGAIN;                                 <<03003>>11476000
                 END;                                          <<03003>>11478000
              RETURN;                                          <<03003>>11480000
            END;                                               <<03003>>11482000
          IF I<72 THEN I:=I+1;                                 <<03003>>11484000
          PREV'H := FALSE;                                     <<03003>>11486000
          GOTO NEXTCHAR;                                       <<03003>>11488000
      END <<READINPUT>> ;                                      <<03003>>11490000
$PAGE                                                          <<03003>>11492000
$IF X1=ON   << ********** SERIES 33 UNIQUE **********>>        <<03003>>11494000
$CONTROL SEGMENT = CONFIGURE                                   <<03004>>11498000
           <<-------------------------------->>                <<03004>>11500000
           << RESET THE SYSTEM CONSOLE BOARD >>                <<03004>>11502000
           <<-------------------------------->>                <<03004>>11504000
PROCEDURE CONSOLEINIT;                                         <<03004>>11506000
   COMMENT                                                     <<03004>>11508000
   RESETS THE SYSTEM CONSOLE BOARD, EITHER LYNX OR ADCC.       <<03004>>11510000
   CALLED ONCE BEFORE SPEEDSENSING AND AGAIN IF AUTO-          <<03004>>11512000
   SPEEDSENSE FAILS;                                           <<03004>>11514000
   BEGIN                                                       <<03004>>11516000
                         << ADCC PARAMETERS >>                 <<03004>>11518000
   ARRAY INITPGM(*) = PB :=    << CHANNEL PROGRAM >>           <<03004>>11520000
     <<  0 >>      %2001,  << WRITE, MOD 1                >>   <<03004>>11522000
     <<  1 >>          1,  << MASTER RESET, 1 START,      >>   <<03004>>11524000
     <<  2 >>          1,  << 8 DATA, 1 STOP, NO PARITY   >>   <<03004>>11526000
     <<  3 >>    %160000,                                      <<03004>>11528000
     <<  4 >>          0,                                      <<03004>>11530000
                                                               <<03004>>11532000
     <<  5 >>      %2007,  << WRITE, MOD 7                >>   <<03004>>11534000
     <<  6 >>          1,  << SET LINE REFERENCE TO       >>   <<03004>>11536000
     <<  7 >>          1,  << A KNOWN STATE               >>   <<03004>>11538000
     << 10 >>    %160000,                                      <<03004>>11540000
     << 11 >>          0,                                      <<03004>>11542000
                                                               <<03004>>11544000
     << 12 >>       %600,  << INTERRUPT, HALT             >>   <<03004>>11546000
     << 13 >>          0,                                      <<03004>>11548000
                                                               <<03004>>11550000
     << 14 >>       %231,  << DATA FOR MASTER RESET, ETC. >>   <<03004>>11552000
     << 15 >>        %40;  << DATA FOR SET LINE REFERENCE >>   <<03004>>11554000
                                                               <<03004>>11556000
   EQUATE                                                      <<03004>>11558000
      INIT'RSTADR         =  %4,                               <<03004>>11560000
      INIT'REFADR         = %11,                               <<03004>>11562000
      INIT'MASTERESET     = %14,                               <<03004>>11564000
      INIT'SETREF         = %15,                               <<03004>>11566000
      INIT'LEN            = %16;                               <<03004>>11568000
                                                               <<03004>>11570000
   ARRAY BUF(0:INIT'LEN-1) = Q;  << FOR BUILDING CHAN. PROG.>> <<03004>>11572000
   DOUBLE DADR;         << ABSOLUTE ADDR OF CHAN. PROG. >>     <<03004>>11574000
   INTEGER                                                     <<03004>>11576000
      BANK = DADR,      << BANK OF ARRAY BUF            >>     <<03004>>11578000
      ADR = DADR+1,     << ADDRESS OF ARRAY BUF         >>     <<03004>>11580000
      CPADR;            << ABSOLUTE ADDR. OF CHAN. PROG.>>     <<03004>>11582000
                                                               <<03004>>11584000
                         << LYNX PARAMETERS >>                 <<03004>>11586000
   LOGICAL INIT'COMMAND := %20000;                             <<03004>>11588000
                                                               <<03004>>11590000
                                                               <<03004>>11594000
   IF (GETBOARDTYPE(CONSOLEDRT) = LYNX'BOARD) THEN             <<03004>>11596000
      BEGIN   << CONSOLE IS ON LYNX >>                         <<03004>>11598000
                                                               <<03022>>11602000
      << SEND INIT COMMAND TO LYNX >>                          <<03022>>11604000
      WIOC( CONSOLEDRT, INIT'COMMAND, 0);                      <<03022>>11606000
      IF <> THEN ERRMESSAGE( M1, CONSOLEDRT);   << FAILURE >>  <<03022>>11608000
                                                               <<03022>>11610000
      DELAY( 10D);         << GIVE INIT TIME TO COMPLETE >>    <<03715>>11612000
      END     << CONSOLE IS ON LYNX >>                         <<03004>>11614000
                                                               <<03004>>11616000
   ELSE                                                        <<03004>>11618000
      BEGIN   << CONSOLE IS ON ADCC >>                         <<03004>>11620000
      CPADR := ABSOLUTE( TERMCHANPROG);                        <<03004>>11622000
      PUSH( DB);                                               <<03004>>11624000
      TOS := TOS + @BUF;                                       <<03004>>11626000
      DADR := TOS;                                             <<03004>>11628000
                                                               <<03004>>11630000
      << SET UP INITIALIZATION CHANNEL PROGRAM ON STACK >>     <<03004>>11632000
                                                               <<03004>>11634000
      MOVE BUF := INITPGM,(INIT'LEN);                          <<03004>>11636000
      BUF( INIT'RSTADR) := CPADR+INIT'MASTERESET;              <<03004>>11638000
      BUF( INIT'REFADR) := CPADR+INIT'SETREF;                  <<03004>>11640000
                                                               <<03004>>11642000
      << MOVE CHAN PGM TO CHAN PGM AREA IN BANK 0 >>           <<03004>>11644000
      MABS( 0,CPADR,BANK,ADR,INIT'LEN);                        <<03004>>11646000
                                                               <<03004>>11648000
      << DO INIT ON CONSOLE                       >>           <<03004>>11650000
      INIT( CONSOLEDRT);                                       <<03022>>11652000
      IF <> THEN ERRMESSAGE( M2, CONSOLEDRT);   << FAILURE >>  <<03022>>11654000
                                                               <<03004>>11656000
      << RUN THE CHANNEL PROGRAM                  >>           <<03004>>11658000
      SIOP( CONSOLEDRT, CPADR);                                <<03022>>11662000
      IF <> THEN ERRMESSAGE( M2, CONSOLEDRT);   << FAILURE >>  <<03022>>11664000
      WHILE GETDRT( CONSOLEDRT, CHANSTAT).(0:2) <> 0 DO;       <<03004>>11666000
      END;    << CONSOLE IS ON ADCC >>                         <<03004>>11668000
   END;   << CONSOLEINIT >>                                    <<03004>>11670000
$CONTROL SEGMENT = CONFIGURE                                   <<03003>>11674000
         <<------------------------------------------>>        <<03003>>11676000
         << TRY TO SPEED SENSE CONSOLE AUTOMATICALLY >>        <<03003>>11678000
         <<------------------------------------------>>        <<03003>>11680000
LOGICAL PROCEDURE AUTOSPEEDSENSE;                              <<03003>>11682000
   COMMENT                                                     <<03003>>11684000
   TRY TO DETERMINE SPEED OF THE TERMINAL BY SENDING ENQ       <<03003>>11686000
   AND WAITING FOR ACK TO RETURN, AT ALL POSSIBLE TERMINAL     <<03003>>11688000
   SPEEDS.  WORKS ONLY FOR 26XX TYPE TERMINALS;                <<03003>>11690000
   BEGIN                                                       <<03003>>11692000
   INTEGER ARRAY BRPARAM(0:10) = PB :=  <<BAUD RATE PARAMS. >> <<03004>>11694000
      %10,         << 9600>>            <<FOR ADCC, LYNX    >> <<03004>>11696000
      %11,         << 4800>>                                   <<03004>>11698000
      %7,          << 2400>>                                   <<03004>>11700000
      %13,         << 1200>>                                   <<03004>>11702000
      %6,          <<  600>>                                   <<03004>>11704000
      %15,         <<  300>>                                   <<03004>>11706000
      %16,         <<  150>>                                   <<03004>>11708000
      %17,         <<  110>>                                   <<03004>>11710000
      %20,         <<19200>>            << THE LAST 3 SPEEDS>> <<03004>>11712000
      %21,         <<38400>>            << FOR LYNX ONLY    >> <<03004>>11714000
      %22;         << 1800>>                                   <<03004>>11716000
   INTEGER ARRAY SPEEDS(0:10) = PB :=   << BAUD RATES IN    >> <<03004>>11718000
      960,480,240,120,60,30,15,10,      <<  CHARS/SECOND    >> <<03004>>11720000
          1920,3840,180;                                       <<03004>>11722000
   EQUATE WAITMS = 200;    << 200 MILLISECOND TIMEOUT >>       <<03003>>11724000
   EQUATE  ENQ=5, ACK=6;                                       <<03003>>11726000
   INTEGER I,               << INDEX VARIABLE               >> <<03003>>11728000
           CHAR,            << TEMP FOR CURRENT CHARACTER   >> <<03004>>11730000
           LIM;             << ARRAY LIMIT                  >> <<03004>>11732000
   LOGICAL FOUND = AUTOSPEEDSENSE;                             <<03003>>11734000
   FOUND := FALSE;                                             <<03003>>11736000
   I := 0;                                                     <<03003>>11738000
   IF GETBOARDTYPE(CONSOLEDRT) = LYNX'BOARD THEN LIM := 10     <<03004>>11740000
                                            ELSE LIM := 7;     <<03004>>11742000
   DO BEGIN     <<LOOP, TEST TERMINAL AT ALL POSSIBLE SPEEDS>> <<03003>>11744000
      BAUDRATE := BRPARAM(I);                                  <<03003>>11746000
      CONSPEED := SPEEDS(I);                                   <<03003>>11748000
      WRITECHAR( ENQ);       <<WRITE ENQ TO TERMINAL>>         <<03003>>11750000
      CHAR := READCHAR(WAITMS).(9:7); <<IF TERMINAL RESPONDS>> <<03003>>11752000
      IF CHAR = ACK THEN              << WITH ACK, IT'S AN  >> <<03003>>11754000
          FOUND := TRUE;              << HP26XX, QUIT LOOP >>  <<03003>>11756000
      I := I + 1;                                              <<03003>>11758000
      END                                                      <<03003>>11760000
   UNTIL I > LIM OR FOUND;        << CONTINUE TEST >>          <<03004>>11762000
   END;   << AUTOSPEEDSENSE >>                                 <<03003>>11764000
                                                               <<03003>>11766000
$CONTROL SEGMENT=CONFIGURE                                     <<03003>>11768000
          <<-------------------------->>                       <<03003>>11770000
          <<DETERMINE SPEED OF CONSOLE>>                       <<03003>>11772000
          <<-------------------------->>                       <<03003>>11774000
  PROCEDURE SPEEDSENSE;                                        <<03003>>11776000
    COMMENT                                                    <<03003>>11778000
    DETERMINES THE SPEED OF THE SYSTEM CONSOLE BY FIRST        <<03003>>11780000
    TRYING TO DETECT THE SPEED AUTOMATICALLY USING ENQ-ACK     <<03003>>11782000
    PAIRS (PROCEDURE AUTOSPEEDSENSE).  THIS ONLY WORKS ON      <<03003>>11784000
    26XX TYPE TERMINALS.  IF THIS DOESN'T WORK, IT SETS UP     <<03003>>11786000
    FOR A CERTAIN BAUDRATE, WAITS FOR THE OPERATOR TO TYPE     <<03003>>11788000
    A CR, AND THEN TRIES TO DETERMINE THE BAUDRATE FROM        <<03003>>11790000
    THE GARBAGE THAT COMES BACK;                               <<03003>>11792000
      BEGIN                                                    <<03003>>11794000
EQUATE NUMSPEEDS=15;                                           <<03003>>11796000
INTEGER ARRAY SPEEDS(6:NUMSPEEDS)=PB:=60,240,960,480,          <<03003>>11798000
-1,120,-1,30,15,10;                                            <<03003>>11800000
INTEGER ARRAY SPEEDCODES(6:NUMSPEEDS)=PB:=6,7,8,9,             <<03003>>11802000
-1,11,-1,13,14,15;                                             <<03003>>11804000
<<ADCC CODES FOR FOR SUPPORTED TERMINAL SPEEDS>>               <<03003>>11806000
INTEGER ARRAY GARBAGECHAR(6:NUMSPEEDS)=PB:=                    <<03003>>11808000
%170,%15,%377,%376,-1,%346,-1,%200,%303,%7;                    <<03003>>11810000
<<VALUE EXPECTED IN CHAR FOR EACH SUPPORTED CONSOLE SPEED>>    <<03003>>11812000
                                                               <<03003>>11814000
INTEGER I:=0,                                                  <<03003>>11816000
        BOARD,    << BOARD TYPE ON CONSOLE CHANNEL >>          <<03004>>11818000
        CHAR;                                                  <<03003>>11820000
EQUATE NULL=0, <<THE NULL CHARACTER IS RECEIVED IF THE>>       <<03003>>11822000
       <<CONSOLE IS SENDING TOO SLOW COMPARED TO THE>>         <<03003>>11824000
       <<CONFIGURED SPEED.  USED AS A KEY TO>>                 <<03003>>11826000
       <<RECONFIGURE AND RE-READ.>>                            <<03003>>11828000
       DEFAULTSPEEDCODE=7, <<START BY ASSUMING 2400BAUD>>      <<03003>>11830000
       DEFAULTSPEED=240,                                       <<03003>>11832000
       SECONDSPEEDCODE=14, <<IF 2400 RETURNS THE NULL>>        <<03003>>11834000
       <<CHARACTER, RECONFIGURE AT 150 AND RETRY>>             <<03003>>11836000
       SECONDSPEED=15;                                         <<03003>>11838000
       LOGICAL FOUND := FALSE;                                 <<03003>>11840000
                                                               <<03003>>11842000
                  <<INITIALIZE CHAR. COUNT FOR WRITECHAR >>    <<03003>>11844000
          CHARCNT := 0;                                        <<03003>>11846000
                                                               <<03003>>11848000
          BOARD := GETBOARDTYPE(CONSOLEDRT);                   <<03004>>11850000
          << IF WRONG BOARD OR NO BOARD RESPONDS ON     >>     <<03004>>11852000
          << CONSOLE CHANNEL, DO A HALT %10             >>     <<03004>>11854000
          IF BOARD <> LYNX'BOARD AND BOARD <> ADCC'BOARD THEN  <<03004>>11856000
             ASSEMBLE( HALT %10);                              <<03004>>11858000
                                                               <<03004>>11860000
          << INITIALIZE LYNX OR ADCC BOARD >>                  <<03004>>11862000
          CONSOLEINIT;                                         <<03003>>11864000
                                                               <<03003>>11866000
          << CALL AUTOSPEEDSENSE TO TRY TO DETERMINE THE   >>  <<03003>>11868000
          << SYSTEM CONSOLE BAUDRATE AUTOMATICALLY.  ONLY  >>  <<03003>>11870000
          << WORKS FOR 26XX TERMINALS.  AUTOSPEEDSENSE     >>  <<03003>>11872000
          << RETURNS TRUE IF IT SUCCEEDS.                  >>  <<03003>>11874000
                                                               <<03003>>11876000
          HP26XX := FALSE;                                     <<03003>>11878000
          IF AUTOSPEEDSENSE THEN                               <<03003>>11880000
             BEGIN                                             <<03003>>11882000
             HP26XX := TRUE;                                   <<03003>>11884000
             RETURN;                                           <<03003>>11886000
             END;                                              <<03003>>11888000
                                                               <<03003>>11890000
          << NOT AN HP26XX TERMINAL--MUST DETERMINE CONSOLE>>  <<03003>>11892000
          << SPEED BY SETTING THE CONSOLE TO A CERTAIN     >>  <<03003>>11894000
          << SPEED AND INTERPRETING THE GARBAGE THAT COMES >>  <<03003>>11896000
          << BACK, HOPING THE OPERATOR TYPES A CR.         >>  <<03003>>11898000
                                                               <<03003>>11900000
          DO                                                   <<03003>>11902000
             BEGIN <<MAKE OPERATOR TYPE CR>>                   <<03003>>11904000
             CONSOLEINIT;                                      <<03003>>11906000
             BAUDRATE := DEFAULTSPEEDCODE;                     <<03003>>11908000
             CONSPEED:=DEFAULTSPEED;                           <<03003>>11910000
             CHAR:=READCHAR(0).(8:8);                          <<03003>>11912000
                                                               <<03003>>11914000
          << IF CONSOLE IS SENDING TOO SLOW COMPARED TO    >>  <<03003>>11916000
          << THE CONFIGURED SPEED, A NULL CHARACTER IS     >>  <<03003>>11918000
          << RETURNED FROM READCHAR ( BEFORE OPERATOR TYPES>>  <<03003>>11920000
          << ANYTHING).  SO, RECONFIGURE AT LOWEST POSSIBLE>>  <<03003>>11922000
          << SPEED (110) AND READ A CHARACTER.  OTHERWISE, >>  <<03003>>11924000
          << INTERPRET THE GARBAGE THAT CAME BACK.         >>  <<03003>>11926000
                                                               <<03003>>11928000
             IF CHAR=NULL THEN                                 <<03003>>11930000
                BEGIN  << RECONFIGURE AND RETRY >>             <<03003>>11932000
                BAUDRATE := SECONDSPEEDCODE;                   <<03003>>11934000
                CONSPEED:=SECONDSPEED;                         <<03003>>11936000
                CHAR:=READCHAR(0).(8:8);                       <<03003>>11938000
                END;                                           <<03003>>11940000
             I:=6; <<LOWEST SUPPORTED SPEED>>                  <<03003>>11942000
             DO                                                <<03003>>11944000
                BEGIN <<TEST FOR VALID SPEED>>                 <<03003>>11946000
                IF CHAR=GARBAGECHAR(I) THEN                    <<03003>>11948000
                   BEGIN <<FOUND IT>>                          <<03003>>11950000
                   BAUDRATE := SPEEDCODES(I);                  <<03003>>11952000
                   CONSPEED:=SPEEDS(I);                        <<03003>>11954000
                   FOUND:=TRUE;                                <<03003>>11956000
                   END;                                        <<03003>>11958000
                END                                            <<03003>>11960000
             UNTIL (I:=I+1)>NUMSPEEDS;                         <<03003>>11962000
             IF CHAR=%362 THEN                                 <<03003>>11964000
                BEGIN <<SPECIAL ALTERNATE CASE FOR 4800>>      <<03003>>11966000
                BAUDRATE := SPEEDCODES(9);                     <<03003>>11968000
                CONSPEED:=SPEEDS(9);                           <<03003>>11970000
                FOUND:=TRUE;                                   <<03003>>11972000
                END;                                           <<03003>>11974000
             END                                               <<03003>>11976000
          UNTIL FOUND;                                         <<03003>>11978000
      END <<SPEEDSENSE>> ;                                     <<03003>>11980000
$CONTROL SEGMENT=RESIDENT                                      <<03603>>11982000
$CONTROL SEGMENT=RESIDENT                                      <<03004>>11986000
          <<---------------------------->>                     <<03004>>11988000
          <<WRITE A CHARACTER ON CONSOLE>>                     <<03004>>11990000
          <<---------------------------->>                     <<03004>>11992000
  LOGICAL PROCEDURE WRITECHAR(CHAR);                           <<03004>>11994000
    VALUE CHAR;                                                <<03004>>11996000
    INTEGER CHAR;                                              <<03004>>11998000
      COMMENT                                                  <<03004>>12000000
        THIS PROCEDURE OUTPUTS THE BYTE CHAR DIRECTLY TO THE   <<03004>>12002000
        SYSTEM CONSOLE.  THIS PROCEDURE HANDLES BOTH ADCC      <<03004>>12004000
        AND LYNX CONSOLES.  NOTE:  RESPONSIBILITY FOR          <<03004>>12006000
        SUPPORTING THIS PROCEDURE FALLS TO THE PEOPLE THAT     <<03004>>12008000
        SUPPORT TERMINAL SOFTWARE.  DO NOT MAKE ANY CHANGES    <<03004>>12010000
        TO THIS PROCEDURE BEFORE CONSULTING THEM! ;            <<03004>>12012000
                                                               <<03004>>12014000
BEGIN   << START OF WRITECHAR  >>                              <<03004>>12016000
EQUATE                                                         <<03004>>12018000
   R0    = 0,                                                  <<03004>>12020000
   R1    = 1,                                                  <<03004>>12022000
   R2    = 2,                                                  <<03004>>12024000
   R3    = 3,                                                  <<03004>>12026000
   R4    = 4,                                                  <<03004>>12028000
   R5    = 5,                                                  <<03004>>12030000
   R6    = 6,                                                  <<03004>>12032000
   R7    = 7,                                                  <<03004>>12034000
   R8    = 8,                                                  <<03004>>12036000
   R9    = 9,                                                  <<03004>>12038000
   RA    = %(16)A,                                             <<03004>>12040000
   RB    = %(16)B,                                             <<03004>>12042000
   RC    = %(16)C,                                             <<03004>>12044000
   RD    = %(16)D,                                             <<03004>>12046000
   RE    = %(16)E,                                             <<03004>>12048000
   RF    = %(16)F;                                             <<03004>>12050000
EQUATE                                                         <<03004>>12052000
   BIT0 = %100000,                                             <<03004>>12054000
   BIT2 = %20000,                                              <<03029>>12056000
   B14'SET = 2,                                                <<03004>>12058000
   B14'CLEAR = 0,                                              <<03004>>12060000
   CONSOLEDRT = %10,                                           <<03004>>12062000
   DMA'CONTROL = %100000,                                      <<03004>>12064000
   DMA'RIGHT = %40000,                                         <<03004>>12066000
   ENABLE'MASK = %177577,                                      <<03004>>12068000
   GO'LYNX = %(16)BF8D,                                        <<03004>>12070000
   ICF'55 = 4,                                                 <<03004>>12072000
   GRIZZLY = 3,                                                <<03004>>12074000
   LYNX'TYPE = %50017,                                         <<03004>>12076000
   PORT'HCP = 8,                                               <<03004>>12078000
   READ'DONE = 6,                                              <<03004>>12080000
   SIO'PORT = 4,                                               <<03004>>12082000
   STD'CONS'AIB = 0,                                           <<03004>>12084000
   STD'CONS'PORT = 0,                                          <<03004>>12086000
   WRITE'DONE = %16;                                           <<03029>>12088000
DEFINE   << DEFINES FOR LYNX REGISTERS >>                      <<03004>>12090000
   WRITE'DMA'ADDR      = R0#,                                  <<03004>>12092000
   WRITE'DMA'BANK       = R1#,                                 <<03004>>12094000
   CONTROL'DMA'ADDR     = R2#,                                 <<03004>>12096000
   CONTROL'DMA'BANK     = R3#,                                 <<03004>>12098000
   READ'DMA'ADDR        = R4#,                                 <<03004>>12100000
   READ'DMA'BANK        = R5#,                                 <<03004>>12102000
   TERM'INTRPT'REASON   = R6#,                                 <<03004>>12104000
   INTRPTS'NO'FLUSH     = R8#,                                 <<03004>>12106000
   PORT'POINTER         = R8#,                                 <<03004>>12108000
   INTRPTS'FLUSH        = R9#,                                 <<03004>>12110000
   BOARD'ENABLE         = R9#,                                 <<03004>>12112000
   DIAG'REGA            = RA#,                                 <<03004>>12114000
   DIAG'WRITE           = RA#,                                 <<03004>>12116000
   DIAG'REGB            = RB#,                                 <<03004>>12118000
   DIRECT'COMMAND       = RB#,                                 <<03004>>12120000
   CHANNEL'CONFIG       = RE#,                                 <<03004>>12122000
   CHANNEL'CONFIG'2     = RF#;                                 <<03004>>12124000
DEFINE                                                         <<03004>>12126000
   DISABLE'INTRPTS = ASSEMBLE( SED 0 )#;                       <<03004>>12128000
LOGICAL   << NOTE !!! - DONT MOVE Q+1 THROUGH Q+8 >>           <<03029>>12130000
   CHARACTER,                                                  <<03004>>12132000
   READ'BRK,                                                   <<03004>>12134000
   CP'WRITECHAR  := %(16)8489, << ATP (LYNX) CONTROL     >>    <<03708>>12136000
   CP'WRITECHAR1 := %(16)0101, << PROGRAM.  SEE ATP      >>    <<03708>>12154000
   CP'WRITECHAR2 := %(16)0101, << DOCUMENTATION FOR THE  >>    <<03708>>12158000
   CP'WRITECHAR3 := %(16)0200, << MEANING OF THESE CODES >>    <<03708>>12168000
   CP'WRITECHAR4 := %(16)0100,                                 <<03708>>12170000
   CP'WRITECHAR5 := %(16)00FF, << END OF CONTROL PROGRAM >>    <<03708>>12172000
   AIB'ENABLE,                                                 <<03004>>12174000
   BOARD'TYPE,                                                 <<03004>>12176000
   CONS'CHANNEL,                                               <<03004>>12178000
   CONS'AIB,                                                   <<03004>>12180000
   CONS'PORT,                                                  <<03004>>12182000
   CPUNUM,                                                     <<03004>>12184000
   CURTIME,                                                    <<03004>>12186000
   DB'REG,      << CURRENT DB FOR PRINT >>                     <<03004>>12188000
   DMA'BANK,    << DMA BANK FOR PRINT   >>                     <<03004>>12190000
   INIT'COMMAND := %20000,                                     <<03004>>12192000
   INTRPT'ERROR,                                               <<03004>>12194000
   INTRPT'REASON,                                              <<03004>>12196000
   LYNX'INTRPT,                                                <<03004>>12198000
   PRINT'ADDR,                                                 <<03004>>12200000
   READ'COMMAND := 0,                                          <<03004>>12202000
   STARTIME,                                                   <<03004>>12204000
   SYS'UP := FALSE,                                            <<03004>>12206000
   TERM'INTRPT  := 0,                                          <<03004>>12208000
   WRITE'COMMAND := 0,                                         <<03004>>12210000
   WAIT'LIMIT := 4;    << 4 MILLISECOND DELAY >>               <<03004>>12212000
INTEGER                                                        <<03004>>12214000
   S2 = S-2,                                                   <<03004>>12216000
   S3 = S-3,                                                   <<03004>>12218000
   I,                                                          <<03004>>12220000
   J;                                                          <<03004>>12222000
INTEGER ARRAY LYNX'CONVERT(6:18) = PB :=  <<ADCC TO LYNX    >> <<03004>>12224000
 2,4,9,5,99,10,99,11,1,0,6,7,3;     <<BAUDRATE CONVERSIONS  >> <<03004>>12226000
                                                               <<03004>>12228000
  DOUBLE OLDDB;  <<DB WHEN PROCEDURE IS CALLED>>               <<03004>>12230000
  LOGICAL CPBASE;    <<BASE OF CHANNEL PROGRAM>>               <<03004>>12232000
  LOGICAL ARRAY CP(*) = DB+0;                                  <<03004>>12234000
  INTEGER ARRAY CHANIOPROG(0:%52)=PB:=                         <<03004>>12236000
                                                               <<03004>>12238000
     %2001,                << WRITE, MOD 1             >>      <<03004>>12240000
     1,                    << MASTER RESET, 1 START    >>      <<03004>>12242000
     1,                    << 8 DATA, 1 STOP,          >>      <<03004>>12244000
     [1/1,1/0,1/1,13/0],   << PARITY DISABLED          >>      <<03004>>12246000
     0,                                                        <<03004>>12248000
                                                               <<03004>>12250000
     %2002,                << WRITE, MOD 2             >>      <<03004>>12252000
     1,                    << TURN OFF ECHO            >>      <<03004>>12254000
     1,                                                        <<03004>>12256000
     [1/1,1/1,1/1,13/0],                                       <<03004>>12258000
     0,                                                        <<03004>>12260000
                                                               <<03004>>12262000
     %2003,                << WRITE, MOD 3             >>      <<03004>>12264000
     1,                    << ENABLE SRQ OUTPUT        >>      <<03004>>12266000
     1,                                                        <<03004>>12268000
     [1/1,1/0,1/1,13/0],                                       <<03004>>12270000
     0,                                                        <<03004>>12272000
                                                               <<03004>>12274000
     %2006,                << WRITE, MOD 6             >>      <<03004>>12276000
     1,                    << SET OUTPUT BAUDRATE      >>      <<03004>>12278000
     1,                                                        <<03004>>12280000
     [1/1,1/1,1/1,13/0],                                       <<03004>>12282000
     0,                                                        <<03004>>12284000
                                                               <<03004>>12286000
     %2006,                << WRITE, MOD 6             >>      <<03004>>12288000
     1,                    << SET INPUT BAUD RATE      >>      <<03004>>12290000
     1,                                                        <<03004>>12292000
     [1/1,1/0,1/1,13/0],                                       <<03004>>12294000
     0,                                                        <<03004>>12296000
                                                               <<03004>>12298000
     %2000,                << WRITE, MOD 0             >>      <<03004>>12300000
     1,                    << OUTPUT DATA              >>      <<03004>>12302000
     1,                                                        <<03004>>12304000
     [1/1,1/1,1/1,13/0],                                       <<03004>>12306000
     0,                                                        <<03004>>12308000
                                                               <<03004>>12310000
     %1000,                << WAIT FOR SRQ             >>      <<03004>>12312000
     0,                                                        <<03004>>12314000
                                                               <<03004>>12316000
     %2003,                << WRITE, MOD 3             >>      <<03004>>12318000
     1,                    << DISABLE SRQ OUTPUT       >>      <<03004>>12320000
     1,                                                        <<03004>>12322000
     [1/1,1/1,1/1,13/0],                                       <<03004>>12324000
     0,                                                        <<03004>>12326000
                                                               <<03004>>12328000
     %600,                 << INTERRUPT, HALT          >>      <<03004>>12330000
     0,                                                        <<03004>>12332000
                                                               <<03004>>12334000
     [8/%231,8/%000],      << MASTER RESET, 1 START,   >>      <<03004>>12336000
                           << 8 DATA, 1 STOP, NO PARITY>>      <<03004>>12338000
                           << ; NO ECHO                >>      <<03004>>12340000
     [8/%005,8/%000],      << SRQ OUTPUT ON; PLACE FOR >>      <<03004>>12342000
                           << OUTPUT BAUDRATE          >>      <<03004>>12344000
     0,                    << PLACE FOR OUTPUT CHAR.   >>      <<03004>>12346000
     [8/%000,8/%001];      << PLACE FOR INPUT BAUDRATE;>>      <<03004>>12348000
                           << SRQ OUTPUT OFF           >>      <<03004>>12350000
                                                               <<03004>>12352000
                                                               <<03004>>12354000
  EQUATE  DATA0 = %47,                                         <<03004>>12356000
          DATA1 = DATA0+1,                                     <<03004>>12358000
          DATA2 = DATA1+1,                                     <<03004>>12360000
          DATA3 = DATA2+1;                                     <<03004>>12362000
  EQUATE  ENQ = 5,                                             <<03004>>12364000
          ACK = 6;                                             <<03004>>12366000
                                                               <<03004>>12368000
SUBROUTINE WRITE'SIB'REG(REG'NUMB, DATA'OUT);                  <<03004>>12370000
VALUE REG'NUMB, DATA'OUT;                                      <<03004>>12372000
LOGICAL REG'NUMB,                                              <<03004>>12374000
        DATA'OUT;                                              <<03004>>12376000
BEGIN                                                          <<03004>>12378000
IF CPUNUM = ICF'55 THEN                                        <<03004>>12380000
   BEGIN   << CPU IS A 55 >>                                   <<03004>>12382000
   TOS := CONSOLEDRT;                                          <<03004>>12384000
   TOS := WRITE'COMMAND CAT S3(4:12:4);                        <<03004>>12386000
   TOS := S3;                                                  <<03004>>12388000
   ASSEMBLE( WIOA);                                            <<03004>>12390000
   END                                                         <<03004>>12392000
ELSE                                                           <<03004>>12394000
   BEGIN                                                       <<03004>>12396000
   TOS := WRITE'COMMAND CAT REG'NUMB(4:12:4) LOR               <<03004>>12398000
          CONSOLEDRT;                                          <<03004>>12400000
   TOS := S2;                                                  <<03004>>12402000
   ASSEMBLE( WIOC);                                            <<03004>>12404000
   END;                                                        <<03004>>12406000
END;                                                           <<03004>>12408000
LOGICAL SUBROUTINE READ'SIB'REG(REG'NUMB);                     <<03004>>12410000
VALUE REG'NUMB;                                                <<03004>>12412000
LOGICAL REG'NUMB;                                              <<03004>>12414000
BEGIN                                                          <<03004>>12416000
IF CPUNUM = ICF'55 THEN                                        <<03004>>12418000
   BEGIN   << CPU IS A 55 >>                                   <<03004>>12420000
   TOS := CONSOLEDRT;                                          <<03004>>12422000
   TOS := READ'COMMAND CAT S2(4:12:4);                         <<03004>>12424000
   ASSEMBLE( RIOA);                                            <<03004>>12426000
   END     << CPU IS A 55 >>                                   <<03004>>12428000
ELSE                                                           <<03004>>12430000
   BEGIN                                                       <<03004>>12432000
   TOS := READ'COMMAND CAT REG'NUMB(4:12:4) LOR                <<03004>>12434000
          CONSOLEDRT;                                          <<03004>>12436000
   ASSEMBLE( RIOC);                                            <<03004>>12438000
   END;                                                        <<03004>>12440000
S3 := TOS;                                                     <<03004>>12442000
END;                                                           <<03004>>12444000
                                                               <<03004>>12446000
                                                               <<03004>>12448000
<< START OF WRITECHAR PROCEDURE >>                             <<03004>>12450000
ASSEMBLE( PCN );   << WHAT PROCESSOR TYPE >>                   <<03004>>12452000
CPUNUM := TOS;                                                 <<03004>>12454000
BOARD'TYPE := READ'SIB'REG(CHANNEL'CONFIG);                    <<03004>>12456000
IF BOARD'TYPE = LYNX'TYPE THEN                                 <<03004>>12458000
   BEGIN   << SIB IS A LYNX >>                                 <<03004>>12460000
   DISABLE'INTRPTS;                                            <<03004>>12462000
   AIB'ENABLE := ENABLE'MASK&LSR(STD'CONS'AIB);                <<03004>>12464000
   CONS'PORT := STD'CONS'AIB&LSL(4) LOR STD'CONS'PORT;         <<03004>>12466000
   << THAW LYNX >>                                             <<03004>>12468000
   WRITE'SIB'REG(DIAG'WRITE, GO'LYNX);                         <<03004>>12470000
   << ENABLE ONLY CONSOLE AIB >>                               <<03004>>12472000
   WRITE'SIB'REG(BOARD'ENABLE, AIB'ENABLE);                    <<03004>>12474000
   << SET UP PORT POINTER TO CONSOLE >>                        <<03004>>12476000
   WRITE'SIB'REG(PORT'POINTER, CONS'PORT);                     <<03004>>12478000
   PUSH(SBANK);                                                <<03004>>12480000
   DMA'BANK := TOS LOR DMA'CONTROL;                            <<03022>>12482000
   PUSH(DB);                                                   <<03004>>12484000
   PUSH(Q);                                                    <<03004>>12486000
   DB'REG := LOGICAL(TOS) + LOGICAL(TOS);                      <<03004>>12488000
   << SET UP CONTROL BANK >>                                   <<03004>>12490000
   WRITE'SIB'REG(CONTROL'DMA'BANK, DMA'BANK);                  <<03004>>12492000
   << SET UP CONTROL ADDR >>                                   <<03004>>12494000
   CP'WRITECHAR.(12:4) := LYNX'CONVERT(BAUDRATE);              <<03004>>12496000
   PRINT'ADDR := LOGICAL(DB'REG) + LOGICAL(3);                 <<03004>>12498000
   WRITE'SIB'REG(CONTROL'DMA'ADDR, PRINT'ADDR );               <<03004>>12500000
   << SET UP WRITE DMA BANK >>                                 <<03004>>12502000
   WRITE'SIB'REG(WRITE'DMA'BANK, DMA'BANK LOR DMA'RIGHT);      <<03004>>12504000
   << SET UP WRITE DMA ADDR >>                                 <<03004>>12506000
   CHARACTER := CHAR;                                          <<03004>>12508000
   WRITE'SIB'REG(WRITE'DMA'ADDR, LOGICAL(1) +                  <<03004>>12510000
                                 LOGICAL(DB'REG));             <<03004>>12512000
   << SET UP READ DMA BANK >>                                  <<03004>>12514000
   WRITE'SIB'REG(READ'DMA'BANK, DMA'BANK);                     <<03004>>12516000
   << SET UP READ DMA ADDR >>                                  <<03004>>12518000
   PRINT'ADDR := LOGICAL(DB'REG) + LOGICAL(2);                 <<03004>>12520000
   WRITE'SIB'REG(READ'DMA'ADDR, PRINT'ADDR);                   <<03004>>12522000
   ASSEMBLE( RCLK );   << DELAY FOR X MSEC >>                  <<03004>>12524000
   STARTIME := TOS;                                            <<03004>>12526000
   DO                                                          <<03004>>12528000
      BEGIN                                                    <<03004>>12530000
      ASSEMBLE( RCLK );                                        <<03004>>12532000
      CURTIME := TOS;                                          <<03004>>12534000
      END                                                      <<03004>>12536000
   UNTIL CURTIME - STARTIME > WAIT'LIMIT;                      <<03004>>12538000
   << START WRITE CONTROL PROGRAM >>                           <<03004>>12540000
   WRITE'SIB'REG(DIRECT'COMMAND, SIO'PORT);                    <<03004>>12542000
   LYNX'INTRPT := FALSE;                                       <<03004>>12544000
   << LOOP UNTIL WRITE IS COMPLETE >>                          <<03004>>12546000
   WRITECHAR := 0;                                             <<03004>>12548000
   DO                                                          <<03004>>12550000
      BEGIN   << WAIT FOR INTERRUPT >>                         <<03004>>12552000
      TERM'INTRPT := READ'SIB'REG(INTRPTS'NO'FLUSH);           <<03004>>12554000
      IF TERM'INTRPT.(0:1) THEN                                <<03004>>12556000
         BEGIN   << INTERRUPT HAS OCCURED >>                   <<03004>>12558000
         TERM'INTRPT := READ'SIB'REG(INTRPTS'FLUSH);           <<03004>>12560000
         IF TERM'INTRPT.(9:7) = CONS'PORT.(9:7) THEN           <<03004>>12562000
            BEGIN   << CORRECT PORT INTERRUPTED >>             <<03004>>12564000
            LYNX'INTRPT := TRUE;                               <<03004>>12566000
            INTRPT'REASON := READ'SIB'REG(TERM'INTRPT'REASON); <<03004>>12568000
            IF INTRPT'REASON&LSR(8) <> WRITE'DONE THEN         <<03004>>12570000
               BEGIN   << NOT CORRECT REASON - ERROR >>        <<03004>>12572000
               WRITECHAR := INTRPT'REASON.(0:8) LOR            <<03029>>12574000
                            BIT0;                              <<03004>>12576000
               END;    << NOT CORRECT REASON - ERROR >>        <<03004>>12578000
            END      << CORRECT PORT INTERRUPTED >>            <<03004>>12580000
         END     << INTERRUPT HAS OCCURED >>                   <<03004>>12582000
      ELSE                                                     <<03004>>12584000
         BEGIN   << CHECK HARDWARE ERROR >>                    <<03004>>12586000
         IF TERM'INTRPT.(2:1) THEN                             <<03004>>12588000
            BEGIN                                              <<03004>>12590000
            LYNX'INTRPT := TRUE;                               <<03004>>12592000
            INTRPT'ERROR := READ'SIB'REG(DIAG'REGA);           <<03004>>12594000
            WRITECHAR := INTRPT'ERROR.(8:8) LOR BIT2;          <<03029>>12596000
            WRITE'SIB'REG(DIAG'REGA, %137613);                 <<03029>>12598000
            WRITE'SIB'REG(DIAG'REGA, %137611);                 <<03029>>12600000
            END;                                               <<03004>>12602000
         END;    << CHECK HARDWARE ERROR >>                    <<03004>>12604000
      END     << WAIT FOR INTERRUPT >>                         <<03004>>12606000
   UNTIL LYNX'INTRPT = TRUE;                                   <<03004>>12608000
   END     << SIB IS A LYNX >>                                 <<03004>>12610000
ELSE                                                           <<03004>>12612000
   BEGIN   << SIB IS A ADCC >>                                 <<03004>>12614000
                                                               <<03004>>12616000
   PUSH(DB);                                                   <<03004>>12618000
   OLDDB := TOS;  <<SAVE OLD DB>>                              <<03004>>12620000
   TOS := 0;                                                   <<03004>>12622000
   TOS := ABSOLUTE(TERMCHANPROG);                              <<03004>>12624000
   CPBASE := LS0;                                              <<03004>>12626000
   SET(DB);                                                    <<03004>>12628000
   MOVE CP := CHANIOPROG,(%53);                                <<03004>>12630000
   CP( %4) := CP(%11) := CPBASE+DATA0;                         <<03004>>12632000
   CP(%16) := CP(%23) := CPBASE+DATA1;                         <<03004>>12634000
   CP(%35) := CPBASE + DATA2;                                  <<03004>>12636000
   CP(%30) := CP(%44) := CPBASE + DATA3;                       <<03004>>12638000
   CP(DATA1).(8:8) := BAUDRATE;                                <<03004>>12640000
   CP(DATA3).(0:8) := BAUDRATE + %20;                          <<03004>>12642000
   CP(DATA2) := CHAR;                                          <<03004>>12644000
   SIOP( CONSOLEDRT, CPBASE);   << START CHANNEL PROGRAM >>    <<03022>>12648000
   IF <> THEN ERRMESSAGE( M2, CONSOLEDRT);  << FAILURE >>      <<03022>>12650000
   WHILE GETDRT(CONSOLEDRT,CHANSTAT).(0:2)<>0 DO;              <<03004>>12652000
        <<WAIT UNTIL PROGRAM FINISHES>>                        <<03004>>12654000
   TOS := OLDDB;                                               <<03004>>12656000
   SET(DB);                                                    <<03004>>12658000
   END;    << SIB IS A ADCC >>                                 <<03004>>12660000
                                                               <<03004>>12662000
<< FOR 26XX TERMINALS, SEND AN ENQ AND WAIT FOR  >>            <<03004>>12664000
<< AN ACK AFTER EVERY 80 CHARACTERS PRINTED SO   >>            <<03004>>12666000
<< WE DON'T OVERRUN THE TERMINAL'S BUFFER        >>            <<03004>>12668000
                                                               <<03004>>12670000
IF HP26XX THEN                                                 <<03004>>12672000
   IF (CHARCNT := CHARCNT + 1) >= 79 THEN                      <<03004>>12674000
      BEGIN                                                    <<03004>>12676000
      CHARCNT := 0;      << ZERO CHARACTER COUNT >>            <<03004>>12678000
      WRITECHAR( ENQ);                                         <<03004>>12680000
      DO UNTIL READCHAR(0).(9:7)=ACK; <<WAIT ON ACK>>          <<03004>>12682000
      END;                                                     <<03004>>12684000
END;  << WRITECHAR >>                                          <<03004>>12686000
$PAGE                                                          <<03004>>12688000
        <<--------------------------------->>                  <<03004>>12690000
        <<  READ A CHARACTER FROM CONSOLE  >>                  <<03004>>12692000
        <<--------------------------------->>                  <<03004>>12694000
  INTEGER PROCEDURE READCHAR( WAITMS);                         <<03004>>12696000
  VALUE WAITMS;                                                <<03004>>12698000
  LOGICAL WAITMS;    << TIME-OUT FOR READ >>                   <<03004>>12700000
  OPTION VARIABLE;                                             <<03004>>12702000
      COMMENT                                                  <<03004>>12704000
        THIS PROCEDURE READS A BYTE DIRECTLY FROM THE          <<03004>>12706000
        SYSTEM CONSOLE.  THE OPTIONAL PARAMETER IS USED        <<03004>>12708000
        FOR AUTOMATIC SPEED SENSING.  IF AN ACK DOES NOT       <<03004>>12710000
        COME BACK IN WAITMS MILLISECONDS AFTER AN ENQ          <<03004>>12712000
        WAS SENT, THE PROCEDURE RETURNS NULL.  NOTE:           <<03004>>12714000
        THIS PROCEDURE SUPPORTS BOTH ADCC AND LYNX             <<03004>>12716000
        CONSOLES.  RESPONSIBILITY FOR SUPPORTING THIS          <<03004>>12718000
        PROCEDURE RESTS WITH THE TERMINAL SOFTWARE             <<03004>>12720000
        GROUP.  DO NOT MODIFY THIS PROCEDURE BEFORE            <<03004>>12722000
        CONSULTING THEM!                                       <<03004>>12724000
        ;                                                      <<03004>>12726000
                                                               <<03004>>12728000
BEGIN   << START OF READCHAR >>                                <<03004>>12730000
EQUATE                                                         <<03004>>12732000
   R0    = 0,                                                  <<03004>>12734000
   R1    = 1,                                                  <<03004>>12736000
   R2    = 2,                                                  <<03004>>12738000
   R3    = 3,                                                  <<03004>>12740000
   R4    = 4,                                                  <<03004>>12742000
   R5    = 5,                                                  <<03004>>12744000
   R6    = 6,                                                  <<03004>>12746000
   R7    = 7,                                                  <<03004>>12748000
   R8    = 8,                                                  <<03004>>12750000
   R9    = 9,                                                  <<03004>>12752000
   RA    = %(16)A,                                             <<03004>>12754000
   RB    = %(16)B,                                             <<03004>>12756000
   RC    = %(16)C,                                             <<03004>>12758000
   RD    = %(16)D,                                             <<03004>>12760000
   RE    = %(16)E,                                             <<03004>>12762000
   RF    = %(16)F;                                             <<03004>>12764000
EQUATE                                                         <<03004>>12766000
   BIT0 = %100000,                                             <<03004>>12768000
   BIT2 = %20000,                                              <<03029>>12770000
   B14'SET = 2,                                                <<03004>>12772000
   B14'CLEAR = 0,                                              <<03004>>12774000
   CONSOLEDRT = %10,                                           <<03004>>12776000
   DMA'CONTROL = %100000,                                      <<03004>>12778000
   DMA'RIGHT = %40000,                                         <<03004>>12780000
   ENABLE'MASK = %177577,                                      <<03004>>12782000
   GO'LYNX = %(16)BF8D,                                        <<03004>>12784000
   HIO'PORT = 8,                                               <<03004>>12786000
   ICF'55 = 4,                                                 <<03004>>12788000
   GRIZZLY = 3,                                                <<03004>>12790000
   LYNX'TYPE = %50017,                                         <<03004>>12792000
   NULL = 0,                                                   <<03004>>12794000
   PORT'HCP = 8,                                               <<03004>>12796000
   READ'DONE = 6,                                              <<03004>>12798000
   SIO'PORT = 4,                                               <<03004>>12800000
   STD'CONS'AIB = 0,                                           <<03004>>12802000
   STD'CONS'PORT = 0,                                          <<03004>>12804000
   WRITE'DONE = %16;                                           <<03029>>12806000
DEFINE   << DEFINES FOR LYNX REGISTERS >>                      <<03004>>12808000
   WRITE'DMA'ADDR      = R0#,                                  <<03004>>12810000
   WRITE'DMA'BANK       = R1#,                                 <<03004>>12812000
   CONTROL'DMA'ADDR     = R2#,                                 <<03004>>12814000
   CONTROL'DMA'BANK     = R3#,                                 <<03004>>12816000
   READ'DMA'ADDR        = R4#,                                 <<03004>>12818000
   READ'DMA'BANK        = R5#,                                 <<03004>>12820000
   TERM'INTRPT'REASON   = R6#,                                 <<03004>>12822000
   INTRPTS'NO'FLUSH     = R8#,                                 <<03004>>12824000
   PORT'POINTER         = R8#,                                 <<03004>>12826000
   INTRPTS'FLUSH        = R9#,                                 <<03004>>12828000
   BOARD'ENABLE         = R9#,                                 <<03004>>12830000
   DIAG'REGA            = RA#,                                 <<03004>>12832000
   DIAG'WRITE           = RA#,                                 <<03004>>12834000
   DIAG'REGB            = RB#,                                 <<03004>>12836000
   DIRECT'COMMAND       = RB#,                                 <<03004>>12838000
   CHANNEL'CONFIG       = RE#,                                 <<03004>>12840000
   CHANNEL'CONFIG'2     = RF#;                                 <<03004>>12842000
DEFINE                                                         <<03004>>12844000
   DISABLE'INTRPTS = ASSEMBLE( SED 0 )#;                       <<03004>>12846000
LOGICAL   << NOTE !!! - DONT MOVE Q+1 THROUGH Q+6 >>           <<03029>>12848000
   CHARACTER,                                                  <<03004>>12850000
   READ'BRK,                                                   <<03004>>12852000
   CP'READCHAR  := %(16)0142,  << ATP (LYNX) CONTROL     >>    <<03708>>12854000
   CP'READCHAR1 := %(16)0000,  << PROGRAM.  SEE ATP      >>    <<03708>>12864000
   CP'READCHAR2 := %(16)0001,  << DOCUMENTATION FOR THE  >>    <<03708>>12868000
   CP'READCHAR3 := %(16)FFFF,  << MEANING OF THESE CODES >>    <<03708>>12870000
   AIB'ENABLE,                                                 <<03004>>12872000
   BOARD'TYPE,                                                 <<03004>>12874000
   CONS'CHANNEL,                                               <<03004>>12876000
   CONS'AIB,                                                   <<03004>>12878000
   CONS'PORT,                                                  <<03004>>12880000
   CPUNUM,                                                     <<03004>>12882000
   DB'REG,      << CURRENT DB FOR PRINT >>                     <<03004>>12884000
   DMA'BANK,    << DMA BANK FOR PRINT   >>                     <<03004>>12886000
   INIT'COMMAND := %20000,                                     <<03004>>12888000
   INTRPT'ERROR,                                               <<03004>>12890000
   INTRPT'REASON,                                              <<03004>>12892000
   LYNX'INTRPT,                                                <<03004>>12894000
   PRINT'ADDR,                                                 <<03004>>12896000
   READ'COMMAND := 0,                                          <<03004>>12898000
   SYS'UP := FALSE,                                            <<03004>>12900000
   TERM'INTRPT  := 0,                                          <<03004>>12902000
   WRITE'COMMAND := 0,                                         <<03004>>12904000
   WAIT'LIMIT := 4,                                            <<03004>>12906000
   CURTIME,                                                    <<03004>>12908000
   STARTIME,                                                   <<03004>>12910000
   TIMEOUT;                                                    <<03004>>12912000
INTEGER                                                        <<03004>>12914000
   S2 = S-2,                                                   <<03004>>12916000
   S3 = S-3,                                                   <<03004>>12918000
   PARMS = Q-4,                                                <<03004>>12920000
   I,                                                          <<03004>>12922000
   J;                                                          <<03004>>12924000
INTEGER ARRAY LYNX'CONVERT(6:18) = PB :=  <<ADCC TO LYNX    >> <<03004>>12926000
 2,4,9,5,99,10,99,11,1,0,6,7,3;    << BAUDRATE CONVERSIONS  >> <<03004>>12928000
                                                               <<03004>>12930000
                                                               <<03004>>12932000
  DOUBLE OLDDB;  <<DB WHEN PROCEDURE IS CALLED>>               <<03004>>12934000
  LOGICAL CPBASE;    <<BASE OF CHANNEL PROGRAM>>               <<03004>>12936000
  LOGICAL ARRAY CP(*) = DB+0;                                  <<03004>>12938000
          ARRAY CHANIOPROG(0:%45)=PB:=                         <<03004>>12940000
                                                               <<03004>>12942000
     %2002,                << WRITE, MOD 2             >>      <<03004>>12944000
     1,                    << TURN ON ECHO             >>      <<03004>>12946000
     1,                                                        <<03004>>12948000
     [1/1,1/0,1/1,13/0],                                       <<03004>>12950000
     0,                                                        <<03004>>12952000
                                                               <<03004>>12954000
     %2006,                << WRITE, MOD 6             >>      <<03004>>12956000
     1,                    << SET INPUT BAUD RATE      >>      <<03004>>12958000
     1,                                                        <<03004>>12960000
     [1/1,1/0,1/1,13/0],                                       <<03004>>12962000
     0,                                                        <<03004>>12964000
                                                               <<03004>>12966000
     %2003,                << WRITE, MOD 3             >>      <<03004>>12968000
     1,                    << ENABLE SRQ INPUT         >>      <<03004>>12970000
     1,                                                        <<03004>>12972000
     [1/1,1/1,1/1,13/0],                                       <<03004>>12974000
     0,                                                        <<03004>>12976000
                                                               <<03004>>12978000
     %1000,                << WAIT FOR SRQ             >>      <<03004>>12980000
     0,                                                        <<03004>>12982000
                                                               <<03004>>12984000
     %1400,                << READ, MOD 0              >>      <<03004>>12986000
     1,                    << GET RECEIVED CHARACTER   >>      <<03004>>12988000
     1,                                                        <<03004>>12990000
     [1/1,1/1,14/0],                                           <<03004>>12992000
     0,                                                        <<03004>>12994000
                                                               <<03004>>12996000
     %2003,                << WRITE, MOD 3             >>      <<03004>>12998000
     1,                    << DISABLE SRQ INPUT        >>      <<03004>>13000000
     1,                                                        <<03004>>13002000
     [1/1,1/0,1/1,13/0],                                       <<03004>>13004000
     0,                                                        <<03004>>13006000
                                                               <<03004>>13008000
     %2002,                << WRITE, MOD 2             >>      <<03004>>13010000
     1,                    << DISABLE ECHO             >>      <<03004>>13012000
     1,                                                        <<03004>>13014000
     [1/1,1/1,1/1,13/0],                                       <<03004>>13016000
     0,                                                        <<03004>>13018000
                                                               <<03004>>13020000
     %600,                 << INTERRUPT, HALT          >>      <<03004>>13022000
     0,                                                        <<03004>>13024000
                                                               <<03004>>13026000
     [8/%020,8/%006],      << ECHO ON; SRQ INPUT ON    >>      <<03004>>13028000
     [8/%002,8/%000],      << SRQ INPUT OFF, ECHO OFF  >>      <<03004>>13030000
     0,                    << PLACE FOR INPUT CHAR.    >>      <<03004>>13032000
     0;                    << PLACE FOR INPUT BAUDRATE >>      <<03004>>13034000
                                                               <<03004>>13036000
  EQUATE  DATA0 = %42,                                         <<03004>>13038000
          DATA1 = DATA0+1,                                     <<03004>>13040000
          DATA2 = DATA1+1,                                     <<03004>>13042000
          DATA3 = DATA2+1;                                     <<03004>>13044000
                                                               <<03004>>13046000
                                                               <<03004>>13048000
                                                               <<03004>>13050000
SUBROUTINE WRITE'SIB'REG(REG'NUMB, DATA'OUT);                  <<03004>>13052000
VALUE REG'NUMB, DATA'OUT;                                      <<03004>>13054000
LOGICAL REG'NUMB,                                              <<03004>>13056000
        DATA'OUT;                                              <<03004>>13058000
BEGIN                                                          <<03004>>13060000
IF CPUNUM = ICF'55 THEN                                        <<03004>>13062000
   BEGIN   << CPU IS A 55 >>                                   <<03004>>13064000
   TOS := CONSOLEDRT;                                          <<03004>>13066000
   TOS := WRITE'COMMAND CAT S3(4:12:4);                        <<03004>>13068000
   TOS := S3;                                                  <<03004>>13070000
   ASSEMBLE( WIOA);                                            <<03004>>13072000
   END                                                         <<03004>>13074000
ELSE                                                           <<03004>>13076000
   BEGIN                                                       <<03004>>13078000
   TOS := WRITE'COMMAND CAT REG'NUMB(4:12:4) LOR               <<03004>>13080000
          CONSOLEDRT;                                          <<03004>>13082000
   TOS := S2;                                                  <<03004>>13084000
   ASSEMBLE( WIOC);                                            <<03004>>13086000
   END;                                                        <<03004>>13088000
END;                                                           <<03004>>13090000
LOGICAL SUBROUTINE READ'SIB'REG(REG'NUMB);                     <<03004>>13092000
VALUE REG'NUMB;                                                <<03004>>13094000
LOGICAL REG'NUMB;                                              <<03004>>13096000
BEGIN                                                          <<03004>>13098000
IF CPUNUM = ICF'55 THEN                                        <<03004>>13100000
   BEGIN   << CPU IS A 55 >>                                   <<03004>>13102000
   TOS := CONSOLEDRT;                                          <<03004>>13104000
   TOS := READ'COMMAND CAT S2(4:12:4);                         <<03004>>13106000
   ASSEMBLE( RIOA);                                            <<03004>>13108000
   END     << CPU IS A 55 >>                                   <<03004>>13110000
ELSE                                                           <<03004>>13112000
   BEGIN                                                       <<03004>>13114000
   TOS := READ'COMMAND CAT REG'NUMB(4:12:4) LOR                <<03004>>13116000
          CONSOLEDRT;                                          <<03004>>13118000
   ASSEMBLE( RIOC);                                            <<03004>>13120000
   END;                                                        <<03004>>13122000
S3 := TOS;                                                     <<03004>>13124000
END;                                                           <<03004>>13126000
                                                               <<03004>>13128000
                                                               <<03004>>13130000
<< START AND OUTER BLOCK OF READCHAR PROCEDURE >>              <<03004>>13132000
ASSEMBLE( PCN );   << WHAT PROCESSOR TYPE >>                   <<03004>>13134000
CPUNUM := TOS;                                                 <<03004>>13136000
BOARD'TYPE := READ'SIB'REG(CHANNEL'CONFIG);                    <<03004>>13138000
IF BOARD'TYPE = LYNX'TYPE THEN                                 <<03004>>13140000
   BEGIN   << SIB IS A LYNX >>                                 <<03004>>13142000
   DISABLE'INTRPTS;                                            <<03004>>13144000
   AIB'ENABLE := ENABLE'MASK&LSR(STD'CONS'AIB);                <<03004>>13146000
   CONS'PORT := STD'CONS'AIB&LSL(4) LOR STD'CONS'PORT;         <<03004>>13148000
   << THAW LYNX >>                                             <<03004>>13150000
   WRITE'SIB'REG(DIAG'WRITE, GO'LYNX);                         <<03004>>13152000
   << ENABLE ONLY CONSOLE AIB >>                               <<03004>>13154000
   WRITE'SIB'REG(BOARD'ENABLE, AIB'ENABLE);                    <<03004>>13156000
   << SET UP PORT POINTER TO CONSOLE >>                        <<03004>>13158000
   WRITE'SIB'REG(PORT'POINTER, CONS'PORT);                     <<03004>>13160000
   PUSH(SBANK);                                                <<03004>>13162000
   DMA'BANK := TOS LOR DMA'CONTROL;                            <<03022>>13164000
   PUSH(DB);                                                   <<03004>>13166000
   PUSH(Q);                                                    <<03004>>13168000
   DB'REG := LOGICAL(TOS) + LOGICAL(TOS);                      <<03004>>13170000
   << SET UP CONTROL BANK >>                                   <<03004>>13172000
   WRITE'SIB'REG(CONTROL'DMA'BANK, DMA'BANK);                  <<03004>>13174000
   << SET UP CONTROL ADDR >>                                   <<03004>>13176000
   CP'READCHAR.(12:4) := LYNX'CONVERT(BAUDRATE);               <<03004>>13178000
   PRINT'ADDR := LOGICAL(DB'REG) + LOGICAL(3);                 <<03004>>13180000
   WRITE'SIB'REG(CONTROL'DMA'ADDR, PRINT'ADDR );               <<03004>>13182000
   << SET UP READ DMA BANK >>                                  <<03004>>13184000
   WRITE'SIB'REG(READ'DMA'BANK, DMA'BANK LOR DMA'RIGHT);       <<03004>>13186000
   << SET UP READ DMA ADDR >>                                  <<03004>>13188000
   PRINT'ADDR := LOGICAL(DB'REG) + LOGICAL(1);                 <<03004>>13190000
   WRITE'SIB'REG(READ'DMA'ADDR, PRINT'ADDR);                   <<03004>>13192000
   ASSEMBLE( RCLK );   << DELAY FOR X MSEC >>                  <<03004>>13194000
   STARTIME := TOS;                                            <<03004>>13196000
   DO                                                          <<03004>>13198000
      BEGIN                                                    <<03004>>13200000
      ASSEMBLE( RCLK );                                        <<03004>>13202000
      CURTIME := TOS;                                          <<03004>>13204000
      END                                                      <<03004>>13206000
   UNTIL CURTIME - STARTIME > WAIT'LIMIT;                      <<03004>>13208000
   READCHAR := NULL;                                           <<03004>>13210000
   << LOOP UNTIL READ IS COMPLETE >>                           <<03004>>13214000
   IF PARMS.(15:1) = 1 THEN                                    <<03004>>13216000
      BEGIN   << TIME READ >>                                  <<03004>>13218000
      CP'READCHAR := %(16)0143;                                <<03708>>13220000
      TIMEOUT := WAITMS;                                       <<03004>>13222000
      END     << TIME READ >>                                  <<03004>>13224000
   ELSE                                                        <<03004>>13226000
      BEGIN                                                    <<03004>>13228000
      TIMEOUT := 0;                                            <<03004>>13232000
      END;                                                     <<03004>>13234000
   << START READ CONTROL PROGRAM >>                            <<03029>>13236000
   WRITE'SIB'REG(DIRECT'COMMAND, SIO'PORT);                    <<03029>>13238000
   LYNX'INTRPT := FALSE;                                       <<03029>>13240000
   ASSEMBLE(RCLK);  << SAVE CURRENT CLOCK FOR TIMEOUT >>       <<03004>>13242000
   STARTIME := TOS;                                            <<03004>>13244000
   DO                                                          <<03004>>13246000
      BEGIN   << WAIT FOR INTERRUPT >>                         <<03004>>13248000
      TERM'INTRPT := READ'SIB'REG(INTRPTS'NO'FLUSH);           <<03004>>13250000
      IF TERM'INTRPT.(0:1) THEN                                <<03004>>13252000
         BEGIN   << INTERRUPT HAS OCCURED >>                   <<03004>>13254000
         TERM'INTRPT := READ'SIB'REG(INTRPTS'FLUSH);           <<03004>>13256000
         IF TERM'INTRPT.(9:7) = CONS'PORT.(9:7) THEN           <<03004>>13258000
            BEGIN   << CORRECT PORT INTERRUPTED >>             <<03004>>13260000
            LYNX'INTRPT := TRUE;                               <<03004>>13262000
            INTRPT'REASON := READ'SIB'REG(TERM'INTRPT'REASON); <<03004>>13264000
            IF INTRPT'REASON&LSR(8) <> READ'DONE THEN          <<03004>>13266000
               BEGIN   << NOT CORRECT REASON - ERROR >>        <<03004>>13268000
               READCHAR := INTRPT'REASON.(0:8) LOR             <<03029>>13270000
                           BIT0;                               <<03004>>13272000
               END     << NOT CORRECT REASON - ERROR >>        <<03004>>13274000
            ELSE                                               <<03004>>13276000
               READCHAR := CHARACTER.(8:8);                    <<03004>>13278000
            END      << CORRECT PORT INTERRUPTED >>            <<03004>>13280000
         END     << INTERRUPT HAS OCCURED >>                   <<03004>>13282000
      ELSE                                                     <<03004>>13284000
         BEGIN   << CHECK HARDWARE ERROR >>                    <<03004>>13286000
         IF TERM'INTRPT.(2:1) THEN                             <<03004>>13288000
            BEGIN                                              <<03004>>13290000
            LYNX'INTRPT := TRUE;                               <<03004>>13292000
            INTRPT'ERROR := READ'SIB'REG(DIAG'REGA);           <<03004>>13294000
            READCHAR := INTRPT'ERROR.(8:8) LOR BIT2;           <<03029>>13296000
            WRITE'SIB'REG(DIAG'REGA, %137613);                 <<03029>>13298000
            WRITE'SIB'REG(DIAG'REGA, %137611);                 <<03029>>13300000
            END;                                               <<03004>>13302000
         END;    << CHECK HARDWARE ERROR >>                    <<03004>>13304000
      IF LYNX'INTRPT = FALSE AND TIMEOUT <> 0 THEN             <<03004>>13306000
         BEGIN                                                 <<03004>>13308000
         ASSEMBLE( RCLK );                                     <<03004>>13310000
         CURTIME := TOS;                                       <<03004>>13312000
         IF CURTIME-STARTIME > TIMEOUT THEN                    <<03004>>13314000
            BEGIN                                              <<03004>>13316000
            READCHAR := NULL;                                  <<03004>>13318000
            WRITE'SIB'REG(DIRECT'COMMAND, HIO'PORT);           <<03004>>13320000
            DO                                                 <<03004>>13322000
               BEGIN   << WAIT FOR HALT >>                     <<03004>>13324000
               TERM'INTRPT := READ'SIB'REG(INTRPTS'NO'FLUSH);  <<03004>>13326000
               IF TERM'INTRPT.(0:1) THEN                       <<03004>>13328000
                  BEGIN   << HALT OCCURED >>                   <<03004>>13330000
                  TERM'INTRPT := READ'SIB'REG(INTRPTS'FLUSH);  <<03004>>13332000
                  LYNX'INTRPT := TRUE;                         <<03004>>13334000
                  END;    << HALT OCCURED >>                   <<03004>>13336000
               END     << WAIT FOR HALT >>                     <<03004>>13338000
            UNTIL LYNX'INTRPT = TRUE;                          <<03004>>13340000
            END;                                               <<03004>>13342000
         END;                                                  <<03004>>13344000
      END     << WAIT FOR INTERRUPT >>                         <<03004>>13346000
   UNTIL LYNX'INTRPT = TRUE;                                   <<03004>>13348000
   END     << SIB IS A LYNX >>                                 <<03004>>13350000
ELSE                                                           <<03004>>13352000
   BEGIN   << SIB IS A ADCC >>                                 <<03004>>13354000
                                                               <<03004>>13356000
                                                               <<03004>>13358000
   << SET TIME-OUT FOR READ IF PROCEDURE WAS CALLED >>         <<03004>>13360000
   << WITH A TIME-OUT VALUE.                        >>         <<03004>>13362000
                                                               <<03004>>13364000
   IF PARMS.(15:1) = 1 THEN                                    <<03004>>13366000
      TIMEOUT := WAITMS                                        <<03004>>13368000
   ELSE                                                        <<03004>>13370000
      TIMEOUT := 0;                                            <<03004>>13372000
                                                               <<03004>>13374000
   PUSH(DB);                                                   <<03004>>13376000
   OLDDB := TOS;  <<SAVE OLD DB>>                              <<03004>>13378000
   TOS := 0;                                                   <<03004>>13380000
   TOS := ABSOLUTE(TERMCHANPROG);                              <<03004>>13382000
   CPBASE := LS0;                                              <<03004>>13384000
   SET(DB);                                                    <<03004>>13386000
   MOVE CP := CHANIOPROG,(%46);                                <<03004>>13388000
   CP( %4) := CP(%16) := CPBASE+DATA0;                         <<03004>>13390000
   CP(%25) := CPBASE+DATA2;                                    <<03004>>13392000
   CP(%32) := CP(%37) := CPBASE+DATA1;                         <<03004>>13394000
   CP(%11) := CPBASE+DATA3;                                    <<03004>>13396000
   CP(DATA3).(0:8) := BAUDRATE + %20;                          <<03004>>13398000
                  << TURN OFF ECHO IF WAITING FOR >>           <<03004>>13402000
                  << AN ACK FROM THE TERMINAL     >>           <<03004>>13404000
   SIOP( CONSOLEDRT, IF PARMS.(15:1)=1 THEN CPBASE+5           <<03022>>13406000
                                       ELSE CPBASE  );         <<03022>>13408000
   IF <> THEN ERRMESSAGE( M2, CONSOLEDRT);                     <<03022>>13410000
   ASSEMBLE(RCLK);   << SAVE CLOCK FOR TIMEOUTS >>             <<03004>>13412000
   STARTIME := TOS;                                            <<03004>>13414000
                                                               <<03004>>13416000
   DO BEGIN     << LOOP UNTIL CHANNEL PROGRAM ENDS >>          <<03004>>13418000
      ASSEMBLE( RCLK);   << OR TIMEOUT IS REACHED  >>          <<03004>>13420000
      CURTIME := TOS;                                          <<03004>>13422000
      IF TIMEOUT = 0 THEN CURTIME := STARTIME;                 <<03004>>13424000
      END                                                      <<03004>>13426000
   UNTIL ( GETDRT( CONSOLEDRT, CHANSTAT).(0:2) = 0             <<03004>>13428000
             OR CURTIME-STARTIME > TIMEOUT);                   <<03004>>13430000
                                                               <<03004>>13432000
   << IF WE TIMED-OUT, HALT THE CHANNEL PROGRAM    >>          <<03004>>13434000
   << AND RETURN THE NULL CHAR.                    >>          <<03004>>13436000
   IF CURTIME-STARTIME > TIMEOUT THEN                          <<03004>>13438000
      BEGIN                                                    <<03004>>13440000
      READCHAR := NULL;                                        <<03004>>13442000
      TOS := CONSOLEDRT;                                       <<03004>>13444000
      ASSEMBLE( DUP; HIOP; BG*-3; DEL);                        <<03004>>13446000
      END                                                      <<03004>>13448000
   ELSE                                                        <<03004>>13450000
      READCHAR := CP( DATA2);                                  <<03004>>13452000
                                                               <<03004>>13454000
   TOS := OLDDB;     << RESTORE DB >>                          <<03004>>13456000
   SET(DB);                                                    <<03004>>13458000
   END     << SIB IS A ADCC >>                                 <<03004>>13460000
END;  << READCHAR >>                                           <<03004>>13462000
$CONTROL SEGMENT=RESIDENT                                      <<03603>>13464000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>13466000
$CONTROL SEGMENT=RESIDENT                                      <<00888>>13468000
PROCEDURE CLEARLINE;                                           <<00888>>13470000
   <<CLEARS THE LIST BUFFER>>                                  <<00888>>13472000
   BEGIN                                                       <<00888>>13474000
   TOS := @LINE; PS0 := "  ";                                  <<00888>>13476000
   ASSEMBLE(DUP,INCB); TOS := 35; ASSEMBLE(MOVE 3);            <<00888>>13478000
   END;                                                        <<00888>>13480000
$CONTROL SEGMENT=RESIDENT                                      <<00888>>13482000
PROCEDURE BLANKLINE;                                           <<00888>>13484000
   <<PRINTS A BLANK LINE ON THE LIST DEVICE AND CLEARS THE LIST BUFFER>>13486000
   BEGIN                                                       <<00888>>13488000
   IF LIST THEN PRINT(LINE,0,0);                               <<00888>>13490000
   CLEARLINE;                                                  <<00888>>13492000
   END;                                                        <<00888>>13494000
$CONTROL SEGMENT=RESIDENT                                      <<00888>>13496000
PROCEDURE PRINTLINE;                                           <<00888>>13498000
   <<PRINTS THE CONTENTS OF THE LIST BUFFER ON THE LIST DEVICE AND      13500000
     CLEARS THE LIST BUFFER>>                                  <<00888>>13502000
   BEGIN                                                       <<00888>>13504000
   IF LIST THEN                                                <<00888>>13506000
      BEGIN                                                    <<00888>>13508000
      TOS := @LINE;                                            <<00888>>13510000
      TOS := @BLINE(71);  <<POINTER TO LAST CHAR.>>            <<00888>>13512000
      IF BPS0 = " " THEN                                       <<00888>>13514000
         BEGIN                                                 <<00888>>13516000
         ASSEMBLE(DUP,DECB);                                   <<00888>>13518000
         TOS := -71;                                           <<00888>>13520000
         ASSEMBLE(CMPB 2);                                     <<00888>>13522000
         END;                                                  <<00888>>13524000
      TOS := -(TOS-@BLINE+1);  <<NEG. NR. CHAR'S>>             <<00888>>13526000
      PRINT(*,*,0);                                            <<00888>>13528000
      END;                                                     <<00888>>13530000
   CLEARLINE;                                                  <<00888>>13532000
   END;                                                        <<00888>>13534000
$PAGE "MESSAGE ROUTINE"                                                 13536000
$CONTROL SEGMENT=RESIDENT                                               13538000
<<  ************************************************  >>       <<01103>>13540000
<<  *      The entire procedure GENMESSAGE was     *  >>       <<01103>>13542000
<<  *  added to initial 9/22/79.  The fix numbers  *  >>       <<01103>>13544000
<<  *  in columns 64/72 apply to the entire        *  >>       <<01103>>13546000
<<  *  procedure.                                  *  >>       <<01103>>13548000
<<  ************************************************  >>       <<01103>>13550000
INTEGER PROCEDURE GENMESSAGE(MSGNR,BUF,NUM1,NUM2,NUM3,NUM4,    <<01103>>13552000
       STRING1,STRING2);                                       <<01103>>13554000
   VALUE MSGNR,NUM1,NUM2,NUM3,NUM4;                            <<01103>>13556000
   INTEGER MSGNR;                                              <<01103>>13558000
   DOUBLE NUM1,NUM2,NUM3,NUM4;                                 <<01103>>13560000
   BYTE ARRAY BUF,STRING1,STRING2;                             <<01103>>13562000
BEGIN COMMENT                                                  <<01103>>13564000
                                                               <<01103>>13566000
      This procedure composes the message identified by        <<01103>>13568000
   MSGNR and inserts the message in the buffer BUF,            <<01103>>13570000
   returning the number of characters in the message.          <<01103>>13572000
   If a message does not exist, a zero length is returned.     <<01103>>13574000
   If the message number is less than 2000 the message         <<01103>>13576000
   will be preceeded with the error number.  Numbers and       <<01103>>13578000
   strings may be passed in and formated as part of the        <<01103>>13580000
   message.                                                    <<01103>>13582000
                                                               <<01103>>13584000
   MESSAGE WORD DEFINATION                                     <<01103>>13586000
                                                               <<01103>>13588000
      VOCAB WORD:                                              <<01103>>13590000
                                                               <<01103>>13592000
      Bit  2     Append a "S" to VOCAB word                    <<01103>>13594000
      Bits 3/15  Position of VOCAB word                        <<01103>>13596000
                                                               <<01103>>13598000
      PARAMETER PASSED:                                        <<01103>>13600000
                                                               <<01103>>13602000
      Bit   1    Must be set                                   <<01103>>13604000
      Bit  11    Parameter is to be formated in octal,         <<01103>>13606000
                 will be preceeded with a "%" sign             <<01103>>13608000
      Bit  12    Parameter is a string                         <<01103>>13610000
      Bits 13/15 Position of parameter (numbers and            <<01103>>13612000
                 strings both start a zero)                    <<01103>>13614000
;                                                              <<01103>>13616000
EQUATE                                                         <<01103>>13618000
   PLURAL    = %20000,  << APPEND A "S" TO VOCAB WORD     >>   <<01103>>13620000
   PD1       = %40000,  << CONVERT FIRST PARM TO DECIMAL  >>   <<01103>>13622000
   PD2       = %40001,  << CONVERT SECOND PARM TO DECIMAL >>   <<01103>>13624000
   PD3       = %40002,  << CONVERT THIRD PARM TO DECIMAL  >>   <<01103>>13626000
   PD4       = %40003,  << CONVERT FOURTH PARM TO DECIMAL >>   <<01103>>13628000
   PO1       = %40020,  << CONVERT FIRST PARM TO OCTAL    >>   <<01103>>13630000
   PO2       = %40021,  << CONVERT SECOND PARM TO OCTAL   >>   <<01103>>13632000
   PO3       = %40022,  << CONVERT THIRD PARM TO OCTAL    >>   <<01103>>13634000
   PO4       = %40023,  << CONVERT FOURTH PARM TO OCTAL   >>   <<01103>>13636000
   STR1      = %40010,  << FIRST STRING PRAM              >>   <<01103>>13638000
   STR2      = %40011;  << SECORD STRING PRAM             >>   <<01103>>13640000
BYTE ARRAY VOCAB(*) = PB :=                                    <<01103>>13642000
    1,"A",                                                     <<01103>>13644000
    7,"ABORTED",                                               <<01103>>13646000
    6,"ACCEPT",                                                <<01103>>13648000
    6,"ACCESS",                                                <<01103>>13650000
    7,"ACCOUNT",                                               <<01103>>13652000
    3,"ADD",                                                   <<01103>>13654000
   10,"ADDITIONAL",                                            <<01103>>13656000
    7,"ADDRESS",                                               <<01103>>13658000
    3,"ALL",                                                   <<01103>>13660000
    8,"ALLOCATE",                                              <<03551>>13662000
   10,"ALLOCATION",                                            <<MPEIV>>13664000
    7,"ALLOWED",                                               <<01103>>13666000
    7,"ALREADY",                                               <<01103>>13668000
    9,"ALTERNATE",                                             <<01103>>13670000
    3,"AND",                                                   <<01103>>13672000
    7,"ANOTHER",                                               <<01103>>13674000
    6,"ANSWER",                                                <<01103>>13676000
    3,"ANY",                                                   <<01103>>13678000
    3,"ARE",                                                   <<01103>>13680000
    4,"AREA",                                                  <<01103>>13682000
    2,"AS",                                                    <<01103>>13684000
    7,"ASSUMED",                                               <<01103>>13686000
    2,"AT",                                                    <<01103>>13688000
    7,"ATTEMPT",                                               <<01103>>13690000
    9,"ATTENTION",                                             <<01103>>13692000
    9,"AUTOMATIC",                                             <<01103>>13694000
    9,"AVAILABLE",                                             <<01103>>13696000
    3,"BAD",                                                   <<01103>>13698000
    4,"BANK",                                                  <<01103>>13700000
    2,"BE",                                                    <<01103>>13702000
    7,"BECAUSE",                                               <<01103>>13704000
    4,"BEEN",                                                  <<03551>>13706000
    5,"BEING",                                                 <<01103>>13708000
    5,"BLANK",                                                 <<01103>>13710000
    5,"BOARD",                                                 <<03004>>13712000
    4,"BOOT",                                                  <<01103>>13714000
    9,"BOOTSTRAP",                                             <<01103>>13716000
    6,"BUFFER",                                                <<01103>>13718000
    2,"BY",                                                    <<01103>>13720000
    4,"CALL",                                                  <<03550>>13722000
    3,"CAN",                                                   <<01103>>13724000
    6,"CANNOT",                                                <<01103>>13726000
    6,"CHANGE",                                                <<01103>>13728000
   10,"CHANGEABLE",                                            <<01103>>13730000
    7,"CHANGED",                                               <<01103>>13732000
    7,"CHANNEL",                                               <<01103>>13734000
   10,"CHARACTERS",                                            <<01103>>13736000
    8,"CHECKSUM",                                              <<03603>>13738000
    8,"CIRCULAR",                                              <<01103>>13740000
    5,"CLASS",                                                 <<01103>>13742000
    7,"CLASSES",                                               <<01103>>13744000
    3,"CMD",                                                   <<01103>>13746000
    4,"CODE",                                                  <<01103>>13748000
   25,"<COLDSTART/RELOAD/UPDATE>",                             <<01103>>13750000
    4,"COLD",                                                  <<01103>>13752000
    8,"COLDLOAD",                                              <<01103>>13754000
   12,"COMBINATIONS",                                          <<01103>>13756000
    1,",",                                                     <<01103>>13758000
    7,"COMMAND",                                               <<03550>>13760000
    7,"COMPARE",                                               <<01103>>13762000
    9,"COMPLETED",                                             <<03550>>13764000
    9,"COMPLETOR",                                             <<01103>>13766000
    9,"COMPONENT",                                             <<01103>>13768000
   10,"CONCURRENT",                                            <<01103>>13770000
   13,"CONFIGURATION",                                         <<01103>>13772000
   10,"CONFIGURED",                                            <<01103>>13774000
    7,"CONNECT",                                               <<01103>>13776000
    7,"CONSOLE",                                               <<01103>>13778000
    8,"CONTAINS",                                              <<01103>>13780000
    8,"CONTINUE",                                              <<01103>>13782000
    7,"CONTROL",                                               <<01103>>13784000
   10,"CONTROLLER",                                            <<01103>>13786000
    9,"CONVERTED",                                             <<03551>>13788000
    4,"CORE",                                                  <<01103>>13790000
    7,"CORRECT",                                               <<01103>>13792000
   11,"CORRECTABLE",                                           <<01103>>13794000
    3,"CPU",                                                   <<03002>>13796000
    4,"CPVA",                                                  <<01103>>13798000
    2,%15,%12,                                                 <<01103>>13800000
    2,"CS",                                                    <<01103>>13802000
    5,"CS'80",                                                 <<03550>>13804000
    3,"CST",                                                   <<01103>>13806000
    6,"CSTBLK",                                                <<01103>>13808000
    7,"CURRENT",                                               <<01103>>13810000
    8,"CYLINDER",                                              <<01103>>13812000
    4,"DATA",                                                  <<01103>>13814000
    4,"DATE",                                                  <<01103>>13816000
    7,"DEFAULT",                                               <<MPEIV>>13818000
    9,"DEFECTIVE",                                             <<01103>>13820000
    7,"DEFINED",                                               <<01103>>13822000
    5,"DELAY",                                                 <<01103>>13824000
    6,"DELETE",                                                <<01103>>13826000
    9,"DEPENDENT",                                             <<01299>>13828000
    9,"DESTROYED",                                             <<01103>>13830000
    6,"DEVICE",                                                <<01103>>13832000
    4,"DIAL",                                                  <<01103>>13834000
    9,"DIFFERENT",                                             <<01103>>13836000
    9,"DIRECTORY",                                             <<01103>>13838000
    7,"DISABLE",                                               <<01103>>13840000
    4,"DISC",                                                  <<01103>>13842000
    8,"DISMOUNT",                                              <<01103>>13844000
    2,"DO",                                                    <<01103>>13846000
    4,"DOES",                                                  <<01103>>13848000
    6,"DOUBLE",                                                <<01103>>13850000
    5,"DRIVE",                                                 <<01103>>13852000
    6,"DRIVER",                                                <<01103>>13854000
    3,"DRT",                                                   <<01103>>13856000
    3,"DST",                                                   <<01103>>13858000
    4,"DUAL",                                                  <<01103>>13860000
    9,"DUPLICATE",                                             <<01103>>13862000
   11,"DUPLICATIVE",                                           <<01103>>13864000
    6,"DURING",                                                <<01103>>13866000
    7,"EARLIER",                                               <<01103>>13868000
    1,"8",                                                     <<01103>>13870000
    6,"ENABLE",                                                <<01853>>13872000
    3,"END",                                                   <<01103>>13874000
    5,"ENTER",                                                 <<01103>>13876000
    7,"ENTRIES",                                               <<01103>>13878000
    5,"ENTRY",                                                 <<01103>>13880000
    3,"EOF",                                                   <<01103>>13882000
    1,"=",                                                     <<03630>>13884000
    5,"ERROR",                                                 <<01103>>13886000
    7,"EXCEEDS",                                               <<01103>>13888000
    5,"EXIST",                                                 <<01103>>13890000
    6,"EXTENT",                                                <<01103>>13892000
    8,"EXTERNAL",                                              <<01103>>13894000
    8,"FACILITY",                                              <<01103>>13896000
    7,"FAILURE",                                               <<01103>>13898000
    5,"FATAL",                                                 <<01103>>13900000
    2,"15",                                                    <<02707>>13902000
    4,"FILE",                                                  <<01103>>13904000
    7,"FLAGGED",                                               <<01103>>13906000
    9,"FOLLOWING",                                             <<01103>>13908000
    3,"FOR",                                                   <<01103>>13910000
    1,"4",                                                     <<02834>>13912000
    7,"FOREIGN",                                               <<01115>>13914000
    6,"FORMAT",                                                <<01103>>13916000
    5,"FOUND",                                                 <<01103>>13918000
    4,"FREE",                                                  <<03551>>13920000
    4,"FROM",                                                  <<01103>>13922000
    4,"FULL",                                                  <<01103>>13924000
    2,">=",                                                    <<03002>>13926000
    7,"GETTING",                                               <<01442>>13928000
    5,"GROUP",                                                 <<01103>>13930000
    4,"HALF",                                                  <<01103>>13932000
    4,"HALT",                                                  <<01103>>13934000
    7,"HANDLER",                                               <<01103>>13936000
    8,"HARDWARE",                                              <<03004>>13938000
    3,"HAS",                                                   <<03551>>13940000
    4,"HAVE",                                                  <<01103>>13942000
    4,"HEAD",                                                  <<01103>>13944000
    7,"HIGHEST",                                               <<01103>>13946000
    4,"HPIB",                                                  <<02707>>13948000
    1,"-",                                                     <<01103>>13950000
    3,"I/O",                                                   <<01103>>13952000
    2,"ID",                                                    <<01103>>13954000
    7,"ILLEGAL",                                               <<01103>>13956000
    8,"IMPROPER",                                              <<01103>>13958000
    2,"IN",                                                    <<01103>>13960000
    6,"IN/OUT",                                                <<01103>>13962000
   11,"INFORMATION",                                           <<03550>>13964000
   14,"INITIALIZATION",                                        <<01103>>13966000
    9,"INITIALLY",                                             <<01103>>13968000
    9,"INITIATOR",                                             <<01103>>13970000
    5,"INPUT",                                                 <<01103>>13972000
   12,"INSUFFICIENT",                                          <<01103>>13974000
   11,"INTERACTIVE",                                           <<01103>>13976000
   14,"INTERCOMPONENT",                                        <<01103>>13978000
    9,"INTERFACE",                                             <<02707>>13980000
    9,"INTERRUPT",                                             <<01103>>13982000
    4,"INTO",                                                  <<01103>>13984000
    7,"INVALID",                                               <<01103>>13986000
    3,"IOP",                                                   <<01103>>13988000
   13,"IRRECOVERABLE",                                         <<01103>>13990000
    2,"IS",                                                    <<01103>>13992000
    4,"JMAT",                                                  <<01103>>13994000
   13,"JOBS/SESSIONS",                                         <<01103>>13996000
   11,"KILOSECTORS",                                           <<01103>>13998000
    5,"LABEL",                                                 <<01103>>14000000
    5,"LARGE",                                                 <<01103>>14002000
    4,"LDEV",                                                  <<01103>>14004000
    6,"LENGTH",                                                <<01103>>14006000
    2,"<=",                                                    <<03002>>14008000
    5,"LEVEL",                                                 <<01103>>14010000
    4,"LIST",                                                  <<01103>>14012000
    4,"LOAD",                                                  <<01103>>14014000
    6,"LOADED",                                                <<01103>>14016000
    5,"LOCAL",                                                 <<01103>>14018000
    7,"LOGGING",                                               <<01103>>14020000
    7,"LOGICAL",                                               <<01103>>14022000
    5,"LOGID",                                                 <<01103>>14024000
    6,"LONGER",                                                <<01103>>14026000
    4,"LOST",                                                  <<01103>>14028000
    4,"MAKE",                                                  <<01103>>14030000
    3,"MAP",                                                   <<01103>>14032000
    5,"MARK.",                                                 <<01103>>14034000
    6,"MARKER",                                                <<01103>>14036000
    4,"MASK",                                                  <<01103>>14038000
    6,"MASTER",                                                <<01103>>14040000
    3,"MAX",                                                   <<01103>>14042000
    3,"MAY",                                                   <<01103>>14044000
    6,"MEMBER",                                                <<01103>>14046000
    6,"MEMORY",                                                <<01103>>14048000
    7,"MESSAGE",                                               <<01103>>14050000
    7,"MISSING",                                               <<01103>>14052000
    3,"MOD",                                                   <<02834>>14054000
    4,"MODE",                                                  <<01103>>14056000
    6,"MODULE",                                                <<01103>>14058000
    4,"MORE",                                                  <<01103>>14060000
    5,"MOUNT",                                                 <<01103>>14062000
    7,"MOUNTED",                                               <<01103>>14064000
    6,"MOVING",                                                <<01103>>14066000
    3,"MPE",                                                   <<01103>>14068000
    4,"MUST",                                                  <<01103>>14070000
    7,"125-127",                                               <<02707>>14072000
   14,"NON-RESPONDING",                                        <<01103>>14074000
    4,"NAME",                                                  <<01103>>14076000
    3,"NEW",                                                   <<01103>>14078000
    4,"NEXT",                                                  <<01103>>14080000
    2,"NO",                                                    <<01103>>14082000
    3,"NON",                                                   <<01103>>14084000
    3,"NOT",                                                   <<01103>>14086000
    3,"NOW",                                                   <<01103>>14088000
    1,"#",                                                     <<01103>>14090000
    6,"NUMBER",                                                <<01103>>14092000
    3,"#'S",                                                   <<01103>>14094000
    2,"OF",                                                    <<01103>>14096000
    4,"OKAY",                                                  <<01103>>14098000
    3,"OLD",                                                   <<01103>>14100000
    2,"ON",                                                    <<01103>>14102000
    1,"1",                                                     <<01103>>14104000
    4,"ONLY",                                                  <<01103>>14106000
    4,"OPEN",                                                  <<01103>>14108000
    9,"OPERATION",                                             <<01103>>14110000
    6,"OPTION",                                                <<01103>>14112000
    2,"OR",                                                    <<01103>>14114000
    3,"OUT",                                                   <<01103>>14116000
    6,"OUTPUT",                                                <<01103>>14118000
    8,"OVERFLOW",                                              <<03550>>14120000
    7,"OVERRUN",                                               <<01103>>14122000
    4,"PACK",                                                  <<01103>>14124000
    6,"PARITY",                                                <<01103>>14126000
    3,"PCB",                                                   <<01103>>14128000
    3,"PER",                                                   <<01103>>14130000
    5,"PHONE",                                                 <<01103>>14132000
    8,"PHYSICAL",                                              <<01103>>14134000
    4,"POLL",                                                  <<01103>>14136000
    4,"PORT",                                                  <<01103>>14138000
    7,"PORTION",                                               <<01103>>14140000
    8,"POSSIBLE",                                              <<01103>>14142000
    9,"PREFERRED",                                             <<01103>>14144000
    8,"PREVIOUS",                                              <<01103>>14146000
    7,"PRIMARY",                                               <<01103>>14148000
    9,"PROCESSES",                                             <<01103>>14150000
    7,"PROGRAM",                                               <<01103>>14152000
    8,"PROGRESS",                                              <<03550>>14154000
    7,"PROTECT",                                               <<01103>>14156000
    8,"PROTOCOL",                                              <<01103>>14158000
    5,"PURGE",                                                 <<03668>>14160000
    6,"PURGED",                                                <<01103>>14162000
    5,"RANGE",                                                 <<03002>>14164000
    4,"READ",                                                  <<01103>>14166000
    7,"READING",                                               <<01103>>14168000
    5,"READY",                                                 <<01103>>14170000
    8,"REASSIGN",                                              <<01103>>14172000
   10,"REASSIGNED",                                            <<01103>>14174000
    7,"RECEIVE",                                               <<01103>>14176000
   12,"RECONFIGURED",                                          <<01103>>14178000
    6,"RECORD",                                                <<01103>>14180000
    7,"RECOVER",                                               <<01103>>14182000
    4,"REEL",                                                  <<01103>>14184000
   12,"REINITIALIZE",                                          <<01103>>14186000
    8,"REJECTED",                                              <<01103>>14188000
    6,"RELOAD",                                                <<01103>>14190000
    6,"REMOTE",                                                <<01103>>14192000
    9,"REMOVABLE",                                             <<01103>>14194000
    8,"REPAIRED",                                              <<03550>>14196000
    7,"REPEATS",                                               <<01103>>14198000
    8,"RESERVED",                                              <<01103>>14200000
    8,"RESIDENT",                                              <<01103>>14202000
    7,"RETRIES",                                               <<03550>>14204000
    9,"RETURNING",                                             <<01442>>14206000
    3,"RIN",                                                   <<01103>>14208000
    4,"SAME",                                                  <<01103>>14210000
    4,"SAVE",                                                  <<03668>>14212000
    6,"SECOND",                                                <<01103>>14214000
    6,"SECTOR",                                                <<01103>>14216000
    9,"SEEKAHEAD",                                             <<01853>>14218000
    7,"SEGMENT",                                               <<01103>>14220000
    8,"SEQUENCE",                                              <<01103>>14222000
    6,"SERIAL",                                                <<01103>>14224000
    3,"SET",                                                   <<01103>>14226000
    1,"7",                                                     <<01103>>14228000
    3,"SIO",                                                   <<01103>>14230000
    1,"6",                                                     <<01103>>14232000
    4,"SIZE",                                                  <<01103>>14234000
    2,"SL",                                                    <<01103>>14236000
    8,"SOFTWARE",                                              <<01103>>14238000
    5,"SPACE",                                                 <<01103>>14240000
    5,"SPARE",                                                 <<01103>>14242000
    7,"SPARING",                                               <<03550>>14244000
    9,"SPECIFIED",                                             <<01103>>14246000
    5,"SPEED",                                                 <<01103>>14248000
    7,"SPOOLED",                                               <<01103>>14250000
    9,"SPOOLFILE",                                             <<01103>>14252000
   38,"<SPREAD/COMPACT/RESTORE/ACCOUNTS/NULL>",                <<01103>>14254000
    5,"STACK",                                                 <<01103>>14256000
    7,"STATION",                                               <<01103>>14258000
    3,"SUB",                                                   <<01103>>14260000
    4,"SUCH",                                                  <<01103>>14262000
    9,"SUPPORTED",                                             <<03002>>14264000
    8,"SUPPOSED",                                              <<01103>>14266000
    6,"SYSTEM",                                                <<01103>>14268000
    5,"TABLE",                                                 <<01103>>14270000
    4,"TAPE",                                                  <<01103>>14272000
    4,"TERM",                                                  <<01103>>14274000
    8,"TERMINAL",                                              <<01103>>14276000
    4,"THAN",                                                  <<01103>>14278000
    3,"THE",                                                   <<03551>>14280000
    4,"THIS",                                                  <<01103>>14282000
    7,"TIMEOUT",                                               <<01103>>14284000
    6,"TIMING",                                                <<01103>>14286000
    2,"TO",                                                    <<01103>>14288000
    3,"TOO",                                                   <<01103>>14290000
    5,"TRACE",                                                 <<01103>>14292000
    5,"TRACK",                                                 <<01103>>14294000
   12,"TRACK/SECTOR",                                          <<03550>>14296000
    7,"TRAILER",                                               <<01103>>14298000
    8,"TRANSFER",                                              <<01103>>14300000
   12,"TRANSMISSION",                                          <<01103>>14302000
    3,"TRY",                                                   <<03551>>14304000
    4,"TYPE",                                                  <<01103>>14306000
   11,"UNAVAILABLE",                                           <<01103>>14308000
   13,"UNCORRECTABLE",                                         <<01103>>14310000
    9,"UNDEFINED",                                             <<01103>>14312000
   13,"UNINITIALIZED",                                         <<01103>>14314000
    6,"UNIQUE",                                                <<01103>>14316000
    4,"UNIT",                                                  <<01103>>14318000
    7,"UNKNOWN",                                               <<03551>>14320000
   10,"UNRESOLVED",                                            <<01103>>14322000
    3,"USE",                                                   <<01103>>14324000
    4,"USED",                                                  <<01103>>14326000
    4,"USER",                                                  <<01103>>14328000
    7,"VIRTUAL",                                               <<01103>>14330000
    6,"VOLUME",                                                <<01103>>14332000
    4,"WANT",                                                  <<01103>>14334000
   21,"<WARMSTART/COOLSTART>",                                 <<01103>>14336000
    9,"WARMSTART",                                             <<01103>>14338000
   11,"**WARNING**",                                           <<01103>>14340000
    7,"WELCOME",                                               <<01103>>14342000
    4,"WENT",                                                  <<01103>>14344000
    5,"WHICH",                                                 <<01103>>14346000
    5,"WHILE",                                                 <<01442>>14348000
    5,"WIDTH",                                                 <<01103>>14350000
    4,"WILL",                                                  <<01103>>14352000
   11,"WRAP-AROUND",                                           <<01103>>14354000
    5,"WRONG",                                                 <<01103>>14356000
    5,"WSTAB",                                                 <<01103>>14358000
    3,"YOU",                                                   <<01103>>14360000
    1,"0";                                                     <<01103>>14362000
EQUATE                                                         <<01103>>14364000
   A                 = 0,                                      <<01103>>14366000
   ABORTED           = A                +1,                    <<01103>>14368000
   ACCEPT            = ABORTED          +1,                    <<01103>>14370000
   ACCESS            = ACCEPT           +1,                    <<01103>>14372000
   ACCOUNT           = ACCESS           +1,                    <<01103>>14374000
   ADD               = ACCOUNT          +1,                    <<01103>>14376000
   ADDITIONAL        = ADD              +1,                    <<01103>>14378000
   ADDRESS           = ADDITIONAL       +1,                    <<01103>>14380000
   ALL               = ADDRESS          +1,                    <<01103>>14382000
   ALLOCATE          = ALL              +1,                    <<03551>>14384000
   ALLOCATION        = ALLOCATE         +1,                    <<03551>>14386000
   ALLOWED           = ALLOCATION       +1,                    <<MPEIV>>14388000
   ALREADY           = ALLOWED          +1,                    <<01103>>14390000
   ALTERNATE         = ALREADY          +1,                    <<01103>>14392000
   ALTERNATES        = ALTERNATE        +PLURAL,               <<01103>>14394000
   AND'              = ALTERNATE        +1,                    <<01103>>14396000
   ANOTHER           = AND'             +1,                    <<01103>>14398000
   ANSWER            = ANOTHER          +1,                    <<01103>>14400000
   ANY               = ANSWER           +1,                    <<01103>>14402000
   ARE               = ANY              +1,                    <<01103>>14404000
   AREA              = ARE              +1,                    <<01103>>14406000
   AS                = AREA             +1,                    <<01103>>14408000
   ASSUMED           = AS               +1,                    <<01103>>14410000
   AT                = ASSUMED          +1,                    <<01103>>14412000
   ATTEMPT           = AT               +1,                    <<01103>>14414000
   ATTENTION         = ATTEMPT          +1,                    <<01103>>14416000
   AUTOMATIC         = ATTENTION        +1,                    <<01103>>14418000
   AVAILABLE         = AUTOMATIC        +1,                    <<01103>>14420000
   BAD               = AVAILABLE        +1,                    <<01103>>14422000
   BANK              = BAD              +1,                    <<01103>>14424000
   BE                = BANK             +1,                    <<01103>>14426000
   BECAUSE           = BE               +1,                    <<01103>>14428000
   BEEN              = BECAUSE          +1,                    <<03551>>14430000
   BEING             = BEEN             +1,                    <<03551>>14432000
   BLANK             = BEING            +1,                    <<01103>>14434000
   BOARD             = BLANK            +1,                    <<03004>>14436000
   BOOT              = BOARD            +1,                    <<03004>>14438000
   BOOTSTRAP         = BOOT             +1,                    <<01103>>14440000
   BUFFER            = BOOTSTRAP        +1,                    <<01103>>14442000
   BY                = BUFFER           +1,                    <<01103>>14444000
   CALL              = BY               +1,                    <<03550>>14446000
   CAN               = CALL             +1,                    <<03550>>14448000
   CANNOT            = CAN              +1,                    <<01103>>14450000
   CHANGE            = CANNOT           +1,                    <<01103>>14452000
   CHANGEABLE        = CHANGE           +1,                    <<01103>>14454000
   CHANGED           = CHANGEABLE       +1,                    <<01103>>14456000
   CHANGES           = CHANGE           +PLURAL,               <<01103>>14458000
   CHANNEL           = CHANGED          +1,                    <<01103>>14460000
   CHARACTERS        = CHANNEL          +1,                    <<01103>>14462000
   CHECKSUM'         = CHARACTERS       +1,                    <<03603>>14464000
   CIRCULAR          = CHECKSUM'        +1,                    <<03603>>14466000
   CLASS             = CIRCULAR         +1,                    <<01103>>14468000
   CLASSES           = CLASS            +1,                    <<01103>>14470000
   CMD               = CLASSES          +1,                    <<01103>>14472000
   CODE              = CMD              +1,                    <<01103>>14474000
   COL'REL'UPD       = CODE             +1,                    <<01103>>14476000
   COLD              = COL'REL'UPD      +1,                    <<01103>>14478000
   COLDLOAD          = COLD             +1,                    <<01103>>14480000
   COMBINATIONS      = COLDLOAD         +1,                    <<01103>>14482000
   COMMA             = COMBINATIONS     +1,                    <<01103>>14484000
   COMMAND           = COMMA            +1,                    <<03550>>14486000
   COMPARE           = COMMAND          +1,                    <<03550>>14488000
   COMPLETED         = COMPARE          +1,                    <<03550>>14490000
   COMPLETOR         = COMPLETED        +1,                    <<03550>>14492000
   COMPONENT         = COMPLETOR        +1,                    <<01103>>14494000
   COMPONENTS        = COMPONENT        +PLURAL,               <<01103>>14496000
   CONCURRENT        = COMPONENT        +1,                    <<01103>>14498000
   CONFIGURATION     = CONCURRENT       +1,                    <<01103>>14500000
   CONFIGURED        = CONFIGURATION    +1,                    <<01103>>14502000
   CONNECT           = CONFIGURED       +1,                    <<01103>>14504000
   CONSOLE           = CONNECT          +1,                    <<01103>>14506000
   CONTAINS          = CONSOLE          +1,                    <<01103>>14508000
   CONTINUE          = CONTAINS         +1,                    <<01103>>14510000
   CONTROL           = CONTINUE         +1,                    <<01103>>14512000
   CONTROLLER        = CONTROL          +1,                    <<01103>>14514000
   CONVERTED         = CONTROLLER       +1,                    <<03551>>14516000
   CORE              = CONVERTED        +1,                    <<03551>>14518000
   CORRECT           = CORE             +1,                    <<01103>>14520000
   CORRECTABLE       = CORRECT          +1,                    <<01103>>14522000
   CPU               = CORRECTABLE      +1,                    <<03002>>14524000
   CPVA              = CPU              +1,                    <<03002>>14526000
   CRLF              = CPVA             +1,                    <<01103>>14528000
   CS                = CRLF             +1,                    <<01103>>14530000
   CS'80             = CS               +1,                    <<03550>>14532000
   CST               = CS'80            +1,                    <<03550>>14534000
   CSTBLK            = CST              +1,                    <<01103>>14536000
   CURRENT           = CSTBLK           +1,                    <<01103>>14538000
   CYLINDER          = CURRENT          +1,                    <<01103>>14540000
   CYLINDERS         = CYLINDER         +PLURAL,               <<01103>>14542000
   DATA              = CYLINDER         +1,                    <<01103>>14544000
   DATE              = DATA             +1,                    <<01103>>14546000
   DEFAULT           = DATE             +1,                    <<MPEIV>>14548000
   DEFECTIVE         = DEFAULT          +1,                    <<MPEIV>>14550000
   DEFINED           = DEFECTIVE        +1,                    <<01103>>14552000
   DELAY             = DEFINED          +1,                    <<01103>>14554000
   DELETE            = DELAY            +1,                    <<01103>>14556000
   DEPENDENT         = DELETE           +1,                    <<01299>>14558000
   DESTROYED         = DEPENDENT        +1,                    <<01299>>14560000
   DEVICE            = DESTROYED        +1,                    <<01103>>14562000
   DEVICES           = DEVICE           +PLURAL,               <<01103>>14564000
   DIAL              = DEVICE           +1,                    <<01103>>14566000
   DIFFERENT         = DIAL             +1,                    <<01103>>14568000
   DIRECTORY         = DIFFERENT        +1,                    <<01103>>14570000
   DISABLE           = DIRECTORY        +1,                    <<01103>>14572000
   DISC              = DISABLE          +1,                    <<01103>>14574000
   DISMOUNT          = DISC             +1,                    <<01103>>14576000
   DO'               = DISMOUNT         +1,                    <<01103>>14578000
   DOES              = DO'              +1,                    <<01103>>14580000
   DOUBLE'           = DOES             +1,                    <<01103>>14582000
   DRIVE             = DOUBLE'          +1,                    <<01103>>14584000
   DRIVER            = DRIVE            +1,                    <<01103>>14586000
   DRIVERS           = DRIVER           +PLURAL,               <<01103>>14588000
   DRT               = DRIVER           +1,                    <<01103>>14590000
   DRTS              = DRT             + PLURAL,               <<03002>>14592000
   DST               = DRT              +1,                    <<01103>>14594000
   DUAL              = DST              +1,                    <<01103>>14596000
   DUPLICATE'        = DUAL             +1,                    <<01103>>14598000
   DUPLICATIVE       = DUPLICATE'       +1,                    <<01103>>14600000
   DURING            = DUPLICATIVE      +1,                    <<01103>>14602000
   EARLIER           = DURING           +1,                    <<01103>>14604000
   EIGHT             = EARLIER          +1,                    <<01103>>14606000
   ENABLE            = EIGHT            +1,                    <<01853>>14608000
   END'              = ENABLE           +1,                    <<01853>>14610000
   ENTER             = END'             +1,                    <<01103>>14612000
   ENTRIES           = ENTER            +1,                    <<01103>>14614000
   ENTRY'            = ENTRIES          +1,                    <<01103>>14616000
   EOF               = ENTRY'           +1,                    <<01103>>14618000
   EQUALS            = EOF              +1,                    <<03630>>14620000
   ERROR             = EQUALS           +1,                    <<03630>>14622000
   ERRORS            = ERROR            +PLURAL,               <<01103>>14624000
   EXCEEDS           = ERROR            +1,                    <<01103>>14626000
   EXIST             = EXCEEDS          +1,                    <<01103>>14628000
   EXISTS            = EXIST            +PLURAL,               <<01103>>14630000
   EXTENT            = EXIST            +1,                    <<01103>>14632000
   EXTERNAL'         = EXTENT           +1,                    <<01103>>14634000
   FACILITY          = EXTERNAL'        +1,                    <<01103>>14636000
   FAILURE           = FACILITY         +1,                    <<01103>>14638000
   FATAL             = FAILURE          +1,                    <<01103>>14640000
   FIFTEEN           = FATAL            +1,                    <<02707>>14642000
   FILE              = FIFTEEN          +1,                    <<02707>>14644000
   FILES             = FILE             +PLURAL,               <<01103>>14646000
   FLAGGED           = FILE             +1,                    <<01103>>14648000
   FOLLOWING         = FLAGGED          +1,                    <<01103>>14650000
   FOR'              = FOLLOWING        +1,                    <<01103>>14652000
   FOUR              = FOR'             +1,                    <<02834>>14654000
   FOREIGN           = FOUR             +1,                    <<02834>>14656000
   FORMAT            = FOREIGN          +1,                    <<01115>>14658000
   FOUND             = FORMAT           +1,                    <<01103>>14660000
   FREE              = FOUND            +1,                    <<03551>>14662000
   FROM              = FREE             +1,                    <<03551>>14664000
   FULL              = FROM             +1,                    <<01103>>14666000
   GEQ               = FULL             +1,                    <<03002>>14668000
   GETTING           = GEQ              +1,                    <<03002>>14670000
   GROUP             = GETTING          +1,                    <<01442>>14672000
   HALF              = GROUP            +1,                    <<01103>>14674000
   HALT              = HALF             +1,                    <<01103>>14676000
   HANDLER           = HALT             +1,                    <<01103>>14678000
   HARDWARE          = HANDLER          +1,                    <<03004>>14680000
   HAS               = HARDWARE         +1,                    <<03551>>14682000
   HAVE              = HAS              +1,                    <<03551>>14684000
   HEAD              = HAVE             +1,                    <<01103>>14686000
   HIGHEST           = HEAD             +1,                    <<01103>>14688000
   HPIB              = HIGHEST          +1,                    <<02707>>14690000
   HYPHEN            = HPIB             +1,                    <<02707>>14692000
   IO                = HYPHEN           +1,                    <<01103>>14694000
   ID                = IO               +1,                    <<01103>>14696000
   ILLEGAL           = ID               +1,                    <<01103>>14698000
   IMPROPER          = ILLEGAL          +1,                    <<01103>>14700000
   IN                = IMPROPER         +1,                    <<01103>>14702000
   IN'OUT            = IN               +1,                    <<01103>>14704000
   INFORMATION       = IN'OUT           +1,                    <<03550>>14706000
   INITIALIZATION    = INFORMATION      +1,                    <<03550>>14708000
   INITIALLY         = INITIALIZATION   +1,                    <<01103>>14710000
   INITIATOR         = INITIALLY        +1,                    <<01103>>14712000
   INPUT             = INITIATOR        +1,                    <<01103>>14714000
   INSUFFICIENT      = INPUT            +1,                    <<01103>>14716000
   INTERACTIVE       = INSUFFICIENT     +1,                    <<01103>>14718000
   INTERCOMPONENT    = INTERACTIVE      +1,                    <<01103>>14720000
   INTERFACE         = INTERCOMPONENT   +1,                    <<02707>>14722000
   INTERRUPT'        = INTERFACE        +1,                    <<02707>>14724000
   INTO              = INTERRUPT'       +1,                    <<01103>>14726000
   INVALID           = INTO             +1,                    <<01103>>14728000
   IOP               = INVALID          +1,                    <<01103>>14730000
   IRRECOVERABLE     = IOP              +1,                    <<01103>>14732000
   IS                = IRRECOVERABLE    +1,                    <<01103>>14734000
   JMAT              = IS               +1,                    <<01103>>14736000
   JOBS'SESSIONS     = JMAT             +1,                    <<01103>>14738000
   KILOSECTORS       = JOBS'SESSIONS    +1,                    <<01103>>14740000
   LABEL'            = KILOSECTORS      +1,                    <<01103>>14742000
   LARGE             = LABEL'           +1,                    <<01103>>14744000
   LDEV              = LARGE            +1,                    <<01103>>14746000
   LENGTH            = LDEV             +1,                    <<01103>>14748000
   LEQ               = LENGTH           +1,                    <<03002>>14750000
   LEVEL             = LEQ              +1,                    <<03002>>14752000
   LIST              = LEVEL            +1,                    <<01103>>14754000
   LOAD              = LIST             +1,                    <<01103>>14756000
   LOADED            = LOAD             +1,                    <<01103>>14758000
   LOCAL             = LOADED           +1,                    <<01103>>14760000
   LOGGING           = LOCAL            +1,                    <<01103>>14762000
   LOGICAL'          = LOGGING          +1,                    <<01103>>14764000
   LOGID             = LOGICAL'         +1,                    <<01103>>14766000
   LONGER            = LOGID            +1,                    <<01103>>14768000
   LOST              = LONGER           +1,                    <<01103>>14770000
   MAKE              = LOST             +1,                    <<01103>>14772000
   MAP               = MAKE             +1,                    <<01103>>14774000
   MARK              = MAP              +1,                    <<01103>>14776000
   MARKER            = MARK             +1,                    <<01103>>14778000
   MASK              = MARKER           +1,                    <<01103>>14780000
   MASTER            = MASK             +1,                    <<01103>>14782000
   MAX               = MASTER           +1,                    <<01103>>14784000
   MAY               = MAX              +1,                    <<01103>>14786000
   MEMBER            = MAY              +1,                    <<01103>>14788000
   MEMORY            = MEMBER           +1,                    <<01103>>14790000
   MESSAGE           = MEMORY           +1,                    <<01103>>14792000
   MISSING           = MESSAGE          +1,                    <<01103>>14794000
   MOD'              = MISSING          +1,                    <<02834>>14796000
   MODE              = MOD'             +1,                    <<02834>>14798000
   MODULE            = MODE             +1,                    <<01103>>14800000
   MORE              = MODULE           +1,                    <<01103>>14802000
   MOUNT             = MORE             +1,                    <<01103>>14804000
   MOUNTED           = MOUNT            +1,                    <<01103>>14806000
   MOVING            = MOUNTED          +1,                    <<01103>>14808000
   MPE               = MOVING           +1,                    <<01103>>14810000
   MUST              = MPE              +1,                    <<01103>>14812000
   N125'127          = MUST             +1,                    <<02707>>14814000
   NON'RESPONDING    = N125'127         +1,                    <<02707>>14816000
   NAME              = NON'RESPONDING   +1,                    <<01103>>14818000
   NEW               = NAME             +1,                    <<01103>>14820000
   NEXT              = NEW              +1,                    <<01103>>14822000
   NO                = NEXT             +1,                    <<01103>>14824000
   NON               = NO               +1,                    <<01103>>14826000
   NOT'              = NON              +1,                    <<01103>>14828000
   NOW               = NOT'             +1,                    <<01103>>14830000
   NUM               = NOW              +1,                    <<01103>>14832000
   NUMBER            = NUM              +1,                    <<01103>>14834000
   NUMBERS           = NUMBER           +PLURAL,               <<01103>>14836000
   NUMS              = NUMBER           +1,                    <<01103>>14838000
   OF'               = NUMS             +1,                    <<01103>>14840000
   OKAY              = OF'              +1,                    <<01103>>14842000
   OLD               = OKAY             +1,                    <<01103>>14844000
   ON                = OLD              +1,                    <<01103>>14846000
   ONE               = ON               +1,                    <<01103>>14848000
   ONLY              = ONE              +1,                    <<01103>>14850000
   OPEN              = ONLY             +1,                    <<01103>>14852000
   OPERATION         = OPEN             +1,                    <<01103>>14854000
   OPERATIONS        = OPERATION        +PLURAL,               <<03630>>14856000
   OPTION'           = OPERATION        +1,                    <<01103>>14858000
   OPTIONS           = OPTION'          +PLURAL,               <<01103>>14860000
   OR'               = OPTION'          +1,                    <<01103>>14862000
   OUT               = OR'              +1,                    <<01103>>14864000
   OUTPUT            = OUT              +1,                    <<01103>>14866000
   OVERFLOW'         = OUTPUT           +1,                    <<03550>>14868000
   OVERRUN           = OVERFLOW'        +1,                    <<03550>>14870000
   PACK              = OVERRUN          +1,                    <<01103>>14872000
   PARITY            = PACK             +1,                    <<01103>>14874000
   PCB               = PARITY           +1,                    <<01103>>14876000
   PER               = PCB              +1,                    <<01103>>14878000
   PHONE             = PER              +1,                    <<01103>>14880000
   PHYSICAL          = PHONE            +1,                    <<01103>>14882000
   POLL              = PHYSICAL         +1,                    <<01103>>14884000
   PORT              = POLL             +1,                    <<01103>>14886000
   PORTION           = PORT             +1,                    <<01103>>14888000
   POSSIBLE          = PORTION          +1,                    <<01103>>14890000
   PREFERRED         = POSSIBLE         +1,                    <<01103>>14892000
   PREVIOUS          = PREFERRED        +1,                    <<01103>>14894000
   PRIMARY           = PREVIOUS         +1,                    <<01103>>14896000
   PROCESSES         = PRIMARY          +1,                    <<01103>>14898000
   PROGRAM           = PROCESSES        +1,                    <<01103>>14900000
   PROGRESS          = PROGRAM          +1,                    <<03550>>14902000
   PROTECT           = PROGRESS         +1,                    <<03550>>14904000
   PROTOCOL          = PROTECT          +1,                    <<01103>>14906000
   PURGE             = PROTOCOL         +1,                    <<03668>>14908000
   PURGED            = PURGE            +1,                    <<03668>>14910000
   RANGE'            = PURGED           +1,                    <<03002>>14912000
   RANGES            = RANGE'           + PLURAL,              <<03002>>14914000
   READ              = RANGE'           +1,                    <<03002>>14916000
   READING           = READ             +1,                    <<01103>>14918000
   READY             = READING          +1,                    <<01103>>14920000
   REASSIGN          = READY            +1,                    <<01103>>14922000
   REASSIGNS         = READY            +PLURAL,               <<03550>>14924000
   REASSIGNED        = REASSIGN         +1,                    <<01103>>14926000
   RECEIVE           = REASSIGNED       +1,                    <<01103>>14928000
   RECONFIGURED      = RECEIVE          +1,                    <<01103>>14930000
   RECORD            = RECONFIGURED     +1,                    <<01103>>14932000
   RECOVER           = RECORD           +1,                    <<01103>>14934000
   REEL              = RECOVER          +1,                    <<01103>>14936000
   REINITIALIZE      = REEL             +1,                    <<01103>>14938000
   REJECTED          = REINITIALIZE     +1,                    <<01103>>14940000
   RELOAD            = REJECTED         +1,                    <<01103>>14942000
   REMOTE            = RELOAD           +1,                    <<01103>>14944000
   REMOVABLE'        = REMOTE           +1,                    <<01103>>14946000
   REPAIRED          = REMOVABLE'       +1,                    <<03550>>14948000
   REPEATS           = REPAIRED         +1,                    <<03550>>14950000
   RESERVED          = REPEATS          +1,                    <<01103>>14952000
   RESIDENT          = RESERVED         +1,                    <<01103>>14954000
   RETRIES           = RESIDENT         +1,                    <<03550>>14956000
   RETURNING         = RETRIES          +1,                    <<03550>>14958000
   RIN               = RETURNING        +1,                    <<01442>>14960000
   SAME              = RIN              +1,                    <<01103>>14962000
   SAVE              = SAME             +1,                    <<03668>>14964000
   SECOND            = SAVE             +1,                    <<03668>>14966000
   SECTOR            = SECOND           +1,                    <<01103>>14968000
   SECTORS           = SECTOR           +PLURAL,               <<01103>>14970000
   SEEKAHEAD         = SECTOR           +1,                    <<01853>>14972000
   SEGMENT           = SEEKAHEAD        +1,                    <<01853>>14974000
   SEQUENCE          = SEGMENT          +1,                    <<01103>>14976000
   SERIAL            = SEQUENCE         +1,                    <<01103>>14978000
   SET'              = SERIAL           +1,                    <<01103>>14980000
   SEVEN             = SET'             +1,                    <<01103>>14982000
   SIO               = SEVEN            +1,                    <<01103>>14984000
   SIX               = SIO              +1,                    <<01103>>14986000
   SIZE              = SIX              +1,                    <<01103>>14988000
   SIZES             = SIZE             +PLURAL,               <<MPEIV>>14990000
   SL                = SIZE             +1,                    <<01103>>14992000
   SOFTWARE          = SL               +1,                    <<01103>>14994000
   SPACE             = SOFTWARE         +1,                    <<01103>>14996000
   SPARE             = SPACE            +1,                    <<01103>>14998000
   SPARING           = SPARE            +1,                    <<03550>>15000000
   SPECIFIED         = SPARING          +1,                    <<03550>>15002000
   SPEED             = SPECIFIED        +1,                    <<01103>>15004000
   SPOOLED           = SPEED            +1,                    <<01103>>15006000
   SPOOLFILE         = SPOOLED          +1,                    <<01103>>15008000
   SPOOLFILES        = SPOOLFILE        +PLURAL,               <<01103>>15010000
   SPR'CMP'RST       = SPOOLFILE        +1,                    <<01103>>15012000
   STACK             = SPR'CMP'RST      +1,                    <<01103>>15014000
   STATION           = STACK            +1,                    <<01103>>15016000
   SUB               = STATION          +1,                    <<01103>>15018000
   SUCH              = SUB              +1,                    <<01103>>15020000
   SUPPORTED         = SUCH            +1,                     <<03002>>15022000
   SUPPOSED          = SUPPORTED       +1,                     <<03002>>15024000
   SYSTEM            = SUPPOSED         +1,                    <<01103>>15026000
   TABLE             = SYSTEM           +1,                    <<01103>>15028000
   TABLES            = TABLE            +PLURAL,               <<01103>>15030000
   TAPE              = TABLE            +1,                    <<01103>>15032000
   TERM              = TAPE             +1,                    <<01103>>15034000
   TERMINAL          = TERM             +1,                    <<01103>>15036000
   THAN              = TERMINAL         +1,                    <<01103>>15038000
   THE               = THAN             +1,                    <<03551>>15040000
   THIS              = THE              +1,                    <<03551>>15042000
   TIMEOUT           = THIS             +1,                    <<01103>>15044000
   TIMING            = TIMEOUT          +1,                    <<01103>>15046000
   TO'               = TIMING           +1,                    <<01103>>15048000
   TOO               = TO'              +1,                    <<01103>>15050000
   TRACE             = TOO              +1,                    <<01103>>15052000
   TRACK             = TRACE            +1,                    <<01103>>15054000
   TRACKS            = TRACK            +PLURAL,               <<01103>>15056000
   TRACK'SECTOR      = TRACK            +1,                    <<03550>>15058000
   TRAILER           = TRACK'SECTOR     +1,                    <<03550>>15060000
   TRANSFER          = TRAILER          +1,                    <<01103>>15062000
   TRANSMISSION      = TRANSFER         +1,                    <<01103>>15064000
   TRY               = TRANSMISSION     +1,                    <<03551>>15066000
   TYPE              = TRY              +1,                    <<03551>>15068000
   UNAVAILABLE       = TYPE             +1,                    <<01103>>15070000
   UNCORRECTABLE     = UNAVAILABLE      +1,                    <<01103>>15072000
   UNDEFINED         = UNCORRECTABLE    +1,                    <<01103>>15074000
   UNINITIALIZED     = UNDEFINED        +1,                    <<01103>>15076000
   UNIQUE            = UNINITIALIZED    +1,                    <<01103>>15078000
   UNIT              = UNIQUE           +1,                    <<01103>>15080000
   UNKNOWN           = UNIT             +1,                    <<03551>>15082000
   UNRESOLVED        = UNKNOWN          +1,                    <<03551>>15084000
   USE               = UNRESOLVED       +1,                    <<01103>>15086000
   USED              = USE              +1,                    <<01103>>15088000
   USER              = USED             +1,                    <<01103>>15090000
   VIRTUAL           = USER             +1,                    <<01103>>15092000
   VOLUME            = VIRTUAL          +1,                    <<01103>>15094000
   VOLUMES           = VOLUME           +PLURAL,               <<01103>>15096000
   WANT              = VOLUME           +1,                    <<01103>>15098000
   WARMCOOL          = WANT             +1,                    <<01103>>15100000
   WARMSTART'        = WARMCOOL         +1,                    <<01103>>15102000
   WARNING           = WARMSTART'       +1,                    <<01103>>15104000
   WELCOME           = WARNING          +1,                    <<01103>>15106000
   WENT              = WELCOME          +1,                    <<01103>>15108000
   WHICH             = WENT             +1,                    <<01103>>15110000
   WHILE'            = WHICH            +1,                    <<01442>>15112000
   WIDTH             = WHILE'           +1,                    <<01442>>15114000
   WILL              = WIDTH            +1,                    <<01103>>15116000
   WRAP'AROUND       = WILL             +1,                    <<01103>>15118000
   WRONG             = WRAP'AROUND      +1,                    <<01103>>15120000
   WSTAB             = WRONG            +1,                    <<01103>>15122000
   YOU               = WSTAB            +1,                    <<01103>>15124000
   ZERO              = YOU              +1;                    <<01103>>15126000
                                                               <<01103>>15128000
INTEGER ARRAY MESS(*) = PB :=                                  <<01103>>15130000
                                                               <<01103>>15132000
             << I/O ERRORS >>                                  <<01103>>15134000
                                                               <<01103>>15136000
        << ERROR MSG ZERO - RESERVED FOR "NO MSG" >>           <<01103>>15138000
   1, 5,NON'RESPONDING,DEVICE,CONTROLLER,DRT,PD1,              <<01103>>15140000
   2, 6,CHANNEL,PROGRAM,FAILURE,HYPHEN,DRT,PD1,                <<02510>>15142000
   3, 6,CHANNEL,PROGRAM,ABORTED,HYPHEN,CPVA,PO1,               <<01103>>15144000
   4, 2,IOP,ERROR,                                             <<01103>>15146000
   5, 4,TAPE,IO,CMD,REJECTED,                                  <<01103>>15148000
   6, 3,TAPE,TRANSFER,ERROR,                                   <<01103>>15150000
   7, 3,TAPE,PARITY,ERROR,                                     <<01103>>15152000
   8, 3,TAPE,TIMING,ERROR,                                     <<01103>>15154000
   9, 3,READING,BLANK,TAPE,                                    <<01103>>15156000
  10, 5,COLD,LOAD,TAPE,READ,ERROR,                             <<01103>>15158000
  11, 3,IRRECOVERABLE,PARITY,ERRORS,                           <<01103>>15160000
  12, 2,ILLEGAL,CMD,                                           <<01103>>15162000
  13, 3,CYLINDER,COMPARE,ERROR,                                <<01103>>15164000
  14, 2,UNCORRECTABLE,ERROR,                                   <<01103>>15166000
  15, 4,HEAD,SECTOR,COMPARE,ERROR,                             <<01103>>15168000
  16, 3,SIO,PROGRAM,ERROR,                                     <<01103>>15170000
  17, 3,END',OF',CYLINDER,                                     <<01103>>15172000
  18, 1,OVERRUN,                                               <<01103>>15174000
  19, 3,POSSIBLE,CORRECTABLE,ERROR,                            <<01103>>15176000
  20, 5,ILLEGAL,ACCESS,TO',SPARE,TRACK,                        <<01103>>15178000
  21, 2,DEFECTIVE,TRACK,                                       <<01103>>15180000
  22, 4,HEAD,MOVING,DURING,OPERATION,                          <<01103>>15182000
  23, 3,DISC,DRIVE,ERROR,                                      <<01103>>15184000
  24, 5,ATTEMPT,TO',PROTECT,DEFECTIVE,TRACK,                   <<01103>>15186000
  25, 2,DRIVE,UNAVAILABLE,                                     <<01103>>15188000
  26, 2,DRIVE,ATTENTION,                                       <<01103>>15190000
  27, 3,BAD,DISC,ADDRESS,                                      <<01103>>15192000
  28, 3,BAD,FILE,ADDRESS,                                      <<01103>>15194000
  29, 3,HPIB,INTERFACE,ERROR,                                  <<02707>>15196000
  30, 5,CS'80,DRIVER,ERROR,NUMBER,PD1,                         <<03550>>15198000
  31,10,DRIVER,COMMAND,STACK,OVERFLOW',LDEV,PD1,DRT,PD2,       <<03550>>15200000
        UNIT,PD3,                                              <<03550>>15202000
  32,11,NUMBER,OF',RETRIES,EXCEEDS,MAX,LDEV,PD1,DRT,PD2,       <<03550>>15204000
        UNIT,PD3,                                              <<03550>>15206000
  33, 6,TRANSFER,SIZE,TOO,LARGE,LDEV,PD1,                      <<03550>>15208000
  34, 5,INVALID,DRIVER,CALL,LDEV,PD1,                          <<03550>>15210000
                                                               <<01103>>15212000
             << CONFIGURATION ERRORS >>                        <<01103>>15214000
                                                               <<01103>>15216000
 100, 6,PREVIOUS,RELOAD,ABORTED,HYPHEN,MUST,RELOAD,            <<01103>>15218000
 101,11,PREVIOUS,TAPE,COLD,LOAD,ABORTED,HYPHEN,MUST,COLD,LOAD, <<01103>>15220000
        FROM,TAPE,                                                      15222000
 102, 6,USER,SPECIFIED,MAX,DRT,IS,PD1,                         <<03002>>15224000
 103, 6,SYSTEM,DISC,MUST,BE,UNIT,ZERO,                         <<01103>>15226000
 104, 8,SYSTEM,DISC,MAY,ONLY,BE,RECONFIGURED,ON,RELOAD,        <<01103>>15228000
 105, 6,LDEV,ONE,MUST,BE,SYSTEM,DISC,                          <<01103>>15230000
 106, 5,WRONG,DRT,FOR',SYSTEM,DISC,                            <<01103>>15232000
 107, 5,NO,DEVICE,IN,CLASS,DISC,                               <<01103>>15234000
 108, 6,COLD,LOAD,DEVICE,MUST,BE,CONFIGURED,                   <<02510>>15236000
 109, 9,SYSTEM,CONSOLE,MUST,BE,IN,DRT,SEVEN,UNIT,ZERO,         <<01103>>15238000
 110, 9,SYSTEM,CONSOLE,MUST,BE,IN,DRT,EIGHT,UNIT,ZERO,         <<01103>>15240000
 111, 5,IMPROPER,SPEED,FOR',SYSTEM,CONSOLE,                    <<01103>>15242000
 112, 7,LDEV,PD1,TERMINAL,UNIT,MUST,BE,ZERO,                   <<03004>>15244000
 113, 7,LDEV,PD1,TERMINAL,DRT,MUST,BE,UNIQUE,                  <<03004>>15246000
 114, 3,ILLEGAL,MASTER,DEVICE,                                 <<01103>>15248000
 115,10,UNDEFINED,CLASS,STR1,USED,AS,OUTPUT,DEVICE,BY,         <<01103>>15250000
        FOLLOWING,DEVICES,                                              15252000
 116, 7,NO,OUTPUT,DEVICE,FOR',LOGICAL',DEVICE,PD1,             <<01103>>15254000
 117, 8,OUTPUT,CLASS,FOR',DEVICE,PD1,NO,LONGER,EXISTS,         <<01103>>15256000
 118, 8,DEVICE,CLASS,STR1,CAN,NOT',BE,OUTPUT,DEVICE,           <<01103>>15258000
 119, 8,LOGICAL',DEVICE,PD1,CAN,NOT',BE,OUTPUT,DEVICE,         <<01103>>15260000
 120, 6,LOGICAL',DEVICE,PD1,DOES,NOT',EXIST,                   <<01103>>15262000
 121,10,LDEV,PD1,AND',LDEV,PD2,ON,SAME,DRT,AND',UNIT,          <<03004>>15264000
 122, 8,DEVICES,OF',DIFFERENT,TYPE,RANGES,IN,CLASS,STR1,       <<01103>>15266000
 123, 6,ILLEGAL,TYPE,COMBINATIONS,IN,CLASS,STR1,               <<01103>>15268000
 124, 7,CONFIGURED,MEMORY,SIZE,EXCEEDS,PHYSICAL,MEMORY,        <<01103>>15270000
        AVAILABLE,                                                      15272000
 125, 8,CAN,NOT',RECOVER,DISC,SPACE,OF',SPOOLFILE,STR1,        <<01103>>15274000
 126, 5,DISC,DRIVER,DOES,NOT',EXIST,                           <<01103>>15276000
 127, 7,MORE,THAN,ONE,DEVICE,FOR',DRT,PD1,                     <<01103>>15278000
 128, 8,HIGHEST,DRT,SUPPORTED,BY,THIS,CPU,IS,PD1,              <<03002>>15280000
 129, 5,FOLLOWING,DRTS,MUST,BE,CHANGED,                        <<03002>>15282000
 130, 4,NOT',A,SUPPORTED,SPEED,                                <<03004>>15284000
 131, 8,LDEV,PD1,TERMINAL,SPEED,NOT',SUPPORTED,BY,HARDWARE,    <<03004>>15286000
 132, 9,NON'RESPONDING,BOARD,FOR',TERMINAL,ON,LDEV,PD1,DRT,PD2,<<03004>>15288000
 133, 9,WRONG,BOARD,FOR',TERMINAL,ON,LDEV,PD1,DRT,PD2,         <<03004>>15290000
 134, 6,CHANGE,LDEV,PD1,TO',DRT,PD2,                           <<03004>>15292000
 135, 8,LDEV,PD1,DRTS,N125'127,RESERVED,FOR',HPIB,INTERFACE,   <<02707>>15294000
 136,12,CHANNEL,ON,HPIB,INTERFACE,CANNOT,BE,ZERO,COMMA,ONE,    <<02707>>15296000
        COMMA,OR',FIFTEEN,                                     <<02707>>15298000
                                                               <<01103>>15300000
             << VOLUME TABLE ERRORS >>                         <<01103>>15302000
                                                               <<01103>>15304000
 200, 3,VOLUME,TABLE,FULL,                                     <<01103>>15306000
 201, 6,VOLUME,TABLE,DESTROYED,HYPHEN,MUST,RELOAD,             <<01103>>15308000
 202, 5,MOUNT,CORRECT,VOLUMES,OR',RELOAD,                      <<01103>>15310000
 203, 5,ALL,VOLUMES,MUST,BE,MOUNTED,                           <<01103>>15312000
 204, 8,DEVICE,PD1,VOLUME,STR1,NOT',DEFINED,IN,TABLE,          <<01103>>15314000
 205, 9,VOLUME,NAME,STR1,ON,DEVICE,PD1,ALREADY,IN,USE,         <<01103>>15316000
                                                               <<01103>>15318000
             << DEFECTIVE TRACKS >>                            <<01103>>15320000
                                                               <<01103>>15322000
 225, 4,DEFECTIVE,TRACKS,TABLE,FULL,                           <<01103>>15324000
 226, 3,NO,ALTERNATES,AVAILABLE,                               <<01103>>15326000
 227, 7,IN,RESERVED,AREA,HYPHEN,CAN,NOT',DELETE,               <<01103>>15328000
 228, 6,IN,DIRECTORY,HYPHEN,CAN,NOT',DELETE,                   <<01103>>15330000
 229, 6,ALTERNATE,TRACK,HYPHEN,CAN,NOT',DELETE,                <<01103>>15332000
 230, 7,IN,SYSTEM,AREA,HYPHEN,CAN,NOT',DELETE,                 <<01103>>15334000
 231, 9,SYSTEM,TABLE,ON,DEFECTIVE,TRACKS,HYPHEN,CAN,NOT',      <<01103>>15336000
        WARMSTART',                                                     15338000
 232, 9,FLAGGED,TRACK,IN,RESERVED,AREA,HYPHEN,MUST,            <<01103>>15340000
        REINITIALIZE,PACK,                                              15342000
 233, 6,NO,MORE,REASSIGNS,ALLOWED,THIS,BOOT,                   <<03550>>15344000
 234, 6,INVALID,DISC,LABEL',ON,LDEV,PD1,                       <<03550>>15346000
 235, 7,INVALID,DEFECTIVE,TRACKS,TABLE,ON,LDEV,PD1,            <<03550>>15348000
 236,10,IN,A,SYSTEM,DISC,RESIDENT,TABLE,HYPHEN,CAN,NOT',DELETE,<<03612>>15350000
 237, 9,IN,DISC,FREE,SPACE,MAP,HYPHEN,CAN,NOT',DELETE,         <<03613>>15352000
                                                               <<01103>>15354000
             << I/O TABLE INITIALIZATION ERRORS >>             <<01103>>15356000
                                                               <<01103>>15358000
 250, 5,TERMINAL,INITIALIZATION,PROGRAM,TOO,LARGE,             <<01103>>15360000
 251, 5,TERMINAL,CHANNEL,PROGRAM,TOO,LARGE,                    <<01103>>15362000
 252, 6,DIFFERENT,PROCESSES,SPECIFIED,FOR',DRT,PD1,            <<01103>>15364000
 253,11,INITIATOR,COMMA,COMPLETOR,FOR',LDEV,PD1,SUPPOSED,TO',  <<01103>>15366000
        BE,CORE,RESIDENT,                                      <<01103>>15368000
 254, 9,MORE,THAN,ONE,PRIMARY,INTERRUPT',HANDLER,FOR',DRT,PD1, <<01103>>15370000
                                                               <<01103>>15372000
             << DIRECTORY ERRORS >>                            <<01103>>15374000
                                                               <<01103>>15376000
 275,17,INVALID,DIRECTORY,ENTRY',HYPHEN,ENTRY',LEVEL,WRONG,OR',<<01103>>15378000
        MISSING,CRLF,AT,ACCOUNT,COMMA,GROUP,OR',FILE,LEVEL,    <<01103>>15380000
 276,15,INVALID,DIRECTORY,ENTRY',HYPHEN,ENTRY',LEVEL,WRONG,OR',<<01103>>15382000
        MISSING,CRLF,AT,ACCOUNT,OR',USER,LEVEL,                <<01103>>15384000
 277, 5,DIRECTORY,ERROR,PD1,COMMA,PD2,                         <<01103>>15386000
                                                               <<01103>>15388000
             << TABLE ERRORS >>                                <<01103>>15390000
                                                               <<01103>>15392000
 300, 4,OUT,OF',CST,ENTRIES,                                   <<01103>>15394000
 301, 4,OUT,OF',DST,ENTRIES,                                   <<01103>>15396000
 302, 4,OUT,OF',PCB,ENTRIES,                                   <<01103>>15398000
 303, 4,OUT,OF',WSTAB,ENTRIES,                                 <<01103>>15400000
 304, 4,OUT,OF',CSTBLK,ENTRIES,                                <<01103>>15402000
 305, 3,INVALID,JMAT,STR1,                                     <<01103>>15404000
                                                               <<01103>>15406000
             << DISC SPACE MGMT >>                             <<01103>>15408000
                                                               <<01103>>15410000
 325,10,DISC,SPACE,ERROR,PD1,COMMA,TRY,RECOVER,LOST,DISC,SPACE,<<03632>>15412000
 326, 7,OUT,OF',DISC,SPACE,ON,LDEV,PD1,                        <<MPEIV>>15414000
 327, 5,OUT,OF',BOOTSTRAP,DISC,SPACE,                          <<01103>>15416000
 328, 7,DISC,SPACE,ERROR,HYPHEN,WHILE',RETURNING,SPACE,        <<01442>>15418000
 329, 7,DISC,SPACE,ERROR,HYPHEN,WHILE',GETTING,SPACE,          <<01442>>15420000
 330, 7,OUT,OF',VIRTUAL,MEMORY,ON,LDEV,PD1,                    <<MPEIV>>15422000
 331,12,LDEV,PD1,HAS,NOT',BEEN,CONVERTED,TO',NEW,DISC,         <<03551>>15424000
        FREE,SPACE,MAP,                                        <<03551>>15426000
 332,22,DISC,FREE,SPACE,MAP,HAS,BEEN,FLAGGED,AS,BAD,COMMA,     <<03551>>15428000
        CANNOT,ALLOCATE,SPACE,ON,LDEV,PD1,COMMA,TRY,RECOVER,   <<03551>>15430000
        LOST,DISC,SPACE,                                       <<03551>>15432000
 333,18,DISC,FREE,SPACE,MAP,FOR',LDEV,PD1,IS,ON,A,             <<03551>>15434000
        DEFECTIVE,AREA,OF',THE,DISC,COMMA,MUST,RELOAD,         <<03551>>15436000
 334, 7,RETURNING,SPACE,NOT',IN,THE,RESERVED,AREA,             <<03550>>15438000
 335, 8,RETURNING,SPACE,ALREADY,FREE,IN,THE,RESERVED,AREA,     <<03550>>15440000
                                                               <<01103>>15442000
             << MEMORY MGMT >>                                 <<01103>>15444000
                                                               <<01103>>15446000
 350, 3,OUT,OF',MEMORY,                                        <<01103>>15448000
 351, 4,OUT,OF',BANK,ZERO,                                     <<01103>>15450000
 352, 2,BANK,WRAP'AROUND,                                      <<01103>>15452000
 374, 3,FATAL,ERROR,PD1,                                       <<01103>>15454000
                                                               <<01103>>15456000
             << RESTORE ERRORS >>                              <<01103>>15458000
                                                               <<01103>>15460000
 375, 3,IMPROPER,TAPE,FORMAT,                                  <<01103>>15462000
 376, 4,NOT',A,RELOAD,TAPE,                                    <<01103>>15464000
 377, 7,TAPE,NOT',A,MEMBER,OF',THIS,SET',                      <<01103>>15466000
 378, 8,WRONG,TAPE,SET',HYPHEN,MUST,HAVE,EARLIER,DATE,         <<01103>>15468000
 379, 2,WRONG,REEL,                                            <<01103>>15470000
                                                               <<01103>>15472000
             << INTERNAL TRAPS >>                              <<01103>>15474000
                                                               <<01103>>15476000
 400, 3,NON'RESPONDING,MODULE,INTERRUPT',                      <<01103>>15478000
                                                               <<03603>>15480000
             << FILE SYSTEM >>                                 <<03603>>15482000
                                                               <<03603>>15484000
 450, 4,FILE,LABEL',CHECKSUM',ERROR,                           <<03603>>15486000
 451, 5,TAPE,FILE,LABEL',CHECKSUM',ERROR,                      <<03603>>15488000
 452, 3,DEFECTIVE,FILE,LABEL',                                 <<03603>>15490000
                                                               <<03550>>15492000
             << CS'80 SPARING >>                               <<03550>>15494000
                                                               <<03550>>15496000
 500, 6,NO,MORE,SPARING,ALLOWED,THIS,BOOT,                     <<03550>>15498000
 501,10,DATA,LOST,DURING,SPARE,LDEV,PD1,SECTORS,STR1,          <<03714>>15500000
        HYPHEN,STR2,                                           <<03714>>15502000
                                                               <<01103>>15504000
                                                               <<01103>>15506000
             << GENERAL MESSAGES AND QUESTIONS  >>             <<01103>>15508000
             << ALL MESSAGES ABOVE 2000 WILL    >>             <<01103>>15510000
             << NOT BE PRECEEDED WILL AN ERROR  >>             <<01103>>15512000
             << NUMBER CODE WHEN MOVED INTO BUF >>             <<01103>>15514000
                                                               <<01103>>15516000
                                                               <<01103>>15518000
             << I/O CONFIGURATION MESSAGES >>                  <<01103>>15520000
                                                               <<01103>>15522000
2000, 3,WHICH,OPTION',WARMCOOL,                                <<01103>>15524000
2001, 3,WHICH,OPTION',COL'REL'UPD,                             <<01103>>15526000
2002, 3,WHICH,OPTION',SPR'CMP'RST,                             <<01103>>15528000
2003, 3,SYSTEM,DISC,DRT,                                       <<01103>>15530000
2004,12,IS,REMOVABLE',PORTION,OF',SYSTEM,DISC,BEING,USED,FOR', <<01103>>15532000
        THIS,COLD,LOAD,                                        <<01103>>15534000
2005, 2,ANY,CHANGES,                                           <<01103>>15536000
2006, 2,LOAD,MAP,                                              <<01103>>15538000
2007, 2,MEMORY,SIZE,                                           <<01103>>15540000
2008, 3,IO,CONFIGURATION,CHANGES,                              <<01103>>15542000
2009, 3,LIST,IO,DEVICES,                                       <<01103>>15544000
2010, 2,HIGHEST,DRT,                                           <<01103>>15546000
2011, 3,LOGICAL',DEVICE,NUM,                                   <<01103>>15548000
2012, 2,DRT,NUM,                                               <<01103>>15550000
2013, 2,UNIT,NUM,                                              <<01103>>15552000
2014, 3,SOFTWARE,CHANNEL,NUM,                                  <<01103>>15554000
2015, 1,TYPE,                                                  <<01103>>15556000
2016, 2,SUB,TYPE,                                              <<01103>>15558000
2017, 2,TERM,TYPE,                                             <<01103>>15560000
2018, 5,SPEED,IN,CHARACTERS,PER,SECOND,                        <<01103>>15562000
2019, 2,RECORD,WIDTH,                                          <<01103>>15564000
2020, 2,OUTPUT,DEVICE,                                         <<01103>>15566000
2021, 2,ACCEPT,JOBS'SESSIONS,                                  <<01103>>15568000
2022, 2,ACCEPT,DATA,                                           <<01103>>15570000
2023, 1,INTERACTIVE,                                           <<01103>>15572000
2024, 1,DUPLICATIVE,                                           <<01103>>15574000
2025, 2,INITIALLY,SPOOLED,                                     <<01103>>15576000
2026, 2,DRIVER,NAME,                                           <<01103>>15578000
2027, 2,DEVICE,CLASSES,                                        <<01103>>15580000
2028, 6,IS,STR1,A,SERIAL,DISC,CLASS,                           <<01103>>15582000
2029, 2,ENABLE,SEEKAHEAD,                                      <<01853>>15584000
                                                               <<01103>>15586000
             << CS MESSAGES >>                                 <<01103>>15588000
                                                               <<01103>>15590000
2100, 3,LIST,CS,DEVICES,                                       <<01103>>15592000
2101, 2,PORT,MASK,                                             <<01103>>15594000
2102, 1,PROTOCOL,                                              <<01103>>15596000
2103, 2,LOCAL,MODE,                                            <<01103>>15598000
2104, 2,TRANSMISSION,CODE,                                     <<01103>>15600000
2105, 2,RECEIVE,TIMEOUT,                                       <<01103>>15602000
2106, 2,LOCAL,TIMEOUT,                                         <<01103>>15604000
2107, 2,CONNECT,TIMEOUT,                                       <<01103>>15606000
2108, 2,DIAL,FACILITY,                                         <<01103>>15608000
2109, 2,ANSWER,FACILITY,                                       <<01103>>15610000
2110, 2,AUTOMATIC,ANSWER,                                      <<01103>>15612000
2111, 2,DUAL,SPEED,                                            <<01103>>15614000
2112, 2,HALF,SPEED,                                            <<01103>>15616000
2113, 2,SPEED,CHANGEABLE,                                      <<01103>>15618000
2114, 2,TRANSMISSION,SPEED,                                    <<01103>>15620000
2115, 2,TRANSMISSION,MODE,                                     <<01103>>15622000
2116, 3,PREFERRED,BUFFER,SIZE,                                 <<01103>>15624000
2117, 2,DRIVER,CHANGEABLE,                                     <<01103>>15626000
2118, 2,DRIVER,OPTIONS,                                        <<01103>>15628000
2119, 2,CONTROL,LENGTH,                                        <<01103>>15630000
2120, 2,PHONE,LIST,                                            <<01103>>15632000
2121, 2,PHONE,NUMBER,                                          <<01103>>15634000
2122, 3,LOCAL,ID,SEQUENCE,                                     <<01103>>15636000
2123, 3,REMOTE,ID,SEQUENCE,                                    <<01103>>15638000
2124, 2,INTERCOMPONENT,DELAY,                                  <<01103>>15640000
2125, 4,NUMBER,OF',POLL,REPEATS,                               <<01103>>15642000
2126, 3,CIRCULAR,POLL,DELAY,                                   <<01103>>15644000
2127, 3,COMPONENTS,PER,STATION,                                <<01103>>15646000
2128, 3,NUMBER,OF',COMPONENTS,                                 <<01103>>15648000
2129, 2,COMPONENT,TYPE,                                        <<01103>>15650000
2130, 4,COMPONENT,IN,POLL,LIST,                                <<01103>>15652000
2131, 2,COMPONENT,SEQUENCE,                                    <<01103>>15654000
2140, 4,ILLEGAL,TYPE,OR',UNIT,                                 <<01103>>15656000
2141, 5,ILLEGAL,TYPE,OR',SUB,TYPE,                             <<01103>>15658000
2150, 3,ADDITIONAL,DRIVER,CHANGES,                             <<01103>>15660000
2151, 3,LIST,ADDITIONAL,DRIVERS,                               <<01103>>15662000
                                                               <<01103>>15664000
             << VOLUME TABLE MESSAGES >>                       <<01103>>15666000
                                                               <<01103>>15668000
2200, 3,DISC,VOLUME,CHANGES,                                   <<01103>>15670000
2201, 3,LIST,VOLUME,TABLE,                                     <<01103>>15672000
2202, 2,DELETE,VOLUME,                                         <<01103>>15674000
2203, 2,ADD,VOLUME,                                            <<01103>>15676000
2204, 3,ENTER,VOLUME,NAME,                                     <<01103>>15678000
2205, 3,NO,SUCH,VOLUME,                                        <<01103>>15680000
2206, 3,VOLUME,ALREADY,DEFINED,                                <<01103>>15682000
2207, 5,VOLUME,NAME,ALREADY,IN,USE,                            <<01103>>15684000
2208, 6,NON,SYSTEM,VOLUME,ON,LDEV,PD1,                         <<01103>>15686000
2210, 4,FOLLOWING,VOLUMES,NOT',FOUND,                          <<01103>>15690000
2211, 5,ADD,TO',SYSTEM,VOLUME,SET',                            <<01103>>15692000
                                                               <<MPEIV>>15694000
             << VIRTUAL MEMORY CHANGES >>                      <<MPEIV>>15696000
                                                               <<MPEIV>>15698000
2215, 3,VIRTUAL,MEMORY,CHANGES,                                <<MPEIV>>15700000
2216, 5,LIST,VIRTUAL,MEMORY,DEVICE,ALLOCATION,                 <<MPEIV>>15702000
2217, 7,ENTER,VOLUME,NAME,COMMA,SIZE,IN,KILOSECTORS,           <<MPEIV>>15704000
2218, 8,WARNING,INSUFFICIENT,DISC,SPACE,AVAILABLE,ON,THIS,DISC,<<MPEIV>>15706000
2219, 7,WARNING,DEFAULT,VIRTUAL,MEMORY,SIZES,BEING,USED,       <<MPEIV>>15708000
2220, 8,WARNING,NO,VIRTUAL,MEMORY,ALLOCATION,ON,SYSTEM,DISC,   <<01682>>15710000
                                                               <<01103>>15712000
             << DEFECTIVE TRACK MESSAGES >>                    <<01103>>15714000
                                                               <<01103>>15716000
2225, 4,LIST,DEFECTIVE,TRACK'SECTOR,INFORMATION,               <<03550>>15718000
2226, 4,NO,ENTRIES,IN,TABLE,                                   <<01103>>15720000
2227, 2,DELETE,TRACK,                                          <<01103>>15722000
2228, 6,ENTER,LDEV,COMMA,CYLINDER,AND',HEAD,                   <<01103>>15724000
2229, 1,RECOVER,                                               <<01103>>15726000
2230, 1,DELETE,                                                <<01103>>15728000
2231, 3,DELETE,OR',RECOVER,                                    <<01103>>15730000
2232, 3,DELETE,OR',REASSIGN,                                   <<01103>>15732000
2233, 5,DELETE,COMMA,REASSIGN,OR',RECOVER,                     <<01103>>15734000
2234, 5,LOGICAL',PACK,SIZE,IN,CYLINDERS,                       <<01103>>15736000
2235, 6,LDEV,PD1,IS,NOT',A,DISC,                               <<03550>>15738000
2236, 2,UNINITIALIZED,DISC,                                    <<01103>>15740000
2237, 2,INVALID,TRACK,                                         <<01103>>15742000
2238, 2,INVALID,CYLINDER,                                      <<01103>>15744000
2239, 2,INVALID,HEAD,                                          <<01103>>15746000
2240, 4,WARNING,IN,RESERVED,AREA,                              <<01103>>15748000
2241, 3,WARNING,IN,DIRECTORY,                                  <<01103>>15750000
2242, 4,WARNING,IN,VIRTUAL,MEMORY,                             <<01103>>15752000
2243, 4,WARNING,IN,ALTERNATE,AREA,                             <<01103>>15754000
2244, 7,WARNING,OLD,WELCOME,MESSAGE,ON,DEFECTIVE,TRACKS,       <<01103>>15756000
2245, 7,WARNING,VIRTUAL,MEMORY,AREA,CONTAINS,REASSIGNED,TRACKS,<<01103>>15758000
2246, 4,WARNING,IN,SYSTEM,AREA,                                <<01103>>15760000
 2247, 3,REASSIGN,OR',RECOVER,                                 <<03613>>15762000
 2248, 6,WARNING,IN,DISC,FREE,SPACE,MAP,                       <<03613>>15764000
2250, 7,WARNING,IN,A,SYSTEM,DISC,RESIDENT,TABLE,               <<03612>>15766000
                                                               <<01103>>15768000
             << RESTORE MESSAGES >>                            <<01103>>15770000
                                                               <<01103>>15772000
2275,11,NO,USER,FILES,ON,TAPE,HYPHEN,DO',YOU,WANT,TO',RELOAD,  <<01103>>15774000
2276, 9,PD1,FILES,NOT',FOUND,HYPHEN,ANOTHER,TAPE,SET',         <<01103>>15776000
        AVAILABLE,                                                      15778000
2277, 6,FOLLOWING,FILES,PURGED,HYPHEN,NOT',FOUND,              <<01103>>15780000
2278, 6,NOT',ALL,FILES,FOUND,HYPHEN,LIST,                      <<01103>>15782000
2279, 9,WARNING,DOUBLE',EOF,MARK,CRLF,TRAILER,LABEL',ERROR,    <<01103>>15784000
        ASSUMED,                                                        15786000
2280, 6,FOLLOWING,FILES,PURGED,HYPHEN,DISC,ERRORS,             <<01103>>15788000
2281, 7,FILES,PURGED,BECAUSE,OF',ERRORS,HYPHEN,LIST,           <<01103>>15790000
2282, 1,LIST,                                                  <<01103>>15792000
2283, 5,RELOAD,OF',USER,FILES,ABORTED,                         <<01103>>15794000
2284, 4,IS,ANOTHER,REEL,AVAILABLE,                             <<01103>>15796000
2285, 4,INVALID,COLD,LOAD,DEVICE,                              <<03550>>15798000
2286, 6,FOLLOWING,FILES,LOST,DATA,DURING,SPARING,              <<03668>>15800000
2287, 6,PURGE,ALL,FILES,WHICH,LOST,DATA,                       <<03668>>15802000
2288, 3,SAVE,FILE,STR1,                                        <<03668>>15804000
2289, 6,RECOVER,LOST,DISC,SPACE,IN,PROGRESS,                   <<03668>>15806000
2290, 5,RECOVER,LOST,DISC,SPACE,COMPLETED,                     <<03668>>15808000
                                                               <<01103>>15810000
             << CLASS MESSAGES >>                              <<01103>>15812000
                                                               <<01103>>15814000
2300, 2,CLASS,CHANGES,                                         <<01103>>15816000
2301, 2,LIST,CLASSES,                                          <<01103>>15818000
2302, 2,DELETE,CLASSES,                                        <<01103>>15820000
2303, 2,ADD,CLASSES,                                           <<01103>>15822000
2304, 1,CLASSES,                                               <<01103>>15824000
2305, 3,LOGICAL',DEVICE,NUMS,                                  <<01103>>15826000
2306, 3,DUPLICATE',DEVICE,NUMS,                                <<01103>>15828000
2307, 2,CLASS,NAME,                                            <<01103>>15830000
2308, 3,INPUT,OR',OUTPUT,                                      <<01103>>15832000
                                                               <<01103>>15834000
             << SERIAL/FOREIGN DISC MESSAGES >>                <<01115>>15836000
                                                               <<01103>>15838000
2325, 5,OKAY,TO',DISMOUNT,LDEV,PD1,                            <<01103>>15840000
2326, 4,SERIAL,DISC,ERROR,PD1,                                 <<01103>>15842000
2327, 3,SERIAL,DISC,CLASS,                                     <<01103>>15844000
2328, 5,NEW,SERIAL,DISC,UNIT,NUM,                              <<01103>>15846000
2329, 6,MAKE,DISC,UNIT,NUM,CHANGES,NOW,                        <<01103>>15848000
2330, 3,CHANGE,INPUT,DEVICE,                                   <<01103>>15850000
2331, 5,MOUNT,SERIAL,DISC,NUM,PD1,                             <<01103>>15852000
2332, 1,READY,                                                 <<01103>>15854000
2333,10,NOT',A,SERIAL,DISC,MOUNTED,ON,DRT,PD1,UNIT,PD2,        <<01103>>15856000
2334, 3,FOREIGN,DISC,CLASS,                                    <<01115>>15858000
                                                               <<01103>>15860000
             << SPOOLING MESSAGES >>                           <<01103>>15862000
                                                               <<01103>>15864000
2350, 5,IN,COMMA,OUT,OR',IN'OUT,                               <<01103>>15866000
2351, 5,CONCURRENT,OR',NON,HYPHEN,CONCURRENT,                  <<01103>>15868000
2352, 5,MAX,NUM,OF',OPEN,SPOOLFILES,                           <<01103>>15870000
2353, 5,MAX,NUM,OF',SPOOLFILE,KILOSECTORS,                     <<01103>>15872000
2354, 6,NUM,OF',SECTORS,PER,SPOOLFILE,EXTENT,                  <<01103>>15874000
2355, 8,MAX,NUM,OF',OPEN,SPOOLFILES,MUST,BE,CHANGED,           <<01103>>15876000
2356, 5,MAX,ALLOWED,IN,CURRENT,CONFIGURATION,                  <<01103>>15878000
2357, 5,SIZE,MUST,BE,MOD',FOUR,                                <<02834>>15880000
                                                               <<01103>>15882000
             << CONFIGURATION MESSAGES >>                      <<01103>>15884000
                                                               <<01103>>15886000
2400, 9,WARNING,COLD,LOAD,DEVICE,NOT',CONFIGURED,INTO,IO,      <<01103>>15888000
        TABLES,                                                         15890000
2401,22,WARNING,SYSTEM,DISC,AND',COLD,LOAD,DEVICE,ARE,ON,SAME, <<01103>>15892000
        DRT,CRLF,SYSTEM,DISC,MUST,BE,ONLY,UNIT,ZERO,ON,THIS,DRT,        15894000
2402, 10,WARNING,SYSTEM,DISC,VIRTUAL,MEMORY,SIZE,ONLY,CHANGED, <<MPEIV>>15896000
         ON,RELOAD,                                            <<MPEIV>>15898000
2403, 7,WARNING,DIRECTORY,SIZE,ONLY,CHANGED,ON,RELOAD,         <<01103>>15900000
2404, 7,WARNING,RIN,TABLE,CHANGED,ONLY,ON,RELOAD,              <<01103>>15902000
2405, 7,WARNING,LOGID,TABLE,ONLY,CHANGED,ON,RELOAD,            <<01103>>15904000
2406, 9,WARNING,CS,DRIVER,WILL,NOT',BE,LOADED,CORE,RESIDENT,   <<01103>>15906000
2407, 7,TAPE,UNIT,NUM,PD1,WENT,NOT',READY,                     <<00799>>15908000
2408, 5,LDEV,NUM,PD1,NOT',READY,                               <<01103>>15910000
2409, 3,NO,SUCH,CLASS,                                         <<01103>>15912000
2410, 3,NO,SUCH,DEVICE,                                        <<01103>>15914000
2411, 4,LDEV,PD1,DRT,PD2,                                      <<03002>>15916000
2412, 5,PHYSICAL,MEMORY,AVAILABLE,IS,PD1,                      <<03002>>15918000
                                                               <<01103>>15920000
             << MISC. MESSAGES >>                              <<01103>>15922000
                                                               <<01103>>15924000
2450, 2,DISABLE,LOGGING,                                       <<01103>>15926000
2451, 4,RECOVER,LOST,DISC,SPACE,                               <<01103>>15928000
2452, 7,BANK,ZERO,DEPENDENT,MEMORY,USED,HYPHEN,PD1,            <<01299>>15930000
2453, 2,ILLEGAL,INPUT,                                         <<01103>>15932000
2454, 3,STACK,MARKER,TRACE,                                    <<01103>>15934000
2455, 1,EOF,                                                   <<01103>>15936000
2456, 6,UNRESOLVED,EXTERNAL',STR1,IN,PROGRAM,STR2,             <<01103>>15938000
2457, 7,UNRESOLVED,EXTERNAL',STR1,IN,SL,SEGMENT,STR2,          <<01103>>15940000
2458,10,INVALID,INPUT,HYPHEN,ALLOWED  ,INPUT,RANGE',IS,        <<03002>>15942000
                PD1,HYPHEN,PD2,                                <<03002>>15944000
                                                               <<03550>>15946000
             << CS'80 SPARING MESSAGES >>                      <<03550>>15948000
                                                               <<03550>>15950000
2500, 6,SPARING,IN,PROGRESS,ON,LDEV,PD1,                       <<03550>>15952000
2501, 5,SPARING,COMPLETED,ON,LDEV,PD1,                         <<03550>>15954000
2502, 7,CAN,NOT',DELETE,TRACKS,ON,THIS,DISC,                   <<03550>>15956000
2503,10,WARNING,INVALID,DEFECTIVE,SECTOR,TABLE,ON,LDEV,PD1,    <<03550>>15958000
        HYPHEN,REPAIRED,                                       <<03550>>15960000
2504, 6,NUM,OF',SPARE,OPERATIONS,EQUALS,STR1,                  <<03630>>15962000
2505, 7,NUM,OF',SPARE,TRACKS,USED,EQUALS,PD1,                  <<03630>>15964000
2506, 7,NUM,OF',SPARE,TRACKS,AVAILABLE,EQUALS,PD1,             <<03630>>15966000
                                                               <<03630>>15968000
  -1;   << TERMINATOR - END OF THE MESSAGES >>                 <<01103>>15970000
                                                               <<01103>>15972000
                                                               <<01103>>15974000
   INTEGER ARRAY TEST(0:29)=Q;                                 <<01103>>15976000
   BYTE ARRAY BTEST(*) = TEST;                                 <<01103>>15978000
   INTEGER POINTER PHRASE;                                     <<01103>>15980000
   POINTER LPHRASE = PHRASE;                                   <<01103>>15982000
   INTEGER DIRECT = STRING1;                                   <<01103>>15984000
   INTEGER ARRAY STRINGARRAY(*) = DIRECT;                      <<01103>>15986000
   DOUBLE ARRAY NUMARRAY(*) = NUM1;                            <<01103>>15988000
                                                               <<01103>>15990000
   TOS := @TEST;    << DESTINATION ADDR >>                     <<01103>>15992000
   TOS := @MESS;    << SOURCE ADDR      >>                     <<01103>>15994000
L: TOS := 2;        << COUNT >>                                <<01103>>15996000
   ASSEMBLE( MOVE PB,1 );                                      <<01103>>15998000
   IF TEST = %177777 OR TEST > MSGNR THEN RETURN;              <<01103>>16000000
   IF <> THEN  << CORRECT MESSAGE? >>                          <<01103>>16002000
      BEGIN                                                    <<01103>>16004000
      ASSEMBLE( DECB,DECB ); << BEGINNING OF TEST >>           <<01103>>16006000
      TOS := TOS+TEST(1);    << BEGINNING OF NEXT MESSAGE >>   <<01103>>16008000
      GO L;                                                    <<01103>>16010000
      END;                                                     <<01103>>16012000
   @PHRASE := S1;  << SAVE POINTER TO PHRASE NR. >>            <<01103>>16014000
   TOS := TEST(1); << COUNT >>                                 <<01103>>16016000
   ASSEMBLE( MOVE PB );  << LOAD REMAINDER OF MESSAGE >>       <<01103>>16018000
   IF MSGNR < 2000 THEN                                        <<01103>>16020000
      BEGIN                                                    <<01103>>16022000
      MOVE BUF := "ERROR #",2;                                 <<01103>>16024000
      TOS := TOS+ASCII(MSGNR,BPS0);                            <<01103>>16026000
      MOVE * := "  ",2;                                        <<01103>>16028000
      END                                                      <<01103>>16030000
   ELSE                                                        <<01103>>16032000
      TOS := @BUF;                                             <<01103>>16034000
                                                               <<01103>>16036000
   DO BEGIN                                                    <<01103>>16038000
      IF LPHRASE.(1:1) THEN                                    <<01103>>16040000
         BEGIN << ADD PARAMETER TO MESSAGE >>                  <<01103>>16042000
         IF LPHRASE.(12:1) THEN                                <<01103>>16044000
            BEGIN  << STRING PARAMETER >>                      <<01103>>16046000
            TOS := STRINGARRAY(PHRASE.(13:3));                 <<01103>>16048000
            TOS := BPS0;  << COUNT FOR MOVE >>                 <<01103>>16050000
            ASSEMBLE( INCB ); << START MOVE FROM SECOND BYTE >><<01103>>16052000
            ASSEMBLE( MVB 2 );<< MOVE IT >>                    <<01103>>16054000
            END                                                <<01103>>16056000
         ELSE                                                  <<01103>>16058000
            BEGIN  << NUMBER PARAMETER >>                      <<01103>>16060000
            IF LPHRASE.(11:1) THEN                             <<01103>>16062000
               BEGIN                                           <<01103>>16064000
               BPS0 := "%";                                    <<01103>>16066000
               TOS := TOS+1;                                   <<01103>>16068000
               END;                                            <<01103>>16070000
            TOS := TOS+LDNTOA(NUMARRAY(PHRASE.(13:3)),         <<01103>>16072000
                   (IF LPHRASE.(11:1) THEN 8 ELSE 10), BPS0);  <<01103>>16074000
            END;                                               <<01103>>16076000
         END                                                   <<01103>>16078000
      ELSE                                                     <<01103>>16080000
         BEGIN << SEARCH FOR VOCAB WORD >>                     <<01103>>16082000
         TOS := @BTEST;  << DESTINATION ADDR >>                <<01103>>16084000
         TOS := @VOCAB;  << SOURCE ADDR >>                     <<01103>>16086000
         XREG := PHRASE.(3:13);                                <<01103>>16088000
         WHILE > DO                                            <<01103>>16090000
            BEGIN                                              <<01103>>16092000
            MOVE * := *PB,(1),1; << LOAD NR. BYTES IN PHRASE >><<01103>>16094000
            TOS := TOS+BTEST;  << BEGINNING OF NEXT PHRASE >>  <<01103>>16096000
            ASSEMBLE( DECB,DECX );                             <<01103>>16098000
            END;                                               <<01103>>16100000
         MOVE * := *PB,(1),1;                                  <<01103>>16102000
         DELB; << LEAVE POINTER TO PHRASE >>                   <<01103>>16104000
         MOVE * := *PB,(BTEST),2; << PUT PHRASE INTO BUF >>    <<01103>>16106000
         IF LPHRASE.(2:1) THEN                                 <<01103>>16108000
            BEGIN  << APPEND A "S" >>                          <<01103>>16110000
            BPS0 := "S";                                       <<01103>>16112000
            TOS := TOS+1;                                      <<01103>>16114000
            END;                                               <<01103>>16116000
         END;                                                  <<01103>>16118000
      BPS0 := " ";  << APPEND A BLANK >>                       <<01103>>16120000
      TOS := TOS+1;                                            <<01103>>16122000
      @PHRASE := @PHRASE+1;  << NEXT PHRASE NR. >>             <<01103>>16124000
      TEST(1) := TEST(1)-1; << DEC. NR. PHRASES >>             <<01103>>16126000
      END UNTIL =;                                             <<01103>>16128000
   GENMESSAGE := TOS-@BUF-1; << NR. BYTES IN MESSAGE >>        <<01103>>16130000
END;                                                           <<01103>>16132000
$CONTROL SEGMENT=RESIDENT                                      <<01103>>16134000
          <<------------------>>                               <<01103>>16136000
          << OUTPUT A MESSAGE >>                               <<01103>>16138000
          <<------------------>>                               <<01103>>16140000
PROCEDURE MESSAGE( MSGNR,NUM1,NUM2,NUM3,NUM4,STRING1,STRING2); <<01103>>16142000
   VALUE MSGNR, NUM1, NUM2, NUM3, NUM4;                        <<01103>>16144000
   INTEGER MSGNR;                                              <<01103>>16146000
   LOGICAL NUM1, NUM2, NUM3, NUM4;                             <<01103>>16148000
   BYTE ARRAY STRING1, STRING2;                                <<01103>>16150000
   OPTION VARIABLE;                                            <<01103>>16152000
BEGIN                                                          <<01103>>16154000
   ARRAY BUF(0:65)=Q; << DIRECT ARRAY - DB SETTING UNKNOWN >>  <<01103>>16156000
   BYTE ARRAY BBUF(*) = BUF;                                   <<01103>>16158000
                                                               <<01103>>16160000
   TOS := ABSOLUTE(DBBANK);                                    <<01103>>16162000
   TOS := ABSOLUTE(DB);                                        <<01103>>16164000
   ASSEMBLE( XCHD );  << SET DB TO STACK >>                    <<01103>>16166000
   XREG := GENMESSAGE( \MSGNR\,BBUF,DOUBLE(NUM1),DOUBLE(NUM2), <<01103>>16168000
                   DOUBLE(NUM3),DOUBLE(NUM4),STRING1,STRING2); <<01103>>16170000
   IF <> THEN << CCA GENERATED BY STAX >>                      <<01103>>16172000
      BEGIN   << THE MESSAGE EXISTS >>                         <<01103>>16174000
      IF MSGNR < 0 THEN                                        <<01103>>16176000
         BEGIN  << IT'S A QUESTION >>                          <<01103>>16178000
         BBUF(XREG) := "?";                                    <<01103>>16180000
         BBUF(XREG:=XREG+1) := " ";                            <<01103>>16182000
         PRINT( BUF, -XREG-1, %320);                           <<01103>>16184000
         END                                                   <<01103>>16186000
      ELSE                                                     <<01103>>16188000
         PRINT( BUF, -XREG, 0);                                <<01103>>16190000
      END;                                                     <<01103>>16192000
   SET( DB );   << RETURN DB TO ORGINAL SETTING >>             <<01103>>16194000
END;  << MESSAGE >>                                            <<01103>>16196000
$CONTROL SEGMENT=BOOTSTRAP                                     <<01103>>16198000
          <<------------>>                                     <<01103>>16200000
          << ERROR QUIT >>                                     <<01103>>16202000
          <<------------>>                                     <<01103>>16204000
PROCEDURE ERRMESSAGE( MSGNR,NUM1,NUM2,NUM3,NUM4,STR1,STR2);    <<01103>>16206000
   VALUE MSGNR, NUM1, NUM2, NUM3, NUM4;                        <<01103>>16208000
   INTEGER MSGNR;                                              <<01103>>16210000
   LOGICAL NUM1, NUM2, NUM3, NUM4;                             <<01103>>16212000
   BYTE ARRAY STR1, STR2;                                      <<01103>>16214000
   OPTION VARIABLE;                                            <<01103>>16216000
BEGIN COMMENT                                                  <<01103>>16218000
                                                               <<01103>>16220000
      This is a fatal error message procedure.  A STACK        <<01103>>16222000
   MARKER TRACE is printed, an error message and then          <<01103>>16224000
   INITIAL halts.  You may enter the HELP debugger by          <<01103>>16226000
   changing the lower eight bits of the switch register        <<01103>>16228000
   to a different value than when cold loaded.                 <<01103>>16230000
                                                               <<01103>>16232000
;                                                              <<01103>>16234000
   INTEGER DELTAQ;  << DELTA Q MUST BE AT Q+1 !!! >>           <<01103>>16236000
   INTEGER ARRAY QARRAY(*) = Q+0;                              <<01103>>16238000
   INTEGER STP, LASTSTP, I, SEG;                               <<01103>>16240000
   DOUBLE OLDDB;                                               <<01103>>16242000
   BYTE ARRAY CNT(0:1) = Q;                                    <<01103>>16244000
   BYTE ARRAY SEGNAMES(*) = PB :=                              <<01103>>16246000
        4,"ININ",                                              <<03603>>16248000
        9,"BOOTSTRAP",                                         <<03603>>16250000
        8,"RESIDENT",                                          <<03603>>16252000
        8,"MAINSEG1",                                          <<03603>>16254000
        9,"MAINSEG1A",                                         <<03603>>16256000
        9,"CONFIGURE",                                         <<03603>>16258000
       10,"DEFCTRACKS",                                        <<03603>>16260000
        5,"SETUP",                                             <<03603>>16262000
        6,"TAPEIO",                                            <<03603>>16264000
        6,"FILEIO",                                            <<03603>>16266000
        9,"DISKSPACE",                                         <<03603>>16268000
       10,"DIRECTORY1",                                        <<03603>>16270000
       10,"DIRECTORY2",                                        <<03603>>16272000
       10,"SL PROGRAM",                                        <<03603>>16274000
        7,"PROCESS",                                           <<03603>>16276000
        9,"MAINSEG1B",                                         <<03603>>16278000
        8,"MAINSEG2",                                          <<03603>>16280000
        8,"MAINSEG3",                                          <<03603>>16282000
        8,"MAINSEG4";                                          <<03603>>16284000
                                                               <<01103>>16286000
   TOS := ABSOLUTE(DBBANK);                                    <<01103>>16288000
   TOS := ABSOLUTE(DB);                                        <<01103>>16290000
   ASSEMBLE( XCHD );  << SET DB TO STACK >>                    <<01103>>16292000
   OLDDB := TOS;  << WE MAY WANT TO KNOW WHERE DB WAS >>       <<01103>>16294000
                                                               <<01103>>16296000
   PUSH( Z );                                                  <<01103>>16298000
   IF TOS <> ABSOLUTE(ZI) THEN  << ICS? >>                     <<01103>>16300000
      BEGIN  << NOT IN BOOTSTRAP >>                            <<01103>>16302000
      MESSAGE(M2454); << STACK MARKER TRACE >>                 <<01103>>16304000
      DELTAQ := 5;                                             <<01103>>16306000
      LASTSTP := STP := 1; << POINTS TO PHONY DELTAQ >>        <<01103>>16308000
                                                               <<01103>>16310000
      DO BEGIN                                                 <<01103>>16312000
         LASTSTP := STP := LASTSTP-QARRAY(STP);                <<01103>>16314000
         NTOA( QARRAY(STP:=STP+1), 8, BLINE(5));               <<01103>>16316000
         NTOA( QARRAY(STP:=STP+1), 8, BLINE(13));              <<01103>>16318000
         NTOA( QARRAY(STP:=STP+1), 8, BLINE(21));              <<01103>>16320000
         SEG := QARRAY(STP).(8:8); << SEGMENT NR. >>           <<01103>>16322000
         NTOA( QARRAY(STP:=STP+1), 8, BLINE(29));              <<01103>>16324000
         IF 1 <= SEG <= %23 THEN                               <<03603>>16326000
            BEGIN                                              <<01103>>16328000
            TOS := @CNT;      << DESTINATION ADR  >>           <<01103>>16330000
            TOS := @SEGNAMES; << SOURCE ADR       >>           <<01103>>16332000
            XREG := XREG-1;   << REL. TO SEGNAMES >>           <<03603>>16334000
            WHILE > DO                                         <<01103>>16336000
               BEGIN                                           <<01103>>16338000
               MOVE * := *PB,(1),1; << LOAD NR. BYTES >>       <<01103>>16340000
               TOS := TOS+CNT;  << BEGINNING OF NEXT NAME >>   <<01103>>16342000
               ASSEMBLE( DECB, DECX );                         <<01103>>16344000
               END;                                            <<01103>>16346000
            MOVE * := *PB,(1),1; << LOAD NR. BYTES >>          <<01103>>16348000
            DELB;  << GET RID OF DESTINATION ADR >>            <<01103>>16350000
            MOVE BLINE(33) := *PB,(CNT);                       <<01103>>16352000
            END;                                               <<01103>>16356000
         PRINTLINE;                                            <<03603>>16358000
         END UNTIL QARRAY(STP) = 0;                            <<01103>>16360000
                                                               <<01103>>16362000
      BLANKLINE;                                               <<01103>>16364000
      BLANKLINE;                                               <<01103>>16366000
      MESSAGE( MSGNR,NUM1,NUM2,NUM3,NUM4,STR1,STR2);           <<01103>>16368000
   IF CS80'LOCK THEN                                           <<04546>>16370000
     UNLOCK'CS80;                                              <<04546>>16372000
      END;                                                     <<01103>>16374000
DIE:                                                           <<01103>>16376000
   ASSEMBLE( HALT 4;                                           <<01103>>16378000
             RSW      );                                       <<01103>>16380000
   IF TOS.(8:8) <> SYSTAPEDRT THEN HELP;                       <<01103>>16382000
   GO DIE;                                                     <<01103>>16384000
END;  << ERRMESSAGE >>                                         <<01103>>16386000
PROCEDURE SUDDENDEATH(PARM);                                   <<04326>>16388000
VALUE PARM;                                                    <<MPEIV>>16390000
INTEGER PARM;                                                  <<MPEIV>>16392000
BEGIN  << VIRTUAL MEMORY SUDDEN DEATH CALL >>                  <<MPEIV>>16394000
ERRMESSAGE(M330, 0);                                           <<MPEIV>>16396000
END;                                                           <<MPEIV>>16398000
$PAGE "CONSOLE INPUT/OUTPUT ROUTINES"                                   16400000
$CONTROL SEGMENT=RESIDENT                                               16402000
                                                                        16404000
  INTEGER PROCEDURE BINARY(STRING,LENGTH);                              16406000
    VALUE LENGTH;                                                       16408000
    INTEGER LENGTH;                                                     16410000
    BYTE ARRAY STRING;                                                  16412000
    BEGIN                                                               16414000
    COMMENT                                                             16416000
      CONVERTS NUMBER POINTED TO BY STRING TO OCTAL.;                   16418000
      INTEGER VAL=BINARY,I:=0;                                          16420000
        TOS := @STRING;                                                 16422000
        DO                                                              16424000
          BEGIN                                                         16426000
          I:=I+1;                                                       16428000
          TOS := VAL;                                                   16430000
          TOS := %10;                                                   16432000
          ASSEMBLE(MPYL,DELB);                                          16434000
          TOS := TOS+INTEGER(BPS1)-%60;                                 16436000
          VAL := TOS;                                                   16438000
          TOS := TOS+1;                                                 16440000
          END                                                           16442000
        UNTIL I=LENGTH;                                                 16444000
     END  <<BINARY>>;                                                   16446000
                                                                        16448000
$PAGE                                                                   16450000
$CONTROL SEGMENT=SETUP                                                  16452000
          <<------------------------                                    16454000
            GET DOUBLE INPUT VALUE                                      16456000
          -------------------------->>                                  16458000
  DOUBLE PROCEDURE DINVAL(ERRLABEL);                                    16460000
    VALUE ERRLABEL;                                                     16462000
    INTEGER ERRLABEL ;                                                  16464000
     COMMENT                                                            16466000
       CONVERTS A DOUBLE INTEGER POINTED TO BY BPINBUF TO               16468000
     BINARY. IF AN ERROR IS DETECTED RETURNS TO ERRLABEL.               16470000
     OTHERWISE RETURNS VALUE AND SETS CONDITION CODE AS                 16472000
     FOLLOWS:                                                           16474000
       CCE - NO VALUE INPUT                                             16476000
       CCG - FOLLOWED BY CARRIAGE RETURN                                16478000
       CCL - FOLLOWED BY COMMA;                                         16480000
     BEGIN                                                              16482000
       EQUATE BLANK=%6440;                                              16484000
       INTEGER CONCODE := CCL,                                          16486000
               TOP = S-0,NCHAR,                                         16488000
               I := -1;                                                 16490000
       DOUBLE TOPD = S-1;                                               16492000
       BYTE POINTER STRING;                                             16494000
          SCAN BPINBUF WHILE BLANK,1;<<DELETE LEADING BLANKS>>          16496000
          IF CARRY THEN                                                 16498000
            BEGIN   <<CARRIAGE RETURN INPUT>>                           16500000
            @BPINBUF := TOS+1;                                          16502000
            CONCODE := CCE;                                             16504000
            GO FIN;                                                     16506000
            END;                                                        16508000
          ASSEMBLE(DUP,DDUP);                                           16510000
          MOVE * := * WHILE N,0; <<FIND FIRST NON-NUMERIC>>             16512000
          SCAN * WHILE BLANK,1;  <<DELETE TRRILING BLANKS>>             16514000
          IF CARRY THEN CONCODE := CCG  <<CR FOLLOWS>>                  16516000
          ELSE IF BPS0<>"," THEN GO TO ERROREXIT;                       16518000
          @BPINBUF := TOS+1; <<UPDATE BUFFER POINTER>>                  16520000
          ASSEMBLE(XCH,SUB); <<COMPUTE LENGTH>>                         16522000
          IF = THEN                                                     16524000
            BEGIN                                                       16526000
            RETURNP := ERRLABEL;                                        16528000
            ASSEMBLE(EXIT 3);                                           16530000
            END;                                                        16532000
          NCHAR := TOS;                                                 16534000
          @STRING := TOS;                                               16536000
          TOS := 0D;                                                    16538000
          WHILE (I:=I+1) <  NCHAR DO                                    16540000
           BEGIN                                                        16542000
           IF TOPD>=%2000000000D THEN                                   16544000
   ERROREXIT:BEGIN   <<TOO BIG>>                                        16546000
             RETURNP := ERRLABEL;                                       16548000
             ASSEMBLE(EXIT 3);                                          16550000
             END;                                                       16552000
           ASSEMBLE(DLSL 1;DDUP;DLSL 2;DADD);                           16554000
           IF OVERFLOW THEN GO ERROREXIT;                               16556000
           TOS := 0;                                                    16558000
           TOS := LOGICAL(STRING(I))-%60;                               16560000
           IF (TOP>9) OR (TOP<0) THEN GO ERROREXIT;                     16562000
           ASSEMBLE(DADD);                                              16564000
           IF OVERFLOW THEN GO ERROREXIT;                               16566000
           END;                                                         16568000
          DINVAL := TOS;                                                16570000
   FIN:   STAT.(6:2) := CONCODE;                                        16572000
     END;                                                               16574000
          <<-----------------                                           16576000
            GET INPUT VALUE                                             16578000
          ----------------->>                                           16580000
  INTEGER PROCEDURE INVAL(ERRLABEL);                                    16582000
    VALUE ERRLABEL;                                                     16584000
    INTEGER ERRLABEL;   <<LABEL FOR ERROR RETURN>>                      16586000
    COMMENT                                                             16588000
      CONVERTS A NUMBER POINTED TO BY BPINBUF TO BINARY. IF AN ERROR    16590000
    IS DETECTED RETURNS TO ERRLABEL. OTHERWISE RETURNS VALUE AND SETS   16592000
    CONDITION CODE AS FOLLOWS:                                          16594000
         CCE - NO VALUE INPUT                                           16596000
         CCG - FOLLOWED BY CARRIAGE RETURN                              16598000
         CCL - FOLLOWED BY COMMA;                                       16600000
      BEGIN                                                             16602000
        EQUATE BLANK=%6440;                                             16604000
        INTEGER CONCODE:=CCL;                                           16606000
        INTEGER BASE:=10;                                      <<00678>>16608000
        INTEGER NCHAR,I:=0,VAL=INVAL;                                   16610000
          TOS  := 0;   <<FOR BINARY RETURN VALUE>>                      16612000
          SCAN BPINBUF WHILE BLANK,1;  <<DELETE LEADING BLANKS>>        16614000
          IF CARRY THEN                                                 16616000
            BEGIN       <<CARRIAGE RETURN INPUT>>                       16618000
              @BPINBUF := TOS+1;                                        16620000
              CONCODE := CCE;                                           16622000
              GOTO FIN;                                                 16624000
            END;                                                        16626000
          IF BPS0="%" THEN                                     <<00678>>16628000
            BEGIN                                              <<00678>>16630000
            BASE:=8;                                           <<00678>>16632000
            TOS:=TOS+1;                                        <<00678>>16634000
            END;                                               <<00678>>16636000
          ASSEMBLE(DUP,DDUP);                                           16638000
          MOVE * := * WHILE N,0;   <<FIND FIRST NON-NUMERIC>>           16640000
          SCAN * WHILE BLANK,1;    <<DELETE TRAILING BLANKS>>           16642000
          IF CARRY THEN CONCODE := CCG    <<CR FOLLOWS>>                16644000
          ELSE IF BPS0<>"," THEN GOTO ERROR; <<ILLEGAL FOLLOWING CHAR>> 16646000
          @BPINBUF := TOS+1;     <<UPDATE BUFFER POINTER>>              16648000
          ASSEMBLE(XCH,SUB);     <<COMPUTE LENGTH>>                     16650000
          IF = THEN                                                     16652000
            BEGIN                                                       16654000
  ERROR:      RETURNP := ERRLABEL;     <<ERROR RETURN LABEL>>           16656000
              ASSEMBLE(EXIT 2);        <<DELETE INVAL'S VALUE>>         16658000
            END;                                                        16660000
          NCHAR := TOS;                                                 16662000
          DO                                                            16664000
            BEGIN                                                       16666000
              I := I+1;                                                 16668000
              TOS := VAL;                                               16670000
              TOS := BASE;                                     <<00678>>16672000
              ASSEMBLE(MPYL,DELB);                                      16674000
              IF CARRY THEN GOTO ERROR;  <<TOO BIG>>                    16676000
              TOS := TOS+INTEGER(BPS1)-%60;                             16678000
              IF OVERFLOW THEN GOTO ERROR;     <<TOO BIG>>              16680000
              VAL := TOS;                                               16682000
              TOS := TOS+1;   <<BUMP CHARACTER POINTER>>                16684000
            END                                                         16686000
          UNTIL I=NCHAR;                                                16688000
  FIN:    STAT.(6:2) := CONCODE;       <<SET CONDITION CODE>>           16690000
      END <<INVAL>> ;                                                   16692000
          <<--------------------------                                  16694000
            GET "YES" OR "NO" ANSWER                                    16696000
          -------------------------->>                                  16698000
PROCEDURE GETYESNO(NOLABEL,MESSN,NUM1,NUM2,NUM3,NUM4,          <<03668>>16700000
                                        STRING1,STRING2);      <<03668>>16702000
VALUE NOLABEL,MESSN,NUM1,NUM2,NUM3,NUM4;                       <<03668>>16704000
INTEGER NOLABEL,MESSN,NUM1,NUM2,NUM3,NUM4;                     <<03668>>16706000
BYTE ARRAY STRING1, STRING2;                                   <<03668>>16708000
OPTION VARIABLE;                                               <<03668>>16710000
    COMMENT                                                             16712000
      OUTPUTS A MESSAGE AND LOOKS FOR A "Y" RESPONSE (NORMAL RETURN)    16714000
    OR A "N" OR CARRIAGE RETURN RESPONSE (RETURN TO NOLABEL);           16716000
      BEGIN                                                             16718000
        EQUATE BLANK = %6440;                                           16720000
  AGAIN:  MESSAGE(-MESSN,NUM1,NUM2,NUM3,  << OUTPUT MESSAGE >> <<03668>>16722000
                    NUM4,STRING1,STRING2);                     <<03668>>16724000
          READINPUT;                                                    16726000
          SCAN BINBUF WHILE BLANK,1;                                    16728000
          ASSEMBLE(DUP,DUP);                                            16730000
          MOVE * := * WHILE ANS;                                        16732000
          IF CARRY OR (BPS0="N") THEN                                   16734000
            BEGIN    <<"NO" RESPONSE>>                                  16736000
              RETURNP := NOLABEL;                                       16738000
              RETURN;                                                   16740000
            END                                                         16742000
          ELSE                                                          16744000
          IF BPS0<>"Y" THEN                                    <<01025>>16746000
            BEGIN    <<ERROR>>                                          16748000
              DEL;                                                      16750000
              MESSAGE(M2453);  <<ILLEGAL INPUT>>               <<01103>>16752000
              GO AGAIN;                                                 16754000
            END;                                                        16756000
                    <<FALLS THROUGH IN "Y" CASE>>                       16758000
      END <<GETYESNO>> ;                                                16760000
$CONTROL SEGMENT=SETUP                                         <<00888>>16762000
LOGICAL PROCEDURE LGETYESNO(MESSAGENR,NUM1,NUM2,NUM3,NUM4,     <<03668>>16764000
                                          STRING1,STRING2);    <<03668>>16766000
VALUE MESSAGENR,NUM1,NUM2,NUM3,NUM4;                           <<03668>>16768000
INTEGER MESSAGENR,NUM1,NUM2,NUM3,NUM4;                         <<03668>>16770000
BYTE ARRAY STRING1,STRING2;                                    <<03668>>16772000
OPTION VARIABLE;                                               <<03668>>16774000
BEGIN                                                          <<00888>>16776000
   GETYESNO(@NOLABEL,MESSAGENR,NUM1,NUM2,NUM3,NUM4,            <<03668>>16778000
                                    STRING1,STRING2);          <<03668>>16780000
   LGETYESNO := TRUE;                                          <<00888>>16782000
NOLABEL:                                                       <<00888>>16784000
END;                                                           <<00888>>16786000
          <<-----------                                                 16788000
            GET VALUE                                                   16790000
          ----------->>                                                 16792000
  INTEGER PROCEDURE GETVAL(MESSN,LLIM,ULIM,TERM);                       16794000
    VALUE MESSN,LLIM,ULIM,TERM;                                         16796000
    INTEGER MESSN,   <<MESSAGE NUMBER>>                                 16798000
            LLIM,    <<LOWER LIMIT>>                                    16800000
            ULIM,    <<UPPER LIMIT>>                                    16802000
            TERM;    <<TERMINATING CONTROL:                             16804000
                          1 - CR ONLY                                   16806000
                          0 - COMMA ONLY                                16808000
                         -1 - CR OR COMMA  >>                           16810000
    COMMENT                                                             16812000
      OUTPUTS A MESSAGE AND LOOKS FOR THE INPUT OF A NUMBER IN THE      16814000
    RANGE  LLIM <= N <= ULIM. IF THE TERMINATING CONTROL = 1, THE       16816000
    CONDITION CODE IS SET AS FOLLOWS:                                   16818000
         CCG - CARRIAGE RETURN                                          16820000
         CCL - COMMA;                                                   16822000
      BEGIN                                                             16824000
      INTEGER TERMTEST;  << HOLDS VALUE OF TERM >>             <<03709>>16826000
  AGAIN:  MESSAGE(-MESSN);       <<OUTPUT MESSAGE>>                     16828000
          READINPUT;                                                    16830000
          TOS := 0;                                                     16832000
          TOS := @ERROR1;                                               16834000
          TOS := INVAL(*);                                              16836000
          IF = THEN IF TERM<>2 THEN GOTO ERROR                          16838000
          ELSE                                                          16840000
            BEGIN                                                       16842000
              STAT.(6:2) := CCE;                                        16844000
              RETURN;                                                   16846000
            END;                                                        16848000
          PUSH(STATUS);                                                 16850000
          TOS := TOS.(6:2);                                             16852000
          STAT.(6:2) := S0;        <<SET CONDITION CODE>>               16854000
        IF TERM=2 THEN TERMTEST:=1 <<FIX TO ALLOW A CR INPUT>> <<03709>>16856000
        ELSE TERMTEST:=TERM;       <<AFTER A BAD VALUE.     >> <<03709>>16858000
        IF TOS=TERMTEST THEN GOTO ERROR; <<WRONG FOLLOW CHAR>> <<03709>>16860000
          IF (LLIM<=S0<=ULIM) THEN                                      16862000
            BEGIN                                                       16864000
              GETVAL := TOS;                                            16866000
              RETURN;                                                   16868000
            END;                                                        16870000
  ERROR:  DEL;                                                          16872000
  ERROR1: MESSAGE(M2453);                                      <<01103>>16874000
          GO AGAIN;                                                     16876000
      END <<GETVAL>> ;                                                  16878000
          <<-----------------------                                     16880000
            GET REPLACEMENT VALUE                                       16882000
          ----------------------->>                                     16884000
  PROCEDURE GETNEWVAL(MESSN,VAL,LLIM,ULIM);                             16886000
    VALUE MESSN,LLIM,ULIM;                                              16888000
    INTEGER MESSN,      <<MESSAGE NUMBER>>                              16890000
            VAL,        <<VALUE TO BE REPLACED>>                        16892000
            LLIM,       <<LOWER LIMIT>>                                 16894000
            ULIM;       <<UPPER LIMIT>>                                 16896000
    COMMENT                                                             16898000
        OUTPUTS A MESSAGE FOLLOWED BY THE CURRENT VALUE, A PERIOD (.)   16900000
      AND A QUESTION MARK(?). LOOKS FOR THE INPUT OF A CARRIAGE         16902000
      RETURN, WHICH LEAVES THE VALUE THE SAME, OR AN INTEGER IN THE     16904000
      RANGE  LLIM <= N <= ULIM;                                         16906000
      BEGIN                                                             16908000
          ARRAY BUF(0:39);                                     <<01103>>16910000
          BYTE ARRAY BBUF(*) = BUF;                            <<01103>>16912000
          INTEGER LEN;                                         <<01103>>16914000
                                                               <<01103>>16916000
          XREG := GENMESSAGE( MESSN, BBUF,0D,0D,0D,0D,BBUF,BBUF);       16918000
          IF = THEN MESSAGE( M374, 1); << FATAL ERROR - NO MESSAGE >>   16920000
          MOVE BBUF(XREG) := " = ",2;                          <<01103>>16922000
          TOS := TOS+ASCII( VAL, BPS0);                        <<01103>>16924000
          MOVE * := ".? ",2;                                   <<01103>>16926000
          LEN := TOS-@BBUF;   << LEN OF MESSAGE >>             <<01103>>16928000
AGAIN:    PRINT( BUF, -LEN, %320);                             <<01103>>16930000
          READINPUT;                                                    16932000
          TOS := 0;                                                     16934000
          TOS := @ERROR1;                                               16936000
          TOS := INVAL(*);                                              16938000
          IF = THEN RETURN;                                             16940000
          IF < THEN GOTO ERROR;                                         16942000
          IF (LLIM<=S0<=ULIM) THEN                                      16944000
          BEGIN                                                         16946000
              VAL := TOS;                                               16948000
              RETURN;                                                   16950000
            END;                                                        16952000
          MESSAGE(M2458,LLIM,ULIM);                            <<03002>>16954000
          DEL;                                                 <<03002>>16956000
          GO AGAIN;                                            <<03002>>16958000
  ERROR:  DEL;                                                          16960000
  ERROR1: MESSAGE(M2453);                                      <<01103>>16962000
          GO AGAIN;                                                     16964000
      END <<GETNEWVAL>> ;                                               16966000
          <<------------                                                16968000
            GET STRING                                                  16970000
          ------------>>                                                16972000
  PROCEDURE GETSTR(ADDR,ERRLABEL,TERM,LEN,SPEC);                        16974000
    VALUE ERRLABEL,TERM,LEN,SPEC;                                       16976000
    BYTE ARRAY ADDR;    <<DESTINATION ARRAY>>                           16978000
    INTEGER ERRLABEL,   <<ERROR RETURN>>                                16980000
            LEN,        <<MAX LENGTH OF STRING>>                        16982000
            SPEC,        <<SPECIAL CHARACTER>>                          16984000
            TERM;       <<TERMINATING CONTROL                           16986000
                           0 - COMMA ONLY                               16988000
                           1 - CR ONLY                                  16990000
                          -1 - CR OR COMMA(NO INPUT NOT OK)             16992000
                           2 - CR OR COMMA(NO INPUT OK)                 16994000
                           3 - CR ONLY(NO INPUT OK) >>                  16996000
    OPTION VARIABLE;                                                    16998000
    COMMENT                                                             17000000
      EXTRACTS AN UP-TO-8 CHARACTER STRING FROM THE INPUT BUFFER        17002000
    POINTED TO BY BPINBUF AND MOVES IT TO BYTE ARRAY ADDR. IF AN        17004000
    ERROR IS ENCOUNTERED EXITS TO ERRLABEL. IF TERM = 0 SETS            17006000
    CONDITION CODE AS FOLLOWS:                                          17008000
         CCG - FOLLOWED BY CARRIAGE RETURN                              17010000
         CCL - FOLLOWED BY COMMA;                                       17012000
      BEGIN                                                             17014000
        EQUATE BLANK=%6440;                                             17016000
        INTEGER CONCODE;                                                17018000
        LOGICAL SPECPASSED=Q-4;                                         17020000
          TOS := @ADDR;       <<DESTINATION FOR FINAL MOVE>>            17022000
          SCAN BPINBUF WHILE BLANK,1;  <<DELETE LEADING BLANKS>>        17024000
          IF CARRY AND (TERM=3 OR TERM=2)  THEN                         17026000
            BEGIN                                                       17028000
            STAT.(6:2) := CCE;                                          17030000
            RETURN;                                                     17032000
            END;                                                        17034000
          IF TERM=2 THEN TERM:=-1 ELSE                                  17036000
          IF TERM=3 THEN TERM:=1;                                       17038000
          IF BPS0<>ALPHA THEN GOTO ERROR;                               17040000
          ASSEMBLE(DUP,DDUP);                                           17042000
  MOVEUP: MOVE *:=* WHILE ANS,0; <<UPSHIFT LOWER CASE>>                 17044000
          IF SPECPASSED AND INTEGER(BPS0)=SPEC THEN                     17046000
            BEGIN                                                       17048000
            ASSEMBLE(INCA,INCB);                                        17050000
            GOTO MOVEUP;                                                17052000
            END;                                                        17054000
          SCAN * WHILE BLANK,1;     <<DELETE TRAILING BLANKS>>          17056000
          IF CARRY THEN CONCODE := CCG                                  17058000
          ELSE IF BPS0="," THEN CONCODE := CCL                          17060000
          ELSE GOTO ERROR;                                              17062000
          IF CONCODE=TERM THEN GOTO ERROR;                              17064000
          STAT.(6:2) := CONCODE;  <<SET CONDITION CODE>>                17066000
          @BPINBUF := TOS+1;  <<UPDATE BUFFER POINTER>>                 17068000
          ASSEMBLE(XCH,SUB; DUP,STAX);  <<COMPUTE LENGTH>>              17070000
          IF = OR (S0>LEN) THEN                                         17072000
            BEGIN    <<LENGTH OUT OF RANGE>>                            17074000
  ERROR:      MESSAGE(M2453);                                  <<01103>>17076000
              RETURNP := ERRLABEL;                                      17078000
              RETURN;                                                   17080000
            END;                                                        17082000
          ASSEMBLE(MVB 3);   <<XFER STRING>>                   <<01025>>17084000
          WHILE X < LEN DO                                              17086000
            BEGIN    <<FILL WITH BLANKS>>                               17088000
              ADDR(X) := " ";                                           17090000
              X := X+1;                                                 17092000
            END;                                                        17094000
      END <<GETSTR>> ;                                                  17096000
$PAGE "INPUT/OUTPUT PROCEDURES"                                         17098000
$CONTROL SEGMENT=BOOTSTRAP                                              17100000
          <<---------                                                   17102000
            TEST IO                                                     17104000
          --------->>                                                   17106000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>17108000
  LOGICAL PROCEDURE TESTIO(DRT,MASK);                                   17110000
    VALUE DRT,MASK;                                                     17112000
    INTEGER DRT;    <<DRT NUMBER>>                                      17114000
    LOGICAL MASK;   <<STATUS MASK>>                                     17116000
    COMMENT                                                             17118000
      EXECUTES A TIO INSTRUCTION ON THE INDICATED CONTROLLER AND RETURNS17120000
    THE STATUS ANDED WITH THE MASK;                                     17122000
      BEGIN                                                             17124000
          TOS := DRT;                                                   17126000
          TIO0;                                                <<01103>>17128000
          TESTIO := LOGICAL(TOS) LAND MASK;                             17130000
      END <<TESTIO>> ;                                                  17132000
                                                                        17134000
          <<------------                                                17136000
            CONTROL IO                                                  17138000
          ------------>>                                                17140000
  PROCEDURE CTRLIO(DRT,CONTROL);                                        17142000
    VALUE DRT,CONTROL;                                                  17144000
    INTEGER DRT,         <<DRT NUMBER>>                                 17146000
            CONTROL;     <<CONTROL WORD TO OUTPUT>>                     17148000
    COMMENT                                                             17150000
      DOES A CIO INSTRUCTION TO THE SPECIFIED DEVICE, PASSING THE       17152000
    GIVEN CONTROL WORD;                                                 17154000
      BEGIN                                                             17156000
          TOS := DRT;                                                   17158000
          TOS := CONTROL;                                               17160000
          CIO1;                                                <<01103>>17162000
      END <<CTRLIO>> ;                                                  17164000
                                                                        17166000
          <<---------------------                                       17168000
            EXECUTE SIO PROGRAM                                         17170000
          --------------------->>                                       17172000
  LOGICAL PROCEDURE EXECUTESIO(DRT,ADDRESS);                            17174000
    VALUE DRT,ADDRESS;                                                  17176000
    INTEGER DRT;         <<DRT NUMBER>>                                 17178000
    LOGICAL ADDRESS;     <<ADDRESS OF SIO PROGRAM>>                     17180000
    COMMENT                                                             17182000
      EXECUTES AN SIO INSTRUCTION ON THE SPECIFIED CONTROLLER, WAITS    17184000
    FOR ITS COMPLETION, AND RETURNS THE STATUS;                         17186000
      BEGIN                                                             17188000
        LOGICAL STATUS=EXECUTESIO;                                      17190000
          TOS := DRT;                                                   17192000
          TOS := ADDRESS;                                               17194000
          DO BEGIN                                             <<01103>>17196000
             ASSEMBLE( SIO 1 );                                <<01103>>17198000
             IF < THEN ERRMESSAGE(M1,S1);<< NON-RESP. CTRL >>  <<01103>>17200000
             DEL;   << DRT IF CCE, STATUS IF CCG >>            <<01103>>17202000
             END UNTIL =;                                      <<01103>>17204000
          WHILE STATUS=0 DO                                             17206000
          IF TESTIO(DRT,%120000)<>0 THEN STATUS:=TESTIO(DRT,%177777);   17208000
      END <<EXECUTESIO>> ;                                              17210000
$IF  << ******* RETURNING TO COMMON CODE ********** >>         <<02510>>17212000
$CONTROL SEGMENT=BOOTSTRAP                                     <<02510>>17214000
PROCEDURE SIOP( DEVNR, CHANADR);                               <<02510>>17218000
   VALUE DEVNR, CHANADR;                                       <<02510>>17220000
   INTEGER DEVNR, CHANADR;                                     <<02510>>17222000
BEGIN                                                          <<02510>>17224000
   CC := CCE;                                                  <<02510>>17226000
   IF SERIESII'III THEN                                        <<02510>>17228000
      BEGIN                                                    <<02510>>17230000
      <<  FILL MAILBOX  >>                                     <<02510>>17232000
      MB0 := 0;          << SIOP CODE >>                       <<02510>>17234000
      MB1 := DEVNR;      << CHAN, DEV >>                       <<02510>>17236000
      MB3 := CHANADR;    << ADDRESSS OF CHAN PGM >>            <<02510>>17238000
      <<  STARTUP IMB ADAPTER  >>                              <<02510>>17240000
      TOS := ADAPTERDRT; << IMB ADAPTER DEV # >>               <<02510>>17242000
      TOS := -1;         << SIO POINTER >>                     <<02510>>17244000
      SIO1;                                                    <<02510>>17246000
      <<  WAIT FOR ADAPTER TO ACCEPT SIOP  >>                  <<02510>>17248000
      DO UNTIL MB4 < 0;                                        <<02510>>17250000
      IF MB4 THEN                                              <<02510>>17252000
         BEGIN                                                 <<02510>>17254000
         CC := IF MB4.(5:1) THEN CCL ELSE CCG;                 <<02510>>17256000
         END                                                   <<02510>>17258000
      END                                                      <<02510>>17260000
   ELSE                                                        <<02510>>17262000
      BEGIN                                                    <<02510>>17264000
      TOS := DEVNR;       << CHAN, DEV >>                      <<02510>>17266000
      TOS := CHANADR;     << ADDRESS OF CHAN PGM >>            <<02510>>17268000
      ASSEMBLE( SIOP );                                        <<02510>>17270000
      PUSH( STATUS );                                          <<02510>>17272000
      TOS := TOS.(6:2);  << CONDITION CODE >>                  <<02510>>17274000
      CC := TOS;                                               <<02510>>17276000
      END;                                                     <<02706>>17278000
END;                                                           <<02706>>17280000
PROCEDURE WIOC( DRT, COMMAND, DATAWORD);                       <<02706>>17282000
   VALUE DRT, COMMAND, DATAWORD;                               <<02706>>17284000
   INTEGER DRT, COMMAND, DATAWORD;                             <<02706>>17286000
BEGIN                                                          <<02706>>17288000
   CC := CCE;                                                  <<02706>>17290000
   IF SERIESII'III THEN                                        <<02706>>17292000
      BEGIN                                                    <<02706>>17294000
      <<  FILL MAILBOX  >>                                     <<02706>>17296000
      MB0 := 3;                     << WIOC CODE >>            <<02706>>17298000
      MB1 := DRT CAT COMMAND(0:0:8);<< IMB WRITE COMMAND >>    <<02706>>17300000
      MB2 := DATAWORD;              << DATA TO BE WRITTEN >>   <<02706>>17302000
      MB4 := 0;                     << CLEAR STATUS WORD >>    <<02706>>17304000
      <<  STARTUP IMB ADAPTER  >>                              <<02706>>17306000
      TOS := ADAPTERDRT;            << IMB ADAPTER DEV # >>    <<02706>>17308000
      TOS := -1;                    << SIO POINTER >>          <<02706>>17310000
      SIO1;                                                    <<02706>>17312000
      <<  WAIT FOR ADAPTER TO ACCEPT SIOP  >>                  <<02706>>17314000
      DO UNTIL MB4 < 0;                                        <<02706>>17316000
      IF MB4 THEN CC := CCL;                                   <<02706>>17318000
      END                                                      <<02706>>17320000
   ELSE                                                        <<02706>>17322000
      BEGIN                                                    <<02706>>17324000
      IF ICF55 THEN                                            <<02706>>17326000
         BEGIN                                                 <<02706>>17328000
         TOS := DRT;                                           <<02706>>17330000
         TOS := COMMAND;            << IMB WRITE COMMAND >>    <<02706>>17332000
         TOS := DATAWORD;           << DATA TO BE WRITTEN >>   <<02706>>17334000
         ASSEMBLE( WIOA );                                     <<02706>>17336000
         IF <> THEN CC := CCL;                                 <<02706>>17338000
         END                                                   <<02706>>17340000
      ELSE                                                     <<02706>>17342000
         BEGIN                                                 <<02706>>17344000
         TOS := DRT CAT COMMAND(0:0:8);<< IMB WRITE COMMAND >> <<02706>>17346000
         TOS := DATAWORD;           << DATA TO BE WRITTEN >>   <<02706>>17348000
         ASSEMBLE( WIOC );                                     <<02706>>17350000
         IF <> THEN CC := CCL;                                 <<02706>>17352000
         END;                                                  <<02706>>17354000
      END;                                                     <<02706>>17356000
END;                                                           <<02706>>17358000
           <<-------------------------->>                      <<02707>>17362000
           <<     READ FROM DEVICE     >>                      <<02707>>17364000
           <<-------------------------->>                      <<02707>>17366000
INTEGER PROCEDURE RIOC(DRT, PARM);                             <<02707>>17368000
VALUE DRT, PARM;                                               <<02707>>17370000
INTEGER DRT,    << DRT # OF DEVICE >>                          <<02707>>17372000
        PARM;   << READ PARAMETER >>                           <<02707>>17374000
COMMENT                                                        <<02707>>17376000
   THIS PROCEDURE READS FROM AN HPIB DEVICE BY ISSUING         <<02707>>17378000
   AN RIOC OR RIOA (ON THE '55) INSTRUCTION.  IT ALSO          <<02707>>17380000
   HANDLES DEVICES CONNECTED TO STARFISH.  IT RETURNS          <<02707>>17382000
   A ONE-WORD RESULT.  ALSO, IT RETURNS CCL IF THE             <<02707>>17384000
   INSTRUCTION FAILS, CCE OTHERWISE.  NOTE: FOR SERIES         <<02707>>17386000
   II, III THIS PROCEDURE ASSUMES THERE IS A STARFISH          <<02707>>17388000
   AND THE DEVICE BEING ADDRESSED IS ON THE STARFISH.          <<02707>>17390000
   ;                                                           <<02707>>17392000
   BEGIN                                                       <<02707>>17394000
   CC := CCE;    << INITIALIZE CC RETURN IN STACK MARKER >>    <<02707>>17396000
   IF SERIESII'III THEN                                        <<02707>>17398000
      BEGIN               << SEND COMMAND TO STARFISH >>       <<02707>>17400000
      << FILL MAILBOX >>                                       <<02707>>17402000
      MB0 := 2;     << RIOC CODE >>                            <<02707>>17404000
      MB1 := DRT CAT PARM(0:0:8);   << CHANNEL, READ PARM >>   <<02707>>17406000
      MB4 := 0;                                                <<02707>>17408000
                                                               <<02707>>17410000
      << START UP IMB ADAPTER >>                               <<02707>>17412000
      TOS := ADAPTERDRT;                                       <<02707>>17414000
      TOS := -1;                                               <<02707>>17416000
      SIO1;                                                    <<02707>>17418000
                                                               <<02707>>17420000
      << WAIT FOR ADAPTER TO ACCEPT RIOC >>                    <<02707>>17422000
      DO UNTIL MB4 < 0;                                        <<02707>>17424000
                                                               <<02707>>17426000
      IF MB4 THEN CC := CCL     << COMMAND FAILED >>           <<02707>>17428000
      ELSE RIOC := MB2;         << SUCCESSFUL     >>           <<02707>>17430000
      END                                                      <<02707>>17432000
   ELSE          << ON A POST-SERIES III MACHINE >>            <<02707>>17434000
      BEGIN                                                    <<02707>>17436000
      IF ICF55 THEN       << MUST DO DIFFERENT READ >>         <<02707>>17438000
         BEGIN            << INSTRUCTION FOR '55    >>         <<02707>>17440000
         TOS := DRT;                                           <<02707>>17442000
         TOS := PARM;                                          <<02707>>17444000
         ASSEMBLE(RIOA);  << SEND READ COMMAND >>              <<02707>>17446000
         IF <> THEN CC := CCL   << COMMAND FAILED >>           <<02707>>17448000
         ELSE RIOC := TOS;      << SUCCESSFUL     >>           <<02707>>17450000
         END                                                   <<02707>>17452000
      ELSE                                                     <<02707>>17454000
         BEGIN         << NOT ON A '55 >>                      <<02707>>17456000
         TOS := DRT CAT PARM(0:0:8);                           <<02707>>17458000
         ASSEMBLE(RIOC);  << SEND READ COMMAND >>              <<02707>>17460000
         IF <> THEN CC := CCL    << COMMAND FAILED >>          <<02707>>17462000
         ELSE RIOC := TOS;       << SUCCESSFUL     >>          <<02707>>17464000
         END;                                                  <<02707>>17466000
      END;                                                     <<02707>>17468000
   END;   << RIOC >>                                           <<02707>>17470000
PROCEDURE INIT( CHANNR);                                       <<02510>>17472000
   VALUE CHANNR;                                               <<02510>>17474000
   INTEGER CHANNR;                                             <<02510>>17476000
BEGIN                                                          <<02510>>17478000
   CC := CCE;                                                  <<02510>>17480000
   IF SERIESII'III THEN                                        <<02510>>17482000
      BEGIN                                                    <<02510>>17484000
      <<  FILL MAILBOX  >>                                     <<02510>>17486000
      MB0 := 6;                                                <<02510>>17488000
      MB1 := CHANNR;           << CHANNEL NR. >>               <<02510>>17490000
      MB4 := 0;                << I/O STATUS  >>               <<02510>>17492000
      TOS := ADAPTERDRT;       << IMB ADAPTER NR. >>           <<02510>>17494000
      TOS := -1;               << SIO POINTER >>               <<02510>>17496000
      SIO1;                                                    <<02510>>17498000
      <<  WAIT FOR ADAPTER TO RESPOND >>                       <<02510>>17500000
      DO UNTIL MB4 < 0;                                        <<02510>>17502000
      IF MB4 THEN CC := CCL;                                   <<02510>>17504000
      END                                                      <<02510>>17506000
   ELSE                                                        <<02510>>17508000
      BEGIN                                                    <<02510>>17510000
      TOS := %151515;                                          <<02510>>17512000
      TOS := CHANNR;                                           <<02510>>17514000
      ASSEMBLE( INIT);                                         <<02510>>17516000
      IF TOS <> %151515 THEN  << MISSING GIC >>                <<02510>>17518000
         CC := CCL;                                            <<02510>>17520000
      END;                                                     <<02510>>17522000
END;                                                           <<02510>>17524000
<<----------------------->>                                    <<02510>>17526000
<<EXECUTE CHANNEL PROGRAM>>                                    <<02510>>17528000
<<----------------------->>                                    <<02510>>17530000
PROCEDURE EXECUTESIOP(DRT,ADDRESS);                            <<02510>>17532000
VALUE DRT,ADDRESS;                                             <<02510>>17534000
INTEGER DRT;                                                   <<02510>>17536000
LOGICAL ADDRESS;                                               <<02510>>17538000
COMMENT:                                                       <<02510>>17540000
   EXECUTES A CHANNEL PROGRAM ON THE SPECIFIED CONTROLLER      <<02510>>17542000
   AND WAITS AWHILE FOR IT TO COMPLETE.;                       <<02510>>17544000
BEGIN                                                          <<02510>>17546000
DOUBLE COUNTER := -5000D;                                      <<02510>>17548000
INIT( DRT);                                                    <<02510>>17550000
IF <> THEN RETURN;                                             <<02510>>17552000
SIOP( DRT, ADDRESS);                                           <<02510>>17554000
IF <> THEN RETURN;                                             <<02510>>17556000
                                                               <<02510>>17558000
TEST:                                                          <<02510>>17560000
                                                               <<02510>>17562000
IF GETDRT(DRT,CHANSTAT).(0:2) = 0 THEN                         <<03002>>17566000
           <<TEST CHANNEL STATUS FOR COMPLETION>>              <<03002>>17568000
   RETURN; <<PROGRAM COMPLETED>>                               <<02510>>17570000
IF (COUNTER:=COUNTER+1D)=0D THEN                               <<02510>>17572000
   BEGIN <<TIMEOUT-PROBABLY WRONG DRT-HALT AND RETURN>>        <<02510>>17574000
   PUTDRT(DRT,CHANSTAT,0);                                     <<03002>>17576000
   END                                                         <<02510>>17578000
ELSE                                                           <<02510>>17580000
   GOTO TEST; <<CHANNEL PROGRAM DIDN'T COMPLETE YET>>          <<02510>>17582000
END;                                                           <<02510>>17584000
$CONTROL SEGMENT=MAINSEG4                                      <<02510>>17586000
PROCEDURE RESETSTARFISH;                                       <<02510>>17588000
BEGIN                                                          <<02510>>17590000
   IF STARFISH THEN                                            <<02510>>17592000
      BEGIN                                                    <<02510>>17594000
      MB0 := 5;   << RESET COMMAND >>                          <<02510>>17596000
      MB4 := 0;   << I/O STATUS    >>                          <<02510>>17598000
      TOS := ADAPTERDRT; << IMB ADAPTER NR. >>                 <<02510>>17600000
      TOS := -1;         << SIO POINTER     >>                 <<02510>>17602000
      SIO1;                                                    <<02510>>17604000
      <<  WAIT FOR ADAPTER TO RESPOND  >>                      <<02510>>17606000
      DO UNTIL MB4 < 0;                                        <<02510>>17608000
      END;                                                     <<02510>>17610000
END;                                                           <<02510>>17612000
$CONTROL SEGMENT=BOOTSTRAP                                     <<02510>>17614000
DOUBLE PROCEDURE L'PADR( LDEV,LOGADR);                         <<02510>>17616000
   VALUE LDEV, LOGADR;                                         <<02510>>17618000
   INTEGER LDEV;                                               <<02510>>17620000
   DOUBLE LOGADR;                                              <<02510>>17622000
BEGIN                                                          <<02510>>17624000
   INTEGER TYPE, STYPE;                                        <<02510>>17626000
   BYTE VOLNR = LOGADR;                                        <<02510>>17628000
   INTEGER POINTER DISCINFO;                                   <<02510>>17630000
   EQUATE                                                      <<02510>>17632000
      SEC'TRK'FLOP  = 30,                                      <<02510>>17634000
      SEC'CYL'FLOP  = 60;                                      <<02510>>17636000
                                                               <<02510>>17638000
   TYPE := LDT(LDEV*LDTSIZE+LDT2).TYP;                         <<02510>>17640000
   STYPE := LPDT(LDEV*LPDTSIZE+LPDT1).SUBTYPE;                 <<02510>>17642000
                                                               <<03550>>17644000
IF TYPE=DISC0 OR TYPE=DISC2 THEN                               <<03550>>17646000
   BEGIN      << CONVERT LOGICAL TO PHYSICAL ADDRESS >>        <<03550>>17648000
   @DISCINFO := @MHINFO(STYPE*MHINFOSIZE);                     <<02510>>17650000
                                                               <<02510>>17652000
   VOLNR := 0;                                                 <<02510>>17654000
   TOS := LOGADR;                                              <<02510>>17656000
   TOS := IF TYPE = DISC2 THEN                                 <<02510>>17658000
      SEC'CYL'FLOP                                             <<02510>>17660000
   ELSE                                                        <<02510>>17662000
      DISCINFO(MHSECTRK)*DISCINFO(MHTRKCYL);                   <<02510>>17664000
   ASSEMBLE( LDIV );                                           <<02510>>17666000
   IF OVERFLOW THEN                                            <<02510>>17668000
      BEGIN                                                    <<02510>>17670000
      STAT.(6:2) := CCL;                                       <<02510>>17672000
      RETURN;                                                  <<02510>>17674000
      END                                                      <<02510>>17676000
   ELSE                                                        <<02510>>17678000
      STAT.(6:2) := CCE;                                       <<02510>>17680000
   TOS := IF TYPE = DISC2 THEN                                 <<02510>>17682000
      SEC'TRK'FLOP                                             <<02510>>17684000
   ELSE                                                        <<02510>>17686000
      DISCINFO(MHSECTRK);                                      <<02510>>17688000
   ASSEMBLE( DIV, XCH );                                       <<02510>>17690000
   IF TYPE <> DISC2 THEN TOS:=TOS+DISCINFO(MHSTHEAD);          <<02510>>17692000
   TOS := TOS&LSL(8);                                          <<02510>>17694000
   TOS := TOS+TOS;   << HEAD/SECTOR >>                         <<02510>>17696000
   L'PADR := TOS;                                              <<02510>>17698000
   END                                                         <<03550>>17700000
                                                               <<03550>>17702000
ELSE                                                           <<03550>>17704000
   BEGIN      << CS'80 AND ANY OTHER TYPES >>                  <<03550>>17706000
   VOLNR := 0;             << CLEAR THE VOLUME NUMBER >>       <<03550>>17708000
                           <<    FROM LOGADR          >>       <<03550>>17710000
   L'PADR := LOGADR;       << PASS BACK THE LOGICAL ADDRESS >> <<03550>>17712000
   END;                                                        <<03550>>17714000
END;                                                           <<02510>>17716000
$PAGE "DISC DRIVERS"                                                    17718000
PROCEDURE ZEROABS( ADDRESS, COUNT);                            <<02510>>17720000
   VALUE ADDRESS, COUNT;                                       <<02510>>17722000
   INTEGER ADDRESS, COUNT;                                     <<02510>>17724000
BEGIN                                                          <<02510>>17726000
   X := ADDRESS;                                               <<02510>>17728000
   TOS := COUNT;                                               <<02510>>17730000
   WHILE <> DO                                                 <<02510>>17732000
      BEGIN                                                    <<02510>>17734000
      ABSOLUTE(X) := 0;                                        <<02510>>17736000
      X := X+1;                                                <<02510>>17738000
      TOS := TOS-1;                                            <<02510>>17740000
      END;                                                     <<02510>>17742000
END;                                                           <<02510>>17744000
$CONTROL SEGMENT=RESIDENT                                               17748000
                                                                        17750000
          <<---------------------------                                 17752000
            OUTPUT DISC ERROR MESSAGE                                   17754000
          --------------------------->>                                 17756000
  PROCEDURE DISCERROR(LDEV,ERRSTAT,ADDR,WORDS,MODE,ERRSTAT2);           17758000
    VALUE LDEV,ERRSTAT,ADDR,WORDS,MODE,ERRSTAT2;                        17760000
    INTEGER LDEV,ERRSTAT,WORDS,MODE,ERRSTAT2;                           17762000
    DOUBLE ADDR;                                                        17764000
    COMMENT                                                             17766000
      OUTPUT A MESSAGE INFORMING THE OPERATOR OF A DISC ERROR AND       17768000
    HALTS.  MODE TELLS IF WE WERE READING, WRITING, OR SEEKING WHEN     17770000
    THE ERROR OCCURRED;                                                 17772000
      BEGIN                                                             17774000
        BYTE ARRAY ERRTYPES(0:14)=PB:="READ WRITESEEK ";                17776000
        ARRAY STATUS'TO'MESS(0:%37) =PB :=                     <<01103>>17778000
            <<    0 >>       M0,    << NORMAL          >>      <<01103>>17780000
            <<    1 >>      M12,    << ILL. CMD        >>      <<01103>>17782000
            <<  2-6 >>    5(M0),                               <<01103>>17784000
            <<    7 >>      M13,    << CYL CMP ERR     >>      <<01103>>17786000
            <<  %10 >>      M14,    << UNCORRECTABLE   >>      <<01103>>17788000
            <<  %11 >>      M15,    << HD/SECT CMP     >>      <<01103>>17790000
            <<  %12 >>      M16,    << SIO PGM ERR     >>      <<01103>>17792000
            <<  %13 >>       M0,                               <<01103>>17794000
            <<  %14 >>      M17,    << EOC             >>      <<01103>>17796000
            <<  %15 >>       M0,                               <<01103>>17798000
            <<  %16 >>      M18,    << OVERRUN         >>      <<01103>>17800000
            <<  %17 >>      M19,    << POSS. CORRECT   >>      <<01103>>17802000
            <<  %20 >>      M20,    << ILL. ACCESS     >>      <<01103>>17804000
            <<  %21 >>      M21,    << DEF. TRACK      >>      <<01103>>17806000
            <<  %22 >>      M22,    << HEAD MOVING     >>      <<01103>>17808000
            <<  %23 >>      M23,    << DISC DVR ERR    >>      <<01103>>17810000
            <<%24-25>>    2(M0),                               <<01103>>17812000
            <<  %26 >>      M24,    << PROTECT DEF.TRK >>      <<01103>>17814000
            <<  %27 >>      M25,    << DVR UNAVAIL     >>      <<01103>>17816000
            <<%30-36>>    7(M0),                               <<01103>>17818000
            <<  %37 >>      M26;    << DVR ATTENTION   >>      <<01103>>17820000
          TOS := ABSOLUTE(DBBANK);                                      17822000
          TOS := ABSOLUTE(DB);                                          17824000
          ASSEMBLE(XCHD);  <<SET DB TO STACK>>                          17826000
          MOVE BLINE := "DISC ",2;                             <<00888>>17828000
          MOVE * := ERRTYPES(MODE*5),(5),2;                             17830000
          MOVE * := " ERR ON LDEV #",2;                        <<01101>>17832000
          TOS := TOS+ASCII(LDEV,BPS0); <<CONVERT LOGICAL DEV #><<01101>>17834000
          MOVE * := " STATUS=%",2;                             <<01101>>17836000
          TOS := TOS+LNTOA(ERRSTAT,8,BPS0);                    <<01101>>17838000
          IF ERRSTAT2<>0 THEN                                  <<01101>>17840000
             BEGIN                                             <<01101>>17842000
             MOVE * := ",%",2;                                 <<01101>>17844000
             TOS := TOS+LNTOA(ERRSTAT2,8,BPS0);                <<01101>>17846000
             END;                                              <<01101>>17848000
          MOVE * := " ADDR=%",2;                               <<01101>>17850000
          TOS := TOS+LDNTOA(ADDR,8,BPS0);                      <<01101>>17852000
          IF WORDS <> 0 THEN                                   <<01101>>17854000
             BEGIN                                             <<01101>>17856000
             MOVE * := " WORDS=",2;                            <<01101>>17858000
             ASCII(WORDS,BPS0);                                <<01101>>17860000
             END;                                              <<01101>>17862000
          PRINTLINE;                                           <<00888>>17864000
          ERRMESSAGE(STATUS'TO'MESS(ERRSTAT.(3:5)));           <<01103>>17866000
      END <<DISCERROR>> ;                                               17868000
$PAGE                                                                   17870000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>17872000
$CONTROL SEGMENT=RESIDENT                                      <<02510>>17874000
          <<------------------------                                    17876000
            FIXED-HEAD DISC DRIVER                                      17878000
          ------------------------>>                                    17880000
  PROCEDURE FHDISC(LDEV,DRTUNIT,STYPE,WRITE,RECORD,BUF,WC);             17882000
    VALUE DRTUNIT,STYPE,WRITE,RECORD,BUF,WC,LDEV;                       17884000
    INTEGER DRTUNIT,     <<DRT AND UNIT NUMBER>>                        17886000
            LDEV,         <<LOGICAL DEVICE #>>                          17888000
            STYPE,       <<SUBTYPE - FOR DIFFERENT SIZED DISCS>>        17890000
            WC;          <<WORD COUNT>>                                 17892000
    LOGICAL WRITE;       <<0 FOR READ, 1 FOR WRITE>>                    17894000
    DOUBLE RECORD,       <<SECTOR ADDRESS>>                             17896000
           BUF;          <<CORE BUFFER ABSOLUTE ADDRESS>>               17898000
    COMMENT                                                             17900000
      PERFORMS A DISC TRANSFER ON THE FIXED-HEAD DISC;                  17902000
      BEGIN                                                             17904000
        LOGICAL ADDRESS=RECORD+1;   <<ALL ADDRESSES <17 BITS>>          17906000
        INTEGER FUNC = WRITE;                                  <<02510>>17908000
        EQUATE ARCPTRK     =    32,                                     17910000
               MAXTRK      =    511;                                    17912000
        INTEGER ERROR := 0;                                             17914000
        INTEGER DRT,J;                                                  17916000
        LOGICAL ARCWRD,TRKWRD,                                          17918000
                COM1:=%170000,                                          17920000
                COM2:=%070000;                                          17922000
        ARRAY S(*)=DB+0;        <<SIO PROGRAM BUFFER>>                  17924000
        INTEGER ARRAY TBUFDB(*)=DB+0;   <<TEMPORARY BUFFER>>            17926000
        DOUBLE OLDDB,TBUFA;                                             17928000
        INTEGER TRACK,BUF1=BUF,BUF2=BUF+1;                              17930000
        INTEGER ARRAY TBUF(0:127)=Q;                                    17932000
          << CHECK FOR VALID FUNCTION >>                       <<02510>>17934000
                                                               <<03715>>17936000
          CC := CCE;    << INIT. CONDITION CODE RETURN >>      <<03715>>17938000
                                                               <<03549>>17940000
          IF FUNC = RSTAT THEN    << READ STATUS >>            <<03549>>17942000
             BEGIN                                             <<03549>>17944000
             TOS := BUF;          << ALWAYS RETURN >>          <<03549>>17946000
             TOS := 0D;           <<    READY      >>          <<03549>>17948000
             ASSEMBLE(SDEA;DDEL);                              <<03549>>17950000
             RETURN;                                           <<03549>>17952000
             END;                                              <<03549>>17954000
                                                               <<03549>>17956000
          IF FUNC = INIT'DEV THEN   << INITIALIZE DISC--DO >>  <<03549>>17958000
             RETURN;                <<    NOTHING--RETURN  >>  <<03549>>17960000
                                                               <<03549>>17962000
          DRT := DRTUNIT.DRTFIELD;                             <<03002>>17964000
          TOS := DRT;                                          <<03002>>17966000
          TIO0;                                                <<01103>>17968000
          IF S0.(2:1)=1 THEN                                            17970000
            BEGIN   <<RESET PREVIOUS INTERRUPT>>                        17972000
              TOS := %100000;                                           17974000
              CIO2;                                            <<01103>>17976000
            END;                                                        17978000
          IF TOS.(3:1)=1 THEN                                           17980000
            BEGIN   <<DEVICE NOT READY>>                                17982000
              IF LDEV<>0 THEN MESSAGE(M2408,LDEV);             <<01103>>17984000
  WAITFOREADY:ASSEMBLE(TIO 0; BL *-1);                                  17986000
              IF TOS.(3:1)=1 THEN GO WAITFOREADY;                       17988000
            END;                                                        17990000
          IF WRITE THEN BEGIN COM1:=%160000; COM2:=%60000 END;          17992000
          TOS := 0;                                                     17994000
          TOS := ADDRESS;                                               17996000
          TOS := ARCPTRK;                                               17998000
          ASSEMBLE(LDIV);                                               18000000
          ARCWRD := TOS;                                                18002000
          IF S0>MAXTRK THEN ERRMESSAGE(M27);                   <<01103>>18004000
          TRKWRD := TOS;                                                18006000
          TOS := ABSOLUTE(DBBANK);                                      18008000
          TOS := ABSOLUTE(DB);                                          18010000
          ASSEMBLE(DDUP;XCHD);  <<SET DB TO STACK>>                     18012000
          OLDDB := TOS;  <<SAVE OLD VALUE OF DB>>                       18014000
          TOS := TOS+@TBUF;                                             18016000
          TBUFA := TOS;  <<ABSOLUTE ADDRESS OF TBUF ARRAY>>             18018000
          TOS := 0;                                                     18020000
          TOS := ABSOLUTE(SIOPROG);                                     18022000
          SET(DB);  <<SET DB TO SIO PROGRAM BUFFER>>                    18024000
  TRYAGAIN:                                                             18026000
          J := 0;                                                       18028000
          S := SIOCNTRL LOR ARCWRD;                                     18030000
          S(1) := TRKWRD;                                               18032000
          S(2) := SIOBANK;                                              18034000
          S(3) := BUF1;    <<SET BANK REGISTER>>                        18036000
          WHILE WC>4096 DO                                              18038000
            BEGIN                                                       18040000
              S(X:=X+1) := COM1;                                        18042000
              S(X:=X+1) := BUF2+J;                                      18044000
              J := J+4096;                                              18046000
              WC := WC-4096;                                            18048000
            END;                                                        18050000
          S(X:=X+1) := LOGICAL(-WC).(4:12) LOR COM2;                    18052000
          S(X:=X+1) := BUF2+J;                                          18054000
          S(X:=X+1) := SIOEND;                                          18056000
          S(X:=X+1) := 0;                                               18058000
          TOS := EXECUTESIO(DRT,ABSOLUTE(SIOPROG));                     18060000
          IF TOS.(3:7) <> 0 THEN                                        18062000
          IF (ERROR:=ERROR+1) < 10 THEN                                 18064000
            BEGIN                                                       18066000
              TOS := %100000;                                           18068000
              CIO1;                                            <<01103>>18070000
              GO TRYAGAIN;                                              18072000
            END                                                         18074000
          ELSE                                                          18076000
            BEGIN   <<OUTPUT ERROR MESSAGE>>                            18078000
              TOS := LDEV;                                              18080000
              IF = THEN ASSEMBLE(HALT 2);  <<IN BOOTSTRAP>>    <<2B.00>>18082000
              ASSEMBLE(TIO 1; BL *-1);    <<GET NORMAL STATUS WORD>>    18084000
              TOS := 0;  <<HIGH ORDER WORD OF ADDRESS>>                 18086000
              TOS := 2;  <<SELECT STATUS WORD 2>>                       18088000
              ASSEMBLE(CIO 4; BL*-1; TIO 3; BL*-1);                     18090000
              TOS := TOS.(4:12)&LSL(5);  <<BAD TRACK ADDR>>             18092000
              TOS := 1;  <<SELECT STATUS WORD 2>>                       18094000
              ASSEMBLE(CIO 5; BL*-1; TIO 4; BL*-1);                     18096000
              TOS := TOS.(10:6);  <<ARC ADDRESS>>                       18098000
              ASSEMBLE(ADD);                                            18100000
              TOS := S2;  << GET STATUS >>                              18102000
              IF TOS.(3:7)=%60 THEN  << TRACK SPECIFIC ERROR >>         18104000
                BEGIN                                                   18106000
                  TOS := RECORD&DASR(5);                                18108000
                  DELB;                                                 18110000
                  TRACK := TOS&LSL(2);                                  18112000
                  IF = THEN GOTO T1;                                    18114000
                  FHDISC(LDEV,DRTUNIT,STYPE,0,1D,TBUFA,128);            18116000
                  TOS := TBUFA;                                         18118000
                  ASSEMBLE(XCHD);  <<SET DB TO TBUF ARRAY>>             18120000
                  X := 0;                                               18122000
                  WHILE (X:=X+1)<=TBUFDB DO                             18124000
                    IF TBUFDB(X)=TRACK THEN GOTO T1; << ALREADY THERE >>18126000
                  TBUFDB := TBUFDB+1;                                   18128000
                  IF X>120 THEN GOTO T1; << TABLE FULL >>               18130000
                  TBUFDB(X) := TRACK;                                   18132000
                  FHDISC(LDEV,DRTUNIT,STYPE,1,1D,TBUFA,128);            18134000
                END;         << MARKING BAD TRACK IN MAP >>             18136000
T1:                                                                     18138000
              DISCERROR(*,*,*,0,WRITE,0);                               18140000
            END;                                                        18142000
          TOS := OLDDB;                                                 18144000
          ASSEMBLE(XCHD);  <<RESET DB TO FORMER VALUE>>                 18146000
      END <<FHDISC>> ;                                                  18148000
$CONTROL SEGMENT=BOOTSTRAP                                     <<02510>>18150000
          <<----------------------------------                          18152000
            7900/ISS MOVING HEAD DISC DRIVER                            18154000
          ---------------------------------->>                          18156000
  PROCEDURE MHDISC(LDEV,DRTUNIT,STYPE,WRITE,RECORD,BUF,WC);             18158000
    VALUE LDEV,DRTUNIT,STYPE,WRITE,RECORD,BUF,WC;                       18160000
    INTEGER DRTUNIT,     <<DRT AND UNIT NUMBER>>                        18162000
            LDEV,         <<LOGICAL DEVICE #>>                          18164000
            STYPE,       <<SUBTYPE - FOR DIFFERENT SIZED DISCS>>        18166000
            WC;          <<WORD COUNT>>                                 18168000
   LOGICAL WRITE ;                                                      18170000
       <<   0  -  READ                                                  18172000
            1  -  WRITE                                                 18174000
            2  -  READ AND RETURN CCL IF TRACK FLAGGED DEFECTIVE;       18176000
                    OR CCG IF TRACK SPECIFIC ERROR ELSE CCE             18178000
            3  -  FLAG A TRACK DEFECTIVE; ALT TRK NUMBER IN BUF(0)      18180000
                    REQUIRES A WORD COUNT OF 46 WORDS AND A BUFFER      18182000
                    OF 46 WORDS WHICH MAY BE MODIFIED                   18184000
            4  -  READ ADDRESS OR READ NEXT FULL SECTOR                 18186000
            BIT 1  INDICATES TRANSFER FROM ALTERNATE TRACK              18188000
       >>                                                               18190000
    DOUBLE RECORD,       <<SECTOR ADDRESS>>                             18192000
           BUF;          <<CORE BUFFER ABSOLUTE ADDRESS>>               18194000
    COMMENT                                                             18196000
      PERFORMS A DISC TRANSFER ON THE SPECIFIED MOVING-HEAD DISC;       18198000
      BEGIN                                                             18200000
        INTEGER FUNC = WRITE;                                  <<02510>>18202000
        EQUATE FTD      =%040000,                                       18204000
               SIOSENSE =%050000,                                       18206000
               RA       =%040000,                                       18208000
               RNFS     =%120000,                                       18210000
               ALTFLAG  =%40000,                                        18212000
               WA       =%130000;                                       18214000
        EQUATE DISCREAD    =   0,                                       18216000
               DISCWRITE   =   %100000,                                 18218000
               DISCSTATUS  =   %30000,                                  18220000
               DISCRECAL   =   %10000,                                  18222000
               DISCSEEK    =   %20000;                                  18224000
        EQUATE RESETINT    =   %40000,                                  18226000
               DISCINTRPT =   %20000;                                   18228000
        INTEGER ARRAY SCTPERCYL(0:3)=PB:=48,48,96,460;                  18230000
        INTEGER ARRAY SCTPERHD(0:3)=PB:=24,24,24,23;                    18232000
        INTEGER ARRAY HDBASE(0:3)=PB:=0,2,0,0;                          18234000
        INTEGER ARRAY MAXSCTPREAD(0:3)=PB:=48,48,48,460;                18236000
        INTEGER ARRAY SCTPERTRK(0:3)=PB:=48,48,48,23;                   18238000
        INTEGER NS,           <<# OF SECTORS>>                          18240000
                AS,           <<# OF AVAILABLE SECTORS>>                18242000
                WC1,          <<CURRENT WORD COUNT>>                    18244000
                DRT,          <<DRT NUMBER>>                            18246000
                UNIT,         <<UNIT NUMBER>>                           18248000
                SCTINCYL,     <<NUMBER OF SECTORS IN CYLINDER>>         18250000
                COUNTER,                                                18252000
                I:=0,         <<BUFFER INDEX>>                          18254000
                RWERROR:=0,   <<NUMBER OF READ/WRITE ERRORS>>           18256000
                TRACK,   << DEFECTIVE TRACK NUMBER >>                   18258000
                CONSTAT,            <<CONTROLLER STATUS>>               18260000
                BUF1=BUF, BUF2=BUF+1,                                   18262000
                STATUS = Q-1,                                           18264000
                SEEKERROR:=0; <<NUMBER OF SEEK ERRORS>>                 18266000
        LOGICAL SIOCOM:=SIOREAD,  <<SIO COMMAND>>                       18268000
                DISCCOM:=DISCREAD,<<DISC COMMAND>>                      18270000
                ERRSTAT,      <<ERROR STATUS>>                          18272000
                ERRORBITS,    <<SEEK ERROR BITS>>                       18274000
                COUNTING,      <<TIMING OUT SIO>>                       18276000
                HDSCTR,           <<HEAD AND SECTOR>>                   18278000
                UNITCYL;          <<UNIT AND CYLINDER>>                 18280000
        DOUBLE OLDDB,        <<ORIGINAL VALUE OF DB>>                   18282000
               TBUFA;        <<ABSOLUTE ADDRESS OF TBUF ARRAY>>         18284000
        LOGICAL ARRAY S(*)=DB+0,  <<SIO PROGRAM BUFFER>>                18286000
                      BUFDB(*)=DB+0;                                    18288000
        INTEGER ARRAY TBUFDB(*)=DB+0;                                   18290000
        INTEGER ARRAY TBUF (0:131) = Q;                                 18292000
        LOGICAL SUBROUTINE WAITFORINT;                                  18294000
        BEGIN                                                           18296000
          TOS := DRT;                                                   18298000
  WAIT:   TIO0;                                                <<01103>>18300000
          S3 := S0;  <<STATUS>>                                         18302000
          IF TOS.(2:1)<>1 THEN GOTO WAIT                                18304000
          ELSE                                                          18306000
            BEGIN  <<RESET INTERRUPT>>                                  18308000
              TOS := RESETINT;                                          18310000
              CIO1;                                            <<01103>>18312000
              IF S2.(13:3)<>UNIT THEN GOTO WAIT  <<WRONG UNIT>>         18314000
            END;                                                        18316000
          DEL;                                                          18318000
        END <<WAITFORINT>> ;                                            18320000
                                                                        18322000
        LOGICAL SUBROUTINE EXANWAIT(INDEX,SAMEUNIT);                    18324000
        VALUE INDEX,SAMEUNIT;                                           18326000
        INTEGER INDEX;                                                  18328000
        LOGICAL SAMEUNIT;  <<TRUE IF INTRPT ON THIS UNIT IS VALID>>     18330000
        BEGIN                                                           18332000
          COUNTING := TRUE;                                             18334000
          COUNTER := -32000;  <<1 SECOND>>                              18336000
          S(INDEX) := SIOEND;                                           18338000
          S(X:=X+1) := 0;                                               18340000
          TOS := DRT;                                                   18342000
          EXECUTESIO(DRT,ABSOLUTE(SIOPROG));                   <<01103>>18344000
  TEST:   TIO0;                                                <<01103>>18346000
          S5 := S0;   <<STATUS>>                                        18348000
          IF TOS.(2:1)=1 THEN                                           18350000
            BEGIN   <<INTERRUPT>>                                       18352000
              TOS := RESETINT;                                          18354000
              ASSEMBLE (CIO 1; BL *-1);                                 18356000
              IF S4.(13:3)=UNIT AND LOGICAL(S2) THEN                    18358000
                BEGIN                                                   18360000
                  DO TIO0 UNTIL TOS<0;                         <<01103>>18362000
  GETOUT:         DEL;                                                  18364000
                  RETURN;                                               18366000
                END                                                     18368000
              ELSE                                                      18370000
                BEGIN                                                   18372000
                  COUNTER := -32000;                                    18374000
                  GOTO TEST;                                            18376000
                END;                                                    18378000
            END;                                                        18380000
          IF S4<0 THEN GOTO GETOUT;   <<SIO OK>>                        18382000
          IF (COUNTER:=COUNTER+1)=0 AND COUNTING THEN                   18384000
            BEGIN  <<UNIT 0 NOT READY>>                                 18386000
              IF UNIT=0 AND LDEV<>0 THEN MESSAGE(M2408,LDEV)   <<01103>>18388000
              ELSE                                                      18390000
                BEGIN                                                   18392000
                  TOS := ABSOLUTE(DBBANK);                              18394000
                  TOS := ABSOLUTE(DB);                                  18396000
                  ASSEMBLE(XCHD);  <<SET DB TO STACK>>                  18398000
                  MOVE BINBUF := "DISC IN DRT ";                        18400000
                  COUNTER := ASCII(DRT,BINBUF(12));                     18402000
                  MOVE BINBUF(12+COUNTER) := " UNIT 0 NOT READY";       18404000
                  PRINT(INBUF,-29-COUNTER,0);                           18406000
                  SET(DB);   <<RESET DB>>                               18408000
                END;                                                    18410000
              COUNTING := FALSE;                                        18412000
            END;                                                        18414000
          GOTO TEST;  <<WAIT FOR SIO OK OR INTERRUPT>>                  18416000
        END <<EXANWAIT>> ;                                              18418000
          << CHECK FOR VALID FUNCTION >>                       <<02510>>18420000
                                                               <<03715>>18422000
          CC := CCE;    << INIT. CONDITION CODE RETURN >>      <<03715>>18424000
                                                               <<03549>>18426000
          IF FUNC = RSTAT THEN     << READ STATUS >>           <<03549>>18428000
             BEGIN                                             <<03549>>18430000
             TOS := BUF;           << ALWAYS RETURN >>         <<03549>>18432000
             TOS := 0D;            <<    READY      >>         <<03549>>18434000
             ASSEMBLE(SDEA;DDEL);                              <<03549>>18436000
             RETURN;                                           <<03549>>18438000
             END;                                              <<03549>>18440000
                                                               <<03549>>18442000
          IF FUNC = INIT'DEV THEN   << INITIALIZE DISC--DO >>  <<03549>>18444000
             RETURN;                <<    NOTHING--RETURN  >>  <<03549>>18446000
                                                               <<03549>>18448000
          TOS := ABSOLUTE(DBBANK);                                      18450000
          TOS := ABSOLUTE(DB);                                          18452000
          ASSEMBLE(DDUP,DDUP; XCHD);  <<SET DB TO STACK>>               18454000
          OLDDB := TOS;  <<SAVE OLD VALUE OF DB>>                       18456000
          TOS := TOS+@TBUF;                                             18458000
          TBUFA := TOS;   <<ABSOLUTE ADDRESS OF TBUF>>                  18460000
          TOS := 0;                                                     18462000
          TOS := ABSOLUTE(SIOPROG);                                     18464000
          SET(DB);  <<SET DB TO SIO PROGRAM BUFFER>>                    18466000
          DRT := DRTUNIT.DRTFIELD;                             <<03002>>18472000
          UNIT := DRTUNIT.UNITFIELD;                           <<03002>>18474000
          IF STYPE=3 THEN TOS := %7000  ELSE TOS := %47000;             18476000
          ERRORBITS := TOS;                                             18478000
          STATUS.(6:2) := CCE;  << SET CCE >>                           18480000
          S := SIOCNTRL+UNIT&LSL(9);                                    18482000
          S(1) := DISCSTATUS;  <<STATUS CHECK>>                         18484000
  SCAGAIN:TOS := EXANWAIT(2,FALSE);                                     18486000
          IF S0.(13:3)<>UNIT THEN                                       18488000
            BEGIN  <<WRONG UNIT BECAUSE UNIT 0 WASN'T READY>>           18490000
              DEL;                                                      18492000
              GOTO SCAGAIN;                                             18494000
            END;                                                        18496000
          IF TOS.(3:4)<>%10 THEN                                        18498000
            BEGIN  <<NOT READY>>                                        18500000
              MESSAGE(M2408,LDEV); << NOT READY >>             <<01103>>18502000
              WAITFORINT;                                               18504000
            END;                                                        18506000
          NS := LOGICAL(WC+127)&LSR(7);   <<NUMBER OF SECTORS>>         18508000
          IF WRITE THEN                                                 18510000
            BEGIN                                                       18512000
              DISCCOM := DISCWRITE;                                     18514000
              SIOCOM := SIOWRITE;                                       18516000
            END;                                                        18518000
  AGAIN:  TOS := RECORD;                                                18520000
          TOS := SCTPERCYL(STYPE);    <<# OF SECTORS PER CYLINDER>>     18522000
          ASSEMBLE(LDIV,ZERO; XCH,DUP);                                 18524000
          SCTINCYL := TOS;                                              18526000
          TOS := SCTPERHD(X);                                           18528000
          ASSEMBLE(LDIV,XCH);                                           18530000
          TOS := (TOS+HDBASE(X))&LSL(6);                                18532000
          ASSEMBLE(OR);                                                 18534000
          HDSCTR := TOS;  <<HEAD AND SECTOR>>                           18536000
          TOS := UNIT&LSL(9);                                           18538000
          ASSEMBLE(OR);                                                 18540000
          UNITCYL := TOS;  <<UNIT AND CYLINDER>>                        18542000
          TOS := MAXSCTPREAD(X)-SCTINCYL;                               18544000
          IF S0<1 THEN TOS := TOS+MAXSCTPREAD(X);                       18546000
          AS := TOS;   <<NUMBER OF AVAILABLE SECTORS>>                  18548000
          TOS := WC;                                                    18550000
          IF NS>AS THEN                                                 18552000
            BEGIN                                                       18554000
              DEL;                                                      18556000
              TOS := AS&LSL(7);   <<NUMBER OF WORDS WE CAN DO>>         18558000
            END;                                                        18560000
          IF S0>4096 THEN                                               18562000
            BEGIN                                                       18564000
              DEL;                                                      18566000
              TOS := 4096;   <<MAXIMUM TRANSFER>>                       18568000
            END;                                                        18570000
  SHORTRACK:                                                            18572000
          WC1 := TOS;  <<# OF WORDS TO TRANSFER>>                       18574000
  RETRY:  SEEKERROR := 0;                                               18576000
          S := UNITCYL LOR SIOCNTRL;                                    18578000
  RESEEK: S(1) := HDSCTR LOR DISCSEEK;   <<SEEK COMMAND>>               18580000
          TOS := EXANWAIT(2,TRUE);  <<EXECUTE SEEK>>                    18582000
          IF S0.(2:1)=1 THEN                                            18584000
          IF (TOS LAND ERRORBITS)<>0 THEN GOTO SEEKERR ELSE GOTO COM    18586000
          ELSE DEL;                                                     18588000
          IF ((ERRSTAT:=WAITFORINT) LAND ERRORBITS) <> 0 THEN           18590000
            BEGIN                                                       18592000
  SEEKERR:    S(1) := DISCRECAL;  <<RECALIBRATE>>                       18594000
              EXANWAIT(2,TRUE);                                         18596000
              WAITFORINT;                                               18598000
              IF (SEEKERROR:=SEEKERROR+1)>10 THEN                       18600000
                BEGIN   <<SEEK ERROR>>                                  18602000
                  TOS := LDEV;                                          18604000
                  IF = THEN ASSEMBLE(HALT 3);  <<IN BOOTSTRAP>><<2B.00>>18606000
                  DISCERROR(*,ERRSTAT,RECORD,0,2,0);                    18608000
                END;                                                    18610000
              GO RESEEK;  <<TRY AGAIN>>                                 18612000
            END;                                                        18614000
  COM:    S(1) := HDSCTR LOR DISCCOM;  <<READ/WRITE COMMAND>>           18616000
          S(2) := SIOBANK;                                              18618000
          S(3) := BUF1;  <<BANK ADDRESS>>                               18620000
          IF WRITE=3 THEN    << FLAG A TRACK DEFECTIVE  >>              18622000
            BEGIN                                                       18624000
              IF STYPE=3 THEN                                           18626000
                BEGIN      << SET UP FOR WRITE ADDRESS >>               18628000
                  TOS := BUF;                                           18630000
                  ASSEMBLE(XCHD);  <<SET DB TO BUF>>                    18632000
                  BUFDB := BUFDB+%100000;                               18634000
                  X := 0;                                               18636000
                  WHILE (X:=X+1)<46 DO BUFDB(X) := BUFDB;               18638000
                  SET(DB);  <<RESET DB>>                                18640000
                  S(1) := WA LOR HDSCTR;                                18642000
                END                                                     18644000
              ELSE                                                      18646000
                BEGIN      << FORM FLAG TRACK SIO PROGRAM >>            18648000
                  TOS := BUF;                                           18650000
                  ASSEMBLE(LSEA; DELB,DELB);   <<GET FIRST WORD>>       18652000
                  S := TOS LOR SIOCNTRL+(UNITCYL LAND %3000);           18654000
                  S(1) := FTD LOR HDSCTR;                               18656000
                  S(4) := SIOSENSE;                                     18658000
                  I := 1;                                               18660000
                  GOTO T4;                                              18662000
                END;                                                    18664000
            END;                                                        18666000
                                                                        18668000
          IF WRITE=4 THEN  << READ ADDRESS OR NEXT FULL SECTOR >>       18670000
            S(1) := (IF STYPE=3 THEN RA ELSE RNFS) LOR HDSCTR;          18672000
                                                                        18674000
          S(4) := SIOCOM+(LOGICAL(-WC1) LAND %7777);                    18676000
T4:                                                                     18678000
          S(5) := BUF2+I;  <<ABSOLUTE ADDRESS>>                         18680000
          IF ((ERRSTAT:=EXANWAIT(6,TRUE)).(2:1))<>0 THEN                18682000
            BEGIN                                                       18684000
              CONSTAT := ERRSTAT.(8:5);  <<CONTROLLER STATUS>>          18686000
              IF CONSTAT=6 THEN  <<TRACK FLAGGED DEFECTIVE>>            18688000
                BEGIN                                                   18690000
                  IF WRITE=2 THEN   << RETURN CONDITION CODE CCL >>     18692000
                    BEGIN                                               18694000
                      STATUS.(6:2) := CCL;   << CCL >>                  18696000
                      GOTO EXIT;                                        18698000
                    END;                                                18700000
                  TOS := SCTPERTRK(STYPE);                              18702000
                  TOS := RECORD;                                        18704000
                  TOS := SCTPERTRK(X);                                  18706000
                  ASSEMBLE(LDIV,DELB; SUB);                             18708000
                  TOS := TOS&LSL(7);                                    18710000
                  IF WC1 > S0 THEN GOTO SHORTRACK                       18712000
                  ELSE DEL;                                             18714000
T1:                                                                     18716000
                  TOS := LDEV;                                          18718000
                  TOS := DRTUNIT;                                       18720000
                  TOS := STYPE;                                         18722000
                  TOS := 4;  <<READ ALTERNATE TRACK>>                   18724000
                  TOS := RECORD;                                        18726000
                  TOS := TOS LOR 1;  <<FOR MV CONTROLLER ERROR>>        18728000
                  MHDISC(*,*,*,*,*,TBUFA,IF STYPE=3 THEN 4 ELSE 132);   18730000
                  X := IF STYPE=3 THEN 2 ELSE 131;                      18732000
                  TOS := TBUFA;                                         18734000
                  ASSEMBLE(XCHD);  <<SET DB TO TBUF>>                   18736000
                  IF TBUFDB<>TBUFDB(X) THEN  << NO TRK # AGREEMENT >>   18738000
                    BEGIN                                               18740000
                      SET(DB);  <<RESET DB BACK WHERE IT WAS>>          18742000
                      IF (RWERROR:=RWERROR+1)>10 THEN  <<IRRECOVERABLE>>18744000
                        BEGIN                                           18746000
                          TOS := LDEV;                                  18748000
                          GOTO T5;                                      18750000
                        END                                             18752000
                      ELSE GOTO T1;                                     18754000
                    END;                                                18756000
                  TOS := LDEV;                                          18758000
                  TOS := DRTUNIT;                                       18760000
                  TOS := STYPE;                                         18762000
                  TOS := WRITE LOR ALTFLAG;                             18764000
                  TOS := TBUFDB.(2:14); <<ALTERNATE TRACK ADDRESS>>     18766000
                  IF STYPE=2 THEN ASSEMBLE(TSBC 7);                     18768000
                  TOS := SCTPERTRK(STYPE);                              18770000
                  ASMB(LMPY,ZERO);                                      18772000
                  TOS := RECORD;  TOS := SCTPERTRK(X);                  18774000
                  ASMB(LDIV,DELB);  << SECTOR NUMBER IN TRACK >>        18776000
                  ASMB(DADD); <<SECTOR ADDRESS OF ALTERNATE AREA>>      18778000
                  TOS := BUF;                                           18780000
                  TOS := TOS+I;  <<ABSOLUTE CORE ADDRESS>>              18782000
                  MHDISC(*,*,*,*,*,*,WC1); <<TRANSFER FROM ALT TRACK>>  18784000
                  SET(DB);  <<RESET DB TO OLD VALUE>>                   18786000
                  GOTO T2;  << CONTINUE ON >>                           18788000
                END;                                                    18790000
              IF (RWERROR:=RWERROR+1)>10 THEN                           18792000
                BEGIN                                                   18794000
                  TOS := LDEV;                                          18796000
                  IF = THEN ASSEMBLE(HALT 4);  <<IN BOOTSTRAP>><<2B.00>>18798000
                  IF 5<=CONSTAT<=%11 OR CONSTAT=%13 OR CONSTAT=%22 THEN 18800000
                    BEGIN   << TRACK SPECIFIC ERROR >>                  18802000
T5:                                                                     18804000
                      IF WRITE=2 THEN << RETURN CCG >>                  18806000
                        BEGIN                                           18808000
                          STATUS.(6:2) := CCG;  << CCG >>               18810000
                          GOTO EXIT;                                    18812000
                        END;                                            18814000
                      TOS := RECORD; TOS := SCTPERTRK(STYPE);           18816000
                      ASMB(LDIV,DEL );   << TRACK NUMBER >>             18818000
                      TOS := WRITE; TOS := ALTFLAG;<< ALT TRK BIT MSK >>18820000
                      TRACK := (TOS LAND TOS LOR TOS)&CSL(2);           18822000
                      IF = THEN GOTO T3;                                18824000
                      MHDISC(LDEV,DRTUNIT,STYPE,0,1D,TBUFA,128);        18826000
                      TOS := TBUFA;                                     18828000
                      SET(DB);   <<SET DB TO TBUF>>                     18830000
                      X := 0;                                           18832000
                      WHILE (X:=X+1)<=TBUFDB DO                         18834000
                        IF TBUFDB(X)=TRACK THEN                         18836000
                          GOTO T3;  << ALREADY IN TABLE >>              18838000
                      TBUFDB := TBUFDB+1;                               18840000
                      IF X>120 THEN GOTO T3;  << NO ROOM >>             18842000
                      TBUFDB(X) := TRACK;                               18844000
                      MHDISC(LDEV,DRTUNIT,STYPE,1,1D,TBUFA,128);        18846000
                    END;                                                18848000
T3:                                                                     18850000
                  DISCERROR(*,ERRSTAT,RECORD,WC1,WRITE.(15:1),0);       18852000
                END;                                                    18854000
              GOTO RETRY;                                               18856000
            END;                                                        18858000
T2:                                                                     18860000
          TOS := WC1;                                                   18862000
          ASSEMBLE(DUP,DUP);                                            18864000
          I := TOS+I;   <<UPDATE BUFFER POINTER>>                       18866000
          WC := -TOS+WC;   <<UPDATE WORD COUNT>>                        18868000
          IF <= THEN                                                    18870000
            BEGIN  <<TRANSFERRED ALL WORDS>>                            18872000
  EXIT:       TOS := OLDDB;                                             18874000
              ASSEMBLE(XCHD);  <<RESET DB TO ORIGINAL VALUE>>           18876000
              RETURN;                                                   18878000
            END;                                                        18880000
          ASSEMBLE(ZERO,XCH);                                           18882000
          TOS := LOGICAL(TOS+127)&LSR(7);  <<# OF SECTORS DONE>>        18884000
          ASSEMBLE(DUP,NEG);                                            18886000
          NS := TOS+NS;  <<# OF SECTORS LEFT TO DO>>                    18888000
          RECORD := TOS+RECORD;                                         18890000
          GO AGAIN;                                                     18892000
      END <<MHDISC>> ;                                                  18894000
          <<----------------------------                                18896000
            7905/7920/7925 DISC DRIVER                                  18898000
          ---------------------------->>                                18900000
$CONTROL SEGMENT=RESIDENT                                      <<02510>>18902000
PROCEDURE MH7905'SIO(LDEV,DRTUNIT,STYPE,FUNCT,RECORD,BUF,WC);  <<02510>>18904000
    VALUE LDEV,DRTUNIT,STYPE,FUNCT,RECORD,BUF,WC;                       18906000
    INTEGER DRTUNIT,        <<DRT AND UNIT NUMBER>>                     18908000
            LDEV,           <<LOGICAL DEVICE NUMBER>>                   18910000
            STYPE,          <<SUBTYPE>>                                 18912000
            WC;             <<WORD COUNT>>                              18914000
    LOGICAL FUNCT;          <<0: READ                                   18916000
                              1: WRITE                                  18918000
                              2: READ AND SET CCE - OK                  18920000
                                              CCL - DEFECTIVE TRACK     18922000
                                              CCG - TRACK SPECIFIC ERROR18924000
                              3: FLAG TRACK DEFECTIVE                   18926000
                              4: READ FULL SECTOR>>                     18928000
    DOUBLE RECORD,          <<DISC ADDRESS>>                            18930000
           BUF;             <<ABSOLUTE ADDRESS OF BUFFER>>              18932000
      BEGIN                                                             18934000
        DEFINE ERRCODE  = (3:5)#,   <<ERROR BITS IN STATUS>>            18936000
               NOTRDY   = (14:1)#;  <<DRIVE NOT READY>>                 18938000
        EQUATE SIOEND   = %30000,   <<SIO END INSTRUCTION>>             18940000
               SIOJUMPC = %4000,    <<SIO CONDITIONAL JUMP>>            18942000
               SIOCNTRL = %40000;   <<SIO CONTROL INSTRUCTION>>         18944000
        EQUATE CDERR    = %17,      <<CORRECTABLE DATA ERROR>>          18946000
               WUPERR   = 2,        <<SET WAKE UP COMPLETED>>  <<00.06>>18948000
               SPT      = %20,      <<SPARE TRACK>>                     18950000
               TFD      = %21;      <<DEFECTIVE TRACK>>                 18952000
        EQUATE D        = 1,        <<DEFECTIVE TRACK BIT>>             18954000
               SP       = 4;        <<SPARE TRACK BIT>>                 18956000
        EQUATE SEEKCOM  = %1200,    <<SEEK COMMAND>>                    18958000
               REQSTAT  = %1400,    <<REQUEST STATUS COMMAAD>>          18960000
               REQADR   = %12000,   <<REQUEST ADDRESS COMMAND>>         18962000
               SETWAKE  = %13000,   <<SET WAKEUP COMMAND>>     <<00.06>>18964000
   <<********************************************************>><<00.06>>18966000
   <<NOTE: THE SET WAKEUP COMMAND IS USED IN THIS DRIVER TO  >><<00.06>>18968000
   <<  INSURE THAT THE CORRECT UNIT NUMBER IS RETURNED IN THE>><<00.06>>18970000
   <<  TIO STATUS AFTER INTERUPT AND TO CLEAR THE TIO ERROR  >><<00.06>>18972000
   <<  STATUS AFTER RUNNING A REQUEST STATUS OR REQUEST      >><<00.06>>18974000
   <<  SYNDROME SIO PROGRAM.                                 >><<00.06>>18976000
   <<********************************************************>><<00.06>>18978000
               SETBANK  = %14000,   <<SET BANK>>                        18980000
               ENDOP    = %12400,   <<END COMMAND>>                     18982000
               REQSYND  = %6400,    <<REQUEST SYNDROME COMMAND>>        18984000
               VFY      = %3400,    <<VERIFY COMMAND>>                  18986000
               INITCOM  = %5400,    <<INITIALIZE COMMAND>>              18988000
               ADRREC   = %6000;    <<ADDRESS RECORD COMMAND>>          18990000
        LOGICAL ARRAY S(*) = DB+0,  <<SIO PROGRAM BUFFER>>              18992000
                      BUFDB(*) = DB+0;                                  18994000
        INTEGER ARRAY SYNRET(0:6)=Q;<<SYNDROME RETURN>>                 18996000
        DOUBLE STATWORDS,           <<STATUS RETURN>>                   18998000
               PHYSADR,             <<CYLINDER, HEAD & SECTOR>>         19000000
               OLDDB,               <<OLD ADDRESS OF DB>>               19002000
               TBUFA,               <<ABSOLUTE ADDRESS OF TBUF>>        19004000
               SYNADR=SYNRET+1,     <<ADDRESS OF ERROR>>                19006000
               ALTADR;              <<ALTERNATE CYLINDER, HEAD & SECT>> 19008000
        INTEGER DRT,                <<DRT NUMBER>>                      19010000
                UNIT,               <<UNIT NUMBER>>            <<03603>>19012000
                SBANK,              <<BANK OF OUR STK>>        <<03603>>19014000
                BUF1=BUF,BUF2=BUF+1,                                    19016000
                I:=0,                                                   19018000
                N,                                                      19020000
                INDEX,                                                  19022000
                CWC,                <<CURRENT WORD COUNT>>              19024000
                RDWRT,              <<COMMAND>>                         19026000
                CONSTAT,            <<CONTROLLER STATUS>>               19028000
                XCNT,               <<WORD COUNT>>                      19030000
                BUFCNT,             <<WORDS FINISHED COUNT>>            19032000
                TRACK,              <<DEFECTIVE TRACK ENTRY>>           19034000
                CYLADR=PHYSADR,                                         19036000
                ALTADR1=ALTADR,                                         19038000
                ALTADR2=ALTADR+1;                                       19040000
        INTEGER ARRAY TBUFDB(*) = DB+0;                                 19042000
        LOGICAL STATWORDABSADR, <<ABSOLUTE ADDR OF STATWORDS>>          19044000
                SYNRETABSADR,   <<ABSOLUTE ADDR OF SYNRET>>             19046000
                PHYSABSADR,     <<ABSOLUTE ADDR OF PHYSADR>>            19048000
                XCNTABSADR,     <<ABSOLUTE ADDR OF XCNT>>               19050000
                ALTABSADR;      <<ABS ADDR OF ALTADR>>                  19052000
        LOGICAL STATWORD1=STATWORDS,                                    19054000
                STATWORD2=STATWORDS+1;                                  19056000
        INTEGER ARRAY TBUF(0:127) = Q;                                  19058000
        INTEGER ARRAY STATSIOPROG(0:13)=PB:=                   <<00.06>>19060000
                %40001,0,           <<CONTROL-REQUEST STATUS>>          19062000
                %14000,0,           <<SET BANK-BANK #>>                 19064000
                %77776,0,           <<READ 2 STATUS WORDS>>             19066000
                %40001,REQADR,      <<CONTROL-RQST DISC ADDR>> <<25.03>>19068000
                %77776,0,           <<READ 2 WORD DISC ADDRESS>>        19070000
                %40000,0,           <<SET WAKEUP  >>           <<00.06>>19072000
                %40000,%12400;      <<CONTROL-END>>                     19074000
        INTEGER ARRAY XFERSIOPROG(0:7)=PB:=                             19076000
                %40000,0,           <<CONTROL-SET MASK>>                19078000
                %40000,ADRREC,      <<CONTROL-ADDRESS RECORD>> <<25.03>>19080000
                %67776,0,           <<WRITE 2 WORD ADDRESS>>            19082000
                %40000,0;           <<CONTROL-TRANSFER ORDER>>          19084000
        INTEGER ARRAY REQSYNSIOPROG(0:13) = PB :=              <<00.06>>19086000
                %40001,REQSYND,     <<CONTROL-REQUEST SYNDRME>><<25.03>>19088000
                %14000,0,           <<SET BANK-BANK #>>                 19090000
                %77771,0,           <<READ 7 WORDS>>                    19092000
                %40001,0,           <<CONTROL-REQUEST STATUS>>          19094000
                %77776,0,           <<READ 2 STATUS WORDS>>             19096000
                %40000,0,           <<SET WAKEUP>>             <<00.06>>19098000
                %40000,%12400;      <<CONTROL-END>>                     19100000
        INTEGER ARRAY VERIFYSIOPROG(0:3)=PB:=                           19102000
                %40000,0,           <<CONTROL-VERIFY>>                  19104000
                %67777,0;           <<WRITE 1 WORD SECTOR COUNT>>       19106000
        INTEGER ARRAY INITSIOPROG(0:11)=PB:=                            19108000
                %40000,ADRREC,      <<CONTROL-ADDRESS RECORD>> <<25.03>>19110000
                %67776,0,           <<WRITE 2 WORD ADDRESS>>            19112000
                %40000,0,           <<CONTROL-INITIALIZE>>              19114000
                %160000,0,          <<WRITE 4K FROM ADDDRESS 0>>        19116000
                %64000,%10000,      <<WRITE 2K FROM ADDRESS 4096>>      19118000
                                    <<  (WRITE 4K IF 7925)  >> <<25.03>>19120000
                %40000,%12400;      <<CONTROL-END>>                     19122000
        INTEGER ARRAY SEEKSIOPROG(0:5)=PB:=                             19124000
                %40000,0,           <<CONTROL-SEEK>>                    19126000
                %14000,0,           <<SET BANK-BANK #>>                 19128000
                %67776,0;           <<WRITE 2 WORD ADDRESS>>            19130000
        INTEGER ARRAY FILEMASK (4:NMHSUBTYPES-1) = PB :=       <<25.02>>19132000
                %7502, %7501, %7503, %7503, %7503, %7503;      <<25.02>>19134000
        INTEGER ARRAY SEC'CYL (4:NMHSUBTYPES-1) = PB :=        <<25.02>>19136000
                96, 48, 144, 144, 240, 576;                    <<25.02>>19138000
        INTEGER ARRAY HEADBASE (4:NMHSUBTYPES-1) = PB :=       <<25.02>>19140000
                0, %1000, 0, 0, 0, 0;                          <<25.02>>19142000
        INTEGER ARRAY SECPERTRK (4:NMHSUBTYPES-1) = PB :=      <<25.02>>19144000
                48, 48, 48, 48, 48, 64;                        <<25.02>>19146000
        INTEGER ARRAY DISKOP(0:4)=PB:=%2400,%4000,%2400,0,%3000;        19148000
        INTEGER ARRAY SIORDWRT(0:1)=PB:=%170000,%160000;                19150000
        LOGICAL SUBROUTINE EXANWAIT(INDEX,SAMEUNIT);                    19152000
        VALUE INDEX,SAMEUNIT;                                           19154000
        INTEGER INDEX;   <<SIO BUFFER INDEX>>                           19156000
        LOGICAL SAMEUNIT;<<TRUE IF INTERRUPT ON THIS UNIT IS VALID>>    19158000
        BEGIN                                                           19160000
          S(INDEX) := SIOEND;                                           19162000
          S(X:=X+1) := 0;                                               19164000
          TOS := DRT;                                                   19166000
          EXECUTESIO(DRT,ABSOLUTE(SIOPROG));                   <<01103>>19168000
  TEST:   TIO0;                                                <<01103>>19170000
          S5 := S0;  <<TIO STATUS>>                                     19172000
          IF TOS.(2:1) THEN                                             19174000
            BEGIN  <<INTERRUPT>>                                        19176000
              TOS := %40000;                                            19178000
              CIO1;                                            <<01103>>19180000
              IF S4.(13:3)=UNIT AND LOGICAL(S2) THEN                    19182000
                BEGIN  <<VALID INTERRUPT>>                              19184000
   GETOUT:        DEL;                                                  19186000
                  RETURN;                                               19188000
                END                                                     19190000
              ELSE GOTO TEST;                                           19192000
            END;                                                        19194000
          IF S4<0 THEN GOTO GETOUT;  <<SIO OK>>                         19196000
          GOTO TEST;                                                    19198000
        END <<EXANWAIT>> ;                                              19200000
        LOGICAL SUBROUTINE GETSTATUS;                                   19202000
        BEGIN                                                           19204000
          MOVE S := STATSIOPROG,(14);                          <<00.06>>19206000
          S(1) := REQSTAT+UNIT;  <<REQUEST STATUS COMMAND>>             19208000
          S(3) := SBANK;                                       <<03603>>19210000
          S(5) := STATWORDABSADR;                                       19212000
                                                               <<25.03>>19214000
          S(9) := SYNRETABSADR+1;  <<FOR ADDRESS RETURN>>               19216000
          S(11) := SETWAKE+UNIT;                               <<00.06>>19218000
          GETSTATUS := EXANWAIT(14,FALSE);                     <<00.06>>19220000
        END <<GETSTATUS>> ;                                             19222000
        SUBROUTINE SEEK;                                                19224000
        BEGIN                                                           19226000
          MOVE S := SEEKSIOPROG,(6);                                    19228000
          S(1) := SEEKCOM+UNIT;                                         19230000
          S(3) := SBANK;                                       <<03603>>19232000
          S(5) := PHYSABSADR;                                           19234000
        END <<SEEK>> ;                                                  19236000
        DOUBLE SUBROUTINE L'PADR(LOGADR);                               19238000
        VALUE LOGADR;                                                   19240000
        DOUBLE LOGADR;  <<LOGICAL ADDRESS>>                             19242000
        BEGIN                                                           19244000
          TOS := LOGADR;                                                19246000
          TOS := SEC'CYL(STYPE);                                        19248000
          ASSEMBLE(LDIV);                                               19250000
          IF OVERFLOW THEN                                              19252000
            BEGIN    <<BAD ADDRESS>>                                    19254000
            TOS := ABSOLUTE(DBBANK);                                    19256000
            TOS := ABSOLUTE(DB);                                        19258000
            SET(DB);  <<SET DB TO INITIAL STACK>>                       19260000
            ERRMESSAGE(M27);                                   <<01103>>19262000
            END;                                                        19264000
          TOS := SECPERTRK (STYPE);                            <<25.02>>19266000
          ASSEMBLE(DIV,XCH);                                            19268000
          TOS := TOS&LSL(8)+HEADBASE(STYPE)+TOS;  <<HEAD/SECTOR>>       19270000
          DS6 := TOS;                                                   19272000
        END <<L'PADR>> ;                                                19274000
        DOUBLE SUBROUTINE CONVERTADR(PHYSADR);                          19276000
        VALUE PHYSADR;                                                  19278000
        DOUBLE PHYSADR;  <<PHYSICAL DISC ADDRESS>>                      19280000
        BEGIN                                                           19282000
          TOS := PHYSADR;                                               19284000
          TOS := S0;                                                    19286000
          TOS := (TOS - HEADBASE(STYPE))& LSR(8) *             <<25.02>>19288000
            SECPERTRK (STYPE);                                 <<25.02>>19290000
          ASSEMBLE(XCH);                                                19292000
          TOS := TOS.(8:8);  <<SECTOR #>>                               19294000
          ASSEMBLE(ADD,ZERO; XCH,CAB);                                  19296000
          TOS := SEC'CYL(X);                                            19298000
          ASSEMBLE(LMPY,DADD);                                          19300000
          DS6 := TOS;  <<SECTOR ADDRESS>>                               19302000
        END <<CONVERTADR>> ;                                            19304000
        SUBROUTINE INITIALIZE(SECTOR,ADRRECSECT,BITS,VERIFY);           19306000
        VALUE SECTOR,ADRRECSECT,BITS,VERIFY;                            19308000
        DOUBLE SECTOR,       <<SECTOR FOR SEEK>>                        19310000
               ADRRECSECT;   <<SECTOR FOR ADDRESS RECORD>>              19312000
        INTEGER BITS;        <<SPARE, DEFECTIVE OR ZERO>>               19314000
        LOGICAL VERIFY;      <<TRUE IF VERIFY COM TO BE EXECUTED>>      19316000
        COMMENT:                                                        19318000
          INITIALIZE IS GENERALLY CALLED WITH DB POINTING               19320000
        TO THE STACK SO INITIALIZE SETS DB TO SIO PROGRAM               19322000
        AREA. DB IS LEFT THERE UPON EXIT FROM INITIALIZE;               19324000
        BEGIN                                                           19326000
          TOS := 0;                                                     19328000
          TOS := ABSOLUTE(SIOPROG);<<INITIALIZE CALLED>>                19330000
          SET(DB);                 <<WITH DB AT STACK>>                 19332000
          PHYSADR := L'PADR(SECTOR);                                    19334000
          SEEK;                                                         19336000
          S(6) := SIOCNTRL;                                             19338000
          S(7) := FILEMASK(STYPE)+4;  <<SPARING ENABLED>>               19340000
          IF VERIFY THEN                                                19342000
            BEGIN                                                       19344000
              MOVE S(8) := VERIFYSIOPROG,(4);                           19346000
              S(9) := VFY+UNIT;                                         19348000
              S(11) := XCNTABSADR;                                      19350000
              XCNT := 1;  <<VERIFY ONE SECTOR>>                         19352000
              N := 12;  <<SIO PROG INDEX>>                              19354000
            END                                                         19356000
          ELSE N := 8;                                                  19358000
          MOVE S(N) := INITSIOPROG,(12);                                19360000
                                                               <<25.03>>19362000
          S(N+3) := ALTABSADR;    <<ADDRESS RECORD ADDRESS>>            19364000
          ALTADR2 := 0;                                                 19366000
          IF ADRRECSECT=-1D THEN ALTADR1 := -1                          19368000
          ELSE IF ADRRECSECT=0D THEN ALTADR1 := 0                       19370000
          ELSE ALTADR := L'PADR(ADRRECSECT);                            19372000
          TOS := INITCOM+UNIT;                                          19374000
          TOS.(0:3) := S3;  <<BITS>>                                    19376000
          S(N+5) := TOS;                                                19378000
                                                               <<25.03>>19380000
  << MUST INITIALIZE ENTIRE TRACK.  DEFAULT WORD COUNT           25.03  19382000
     = 6144 (48 SECTORS).  IF DISC = 7925, ONE TRACK = 64        25.03  19384000
     SECTORS, SO ADJUST WORD COUNT ACCORDINGLY.                  25.03>>19386000
                                                               <<25.03>>19388000
          IF STYPE = S7925 THEN S(N+8) := %60000;              <<25.03>>19390000
          IF EXANWAIT(N+12,TRUE).ERRCODE<>0 THEN GOTO GETERRSTAT;       19392000
        END <<INITIALIZE>> ;                                            19394000
                                                                        19396000
          CC := CCE;                                           <<01889>>19398000
          IF FUNCT = NON'FATAL'READ THEN FUNCT := READ;        <<01889>>19400000
          IF ON'ICS THEN                                       <<03603>>19402000
            BEGIN                                              <<03603>>19404000
            TOS := 0;  << BANK 0 >>                            <<03603>>19406000
            TOS := ABS(QI); << DB REGISTER TO QI >>            <<03603>>19408000
            END                                                <<03603>>19410000
          ELSE                                                          19412000
            BEGIN <<LOAD STACK DB POINTER>>                             19414000
            TOS := ABSOLUTE(DBBANK);                                    19416000
            TOS := ABSOLUTE(DB);                                        19418000
            END;                                                        19420000
          ASSEMBLE(DDUP,DDUP;XCHD);  <<SET DB TO STACK>>       <<03603>>19422000
          OLDDB := TOS;  <<SAVE OLD DB>>                       <<03603>>19424000
          SBANK := S1; << STACK WE ARE CURRENTLY RUNNING ON >> <<03603>>19426000
          STATWORDABSADR := S0 + @STATWORDS;<<SAVE ABS ADDR>>           19428000
          SYNRETABSADR := S0 + @SYNRET;                                 19430000
          PHYSABSADR := S0 + @PHYSADR;                                  19432000
          XCNTABSADR := S0 + @XCNT;                                     19434000
          ALTABSADR  := S0 + @ALTADR;                                   19436000
          TOS := TOS + @TBUF;                                           19440000
          TBUFA := TOS;  <<ABSOLUTE ADDRESS OF TBUF>>                   19442000
          TOS := 0;                                                     19444000
          TOS := ABSOLUTE(SIOPROG);                                     19446000
          SET(DB);                                                      19448000
          DRT := DRTUNIT.DRTFIELD;                             <<03002>>19452000
          UNIT := DRTUNIT.UNITFIELD;                           <<03002>>19454000
          IF GETSTATUS.ERRCODE<>WUPERR THEN GOTO ERROR;        <<00.06>>19456000
                                                               <<03549>>19458000
          IF FUNCT = INIT'DEV THEN   << INITIALIZE DONE BY  >> <<03715>>19460000
             BEGIN                   <<     READING STATUS  >> <<03715>>19462000
             IF STATWORD2.NOTRDY THEN                          <<03715>>19464000
                CC := CCL;    << RETURN CCL IF OFFLINE >>      <<03715>>19466000
             GO EXIT;                                          <<03715>>19468000
             END;                                              <<03715>>19470000
                                                               <<03549>>19472000
          IF FUNCT = RSTAT THEN  <<REQUEST STATUS>>            <<RH.PV>>19474000
            BEGIN                                              <<RH.PV>>19476000
              TOS := BUF;                                      <<RH.PV>>19478000
              ASSEMBLE(XCHD);  <<SET DB TO BUF>>               <<RH.PV>>19480000
              BUFDB(0) := STATWORD1;                           <<RH.PV>>19482000
              BUFDB(1) := STATWORD2;                           <<RH.PV>>19484000
              ASSEMBLE(XCHD);  <<RESET DB>>                    <<RH.PV>>19486000
              GO EXIT;                                         <<RH.PV>>19488000
            END;                                               <<RH.PV>>19490000
          IF STATWORD2.NOTRDY THEN                                      19492000
            BEGIN  <<DRIVE NOT READY>>                                  19494000
              MESSAGE(M2408,LDEV); << PRINT NOT READY >>       <<01103>>19496000
              TOS := DRT;                                               19498000
  WAITFORINT: ASSEMBLE(TIO 0; BL *-1);                                  19500000
              IF S0.(2:1)<>1 THEN                                       19502000
                BEGIN  <<NO INTERRUPT YET>>                             19504000
                  DEL;                                                  19506000
                  GOTO WAITFORINT;                                      19508000
                END                                                     19510000
              ELSE                                                      19512000
                BEGIN                                                   19514000
                  TOS := %40000;  <<RESET INTERRUPT>>                   19516000
                  ASSEMBLE(CIO 2; BL *-1);                              19518000
                  IF TOS.(13:3)<>UNIT THEN GOTO WAITFORINT;             19520000
                END;                                                    19522000
              DEL;                                                      19524000
            END;                                                        19526000
          IF FUNCT<>3 THEN                                              19528000
            BEGIN  <<NOT FLAG TRACK>>                                   19530000
  AGAIN:      PHYSADR := L'PADR(RECORD);                                19532000
              SEEK;                                                     19534000
              MOVE S(6) := XFERSIOPROG,(8);                             19536000
              TOS := FILEMASK(STYPE);                                   19538000
              IF FUNCT<2 THEN TOS.(13:1) := 1;  <<SPARING ENABLED>>     19540000
              S(7) := TOS;                                              19542000
                                                               <<25.03>>19544000
              S(11) := PHYSABSADR;    <<POINTER TO PHYSICAL ADDRESS>>   19546000
              S(13) := DISKOP(FUNCT)+UNIT;                              19548000
              TOS := WC;                                                19550000
              IF STYPE=4 THEN                                           19552000
                BEGIN  <<CHECK FOR CYLINDER OVERFLOW>>                  19554000
                  TOS := SEC'CYL(STYPE);                                19556000
                  TOS := RECORD;                                        19558000
                  TOS := S2;                                            19560000
                  ASSEMBLE(LDIV,DELB; SUB);                             19562000
                  TOS := TOS&LSL(7);                                    19564000
                  ASSEMBLE(DDUP,LCMP);                                  19566000
                  IF < THEN ASSEMBLE(XCH);                              19568000
                  DELB;                                                 19570000
                END;                                                    19572000
              ASSEMBLE(DUP,DUP);                                        19574000
              CWC := TOS;  <<# OF WORDS TO TRANSFER>>                   19576000
              XCNT := I;  <<BUFFER INDEX>>                              19578000
              RDWRT := SIORDWRT(FUNCT.(15:1));  <<SIO COMMAND>>         19580000
              S(14) := SETBANK;                                         19582000
              S(15) := BUF1;                                            19584000
              X := 16;                                                  19586000
              WHILE TOS>4096 DO                                         19588000
                BEGIN  <<FORM DATA TRANSFER ORDERS>>                    19590000
                  TOS := TOS-4096;                                      19592000
                  S(X) := RDWRT;                                        19594000
                  S(X:=X+1) := BUF2+XCNT;                               19596000
                  X := X+1;                                             19598000
                  TOS := S0;                                            19600000
                  XCNT := XCNT+4096;                                    19602000
                END;                                                    19604000
              TOS := RDWRT;                                             19606000
              ASSEMBLE(TRBC 0; XCH,NEG);                                19608000
              TOS := TOS LAND %7777 LOR TOS;                            19610000
              S(X) := TOS;                                              19612000
              S(X:=X+1) := BUF2+XCNT;                                   19614000
              S(X:=X+1) := SIOJUMPC;                                    19616000
              TOS := X; <<SAVE X REG. FOR AFTER PRIV LOAD>>             19618000
              TOS := ABSOLUTE(SIOPROG)+8;<<PT TO ADDRESS RECORD>>       19620000
              ASSEMBLE(XCH);                                            19622000
              X := TOS+1;                                               19624000
              S(X) := TOS;                                              19626000
              S(X:=X+1) := SIOCNTRL;                                    19628000
              S(X:=X+1) := ENDOP;                                       19630000
              IF (CONSTAT:=EXANWAIT(X+1,TRUE).ERRCODE)<>0 THEN          19632000
                BEGIN  <<ERROR>>                                        19634000
                  IF CONSTAT=CDERR THEN                                 19636000
                    BEGIN  <<CORRECTABLE DATA ERROR>>                   19638000
                      MOVE S := REQSYNSIOPROG,(14);            <<00.06>>19640000
                                                               <<25.03>>19642000
                      S(3) := SBANK;                           <<03603>>19644000
                      S(5) := SYNRETABSADR;                             19646000
                      S(7) := REQSTAT+UNIT;        <<CAUSE UNIT>>       19648000
                      S(9) := ABSOLUTE(SIOPROG)+15;<<TO BE RETURNED>>   19650000
                      S(11) := SETWAKE+UNIT;                   <<00.06>>19652000
                      IF EXANWAIT(14,TRUE).ERRCODE<>WUPERR THEN<<00.06>>19654000
                       GO TO GETERRSTAT;                                19656000
                      IF SYNRET.ERRCODE=CDERR THEN                      19658000
                        BEGIN  <<CORRECT ERROR>>                        19660000
                          TOS := CONVERTADR(SYNADR)-RECORD;             19662000
                          XCNT := TOS&LSL(7);                           19664000
                          N := TOS;  <<ZERO>>                           19666000
                          TOS := XCNT+SYNRET(3);  <<DISPLACEMENT>>      19668000
                          ASSEMBLE(DUP,NEG);                            19670000
                          BUFCNT := TOS+CWC;  <<BUFFER LIMIT>>          19672000
                          INDEX := TOS;  <<BUFFER INDEX>>               19674000
                          TOS := BUF;                                   19676000
                          ASSEMBLE(XCHD); <<SET DB TO BUF>>             19678000
                          DO IF 0<=(SYNRET(3)+N)<=127 AND (BUFCNT-N)>0  19680000
                            THEN BUFDB(X) := LOGICAL(SYNRET(4+N)) XOR   19682000
                            BUFDB(I+N+INDEX)                            19684000
                          UNTIL (N:=N+1)=3;                             19686000
                          ASSEMBLE(XCHD);  <<RESET DB>>                 19688000
                          CWC := XCNT+128;                              19690000
                          GOTO CONTXFER;                                19692000
                        END;                                            19694000
                      STATWORD1 := SYNRET;                              19696000
                      GOTO UNCORRECTABLE;                               19698000
                    END;                                                19700000
                  IF CONSTAT=SPT THEN                                   19702000
                    BEGIN  <<SPARE TRACK>>                              19704000
                      TOS := ABSOLUTE(DBBANK);                          19706000
                      TOS := ABSOLUTE(DB);                              19708000
                      SET(DB); <<SET DB TO STACK FOR CALL TO ALTTRACK>> 19710000
                      TOS := 0;                                         19712000
                      TOS := LDEV;                                      19714000
                      TOS := RECORD;                                    19716000
                      TOS := SECPERTRK (STYPE);                <<25.02>>19718000
                      ASSEMBLE(LDIV,DEL);                               19720000
                      TOS := ALTTRACK(*,*);  <<GET ALTERNATE ADDRESS>>  19722000
                      IF TOS >= 0 THEN                                  19724000
                        BEGIN  <<A FORMER SPARE TRACK>>                 19726000
                          IF CYLADR>=DTT(DTTLPS) THEN INITIALIZE(RECORD,19728000
                            0D,SP,0)  <<SPARE TRACK>>                   19730000
                          ELSE INITIALIZE(RECORD,RECORD,0,0); <<NORMAL>>19732000
                          CC := CCE;  <<OK>>                            19734000
                        END                                             19736000
                      ELSE                                              19738000
                        BEGIN  <<DEFECTIVE>>                            19740000
  DEFECTIVE:              IF CYLADR>=DTT(DTTLPS) THEN INITIALIZE(RECORD,19742000
                            -1D,SP,0)   <<DEFECTIVE IN SPARE AREA>>     19744000
                          ELSE INITIALIZE(RECORD,-1D,D,0);              19746000
                          CC := CCL;                                    19748000
                        END;                                            19750000
                      GO EXIT;                                          19752000
                    END;                                                19754000
                  IF CONSTAT=TFD THEN GOTO DEFECTIVE; <<FLAGGED TRACK>> 19756000
  GETERRSTAT:      IF GETSTATUS.ERRCODE<>WUPERR THEN           <<00.06>>19758000
                     GOTO PRINTERR;                            <<00.06>>19760000
  ERROR: IF LDEV=0 THEN ASSEMBLE(HALT 5);  <<IN BOOTSTRAP>>    <<2B.00>>19762000
                  IF 7<=CONSTAT<=%11 THEN                               19764000
                    BEGIN  <<TRACK SPECIFIC ERROR>>                     19766000
  UNCORRECTABLE:      IF FUNCT=2 THEN                                   19768000
                        BEGIN  <<RETURN CCG>>                           19770000
                          CC := CCG;                                    19772000
                          GO EXIT;                                      19774000
                        END;                                            19776000
                      TOS := CONVERTADR(SYNADR);                        19778000
                      TOS := SECPERTRK (STYPE);                <<25.02>>19780000
                      ASSEMBLE(LDIV,DEL);  <<TRACK #>>                  19782000
                      TOS := TOS&LSL(2);                                19784000
                      IF <> THEN                                        19786000
                        BEGIN  <<ADD TO DEFECTIVE TRACKS TABLE>>        19788000
                          IF STATWORD1.(0:1) THEN TOS:=TOS+1;<<SPARE>>  19790000
                          TRACK := TOS;                                 19792000
                          MH7905'SIO(LDEV,DRTUNIT,STYPE,0,1D,  <<02510>>19794000
                            TBUFA,128);                        <<02510>>19796000
                          TOS := TBUFA;                                 19798000
                          ASSEMBLE(XCHD); <<SET DB TO TBUF>>            19800000
                          X := 0;                                       19802000
                          WHILE (X:=X+1)<=TBUFDB DO                     19804000
                          IF TBUFDB(X)= TRACK  THEN GOTO PRINTERR;      19806000
                          IF X>120 THEN GOTO PRINTERR;                  19808000
                          TBUFDB := TBUFDB+1;                           19810000
                          TBUFDB(X) := TRACK;                           19812000
                          MH7905'SIO(LDEV,DRTUNIT,STYPE,1,1D,  <<02510>>19814000
                            TBUFA,128);                        <<02510>>19816000
                        END;                                            19818000
                    END;                                                19820000
  PRINTERR:       DISCERROR(LDEV,STATWORD1,CONVERTADR(SYNADR),0,FUNCT.  19822000
                   (15:1),IF INTEGER(STATWORD2)<0 THEN STATWORD2 ELSE   19824000
                   0);                                                  19826000
                END;                                                    19828000
              IF FUNCT=2 THEN                                           19830000
                BEGIN  <<TYPE 2 READ - OK>>                             19832000
                  TOS := ABSOLUTE(DBBANK);                              19834000
                  TOS := ABSOLUTE(DB);                                  19836000
                  ASSEMBLE(XCHD); <<SET DB TO STACK>>                   19838000
                  CC := CCE;                                            19840000
                  IF CYLADR>DTT(DTTLPS) THEN INITIALIZE(RECORD,0D,SP,   19842000
                    0);  <<FLAG AS SPARE>>                              19844000
                  GO EXIT;                                              19846000
                END;                                                    19848000
  CONTXFER:   I := I+CWC;                                               19850000
              WC := WC-CWC;                                             19852000
              IF <= THEN GO EXIT;                                       19854000
              TOS := 0;                                                 19856000
              TOS := (CWC+127)&LSR(7);                                  19858000
              RECORD := TOS+RECORD;                                     19860000
              GOTO AGAIN;                                               19862000
            END                                                         19864000
          ELSE                                                          19866000
            BEGIN  <<FLAG A TRACK DEFECTIVE>>                  <<00888>>19868000
              TOS := BUF;                                      <<00888>>19870000
              ASSEMBLE(LSEA;DELB,DELB);                        <<00888>>19872000
              IF S0<>-1 THEN                                   <<00888>>19874000
                BEGIN <<POINT ALTERNATE AT DEFECTIVE TRACK>>   <<00888>>19876000
                TOS := TOS ** LOGICAL (SECPERTRK (STYPE));     <<00888>>19878000
                INITIALIZE(*,RECORD,SP,0);                     <<00888>>19880000
                END;                                           <<00888>>19882000
              TOS := ABSOLUTE(DBBANK);                         <<00888>>19884000
              TOS := ABSOLUTE(DB);                             <<00888>>19886000
              ASSEMBLE(XCHD;DDEL); <<SET DB TO STACK>>         <<00888>>19888000
              TOS := 0;                                        <<00888>>19890000
              TOS := LDEV;                                     <<00888>>19892000
              TOS := RECORD;                                   <<00888>>19894000
              TOS := SECPERTRK (STYPE);                        <<00888>>19896000
              ASSEMBLE(LDIV,DEL);  <<TRACK #>>                 <<00888>>19898000
              TOS := ALTTRACK(*,*);                            <<00888>>19900000
              IF TOS<>-1 THEN                                  <<00888>>19902000
                BEGIN <<GARBAGE FORMER SPARE TRACK>>           <<00888>>19904000
                INITIALIZE(RECORD,-1D,SP,1);                   <<00888>>19906000
                TOS := ABSOLUTE(DBBANK);                       <<00888>>19908000
                TOS := ABSOLUTE(DB);                           <<00888>>19910000
                ASSEMBLE(XCHD;DDEL);<<RESET DB >>              <<00888>>19912000
                END;                                           <<00888>>19914000
              TOS := RECORD;                                   <<00888>>19916000
              TOS := BUF;                                      <<00888>>19918000
              ASSEMBLE(LSEA;DELB,DELB);                        <<00888>>19920000
              IF S0=-1 THEN                                    <<00888>>19922000
                BEGIN  <<DELETE>>                              <<00888>>19924000
                  DEL;                                         <<00888>>19926000
                  PHYSADR := L'PADR(RECORD);                   <<00888>>19928000
                  TOS := -1D;                                  <<00888>>19930000
                  IF CYLADR >= DTT(DTTLPS) THEN TOS := SP ELSE TOS := D;19932000
                END                                            <<00888>>19934000
              ELSE                                             <<00888>>19936000
                BEGIN  <<REASSIGN>>                            <<00888>>19938000
                  TOS := TOS ** LOGICAL (SECPERTRK (STYPE));   <<00888>>19940000
                  TOS := D;                                    <<00888>>19942000
                END;                                           <<00888>>19944000
              INITIALIZE(*,*,*,0);                             <<00888>>19946000
            END;                                               <<00888>>19948000
  EXIT:   TOS := OLDDB;                                        <<00888>>19950000
          ASSEMBLE(XCHD); <<SET DB TO OLD DB>>                 <<00888>>19952000
      END <<MH7905>> ;                                         <<00888>>19954000
$IF   << ******** RETURNING TO COMMON CODE ******** >>         <<02510>>19956000
$PAGE                                                          <<03550>>19960000
$CONTROL SEGMENT=RESIDENT                                      <<03550>>19962000
         <<------------------------------>>                    <<03550>>19964000
         <<     CS'80 DEVICE DRIVER      >>                    <<03550>>19966000
         <<------------------------------>>                    <<03550>>19968000
PROCEDURE CS80'DRIVER(LDEV,DRTUNIT,STYPE,FUNCT,RECORD,BUF,WC); <<03550>>19970000
VALUE LDEV,DRTUNIT,STYPE,FUNCT,RECORD,BUF,WC;                  <<03550>>19972000
INTEGER                                                        <<03550>>19974000
   DRTUNIT,    << DRT (HIGH 9 BITS) AND UNIT (LOW 7 BITS) >>   <<03668>>19976000
   LDEV,       << LOGICAL DEVICE NUMBER >>                     <<03550>>19978000
   STYPE,      << DEVICE SUBTYPE >>                            <<03550>>19980000
   WC;         << NO. OF WORDS TO READ/WRITE >>                <<03550>>19982000
               << NOTE: THIS DRIVER ABORTS IF THE    >>        <<03668>>19984000
               << WORD COUNT EXCEEDS 32K-1           >>        <<03668>>19986000
               << (%77777) FOR ONE TRANSFER          >>        <<03550>>19988000
                                                               <<03550>>19990000
LOGICAL                                                        <<03550>>19992000
   FUNCT;      <<    DRIVER FUNCTION CODE              >>      <<03672>>19994000
               <<  ** NOTE--THOSE FUNCTIONS MARKED     >>      <<03672>>19996000
               <<  '+' ARE USED INTERNALLY ONLY, AND   >>      <<03672>>19998000
               <<  SHOULD NOT BE USED IN CALLING THIS  >>      <<03672>>20000000
               <<  DRIVER.  THE FUNCTIONS MARKED 'N'   >>      <<03672>>20002000
               <<  ARE NON-FATAL, AND DO NOT ABORT ON  >>      <<03672>>20004000
               <<  UNRECOVERABLE ERRORS, BUT RETURN    >>      <<03672>>20006000
               <<  CCL INSTEAD.  SEE SUBROUTINE        >>      <<03672>>20008000
               <<  FATAL'FUNCT.                        >>      <<03672>>20010000
               <<     0      READ                      >>      <<03672>>20012000
               <<     1      WRITE                     >>      <<03672>>20014000
               <<     2      ***UNUSED***              >>      <<03672>>20016000
               <<     3      ***UNUSED***              >>      <<03672>>20018000
               <<     4      ***UNUSED***              >>      <<03672>>20020000
               <<     5    N READ STATUS               >>      <<03672>>20022000
               <<     6    N NON-FATAL READ            >>      <<03672>>20024000
               <<     7    N INITIALIZE DEVICE         >>      <<03715>>20026000
               <<     8    + RELEASE                   >>      <<03672>>20028000
               <<     9    + DENY RELEASE              >>      <<03672>>20030000
               <<    10      DEVICE CLEAR              >>      <<03715>>20032000
               <<    11      SUPPRESS RELEASE TIMEOUT  >>      <<03672>>20034000
               <<    12    N ENABLE RELEASE TIMEOUT    >>      <<03715>>20036000
               <<    13      GET VOLUME LIMIT          >>      <<03672>>20038000
               <<    14      RECOVERY READ             >>      <<03672>>20040000
               <<    15      SPARE RETAINING DATA      >>      <<03672>>20042000
               <<    16      SPARE NOT RETAINING DATA  >>      <<03672>>20044000
               <<    17      DESCRIBE                  >>      <<03672>>20046000
               <<    18      R/W ERT                   >>      <<03672>>20048000
               <<    19      READ SPARE TABLE          >>      <<03672>>20050000
               <<    20    + DSCT READ                 >>      <<03672>>20052000
               <<    21    + DSCT WRITE                >>      <<03672>>20054000
               <<    22      INTERNAL DIAGNOSTIC       >>      <<03672>>20056000
               <<    23      R/O ERT                   >>      <<03672>>20058000
               <<    24    N CLEAR STATUS              >>      <<03672>>20060000
               <<    25    + READ STATUS               >>      <<03672>>20062000
               <<    26    N UNLOAD TAPE               >>      <<03715>>20064000
                                                               <<03550>>20066000
DOUBLE                                                         <<03550>>20068000
   RECORD,      << LOGICAL DISC ADDRESS >>                     <<03550>>20070000
   BUF;         << ABSOLUTE ADDRESS OF R/W BUFFER >>           <<03550>>20072000
                                                               <<03550>>20074000
COMMENT                                                        <<03550>>20076000
CS80'DRIVER IS THE COMMAND SET '80 DEVICE DRIVER.  IT IS USED  <<03550>>20078000
TO TALK TO THE 7911, 7912, 7935, LINUS, AND ALL OTHER CS'80    <<03550>>20080000
DEVICES.                                                       <<03550>>20082000
                                                               <<03550>>20084000
                                                               <<03550>>20086000
                                                               <<03550>>20088000
;                                                              <<03550>>20090000
                                                               <<03550>>20092000
BEGIN                                                          <<03550>>20094000
                                                               <<03550>>20096000
<< CHANNEL PROGRAM OFFSETS >>                                  <<03550>>20098000
                                                               <<03550>>20100000
EQUATE                                                         <<03550>>20102000
   BRANCHPT       = 1,  << BRANCH POINT OFFSET >>              <<03550>>20104000
   DXFER          =  2, << DATA XFER SECTION OFFSET >>         <<03668>>20108000
   STATX          = 23, << READ STATUS OFFSET >>               <<03668>>20110000
   DIAG           = 46, << DIAG SECTION OFFSET >>              <<03668>>20112000
   PON            = 60, << POWER ON OFFSET >>                  <<03668>>20114000
   PON'HALT       = PON+9,                                     <<03668>>20116000
   STAT'AREA      = 73, <<START OF STATUS RETURN AREA>>        <<03668>>20118000
   CDB'AREA'WRD   = 83, <<START OF COMMAND DATA BYTES>>        <<03668>>20120000
   CDB'AREA'BYTE  = CDB'AREA'WRD*2,                            <<03668>>20122000
   STAT'CDB       = 72; << STATUS COMMAND OFFSET >>            <<03668>>20124000
                                                               <<03550>>20126000
<< MISCELLANEOUS DEFINES >>                                    <<03550>>20128000
                                                               <<03550>>20130000
DEFINE                                                         <<03550>>20132000
   CHAN'PROG'BASE = ABS(CHANPROG)#,   <<ABS. BASE ADDR OF CP>> <<03550>>20136000
   CPVAP = ABS(GETDRT(DRT,DBI))#,                              <<03550>>20138000
   ERRCODE = (0:3)#;                                           <<03550>>20140000
                                                               <<03550>>20142000
<< DRIVER FUNCTION CODES >>                                    <<03550>>20144000
                                                               <<03550>>20146000
EQUATE                                                         <<03550>>20148000
   MAX'FUNCT        = 26,    << MAXIMUM FUNCTION NO. USED >>   <<03672>>20150000
   NUM'FUNCTS       = MAX'FUNCT + 1,                           <<03550>>20152000
   RELEASE          = 8,     << RELEASE >>                     <<03550>>20154000
   RELEASE'DENY     = 9,     << DENY RELEASE REQUEST >>        <<03550>>20156000
   CLEAR            = 10,    << SELECTED DEVICE CLEAR >>       <<03550>>20158000
   SUPP'RELEASE     = 11,    << SUPPRESS RELEASE TIMEOUT >>    <<03672>>20160000
   ENAB'RELEASE     = 12,    << ENABLE RELEASE TIMEOUT >>      <<03672>>20162000
   GET'VOL'LIMIT    = 13,    << GET VOLUME LIMIT >>            <<03550>>20164000
   RECOV'READ       = 14,    << READ--TRY TO RECOVER DATA >>   <<03550>>20166000
   SPARE'RETAIN     = 15,    << SPARE RETAINING DATA >>        <<03550>>20168000
   SPARE'NO'RETAIN  = 16,    << SPARE NOT RETAINING DATA >>    <<03550>>20170000
   DESCRIBE         = 17,    << GET DESCRIBE INFO. >>          <<03550>>20172000
   RW'ERT           = 18,    << DO READ/WRITE ERT >>           <<03550>>20174000
   READ'SPARES      = 19,    << READ SPARE TABLE >>            <<03550>>20176000
   DSCT'READ        = 20,    << READ DEFECTIVE SECTOR TABLE >> <<03550>>20178000
   DSCT'WRITE       = 21,    << WRITE DEFECTIVE SECTOR TABLE>> <<03550>>20180000
   DIAGNOSTIC       = 22,    << INTERNAL DIAGNOSTIC >>         <<03550>>20182000
   RO'ERT           = 23,    << READ ONLY ERT >>               <<03668>>20184000
   CLEAR'STAT       = 24,    << READ AND CLEAR STATUS >>       <<03668>>20186000
   GET'STAT         = 25,    << READ STATUS >>                 <<03672>>20188000
   UNLOAD           = 26;    << UNLOAD TAPE >>                 <<03672>>20190000
                                                               <<03550>>20192000
<< MODIFIED CHANNEL PROGRAM WORDS >>                           <<03550>>20194000
                                                               <<03550>>20196000
EQUATE                                                         <<03550>>20198000
   DX'CMD'MSGLEN      = DXFER+1,                               <<03550>>20200000
   DX'CMD'AREA'ADR    = DXFER+4,                               <<03550>>20202000
   DX'5               = DXFER+5,                               <<03550>>20204000
   DX'6               = DXFER+6,                               <<03550>>20206000
   DX'EXEC'SEC        = DXFER+7,                               <<03550>>20208000
   DX'COUNT           = DXFER+8,                               <<03550>>20210000
   DX'DATA'BANK       = DXFER+10,                              <<03550>>20212000
   DX'DATA'ADR        = DXFER+11,                              <<03550>>20214000
   DIAG'CMD'MSGLEN    = DIAG+1,                                <<03550>>20216000
   DIAG'CMD'AREA'ADR  = DIAG+4,                                <<03550>>20218000
   DIAG'NORMAL'JUMP   = DIAG+9,                                <<03550>>20220000
   DIAG'HALT'CODE     = DIAG+13,                               <<03550>>20224000
   STATX'CMD'ADR      = STATX+4,                               <<03550>>20226000
   STATX'DATA'ADR     = STATX+11,                              <<03550>>20228000
   STATX'HALT'CODE    = STATX+20,                              <<03550>>20232000
   STATX'FAIL'CODE    = STATX+22,                              <<03672>>20234000
   PON'HALT'CODE      = PON+10;                                <<03550>>20236000
                                                               <<03550>>20238000
<< MISCELLANEOUS EQUATES >>                                    <<03550>>20240000
                                                               <<03550>>20242000
EQUATE                                                         <<03550>>20244000
   CPSIZE =  98,            << CHANNEL PROGRAM SIZE >>         <<03668>>20246000
   STATUS'RETURN'SIZE = 20, <<SIZE OF STATUS RETURN (BYTES) >> <<03668>>20248000
   STAT'SIZE          = (STATUS'RETURN'SIZE+1)/2,              <<03668>>20250000
   MAX'DESC'BYTE      = 37, <<MAX # DESCRIBE BYTES >>          <<03550>>20252000
   ERT'RETURN         = 10, <<MAX # BYTES RETURN FROM ERT >>   <<03550>>20254000
   SNGL'VEC'LIMIT     = 15, <<VOL. LIMIT ADDRESS IN DESCRIBE>> <<03550>>20256000
   READ'MSGLEN        = 15, <<LENGTH OF READ COMMAND>>         <<03550>>20258000
   WRITE'MSGLEN       = 15, <<LENGTH OF WRITE COMMAND>>        <<03550>>20260000
   CTRL'UNIT          = %17,  << CONTROLLER UNIT NO. >>        <<03550>>20262000
   READ'EXEC'SEC      = %1416,                                 <<03550>>20264000
   WRITE'EXEC'SEC     = %2016;                                 <<03550>>20266000
                                                               <<03550>>20268000
<< CS'80 FUNCTION CODES >>                                     <<03550>>20270000
                                                               <<03550>>20272000
EQUATE                                                         <<03550>>20274000
   CDB'DESCRIBE       = %65,                                   <<03550>>20276000
   CDB'INIT'DIAG      = %63,                                   <<03550>>20278000
   CDB'INIT'UTIL      = %60,                                   <<03550>>20280000
   CDB'READ           = 0,                                     <<03550>>20282000
   CDB'RELEASE        = %16,                                   <<03550>>20284000
   CDB'RELEASE'DENY   = %17,                                   <<03550>>20286000
   CDB'SET'LENGTH     = %30,                                   <<03550>>20288000
   CDB'SET'RELEASE    = %73,                                   <<03550>>20290000
   CDB'SET'SNGL'VEC   = %20,                                   <<03550>>20292000
   CDB'SET'UNIT       = %40,                                   <<03550>>20294000
   CDB'SET'VOL        = %100,                                  <<03550>>20296000
   CDB'SPARE'BLK      = %6,                                    <<03550>>20298000
   CDB'UNLOAD         = %112,                                  <<03672>>20300000
   CDB'WRITE          = %2;                                    <<03550>>20302000
                                                               <<03550>>20304000
<< CHANNEL PROGRAM BRANCH POINTS >>                            <<03550>>20306000
                                                               <<03550>>20308000
EQUATE                                                         <<03550>>20310000
   DXFERCP     = DXFER-BRANCHPT-1,                             <<03550>>20314000
                                                               <<03550>>20316000
   DIAGCP      = DIAG-BRANCHPT-1,                              <<03550>>20318000
   PONCP       = PON-BRANCHPT-1;                               <<03550>>20320000
                                                               <<03550>>20322000
<< STATUS RETURN INDICES >>                                    <<03550>>20324000
                                                               <<03550>>20326000
EQUATE                                                         <<03550>>20328000
   ID'FIELD      = 0,                                          <<03550>>20330000
   REJECT'FIELD  = 1,                                          <<03550>>20332000
   FAULT'FIELD   = 2,                                          <<03550>>20334000
   ACCESS'FIELD  = 3,                                          <<03550>>20336000
   INFOR'FIELD   = 4,                                          <<03550>>20338000
   PARM'FIELD    = 5;                                          <<03550>>20340000
                                                               <<03550>>20342000
<< STATUS RETURN FIELDS >>                                     <<03550>>20344000
                                                               <<03550>>20346000
DEFINE                                                         <<03550>>20348000
                                                               <<03550>>20350000
             << ID'FIELD >>                                    <<03550>>20352000
                                                               <<03550>>20354000
   UNIT'ATTN        = (8:8)#,    <<UNIT ATTENTION>>            <<03550>>20356000
                                                               <<03550>>20358000
             << REJECT'FIELD >>                                <<03550>>20360000
                                                               <<03550>>20362000
   CHAN'PARITY      = (2:1)#,    <<CHANNEL PARITY>>            <<03715>>20364000
   ILLEG'OPCODE     = (5:1)#,    <<ILLEGAL OPCODE>>            <<03715>>20366000
   MOD'ADDR'ERR     = (6:1)#,    <<MODULE ADDR ERROR>>         <<03715>>20368000
   ADDR'BOUND       = (7:1)#,    <<ADDRESS BOUNDS>>            <<03715>>20370000
   PARM'BOUND       = (8:1)#,    <<PARAMETER BOUNDS>>          <<03715>>20372000
   ILLEG'PARM       = (9:1)#,    <<ILLEGAL PARAMETER>>         <<03715>>20374000
   MSG'SEQ'VIOL     =(10:1)#,    <<MSG SEQ VIOLATION>>         <<03715>>20376000
   MSG'LEN'DIFF     =(12:1)#,    <<MSG LENGTH DIFFER>>         <<03715>>20378000
                                                               <<03550>>20380000
             << FAULT'FIELD >>                                 <<03550>>20382000
                                                               <<03550>>20384000
   CROSS'UNIT       = (1:1)#,    <<ERROR DURING COPY OPER>>    <<03715>>20386000
   CTRL'FAULT       = (3:1)#,    <<CONTROLLER FAULT>>          <<03715>>20388000
   UNIT'FAULT       = (6:1)#,    <<UNIT FAULT>>                <<03715>>20390000
   DIAG'FAILED      = (8:1)#,    <<DIAGNOSTIC FAILED>>         <<03715>>20392000
   OPER'REL'REQRD   =(10:1)#,    <<OPER REL REQUIRED>>         <<03715>>20394000
   DIAG'REL'REQRD   =(11:1)#,    <<DIAG REL REQUIRED>>         <<03715>>20396000
   INT'MAINT'REQRD  =(12:1)#,    <<INT MAINT REQUIRED>>        <<03715>>20398000
   POWER'FAIL       =(14:1)#,    <<POWER FAIL>>                <<03715>>20400000
   RETRANSMIT       =(15:1)#,    <<RETRY REQUIRED>>            <<03715>>20402000
                                                               <<03550>>20404000
             << ACCESS'FIELD >>                                <<03550>>20406000
                                                               <<03550>>20408000
   ILLEG'PAR'OPER   = (0:1)#,    <<ILLEGAL // OPER>>           <<03715>>20410000
   UNINIT'MEDIA     = (1:1)#,    <<UNINITIALIZED MEDIA>>       <<03715>>20412000
   NO'SPARE'AVAIL   = (2:1)#,    <<NO SPARE AVAILABLE>>        <<03715>>20414000
   DEV'NOT'RDY      = (3:1)#,    <<DEVICE NOT READY>>          <<03715>>20416000
   WRT'PROTECT      = (4:1)#,    <<WRITE PROTECTED>>           <<03715>>20418000
   NO'DATA'FOUND    = (5:1)#,    <<NO DATA FOUND>>             <<03715>>20420000
   UNRECOV'DATA'OV  = (8:1)#,    <<UNRECOV DATA OVERFLOW>>     <<03715>>20422000
   UNRECOV'DATA     = (9:1)#,    <<UNRECOV DATA>>              <<03715>>20424000
   END'OF'FILE      =(11:1)#,    <<END OF FILE>>               <<03715>>20426000
   END'OF'VOLUME    =(12:1)#,    <<END OF VOLUME>>             <<03715>>20428000
                                                               <<03550>>20430000
             << INFOR'FIELD >>                                 <<03550>>20432000
                                                               <<03550>>20434000
   OPER'REL'REQST   = (0:1)#,    <<OPER RELEASE REQUEST>>      <<03715>>20436000
   DIAG'REL'REQST   = (1:1)#,    <<DIAG RELEASE REQUEST>>      <<03715>>20438000
   INT'MAINT'REQST  = (2:1)#,    <<INT MAINT REQUEST>>         <<03715>>20440000
   MEDIA'WEARING    = (3:1)#,    <<MEDIA WEARING OUT>>         <<03715>>20442000
   DATA'OVERRUN     = (4:1)#,    <<DATA OVERRUN>>              <<03715>>20444000
   DEF'BLK'SPARE    = (7:1)#,    <<DEFEC BLK AUTO SPARED>>     <<03715>>20446000
   RECOV'DATA'OV    = (9:1)#,    <<RECOV DATA OVERFLOW>>       <<03715>>20448000
   MARGINAL'DATA    =(10:1)#,    <<MARGINAL DATA>>             <<03715>>20450000
   RECOV'DATA       =(11:1)#,    <<RECOVERABLE DATA>>          <<03715>>20452000
   MAINT'TRK'OV     =(13:1)#;    <<MAINT TRACK OVERFLOW>>      <<03715>>20454000
                                                               <<03550>>20456000
INTEGER                                                        <<03550>>20458000
   DATA'BANK = BUF,     << BANK OF DATA BUFFER >>              <<03550>>20460000
   DATA'ADDR = BUF+1,   << BANK OFFSET OF DATA BUFFER >>       <<03550>>20462000
   OLD'STAT'ADDR,       << BANK OFFSET OF OLD'STAT >>          <<03668>>20464000
   STAT'ADDR,           << BANK OFFSET OF STATUS >>            <<03668>>20466000
   LOCAL'BUF'BANK,      << BANK OF LOCAL'BUF >>                <<03550>>20468000
   LOCAL'BUF'ADDR,      << BANK OFFSET OF LOCAL'BUF >>         <<03668>>20470000
   T'BANK,              << TEMP. FOR A BANK NO. >>             <<03668>>20472000
   T'ADDR,              << TEMP. FOR A BANK OFFSET >>          <<03668>>20474000
   CPADDRESS;           << BANK OFFSET OF CP >>                <<03550>>20476000
                                                               <<03550>>20478000
DOUBLE                                                         <<03550>>20480000
   OLDDB,         << SAVED DB ON ENTRY TO THE DRIVER >>        <<03672>>20482000
   STARTIME,      << STARTING TIMEOUT CLOCK VALUE >>           <<03672>>20484000
   CURTIME,       << CURRENT TIMEOUT CLOCK VALUE >>            <<03672>>20486000
   TIMEOUT;       << TIME-OUT VALUE IN MILLISECONDS >>         <<03672>>20488000
                                                               <<03550>>20490000
EQUATE                                                         <<03550>>20492000
   MAX'RETRIES = 25;    << MAXIMUM FOR NUM'RETRIES >>          <<03668>>20494000
                                                               <<03550>>20496000
INTEGER                                                        <<03550>>20498000
   NUM'RETRIES;      << NO. OF CHANNEL PROGRAMS RUN >>         <<03550>>20500000
                     <<    DURING THIS DRIVER CALL  >>         <<03550>>20502000
                                                               <<03550>>20504000
EQUATE                                                         <<03550>>20506000
   STACK'MAX = 0,       << INDEX OF TOP OF COMMAND STACK >>    <<03550>>20508000
   STACK'BOTTOM = 15,   << INDEX OF BOTTOM OF COMMAND STACK >> <<03550>>20510000
   STACK'BOTTOMX = STACK'BOTTOM+1;                             <<03550>>20512000
                                                               <<03550>>20514000
INTEGER                                                        <<03550>>20516000
   POINT := STACK'BOTTOMX;  <<STACK POINTER--INITIALLY EMPTY>> <<03550>>20518000
                                                               <<03550>>20520000
LOGICAL                                                        <<03550>>20522000
   GOOD'COMPLETION,       << TRUE IF CP COMPLETED W/0 ERROR >> <<03668>>20524000
   FIRST'OFFLINE := TRUE, << TRUE IF NOT OFF-LINE YET >>       <<03668>>20526000
   CURFUNCT,      << INDEX FOR CASE STATEMENT >>               <<03550>>20528000
   NEW'RCLK,      << LATEST VALUE OF RCLK >>                   <<03672>>20530000
   LAST'RCLK;     << PREVIOUS VALUE OF RCLK >>                 <<03672>>20532000
                                                               <<03550>>20536000
DOUBLE ARRAY                 << DISC TIMEOUTS FOR EACH      >> <<03672>>20538000
   DISC'TIMEOUT(*) = PB :=   <<   FUNCTION IN MILLISECONDS  >> <<03672>>20540000
<< 0- 4>> 5000D,5000D,0D,0D,0D,                                <<03672>>20542000
<< 5- 9>> 0D,5000D,0D,3000D,3000D,                             <<03672>>20544000
<<10-14>> 45000D,3000D,3000D,0D,5000D,                         <<03672>>20546000
<<15-19>> 15000D,15000D,3000D,15000D,5000D,                    <<03672>>20548000
<<20-24>> 5000D,5000D,45000D,15000D,3000D,                     <<03672>>20550000
<<25-26>> 3000D,0D;                                            <<03672>>20552000
                                                               <<03672>>20554000
DOUBLE ARRAY                 << LINUS TIMEOUTS FOR EACH     >> <<03672>>20556000
   TAPE'TIMEOUT(*) = PB :=   <<   FUNCTION IN MILLISECONDS  >> <<03672>>20558000
<< 0- 4>> 100000D,100000D,0D,0D,0D,                            <<03715>>20560000
<< 5- 9>> 0D,100000D,0D,200000D,12000D,                        <<03715>>20562000
<<10-14>> 100000D,15000D,15000D,0D,100000D,                    <<03715>>20564000
<<15-19>> 0D,0D,15000D,0D,0D,                                  <<03715>>20566000
<<20-24>> 0D,0D,200000D,0D,12000D,                             <<03715>>20568000
<<25-26>> 12000D,5000D;                                        <<03715>>20570000
                                                               <<03550>>20574000
BYTE POINTER                                                   <<03550>>20576000
   TEMP;    << TEMP FOR BYTE ADDRESSING >>                     <<03550>>20578000
                                                               <<03550>>20580000
INTEGER                                                        <<03550>>20582000
   COUNT,   << BYTE COUNT FOR READ/WRITE TRANSFERS >>          <<03550>>20584000
   ERROR,   << ERROR NUMBER >>                                 <<03550>>20586000
   PARM,    << TEMP >>                                         <<03550>>20588000
   I,       << TEMP >>                                         <<03668>>20590000
   DRT,     << DRT OF DISC >>                                  <<03550>>20592000
   UNIT;    << UNIT OF DISC >>                                 <<03550>>20594000
                                                               <<03550>>20596000
ARRAY                                                          <<03550>>20598000
   STACK(STACK'MAX:STACK'BOTTOM),  << DRIVER COMMAND STACK >>  <<03550>>20600000
   LOCAL'BUF(0:18),        << LOCAL BUFFER >>                  <<03550>>20602000
   STATUS(0:9),            << LOCAL STATUS BUFFER >>           <<03550>>20604000
   OLD'STAT(0:9),               << BUFFER FOR SAVED STATUS >>  <<03668>>20606000
   CP(0:CPSIZE-1);         << LOCAL BUFFER FOR CHAN PROG >>    <<03550>>20608000
                                                               <<03550>>20610000
BYTE ARRAY                                                     <<03550>>20612000
   CPB(*) = CP;     << BYTE POINTER FOR CP >>                  <<03550>>20614000
                                                               <<03550>>20616000
$PAGE                                                          <<03550>>20618000
ARRAY CS80'CHAN'PROG(*) = PB :=                                <<03550>>20620000
                                                               <<03550>>20622000
        <<****************************>>                       <<03550>>20624000
        <<      CHANNEL PROGRAM       >>                       <<03550>>20626000
        <<****************************>>                       <<03550>>20628000
                                                               <<03550>>20630000
    << NOTE: A '*' NEXT TO A CHANNEL PROGRAM LOCATION >>       <<03550>>20632000
    << DENOTES A LOCATION WHICH IS (SOMETIMES)        >>       <<03550>>20634000
    << MODIFIED BEFORE EXECUTION.                     >>       <<03550>>20636000
                                                               <<03550>>20638000
<<   0>>       0,  << JUMP TO APPROPRIATE LOCATION >>          <<03550>>20640000
<<*  1>>       0,  << BRANCHPT >>                              <<03550>>20642000
                                                               <<03550>>20644000
  <<***************************************>>                  <<03550>>20680000
  <<   [DXFER] GENERAL PURPOSE COMMANDS    >>                  <<03550>>20682000
  << COMMAND--EXECUTION--REPORTING MESSAGE >>                  <<03550>>20684000
  <<***************************************>>                  <<03550>>20686000
                                                               <<03550>>20688000
<<   0>>   %2005,  << WRITE COMMAND MESSAGE >>                 <<03550>>20690000
<<*  1>>       0,  << COMMAND BUFFER LENGTH >>                 <<03550>>20692000
<<   2>>       0,  << NO BURST >>                              <<03550>>20694000
<<   3>>   %2000,  << COMMAND BUFFER BANK >>                   <<03550>>20696000
<<*  4>>       0,  << COMMAND BUFFER ABSOLUTE ADDRESS >>       <<03550>>20698000
                                                               <<03550>>20700000
<<   5>>   %1000,  << WAIT FOR // POLL RESPONSE >>             <<03550>>20702000
<<   6>>       0,                                              <<03550>>20704000
                                                               <<03550>>20706000
<<*  7>>   %1416,  << EXECUTION MESSAGE SECONDARY >>           <<03550>>20708000
<<*  8>>       0,  << # BYTES TO READ/WRITE >>                 <<03550>>20710000
<<   9>>       0,  << NO BURST >>                              <<03550>>20712000
<<* 10>>       0,  << DATA BANK >>                             <<03550>>20714000
<<* 11>>       0,  << DATA BUFFER ABSOLUTE ADDRESS >>          <<03550>>20716000
                                                               <<03550>>20718000
<<  12>>   %1000,  << WAIT FOR // POLL RESPONSE >>             <<03550>>20720000
<<  13>>       0,                                              <<03550>>20722000
                                                               <<03550>>20724000
<<  14>>   %2402,  << REPORTING MESSAGE >>                     <<03550>>20726000
<<  15>>       0,  << RETURN BYTE >>                           <<03550>>20728000
<<  16>>       0,  << NORMAL COMPLETION >>                     <<03550>>20730000
<<  17>>       2,  << HARD ERROR--REQUEST STATUS >>            <<03550>>20732000
<<  18>>      39,  << POWER ON OCCURRED >>                     <<03550>>20734000
                                                               <<03550>>20736000
<<  19>>    %600,  << INTERRUPT/HALT >>                        <<03550>>20738000
<<  20>>       0,  << HALT CODE OF 0 IN CPVA(0) >>             <<03550>>20740000
                                                               <<03550>>20742000
  <<********************************************>>             <<03550>>20744000
  <<  [STATX] STATUS INTERROGATION SECTION      >>             <<03550>>20746000
  << COMMAND--EXECUTION--REPORTING MESSAGE      >>             <<03550>>20748000
  <<********************************************>>             <<03550>>20750000
                                                               <<03550>>20752000
<<   0>>   %2005,  << COMMAND MESSAGE SECONDARY >>             <<03550>>20754000
<<   1>>       1,  << COMMAND BUFFER LENGTH >>                 <<03550>>20756000
<<   2>>       0,  << NO BURST >>                              <<03550>>20758000
<<   3>>   %2000,  << COMMAND BUFFER BANK >>                   <<03550>>20760000
<<*  4>>       0,  << COMMAND BUFFER ABSOLUTE ADDRESS >>       <<03550>>20762000
                                                               <<03550>>20764000
<<   5>>   %1000,  << WAIT FOR // POLL RESPONSE >>             <<03550>>20766000
<<   6>>       0,                                              <<03550>>20768000
                                                               <<03550>>20770000
<<   7>>   %1416,  << EXECUTION MESSAGE SECONDARY >>           <<03550>>20772000
<<   8>>      20,  << # STATUS BYTES TO READ >>                <<03550>>20774000
<<   9>>       0,  << NO BURST >>                              <<03550>>20776000
<<  10>>       0,  << DATA BANK >>                             <<03550>>20778000
<<* 11>>       0,  << DATA BUFFER ABSOLUTE ADDRESS >>          <<03550>>20780000
                                                               <<03550>>20782000
<<  12>>   %1000,  << WAIT FOR // POLL RESPONSE >>             <<03550>>20784000
<<  13>>       0,                                              <<03550>>20786000
                                                               <<03550>>20788000
<<  14>>   %2402,  << REPORTING MESSAGE SECONDARY >>           <<03550>>20790000
<<  15>>       0,  << RETURN BYTE >>                           <<03550>>20792000
<<  16>>       0,  << NORMAL COMPLETION >>                     <<03550>>20794000
<<  17>>       2,  << HARD ERROR--TERMINATE >>                 <<03550>>20796000
<<  18>>      18,  << POWER ON OCCURRED >>                     <<03668>>20798000
                                                               <<03550>>20800000
<<  19>>    %600,  << INTERRUPT/HALT >>                        <<03550>>20802000
<<* 20>>       1,  << HALT CODE OF 1 IN CPVA(0) >>             <<03550>>20804000
                                                               <<03550>>20806000
<<  21>>    %600,  << INTERRUPT/HALT >>                        <<03550>>20808000
<<* 22>>       3,  << HALT CODE OF 3 IN CPVA(0) >>             <<03672>>20810000
                                                               <<03550>>20812000
  <<************************************************>>         <<03550>>20814000
  << [DIAG] COMPLEMENTARY, GP, DIAG, TRANS COMMANDS >>         <<03550>>20816000
  << COMMAND/TRANS--REPORTING MESSAGE               >>         <<03550>>20818000
  <<************************************************>>         <<03550>>20820000
                                                               <<03550>>20822000
<<   0>>   %2005,  << WRITE COMMAND MESSAGE >>                 <<03550>>20824000
<<*  1>>       0,  << COMMAND BUFFER LENGTH >>                 <<03550>>20826000
<<   2>>       0,  << NO BURST >>                              <<03550>>20828000
<<   3>>   %2000,  << DATA BANK >>                             <<03550>>20830000
<<*  4>>       0,  << COMMAND BUFFER ABS ADDR >>               <<03550>>20832000
                                                               <<03550>>20834000
<<   5>>   %1000,  << WAIT FOR // POLL RESPONSE >>             <<03550>>20836000
<<   6>>       0,                                              <<03550>>20838000
                                                               <<03550>>20840000
<<   7>>   %2402,  << REPORTING MESSAGE SECONDARY >>           <<03550>>20842000
<<   8>>       0,  << RETURN BYTE >>                           <<03550>>20844000
<<*  9>>       0,  << NORMAL COMPLETION >>                     <<03550>>20846000
<<  10>>     -35,  << HARD ERROR--REQUEST STATUS >>            <<03550>>20848000
<<  11>>       2,  << POWER ON OCCURRED >>                     <<03668>>20850000
                                                               <<03550>>20852000
<<  12>>    %600,  << INTERRUPT/HALT >>                        <<03550>>20854000
<<* 13>>       0,  << HALT CODE OF 0 IN CPVA(0) >>             <<03550>>20856000
                                                               <<03550>>20858000
  <<****************************************>>                 <<03550>>20860000
  << [PON] SELECTED DEVICE CLEAR/PARITY     >>                 <<03550>>20862000
  << ENABLED ON POWER ON                    >>                 <<03550>>20864000
  <<****************************************>>                 <<03550>>20866000
                                                               <<03550>>20868000
<<   0>>   %4401,  << SEL. DEV. CLR/PARITY ON >>               <<03550>>20870000
<<   1>>       0,                                              <<03550>>20872000
                                                               <<03550>>20874000
<<   2>>   %1000,  << WAIT FOR // POLL RESPONSE >>             <<03550>>20876000
<<   3>>       0,                                              <<03550>>20878000
                                                               <<03550>>20880000
<<   4>>   %2402,  << REPORTING MESSAGE SECONDARY >>           <<03550>>20882000
<<   5>>       0,  << RETURN BYTE >>                           <<03550>>20884000
<<   6>>       0,  << NORMAL COMPLETION >>                     <<03550>>20886000
<<   7>>       0,  << HOLD OFF ON STATUS REQUEST >>            <<03550>>20888000
<<   8>>      -9,  << POWER ON--REDO DEV. CLR >>               <<03550>>20890000
                                                               <<03550>>20892000
<<   9>>    %600,  << INTERRUPT/HALT >>                        <<03550>>20894000
<<* 10>>       2,  << HALT CODE OF 2 IN CPVA(0) >>             <<03550>>20896000
                                                               <<03550>>20898000
  <<***************************************>>                  <<03550>>20900000
  << MISCELLANEOUS STORAGE AND CONSTANTS   >>                  <<03550>>20902000
  <<***************************************>>                  <<03550>>20904000
                                                               <<03550>>20906000
<<   0>>      -1,                                              <<03550>>20908000
<<   0>> [8/%15,8/0],  << READ STATUS COMMAND (LEFT BYTE)>>    <<03550>>20910000
                                                               <<03550>>20912000
<<   0>>  0,0,0,0,0,  << STATUS RETURN AREA >>                 <<03550>>20914000
<<   5>>  0,0,0,0,0,                                           <<03550>>20916000
                                                               <<03550>>20918000
<<*  0>>  0,0,0,0,0,  << COMMAND DATA BUFFER >>                <<03550>>20920000
<<*  5>>  0,0,0,0,0,                                           <<03550>>20922000
<<* 10>>  0,0,0,0,0;                                           <<03550>>20924000
                                                               <<03550>>20926000
                                                               <<03550>>20928000
$PAGE                                                          <<03550>>20930000
SUBROUTINE SET'CMD'BYTES( RECORD, COUNT);                      <<03550>>20932000
VALUE RECORD, COUNT;                                           <<03550>>20934000
DOUBLE                                                         <<03550>>20936000
   RECORD;      << LOGICAL DISC ADDRESS >>                     <<03550>>20938000
INTEGER                                                        <<03550>>20940000
   COUNT;       << NO. OF BYTES TO READ/WRITE >>               <<03550>>20942000
                                                               <<03550>>20944000
<< FILL COMMAND BUFFER FOR READ/WRITE COMMANDS >>              <<03550>>20946000
BEGIN                                                          <<03550>>20948000
CPB(CDB'AREA'BYTE+ 0) := CDB'SET'UNIT;                         <<03550>>20950000
CPB(CDB'AREA'BYTE+ 1) := CDB'SET'VOL;                          <<03550>>20952000
CPB(CDB'AREA'BYTE+ 2) := CDB'SET'SNGL'VEC;                     <<03550>>20954000
CPB(CDB'AREA'BYTE+ 3) := 0;                                    <<03550>>20956000
CPB(CDB'AREA'BYTE+ 4) := 0;                                    <<03550>>20958000
@TEMP := @RECORD&LSL(1);                                       <<03550>>20960000
CPB(CDB'AREA'BYTE+ 5) := TEMP(0);                              <<03550>>20962000
CPB(CDB'AREA'BYTE+ 6) := TEMP(1);                              <<03550>>20964000
CPB(CDB'AREA'BYTE+ 7) := TEMP(2);                              <<03550>>20966000
CPB(CDB'AREA'BYTE+ 8) := TEMP(3);                              <<03550>>20968000
CPB(CDB'AREA'BYTE+ 9) := CDB'SET'LENGTH;                       <<03550>>20970000
CPB(CDB'AREA'BYTE+10) := 0;                                    <<03550>>20972000
CPB(CDB'AREA'BYTE+11) := 0;                                    <<03550>>20974000
CPB(CDB'AREA'BYTE+12) := COUNT.(0:8);                          <<03550>>20976000
CPB(CDB'AREA'BYTE+13) := COUNT.(8:8);                          <<03550>>20978000
END;   << SET'CMD'BYTES >>                                     <<03550>>20980000
                                                               <<03550>>20982000
SUBROUTINE SET'FOR'ERRORS;                                     <<03550>>20984000
<< SET UP READ STATUS SECTION OF CHANNEL PROGRAM >>            <<03550>>20986000
<< IN CASE RETURN BYTE = 1                       >>            <<03550>>20988000
BEGIN                                                          <<03550>>20990000
CP(STATX'CMD'ADR) := CHAN'PROG'BASE + STAT'CDB;                <<03550>>20992000
CP(STATX'DATA'ADR) := CHAN'PROG'BASE + STAT'AREA;              <<03550>>20994000
END;   << SET'FOR'ERRORS >>                                    <<03550>>20996000
                                                               <<03550>>20998000
LOGICAL SUBROUTINE FATAL'FUNCT( FUNCT);                        <<03550>>21000000
VALUE FUNCT;                                                   <<03550>>21002000
LOGICAL                                                        <<03550>>21004000
      FUNCT;   << DRIVER FUNCTION CODE >>                      <<03550>>21006000
<< RETURNS TRUE IF THE CURRENT FUNCTION ('FUNCT') BEING  >>    <<03550>>21008000
<< PERFORMED BY THE DRIVER IS FATAL IF IT GETS AN        >>    <<03550>>21010000
<< UNRECOVERABLE ERROR.  NON-FATAL FUNCTIONS ENCOUNTERING>>    <<03550>>21012000
<< THE SAME ERROR WILL RETURN WITH CCL.                  >>    <<03550>>21014000
BEGIN                                                          <<03550>>21016000
IF FUNCT = RSTAT OR      << IS IT ONE OF THE NON-FATALS? >>    <<03550>>21018000
   FUNCT = CLEAR'STAT OR                                       <<03668>>21020000
   FUNCT = NON'FATAL'READ OR                                   <<03550>>21022000
   FUNCT = ENAB'RELEASE OR                                     <<03715>>21024000
   FUNCT = UNLOAD OR                                           <<03715>>21026000
   FUNCT = INIT'DEV THEN                                       <<03715>>21028000
   FATAL'FUNCT := FALSE     << YEP, NON-FATAL >>               <<03550>>21030000
                                                               <<03550>>21032000
ELSE                                                           <<03550>>21034000
   FATAL'FUNCT := TRUE;     << NOPE, IT'S CURTAINS >>          <<03550>>21036000
END;   << FATAL'FUNCT >>                                       <<03550>>21038000
                                                               <<03550>>21040000
INTEGER SUBROUTINE SET'BYTE'COUNT( WORDS);                     <<03550>>21042000
VALUE WORDS;                                                   <<03550>>21044000
INTEGER                                                        <<03550>>21046000
   WORDS;    << NO. OF WORDS TO TRANSFER >>                    <<03550>>21048000
<< CONVERT NO. OF WORDS TO NO. OF BYTES AND RETURN IT >>       <<03550>>21050000
BEGIN                                                          <<03550>>21052000
IF WORDS.(0:1) = 1 THEN       << IF WORD COUNT IS TOO >>       <<03550>>21054000
   ERRMESSAGE(M33,LDEV);      <<    LARGE, ABORT      >>       <<03550>>21056000
SET'BYTE'COUNT := WORDS&LSL(1);   <<    LOGICAL SHIFT HERE! >> <<03550>>21058000
END;   << SET'BYTE'COUNT >>                                    <<03550>>21060000
                                                               <<03550>>21062000
SUBROUTINE DESCRIBE'CP;                                        <<03550>>21064000
<< FILL CHANNEL PROGRAM WORDS FOR A DESCRIBE COMMAND >>        <<03550>>21066000
BEGIN                                                          <<03550>>21068000
CP(DX'CMD'MSGLEN) := 3;                                        <<03550>>21070000
CP(DX'CMD'AREA'ADR) := CHAN'PROG'BASE + CDB'AREA'WRD;          <<03550>>21072000
CP(DX'EXEC'SEC) := READ'EXEC'SEC;                              <<03550>>21074000
CP(DX'COUNT) := MAX'DESC'BYTE;                                 <<03550>>21076000
CP(DX'DATA'BANK).(8:8) := LOCAL'BUF'BANK;                      <<03550>>21078000
CP(DX'DATA'ADR) := LOCAL'BUF'ADDR;                             <<03550>>21080000
                                                               <<03550>>21082000
CPB(CDB'AREA'BYTE+ 0) := CDB'SET'UNIT;                         <<03550>>21084000
CPB(CDB'AREA'BYTE+ 1) := CDB'SET'VOL;                          <<03550>>21086000
CPB(CDB'AREA'BYTE+ 2) := CDB'DESCRIBE;                         <<03550>>21088000
                                                               <<03550>>21090000
CP(BRANCHPT) := DXFERCP;                                       <<03550>>21092000
END;   << DESCRIBE'CP >>                                       <<03550>>21094000
                                                               <<03550>>21096000
SUBROUTINE SPARE'CP(RETAIN);                                   <<03550>>21098000
VALUE RETAIN;                                                  <<03550>>21100000
LOGICAL                                                        <<03550>>21102000
   RETAIN;   << IF TRUE, SEND 'SPARE RETAINING DATA', >>       <<03550>>21104000
             <<  ELSE SEND 'SPARE NOT RETAINING DATA' >>       <<03550>>21106000
                                                               <<03550>>21108000
<< SETS UP A CHANNEL PROGRAM FOR EITHER 'SPARE RETAINING   >>  <<03550>>21110000
<< DATA' OR 'SPARE NOT RETAINING DATA', DEPENDING ON THE   >>  <<03550>>21112000
<< VALUE OF 'RETAIN'.                                      >>  <<03550>>21114000
BEGIN                                                          <<03550>>21116000
                                                               <<03550>>21118000
CPB(CDB'AREA'BYTE+ 0) := CDB'SET'UNIT;                         <<03550>>21120000
CPB(CDB'AREA'BYTE+ 1) := CDB'SET'SNGL'VEC;                     <<03550>>21122000
CPB(CDB'AREA'BYTE+ 2) := 0;                                    <<03550>>21124000
CPB(CDB'AREA'BYTE+ 3) := 0;                                    <<03550>>21126000
@TEMP := @RECORD&LSL(1);                                       <<03550>>21128000
CPB(CDB'AREA'BYTE+ 4) := TEMP(0);                              <<03550>>21130000
CPB(CDB'AREA'BYTE+ 5) := TEMP(1);                              <<03550>>21132000
CPB(CDB'AREA'BYTE+ 6) := TEMP(2);                              <<03550>>21134000
CPB(CDB'AREA'BYTE+ 7) := TEMP(3);                              <<03550>>21136000
CPB(CDB'AREA'BYTE+ 8) := CDB'SPARE'BLK;                        <<03550>>21138000
                                                               <<03550>>21140000
IF RETAIN THEN                                                 <<03550>>21142000
   CPB(CDB'AREA'BYTE+ 9) := 0       << RETAINING DATA >>       <<03550>>21144000
ELSE                                                           <<03550>>21146000
   CPB(CDB'AREA'BYTE+ 9) := 1;      << NOT RETAINING DATA >>   <<03550>>21148000
                                                               <<03550>>21150000
CP(DIAG'CMD'MSGLEN) := 10;                                     <<03550>>21152000
CP(DIAG'CMD'AREA'ADR) := CHAN'PROG'BASE + CDB'AREA'WRD;        <<03550>>21154000
                                                               <<03550>>21156000
<< SET UP SO THAT EVEN QSTAT OF 0 RETURNED FROM THE DRIVE >>   <<03550>>21158000
<< WILL CAUSE US TO READ STATUS.  WE DO THIS TO GET THE   >>   <<03550>>21160000
<< AFFECTED AREA OF THE SPARE OPERATION.                  >>   <<03550>>21162000
                                                               <<03550>>21164000
CP(DIAG'NORMAL'JUMP) := STATX - (DIAG'NORMAL'JUMP + 3);        <<03550>>21166000
                                                               <<03550>>21168000
CP(BRANCHPT) := DIAGCP;                                        <<03550>>21170000
END;   << SPARE'CP >>                                          <<03550>>21172000
                                                               <<03550>>21174000
SUBROUTINE MOVE'STATUS;                                        <<03550>>21176000
<< MOVE STATUS RETURN INTO LOCAL BUFFER >>                     <<03550>>21178000
BEGIN                                                          <<03550>>21180000
                                                               <<03668>>21182000
MABS( LOCAL'BUF'BANK, STAT'ADDR, 0,     << MOVE IT IN >>       <<03668>>21188000
      CHAN'PROG'BASE+STAT'AREA, STAT'SIZE);                    <<03668>>21190000
END;   << MOVE'STATUS >>                                       <<03550>>21192000
                                                               <<03550>>21194000
SUBROUTINE SET'STATUS'RETURN( NOT'READY);                      <<03550>>21196000
VALUE NOT'READY;                                               <<03550>>21198000
LOGICAL                                                        <<03550>>21200000
   NOT'READY;    << IF TRUE, SET STATUS TO 'NOT READY' >>      <<03550>>21202000
<< SETS THE RETURN FOR A READ STATUS (RSTAT) FUNCTION CALL >>  <<03550>>21204000
<< TO EITHER READY OR NOT READY.                           >>  <<03550>>21206000
BEGIN                                                          <<03550>>21208000
LOCAL'BUF(0) := 0;            << INITIALIZE LOCAL BUFFER >>    <<03550>>21210000
LOCAL'BUF(1) := 0;                                             <<03550>>21212000
LOCAL'BUF(1).NREADYF := NOT'READY;   << SET READY/NOT READY >> <<03550>>21214000
MABS( DATA'BANK,DATA'ADDR,    << COPY RETURN TO CALLER >>      <<03550>>21216000
      LOCAL'BUF'BANK,                                          <<03550>>21218000
      LOCAL'BUF'ADDR,2);                                       <<03550>>21220000
END;   << SET'STATUS'RETURN >>                                 <<03550>>21222000
                                                               <<03550>>21224000
SUBROUTINE ERT'CP(READ'ONLY);                                  <<03550>>21226000
VALUE READ'ONLY;                                               <<03550>>21228000
LOGICAL                                                        <<03550>>21230000
   READ'ONLY;     << IF TRUE THEN BUILD CP FOR READ-ONLY >>    <<03550>>21232000
                  << ERT, OTHERWISE READ/WRITE ERT       >>    <<03550>>21234000
<< BUILDS A CHANNEL PROGRAM TO DO EITHER A READ ONLY OR  >>    <<03550>>21236000
<< A READ/WRITE ERROR RATE TEST                          >>    <<03550>>21238000
BEGIN                                                          <<03550>>21240000
IF WC > 1 THEN        << IF AFFECTED AREA > SECTOR >>          <<03550>>21242000
   PARM := 1          <<    DO ERT ON WHOLE TRACK  >>          <<03550>>21244000
ELSE                                                           <<03550>>21246000
   PARM := 0;         << OTHERWISE JUST ON SECTOR  >>          <<03550>>21248000
                                                               <<03550>>21250000
CPB(CDB'AREA'BYTE+ 0) := CDB'SET'UNIT;                         <<03550>>21252000
CPB(CDB'AREA'BYTE+ 1) := CDB'SET'SNGL'VEC;                     <<03550>>21254000
CPB(CDB'AREA'BYTE+ 2) := 0;                                    <<03550>>21256000
CPB(CDB'AREA'BYTE+ 3) := 0;                                    <<03550>>21258000
@TEMP := @RECORD&LSL(1);                                       <<03550>>21260000
CPB(CDB'AREA'BYTE+ 4) := TEMP(0);                              <<03550>>21262000
CPB(CDB'AREA'BYTE+ 5) := TEMP(1);                              <<03550>>21264000
CPB(CDB'AREA'BYTE+ 6) := TEMP(2);                              <<03550>>21266000
CPB(CDB'AREA'BYTE+ 7) := TEMP(3);                              <<03550>>21268000
CPB(CDB'AREA'BYTE+ 8) := CDB'INIT'UTIL + 2;                    <<03550>>21270000
                                                               <<03550>>21272000
IF READ'ONLY THEN                                              <<03550>>21274000
   CPB(CDB'AREA'BYTE+ 9) := %311    << R/O ERT >>              <<03550>>21276000
ELSE                                                           <<03550>>21278000
   CPB(CDB'AREA'BYTE+ 9) := %310;   << PATTERN ERT >>          <<03550>>21280000
                                                               <<03550>>21282000
CPB(CDB'AREA'BYTE+10) := 5;      << LOOP >>                    <<03550>>21284000
CPB(CDB'AREA'BYTE+11) := 0;      << OFFSET >>                  <<03550>>21286000
CPB(CDB'AREA'BYTE+12) := 0;      << REPORT >>                  <<03550>>21288000
CPB(CDB'AREA'BYTE+13) := PARM;   << TEST AREA >>               <<03550>>21290000
CPB(CDB'AREA'BYTE+14) := 0;      << DATA SOURCE >>             <<03550>>21292000
                                                               <<03550>>21294000
IF READ'ONLY THEN                                              <<03550>>21296000
   CP(DX'CMD'MSGLEN) := 14                                     <<03550>>21298000
ELSE                                                           <<03550>>21300000
   CP(DX'CMD'MSGLEN) := 15;                                    <<03550>>21302000
                                                               <<03550>>21304000
CP(DX'CMD'AREA'ADR) := CHAN'PROG'BASE + CDB'AREA'WRD;          <<03550>>21306000
CP(DX'EXEC'SEC) := READ'EXEC'SEC;                              <<03550>>21308000
CP(DX'COUNT) := ERT'RETURN; << EXPECT 10 BYTES MAX. RETURN >>  <<03550>>21310000
CP(DX'DATA'BANK).(8:8) := LOCAL'BUF'BANK;                      <<03550>>21312000
CP(DX'DATA'ADR) := LOCAL'BUF'ADDR;                             <<03550>>21314000
                                                               <<03550>>21316000
CP(BRANCHPT) := DXFERCP;                                       <<03550>>21318000
END;   << ERT'CP >>                                            <<03550>>21320000
                                                               <<03550>>21322000
SUBROUTINE PUSH'STACK( ITEM);                                  <<03550>>21324000
VALUE ITEM;                                                    <<03550>>21326000
LOGICAL ITEM;   << ITEM TO BE STACKED >>                       <<03550>>21328000
<< PUSH A WORD ONTO THE DRIVER COMMAND STACK >>                <<03550>>21330000
BEGIN                                                          <<03550>>21332000
POINT := POINT - 1;                                            <<03550>>21334000
IF POINT < STACK'MAX THEN       << ABORT--DRIVER COMMAND   >>  <<03550>>21336000
   ERRMESSAGE( M31, LDEV, DRT, UNIT)    << STACK OVERFLOW  >>  <<03550>>21338000
ELSE                                                           <<03550>>21340000
   STACK(POINT) := ITEM;        << PUSH THE ITEM >>            <<03550>>21342000
END;   << PUSH'STACK >>                                        <<03550>>21344000
                                                               <<03550>>21346000
LOGICAL SUBROUTINE POP'STACK( ITEM);                           <<03550>>21348000
LOGICAL ITEM;   << RETURN ITEM >>                              <<03550>>21350000
<< RETURNS IN 'ITEM' THE TOP ELEMENT OF THE DRIVER   >>        <<03550>>21352000
<< COMMAND STACK AND POPS THAT ITEM.  IF THE STACK   >>        <<03550>>21354000
<< IS EMPTY, POP'STACK RETURNS FALSE, OTHERWISE TRUE.>>        <<03550>>21356000
BEGIN                                                          <<03550>>21358000
IF POINT > STACK'BOTTOM THEN    << STACK IS EMPTY >>           <<03550>>21360000
   BEGIN                                                       <<03550>>21362000
   POP'STACK := FALSE;                                         <<03550>>21364000
   RETURN;                                                     <<03550>>21366000
   END                                                         <<03550>>21368000
ELSE                                                           <<03550>>21370000
   BEGIN                        << SOMETHING ON THE STACK >>   <<03550>>21372000
   ITEM := STACK(POINT);        << GET THE ITEM >>             <<03550>>21374000
   POINT := POINT + 1;          << POP THE STACK >>            <<03550>>21376000
   POP'STACK := TRUE;                                          <<03550>>21378000
   END;                                                        <<03550>>21380000
END;   << POP'STACK >>                                         <<03550>>21382000
                                                               <<03668>>21384000
SUBROUTINE READ'CP(WC, RECORD, DATA'BANK, DATA'ADDR);          <<03668>>21386000
VALUE WC,RECORD,DATA'BANK,DATA'ADDR;                           <<03668>>21388000
INTEGER                                                        <<03668>>21390000
   WC,           << NO. OF WORDS TO READ >>                    <<03668>>21392000
   DATA'BANK,    << BANK OF READ BUFFER >>                     <<03668>>21394000
   DATA'ADDR;    << BANK OFFSET OF READ BUFFER >>              <<03668>>21396000
DOUBLE                                                         <<03668>>21398000
   RECORD;       << LOGICAL DISC ADDRESS >>                    <<03668>>21400000
<< CONSTRUCT A READ CHANNEL PROGRAM >>                         <<03668>>21402000
BEGIN                                                          <<03668>>21404000
COUNT := SET'BYTE'COUNT(WC);   <<  CONVERT WORD COUNT >>       <<03668>>21406000
                               <<     TO BYTE COUNT   >>       <<03668>>21408000
SET'CMD'BYTES(RECORD,COUNT);   << FILL COMMAND BUFFER >>       <<03668>>21410000
                                                               <<03668>>21412000
CP(DX'CMD'MSGLEN) := READ'MSGLEN;                              <<03668>>21414000
CP(DX'CMD'AREA'ADR) := CHAN'PROG'BASE + CDB'AREA'WRD;          <<03668>>21416000
                                                               <<03668>>21418000
IF COUNT = 0 THEN                                              <<03668>>21420000
   BEGIN                 << JUMP PAST EXECUTION   >>           <<03668>>21422000
   CP(DX'5) := 0;        <<     MESSAGE FOR ZERO- >>           <<03668>>21424000
   CP(DX'6) := 5;        <<     LENGTH READS      >>           <<03668>>21426000
   END                                                         <<03668>>21428000
ELSE                                                           <<03668>>21430000
   BEGIN                                                       <<03668>>21432000
   CP(DX'EXEC'SEC) := READ'EXEC'SEC;                           <<03668>>21434000
   CP(DX'COUNT) := COUNT;                                      <<03668>>21436000
   CP(DX'DATA'BANK).(8:8) := DATA'BANK;                        <<03668>>21438000
   CP(DX'DATA'ADR) := DATA'ADDR;                               <<03668>>21440000
   END;                                                        <<03668>>21442000
                                                               <<03668>>21444000
CPB(CDB'AREA'BYTE+14) := CDB'READ;                             <<03668>>21446000
                                                               <<03668>>21448000
CP(BRANCHPT) := DXFERCP;                                       <<03668>>21450000
END;   << READ'CP >>                                           <<03668>>21452000
                                                               <<03668>>21454000
SUBROUTINE WRITE'CP(WC, RECORD, DATA'BANK, DATA'ADDR);         <<03668>>21456000
VALUE WC,RECORD,DATA'BANK,DATA'ADDR;                           <<03668>>21458000
INTEGER                                                        <<03668>>21460000
   WC,             << NO. OF WORDS TO WRITE >>                 <<03668>>21462000
   DATA'BANK,      << BANK NO. OF WRITE BUFFER >>              <<03668>>21464000
   DATA'ADDR;      << BANK OFFSET OF WRITE BUFFER >>           <<03668>>21466000
DOUBLE                                                         <<03668>>21468000
   RECORD;         << LOGICAL DISC ADDRESS >>                  <<03668>>21470000
<< CONSTRUCT A WRITE CHANNEL PROGRAM >>                        <<03668>>21472000
BEGIN                                                          <<03668>>21474000
COUNT := SET'BYTE'COUNT(WC);   <<  CONVERT WORD COUNT >>       <<03668>>21476000
                               <<     TO BYTE COUNT   >>       <<03668>>21478000
SET'CMD'BYTES(RECORD,COUNT);   << FILL COMMAND BUFFER >>       <<03668>>21480000
                                                               <<03668>>21482000
CP(DX'CMD'MSGLEN) := WRITE'MSGLEN;                             <<03668>>21484000
CP(DX'CMD'AREA'ADR) := CHAN'PROG'BASE + CDB'AREA'WRD;          <<03668>>21486000
                                                               <<03668>>21488000
IF COUNT = 0 THEN                                              <<03668>>21490000
   BEGIN                 << JUMP PAST EXECUTION   >>           <<03668>>21492000
   CP(DX'5) := 0;        <<     MESSAGE FOR ZERO- >>           <<03668>>21494000
   CP(DX'6) := 5;        <<     LENGTH WRITES     >>           <<03668>>21496000
   END                                                         <<03668>>21498000
ELSE                                                           <<03668>>21500000
   BEGIN                                                       <<03668>>21502000
   CP(DX'EXEC'SEC) := WRITE'EXEC'SEC;                          <<03668>>21504000
   CP(DX'COUNT) := COUNT;                                      <<03668>>21506000
   CP(DX'DATA'BANK).(8:8) := DATA'BANK;                        <<03668>>21508000
   CP(DX'DATA'ADR) := DATA'ADDR;                               <<03668>>21510000
   END;                                                        <<03668>>21512000
                                                               <<03668>>21514000
CPB(CDB'AREA'BYTE+14) := CDB'WRITE;                            <<03668>>21516000
                                                               <<03668>>21518000
CP(BRANCHPT) := DXFERCP;                                       <<03668>>21520000
END;   << WRITE'CP >>                                          <<03668>>21522000
                                                               <<03668>>21524000
SUBROUTINE ADD'DSCT'ENTRY( DSCT, WORD1, WORD2);                <<03668>>21526000
INTEGER ARRAY                                                  <<03668>>21528000
   DSCT;      << DEFECTIVE SECTOR TABLE >>                     <<03668>>21530000
INTEGER                                                        <<03668>>21532000
   WORD1,     << HIGH ORDER WORD OF DISC ADDRESS >>            <<03668>>21534000
   WORD2;     << LOW ORDER WORD OF DISC ADDRESS >>             <<03668>>21536000
<< ADDS AN ENTRY TO THE GIVEN DEFECTIVE SECTOR TABLE, >>       <<03668>>21538000
<< IF THERE IS ROOM AND IF THERE IS NOT ALREADY AN    >>       <<03668>>21540000
<< ENTRY FOR THE GIVEN ADDRESS.                       >>       <<03668>>21542000
BEGIN                                                          <<03668>>21544000
IF DSCT( DSCT'NUM'ENTRIES) < MAX'DSCT THEN                     <<03668>>21546000
   BEGIN           << THERE IS SOME EMPTY SPACE IN THE DSCT >> <<03668>>21548000
                                                               <<03668>>21550000
   I := 0;                                                     <<03668>>21552000
   PARM := DSCT(DSCT'FIRST'ENTRY);                             <<03668>>21554000
   WHILE I < DSCT(DSCT'NUM'ENTRIES) DO    << SCAN FOR       >> <<03668>>21556000
      BEGIN                               <<    DUPLICATES  >> <<03668>>21558000
                                                               <<03668>>21560000
      IF DSCT(PARM)   = WORD1 AND     << IF DUPLICATE ENTRY >> <<03668>>21562000
         DSCT(PARM+1) = WORD2 THEN    <<     JUST RETURN    >> <<03668>>21564000
         RETURN;                                               <<03668>>21566000
                                                               <<03668>>21568000
      I := I + 1;                                              <<03668>>21570000
      PARM := PARM + DSCT(DSCT'ENTRY'SIZE);                    <<03668>>21572000
      END;                                                     <<03668>>21574000
                                                               <<03668>>21576000
   DSCT(PARM) := WORD1;        << NO DUPLICATES FOUND--    >>  <<03668>>21578000
   DSCT(PARM + 1) := WORD2;    <<    INSERT NEW ENTRY.     >>  <<03668>>21580000
   DSCT(DSCT'NUM'ENTRIES) := DSCT(DSCT'NUM'ENTRIES) + 1;       <<03668>>21582000
   END;                                                        <<03668>>21584000
END;   << ADD'DSCT'ENTRY >>                                    <<03668>>21586000
                                                               <<03668>>21588000
SUBROUTINE OFFLINE;                                            <<03668>>21590000
<< HANDLES OFF-LINE DEVICE--WAITS 1 SECOND THEN READS   >>     <<03668>>21592000
<< STATUS AGAIN TO SEE IF DEVICE IS ON-LINE.            >>     <<03668>>21594000
BEGIN                                                          <<03668>>21596000
IF FIRST'OFFLINE THEN                                          <<03668>>21598000
   BEGIN                                                       <<03668>>21600000
   FIRST'OFFLINE := FALSE;    << RESET FLAG >>                 <<03668>>21602000
   PUSH'STACK(CURFUNCT);      << SAVE THE CURRENT FUNCTION >>  <<03668>>21604000
   MESSAGE( M2408, LDEV);     << LDEV #N NOT READY >>          <<03668>>21606000
   END;                                                        <<03668>>21608000
                                                               <<03668>>21610000
NUM'RETRIES := 0;          << UNLIMITED RETRIES >>             <<03668>>21612000
DELAY(1000D);              << DELAY 1 SECOND >>                <<03715>>21614000
PUSH'STACK(GET'STAT);      << TRY READING STATUS AGAIN >>      <<03668>>21616000
END;   << OFFLINE >>                                           <<03668>>21618000
                                                               <<03668>>21620000
SUBROUTINE RSTAT'CP( CLEARING);                                <<03668>>21622000
VALUE CLEARING;                                                <<03668>>21624000
LOGICAL                                                        <<03668>>21626000
   CLEARING;      << IF TRUE, READ AND CLEAR STATUS >>         <<03668>>21628000
<< SET UP CHANNEL PROGRAM TO READ STATUS.  IN ORDER TO GET >>  <<03668>>21630000
<< AN ACCURATE DEVICE READY/NOT READY BIT, WE MUST DO A    >>  <<03668>>21632000
<< ZERO-LENGTH WRITE.  IF WE GET A DSJ OF 1 ON THIS WRITE, >>  <<03668>>21634000
<< WE WILL READ STATUS, OTHERWISE THERE ARE NO STATUS      >>  <<03668>>21636000
<< CONDITIONS.  IF CLEARING IS TRUE, SET UP CHANNEL PROG.  >>  <<03668>>21638000
<< SO THAT STATUS WILL NOT BE INTERROGATED AFTER THE       >>  <<03668>>21640000
<< CHANNEL PROGRAM COMPLETES.                              >>  <<03668>>21642000
BEGIN                                                          <<03668>>21644000
                                                               <<03668>>21646000
CPB(CDB'AREA'BYTE+ 0) := CDB'SET'UNIT;                         <<03668>>21648000
CPB(CDB'AREA'BYTE+ 1) := CDB'SET'LENGTH;                       <<03668>>21650000
CPB(CDB'AREA'BYTE+ 2) := 0;                                    <<03668>>21652000
CPB(CDB'AREA'BYTE+ 3) := 0;    << GIVE IT A LENGTH >>          <<03668>>21654000
CPB(CDB'AREA'BYTE+ 4) := 0;    <<    OF ZERO       >>          <<03668>>21656000
CPB(CDB'AREA'BYTE+ 5) := 0;                                    <<03668>>21658000
CPB(CDB'AREA'BYTE+ 6) := CDB'WRITE;                            <<03668>>21660000
                                                               <<03668>>21662000
CP(DIAG'CMD'MSGLEN) := 7;                                      <<03668>>21664000
CP(DIAG'CMD'AREA'ADR) := CHAN'PROG'BASE + CDB'AREA'WRD;        <<03668>>21666000
                                                               <<03668>>21668000
<< SET UP SO WE WON'T INTERROGATE THE STATUS RETURN >>         <<03668>>21670000
<<    IF WE DO READ IT                              >>         <<03668>>21672000
                                                               <<03668>>21674000
IF CLEARING THEN                                               <<03668>>21676000
   BEGIN                                                       <<03672>>21678000
   CP(STATX'HALT'CODE) := 0;                                   <<03668>>21680000
   CP(STATX'FAIL'CODE) := 0;                                   <<03672>>21682000
   END;                                                        <<03672>>21684000
                                                               <<03668>>21686000
CP(BRANCHPT) := DIAGCP;                                        <<03668>>21688000
END;   << RSTAT'CP >>                                          <<03668>>21690000
                                                               <<03672>>21692000
SUBROUTINE RELEASE'CP( ALLOW);                                 <<03672>>21694000
VALUE ALLOW;                                                   <<03672>>21696000
LOGICAL                                                        <<03672>>21698000
   ALLOW;   << IF TRUE SEND RELEASE, OTHERWISE DENY RELEASE >> <<03672>>21700000
<< BUILDS A CHANNEL PROGRAM TO DO EITHER A RELEASE OR >>       <<03672>>21702000
<< DENY RELEASE, DEPENDING ON THE VALUE OF ALLOW      >>       <<03672>>21704000
BEGIN                                                          <<03672>>21706000
CPB(CDB'AREA'BYTE+ 0) := CDB'SET'UNIT + CTRL'UNIT;             <<03672>>21708000
CPB(CDB'AREA'BYTE+ 1) := IF ALLOW THEN CDB'RELEASE             <<03672>>21710000
                                  ELSE CDB'RELEASE'DENY;       <<03672>>21712000
CP(DIAG'CMD'MSGLEN) := 2;                                      <<03672>>21714000
CP(DIAG'CMD'AREA'ADR) := CHAN'PROG'BASE + CDB'AREA'WRD;        <<03672>>21716000
CP(BRANCHPT) := DIAGCP;                                        <<03672>>21718000
END;   << RELEASE'CP >>                                        <<03672>>21720000
                                                               <<03672>>21722000
SUBROUTINE SET'RELEASE'CP( SUPPRESS);                          <<03672>>21724000
VALUE SUPPRESS;                                                <<03672>>21726000
LOGICAL                                                        <<03672>>21728000
   SUPPRESS;   << IF TRUE SUPPRESS RELEASE TIMEOUT >>          <<03672>>21730000
<< BUILDS CHANNEL PROGRAM TO SET RELEASE MODE >>               <<03672>>21732000
BEGIN                                                          <<03672>>21734000
CPB(CDB'AREA'BYTE+ 0) := CDB'SET'UNIT + CTRL'UNIT;             <<03672>>21736000
CPB(CDB'AREA'BYTE+ 1) := CDB'SET'RELEASE;                      <<03672>>21738000
CPB(CDB'AREA'BYTE+ 2) := 0;                                    <<03672>>21740000
IF SUPPRESS THEN                                               <<03672>>21742000
   CPB(CDB'AREA'BYTE+ 2) := %200;    << SUPPRESS RELEASE >>    <<03672>>21744000
CP(DIAG'CMD'MSGLEN) := 3;                                      <<03672>>21746000
CP(DIAG'CMD'AREA'ADR) := CHAN'PROG'BASE + CDB'AREA'WRD;        <<03672>>21748000
                                                               <<03672>>21750000
CP(BRANCHPT) := DIAGCP;                                        <<03672>>21752000
END;   << SET'RELEASE'CP >>                                    <<03672>>21754000
                                                               <<03550>>21756000
LOGICAL SUBROUTINE SETUP'STACK( FUNCT);                        <<03550>>21758000
VALUE FUNCT;                                                   <<03550>>21760000
LOGICAL FUNCT;   << FUNCTION TO BE PERFORMED >>                <<03550>>21762000
<< PUT SEQUENCE OF SUBFUNCTIONS TO PERFORM THE GIVEN  >>       <<03550>>21764000
<< FUNCTION ON THE COMMAND STACK                      >>       <<03550>>21766000
BEGIN                                                          <<03550>>21768000
SETUP'STACK := TRUE;     << INITIALIZE RETURN VALUE >>         <<03550>>21770000
IF (0 <= INTEGER(FUNCT) <= MAX'FUNCT) THEN                     <<03550>>21772000
   BEGIN                                                       <<03550>>21774000
   CASE FUNCT OF                                               <<03550>>21776000
      BEGIN                                                    <<03550>>21778000
      <<  0 >> PUSH'STACK(READ);       << READ >>              <<03550>>21780000
      <<  1 >> PUSH'STACK(WRITE);      << WRITE >>             <<03550>>21782000
      <<  2 >> SETUP'STACK := FALSE;   << NOT USED >>          <<03550>>21784000
      <<  3 >> SETUP'STACK := FALSE;   << NOT USED >>          <<03550>>21786000
      <<  4 >> SETUP'STACK := FALSE;   << NOT USED >>          <<03550>>21788000
      <<  5 >> BEGIN                   << READ STATUS >>       <<03668>>21790000
               SET'STATUS'RETURN(                              <<03668>>21792000
                  TRUE);                                       <<03668>>21794000
               PUSH'STACK(                                     <<03668>>21796000
                  CLEAR'STAT);                                 <<03668>>21798000
               END;                                            <<03668>>21800000
      <<  6 >> BEGIN                   << NON-FATAL READ >>    <<03550>>21802000
               PUSH'STACK(                                     <<03668>>21804000
                  NON'FATAL'READ);                             <<03668>>21806000
               PUSH'STACK(                                     <<03668>>21808000
                  CLEAR'STAT);                                 <<03668>>21810000
               END;                                            <<03550>>21812000
      <<  7 >> BEGIN                   << INITIALIZE >>        <<03550>>21814000
               PUSH'STACK(CLEAR);      <<    DISC    >>        <<03672>>21820000
               PUSH'STACK(                                     <<03668>>21822000
                  CLEAR'STAT);                                 <<03668>>21824000
               END;                                            <<03550>>21826000
      <<  8 >> SETUP'STACK := FALSE;   << RELEASE--        >>  <<03672>>21828000
                                       <<    INTERNAL ONLY >>  <<03672>>21830000
      <<  9 >> SETUP'STACK := FALSE;   << DENY RELEASE--   >>  <<03672>>21832000
                                       <<    INTERNAL ONLY >>  <<03672>>21834000
      << 10 >> PUSH'STACK(CLEAR);      << DEVICE CLEAR >>      <<03550>>21836000
      << 11 >> PUSH'STACK(             << SUPPRESS RELEASE >>  <<03672>>21838000
                  SUPP'RELEASE);       <<     TIMEOUT      >>  <<03672>>21840000
      << 12 >> PUSH'STACK(             << ENABLE RELEASE >>    <<03672>>21842000
                  ENAB'RELEASE);       <<     TIMEOUT    >>    <<03672>>21844000
      << 13 >> PUSH'STACK(DESCRIBE);   << GET VOLUME LIMIT >>  <<03550>>21846000
      << 14 >> PUSH'STACK(             << RECOVERY READ >>     <<03668>>21848000
                  RECOV'READ);                                 <<03668>>21850000
      << 15 >> PUSH'STACK(             << SPARE RETAINING >>   <<03550>>21852000
                  SPARE'RETAIN);       <<     DATA        >>   <<03550>>21854000
      << 16 >> PUSH'STACK(             << SPARE NOT       >>   <<03550>>21856000
                  SPARE'NO'RETAIN);    <<  RETAINING DATA >>   <<03550>>21858000
      << 17 >> PUSH'STACK(DESCRIBE);   << DESCRIBE >>          <<03550>>21860000
      << 18 >> PUSH'STACK(RW'ERT);     << R/W ERT >>           <<03550>>21862000
      << 19 >> PUSH'STACK(             << READ SPARE TABLE >>  <<03630>>21864000
                  READ'SPARES);                                <<03630>>21866000
      << 20 >> SETUP'STACK := FALSE;   << READ DSCT--      >>  <<03672>>21868000
                                       <<    INTERNAL ONLY >>  <<03672>>21870000
      << 21 >> SETUP'STACK := FALSE;   << WRITE DSCT--     >>  <<03672>>21872000
                                       <<    INTERNAL ONLY >>  <<03672>>21874000
      << 22 >> PUSH'STACK(             << PERFORM DIAGNOSTIC >><<03550>>21876000
                  DIAGNOSTIC);                                 <<03550>>21878000
      << 23 >> PUSH'STACK(RO'ERT);     << R/O ERT >>           <<03550>>21880000
      << 24 >> PUSH'STACK(             << READ, CLEAR STATUS >><<03668>>21882000
                  CLEAR'STAT);                                 <<03668>>21884000
      << 25 >> SETUP'STACK := FALSE;   << READ STATUS--    >>  <<03672>>21886000
                                       <<    INTERNAL ONLY >>  <<03672>>21888000
      << 26 >> PUSH'STACK(UNLOAD);     << UNLOAD TAPE >>       <<03672>>21890000
      END;                                                     <<03550>>21892000
   END                                                         <<03550>>21894000
                                                               <<03550>>21896000
ELSE                                                           <<03550>>21898000
   SETUP'STACK := FALSE;         << FUNCTION NOT USED >>       <<03550>>21900000
END;  << SETUP'STACK >>                                        <<03550>>21902000
$PAGE                                                          <<03550>>21904000
                                                               <<03550>>21906000
<< SET DB TO INITIAL'S STACK, UNLESS WE ARE ON THE ICS. >>     <<03614>>21908000
<< IN THAT CASE, WE SET IT TO Q-INITIAL OF THE ICS.     >>     <<03614>>21910000
                                                               <<03614>>21912000
IF ON'ICS THEN        << RUNNING ON THE ICS >>                 <<03614>>21914000
   BEGIN                                                       <<03614>>21916000
   TOS := 0;           << BANK 0 >>                            <<03614>>21918000
   TOS := ABS(QI);     << DB REGISTER TO QI >>                 <<03614>>21920000
   END                                                         <<03614>>21922000
ELSE                                                           <<03550>>21924000
   BEGIN                       << SET UP TO POINT DB AT >>     <<03550>>21926000
   TOS := ABSOLUTE(DBBANK);    <<    INITIAL'S STACK    >>     <<03550>>21928000
   TOS := ABSOLUTE(DB);                                        <<03550>>21930000
   END;                                                        <<03550>>21932000
ASSEMBLE(XCHD);                << SWITCH DB, BUT      >>       <<03550>>21934000
OLDDB := TOS;                  <<    SAVE THE OLD ONE >>       <<03550>>21936000
                                                               <<03550>>21938000
PUSH(DB);              << COMPUTE ABS. ADDRESS OF     >>       <<03550>>21940000
CPADDRESS := TOS+@CP;  <<    LOCAL CHANNEL PROGRAM    >>       <<03550>>21942000
LOCAL'BUF'BANK := TOS; <<    BUFFER                   >>       <<03668>>21944000
                                                               <<03550>>21946000
PUSH(DB);                   << COMPUTE ABS. ADDRESS OF >>      <<03550>>21948000
LOCAL'BUF'ADDR := TOS + @LOCAL'BUF;    << LOCAL'BUF    >>      <<03550>>21950000
LOCAL'BUF'BANK := TOS;                                         <<03550>>21952000
                                                               <<03668>>21954000
PUSH(DB);                    << COMPUTE ABS. ADDRESS >>        <<03668>>21956000
STAT'ADDR := TOS+@STATUS;    <<   OF STATUS BUFFER   >>        <<03668>>21958000
LOCAL'BUF'BANK := TOS;                                         <<03668>>21960000
                                                               <<03668>>21962000
PUSH(DB);                          << COMPUTE ABS. ADDRESS >>  <<03668>>21964000
OLD'STAT'ADDR := TOS+@OLD'STAT;    << OF OLD STATUS BUFFER >>  <<03668>>21966000
LOCAL'BUF'BANK := TOS;                                         <<03668>>21968000
                                                               <<03550>>21970000
DRT := DRTUNIT.DRTFIELD;   << GET THE DISC'S DRT >>            <<03550>>21972000
UNIT := DRTUNIT.UNITFIELD; << AND UNIT           >>            <<03550>>21974000
                                                               <<03550>>21976000
CC := CCE;     << INITIALIZE CONDITION CODE RETURN >>          <<03550>>21978000
                                                               <<03550>>21980000
                                                               <<03550>>21986000
IF NOT SETUP'STACK(FUNCT) THEN      << SET UP THE DRIVER  >>   <<03550>>21988000
   GO FUNCT'ERROR;                  <<      COMMAND STACK >>   <<03550>>21990000
                                                               <<03550>>21992000
NUM'RETRIES := 0;     << INITIALIZE RETRY COUNT >>             <<03550>>21994000
                                                               <<03550>>21996000
WHILE POP'STACK(CURFUNCT) AND    << DO WHILE MORE FUNCTIONS >> <<03550>>21998000
      NUM'RETRIES <= MAX'RETRIES DO    <<   AND RETRIES NOT >> <<03550>>22000000
                                       <<   EXCEEDED        >> <<03550>>22002000
   BEGIN                                                       <<03550>>22004000
                                                               <<03550>>22006000
   NUM'RETRIES := NUM'RETRIES + 1;   <<INCREMENT RETRY COUNT>> <<03550>>22008000
                                                               <<03550>>22010000
   << MOVE CHANNEL PROGRAM TO Q-RELATIVE BUFFER >>             <<03550>>22012000
   MOVE CP := CS80'CHAN'PROG,(CPSIZE);                         <<03550>>22014000
                                                               <<03550>>22016000
   << SET UP CHANNEL PROGRAM TO HANDLE ERRORS >>               <<03550>>22018000
   SET'FOR'ERRORS;                                             <<03550>>22020000
                                                               <<03550>>22022000
$PAGE                                                          <<03550>>22024000
   CASE CURFUNCT OF          << SET UP CHANNEL PROGRAM FOR  >> <<03550>>22026000
      BEGIN                  <<     THE CURRENT FUNCTION    >> <<03550>>22028000
                                                               <<03550>>22030000
      <<********************************>>                     <<03550>>22032000
      <<  0      READ                   >>                     <<03550>>22034000
      <<********************************>>                     <<03550>>22036000
                                                               <<03550>>22038000
      BEGIN                                                    <<03550>>22040000
      READ'CP( WC, RECORD, DATA'BANK, DATA'ADDR);              <<03668>>22042000
      END;                                                     <<03668>>22044000
                                                               <<03668>>22046000
                                                               <<03550>>22090000
      <<*******************************>>                      <<03550>>22092000
      <<  1        WRITE               >>                      <<03550>>22094000
      <<*******************************>>                      <<03550>>22096000
                                                               <<03550>>22098000
      BEGIN                                                    <<03550>>22100000
      WRITE'CP( WC, RECORD, DATA'BANK, DATA'ADDR);             <<03668>>22102000
      END;                                                     <<03668>>22104000
                                                               <<03668>>22106000
                                                               <<03550>>22150000
      BEGIN      <<  2 >>                                      <<03550>>22152000
      GO FUNCT'ERROR;                                          <<03550>>22154000
      END;                                                     <<03550>>22156000
                                                               <<03550>>22158000
      BEGIN      <<  3 >>                                      <<03550>>22160000
      GO FUNCT'ERROR;                                          <<03550>>22162000
      END;                                                     <<03550>>22164000
                                                               <<03550>>22166000
      BEGIN      <<  4 >>                                      <<03550>>22168000
      GO FUNCT'ERROR;                                          <<03550>>22170000
      END;                                                     <<03550>>22172000
                                                               <<03550>>22174000
                                                               <<03550>>22182000
      BEGIN      <<  5 >>                                      <<03668>>22184000
      GO FUNCT'ERROR;                                          <<03668>>22186000
      END;                                                     <<03668>>22188000
                                                               <<03668>>22190000
                                                               <<03550>>22244000
      <<**********************************>>                   <<03668>>22246000
      <<  6      NON-FATAL READ           >>                   <<03668>>22248000
      <<**********************************>>                   <<03668>>22250000
                                                               <<03668>>22252000
      BEGIN                                                    <<03668>>22254000
      READ'CP( WC, RECORD, DATA'BANK, DATA'ADDR);              <<03668>>22256000
      END;                                                     <<03550>>22258000
                                                               <<03550>>22260000
      BEGIN     <<  7 >>                                       <<03550>>22262000
      GO FUNCT'ERROR;                                          <<03550>>22264000
      END;                                                     <<03550>>22266000
                                                               <<03550>>22268000
      <<*********************************>>                    <<03550>>22270000
      <<  8        RELEASE               >>                    <<03550>>22272000
      <<*********************************>>                    <<03550>>22274000
                                                               <<03550>>22276000
      BEGIN                                                    <<03550>>22278000
      RELEASE'CP(TRUE);                                        <<03672>>22288000
      END;                                                     <<03550>>22290000
                                                               <<03550>>22292000
      <<***********************************>>                  <<03550>>22294000
      <<  9        DENY RELEASE            >>                  <<03550>>22296000
      <<***********************************>>                  <<03550>>22298000
                                                               <<03550>>22300000
      BEGIN                                                    <<03550>>22302000
      RELEASE'CP(FALSE);                                       <<03672>>22312000
      END;                                                     <<03550>>22314000
                                                               <<03550>>22316000
      <<************************************>>                 <<03550>>22318000
      <<  10       DEVICE CLEAR             >>                 <<03550>>22320000
      <<************************************>>                 <<03550>>22322000
                                                               <<03550>>22324000
      BEGIN                                                    <<03550>>22326000
      CP(PON'HALT'CODE) := 0;                                  <<03550>>22328000
      CP(BRANCHPT) := PONCP;                                   <<03550>>22330000
      END;                                                     <<03550>>22332000
                                                               <<03550>>22334000
      <<*************************************>>                <<03550>>22336000
      <<  11    SUPPRESS RELEASE TIMEOUT     >>                <<03550>>22338000
      <<*************************************>>                <<03550>>22340000
                                                               <<03550>>22342000
      BEGIN                                                    <<03550>>22344000
      SET'RELEASE'CP(TRUE);                                    <<03672>>22360000
      END;                                                     <<03550>>22362000
                                                               <<03550>>22364000
      <<**************************************>>               <<03672>>22366000
      <<  12    ENABLE RELEASE TIMEOUT        >>               <<03672>>22368000
      <<**************************************>>               <<03672>>22370000
                                                               <<03672>>22372000
      BEGIN                                                    <<03672>>22374000
      SET'RELEASE'CP(FALSE);                                   <<03672>>22376000
      END;                                                     <<03550>>22378000
                                                               <<03550>>22380000
      BEGIN     << 13 >>                                       <<03550>>22382000
      GO FUNCT'ERROR;                                          <<03550>>22384000
      END;                                                     <<03550>>22386000
                                                               <<03550>>22388000
      <<*************************************>>                <<03668>>22390000
      <<  14         RECOVERY READ           >>                <<03668>>22392000
      <<*************************************>>                <<03668>>22394000
                                                               <<03668>>22396000
      BEGIN                                                    <<03668>>22398000
      READ'CP( WC, RECORD, DATA'BANK, DATA'ADDR);              <<03668>>22400000
      END;                                                     <<03550>>22402000
                                                               <<03550>>22404000
      <<*******************************************>>          <<03550>>22406000
      <<  15      SPARE RETAINING DATA             >>          <<03550>>22408000
      <<*******************************************>>          <<03550>>22410000
                                                               <<03550>>22412000
      BEGIN                                                    <<03550>>22414000
      SPARE'CP(TRUE);                                          <<03550>>22416000
      END;                                                     <<03550>>22418000
                                                               <<03550>>22420000
      <<*******************************************>>          <<03550>>22422000
      <<  16      SPARE NOT RETAINING DATA         >>          <<03550>>22424000
      <<*******************************************>>          <<03550>>22426000
                                                               <<03550>>22428000
      BEGIN                                                    <<03550>>22430000
      SPARE'CP(FALSE);                                         <<03550>>22432000
      END;                                                     <<03550>>22434000
                                                               <<03550>>22436000
      <<*******************************************>>          <<03550>>22438000
      <<  17           DESCRIBE                    >>          <<03550>>22440000
      <<*******************************************>>          <<03550>>22442000
                                                               <<03550>>22444000
      BEGIN                                                    <<03550>>22446000
      DESCRIBE'CP;                                             <<03550>>22448000
      END;                                                     <<03550>>22450000
                                                               <<03550>>22452000
      <<*******************************************>>          <<03550>>22454000
      <<  18   READ/WRITE ERROR RATE TEST          >>          <<03550>>22456000
      <<*******************************************>>          <<03550>>22458000
                                                               <<03550>>22460000
      BEGIN                                                    <<03550>>22462000
      ERT'CP(FALSE);                                           <<03550>>22464000
      END;                                                     <<03550>>22466000
                                                               <<03550>>22468000
      <<**************************************>>               <<03550>>22470000
      <<  19      READ SPARE TABLE            >>               <<03550>>22472000
      <<**************************************>>               <<03550>>22474000
                                                               <<03550>>22476000
      BEGIN                                                    <<03550>>22478000
                                                               <<03550>>22480000
      CPB(CDB'AREA'BYTE+ 0) := CDB'SET'UNIT;                   <<03550>>22482000
      CPB(CDB'AREA'BYTE+ 1) := CDB'INIT'UTIL + 2;              <<03550>>22484000
      CPB(CDB'AREA'BYTE+ 2) := %304;   << READ DRIVE TABLES >> <<03550>>22486000
      CPB(CDB'AREA'BYTE+ 3) := 1;      << SPARE TRACK TABLE >> <<03550>>22488000
                                                               <<03550>>22490000
      CP(DX'CMD'MSGLEN) := 4;                                  <<03550>>22492000
      CP(DX'CMD'AREA'ADR) := CHAN'PROG'BASE + CDB'AREA'WRD;    <<03550>>22494000
      CP(DX'EXEC'SEC) := READ'EXEC'SEC;                        <<03550>>22496000
      CP(DX'COUNT) := 512;    << MAX. RETURN BYTES >>          <<03550>>22498000
      CP(DX'DATA'BANK).(8:8) := DATA'BANK;                     <<03550>>22500000
      CP(DX'DATA'ADR) := DATA'ADDR;                            <<03550>>22502000
                                                               <<03550>>22504000
      CP(BRANCHPT) := DXFERCP;                                 <<03550>>22506000
      END;                                                     <<03550>>22508000
                                                               <<03550>>22510000
      <<**************************************>>               <<03668>>22512000
      <<  20   READ DEFECTIVE SECTOR TABLE    >>               <<03668>>22514000
      <<**************************************>>               <<03668>>22516000
                                                               <<03668>>22518000
      BEGIN    << 20 >>                                        <<03550>>22520000
      PUSH(DB);                 << COMPUTE ABS. ADDRESS >>     <<03668>>22522000
      T'ADDR := TOS + @DSCT;    <<    OF DSCT           >>     <<03668>>22524000
      T'BANK := TOS;                                           <<03668>>22526000
      READ'CP( 128, 1D, T'BANK, T'ADDR);                       <<03668>>22528000
      END;                                                     <<03550>>22530000
                                                               <<03550>>22532000
      <<*****************************************>>            <<03668>>22534000
      <<  21    WRITE DEFECTIVE SECTOR TABLE     >>            <<03668>>22536000
      <<*****************************************>>            <<03668>>22538000
                                                               <<03668>>22540000
      BEGIN    << 21 >>                                        <<03550>>22542000
      PUSH(DB);                 << COMPUTE ABS. ADDRESS >>     <<03668>>22544000
      T'ADDR := TOS + @DSCT;    <<    OF DSCT           >>     <<03668>>22546000
      T'BANK := TOS;                                           <<03668>>22548000
      WRITE'CP( 128, 1D, T'BANK, T'ADDR);                      <<03668>>22550000
      END;                                                     <<03550>>22552000
                                                               <<03550>>22554000
      <<*************************************>>                <<03550>>22556000
      <<  22     INTERNAL DIAGNOSTIC         >>                <<03550>>22558000
      <<*************************************>>                <<03550>>22560000
                                                               <<03550>>22562000
      BEGIN                                                    <<03550>>22564000
      CPB(CDB'AREA'BYTE+ 0) := CDB'SET'UNIT + CTRL'UNIT;       <<03550>>22566000
      CPB(CDB'AREA'BYTE+ 1) := CDB'INIT'DIAG;                  <<03550>>22568000
      CPB(CDB'AREA'BYTE+ 2) := 0;      << 2 BYTE       >>      <<03550>>22570000
      CPB(CDB'AREA'BYTE+ 3) := 1;      <<  LOOP COUNT  >>      <<03550>>22572000
      CPB(CDB'AREA'BYTE+ 4) := 0;      << DIAG. SECTION >>     <<03550>>22574000
                                                               <<03550>>22576000
      CP(DIAG'CMD'MSGLEN) := 5;                                <<03550>>22578000
      CP(DIAG'CMD'AREA'ADR) := CHAN'PROG'BASE + CDB'AREA'WRD;  <<03550>>22580000
                                                               <<03550>>22582000
      CP(DIAG'HALT'CODE) := 4;   << THIS FUNCTION ACTS LIKE >> <<03672>>22584000
                                 << DEVICE CLEAR, SO GIVE   >> <<03672>>22586000
                                 << IT A SPECIAL HALT CODE  >> <<03672>>22588000
      CP(BRANCHPT) := DIAGCP;                                  <<03550>>22590000
      END;                                                     <<03550>>22592000
                                                               <<03550>>22594000
      <<**************************************>>               <<03668>>22596000
      <<  23   READ-ONLY ERROR RATE TEST      >>               <<03668>>22598000
      <<**************************************>>               <<03668>>22600000
                                                               <<03668>>22602000
      BEGIN                                                    <<03668>>22604000
      ERT'CP(TRUE);                                            <<03668>>22606000
      END;                                                     <<03668>>22608000
                                                               <<03668>>22610000
      <<***************************************>>              <<03668>>22612000
      <<  24     READ AND CLEAR STATUS         >>              <<03668>>22614000
      <<***************************************>>              <<03668>>22616000
                                                               <<03668>>22618000
      BEGIN                                                    <<03668>>22620000
      RSTAT'CP( TRUE);                                         <<03668>>22622000
      END;                                                     <<03668>>22624000
                                                               <<03668>>22626000
      <<*************************************>>                <<03668>>22628000
      <<  25        READ STATUS              >>                <<03668>>22630000
      <<*************************************>>                <<03668>>22632000
                                                               <<03668>>22634000
      BEGIN                                                    <<03668>>22636000
      RSTAT'CP( FALSE);                                        <<03668>>22638000
      END;                                                     <<03668>>22640000
                                                               <<03668>>22642000
      <<******************************>>                       <<03672>>22644000
      <<  26     UNLOAD TAPE          >>                       <<03672>>22646000
      <<******************************>>                       <<03672>>22648000
                                                               <<03672>>22650000
      BEGIN                                                    <<03672>>22652000
      CPB(CDB'AREA'BYTE+ 0) := CDB'SET'UNIT;                   <<03672>>22654000
      CPB(CDB'AREA'BYTE+ 1) := CDB'UNLOAD;                     <<03672>>22656000
      CP(DIAG'CMD'MSGLEN) := 2;                                <<03672>>22658000
      CP(DIAG'CMD'AREA'ADR) := CHAN'PROG'BASE + CDB'AREA'WRD;  <<03672>>22660000
      CP(BRANCHPT) := DIAGCP;                                  <<03672>>22662000
      END;                                                     <<03672>>22664000
      END;      << CASE STATEMENT >>                           <<03550>>22666000
                                                               <<03550>>22668000
$PAGE                                                          <<03550>>22670000
   << MOVE CHANNEL PROGRAM INTO BANK 0 LOCATION >>             <<03550>>22672000
   MABS( 0,CHAN'PROG'BASE,LOCAL'BUF'BANK,CPADDRESS,CPSIZE);    <<03668>>22674000
                                                               <<03550>>22676000
   ZEROABS(GETDRT(DRT,DBI), 7);  << ZERO THE CPVA AREA >>      <<03550>>22678000
                                                               <<03550>>22680000
   GOOD'COMPLETION := FALSE;    << INIT. COMPLETION FLAG >>    <<03668>>22682000
                                                               <<03668>>22684000
   INIT( DRT);                  << INITIALIZE THE CHANNEL >>   <<03550>>22686000
   IF <> THEN                                                  <<03550>>22688000
      GOTO LAUNCH'ERROR;        << ERROR--ABORT >>             <<03550>>22690000
                                                               <<03550>>22692000
   SIOP( DRT, CHAN'PROG'BASE);  <<START THE CHANNEL PROGRAM>>  <<03550>>22694000
   IF <> THEN                                                  <<03550>>22696000
      GOTO LAUNCH'ERROR;        << ERROR--ABORT >>             <<03550>>22698000
                                                               <<03550>>22700000
   IF STYPE = LINUS THEN                   << GET TIMEOUT   >> <<03672>>22702000
      TIMEOUT := TAPE'TIMEOUT(CURFUNCT)    <<  FOR CURRENT  >> <<03672>>22704000
   ELSE                                    <<  FUNCTION     >> <<03672>>22706000
      TIMEOUT := DISC'TIMEOUT(CURFUNCT);                       <<03672>>22708000
                                                               <<03672>>22710000
   STARTIME := 0D;        << SET INITIAL TIME CLOCK >>         <<03672>>22712000
   CURTIME := 0D;         << INITIALIZE CURRENT TIME CLOCK >>  <<03672>>22714000
   LAST'RCLK := RCLK;     << GET INITIAL RCLK >>               <<03672>>22716000
                                                               <<03672>>22718000
   DO                     << LOOP UNTIL CHANNEL PROGRAM     >> <<03672>>22720000
      BEGIN               <<    ENDS OR TIMEOUT IS REACHED  >> <<03672>>22722000
      NEW'RCLK := RCLK;                                        <<03672>>22724000
      IF NEW'RCLK <> LAST'RCLK THEN    <<INCREMENT CLOCK IF >> <<03672>>22726000
         CURTIME := CURTIME + 1D;      <<   RCLK HAS TICKED >> <<03672>>22728000
      LAST'RCLK := NEW'RCLK;                                   <<03672>>22730000
                                                               <<03672>>22732000
                          << TIMEOUT=0 MEANS NEVER TIMEOUT  >> <<03672>>22734000
      IF TIMEOUT = 0D THEN CURTIME := STARTIME;                <<03672>>22736000
      END                                                      <<03672>>22738000
   UNTIL (GETDRT(DRT,CHANSTAT).(0:2) = 0 OR                    <<03672>>22740000
          CURTIME - STARTIME > TIMEOUT);                       <<03672>>22742000
                                                               <<03550>>22744000
   IF CURTIME - STARTIME > TIMEOUT THEN     << TIMED OUT >>    <<03668>>22746000
      BEGIN                                                    <<03668>>22748000
      PARM := GETDRT( DRT, CHANSTAT);     << FAKE CP        >> <<03668>>22750000
      PARM.(0:2) := 0;                    <<    COMPLETION  >> <<03668>>22752000
      PUTDRT(DRT, CHANSTAT, PARM);                             <<03668>>22754000
                                                               <<03668>>22756000
      IF FATAL'FUNCT(FUNCT) THEN      << WAIT FOR CP TO >>     <<03668>>22758000
         OFFLINE                      <<   COME ON-LINE >>     <<03668>>22760000
      ELSE                                                     <<03668>>22762000
         GOTO OFFLINE'ERROR;                                   <<03668>>22764000
      END                                                      <<03668>>22766000
                                                               <<03550>>22768000
   ELSE IF CPVAP.ERRCODE <> 4 THEN     << CHANNEL OR DMA  >>   <<03668>>22770000
      GOTO CPVA'ERROR                  <<    ABORT        >>   <<03668>>22772000
$PAGE                                                          <<03550>>22774000
   ELSE IF CPVAP.(3:13) = 1 THEN                               <<03668>>22776000
      BEGIN        << DIAGNOSE STATUS >>                       <<03550>>22778000
                                                               <<03550>>22780000
      MOVE'STATUS;  << PUT STATUS INTO LOCAL BUFFER >>         <<03550>>22782000
                                                               <<03550>>22784000
      IF STATUS(ID'FIELD).UNIT'ATTN <> %377 AND                <<03550>>22786000
         STATUS(ID'FIELD).UNIT'ATTN <> %17 AND                 <<03550>>22788000
         STATUS(ID'FIELD).UNIT'ATTN <> 0 THEN                  <<03550>>22790000
         GOTO ID'ERROR                                         <<03550>>22792000
                                                               <<03550>>22794000
      ELSE IF STATUS(REJECT'FIELD).CHAN'PARITY OR              <<03550>>22796000
         STATUS(REJECT'FIELD).ILLEG'OPCODE OR                  <<03550>>22798000
         STATUS(REJECT'FIELD).MOD'ADDR'ERR OR                  <<03550>>22800000
         STATUS(REJECT'FIELD).ADDR'BOUND OR                    <<03550>>22802000
         STATUS(REJECT'FIELD).PARM'BOUND OR                    <<03550>>22804000
         STATUS(REJECT'FIELD).ILLEG'PARM OR                    <<03550>>22806000
         STATUS(REJECT'FIELD).MSG'SEQ'VIOL OR                  <<03550>>22808000
         STATUS(REJECT'FIELD).MSG'LEN'DIFF THEN                <<03550>>22810000
         GOTO REJECT'ERROR                                     <<03550>>22812000
                                                               <<03550>>22814000
      ELSE IF STATUS(FAULT'FIELD).CROSS'UNIT OR                <<03550>>22816000
         STATUS(FAULT'FIELD).CTRL'FAULT OR                     <<03550>>22818000
         STATUS(FAULT'FIELD).UNIT'FAULT OR                     <<03550>>22820000
         STATUS(FAULT'FIELD).DIAG'FAILED OR                    <<03550>>22822000
         STATUS(FAULT'FIELD).OPER'REL'REQRD OR                 <<03550>>22824000
         STATUS(FAULT'FIELD).DIAG'REL'REQRD OR                 <<03550>>22826000
         STATUS(FAULT'FIELD).POWER'FAIL THEN                   <<03550>>22828000
         GOTO FAULT'ERROR                                      <<03550>>22830000
                                                               <<03550>>22832000
      ELSE IF STATUS(FAULT'FIELD).RETRANSMIT THEN              <<03550>>22834000
         PUSH'STACK(CURFUNCT)         << RETRY REQUEST >>      <<03550>>22836000
                                                               <<03550>>22838000
      ELSE IF STATUS(ACCESS'FIELD).ILLEG'PAR'OPER OR           <<03550>>22840000
         STATUS(ACCESS'FIELD).UNINIT'MEDIA OR                  <<03550>>22842000
         STATUS(ACCESS'FIELD).NO'SPARE'AVAIL OR                <<03550>>22844000
         STATUS(ACCESS'FIELD).WRT'PROTECT OR                   <<03550>>22846000
         STATUS(ACCESS'FIELD).NO'DATA'FOUND OR                 <<03550>>22848000
         STATUS(ACCESS'FIELD).END'OF'FILE OR                   <<03550>>22850000
         STATUS(ACCESS'FIELD).END'OF'VOLUME THEN               <<03550>>22852000
         GOTO ACCESS'ERROR                                     <<03550>>22854000
                                                               <<03550>>22856000
      ELSE IF STATUS(FAULT'FIELD).INT'MAINT'REQRD OR           <<03550>>22858000
         STATUS(INFOR'FIELD).OPER'REL'REQST OR                 <<03550>>22860000
         STATUS(INFOR'FIELD).DIAG'REL'REQST OR                 <<03550>>22862000
         STATUS(INFOR'FIELD).INT'MAINT'REQST THEN              <<03550>>22864000
         BEGIN                                                 <<03550>>22866000
         PUSH'STACK(CURFUNCT);    << REDO CURRENT FUNCTION >>  <<03550>>22868000
         IF STATUS(FAULT'FIELD).INT'MAINT'REQRD OR             <<03550>>22870000
            STATUS(INFOR'FIELD).INT'MAINT'REQST OR             <<03668>>22872000
            STATUS(INFOR'FIELD).OPER'REL'REQST AND             <<03668>>22874000
            STATUS(ACCESS'FIELD).DEV'NOT'RDY                   <<03668>>22876000
            THEN PUSH'STACK(RELEASE)                           <<03550>>22878000
            ELSE PUSH'STACK(RELEASE'DENY);                     <<03550>>22880000
         END                                                   <<03550>>22882000
                                                               <<03550>>22884000
      ELSE IF STATUS(ACCESS'FIELD).DEV'NOT'RDY THEN            <<03668>>22886000
         IF FATAL'FUNCT(FUNCT) THEN     << WAIT FOR DISC TO >> <<03668>>22888000
            OFFLINE                     <<   COME ON-LINE   >> <<03668>>22890000
         ELSE                                                  <<03668>>22892000
            GOTO OFFLINE'ERROR                                 <<03668>>22894000
                                                               <<03550>>22896000
      ELSE IF STATUS(ACCESS'FIELD).UNRECOV'DATA'OV OR          <<03550>>22898000
              STATUS(ACCESS'FIELD).UNRECOV'DATA THEN           <<03550>>22900000
         BEGIN                                                 <<03550>>22902000
         IF CURFUNCT = RECOV'READ THEN   <<UNABLE TO RECOVER>> <<03668>>22904000
            GOTO CCL'EXIT                <<  DATA, JUST EXIT>> <<03668>>22906000
                                                               <<03550>>22908000
         ELSE IF CURFUNCT = SPARE'RETAIN THEN                  <<03668>>22910000
                                                               <<03550>>22912000
       << SPARE RETAINING DATA FAILED, RETURN CCL.  NEXT >>    <<03550>>22914000
       << COMMAND SHOULD BE A SPARE NOT RETAINING DATA   >>    <<03550>>22916000
                                                               <<03550>>22918000
            GOTO CCL'EXIT                                      <<03550>>22920000
                                                               <<03668>>22922000
         ELSE IF NOT ON'ICS THEN                               <<03668>>22924000
            BEGIN                        << SAVE CURRENT    >> <<03668>>22926000
            MOVE OLD'STAT := STATUS,(STAT'SIZE);  << STATUS >> <<03668>>22928000
            PUSH'STACK( DSCT'READ);    << GO READ THE DSCT  >> <<03668>>22930000
            END                                                <<03668>>22932000
                                                               <<03668>>22934000
         ELSE                     << ADDRESSING VAR. 'DSCT' >> <<03668>>22936000
                                  <<  WHILE RUNNING ON ICS  >> <<03668>>22938000
            GOTO ACCESS'ERROR;    <<  WON'T WORK, SO ABORT  >> <<03668>>22940000
         END                                                   <<03668>>22942000
                                                               <<03668>>22944000
      ELSE            << STATUS RETURN INFORMATIONAL ONLY >>   <<03668>>22946000
         GOOD'COMPLETION := TRUE;                              <<03668>>22948000
      END                                                      <<03668>>22950000
                                                               <<03550>>22952000
 << POWER ON--REDO REQUEST.  WE HAVE JUST COMPLETED A       >> <<03550>>22954000
 << DEVICE CLEAR, SO DOWNLOAD SUP-                          >> <<03668>>22956000
 << PRESS RELEASE TIMEOUT AGAIN FIRST.  WE DON'T DO THIS    >> <<03550>>22958000
 << IF WE HAVEN'T GOTTEN TO THE POINT IN INITIAL WHERE THE  >> <<03668>>22960000
 << DEVICES ARE LOCKED IN.                                  >> <<03668>>22962000
                                                               <<03550>>22964000
   ELSE IF CPVAP.(3:13) = 2 THEN   <<POWER ON - REDO REQUEST>> <<03672>>22966000
      BEGIN                          << IF RELEASE TIMEOUT  >> <<03672>>22968000
      PUSH'STACK(CURFUNCT);          << WAS PREVIOUSLY DIS- >> <<03672>>22970000
      IF CS80'LOCK THEN              << ABLED, MUST RESET   >> <<03672>>22972000
         PUSH'STACK(SUPP'RELEASE);   << IT FIRST.           >> <<03672>>22974000
      END                                                      <<03672>>22976000
                                                               <<03672>>22978000
   ELSE IF CPVAP.(3:13) = 3 THEN   <<PROBLEM READING STATUS>>  <<03672>>22980000
      GOTO UNIT'ERROR             << ABORT THE PROGRAM >>      <<03672>>22982000
                                                               <<03672>>22984000
 << JUST COMPLETED DIAGNOSTIC (FUNCTION 22) -- THIS ACTS >>    <<03672>>22986000
 << LIKE A DEVICE CLEAR, SO WE MUST RE-DOWNLOAD          >>    <<03672>>22988000
 << PARAMETERS JUST AS WE DO AFTER A DEVICE CLEAR        >>    <<03672>>22990000
                                                               <<03672>>22992000
   ELSE IF CPVAP.(3:13) = 4 THEN     <<DIAGNOSTIC COMPLETION>> <<03672>>22994000
      BEGIN                          << IF RELEASE TIMEOUT  >> <<03672>>22996000
      IF CS80'LOCK THEN              << WAS PREVIOUSLY DIS- >> <<03672>>22998000
         PUSH'STACK(SUPP'RELEASE);   << ABLED, MUST RESET   >> <<03672>>23000000
      END                                                      <<03672>>23002000
                                                               <<03668>>23004000
   ELSE                               << NO ERRORS >>          <<03668>>23006000
      GOOD'COMPLETION := TRUE;                                 <<03668>>23008000
                                                               <<03668>>23010000
   IF GOOD'COMPLETION THEN                                     <<03668>>23012000
                                                               <<03668>>23014000
      IF CURFUNCT = DSCT'READ THEN     << HAVE THE DSCT >>     <<03668>>23016000
         IF GOOD'DSCT(DSCT) THEN       << IF IT'S SET UP, >>   <<03668>>23018000
            BEGIN                      <<    ADD AN ENTRY >>   <<03668>>23020000
            ADD'DSCT'ENTRY(DSCT, OLD'STAT(6), OLD'STAT(7));    <<03668>>23022000
            PUSH'STACK(DSCT'WRITE);      << WRITE OUT DSCT >>  <<03668>>23024000
            END                                                <<03668>>23026000
         ELSE                       << DSCT INVALID, JUST >>   <<03668>>23028000
            BEGIN                   <<    QUIT WITH ERROR >>   <<03668>>23030000
            MOVE STATUS := OLD'STAT,(STAT'SIZE);               <<03668>>23032000
            GOTO ACCESS'ERROR;                                 <<03668>>23034000
            END                                                <<03668>>23036000
                                                               <<03668>>23038000
      ELSE IF CURFUNCT = DSCT'WRITE THEN    <<  FINISHED    >> <<03668>>23040000
         BEGIN                              << WRITING DSCT >> <<03668>>23042000
         MOVE STATUS := OLD'STAT,(STAT'SIZE);                  <<03668>>23044000
         GOTO ACCESS'ERROR;           << QUIT WITH ERROR >>    <<03668>>23046000
         END                                                   <<03668>>23048000
                                                               <<03668>>23050000
      ELSE IF NOT FIRST'OFFLINE AND    << RESET FLAG IF ON- >> <<03668>>23052000
           CURFUNCT = GET'STAT THEN    <<   LINE WAIT JUST  >> <<03668>>23054000
         FIRST'OFFLINE := TRUE;        <<   FINISHED        >> <<03668>>23056000
                                                               <<03668>>23058000
   END;  << WHILE POP'STACK(CURFUNCT) AND    >>                <<03668>>23060000
         <<       NUM'RETRIES <= MAX'RETRIES >>                <<03668>>23062000
                                                               <<03550>>23064000
IF NUM'RETRIES > MAX'RETRIES THEN       << ABORT--NUMBER OF >> <<03550>>23066000
   GOTO RETRY'ERROR;                    <<  RETRIES EXCEEDS >> <<03550>>23068000
                                        <<  MAXIMUM         >> <<03550>>23070000
$PAGE                                                          <<03550>>23072000
            <<***********************************>>            <<03550>>23074000
            <<  FUNCTION-DEPENDENT COMPLETION    >>            <<03550>>23076000
            <<***********************************>>            <<03550>>23078000
                                                               <<03550>>23080000
IF FUNCT = RSTAT THEN           << READ STATUS COMPLETION >>   <<03550>>23082000
   BEGIN                                                       <<03550>>23084000
   MOVE'STATUS;                                                <<03550>>23086000
                                                               <<03550>>23088000
   << NOTE: STATUS RETURN IS INITIALIZED TO NOT READY ABOVE >> <<03550>>23090000
                                                               <<03550>>23092000
   IF STATUS(ACCESS'FIELD).DEV'NOT'RDY THEN                    <<03550>>23094000
      SET'STATUS'RETURN(TRUE)      << RETURN NOT READY >>      <<03550>>23096000
                                                               <<03550>>23098000
   ELSE                                                        <<03550>>23100000
      SET'STATUS'RETURN(FALSE);    << RETURN READY >>          <<03550>>23102000
   END                                                         <<03550>>23104000
                                                               <<03550>>23106000
ELSE IF FUNCT = GET'VOL'LIMIT THEN   << GET VOLUME LIMIT    >> <<03550>>23108000
   BEGIN                             <<    COMPLETION       >> <<03550>>23110000
   MABS( DATA'BANK,DATA'ADDR,                                  <<03550>>23112000
         LOCAL'BUF'BANK,             << MOVE IT TO RETURN   >> <<03550>>23114000
         LOCAL'BUF'ADDR+             <<    BUFFER           >> <<03550>>23116000
            SNGL'VEC'LIMIT+1, 2);                              <<03550>>23118000
   END                                                         <<03550>>23120000
                                                               <<03550>>23122000
 << SPARE RETAINING DATA OR SPARE NOT RETAINING DATA       >>  <<03550>>23124000
 << COMPLETED SUCCESSFULLY--RETURN THE PARM'FIELD FROM THE >>  <<03550>>23126000
 << STATUS, WHICH CONTAINS THE ADDRESS + LENGTH OF THE     >>  <<03550>>23128000
 << AREA AFFECTED BY THE SPARE.                            >>  <<03550>>23130000
                                                               <<03550>>23132000
ELSE IF FUNCT = SPARE'RETAIN OR FUNCT = SPARE'NO'RETAIN THEN   <<03550>>23134000
   BEGIN                                                       <<03550>>23136000
   MABS( DATA'BANK,DATA'ADDR,0,                                <<03550>>23138000
         CHAN'PROG'BASE+STAT'AREA+PARM'FIELD,5);               <<03550>>23140000
   END                                                         <<03550>>23142000
                                                               <<03550>>23144000
ELSE IF FUNCT = DESCRIBE THEN        << DESCRIBE COMPLETION >> <<03550>>23146000
   MABS(DATA'BANK,DATA'ADDR,                                   <<03550>>23148000
        LOCAL'BUF'BANK,LOCAL'BUF'ADDR,WC)                      <<03630>>23150000
                                                               <<03550>>23152000
 << CHECK RESULTS OF R/W ERT.  IF ONLY ONE BYTE WAS   >>       <<03550>>23154000
 << TRANSFERRED BACK IN THE EXECUTION MESSAGE, THEN   >>       <<03550>>23156000
 << THE ERT WAS SUCCESSFUL.  OTHERWISE, RETURN CCL.   >>       <<03550>>23158000
                                                               <<03550>>23160000
ELSE IF FUNCT = RW'ERT OR FUNCT = RO'ERT THEN                  <<03550>>23162000
   BEGIN                                                       <<03550>>23164000
   IF ABS(CHAN'PROG'BASE+DX'COUNT) <>    << IF NOT ONE BYTE >> <<03550>>23166000
      ERT'RETURN - 1 THEN                <<  TRANSFERRED,   >> <<03550>>23168000
      GOTO CCL'EXIT;                     <<   RETURN CCL    >> <<03550>>23170000
   END;                                                        <<03550>>23172000
                                                               <<03550>>23174000
GOTO EXIT;    << TAKE NORMAL EXIT >>                           <<03550>>23176000
$PAGE                                                          <<03550>>23178000
           <<********************************>>                <<03550>>23180000
           <<        ERROR EXIT              >>                <<03550>>23182000
           <<********************************>>                <<03550>>23184000
                                                               <<03550>>23186000
FUNCT'ERROR:       << INVALID FUNCTION CODE SENT TO DRIVER >>  <<03550>>23188000
                                                               <<03550>>23190000
   ERRMESSAGE( M34, LDEV);                                     <<03550>>23192000
                                                               <<03550>>23194000
LAUNCH'ERROR:         << ERROR LAUNCHING CHANNEL PROGRAM >>    <<03550>>23196000
                                                               <<03550>>23198000
   ERROR := 5;                                                 <<03550>>23200000
   GOTO ERROR'EXIT;                                            <<03550>>23202000
                                                               <<03550>>23204000
CPVA'ERROR:           << CHANNEL ABORT OR DMA ABORT >>         <<03550>>23206000
                                                               <<03550>>23208000
   ERROR := 6;                                                 <<03550>>23210000
   GOTO ERROR'EXIT;                                            <<03550>>23212000
                                                               <<03550>>23214000
OFFLINE'ERROR:                                                 <<03550>>23216000
                                                               <<03550>>23218000
   ERROR := 7;                                                 <<03550>>23220000
   GOTO ERROR'EXIT;                                            <<03550>>23222000
                                                               <<03550>>23224000
UNIT'ERROR:           << ERROR DURING READ STATUS >>           <<03550>>23226000
                                                               <<03550>>23228000
   ERROR := 8;                                                 <<03550>>23230000
   GOTO ERROR'EXIT;                                            <<03550>>23232000
                                                               <<03550>>23234000
ID'ERROR:        << QSTAT = 1, ERROR IN THE ID'FIELD >>        <<03550>>23236000
                                                               <<03550>>23238000
   ERROR := 0;                                                 <<03550>>23240000
   GOTO ERROR'EXIT;                                            <<03550>>23242000
                                                               <<03550>>23244000
REJECT'ERROR:    << QSTAT = 1, ERROR IN THE REJECT'FIELD >>    <<03550>>23246000
                                                               <<03550>>23248000
   ERROR := 1;                                                 <<03550>>23250000
   GOTO ERROR'EXIT;                                            <<03550>>23252000
                                                               <<03550>>23254000
FAULT'ERROR:     << QSTAT = 1, ERROR IN THE FAULT'FIELD >>     <<03550>>23256000
                                                               <<03550>>23258000
   ERROR := 2;                                                 <<03550>>23260000
   GOTO ERROR'EXIT;                                            <<03550>>23262000
                                                               <<03550>>23264000
ACCESS'ERROR:    << QSTAT = 1, ERROR IN THE ACCESS FIELD >>    <<03550>>23266000
                                                               <<03550>>23268000
   ERROR := 3;                                                 <<03550>>23270000
   GOTO ERROR'EXIT;                                            <<03550>>23272000
                                                               <<03550>>23274000
RETRY'ERROR:     << NUMBER OF RETRIES EXCEEDS MAXIMUM >>       <<03550>>23276000
                                                               <<03550>>23278000
   ERROR := 4;                                                 <<03550>>23280000
   GOTO ERROR'EXIT;                                            <<03550>>23282000
                                                               <<03550>>23284000
                                                               <<03550>>23286000
$PAGE                                                          <<03550>>23288000
                                                               <<03550>>23290000
ERROR'EXIT:                                                    <<03550>>23292000
                                                               <<03550>>23294000
IF FATAL'FUNCT(FUNCT) THEN                                     <<03550>>23296000
   BEGIN                                                       <<03550>>23298000
   CASE ERROR OF                                               <<03550>>23300000
      BEGIN                                                    <<03550>>23302000
      <<  0 >> ERRMESSAGE(M30,0);     << ID'ERROR >>           <<03550>>23304000
      <<  1 >> ERRMESSAGE(M30,0);     << REJECT'ERROR >>       <<03550>>23306000
      <<  2 >> ERRMESSAGE(M30,0);     << FAULT'ERROR >>        <<03550>>23308000
      <<  3 >> ERRMESSAGE(M30,0);     << ACCESS'ERROR >>       <<03550>>23310000
      <<  4 >> ERRMESSAGE(M32,LDEV,   << RETRY'ERROR >>        <<03550>>23312000
                          DRT,UNIT);                           <<03550>>23314000
      <<  5 >> ERRMESSAGE(M2,DRT);    << LAUNCH'ERROR >>       <<03550>>23316000
      <<  6 >> ERRMESSAGE(M3,CPVAP);  << CPVA'ERROR >>         <<03550>>23318000
      <<  7 >> ERRMESSAGE(M30,1);     << OFFLINE'ERROR >>      <<03550>>23320000
      <<  8 >> ERRMESSAGE(M30,3);     << UNIT'ERROR >>         <<03550>>23322000
      END;                                                     <<03550>>23324000
   ERRMESSAGE(M30,2);     << SHOULD NOT HAPPEN >>              <<03550>>23326000
   END;                                                        <<03550>>23328000
                                                               <<03550>>23330000
CCL'EXIT:                                                      <<03550>>23332000
                                                               <<03550>>23334000
CC := CCL;    << RETURN CCL >>                                 <<03550>>23336000
                                                               <<03550>>23338000
                                                               <<03550>>23340000
EXIT:         << ALL EXITS MUST GO THROUGH THIS POINT! >>      <<03550>>23342000
                                                               <<03550>>23344000
TOS := OLDDB;      << SET DB BACK TO WHERE CALLER HAD IT >>    <<03550>>23346000
ASSEMBLE(XCHD);                                                <<03550>>23348000
                                                               <<03550>>23350000
END;  << CS80'DRIVER >>                                        <<03550>>23352000
$PAGE                                                          <<03550>>23354000
$CONTROL SEGMENT=RESIDENT                                      <<03550>>23356000
PROCEDURE MH7905'HPIB(LDEV,DRTUNIT,STYPE,FUNCT,RECORD,BUF,WC); <<03550>>23358000
    VALUE LDEV,DRTUNIT,STYPE,FUNCT,RECORD,BUF,WC;              <<03550>>23360000
    INTEGER DRTUNIT,        <<DRT AND UNIT NUMBER>>            <<03550>>23362000
            LDEV,           <<LOGICAL DEVICE NUMBER>>          <<03550>>23364000
            STYPE,          <<SUBTYPE>>                        <<03550>>23366000
            WC;             <<WORD COUNT>>                     <<03550>>23368000
                      <<NOTE: THIS DRIVER ASSUMES THAT  >>     <<03550>>23370000
                      <<THE WORD COUNT WILL NEVER EXCEED>>     <<00888>>23372000
                      <<16K WORDS FOR ONE TRANSFER.     >>     <<00888>>23374000
    LOGICAL FUNCT;  COMMENT-- 0: READ                          <<00888>>23376000
                              1: WRITE                         <<00888>>23378000
                              2: READ AND SET CCE - OK         <<00888>>23380000
                                              CCL - DEFECTIVE TRACK     23382000
                                              CCG - TRACK SPECIFIC ERROR23384000
                              3: FLAG TRACK DEFECTIVE          <<00888>>23386000
                              4: READ FULL SECTOR              <<01889>>23388000
                              5: READ STATUS                   <<03550>>23390000
                              6: NON-FATAL READ                <<01889>>23392000
                              7: INITIALIZE DEVICE             <<03550>>23394000
                                                               <<03550>>23396000
      <<NOTE!!!!                                               <<00888>>23398000
          THIS DRIVER IS CALLED WITH FUNCT=2 ONLY WHEN         <<00888>>23400000
          INITIALIZING A PACK. THUS THE DEFECTIVE TRACK        <<00888>>23402000
          TABLE IN DTT IS (OR IS BEING GENERATED) FOR          <<00888>>23404000
          LDEV.                                        ;       <<00888>>23406000
          <<**********************************>>                        23408000
           COMMENT:                                                     23410000
             When code was added for 7910 there                         23412000
           were not enough unused line numbers                          23414000
           to put desired comments so please see                        23416000
           end of this procedure for warning of                         23418000
           how 7910 works ;                                             23420000
          <<**********************************>>                        23422000
    DOUBLE RECORD,          <<DISC ADDRESS>>                   <<00888>>23424000
           BUF;             <<ABSOLUTE ADDRESS OF BUFFER>>     <<00888>>23426000
      BEGIN                                                    <<00888>>23428000
        EQUATE CLEARC  = %4400;    <<AMIGO CLEAR>>             <<00888>>23430000
        DEFINE ERRCODE  = (3:5)#,   <<ERROR BITS IN STATUS1>>  <<00888>>23432000
               NOTRDY   = (14:1)#,  <<DRIVE NOT READY>>        <<00888>>23434000
               SEEKCHECK= (13:1)#,  << SEEK CHECK ERROR >>     <<00888>>23436000
               GETSTATUS= BEGIN                                <<03067>>23438000
                          STATUSPROG(0);                       <<03067>>23440000
                          EXANWAIT(24,FALSE);                  <<03067>>23442000
                          END#,                                <<03067>>23444000
               GET'INITIAL'STATUS= IF FUNCT=RSTAT OR           <<03715>>23446000
                                      FUNCT=INIT'DEV THEN      <<03715>>23448000
                                      BEGIN                    <<00888>>23450000
                                      CP:=CLEARC;              <<00888>>23452000
                                      CP(1):=0;                <<00888>>23454000
                                      STATUSPROG(2);           <<00888>>23456000
                                      EXANWAIT(26,FALSE);      <<00888>>23458000
                                      END                      <<00888>>23460000
                                   ELSE                        <<00888>>23462000
                                      GETSTATUS#;              <<00888>>23464000
        EQUATE CHANWAIT = %1000,    <<WAIT INTSRTUCTION>>      <<00888>>23466000
               CHANJUMP = 0,        <<UNCONDITIONAL JUMP>>     <<00888>>23468000
               INTRPT'HLT=%600,     <<INTERRUPT AND HALT>>     <<00888>>23470000
               CHANREAD = %1400,    <<CHANNEL READ ORDER>>     <<00888>>23472000
               CHANWRITE= %2000,    <<CHANNEL WRITE ORDER>>    <<00888>>23474000
               CHANEND  = %177777;                             <<00888>>23476000
        EQUATE CDERR    = %17,      <<CORRECTABLE DATA ERROR>> <<00888>>23478000
               W2ERR    =%23,      <<SEE WORD2 ERROR>>         <<00888>>23480000
               SPT      = %20,      <<SPARE TRACK ERROR>>      <<00888>>23482000
               TFD      = %21;      <<DEFECTIVE TRACK>>        <<00888>>23484000
        EQUATE D        = 1,        <<DEFECTIVE TRACK BIT>>    <<00888>>23486000
               SP       = 4;        <<SPARE TRACK BIT>>        <<00888>>23488000
        EQUATE SEEKCOM  = %1000,    <<SEEK COMMAND>>           <<00888>>23490000
               REQSTAT  = %1400,    <<REQUEST STATUS COMMAND>> <<00888>>23492000
               REQADR   = %2000,    <<REQUEST SECTOR ADDRESS COMMAND>>  23494000
               ENDOP    = %12400,   <<END COMMAND>>            <<00888>>23496000
               REQSYND  = %6400,    <<REQUEST SYNDRONE COMMAND>>        23498000
               READCOM  = %2400,    <<READ COMMAND>>           <<00888>>23500000
               READFS   = %3000,    <<READ FULL SECTOR>>       <<00888>>23502000
               WRITECOM = %4000,    <<WRITE COMMAND>>          <<00888>>23504000
               VFY      = %3400,    <<VERIFY COMMAND>>         <<00888>>23506000
               INITCOM  = %5400,    <<INITIALIZE COMMAND>>     <<00888>>23508000
               ADRREC   = %6000,    <<ADDRESS RECODR COMMAND>> <<00888>>23510000
               SETFMSK  = %7400,    <<SET FILE MASK COMMAND>>  <<00888>>23512000
               REQDISCADR=%12000;   <<REQUEST DISC ADDRESS>>   <<00888>>23514000
        DOUBLE OLDDB,               <<OLD ADDRESS OF DB>>      <<00888>>23516000
               TBUFA,               <<ABSOLUTE ADDRESS OF TBUF>>        23518000
               STATUSRET,           <<LOCAL STORAGE FOR STATUS>>        23520000
               DISCADRRET,          <<LOCAL STORAGE FOR DISCADR>>       23522000
               COUNTER,                                        <<00888>>23524000
               ALTADR;              <<ALTERNATE CYLINSER,HEAD & SECT>>  23526000
        INTEGER DRT,                <<DRT NUMBER>>             <<TP.00>>23528000
                UNIT,               <<UNIT NUMBER>>            <<00888>>23530000
                SBANK,                                         <<03603>>23532000
                BUF1=BUF,BUF2=BUF+1,                           <<00888>>23534000
                I := 0,                                        <<00888>>23536000
                RETRYCOUNT:=0,                                 <<00888>>23538000
                RESIDUEINDEX, << INDEX TO RESIDUE BYTE COUNT >><<00904>>23540000
                N,                                             <<00888>>23542000
                INDEX,                                         <<00888>>23544000
                TYPE,                                          <<00888>>23546000
                CPX,                <<INDEX TO CHANNEL PROGRAM>>        23548000
                CWC,                <<CURRENT WORD COUNT>>     <<00888>>23550000
                CONSTAT,            <<CONTROLLER STATUS>>      <<00888>>23552000
                XCNT,               <<WORD COUNT>>             <<00888>>23554000
                BUFCNT,             <<WORDS FINISHED COUNT>>   <<00888>>23556000
                TRACK,              <<DEFECTIVE TRACK ENTRY>>  <<00888>>23558000
                ALTADR1=ALTADR,                                <<00888>>23560000
                ATLADR2=ALTADR+1,                              <<00888>>23562000
                COMADR;             <<ADDRESS IN BANK OF @COMMANDS>>    23564000
        LOGICAL COUNTING;                                      <<00888>>23566000
        INTEGER INITRETRY;                                     <<00888>>23568000
        INTEGER ARRAY COMMANDS(0:25)=Q; <<BUFFER FOR DISC>>    <<00888>>23570000
                        <<COMMANDS AND RETURNS FROM COMMANDS>> <<00888>>23572000
        LOGICAL STATUS1 = STATUSRET,                           <<00888>>23574000
                STATUS2 = STATUSRET+1,                         <<00888>>23576000
                DISCSTATUS1=COMMANDS+23,                       <<00888>>23578000
                DISCSTATUS2=COMMANDS+24,                       <<00888>>23580000
                DISCADR1= DISCADRRET,                          <<00888>>23582000
                DISCADR2= DISCADRRET+1;                        <<00888>>23584000
        INTEGER SEEKCYLINDER  = COMMANDS+1,                    <<00888>>23586000
                SEEKHDSECT    = COMMANDS+2,                    <<00888>>23588000
                ADRRECCYLINDER= COMMANDS+4,                    <<00888>>23590000
                ADRRECHDSECT  = COMMANDS+5,                    <<00888>>23592000
                VFYSECTCNT    = COMMANDS+20;                   <<00888>>23594000
        DOUBLE DISCSTATUS     = COMMANDS+23,                   <<00888>>23596000
               SEEKPHYSADR    = SEEKCYLINDER,                  <<00888>>23598000
               ADRRECPHYSADR  = ADRRECCYLINDER,                <<00888>>23600000
               SYNADR         = COMMANDS+10,                   <<00888>>23602000
               DISCADR        = COMMANDS+17;                   <<00888>>23604000
        INTEGER ARRAY SYNRET(*) = COMMANDS+9;                  <<00888>>23606000
        EQUATE CMSEEK = 0,        <<SEEK COMMAND INDEX>>       <<00888>>23608000
               CMADR  = 3,        <<ADDRESS RECORD INDEX>>     <<00888>>23610000
               CMEND  = 6,        <<ENDOP INDEX>>              <<00888>>23612000
               CMSFM  = 7,        <<SET FILE MASK INDEX>>      <<00888>>23614000
               CMRQSYN= 8,        <<REQUEST SYNDRONE INDEX>>   <<00888>>23616000
               CMRQDA = 16,       <<REQUEST DISC ADDRESS>>     <<00888>>23618000
               CMVFY  = 19,       <<VERIFY INEX>>              <<00888>>23620000
               CMINIT = 21,       <<INITIALIZE INDEX>>         <<00888>>23622000
               CMRQST = 22,       <<REQUEST STATUS>>           <<00888>>23624000
               CMREAD = 25;       <<READ INDEX>>               <<00888>>23626000
        LOGICAL ARRAY CP(*)   = DB+0, <<CHANNEL PROGRAM BUFFER>>        23628000
                      BUFDB(*)= DB+0;                          <<00888>>23630000
        INTEGER ARRAY TBUFDB(*)=DB+0;                          <<00888>>23632000
    INTEGER TEMP;                                              <<03002>>23634000
        INTEGER ARRAY TBUF(0:127) = Q;                         <<00888>>23636000
        <<------------------------------------->>              <<00888>>23638000
        <<COMMANDS AREA WILL BE USED AS FOLLOWS>>              <<00888>>23640000
        <<------------------------------------->>              <<00888>>23642000
          COMMENT:                                             <<00888>>23644000
          COMMANDS :=                                          <<00888>>23646000
          <<00>> SEEKCOM,                                      <<00888>>23648000
          <<01>> 0,            <<CYLINDER>>                    <<00888>>23650000
          <<02>> 0,            <<HEAD-SECTOR ADDRESS>>         <<00888>>23652000
          <<03>> ADRREC,                                       <<00888>>23654000
          <<04>> 0,            <<CYLINDER>>                    <<00888>>23656000
          <<05>> 0,            <<HEAD-SECTOR ADDRESS>>         <<00888>>23658000
          <<06>> ENDOP,                                        <<00888>>23660000
          <<07>> SETFMSK,                                      <<00888>>23662000
          <<08>> REQSYND,                                      <<00888>>23664000
          <<09>> 0,            <<RQ'SYN1>>                     <<00888>>23666000
          <<10>> 0,            <<RQ'SYN2>>                     <<00888>>23668000
          <<11>> 0,            <<RQ'SYN3>>                     <<00888>>23670000
          <<12>> 0,            <<RQ'SYN4>>                     <<00888>>23672000
          <<13>> 0,            <<RQ'SYN5>>                     <<00888>>23674000
          <<14>> 0,            <<RQ'SYN6>>                     <<00888>>23676000
          <<15>> 0,            <<RQ'SYN7N7>>                   <<00888>>23678000
          <<16>> REQDISCADR,                                   <<00888>>23680000
          <<17>> 0,                                            <<00888>>23682000
          <<18>> 0,                                            <<00888>>23684000
          <<19>> VFY,                                          <<00888>>23686000
          <<20>> 0,            <<SECTOR COUNT>>                <<00888>>23688000
          <<21>> INITCOM,                                      <<00888>>23690000
          <<22>> REQSTAT,                                      <<00888>>23692000
          <<23>> 0,            <<STATUS1>>                     <<00888>>23694000
          <<24>> 0,            <<STATUS2>>                     <<00888>>23696000
          <<25>> READCOM,                                      <<00888>>23698000
          <<25>> WRITECOM,                                     <<00888>>23700000
          <<25>> READCOM,                                      <<00888>>23702000
          <<25>> 0,                                            <<00888>>23704000
          <<25>> READFS;                                       <<00888>>23706000
        INTEGER ARRAY CHANIOPROG(0:11) = PB :=                 <<00888>>23708000
                %1000,0,       <<WAIT>>                        <<00888>>23710000
                %2010,2,0,%2000,0, <<WRITE ORDER TO CONTROLLER>>        23712000
                %1410,4,0,%2000,0; <<READ RETURN   >>          <<00888>>23714000
        INTEGER ARRAY FILEMASK(4:NMHSUBTYPES-1) = PB :=        <<00904>>23716000
        %7402,%7401,%7403,%7403,%7403,%7403,%7402,             <<00904>>23718000
        %7403,%7403,%7400;                                     <<00904>>23720000
        DEFINE SEC'CYL'FLOP=(DISCSTATUS2.(4:1)+1)*SEC'TRK'FLOP#;        23722000
        INTEGER ARRAY SEC'CYL(4:NMHSUBTYPES-1) = PB :=         <<00904>>23724000
          96, 48, 144, 144, 240, 576, 96, 96, 192, 64;         <<00904>>23726000
        INTEGER ARRAY HEADBASE(4:NMHSUBTYPES-1) = PB :=        <<00904>>23728000
          0, %1000, 0, 0, 0, 0, 0, %1000, 0, 0;                <<00904>>23730000
        EQUATE SEC'TRK'FLOP=30;                                <<00888>>23732000
        INTEGER ARRAY SECPERTRK(4:NMHSUBTYPES-1) =PB :=        <<00904>>23734000
          48,48,48,48,48,64,48,48,48,32;                       <<00904>>23736000
        INTEGER ARRAY CHANRDWRT(0:1)=PB:=CHANREAD,CHANWRITE;   <<00888>>23738000
        INTEGER ARRAY DISCOP(0:4) =PB :=                       <<00888>>23740000
          READCOM, WRITECOM, READCOM, 0, READFS, 0, READCOM;   <<01889>>23742000
                                                               <<00888>>23744000
  LOGICAL SUBROUTINE EXANWAIT(INDEX,DUMMY);                    <<00888>>23746000
    VALUE INDEX,DUMMY;                                         <<00888>>23748000
    INTEGER INDEX;                                             <<00888>>23750000
    LOGICAL DUMMY;                                             <<00888>>23752000
      BEGIN                                                    <<00888>>23754000
      COUNTING := TRUE;                                        <<00888>>23756000
      COUNTER := -64000D;                                      <<00888>>23758000
      CP(INDEX) := CHANWAIT;                                   <<00888>>23760000
      CP(X:=X+1) := 0;                                         <<00888>>23762000
      CP(X:=X+1) := INTRPT'HLT;                                <<00888>>23764000
      CP(X:=X+1) := 0;                                         <<00888>>23766000
      CP(X:=X+1) := CHANEND;                                   <<00888>>23768000
      CP(X:=X+1) := 0;                                         <<00888>>23770000
      INIT( DRT);                                              <<02510>>23774000
      IF <> THEN GO MISSINGGIC;                                <<02510>>23776000
      SIOP( DRT, ABSOLUTE(CHANPROG));                          <<02510>>23778000
      IF > THEN                                                <<00888>>23780000
         BEGIN <<FATAL ERROR - BUSY>>                          <<00888>>23782000
         ERRMESSAGE(M2,DRT);                                   <<01103>>23786000
         END;                                                  <<00888>>23788000
      IF < THEN                                                <<00888>>23790000
         BEGIN <<GIC MISSING - SET NOT READY>>                 <<00888>>23792000
MISSINGGIC:                                                    <<00888>>23794000
         TEMP:= GETDRT(DRT,CHANSTAT);  <<GET CHAN STATUS>>     <<03002>>23798000
         TEMP.(0:2):=0;  <<SET "CHANNEL COMPLETED">>           <<03002>>23800000
         PUTDRT(DRT,CHANSTAT,TEMP);                            <<03002>>23802000
         ABSOLUTE(GETDRT(DRT,DBI)).(0:2) := 0;                 <<03002>>23804000
         DISCSTATUS1.ERRCODE:=0;                               <<00888>>23806000
         DISCSTATUS2.NREADYF:=1;                               <<00888>>23808000
         END;  <<GIC MISSING - SIMULATE NOT READY>>            <<00888>>23810000
  TEST:                                                        <<00888>>23814000
          <<TEST CHANNEL STATUS>>                              <<03002>>23818000
      IF GETDRT(DRT,CHANSTAT).(0:2)=0 THEN                     <<03002>>23820000
        BEGIN <<CHANNEL PROGRAM COMPLETED>>                    <<00888>>23822000
        EXANWAIT := DISCSTATUS1;                               <<00888>>23824000
        RETURN;                                                <<00888>>23826000
        END;                                                   <<00888>>23828000
      IF (COUNTER:=COUNTER+1D)=0D AND COUNTING THEN            <<00888>>23830000
        BEGIN                                                  <<00888>>23832000
        IF FUNCT=RSTAT OR FUNCT=INIT'DEV THEN                  <<03715>>23834000
           BEGIN                                               <<00888>>23836000
           DISCSTATUS2.NREADYF:=1; <<RETURN NOT READY>>        <<00888>>23838000
           RETURN;                                             <<00888>>23840000
           END;                                                <<00888>>23842000
        MESSAGE( M2408, LDEV); << LDEV # n NOT READY >>        <<01103>>23844000
        COUNTING := FALSE;                                     <<00888>>23846000
        END;                                                   <<00888>>23848000
      GOTO TEST;                                               <<00888>>23850000
      END  <<EXANWAIT>>;                                       <<00888>>23852000
                                                               <<00888>>23854000
  SUBROUTINE SEEK;                                             <<00888>>23856000
    BEGIN                                                      <<00888>>23858000
    MOVE CP := CHANIOPROG,(7);                                 <<00888>>23860000
    CP(3) := 6;  <<BYTE COUNT>>                                <<00888>>23862000
    CP(5) := SBANK;                                            <<03603>>23864000
    CP(6) := COMADR + CMSEEK;                                  <<00888>>23866000
    COMMANDS(CMSEEK) := SEEKCOM + UNIT;                        <<00888>>23868000
    END;                                                       <<00888>>23870000
                                                               <<00888>>23872000
  SUBROUTINE STATUSPROG(INDEX);                                <<00888>>23874000
    VALUE INDEX;                                               <<00888>>23876000
    INTEGER INDEX;                                             <<00888>>23878000
      BEGIN                                                    <<00888>>23880000
      MOVE CP(INDEX) := CHANIOPROG,(12),2;                     <<00888>>23882000
      MOVE * := CHANIOPROG,(12);                               <<00888>>23884000
      CP(INDEX+5):=CP(INDEX+10):=CP(INDEX+17):=                <<00888>>23886000
        CP(INDEX+22) := SBANK;                                 <<03603>>23888000
      CP(INDEX+6) := COMADR+CMRQST;      <<REQUEST STATUS>>    <<00888>>23890000
      COMMANDS(CMRQST) := REQSTAT+UNIT;                        <<00888>>23892000
      CP(INDEX+11) := COMADR+CMRQST+1;                         <<00888>>23894000
      CP(INDEX+18) := COMADR+CMRQDA;     <<REQUEST DISC ADDRESS>>       23896000
      COMMANDS(CMRQDA) := REQDISCADR;                          <<00888>>23898000
      CP(INDEX+23) := COMADR+CMRQDA+1;                         <<00888>>23900000
      END;                                                     <<00888>>23902000
                                                               <<00888>>23904000
  DOUBLE SUBROUTINE L'PADR(LOGADR);                            <<00888>>23906000
    VALUE LOGADR;                                              <<00888>>23908000
    DOUBLE LOGADR;  <<LOGICAL ADDRESS>>                        <<00888>>23910000
      BEGIN                                                    <<00888>>23912000
      TOS := LOGADR;                                           <<00888>>23914000
      TOS := IF TYPE=DISC2 THEN                                <<00888>>23916000
         SEC'CYL'FLOP                                          <<00888>>23918000
      ELSE                                                     <<00888>>23920000
         SEC'CYL(STYPE);                                       <<00888>>23922000
      ASSEMBLE(LDIV);                                          <<00888>>23924000
      IF OVERFLOW THEN                                         <<00888>>23926000
        BEGIN    <<BAD ADDRESS>>                               <<00888>>23928000
        TOS := ABSOLUTE(DBBANK);                               <<00888>>23930000
        TOS := ABSOLUTE(DB);                                   <<00888>>23932000
        SET(DB);  <<SET DB TO INITIAL STACK>>                  <<00888>>23934000
        ERRMESSAGE(M27);                                       <<01103>>23936000
        END;                                                   <<00888>>23938000
      TOS := IF TYPE=DISC2 THEN                                <<00888>>23940000
         SEC'TRK'FLOP                                          <<00888>>23942000
      ELSE                                                     <<00888>>23944000
         SECPERTRK(STYPE);                                     <<00888>>23946000
      ASSEMBLE(DIV,XCH);                                       <<00888>>23948000
      TOS := TOS&LSL(8);                                       <<00888>>23950000
      IF TYPE<>DISC2 THEN TOS:=TOS+HEADBASE(STYPE);            <<00888>>23952000
      TOS:=TOS+TOS;     <<HEAD/SECTOR>>                        <<00888>>23954000
      DS6 := TOS;                                              <<00888>>23956000
      END <<L'PADR>> ;                                         <<00888>>23958000
                                                               <<00888>>23960000
  DOUBLE SUBROUTINE CONVERTADR(PHYSADR);                       <<00888>>23962000
    VALUE PHYSADR;                                             <<00888>>23964000
    DOUBLE PHYSADR;  <<PHYSICAL DISC ADDRESS>>                 <<00888>>23966000
      BEGIN                                                    <<00888>>23968000
      TOS := PHYSADR;                                          <<00888>>23970000
      TOS := S0;                                               <<00888>>23972000
      TOS := (TOS-HEADBASE(STYPE))&LSR(8)*                     <<00888>>23974000
             SECPERTRK(STYPE);                                 <<00888>>23976000
      ASSEMBLE(XCH);                                           <<00888>>23978000
      TOS := TOS.(8:8);  <<SECTOR #>>                          <<00888>>23980000
      ASSEMBLE(ADD,ZERO; XCH,CAB);                             <<00888>>23982000
      TOS := SEC'CYL(X);                                       <<00888>>23984000
      ASSEMBLE(LMPY,DADD);                                     <<00888>>23986000
      DS6 := TOS;  <<SECTOR ADDRESS>>                          <<00888>>23988000
      END <<CONVERTADR>> ;                                     <<00888>>23990000
                                                               <<00888>>23992000
  SUBROUTINE INITIALIZE(SECTOR,ADRRECSECT,BITS,VERIFY);        <<00888>>23994000
    VALUE SECTOR,ADRRECSECT,BITS,VERIFY;                       <<00888>>23996000
    DOUBLE SECTOR,     <<SECTOR FOR SEEK>>                     <<00888>>23998000
           ADRRECSECT; <<SECTOR FOR ADDRESS RECORD>>           <<00888>>24000000
    INTEGER BITS;      <<SPARE,DEFECTIVE OR ZERO>>             <<00888>>24002000
    LOGICAL VERIFY;    <<TRUE IF VERIFY COM TO BE EXECUTED>>   <<00888>>24004000
      COMMENT:                                                 <<00888>>24006000
        IT IS ASSUMED INITIALIZED IS NEVER CALLED FOR FLOPPY.  <<00888>>24008000
                                                               <<00888>>24010000
        INITIALIZE IS GENERALLY CALLED WITH DB POINTED TO      <<00888>>24012000
        INITIAL'S STACK,SO INITIALIZE SETS DB TO THE CHANNEL   <<00888>>24014000
        PROGRAM AREA. DB IS NOT RESET BEFORE EXITING;          <<00888>>24016000
          BEGIN                                                <<00888>>24018000
          INITRETRY:=0;                                        <<00888>>24020000
RETRYLABEL:                                                    <<00888>>24022000
          TOS := 0;                                            <<00888>>24024000
          TOS := ABSOLUTE(CHANPROG);                           <<00888>>24026000
          SET(DB);                                             <<00888>>24028000
          SEEK;                                                <<00888>>24030000
          SEEKPHYSADR := L'PADR(SECTOR);                       <<00888>>24032000
          MOVE CP(7) := CHANIOPROG,(7);                        <<00888>>24034000
          IF STYPE=S7910 THEN                                  <<00904>>24036000
            BEGIN << 7910, DON'T DO FILEMASK >>                         24038000
            CP(7) := CHANJUMP;                                          24040000
            CP(8) := 5;                                                 24042000
            END;                                                        24044000
          COMMANDS(CMSFM) := FILEMASK(STYPE)+4;<<SPARING ENABLED>>      24046000
          CP(12) := SBANK;                                     <<03603>>24048000
          CP(13) := COMADR+CMSFM;                              <<00888>>24050000
          IF VERIFY THEN                                       <<00888>>24052000
            BEGIN                                              <<00888>>24054000
            MOVE CP(14) := CHANIOPROG,(7);                     <<00888>>24056000
            COMMANDS(CMVFY) := VFY+UNIT;                       <<00888>>24058000
            COMMANDS(X:=X+1) := 1;  <<VERIFY 1 SECTOR>>        <<00888>>24060000
            CP(17) := 4;   <<COMMAND LENGTH IS FOUR BYTES>>    <<00888>>24062000
            CP(19) := SBANK;                                   <<03603>>24064000
            CP(20) := COMADR+CMVFY;                            <<00888>>24066000
            CPX := 21;                                         <<00888>>24068000
            END                                                <<00888>>24070000
          ELSE CPX := 14;                                      <<00888>>24072000
          MOVE CP(CPX) := CHANIOPROG,(7);                      <<00888>>24074000
          COMMANDS(CMADR) := ADRREC;                           <<00888>>24076000
          CP(CPX+3) := 6;   <<SIX BYTES WRITTEN>>              <<00888>>24078000
          CP(CPX+5) := SBANK;                                  <<03603>>24080000
          CP(CPX+6) := COMADR+CMADR;                           <<00888>>24082000
          ADRRECHDSECT := 0;                                   <<00888>>24084000
          IF ADRRECSECT=-1D THEN ADRRECCYLINDER := -1          <<00888>>24086000
          ELSE IF ADRRECSECT=0D THEN ADRRECCYLINDER := 0       <<00888>>24088000
               ELSE ADRRECPHYSADR := L'PADR(ADRRECSECT);       <<00888>>24090000
          CPX := CPX+7;                                        <<00888>>24092000
          MOVE CP(CPX) := CHANIOPROG,(12);                     <<00888>>24094000
          CP(CPX+5):=CP(CPX+10):=SBANK;                        <<03603>>24096000
          TOS := INITCOM+UNIT;                                 <<00888>>24098000
          TOS.(0:3) := S3;  <<BITS>>                           <<00888>>24100000
          COMMANDS(CMINIT) := TOS;                             <<00888>>24102000
          CP(CPX+6) := COMADR+CMINIT;                          <<00888>>24104000
          CP(CPX+7) := CHANWRITE;                              <<00888>>24106000
          CP(CPX+8) := SECPERTRK(STYPE)&LSL(8); <<BYTES IN A TRACK>>    24108000
          STATUSPROG(CPX+12);                                  <<00888>>24110000
          RESIDUEINDEX := CPX+8;     << INDEX TO RESIDUE >>    <<00904>>24112000
          IF (CONSTAT:=EXANWAIT(CPX+36,TRUE).ERRCODE)<>0 THEN  <<00888>>24114000
            BEGIN <<ERROR>>                                    <<00888>>24116000
            IF STYPE=S7910 AND CP(RESIDUEINDEX)=0 THEN         <<00904>>24118000
              RETURN;  << NOT AN ERROR, SEE WARNING ABOVE >>   <<00904>>24120000
            IF(INITRETRY:=INITRETRY+1)<4 THEN GOTO RETRYLABEL; <<00888>>24122000
            STATUSRET := DISCSTATUS;                           <<00888>>24124000
            DISCADRRET := DISCADR;                             <<00888>>24126000
            GOTO ERROR;                                        <<00888>>24128000
            END;                                               <<00888>>24130000
          END;   <<INITIALIZE>>                                <<00888>>24132000
                                                               <<00888>>24134000
          <<--------->>                                        <<00888>>24136000
          <<MAIN CODE>>                                        <<00888>>24138000
          <<--------->>                                        <<00888>>24140000
                                                               <<00888>>24142000
          CC := CCE;                                           <<01889>>24144000
          PUSH( SBANK );                                       <<03603>>24148000
          SBANK := TOS;   << BANK NR. OF OUR STACK >>          <<03603>>24150000
          IF ON'ICS THEN                                       <<03603>>24152000
            BEGIN                                              <<03603>>24154000
            TOS := 0;     << BANK >>                           <<03603>>24156000
            TOS := ABS(QI); << DB REGISTER TO QI >>            <<03603>>24158000
            END                                                <<03603>>24160000
          ELSE                                                 <<00888>>24162000
            BEGIN  <<LOAD STACK'S DB POINTER>>                 <<00888>>24164000
            TOS := ABSOLUTE(DBBANK);                           <<00888>>24166000
            TOS := ABSOLUTE(DB);                               <<00888>>24168000
            END;                                               <<00888>>24170000
          ASSEMBLE(DDUP,XCHD);                                 <<00888>>24172000
          OLDDB := TOS;   <<SAVE OLD DB>>                      <<00888>>24174000
          COMADR := S0+@COMMANDS; <<ADDRESS IN BANK OF COMMANDS>>       24176000
          TOS := TOS + @TBUF;                                  <<00888>>24178000
          TBUFA := TOS;   <<ABSOLUTE ADDRESS OF BUF>>          <<00888>>24180000
          COMMANDS := 0;                                       <<03603>>24182000
          MOVE COMMANDS(1) := COMMANDS,(25);                   <<03603>>24184000
          TOS := ABSOLUTE(DBBANK);                             <<00888>>24186000
          TOS := ABSOLUTE(DB);                                 <<00888>>24188000
          SET(DB);                                             <<00888>>24190000
          TYPE := IF LDEV=0 THEN ABSOLUTE(SDTYPE)              <<00892>>24192000
                  ELSE LDT(LDEV*LDTSIZE+LDT2).TYP;             <<00892>>24194000
          TOS := 0;                                            <<00888>>24196000
          TOS := ABSOLUTE(CHANPROG);                           <<00888>>24198000
          SET(DB);                                             <<00888>>24200000
          DRT := DRTUNIT.DRTFIELD;                             <<03002>>24204000
          UNIT := DRTUNIT.UNITFIELD;                           <<03002>>24206000
          GET'INITIAL'STATUS;                                  <<00888>>24208000
                                                               <<03549>>24210000
          IF FUNCT = INIT'DEV THEN   << INITIALIZE DONE BY  >> <<03715>>24212000
             BEGIN                   <<    READING STATUS   >> <<03715>>24214000
             IF DISCSTATUS2.NREADYF = 1 THEN                   <<03715>>24216000
                CC := CCL;     << RETURN CCL IF OFFLINE >>     <<03715>>24218000
             GO EXIT;                                          <<03715>>24220000
             END;                                              <<03715>>24222000
                                                               <<03549>>24224000
          IF FUNCT=RSTAT THEN                                  <<00888>>24226000
             BEGIN <<REQUEST STATUS>>                          <<00888>>24228000
             TOS:=BUF;                                         <<00888>>24230000
             ASSEMBLE (XCHD);                                  <<00888>>24232000
             BUFDB(0):=DISCSTATUS1;                            <<00888>>24234000
             BUFDB(1):=DISCSTATUS2;                            <<00888>>24236000
             ASSEMBLE (XCHD);                                  <<00888>>24238000
             GOTO EXIT;                                        <<00888>>24240000
             END;                                              <<00888>>24242000
          IF DISCSTATUS2.NOTRDY THEN                           <<00888>>24244000
            BEGIN  <<DRIVE NOT READY>>                         <<00888>>24246000
            MESSAGE(M2408,LDEV); <<NOT READY MESSAGE>>         <<01103>>24248000
            DO                                                 <<00888>>24250000
              BEGIN                                            <<00888>>24252000
              GETSTATUS;                                       <<00888>>24254000
              END                                              <<00888>>24256000
            UNTIL NOT(DISCSTATUS2.NOTRDY);                     <<00888>>24258000
            END;                                               <<00888>>24260000
  STARTOVER:                                                   <<00888>>24262000
          RETRYCOUNT:=RETRYCOUNT+1;                            <<00888>>24264000
          IF FUNCT<>3 THEN                                     <<00888>>24266000
            BEGIN  <<NOT FLAG TRACK>>                          <<00888>>24268000
  AGAIN:    SEEK;                                              <<00888>>24270000
            SEEKPHYSADR := L'PADR(RECORD);                     <<00888>>24272000
            IF TYPE<>DISC2 AND STYPE<>S7910 THEN               <<00904>>24274000
              BEGIN  <<7905-MUST SET FILE MASK>>               <<00888>>24276000
              MOVE CP(7) := CHANIOPROG,(7);<<SET FILE MASK>>   <<00888>>24278000
              MOVE CP(14) := CHANIOPROG,(7);<<ADDRESS RECORD>> <<00888>>24280000
                COMMENT:                                       <<00888>>24282000
                  THE ADDRESS RECORD IS NECESSARY AFTER A SEEK <<00888>>24284000
                  BECAUSE IF ANOTHER UNIT COMES ON LINE AFTER  <<00888>>24286000
                  THE SEEK STARTS, THE CONTROLLER MUST BE TOLD <<00888>>24288000
                  WHERE IT DID THE SEEK TO;                    <<00888>>24290000
              TOS := FILEMASK(STYPE);                          <<00888>>24292000
              IF FUNCT<2 OR FUNCT=NON'FATAL'READ THEN          <<01889>>24294000
                TOS.(13:1) := 1;  << SPARING ENABLED >>        <<01889>>24296000
              COMMANDS(CMSFM) := TOS;                          <<00888>>24298000
              CP(12):=CP(19):=SBANK;                           <<03603>>24300000
              CP(13) := COMADR+CMSFM; <<SET FILE MASK>>        <<00888>>24302000
              CP(20) := COMADR+CMADR; <<ADDRESS RECORD>>       <<00888>>24304000
              COMMANDS(CMADR) := ADRREC;                       <<00888>>24306000
              CP(17) := 6;  <<SIX BYTES>>                      <<00888>>24308000
              ADRRECPHYSADR := SEEKPHYSADR;                    <<00888>>24310000
              CPX := 21;                                       <<00888>>24312000
              END                                              <<00888>>24314000
            ELSE CPX := 7;  << FLOPPY OR 7910 >>               <<00904>>24316000
            MOVE CP(CPX) := CHANIOPROG,(7); <<XFER PROGRAM>>   <<00888>>24318000
            MOVE CP(CPX+7) := CHANIOPROG(7),(5);               <<00888>>24320000
            CP(CPX+5) := SBANK;                                <<03603>>24322000
            CP(CPX+6) := COMADR+CMREAD;<<XFER COMMAND>>        <<00888>>24324000
            COMMANDS(CMREAD) := DISCOP(FUNCT)+UNIT;            <<00888>>24326000
            CP(CPX+7):=CHANRDWRT(FUNCT.(15:1));<<CHAN COMND>>  <<00888>>24328000
            TOS := WC;                                         <<00888>>24330000
            IF 10<=STYPE<=11 OR STYPE=4 THEN                   <<00888>>24332000
              BEGIN <<CHECK FOR CYLINDER OVERFLOW>>            <<00888>>24334000
              TOS := SEC'CYL(STYPE);                           <<00888>>24336000
              TOS := RECORD;                                   <<00888>>24338000
              TOS := S2;                                       <<00888>>24340000
              ASSEMBLE(LDIV,DELB;SUB);                         <<00888>>24342000
              TOS := TOS&LSL(7);                               <<00888>>24344000
              ASSEMBLE(DDUP,LCMP);                             <<00888>>24346000
              IF < THEN ASSEMBLE(XCH);                         <<00888>>24348000
              DELB;                                            <<00888>>24350000
              END;                                             <<00888>>24352000
            CWC := S0;  <<# OF WORDS TO TRANSFER>>             <<00888>>24354000
            XCNT := I;                                         <<00888>>24356000
            CP(CPX+8) := CWC&LSL(1);  <<BYTE COUNT>>           <<00888>>24358000
            TOS := BUF1;                                       <<00888>>24360000
            CP(CPX+10) := TOS;  <<BANK NUMBER>>                <<00888>>24362000
            CP(X:=X+1) := BUF2+XCNT;                           <<00888>>24364000
            CPX := (X:=X+1)+24;     <<AFTER STATUS PROG>>      <<00888>>24366000
            STATUSPROG(X);                                     <<00888>>24368000
            IF (CONSTAT:=EXANWAIT(CPX,TRUE).ERRCODE)<>0 THEN   <<00888>>24370000
              BEGIN   <<ERROR>>                                <<00888>>24372000
              STATUSRET := DISCSTATUS;                         <<00888>>24374000
              DISCADRRET := DISCADR;                           <<00888>>24376000
              <<STATUS AND ADR SAVED IN CASE DRIVER CALLED RECURSIVELY>>24378000
              IF (1<=CONSTAT<=%16 OR %22<=CONSTAT<=%37)        <<00888>>24380000
              AND RETRYCOUNT<4 THEN GOTO STARTOVER;            <<00888>>24382000
              IF CONSTAT=W2ERR AND DISCSTATUS2.SEEKCHECK=1 AND <<00888>>24384000
              WC-CWC<=0 THEN                                   <<00888>>24386000
                 BEGIN <<FALSE ERROR DUE TO OVERREAD>>         <<00888>>24388000
                 <<THIS ERROR CONDITION OCCURS WHEN THE>>      <<00888>>24390000
                 <<CONTROLLER FAILS TO GET THE DISC XFER>>     <<00888>>24392000
                 <<STOPPED BEFORE THE DISC RUNS INTO A>>       <<00888>>24394000
                 <<DEFECTIVE TRACK.  THE DISC USUALLY>>        <<00888>>24396000
                 <<READS 3 OR 4 SECTORS BEYOND THE END OF>>    <<00888>>24398000
                 <<TRANSFER BEFORE THE CONTROLLER CAN GET IT>> <<00888>>24400000
                 <<TO STOP, BUT THE CONTROLLER THROWS THE>>    <<00888>>24402000
                 <<DATA INTO THE BIT BUCKET.  IF, HOWEVER, >>  <<00888>>24404000
                 <<THIS EXTRA DATA IS ON A BAD TRACK, A FALSE>><<00888>>24406000
                 <<ERROR MESSAGE WILL BE REPORTED.>>           <<00888>>24408000
                 GOTO NOREALERR;                               <<00888>>24410000
                 END;  <<FALSE ERROR DUE TO OVERREAD>>         <<00888>>24412000
              IF CONSTAT=CDERR THEN                            <<00888>>24414000
                BEGIN <<POSSIBLE CORRECTABLE ERROR>>           <<00888>>24416000
                MOVE CP := CHANIOPROG,(12);                    <<00888>>24418000
                CP(5):=CP(10):= SBANK;                         <<03603>>24420000
                CP(6) := COMADR+CMRQSYN;                       <<00888>>24422000
                COMMANDS(CMRQSYN) := REQSYND;                  <<00888>>24424000
                CP(8) := 14;   <<READ 14 BYTES OF STATUS>>     <<00888>>24426000
                CP(11) := CP(6)+1; <<READ INTO SYNRET>>        <<00888>>24428000
                EXANWAIT(12,TRUE);                             <<00888>>24430000
                IF SYNRET.ERRCODE=CDERR THEN                   <<00888>>24432000
                  BEGIN <<CORRECTABLE ERROR>>                  <<00888>>24434000
                  TOS := CONVERTADR(SYNADR)-RECORD;            <<00888>>24436000
                  XCNT := TOS&LSL(7);                          <<00888>>24438000
                  N := TOS;  <<ZERO>>                          <<00888>>24440000
                  TOS := XCNT+SYNRET(3);  <<DISPLACEMENT>>     <<00888>>24442000
                  ASSEMBLE(DUP,NEG);                           <<00888>>24444000
                  BUFCNT := TOS+CWC;  <<BUFFER LIMIT>>         <<00888>>24446000
                  INDEX := TOS;  <<BUFFER INDEX>>              <<00888>>24448000
                  TOS := BUF;                                  <<00888>>24450000
                  ASSEMBLE(XCHD); <<SET DB TO BUF>>            <<00888>>24452000
                  DO IF 0<=(SYNRET(3)+N)<=127 AND (BUFCNT-N)>0 <<00888>>24454000
                    THEN BUFDB(X) := LOGICAL(SYNRET(4+N)) XOR  <<00888>>24456000
                    BUFDB(I+N+INDEX)                           <<00888>>24458000
                  UNTIL (N:=N+1)=3;                            <<00888>>24460000
                  ASSEMBLE(XCHD);  <<RESET DB>>                <<00888>>24462000
                  CWC := XCNT+128;                             <<00888>>24464000
                  GOTO CONTXFER;                               <<00888>>24466000
                  END;                                         <<00888>>24468000
                STATUS1 := SYNRET;                             <<00888>>24470000
                GOTO UNCORRECTABLE;                            <<00888>>24472000
                END;                                           <<00888>>24474000
              IF CONSTAT=SPT OR STATUS1.(0:1) THEN             <<00904>>24476000
                BEGIN  <<SPARE TRACK>>                         <<00888>>24478000
                TOS := ABSOLUTE(DBBANK);                       <<00888>>24480000
                TOS := ABSOLUTE(DB);                           <<00888>>24482000
                SET(DB); <<SET DB TO STACK FOR CALL TO ALTTRACK>>       24484000
                TOS := 0;                                      <<00888>>24486000
                TOS := LDEV;                                   <<00888>>24488000
                TOS := RECORD;                                 <<00888>>24490000
                TOS := SECPERTRK(STYPE);                       <<00888>>24492000
                ASSEMBLE(LDIV,DEL);                            <<00888>>24494000
                TOS := ALTTRACK(*,*);  <<GET ALTERNATE ADDRESS>>        24496000
                IF TOS >= 0 THEN                               <<00888>>24498000
                  BEGIN  <<A FORMER SPARE TRACK>>              <<00888>>24500000
                  IF SEEKCYLINDER>=DTT(DTTLPS) THEN INITIALIZE(RECORD,  24502000
                    0D,SP,0)  <<SPARE TRACK>>                  <<00888>>24504000
                  ELSE INITIALIZE(RECORD,RECORD,0,0); <<NORMAL>>        24506000
                  CC := CCE;  <<OK>>                           <<00888>>24508000
                  END                                          <<00888>>24510000
                ELSE                                           <<00888>>24512000
                  BEGIN  <<DEFECTIVE>>                         <<00888>>24514000
  DEFECTIVE:      IF SEEKCYLINDER>=DTT(DTTLPS) THEN INITIALIZE(RECORD,  24516000
                    -1D,SP,0)   <<DEFECTIVE IN SPARE AREA>>    <<00888>>24518000
                  ELSE INITIALIZE(RECORD,-1D,D,0);             <<00888>>24520000
                  CC := CCL;                                   <<00888>>24522000
                  END;                                         <<00888>>24524000
                GO EXIT;                                       <<00888>>24526000
                END;                                           <<00888>>24528000
              IF CONSTAT=TFD OR STATUS1.(1:1) THEN             <<00904>>24530000
                GOTO DEFECTIVE;  << FLAGGED TRACK >>           <<00904>>24532000
  ERROR:      IF LDEV=0 THEN ASSEMBLE(HALT 0);  <<IN BOOTSTRAP>>        24534000
              IF 7<=CONSTAT<=%11 THEN                          <<00888>>24536000
                BEGIN  <<TRACK SPECIFIC ERROR>>                <<00888>>24538000
  UNCORRECTABLE:IF FUNCT=2 THEN                                <<00888>>24540000
                  BEGIN  <<RETURN CCG>>                        <<00888>>24542000
                  CC := CCG;                                   <<00888>>24544000
                  GO EXIT;                                     <<00888>>24546000
                  END;                                         <<00888>>24548000
                TOS := CONVERTADR(DISCADRRET);                 <<00888>>24550000
                TOS := SECPERTRK(STYPE);                       <<00888>>24552000
                ASSEMBLE(LDIV,DEL);  <<TRACK #>>               <<00888>>24554000
                TOS := TOS&LSL(2);                             <<00888>>24556000
                IF <> THEN                                     <<00888>>24558000
                  BEGIN  <<ADD TO DEFECTIVE TRACKS TABLE>>     <<00888>>24560000
                  IF STATUS1.(0:1) THEN TOS:=TOS+1;<<SPARE>>   <<00888>>24562000
                  TRACK := TOS;                                <<00888>>24564000
                  MH7905'HPIB(LDEV,DRTUNIT,STYPE,0,1D,TBUFA,   <<02510>>24566000
                    128);                                      <<02510>>24568000
                  TOS := TBUFA;                                <<00888>>24570000
                  ASSEMBLE(XCHD); <<SET DB TO TBUF>>           <<00888>>24572000
                  X := 0;                                      <<00888>>24574000
                  WHILE (X:=X+1)<=TBUFDB DO                    <<00888>>24576000
                  IF TBUFDB(X)= TRACK  THEN GOTO PRINTERR;     <<00888>>24578000
                  IF X>120 THEN GOTO PRINTERR;                 <<00888>>24580000
                  TBUFDB := TBUFDB+1;                          <<00888>>24582000
                  TBUFDB(X) := TRACK;                          <<00888>>24584000
                  MH7905'HPIB(LDEV,DRTUNIT,STYPE,1,1D,TBUFA,   <<02510>>24586000
                    128);                                      <<02510>>24588000
                  END;                                         <<00888>>24590000
                END;                                           <<00888>>24592000
                IF FUNCT = NON'FATAL'READ THEN                 <<01889>>24594000
                  BEGIN                                        <<01889>>24596000
                  CC := CCL;                                   <<01889>>24598000
                  GO TO EXIT;                                  <<01889>>24600000
                  END;                                         <<01889>>24602000
  PRINTERR:     DISCERROR(LDEV,STATUS1,CONVERTADR(DISCADRRET),0,FUNCT.  24604000
                 (15:1),IF INTEGER(STATUS2)<0 THEN STATUS2 ELSE<<00888>>24606000
                 0);                                           <<00888>>24608000
              END;                                             <<00888>>24610000
              TOS := ABSOLUTE(GETDRT(DRT,DBI));  <<CPVA0>>     <<03002>>24614000
                 <<FETCH WORD0 OF CPVA,CHECK FOR ABORT>>       <<03002>>24616000
              IF S0.(0:2)=3 AND RETRYCOUNT<4 THEN              <<00888>>24618000
                 BEGIN                                         <<00888>>24620000
                 DEL;                                          <<00888>>24622000
                 GOTO STARTOVER;                               <<00888>>24624000
                 END;                                          <<00888>>24626000
              IF S0.(0:2)=3 THEN                               <<00888>>24628000
                 BEGIN <<IRRECOVERABLE CHANNEL ABORT>>         <<00888>>24630000
                 ERRMESSAGE(M3,S0); << CHANNEL PGM ABORT >>    <<01103>>24632000
                 END                                           <<00888>>24634000
              ELSE                                             <<00888>>24636000
                 DEL;                                          <<00888>>24638000
NOREALERR:  IF FUNCT=2 THEN                                    <<00888>>24640000
              BEGIN  <<TYPE 2 READ - OK>>                      <<00888>>24642000
              TOS := ABSOLUTE(DBBANK);                         <<00888>>24644000
              TOS := ABSOLUTE(DB);                             <<00888>>24646000
              ASSEMBLE(XCHD); <<SET DB TO STACK>>              <<00888>>24648000
              CC := CCE;                                       <<00888>>24650000
              IF SEEKCYLINDER>DTT(DTTLPS) THEN INITIALIZE(RECORD,0D,SP, 24652000
                0);  <<FLAG AS SPARE>>                         <<00888>>24654000
              GO EXIT;                                         <<00888>>24656000
              END;                                             <<00888>>24658000
  CONTXFER: I := I+CWC;                                        <<00888>>24660000
            WC := WC-CWC;                                      <<00888>>24662000
            IF <= THEN GO EXIT;                                <<00888>>24664000
            TOS := 0;                                          <<00888>>24666000
            TOS := (CWC+127)&LSR(7);                           <<00888>>24668000
            RECORD := TOS+RECORD;                              <<00888>>24670000
            GOTO AGAIN;                                        <<00888>>24672000
            END                                                <<00888>>24674000
          ELSE                                                 <<00888>>24676000
            BEGIN  <<FLAG A TRACK DEFECTIVE>>                  <<00888>>24678000
            TOS := BUF;                                        <<00888>>24680000
            ASSEMBLE(LSEA;DELB,DELB);                          <<00888>>24682000
            IF S0<>-1 THEN                                     <<00888>>24684000
              BEGIN <<POINT ALTERNATE AT DEFECTIVE TRACK>>     <<00888>>24686000
              TOS := TOS**LOGICAL(SECPERTRK(STYPE));           <<00888>>24688000
              INITIALIZE(*,RECORD,SP,0);                       <<00888>>24690000
              END;                                             <<00888>>24692000
            TOS := ABSOLUTE(DBBANK);                           <<00888>>24694000
            TOS := ABSOLUTE(DB);                               <<00888>>24696000
            ASSEMBLE(XCHD;DDEL); <<SET DB TO STACK>>           <<00888>>24698000
            TOS := 0;                                          <<00888>>24700000
            TOS := LDEV;                                       <<00888>>24702000
            TOS := RECORD;                                     <<00888>>24704000
            TOS := SECPERTRK(STYPE);                           <<00888>>24706000
            ASSEMBLE(LDIV,DEL);  <<TRACK #>>                   <<00888>>24708000
            TOS := ALTTRACK(*,*);                              <<00888>>24710000
            IF TOS<>-1 THEN                                    <<00888>>24712000
              BEGIN <<GARBAGE FORMER SPARE TRACK>>             <<00888>>24714000
              INITIALIZE(RECORD,-1D,SP,1);                     <<00888>>24716000
              TOS := ABSOLUTE(DBBANK);                         <<00888>>24718000
              TOS := ABSOLUTE(DB);                             <<00888>>24720000
              ASSEMBLE(XCHD;DDEL);<<RESET DB >>                <<00888>>24722000
              END;                                             <<00888>>24724000
            TOS := RECORD;                                     <<00888>>24726000
            TOS := BUF;                                        <<00888>>24728000
            ASSEMBLE(LSEA;DELB,DELB);                          <<00888>>24730000
            IF S0=-1 THEN                                      <<00888>>24732000
              BEGIN  <<DELETE>>                                <<00888>>24734000
              DEL;                                             <<00888>>24736000
              SEEKPHYSADR := L'PADR(RECORD);                   <<00888>>24738000
              TOS := -1D;                                      <<00888>>24740000
              IF SEEKCYLINDER >= DTT(DTTLPS) THEN TOS:=SP ELSE TOS:=D;  24742000
              END                                              <<00888>>24744000
            ELSE                                               <<00888>>24746000
              BEGIN  <<REASSIGN>>                              <<00888>>24748000
              TOS := TOS**LOGICAL(SECPERTRK(STYPE));           <<00888>>24750000
              TOS := D;                                        <<00888>>24752000
              END;                                             <<00888>>24754000
            INITIALIZE(*,*,*,0);                               <<00888>>24756000
            END;                                               <<00888>>24758000
  EXIT:   TOS := OLDDB;                                        <<00888>>24760000
          ASSEMBLE(XCHD); <<SET DB TO OLD DB>>                 <<00888>>24762000
      COMMENT:                                                 <<00904>>24764000
                                                                        24766000
**************************************************************          24768000
            W  A  R  N  I  N  G                                         24770000
**************************************************************          24772000
                                                                        24774000
     The 7910 has a "feature" which                                     24776000
can cause errors to be incorrectly diagnosed.                           24778000
This "feature" is automatic address verication                          24780000
when a seek is issued.  The result is that a status                     24782000
returned after a seek completion(caused by either                       24784000
issuance of a seek command or by an automatic seek                      24786000
following a transfer at the end of a track) to a track                  24788000
which is defective,protected,or spared will indicate an                 24790000
error even if no data is transfered (the 7905/06/20/25                  24792000
interface                                                               24794000
will only return an error if a data transfer is attempted).             24796000
                                                                        24798000
     What this means is that whenever an error is returned,             24800000
some check should be made to be sure that the error                     24802000
did in fact occur in the area of the disc that the                      24804000
caller is transferring to(from).  It seems that to be                   24806000
absolutely sure that the error occured within the area                  24808000
of immediate concern, the disc address of the error                     24810000
should be obtained and compared with where the transfer                 24812000
should have ended.  However, in most cases, the byte                    24814000
count in the channel program can be checked to see if it                24816000
is zero(NOTE: this method may be used iff the channel program           24818000
allows this count to be updated by the I/O processor).                  24820000
                                                                        24822000
     This problem is made a little more cumbersome by                   24824000
the fact that the error returned depends on the type                    24826000
of seek which occurred (whether a seek was issued or                    24828000
an automatic seek by the controller).In the case of seeking             24830000
to a spare track, if the status is following a seek                     24832000
command, then the error returned is illegal access to a                 24834000
spare track.  However, if the status is following an                    24836000
automatic seek as a result of a transfer at the end of a                24838000
track, the error returned is different.  In the latter case             24840000
I think the error returned depends on the address field                 24842000
of the track to which the seek is done.  Since the cases                24844000
that I have encountered have zero in the address field for              24846000
spare tracks which are not assigned as alternates, the error I have     24848000
seen is cylinder miscompare error for this condition.                   24850000
                                                                        24852000
     Note that the HPIB interface for the 7905/06/20/25 disc            24854000
has a similar problem                                                   24856000
on buffered reads.  It does seem that the cases are more                24858000
limit than with the 7910.  The problem seems only to occur              24860000
on reads that would terminate within two                                24862000
sectors of a defective                                                  24864000
area or spare track.  Because data is buffered in advance of            24866000
the actual transfer, an error will be returned even                     24868000
though the error was not in the area of the disc of                     24870000
the requested transfer.  In this situation, it seems to                 24872000
be sufficient to check for a byte residue count of zero.                24874000
The addresses could also be compared to determine if the                24876000
error occured beyond the area of concern.                               24878000
                                                                        24880000
                                                                        24882000
*************************************************************;          24884000
        END <<MH7905>>;                                                 24886000
$CONTROL SEGMENT=RESIDENT                                      <<02510>>24888000
PROCEDURE MH7905(LDEV,DRTUNIT,STYPE,FUNCT,RECORD,BUF,WC);      <<02510>>24890000
   VALUE LDEV,DRTUNIT,STYPE,FUNCT,RECORD,BUF,WC;               <<02510>>24892000
   INTEGER LDEV,DRTUNIT,STYPE,WC;                              <<02510>>24894000
   LOGICAL FUNCT;                                              <<02510>>24896000
   DOUBLE RECORD,BUF;                                          <<02510>>24898000
BEGIN                                                          <<02510>>24900000
$IF X1=OFF << ******* SERIES II/III UNIQUE ******* >>          <<02510>>24902000
   IF SERIESII'III THEN                                        <<02510>>24904000
      BEGIN                                                    <<02510>>24906000
      TOS := DRTUNIT.DRTFIELD;                                 <<03002>>24908000
      ASSEMBLE( TIO 0 );                                       <<02510>>24910000
      IF <> THEN                                               <<02510>>24912000
         BEGIN                                                 <<02510>>24914000
         IF STARFISH THEN                                      <<02510>>24916000
            GO HPIB'DVR                                        <<02510>>24918000
         ELSE                                                  <<02510>>24920000
            ERRMESSAGE(M1,DRTUNIT.DRTFIELD);                   <<03002>>24922000
         END                                                   <<02510>>24924000
      ELSE                                                     <<02510>>24926000
         MH7905'SIO(LDEV,DRTUNIT,STYPE,FUNCT,RECORD,BUF,       <<02510>>24928000
                    WC);                                       <<02510>>24930000
      END                                                      <<02510>>24932000
   ELSE                                                        <<02510>>24934000
$IF << ******** RETURN TO COMMON CODE ********* >>             <<02510>>24936000
HPIB'DVR:                                                      <<02510>>24938000
      MH7905'HPIB(LDEV,DRTUNIT,STYPE,FUNCT,RECORD,BUF,WC);     <<02510>>24940000
   PUSH( STATUS );                                             <<02510>>24942000
   TOS := TOS.(6:2);                                           <<02510>>24944000
   CC := TOS;                                                  <<02510>>24946000
END;                                                           <<02510>>24948000
$IF X1=ON <<  ******  SERIES 33 UNIQUE  ******* >>             <<02510>>24950000
$CONTROL SEGMENT=RESIDENT                                      <<02510>>24952000
PROCEDURE MHDISC(LDEV,DRTUNIT,STYPE,FUNCT,RECORD,BUF,WC);      <<00888>>24954000
    VALUE LDEV,DRTUNIT,STYPE,FUNCT,RECORD,BUF,WC;              <<00888>>24956000
    INTEGER DRTUNIT,LDEV,STYPE,WC;                             <<00888>>24958000
    LOGICAL FUNCT;                                             <<00888>>24960000
    DOUBLE RECORD,BUF;                                         <<00888>>24962000
BEGIN                                                          <<00888>>24964000
    ERRMESSAGE(M126); <<DRIVER DOES NOT EXIST>>                <<01103>>24966000
END;                                                           <<00888>>24968000
PROCEDURE FHDISC(LDEV,DRTUNIT,STYPE,FUNCT,RECORD,BUF,WC);      <<00888>>24970000
    VALUE LDEV,DRTUNIT,STYPE,FUNCT,RECORD,BUF,WC;              <<00888>>24972000
    INTEGER DRTUNIT,LDEV,STYPE,WC;                             <<00888>>24974000
    LOGICAL FUNCT;                                             <<00888>>24976000
    DOUBLE RECORD,BUF;                                         <<00888>>24978000
BEGIN                                                          <<00888>>24980000
    ERRMESSAGE(M126); <<DRIVER DOES NOT EXIST>>                <<01103>>24982000
END;                                                           <<00888>>24984000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>24986000
$PAGE                                                                   24988000
$CONTROL SEGMENT=RESIDENT                                               24990000
          <<------------------------------>>                   <<00888>>24992000
          <<DISC DRIVER (ABSOLUTE ADDRESS)>>                   <<00888>>24994000
          <<------------------------------>>                   <<00888>>24996000
  PROCEDURE DISC'(WRITE,LDEV,RECORD,BUF,WORDS);                <<00888>>24998000
    VALUE WRITE,LDEV,RECORD,BUF,WORDS;                         <<00888>>25000000
    INTEGER WRITE,    <<0 FOR READ, 1 FOR WRITE>>              <<00888>>25002000
            LDEV,     <<LOGICAL DEVICE #>>                     <<00888>>25004000
            WORDS;    <<# OF WORDS TO TRANSFER>>               <<00888>>25006000
    DOUBLE RECORD,    <<SECTOR ADDRESS>>                       <<00888>>25008000
           BUF;       <<ABSOLUTE CORE ADDRESS>>                <<00888>>25010000
    COMMENT                                                    <<00888>>25012000
      PERFORMS SAME FUNCTION AS PROCEDURE DISC. BUFFER ADDRESS IS       25014000
    ASSUMED TO BE ABSOLUTE;                                    <<00888>>25016000
      BEGIN                                                    <<00888>>25018000
          CC := CCE;                                           <<01889>>25020000
          IF WORDS=0 THEN RETURN;                              <<00888>>25022000
          TOS := LDEV;                                         <<00888>>25024000
          TOS := DVRTAB(LDEV*DVRSIZE);  <<DRT AND UNIT>>       <<00888>>25026000
          TOS := LPDT(LDEV*LPDTSIZE+LPDT1).SUBTYPE;            <<00888>>25028000
          TOS := WRITE;                                        <<00888>>25030000
          TOS := RECORD;                                       <<00888>>25032000
          BS1 := 0;                                            <<03603>>25034000
          TOS := BUF;                                          <<00888>>25036000
          TOS := WORDS;                                        <<00888>>25038000
          TOS := LDT(LDEV*LDTSIZE+LDT2).TYP;                   <<00888>>25040000
          IF S0=FHDISCTYPE THEN TOS := @FHDISC                 <<00888>>25042000
       ELSE                                                    <<00888>>25044000
          IF S0=MHDISCTYPE THEN                                <<00888>>25046000
             IF S7 < 4 THEN TOS := @MHDISC                     <<00888>>25048000
          ELSE                                                 <<00888>>25050000
             IF S7 < NMHSUBTYPES THEN TOS := @MH7905           <<00888>>25052000
          ELSE                                                 <<00888>>25054000
             ERRMESSAGE(M126,0)                                <<01103>>25056000
       ELSE                                                    <<00888>>25058000
          IF S0=DISC2 THEN TOS := @MH7905                      <<00888>>25062000
       ELSE                                                    <<00888>>25064000
          IF S0=DISC3 THEN TOS := @CS80'DRIVER  <<CALL CS'80>> <<03550>>25066000
                                                << DRIVER   >> <<03550>>25068000
       ELSE     << BAD DISC TYPE >>                            <<03550>>25070000
          ERRMESSAGE(M126,2);                                  <<01103>>25074000
          ASSEMBLE(DELB; PCAL 0);                              <<00888>>25076000
                                                               <<03549>>25078000
          PUSH(STATUS);     << PRESERVE CC RETURN FROM      >> <<03549>>25080000
          TOS := TOS.(6:2); << DRIVER.  NOTE: DO NOT        >> <<03549>>25082000
          CC := TOS;        << SHORTEN THESE STEPS--        >> <<03549>>25084000
                            << COMPILER PRODUCES WRONG CODE >> <<03549>>25086000
      END <<DISC'>> ;                                          <<00888>>25088000
          <<-----------------------------------                         25090000
            DISC DRIVER (DB-RELATIVE ADDRESS)                           25092000
          ----------------------------------->>                         25094000
  PROCEDURE DISC(WRITE,LDEV,RECORD,BUF,WORDS);                          25096000
    VALUE WRITE,LDEV,RECORD,WORDS;                                      25098000
    INTEGER WRITE,       <<0 FOR READ, 1 FOR WRITE>>                    25100000
            LDEV,        <<LOGICAL DEVICE NUMBER OF DISC>>              25102000
            WORDS;       <<NUMBER OF WORDS TO TRANSFER>>                25104000
    DOUBLE RECORD;       <<SECTOR ADDRESS>>                             25106000
    ARRAY BUF;           <<CORE BUFFER>>                                25108000
    COMMENT                                                             25110000
      CALLS THE APPROPRIATE DRIVER BASED ON THE TYPE OF THE DISC        25112000
    FOUND IN THE LDT. THE BUFFER ADDRESS PASSED IS ASSUMED TO BE        25114000
    DB-RELATIVE;                                                        25116000
BEGIN                                                          <<00888>>25118000
   DOUBLE ABSBUF = Q+1;                                        <<00888>>25120000
                                                               <<00888>>25122000
   CC := CCE;                                                  <<01889>>25124000
   PUSH( DB );                                                 <<00888>>25126000
   TOS := TOS+@BUF;                                            <<00888>>25128000
   DISC'( WRITE, LDEV, RECORD, ABSBUF, WORDS);                 <<00888>>25130000
                                                               <<03549>>25132000
   PUSH(STATUS);       << PRESERVE CONDITION CODE RETURN >>    <<03549>>25134000
   TOS := TOS.(6:2);   << FROM DRIVER.  NOTE:  DO NOT    >>    <<03549>>25136000
   CC := TOS;          << SHORTEN THESE STEPS-- COMPILER >>    <<03549>>25138000
                       << PRODUCES WRONG CODE.           >>    <<03549>>25140000
END;                                                           <<00888>>25142000
          <<------------------------                                    25144000
            FLAG A TRACK DEFECTIVE                                      25146000
          ------------------------>>                                    25148000
PROCEDURE FLAGTRACK(LDEV,TRACK,ALT);                                    25150000
  VALUE   LDEV,TRACK,ALT;                                               25152000
  INTEGER LDEV,TRACK,ALT;                                               25154000
    COMMENT                                                             25156000
      FLAGS A TRACK DEFECTIVE ON THE MOVING HEAD DISC, WRITING THE      25158000
    ALTERNATE TRACK ADDRESS IN THE CYLINDER ADDRESS WORD;               25160000
      BEGIN                                                             25162000
        INTEGER STYPE;                                                  25164000
        INTEGER ARRAY B(0:45) = Q;                                      25166000
          TOS := LDEV;                                                  25168000
          TOS := DVRTAB(LDEV*DVRSIZE);  <<DRT AND UNIT>>                25170000
          TOS := LPDT(LDEV*LPDTSIZE+LPDT1).SUBTYPE;                     25172000
          STYPE := S0;                                                  25174000
          TOS := 3;                                                     25176000
          TOS := ALT;  <<ALTERNATE TRACK ADDRESS>>                      25178000
          IF = AND STYPE>3 THEN TOS:=TOS-1;  <<FOR 7905>>               25180000
          IF STYPE=2 THEN ASSEMBLE(TRBC 7);  <<8 BITS ONLY>>            25182000
          B := TOS;                                                     25184000
          TOS := MHINFO (STYPE*MHINFOSIZE + MHSECTRK);         <<25.00>>25186000
          TOS := TRACK;                                                 25188000
          ASSEMBLE(LMPY);                                               25190000
          PUSH(DB);                                                     25192000
          TOS := TOS + @B;                                              25194000
          TOS := 46;  <<WORD COUNT>>                                    25196000
          IF STYPE<4 THEN TOS:=@MHDISC ELSE TOS := @MH7905;             25198000
          ASSEMBLE(PCAL 0);                                             25200000
      END <<FLAGTRACK>> ;                                               25202000
          <<-------------------------------                             25204000
            RETURN ALTERNATE TRACK NUMBER                               25206000
          ------------------------------->>                             25208000
INTEGER PROCEDURE ALTTRACK(LDEV,TRACK);                                 25210000
  VALUE   LDEV,TRACK;                                                   25212000
  INTEGER LDEV,TRACK;                                                   25214000
    COMMENT                                                             25216000
      FINDS THE TRACK NUMBER OF THE ALTERNATE OF THE SPECIFIED TRACK    25218000
    AND RETURNS IT. IF UNABLE TO READ THE ALTERNATE TRACK NUMBER,       25220000
    RETURNS -1;                                                         25222000
      BEGIN                                                             25224000
        INTEGER I := -1;                                                25226000
        INTEGER STYPE;                                                  25228000
        INTEGER INDEX;                                         <<2B.00>>25230000
        DOUBLE SECTOR,BA;                                               25232000
        INTEGER ARRAY B(0:140) = Q;                                     25234000
          PUSH(DB);                                                     25236000
          TOS := TOS+@B;                                                25238000
          BA := TOS;  <<ABSOLUTE ADDRESS OF B>>                         25240000
          TOS := LPDT(LDEV*LPDTSIZE+LPDT1).SUBTYPE;                     25242000
          ASSEMBLE(DUP,STAX);                                           25244000
          STYPE := TOS;  <<SUB TYPE>>                                   25246000
          TOS := MHINFO ((INDEX := STYPE*MHINFOSIZE)+MHSECTRK);<<25.00>>25248000
          TOS := TRACK;                                                 25250000
          ASSEMBLE(LMPY);                                               25252000
          SECTOR := TOS;                                                25254000
          IF STYPE<4 THEN                                               25256000
          WHILE (I:=I+1)<10 DO                                          25258000
            BEGIN                                                       25260000
              MHDISC(LDEV,DVRTAB(LDEV*DVRSIZE),STYPE,4,SECTOR,BA,       25262000
                IF STYPE=3 THEN 4 ELSE 132);                            25264000
              X := IF STYPE=3 THEN 2 ELSE 131;                          25266000
              IF B=B(X) THEN                                            25268000
                BEGIN                                                   25270000
                  TOS := B.(2:14);                                      25272000
                  IF STYPE=2 THEN ASSEMBLE(TSBC 7);                     25274000
                  ALTTRACK := TOS;                                      25276000
                  RETURN;                                               25278000
                END;                                                    25280000
            END                                                         25282000
          ELSE WHILE (I:=I+1) < (MHINFO(INDEX+MHSECTRK)-1) DO  <<25.00>>25284000
            BEGIN                                                       25286000
              PUSH(DB);                                                 25288000
              TOS := TOS+@B;                                            25290000
              BA := TOS;                                                25292000
              MH7905(LDEV,DVRTAB(LDEV*DVRSIZE),STYPE,4,SECTOR+DOUBLE(I),25294000
                     BA,141);                                           25296000
              IF B(1)=B(139) AND B(2).(3:5)=B(140).(3:5) THEN           25298000
                BEGIN  <<VALID ALTERNATE ADDRESS>>                      25300000
                  IF B(1)=-1 THEN ALTTRACK := -1                        25302000
                  ELSE IF B(1)=0 AND B(2).(3:5)=0 THEN ALTTRACK:=0      25304000
                  ELSE ALTTRACK := B(1) * MHINFO (INDEX        <<25.00>>25306000
                    +MHTRKCYL)+B(2).(3:5)-MHINFO(INDEX+MHSTHEAD);       25308000
                  RETURN;                                               25310000
                END;                                                    25312000
            END;                                                        25314000
          ALTTRACK := -2;  <<NO GOOD ALT TRACK READ>>                   25316000
      END <<ALTTRACK>> ;                                                25318000
$PAGE "SERIAL DISC DRIVER"                                     <<SD.00>>25320000
$CONTROL SEGMENT=TAPEIO                                        <<03715>>25322000
     <<------------------------------------------->>           <<03715>>25324000
     <<    CHECK FOR A VALID SERIAL DISC LABEL    >>           <<03715>>25326000
     <<------------------------------------------->>           <<03715>>25328000
LOGICAL PROCEDURE VALID'SERDISC(DLABEL,TYPE,SUBTYP);           <<03715>>25330000
VALUE TYPE, SUBTYP;                                            <<03715>>25332000
INTEGER ARRAY                                                  <<03715>>25334000
   DLABEL;      << DISC LABEL >>                               <<03715>>25336000
INTEGER                                                        <<03715>>25338000
   TYPE,        << DEVICE TYPE >>                              <<03715>>25340000
   SUBTYP;      << DEVICE SUBTYPE >>                           <<03715>>25342000
COMMENT                                                        <<03715>>25344000
CHECKS TO SEE IF THE DISC LABEL 'DLABEL' IS VALID FOR A        <<03715>>25346000
SERIAL DISC WITH THE GIVEN TYPE AND SUBTYPE.  IF SO,           <<03715>>25348000
VALID'SERDISC RETURNS TRUE, OTHERWISE FALSE.                   <<03715>>25350000
;                                                              <<03715>>25352000
BEGIN                                                          <<03715>>25354000
BYTE ARRAY                                                     <<03715>>25356000
   BLABEL(*) = DLABEL;                                         <<03715>>25358000
                                                               <<03715>>25360000
IF BLABEL(LABVOLB) = "SERDISC " AND                            <<03715>>25362000
   TYPE = DLABEL(LAB6).LABDTYPE AND                            <<03715>>25364000
   SUBTYP = DLABEL(LAB6).LABDSUBTYPE THEN                      <<03715>>25366000
                                                               <<03715>>25368000
   VALID'SERDISC := TRUE                                       <<03715>>25370000
                                                               <<03715>>25372000
ELSE                                                           <<03715>>25374000
                                                               <<03715>>25376000
   VALID'SERDISC := FALSE;                                     <<03715>>25378000
END;   << VALID'SERDISC >>                                     <<03715>>25380000
$CONTROL SEGMENT=TAPEIO                                        <<03603>>25384000
                                                               <<03598>>25386000
<<------------------------------------------------->>          <<03598>>25388000
                                                               <<03598>>25390000
PROCEDURE TZT'INCR;                                            <<03598>>25392000
                                                               <<03598>>25394000
COMMENT:                                                       <<03598>>25396000
                                                               <<03598>>25398000
   TZT'INCR increments the TZTBUFINDEX and refills TZTBUF      <<03598>>25400000
   when necessary.  It then extracts the TZT'TYPE and          <<03598>>25402000
   TZT'ADDR from the current entry.                 ;          <<03598>>25404000
                                                               <<03598>>25406000
BEGIN  <<Tzt'incr>>                                            <<03598>>25408000
                                                               <<03598>>25410000
   EQUATE  TZT'START   =   4,<<First entry in First Sector>>   <<03598>>25412000
           SYSDSECTLEN = 128;<<Words per Sector on SysDisc>>   <<03598>>25414000
                                                               <<03598>>25416000
   DEFINE  TZT'ADRFLD  = (3:13)#,<<High Order Part of Adr>>    <<03598>>25418000
           TZT'TYPFLD  = (0: 3)#;<< Gap Table Entry Type >>    <<03598>>25420000
                                                               <<03598>>25422000
   IF(TZTBUFINDEX:=TZTBUFINDEX+2) > TZTBUFLEN THEN             <<03598>>25424000
   BEGIN                                                       <<03598>>25426000
      DISC(READ,SYSDISC,SYSD'TZTBASE+DOUBLE(TZTSECTOR),        <<03598>>25428000
                                   TZTBUF,TZTBUFLEN+1);        <<03598>>25430000
      TZTBUFINDEX:=(IF TZTSECTOR=0 THEN TZT'START ELSE 0);     <<03598>>25432000
      TZTSECTOR:=TZTSECTOR+(TZTBUFLEN+1)/SYSDSECTLEN;          <<03598>>25434000
   END;                                                        <<03598>>25436000
   TZT'TYPE:=TZTBUF(TZTBUFINDEX).TZT'TYPFLD;                   <<03598>>25438000
   TOS:=TZTBUF(TZTBUFINDEX).TZT'ADRFLD;                        <<03598>>25440000
   TOS:=TZTBUF(TZTBUFINDEX+1);                                 <<03598>>25442000
   TZT'ADDR:=TOS;                                              <<03598>>25444000
   IF TZT'ADDR+1D<SD'SECTR THEN                                <<03598>>25446000
      ERRMESSAGE(M2326,SDERR17);                               <<03598>>25448000
                                                               <<03598>>25450000
END;   <<Tzt'incr>>                                            <<03598>>25452000
                                                               <<03598>>25454000
<<------------------------------------------------->>          <<03598>>25456000
                                                               <<03598>>25458000
LOGICAL PROCEDURE TZT'INIT;                                    <<03715>>25460000
                                                               <<03598>>25462000
COMMENT:                                                       <<03598>>25464000
                                                               <<03598>>25466000
   TZT'INIT reads and verifies the label on serial discs and   <<03598>>25468000
   initializes the SD GLOBAL variables with the label info.    <<03598>>25470000
   Gets space on Ldev 1 and copies TZT from SerDisc to SysDisc.<<03598>>25472000
   It calls TZT'INCR to fill the TZTBUF the first time.        <<03715>>25474000
   This procedure returns true if a valid serial disc label    <<03715>>25476000
   and TZT are found, false otherwise;                         <<03715>>25478000
                                                               <<03598>>25480000
BEGIN <<Tzt'init>>                                             <<03598>>25482000
                                                               <<03598>>25484000
   EQUATE  SYSDSECTLEN = 128,<<Words per Sector on SysDisc>>   <<03598>>25486000
           SERD'TZTBASE=   4;<<First Sector of Gap Table >>    <<03598>>25488000
                                                               <<03598>>25490000
   DEFINE  SECTR'MLTPLR=(SDISCSECTLEN/SYSDSECTLEN)#;           <<03598>>25492000
                                                               <<03598>>25494000
                                                               <<03602>>25496000
   IF NOT SDISC'TYPE(SYSTAPETYPE,SYSTAPESTYPE) THEN            <<03602>>25498000
      ERRMESSAGE(M2326,SDERR28);<<Not a Valid Serial Disc Dev>><<03602>>25500000
                                                               <<03602>>25502000
                                                               <<03715>>25520000
   DISC(READ,SYSTAPELDEV,0D,RECBUF,128); << Get Sdisc Label >> <<03598>>25522000
                                                               <<03715>>25524000
   IF NOT VALID'SERDISC(RECBUF,SYSTAPETYPE,SYSTAPESTYPE) THEN  <<03715>>25526000
      BEGIN                                                    <<03715>>25528000
      TZT'INIT := FALSE;     << INVALID SERIAL DISC LABEL >>   <<03715>>25530000
      RETURN;                << JUST EXIT                 >>   <<03715>>25532000
      END;                                                     <<03715>>25534000
                                                               <<03715>>25536000
   << init. WDS/SEC, SEC/TRK, BOT, EOT, EOD from Sdisc Label >><<03598>>25538000
   SDISCSECTLEN:=RECBUF(14);                                   <<03598>>25540000
   SDISCBOT:=RECBUF(16);                                       <<03598>>25542000
   TOS:=RECBUF(17);                                            <<03598>>25544000
   TOS:=RECBUF(18);                                            <<03598>>25546000
   EOTSECTR:=TOS;                                              <<03598>>25548000
   TOS:=RECBUF(19);                                            <<03598>>25550000
   TOS:=RECBUF(20);                                            <<03598>>25552000
   EODSECTR:=TOS;                                              <<03598>>25554000
                    <<Get enough space on sysdisc to copy TZT>><<03598>>25556000
   IF SYSD'NSECTS<>0 THEN ERRMESSAGE (M326,SYSDISC);           <<03598>>25558000
   SYSD'NSECTS:=(SDISCBOT-SERD'TZTBASE)*SECTR'MLTPLR;          <<03598>>25560000
   TOS := GETDISCSPACE(SYSDISC, D'L(SYSD'NSECTS)));            <<03715>>25562000
   IF <> THEN                                                  <<03715>>25564000
      ERRMESSAGE(M326,SYSDISC);    << OUT OF DISC SPACE >>     <<03715>>25566000
   SYSD'TZTBASE := TOS;                                        <<03715>>25568000
   TZTSECTOR:=SERD'TZTBASE;                                    <<03598>>25570000
   TZTBUFINDEX:=0;                                             <<03598>>25572000
   DO                                                          <<03598>>25574000
   BEGIN <<Copy TZT from SerDisc to SysDisc>>                  <<03598>>25576000
      DISC(READ,SYSTAPELDEV,DOUBLE(TZTSECTOR),                 <<03598>>25578000
                                 RECBUF,SDISCSECTLEN);         <<03598>>25580000
      DISC(WRITE,SYSDISC,SYSD'TZTBASE+DOUBLE(TZTBUFINDEX),     <<03598>>25582000
                                 RECBUF,SDISCSECTLEN);         <<03598>>25584000
      TZTBUFINDEX:=TZTBUFINDEX+SECTR'MLTPLR;                   <<03598>>25586000
   END   <<Copy TZT from SerDisc to SysDisc>>                  <<03598>>25588000
   UNTIL (TZTSECTOR:=TZTSECTOR+1)=SDISCBOT;                    <<03598>>25590000
   SD'SECTR:=DOUBLE(SDISCBOT);                                 <<03598>>25592000
   NEXTRECINBUF:=FALSE;                                        <<03598>>25594000
   END'OF'TAPE:=FALSE;                                         <<03598>>25596000
   TZTSECTOR:=0;                                               <<03598>>25598000
   TZTBUFINDEX:=TZTBUFLEN;  <<Set to cause buffer overflow &>> <<03598>>25600000
   TZT'INCR;               <<Fill TZTBUF and set TZTBUFINDEX>> <<03598>>25602000
   IF INTEGER(TZTBUF.(3:13))<>SDISCBOT THEN                    <<03598>>25604000
   BEGIN << Invalid TZT, try another disc >>                   <<03598>>25606000
      TZT'INIT := FALSE;     << Take error return >>           <<03715>>25616000
   END;  << Invalid TZT, try another disc >>                   <<03598>>25618000
   TZT'INIT := TRUE;      << Take good return >>               <<03715>>25620000
END;  <<Tzt'init>>                                             <<03598>>25622000
                                                               <<03598>>25624000
<<------------------------------------------------->>          <<03598>>25626000
                                                               <<03598>>25628000
PROCEDURE READBLOCK;                                           <<03598>>25630000
                                                               <<03598>>25632000
COMMENT:                                                       <<03598>>25634000
                                                               <<03598>>25636000
   Readblock fills RECBUF starting at SD'SECTR address         <<03598>>25638000
   on Serial Disc.  It skips around Holes and Cont. Blocks in  <<03598>>25640000
   order to fill buffer, but returns partial bkock if an eof is<<03598>>25642000
   encountered.  Sets WORDSINRECBUF and resets RECBUFINDEX.;   <<03598>>25644000
                                                               <<03598>>25646000
BEGIN <<Readblock>>                                            <<03598>>25648000
                                                               <<03598>>25650000
   DOUBLE  ENDSECTOR;                                          <<03598>>25652000
   INTEGER OFFSET:=0,                                          <<03598>>25654000
           WRDCNT,                                             <<03598>>25656000
           GAPTYPE,                                            <<03598>>25658000
           EOF;                                                <<03598>>25660000
                                                               <<03598>>25662000
   CC:=CCE;       <<check serial disc unit is on line>>        <<03598>>25664000
   IF NOT SD'ONLINE THEN ERRMESSAGE(M2326,SDERR24);            <<03598>>25666000
   DISCINRECBUF:=SD'SECTR;                                     <<03598>>25668000
   DO                                                          <<03598>>25670000
   BEGIN  <<Try to Read a Block from Sdisc>>                   <<03598>>25672000
      ENDSECTOR:=SD'SECTR                                      <<03598>>25674000
                +DOUBLE((RECBUFLEN+1)/SDISCSECTLEN)            <<03598>>25676000
                -DOUBLE(OFFSET/SDISCSECTLEN)-1D;               <<03598>>25678000
      IF TZT'ADDR > ENDSECTOR THEN                             <<03598>>25680000
      BEGIN  <<No Problems with Transfer>>                     <<03598>>25682000
         DISC(READ,SYSTAPELDEV,SD'SECTR,                       <<03598>>25684000
              RECBUF(OFFSET),RECBUFLEN+1-OFFSET);              <<03598>>25686000
         SD'SECTR:=ENDSECTOR+1D;                               <<03598>>25688000
         RECBUFINDEX:=0;                                       <<03598>>25690000
         NEXTRECINBUF:=TRUE;   <<True>>                        <<03598>>25692000
         WORDSINRECBUF:=RECBUFLEN+1;                           <<03598>>25694000
         RETURN;                                               <<03598>>25696000
      END    <<No Problems with Transfer>>                     <<03598>>25698000
      ELSE                                                     <<03598>>25700000
      BEGIN  <<Will Hit Gap or Eof Before End of Block>>       <<03598>>25702000
         EOF:=(IF TZT'TYPE=0 OR TZT'TYPE=6 THEN 1 ELSE 0);     <<03598>>25704000
         WRDCNT:=(INTEGER(TZT'ADDR-SD'SECTR)+EOF)              <<03598>>25706000
                 *SDISCSECTLEN;                                <<03598>>25708000
         IF WRDCNT+OFFSET > RECBUFLEN+1 THEN                   <<03598>>25710000
            ERRMESSAGE(M2326,SDERR31);                         <<03598>>25712000
         IF WRDCNT>0 THEN                                      <<03598>>25714000
            DISC(READ,SYSTAPELDEV,SD'SECTR,                    <<03598>>25716000
                 RECBUF(OFFSET),WRDCNT);                       <<03598>>25718000
         OFFSET:=OFFSET+WRDCNT;                                <<03598>>25720000
         IF (GAPTYPE:=TZT'TYPE)=2 OR GAPTYPE=4 THEN            <<03598>>25722000
         BEGIN                                                 <<03598>>25724000
            TZT'INCR;                                          <<03598>>25726000
            IF GAPTYPE+1<>TZT'TYPE THEN                        <<03598>>25728000
               ERRMESSAGE(M2326,SDERR17);<<Out of Sync w TZT>> <<03598>>25730000
            SD'SECTR:=TZT'ADDR+1D;                             <<03598>>25732000
            TZT'INCR;                                          <<03598>>25734000
         END;                                                  <<03598>>25736000
      END;   <<Will Hit Gap or Eof Before End of Block>>       <<03598>>25738000
   END    <<Try to Read a Block from Sdisc>>                   <<03598>>25740000
   UNTIL EOF=1;                                                <<03598>>25742000
   WORDSINRECBUF:=OFFSET;                                      <<03598>>25744000
   RECBUFINDEX:=0;                                             <<03598>>25746000
   NEXTRECINBUF:=TRUE;   <<True>>                              <<03598>>25748000
END;  <<Readblock>>                                            <<03598>>25750000
                                                               <<03598>>25752000
<<------------------------------------------------->>          <<03598>>25754000
                                                               <<03598>>25756000
PROCEDURE SDISCCTRL(CONTROL);                                  <<03598>>25758000
VALUE CONTROL;                                                 <<03598>>25760000
INTEGER CONTROL;                                               <<03598>>25762000
                                                               <<03598>>25764000
COMMENT:                                                       <<03598>>25766000
                                                               <<03598>>25768000
   SDISCCTRL simulates tape control functions for Serial Disc  <<03598>>25770000
                                                               <<03598>>25772000
   Valid Control Functions:  %10 - Rewind                      <<03598>>25774000
                             %11 - Rewind and Unload           <<03598>>25776000
                             %12 - Wait for New Mount          <<03598>>25778000
                             %17 - Forward Space File       ;  <<03598>>25780000
                                                               <<03598>>25782000
BEGIN  <<Sdiscctrl>>                                           <<03598>>25784000
                                                               <<03598>>25786000
   EQUATE  UNLOAD    = 26;  << UNLOAD LINUS FUNCTION >>        <<03672>>25788000
   EQUATE  TZT'START = 4;<<First entry in First Sector>>       <<03598>>25790000
                                                               <<03598>>25792000
   CC := CCE;       << INITIALIZE CC RETURN >>                 <<03715>>25794000
                                                               <<03715>>25796000
   CASE (CONTROL-%10) OF                                       <<03598>>25798000
   BEGIN <<Case on Function>>                                  <<03598>>25800000
                                                               <<03598>>25802000
      BEGIN <<%10-Rewind>>                                     <<03598>>25804000
        IF SYSTAPETYPE = DISC2 THEN                            <<04844>>25806000
          DISC(INIT'DEV,SYSTAPELDEV,0D,DTEMP,2);               <<04844>>25808000
                                                               <<04844>>25810000
         << IF SERIAL DISC IS CS'80 TYPE, DISABLE >>           <<03715>>25812000
         << RELEASE TIMEOUT.                      >>           <<03715>>25814000
                                                               <<03715>>25816000
         IF SYSTAPETYPE = DISC3 THEN                           <<03715>>25818000
            DISC(LOCK'DEV,SYSTAPELDEV,0D,DTEMP,2);             <<03715>>25820000
                                                               <<03715>>25822000
         SD'ONLINE:=TRUE;                                      <<03602>>25824000
         IF NOT TZT'INIT THEN         << READ IN TZT >>        <<03715>>25826000
            ERRMESSAGE(M2326,SDERR28);    << BAD TZT >>        <<03715>>25828000
      END;  <<%10-Rewind>>                                     <<03598>>25830000
                                                               <<03598>>25832000
      BEGIN <<%11-Rewind and Unload>>                          <<03598>>25834000
         SD'ONLINE:=FALSE;  <<False>>                          <<03598>>25836000
         NEXTRECINBUF:=FALSE;  <<False>>                       <<03598>>25838000
         TZTBUFINDEX:=TZT'START;                               <<03598>>25840000
         TZTSECTOR:=0;                                         <<03598>>25842000
         IF SYSD'NSECTS<>0 THEN   <<Return SysDisc space held>><<03598>>25844000
            RETDISCSPACE(SYSDISC,D'L(SYSD'NSECTS)),            <<03715>>25846000
                                     SYSD'TZTBASE);            <<03715>>25848000
         SYSD'NSECTS:=0;                                       <<03598>>25850000
         SYSD'TZTBASE:=0D;                                     <<03598>>25852000
                                                               <<03672>>25854000
         << IF CS'80 TYPE, SEND UNLOCK TO RE-ENABLE RELEASE >> <<03715>>25856000
         << TIMEOUT, SO THE USER CAN UNLOAD THE PACK.       >> <<03715>>25858000
         << IF IT IS A LINUS, WE ALSO SEND AN UNLOAD TO     >> <<03715>>25860000
         << UNLOAD THE CARTRIDGE OURSELVES.                 >> <<03715>>25862000
                                                               <<03672>>25864000
         IF SYSTAPETYPE = DISC3 THEN                           <<03672>>25866000
            BEGIN                                              <<03672>>25868000
            DISC(UNLOCK'DEV,SYSTAPELDEV,0D,RECBUF,10);         <<03715>>25870000
            IF SYSTAPESTYPE = LINUS THEN                       <<03672>>25872000
               DISC(UNLOAD,SYSTAPELDEV,0D,RECBUF,10);          <<03672>>25874000
            END;                                               <<03672>>25876000
      END;  <<%11-Rewind and Unload>>                          <<03598>>25878000
                                                               <<03598>>25880000
      BEGIN <<%12 - Wait for Sdisc to be readied>>             <<03598>>25882000
         SD'ONLINE := FALSE;                                   <<03715>>25884000
         DO UNTIL LGETYESNO(M2332);       << Ready? >>         <<03715>>25886000
                                                               <<03715>>25888000
         << CLEAR SERIAL DISC >>                               <<03715>>25890000
         DISC(INIT'DEV,SYSTAPELDEV,0D,DTEMP,2);                <<03715>>25892000
                                                               <<03715>>25894000
         DISC(RSTAT,SYSTAPELDEV,0D,DTEMP,2);   <<READ STATUS>> <<03715>>25896000
         IF DTEMP2.NREADYF = 1 THEN                            <<03715>>25898000
            BEGIN               << SERIAL DISC IS NOT READY >> <<03715>>25900000
            MESSAGE(M2408,SYSTAPELDEV);    <<LDEV NOT READY>>  <<03715>>25902000
            CC := CCG;                     << RETURN CCG   >>  <<03715>>25904000
            RETURN;                                            <<03715>>25906000
            END;                                               <<03715>>25908000
                                                               <<03715>>25910000
         << IF SERIAL DISC IS CS'80 TYPE, DISABLE >>           <<03715>>25912000
         << RELEASE TIMEOUT.                      >>           <<03715>>25914000
                                                               <<03715>>25916000
         IF SYSTAPETYPE = DISC3 THEN                           <<03715>>25918000
            DISC(LOCK'DEV,SYSTAPELDEV,0D,DTEMP,2);             <<03715>>25920000
                                                               <<03715>>25922000
         SD'ONLINE := TRUE;                                    <<03715>>25924000
         IF NOT TZT'INIT THEN     << READ IN GAP TABLE >>      <<03715>>25926000
            BEGIN                 << BAD SERIAL DISC FORMAT >> <<03715>>25928000
            MESSAGE(M2333,SYSTAPEDRT,      << NOT SERIAL >>    <<03715>>25930000
                          SYSTAPEUNIT);                        <<03715>>25932000
            CC := CCG;                     << RETURN CCG >>    <<03715>>25934000
            RETURN;                                            <<03715>>25936000
            END;                                               <<03715>>25938000
      END;  <<%12 - Wait for Sdisc to be readied>>             <<03598>>25940000
                                                               <<03598>>25942000
      ;;;;  <<%13-%16>>                                        <<03598>>25944000
                                                               <<03598>>25946000
      BEGIN <<%17-Forward Space File>>                         <<03598>>25948000
         WHILE (2<=TZT'TYPE<=5) DO TZT'INCR;                   <<03598>>25950000
         SD'SECTR:=TZT'ADDR+1D;                                <<03598>>25952000
         IF TZT'TYPE=1 OR TZT'TYPE=6 THEN END'OF'TAPE:=TRUE;   <<03598>>25954000
         TZT'INCR;                                             <<03598>>25956000
         NEXTRECINBUF:=FALSE;  <<False>>                       <<03598>>25958000
      END;  <<%17-Forward Space File>>                         <<03598>>25960000
   END;  <<Case on Function>>                                  <<03598>>25962000
END;  <<Sdiscctrl>>                                            <<03598>>25964000
                                                               <<03598>>25966000
<<------------------------------------------------->>          <<03598>>25968000
                                                               <<03598>>25970000
INTEGER PROCEDURE READSDISC(BUFFER,WORDC);                     <<03598>>25972000
VALUE WORDC;  INTEGER WORDC;  ARRAY BUFFER;                    <<03598>>25974000
                                                               <<03598>>25976000
COMMENT:                                                       <<03598>>25978000
                                                               <<03598>>25980000
   READSDISC Transfers the next logical record from the        <<03598>>25982000
   Serial Disc Buffer to the User's Buffer.           ;        <<03598>>25984000
                                                               <<03598>>25986000
BEGIN  <<Readsdisc>>                                           <<03598>>25988000
                                                               <<03598>>25990000
   INTEGER NEXTBUFINDEX,                                       <<03598>>25992000
           NEXTWORD,                                           <<03598>>25994000
           RECLEN,                                             <<03598>>25996000
           BYTEC,                                              <<03598>>25998000
           TRANSFERC,                                          <<03598>>26000000
           TRANSFERLENGTH;                                     <<03598>>26002000
   LOGICAL TRANSFERMODE,                                       <<03598>>26004000
           TRANSFERCOMPLETE;                                   <<03598>>26006000
   DOUBLE  STARTSECTOR;                                        <<03598>>26008000
   BYTE POINTER BPTEMP1,                                       <<03598>>26010000
                BPTEMP2;                                       <<03598>>26012000
   DEFINE  BYTES=TRUE#;                                        <<03598>>26014000
                                                               <<03598>>26016000
   EQUATE  EOT'RECLN  = -2,                                    <<03598>>26018000
           FILLCHAR   = -1,                                    <<03598>>26020000
           EOF'RECLN  =  0;                                    <<03598>>26022000
                                                               <<03598>>26024000
                                                               <<03598>>26026000
   CC:=CCE;                                                    <<03598>>26028000
   IF NOT SD'ONLINE THEN ERRMESSAGE(M2326,SDERR24);            <<03598>>26030000
   IF NOT NEXTRECINBUF THEN READBLOCK;                         <<03598>>26032000
   IF RECBUFINDEX>=WORDSINRECBUF THEN                          <<03598>>26034000
      ERRMESSAGE(M2326,SDERR23);                               <<03598>>26036000
   STARTSECTOR:=DISCINRECBUF+DOUBLE(RECBUFINDEX/               <<03598>>26038000
      SDISCSECTLEN);                                           <<03598>>26040000
   RECLEN:=RECBUF(RECBUFINDEX);                                <<03598>>26042000
   IF RECLEN=EOF'RECLN OR RECLEN=EOT'RECLN THEN                <<03598>>26044000
   BEGIN  <<End of File>>                                      <<03598>>26046000
      IF RECLEN=EOT'RECLN THEN END'OF'TAPE:=TRUE;  <<True>>    <<03598>>26048000
      IF RECLEN=EOF'RECLN THEN CC:=CCG;                        <<03598>>26050000
      RECBUFINDEX:=(RECBUFINDEX/SDISCSECTLEN+1)                <<03598>>26052000
         *SDISCSECTLEN;                                        <<03598>>26054000
      IF RECBUFINDEX>=WORDSINRECBUF THEN                       <<03598>>26056000
         NEXTRECINBUF:=FALSE;  <<FALSE>>                       <<03598>>26058000
      IF STARTSECTOR=TZT'ADDR THEN                             <<03598>>26060000
      BEGIN                                                    <<03598>>26062000
         SD'SECTR:=TZT'ADDR+1D;                                <<03598>>26064000
         TZT'INCR;                                             <<03598>>26066000
         RETURN;                                               <<03598>>26068000
      END                                                      <<03598>>26070000
      ELSE ERRMESSAGE(M2326,SDERR17);<<Out of Sync with TZT>>  <<03598>>26072000
   END;   <<End of File>>                                      <<03598>>26074000
   IF RECLEN=FILLCHAR THEN                                     <<03598>>26076000
   BEGIN  <<Must be Last Sector Before a Gap>>                 <<03598>>26078000
      RECBUFINDEX:=(RECBUFINDEX/SDISCSECTLEN+1)                <<03598>>26080000
         *SDISCSECTLEN;                                        <<03598>>26082000
      IF RECBUFINDEX>=WORDSINRECBUF THEN                       <<03598>>26084000
      BEGIN <<Transfer>>                                       <<03598>>26086000
         READBLOCK;                                            <<03598>>26088000
         RECLEN:=RECBUF(RECBUFINDEX);                          <<03598>>26090000
      END;  <<Transfer>>                                       <<03598>>26092000
   END;   <<Must be Last Sector Before a Gap>>                 <<03598>>26094000
   NEXTBUFINDEX:=RECBUFINDEX+(RECLEN+1)&LSR(1)+2;              <<03598>>26096000
   IF WORDC<0 THEN TRANSFERMODE:=BYTES; <<TRUE>>               <<03598>>26098000
   BYTEC:=IF WORDC<0 THEN -WORDC ELSE WORDC&LSL(1);            <<03598>>26100000
   TRANSFERC:=IF BYTEC>RECLEN THEN RECLEN ELSE BYTEC;          <<03598>>26102000
   READSDISC:=IF WORDC<0 THEN TRANSFERC                        <<03598>>26104000
                 ELSE (TRANSFERC+1)&LSR(1);                    <<03598>>26106000
   TRANSFERCOMPLETE:=FALSE;                                    <<03598>>26108000
   NEXTWORD:=RECBUFINDEX+1;                                    <<03598>>26110000
   TOS:=@BUFFER;                                               <<03598>>26112000
   DO                                                          <<03598>>26114000
   BEGIN <<Move Rec to User Buffer>>                           <<03598>>26116000
      IF (TRANSFERC+1)&LSR(1)+RECBUFINDEX<=RECBUFLEN THEN      <<03598>>26118000
      BEGIN  <<Transfer can be completed>>                     <<03598>>26120000
         MOVE *:=RECBUF(NEXTWORD),(TRANSFERC&LSR(1)),1;        <<03598>>26122000
         IF TRANSFERMODE AND LOGICAL(TRANSFERC) THEN           <<03598>>26124000
         BEGIN  <<Move Last Byte>>                             <<03598>>26126000
            @BPTEMP1 := TOS&LSL(1);                            <<03715>>26128000
            @BPTEMP2 := TOS&LSL(1);                            <<03715>>26130000
            MOVE BPTEMP2:=BPTEMP1,(1);                         <<03598>>26132000
         END    <<Move Last Byte>>                             <<03598>>26134000
         ELSE                                                  <<03598>>26136000
         DDEL;                                                 <<03598>>26138000
         TRANSFERCOMPLETE:=TRUE;                               <<03598>>26140000
      END    <<Transfer can be Completed>>                     <<03598>>26142000
      ELSE                                                     <<03598>>26144000
      BEGIN  <<Transfer Remainder of Recbuff>>                 <<03598>>26146000
         MOVE *:=RECBUF(NEXTWORD),(TRANSFERLENGTH:=            <<03598>>26148000
         RECBUFLEN-NEXTWORD+1),2;                              <<03598>>26150000
         NEXTBUFINDEX:=NEXTBUFINDEX-WORDSINRECBUF;             <<03598>>26152000
         READBLOCK;                                            <<03598>>26154000
         NEXTWORD:=0;                                          <<03598>>26156000
         TRANSFERC:=TRANSFERC-TRANSFERLENGTH&LSL(1);           <<03598>>26158000
      END;   <<Transfer Remainder of Recbuff>>                 <<03598>>26160000
   END    <<Transfer Record to User Buffer>>                   <<03598>>26162000
   UNTIL TRANSFERCOMPLETE;                                     <<03598>>26164000
   IF NEXTBUFINDEX>=WORDSINRECBUF THEN                         <<03598>>26166000
   BEGIN                                                       <<03598>>26168000
      NEXTBUFINDEX:=NEXTBUFINDEX-WORDSINRECBUF;                <<03598>>26170000
      READBLOCK;                                               <<03598>>26172000
   END;                                                        <<03598>>26174000
   RECBUFINDEX:=NEXTBUFINDEX;                                  <<03598>>26176000
   IF RECBUFINDEX>0 THEN                                       <<03598>>26178000
      IF INTEGER(RECBUF(RECBUFINDEX-1))<>RECLEN THEN           <<03598>>26180000
         ERRMESSAGE(M2326,SDERR30);<<Ld & Tr Reclen Mismatch>> <<03598>>26182000
END;   <<Readsdisc>>                                           <<03598>>26184000
                                                               <<03598>>26186000
<<------------------------------------------------->>          <<03598>>26188000
                                                               <<03598>>26190000
INTEGER PROCEDURE SDISCDVR(FUNC, BUF, WORDC);                  <<03598>>26192000
VALUE FUNC,WORDC;  INTEGER FUNC,WORDC;  ARRAY BUF;             <<03598>>26194000
                                                               <<03598>>26196000
COMMENT                                                        <<03598>>26198000
                                                               <<03598>>26200000
   SDISCDRVR serves as an outer block for the Serial Disc      <<03598>>26202000
   Routines.  It translates the function Codes and Xfers       <<03598>>26204000
   Control to the Appropriate Procedure to do the work.  ;     <<03598>>26206000
                                                               <<03598>>26208000
BEGIN  <<Sdiscdrvr>>                                           <<03598>>26210000
                                                               <<03598>>26212000
   EQUATE  SDISCREWIND    = %10,                               <<03598>>26214000
           SDISCREWUNLOAD = %11, <<Serial Disc Funct Codes>>   <<03598>>26216000
           SDISCTAPEREADY = %12, <<are Different than Tape>>   <<03598>>26218000
           SDISCFWDSPFILE = %17; <<Function Codes>>            <<03598>>26220000
                                                               <<03598>>26222000
   CC:=CCE;                                                    <<03598>>26224000
   CASE FUNC OF                                                <<03598>>26226000
   BEGIN  <<Case on Function>>                                 <<03598>>26228000
      SDISCDVR:=READSDISC(BUF,WORDC);                          <<03598>>26230000
      SDISCCTRL(SDISCREWUNLOAD);                               <<03598>>26232000
      SDISCCTRL(SDISCFWDSPFILE);                               <<03598>>26234000
      SDISCCTRL(SDISCTAPEREADY);                               <<03598>>26236000
      SDISCCTRL(SDISCREWIND);                                  <<03598>>26238000
   END;   <<Case on Function>>                                 <<03598>>26240000
   IF > THEN                                                   <<03598>>26242000
      CC := CCG                                                <<03598>>26244000
   ELSE                                                        <<03598>>26246000
      IF < THEN                                                <<03598>>26248000
      BEGIN                                                    <<03598>>26250000
         SDISCDVR := 1;  << Flag Fatal Error >>                <<03598>>26252000
         CC := CCL;                                            <<03598>>26254000
      END;                                                     <<03598>>26256000
END;   <<Sdiscdrvr>>                                           <<03598>>26258000
                                                               <<03598>>26260000
<<------------------------------------------------->>          <<03598>>26262000
                                                               <<03598>>26264000
$PAGE "MAG TAPE DRIVER"                                                 26266000
$CONTROL SEGMENT=TAPEIO                                        <<03603>>26268000
          <<----------------------------------                          26270000
            EXECUTE SIO PROGRAM FOR MAG TAPE                            26272000
          ---------------------------------->>                          26274000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>26276000
  INTEGER PROCEDURE TAPESIO;                                            26278000
    <<  THIS PROCEDURE USES GLOBAL DB RELATIVE VARIABLES SO  >><<01028>>26280000
    <<  DB MUST NOT BE SWITCHED TO SIO PROGRAM AREA ON ENTRY.>><<01028>>26282000
    COMMENT                                                             26284000
      EXECUTES AN SIO PROGRAM ON THE SYSTEM MAG TAPE;                   26286000
      BEGIN                                                             26288000
        INTEGER STATUS = TAPESIO;                              <<01028>>26290000
          TOS := SYSTAPEDRT;                                   <<01028>>26292000
          TOS := ABSOLUTE(SIOPROG);                                     26294000
  DOSIO:  ASSEMBLE( SIO 1 );                                   <<01103>>26296000
          IF < THEN ERRMESSAGE(M1,S1);                         <<01103>>26298000
          IF > THEN                                                     26300000
            BEGIN  <<CMD REJECTED>>                                     26302000
              IF TOS.(2:1) THEN                                         26304000
                BEGIN  <<INTERRUPT>>                                    26306000
                  TOS := %40000;                                        26308000
                  CIO2;                                        <<01103>>26310000
                END;                                                    26312000
              GOTO DOSIO;                                               26314000
            END;                                                        26316000
  TEST:   TIO0;                                                <<01103>>26318000
          STATUS:=TOS;                                         <<01028>>26320000
          IF STATUS.(2:1) = 1 THEN                             <<01028>>26322000
            BEGIN  <<INTERRUPT>>                                        26324000
              TOS := %40000;                                            26326000
              CIO1;                                            <<01103>>26328000
              IF STATUS.(3:2)=SYSTAPEUNIT THEN RETURN;         <<01028>>26330000
            END;                                                        26332000
          GOTO TEST;                                                    26334000
      END <<TAPESIO>> ;                                                 26336000
          <<---------------------------                                 26338000
            INSURE TAPE UNIT IS READY                                   26340000
          --------------------------->>                                 26342000
  PROCEDURE READYTAPE;                                         <<00678>>26344000
    COMMENT                                                             26346000
      INSURES THAT UNIT ZERO OF THE SYSTEM MAG TAPE IS READY;           26348000
      BEGIN                                                             26350000
        LOGICAL STATUS;                                        <<04443>>26352000
          TOS := SYSTAPEDRT;                                   <<01028>>26354000
          <<WAIT UNTIL INTERRUPT REQUEST IS TRUE>>             <<00.06>>26356000
          <<I.E.  UNTIL "UNIT NOT READY" BECOMES "READY">>     <<00.06>>26358000
  TEST:   TIO0;                                                <<01103>>26360000
          STATUS:= S0;                                         <<04443>>26362000
          IF NOT TOS.(2:1) THEN GOTO TEST;                              26364000
          TOS:=%40000; <<CLEAR INTERRUPT REQUEST FLAG>>        <<00.06>>26366000
          CIO1;                                                <<01103>>26368000
          IF INTEGER(STATUS.(3:2))<>SYSTAPEUNIT THEN GOTO TEST;<<04443>>26370000
          IF NOT STATUS.(7:1) THEN                             <<04443>>26372000
            BEGIN                                              <<01092>>26374000
              MESSAGE(M2407,SYSTAPEUNIT);                      <<01103>>26376000
              GO TO TEST;                                      <<01092>>26378000
            END;                                               <<01092>>26380000
          CC:= CCE;                                            <<04443>>26382000
      END <<TAPEREADY>> ;                                               26384000
          <<-----------------------------                               26386000
            OUTPUT CONTROL TO TAPE UNIT                                 26388000
          ----------------------------->>                               26390000
INTEGER PROCEDURE TAPECTRL(CONTROL);                           <<01103>>26392000
    VALUE CONTROL;                                                      26394000
    INTEGER CONTROL;   <<CONTROL WORD>>                                 26396000
    COMMENT                                                             26398000
      OUTPUTS A CONTROL WORD TO THE SYSTEM TAPE DRIVE;                  26400000
      BEGIN                                                             26402000
        INTEGER ARRAY STATUS'TO'MESSAGE(0:7) = PB :=           <<01103>>26404000
          M0,M6,M5,M9,M8,M7,M6,M0;                             <<01103>>26406000
        INTEGER UNIT, STATUS;                                  <<01028>>26408000
        ARRAY S(*)=DB+0;  <<SIO PROGRAM BUFFER>>                        26410000
        UNIT:=SYSTAPEUNIT;                                     <<01028>>26412000
        CC := CCE;                                             <<01092>>26414000
          TOS := 0;                                                     26416000
          TOS := ABSOLUTE(SIOPROG);                                     26418000
          ASSEMBLE(XCHD);  <<SET DB TO SIO PROGRAM BUFFER>>             26420000
          S := SIOCNTRL;                                                26422000
          S(1) := UNIT&LSL(8);  <<UNIT NUMBER TO BITS 6&7>>    <<01028>>26424000
          S(2) := SIOCNTRL;                                             26426000
          S(3) := CONTROL;                                              26428000
          S(4) := SIOENDINT;                                            26430000
          S(5) := 0;                                                    26432000
          SET(DB);  <<RESET DB>>                                        26434000
          STATUS := TAPESIO;  <<EXECUTE SIO PROGRAM>>          <<01028>>26436000
          <<TAPESIO WILL LOOP IF STAT IS NOT FOR SYSTAPEUNIT >><<01028>>26438000
          <<SO NO NEED TO RECHECK IT FOR CORRRECT UNIT HERE. >><<01028>>26440000
                                                               <<01028>>26442000
          TAPECTRL := STATUS'TO'MESSAGE(STATUS.(12:3));        <<01103>>26444000
          IF = THEN RETURN;                                    <<01103>>26446000
          CC := CCL;                                           <<01092>>26448000
                                                               <<01092>>26450000
          RETURN;                                              <<01028>>26452000
      END <<TAPECTRL>> ;                                                26454000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>26456000
          <<---------------------------                                 26458000
            READ RECORD FROM MAG TAPE                                   26460000
          --------------------------->>                                 26462000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>26464000
  INTEGER PROCEDURE READTAPE (BUF, WORDS);                     <<01122>>26466000
    VALUE WORDS;                                               <<01122>>26468000
    ARRAY BUF;      <<CORE BUFFER>>                                     26470000
    INTEGER WORDS;  <<TRANSFER LENGTH>>                                 26472000
    COMMENT                                                             26474000
      READS A RECORD OF LENGTH WORDS FROM THE SYSTEM MAG TAPE INTO      26476000
    THE CORE BUFFER BUF.  RETURNS # OF WORDS READ.             <<00.06>>26478000
    STATUS ON RETURN:                                          <<00.06>>26480000
      CCL-TAPE READ ERROR                                      <<01122>>26482000
      CCG-EOF READ                                             <<00.06>>26484000
      CCE-RECORD READ OKAY                                     <<00.06>>26486000
      ;                                                        <<00.06>>26488000
      BEGIN                                                             26490000
        INTEGER ARRAY STATUS'TO'MESSAGE(0:7) = PB :=           <<01103>>26492000
          M0,M6,M5,M9,M8,M7,M6,M0;                             <<01103>>26494000
        EQUATE BSCOM     =    %12,     <<TAPE BACKSPACE COMMAND>>       26496000
               RDRCOM    =    %6;      <<TAPE READ RECORD COMMAND>>     26498000
        DEFINE EOFFLD    =    (11:1)#, <<END OF FILE>>                  26500000
               RESFLD    =    (12:3)#; <<RESIDUE>>                      26502000
        INTEGER UNIT;                                          <<01028>>26504000
        DOUBLE STACKDB;                                                 26506000
        INTEGER STACKDB1=STACKDB,STACKDB2=STACKDB+1;                    26508000
        LOGICAL STATUS;                                                 26510000
        INTEGER ERRCNT:=0;             <<NUMBER OF TAPE ERRORS>>        26512000
        ARRAY S(*)=DB+0;   <<SIO PROGRAM BUFFER>>                       26514000
        STAT.(6:2):=CCE; <<ALL OKAY>>                          <<SD.00>>26516000
        UNIT:=SYSTAPEUNIT;                                     <<01028>>26518000
  AGAIN:                                                                26520000
          IF WORDS = 0 THEN RETURN;                            <<03603>>26522000
          TOS := @BUF;  <<DB-RELATIVE ADDRESS>>                         26524000
          TOS := 0;                                                     26526000
          TOS := ABSOLUTE(SIOPROG);                                     26528000
          ASSEMBLE(XCHD);  <<SET DB TO SIO PROGRAM BUFFER>>             26530000
          STACKDB := TOS;  <<SAVE STACK DB>>                            26532000
          S := SIOCNTRL;                                                26534000
          S(1) := UNIT&LSL(8); <<SELECT UNIT>>                 <<01028>>26536000
          S(2) := SIOCNTRL;                                             26538000
          S(3) := RDRCOM;                                               26540000
          S(4) := SIOBANK;                                              26542000
          S(5) := STACKDB1;  <<BANK ADDRESS>>                           26544000
          TOS := WORDS;                                                 26546000
          S(6) := (-TOS) CAT 0(0:15:1);                                 26550000
          S(7) := TOS+STACKDB2;   <<BUFFER ADDRESS>>                    26552000
          S(8) := SIORES;                                               26554000
          S(9) := 0;                                                    26556000
          S(10) := SIOENDINT;                                           26558000
          S(11) := 0;                                                   26560000
          TOS := STACKDB;                                      <<01028>>26562000
          SET(DB);  << RESET DB TO STACK >>                    <<01028>>26564000
          STATUS:=TAPESIO; <<EXECUTE SIO PROGRAM>>             <<00.06>>26566000
          IF STATUS.EOFFLD THEN TOS:= CCG ELSE TOS:=CCE;                26568000
          STAT.(6:2) := TOS;  <<SET CONDITION CODE FOR EOF>>            26570000
          TOS := WORDS;                                                 26572000
          TOS := 0;                                            <<01028>>26574000
          TOS := ABSOLUTE(SIOPROG) + 9;                        <<01028>>26576000
          ASSEMBLE(LSEA; DELB, DELB);  << TOS := S(9) >>       <<01028>>26578000
          ASSEMBLE(NEG; LSL 4; LSR 4; NEG,ADD);                         26580000
          READTAPE := TOS;  <<# OF WORDS READ>>                         26582000
          IF STATUS.RESFLD = 4 OR STATUS.RESFLD = 5 THEN       <<01028>>26584000
            << TIMING/PARITY ERROR RESPECTIVELY >>             <<01028>>26586000
            IF (ERRCNT := ERRCNT + 1) < 10 THEN                <<01028>>26588000
              BEGIN                                            <<01028>>26590000
                TOS := %100000;                                <<01028>>26592000
                WHILE (TOS:=TOS-1)>0 DO <<DELAY FOR ..>>       <<00888>>26594000
                      BEGIN END;  <<..MULTIPLE TAPE ERRORS>>   <<00888>>26596000
                TOS := SYSTAPEDRT;  <<CLEAR SECOND INTERRUPT>> <<01028>>26598000
                TOS := SIOCNTRL;                               <<00888>>26600000
                CIO1; DEL;                                     <<01103>>26602000
                TAPECTRL(BSCOM);                               <<01028>>26604000
                GO AGAIN;                                      <<00888>>26606000
              END;                                             <<00888>>26608000
          IF STATUS.RESFLD = 7 THEN RETURN;                    <<01103>>26610000
          IF STATUS.RESFLD = 0 THEN                            <<01103>>26612000
             BEGIN                                             <<01103>>26614000
             READYTAPE;                                        <<01103>>26616000
             RETURN;                                           <<01103>>26618000
             END;                                              <<01103>>26620000
          READTAPE := STATUS'TO'MESSAGE(STATUS.RESFLD);        <<01103>>26622000
           CC := CCL;                                          <<01092>>26624000
                                                               <<01092>>26626000
      END <<READTAPE>> ;                                       <<00888>>26628000
$IF   << ******** RETURNING TO COMMON CODE ******** >>         <<02510>>26630000
$CONTROL SEGMENT=TAPEIO                                        <<03603>>26632000
$TITLE "HP 7970E MAG TAPE DRIVER"                              <<01028>>26634000
INTEGER PROCEDURE MTAPE(FCODE, BUFF, WORDS);                   <<01122>>26636000
                                                               <<01028>>26638000
  VALUE  FCODE, WORDS;                                         <<01122>>26640000
  INTEGER  FCODE,WORDS;                                        <<01028>>26642000
  ARRAY  BUFF;                                                 <<01028>>26644000
  OPTION  VARIABLE;                                            <<01028>>26646000
                                                               <<01028>>26648000
  COMMENT                                                      <<01028>>26650000
                                                               <<01028>>26652000
          FCODE = 0 - READ,                                    <<01028>>26654000
                  1 - REWIND/OFFLINE,                          <<01028>>26656000
                  2 - FORWARD SPACE FILE,                      <<01028>>26658000
                  3 - WAIT FOR TAPE READY,                     <<00799>>26660000
                  4 - BACKSPACE RECORD (CALLED RECURSIVELY TO  <<00799>>26662000
                      RECOVER FROM A PARITY ERROR).            <<01028>>26664000
                                                               <<01028>>26666000
     STATUS RETURNED IN THE STATUS CONDITION CODE:             <<01028>>26668000
             CC = CCE - REQUESTED COMPLETED,                   <<01028>>26670000
                  CCG - EOF READ,                              <<01028>>26672000
                  CCL - TRANSFER ERROR.                        <<01028>>26674000
                                                               <<01028>>26676000
     MTAPE IS GIVEN THE READ LENGTH ON A SUCCESSFUL READ,      <<01028>>26678000
     MTAPE = ERROR MESSAGE NUMBER AND CCL ON IRRECOVERABLE     <<01103>>26680000
     ERRORS.                                                   <<01103>>26682000
  ;                                                            <<01028>>26684000
                                                               <<01028>>26686000
BEGIN                                                          <<01028>>26688000
                                                               <<01028>>26690000
  INTEGER ARRAY  CHANIOPROG(0:53) = PB :=                      <<01028>>26692000
                                                               <<01028>>26694000
  << 0>>      %2001,  << SELECT UNIT >>                        <<01028>>26696000
  << 1>>          1,                                           <<01028>>26698000
  << 2>>          0,                                           <<01028>>26700000
  << 3>>     %42000,                                           <<01028>>26702000
  << 4>>          0,                                           <<01028>>26704000
                                                               <<01028>>26706000
  << 5>>      %1000,  << WAIT >>                               <<01028>>26708000
  << 6>>          0,                                           <<01028>>26710000
                                                               <<01028>>26712000
  << 7>>      %2401,  << DSJ - TO CLEAR PP RESPONSE >>         <<01028>>26714000
  << 8>>          0,                                           <<01028>>26716000
  << 9>>          0,                                           <<01028>>26718000
  <<10>>         36,                                           <<01028>>26720000
                                                               <<01028>>26722000
  <<11>>      %2001,  << ISSUE MOTION COMMAND >>               <<01028>>26724000
  <<12>>          1,                                           <<01028>>26726000
  <<13>>          0,                                           <<01028>>26728000
  <<14>>     %42000,                                           <<01028>>26730000
  <<15>>          0,                                           <<01028>>26732000
                                                               <<01028>>26734000
  <<16>>      %1000,  << WAIT >>                               <<01028>>26736000
  <<17>>          0,                                           <<01028>>26738000
                                                               <<01028>>26740000
  <<18>>      %2401,  << DSJ - TO CLEAR PP RESPONSE >>         <<01028>>26742000
  <<19>>          0,                                           <<01028>>26744000
  <<20>>          0,  << JMP *+0/25, READ/COMMAND MODE >>      <<01028>>26746000
  <<21>>         25,  << STATUS DIAGNOSIS REQUIRED >>          <<01028>>26748000
                                                               <<01028>>26750000
  <<22>>      %1400,  << READ RECORD >>                        <<01028>>26752000
  <<23>>          0,                                           <<01028>>26754000
  <<24>>      %2100,                                           <<01028>>26756000
  <<25>>    %100000,                                           <<01028>>26758000
  <<26>>          0,                                           <<01028>>26760000
                                                               <<01028>>26762000
  <<27>>          0,  << JMP *+2, EOI RECEIVED >>              <<01028>>26764000
  <<28>>          2,                                           <<01028>>26766000
                                                               <<01028>>26768000
  <<29>>          0,                                           <<01028>>26770000
  <<30>>        -15,  << JMP *-15, BURST COMPLETED >>          <<01028>>26772000
                                                               <<01028>>26774000
  <<31>>      %2007,  << WRITE END COMMAND >>                  <<01028>>26776000
  <<32>>          1,                                           <<01028>>26778000
  <<33>>          0,                                           <<01028>>26780000
  <<34>>     %42000,                                           <<01028>>26782000
  <<35>>          0,                                           <<01028>>26784000
                                                               <<01028>>26786000
  <<36>>      %1402,  << DUMMY XFER COUNT READ >>              <<01028>>26788000
  <<37>>          2,                                           <<01028>>26790000
  <<38>>          0,                                           <<01028>>26792000
  <<39>>      %2000,                                           <<01028>>26794000
  <<40>>          0,                                           <<01028>>26796000
                                                               <<01028>>26798000
  <<41>>      %1000,  << WAIT FOR READ TO COMPLETE >>          <<01028>>26800000
  <<42>>          0,                                           <<01028>>26802000
                                                               <<01028>>26804000
  <<43>>      %2401,  << DSJ - CLEARS FINAL PP RESPONSE >>     <<01028>>26806000
  <<44>>          0,                                           <<01028>>26808000
  <<45>>          0,                                           <<01028>>26810000
  <<46>>          0,                                           <<01028>>26812000
                                                               <<01028>>26814000
  <<47>>      %1401,  << READ STATUS >>                        <<01028>>26816000
  <<48>>          3,                                           <<01028>>26818000
  <<49>>          0,                                           <<01028>>26820000
  <<50>>      %2000,                                           <<01028>>26822000
  <<51>>          0,                                           <<01028>>26824000
                                                               <<01028>>26826000
  <<52>>       %601,  << INTERRUPT/HALT >>                     <<01028>>26828000
  <<53>>          0;                                           <<01028>>26830000
                                                               <<01028>>26832000
  LOGICAL                                                      <<01028>>26834000
    STATUS, GOOD'IO, PASS'1, RETRY;                            <<01028>>26836000
                                                               <<01028>>26838000
  INTEGER                                                      <<01028>>26840000
    UNIT, DRT, CMDBUFADR, ERRCOUNT;                            <<01103>>26842000
                                                               <<01028>>26844000
  DOUBLE                                                       <<01028>>26846000
    OLDDB;                                                     <<01028>>26848000
                                                               <<01028>>26850000
  INTEGER ARRAY  CMDBUFF(0:5) = Q;  << COMMAND BUFFER >>       <<01028>>26852000
                                                               <<01028>>26854000
  LOGICAL ARRAY  CP(*) = DB+0;                                 <<01028>>26856000
                                                               <<01028>>26858000
  EQUATE                                                       <<01028>>26860000
    CUNIT       =      0,  << UNIT NUMBER >>                   <<01028>>26862000
    CMOTIONCMD  =      1,  << MOTION COMMAND >>                <<01028>>26864000
    CSPFD       =      2,  << STOP POLLING FOR DATA COMMAND >> <<01028>>26866000
    CSTATBUFF   =      3,  << STATUS BUFFER >>                 <<01028>>26868000
    CDXFERCNT   =      5;  << DUMMY XFER COUNT BUFFER >>       <<01028>>26870000
                                                               <<01028>>26872000
                                                               <<01028>>26874000
  EQUATE                                                       <<01028>>26876000
    CMDREAD     =    %10,  << READ RECORD COMMAND >>           <<01028>>26878000
    CMDBSREC    =    %12,  << BACK SPACE RECORD COMMAND >>     <<01028>>26880000
    CMDFSFILE   =    %13,  << FORWARD SPACE FILE COMMAND >>    <<01028>>26882000
    CMDREW'OFF  =    %16,  << REWIND/OFFINE COMMAND >>         <<01028>>26884000
    ERRMASK     = %05037;  << ERROR MASK >>                    <<01028>>26886000
                                                               <<01028>>26888000
  DEFINE                                                       <<01028>>26890000
    EOF         = CMDBUFF(CSTATBUFF).( 0:1)#,<< EOF DETECTED >><<01028>>26892000
    CMD'REJ     = ( 4:1)#,  << COMMAND CMD'REJED >>            <<01028>>26894000
    TRACKERR    = ( 6:1)#,  << MULTIPLE TRACK ERROR >>         <<01028>>26896000
    ONLINE      = CMDBUFF(CSTATBUFF).(7:1)#,  << UNIT ONLINE >><<01028>>26898000
    TIMINGERR   = (11:1)#,  << TIMING ERROR >>                 <<01028>>26900000
    TAPERUN     = (12:1)#,  << TAPE RUNAWAY >>                 <<01028>>26902000
    BUSY        = (13:3)#,  << UNIT/INTERFACE BUSY OR REWIND >><<01028>>26904000
    MEMX        = ( 8:8)#;  << BANK NUMBER >>                  <<01028>>26906000
                                                               <<01028>>26908000
                                                               <<01028>>26910000
                                                               <<01028>>26912000
                                                               <<01028>>26914000
  SUBROUTINE STATUS'CHECK;                                     <<01028>>26916000
                                                               <<01028>>26918000
  BEGIN                                                        <<01028>>26920000
    RETRY := FALSE;                                            <<01028>>26922000
    GOOD'IO := TRUE;                                           <<01028>>26924000
    STATUS := LOGICAL(CMDBUFF(CSTATBUFF)) LAND ERRMASK;        <<01028>>26926000
                                                               <<01028>>26928000
    IF LOGICAL(ONLINE) AND STATUS=0                            <<01028>>26930000
      OR FCODE = 1 AND NOT STATUS.CMD'REJ THEN RETURN;         <<01028>>26932000
      << NORMAL RETURN; FCODE=1 => REWIND/OFFLINE >>           <<01028>>26934000
                                                               <<01028>>26936000
    << IF YOU GOT HERE, SOMETHING IS WRONG >>                  <<01028>>26938000
    GOOD'IO := FALSE;                                          <<01028>>26940000
    IF NOT LOGICAL(ONLINE) OR STATUS.BUSY <> 0 THEN            <<01028>>26942000
      BEGIN                                                    <<01028>>26944000
        RETRY := TRUE;                                         <<01028>>26946000
        IF PASS'1 AND FCODE <> 3 THEN                          <<00799>>26948000
          BEGIN                                                <<01028>>26950000
            MESSAGE(M2407,UNIT);  << UNIT NOT READY >>         <<01103>>26952000
            PASS'1 := FALSE;                                   <<01028>>26954000
          END;                                                 <<01028>>26956000
      END;                                                     <<01028>>26958000
                                                               <<01028>>26960000
    IF FCODE = 0 AND (STATUS.TRACKERR OR STATUS.TIMINGERR) THEN<<01028>>26962000
      << PARITY/TIMING ERROR DURING READ >>                    <<01028>>26964000
        IF (ERRCOUNT := ERRCOUNT + 1) < 10 THEN                <<01028>>26966000
          BEGIN                                                <<01028>>26968000
            MTAPE(4);  << SEE NOTE 1 AT END >>                 <<01092>>26970000
            IF = THEN                                          <<01028>>26972000
              RETRY := TRUE;                                   <<01028>>26974000
          END;                                                 <<01092>>26976000
                                                               <<01028>>26978000
    IF NOT RETRY THEN  << PRINT ERROR(S) >>                    <<01028>>26980000
      BEGIN                                                    <<01028>>26982000
        IF STATUS.CMD'REJ   THEN MTAPE := M5;                  <<01103>>26984000
        IF STATUS.TRACKERR  THEN MTAPE := M7;                  <<01103>>26986000
        IF STATUS.TIMINGERR THEN MTAPE := M8;                  <<01103>>26988000
        IF STATUS.TAPERUN   THEN MTAPE := M9;                  <<01103>>26990000
        IF STATUS.BUSY      THEN MESSAGE(M2407,UNIT);          <<01103>>26992000
      END;                                                     <<01028>>26994000
                                                               <<01028>>26996000
                                                               <<01028>>26998000
    <<  NOTE 1:  THE CALL TO MTAPE IS A RECURSIVE BACK       >><<01028>>27000000
    <<  SPACE RECORD COMMAND.  RECURSION CAN ONLY BE ONE     >><<01028>>27002000
    <<  LEVEL DEEP SINCE THE RECURSIVE CALL USES AN FCODE    >><<01028>>27004000
    <<  OF 3 AND RECURSION CAN ONLY OCCUR WITH AN FCODE OF   >><<01028>>27006000
    <<  0 (READ).                                            >><<01028>>27008000
                                                               <<01028>>27010000
    RETURN;                                                    <<01028>>27012000
  END;                                                         <<01028>>27014000
                                                               <<01028>>27016000
$PAGE                                                          <<01028>>27018000
     <<     S T A R T   O F   D R I V E R     >>               <<01028>>27020000
                                                               <<01028>>27022000
                                                               <<01028>>27024000
                                                               <<00799>>27026000
  TOS := ABSOLUTE(DBBANK);                                     <<01028>>27028000
  TOS := ABSOLUTE(DB);                                         <<01028>>27030000
  ASSEMBLE (DDUP,XCHD);   << SET DB >>                         <<01028>>27032000
  OLDDB := TOS;       << SAVE OLD DB >>                        <<01028>>27034000
    << ONE SET OF DBBANK & DB ADDR ARE STILL ON STACK >>       <<01028>>27036000
  CMDBUFADR := TOS+@CMDBUFF;  << GET ADDRESS OF CMD BUFFER >>  <<01028>>27038000
  DEL;  << DELETE BANK ADDR FROM TOS >>                        <<01028>>27040000
                                                               <<01028>>27042000
  ZEROABS( TEMP'CPVA, 8);                                      <<02510>>27046000
  ERRCOUNT := 0;                                               <<01028>>27048000
  MTAPE := 0;                                                  <<01028>>27050000
  PASS'1 := TRUE;                                              <<01028>>27052000
  DRT := SYSTAPEDRT;  <<SAVE DRT NUMBER>>                      <<03002>>27054000
  UNIT := SYSTAPEUNIT;                                         <<01103>>27056000
  CMDBUFF(CUNIT) := UNIT+1;                                    <<01103>>27058000
    << UNIT # IS INCREMENTED BY 1 ON TOOTHPICK BECAUSE    >>   <<01028>>27060000
    << THE DESIGNERS USED TOO MANY DRUGS.                 >>   <<01028>>27062000
                                                               <<01028>>27064000
  TOS := 0;                                                    <<01028>>27066000
  TOS := ABSOLUTE(TAPECHANPROG);                               <<01028>>27068000
  SET(DB);   << SET DB TO CHAN PROG AREA >>                    <<01028>>27070000
                                                               <<01028>>27072000
                                                               <<01028>>27074000
                                                               <<01028>>27076000
                                                               <<01028>>27078000
<< S E T   U P   &   E X E C U T E   C H A N   P R O G R A M >><<01028>>27080000
                                                               <<01028>>27082000
  DO                                                           <<01028>>27084000
    BEGIN                                                      <<01028>>27086000
      MOVE CP     := CHANIOPROG,(54);                          <<01028>>27088000
      CP(3).MEMX  := ABSOLUTE(DBBANK).MEMX;                    <<01028>>27090000
      CP(4)       := CMDBUFADR+CUNIT;                          <<01028>>27092000
      CP(14).MEMX := ABSOLUTE(DBBANK).MEMX;                    <<01028>>27094000
      CP(15)      := CMDBUFADR+CMOTIONCMD;                     <<01028>>27096000
      CP(50).MEMX := ABSOLUTE(DBBANK).MEMX;                    <<01028>>27098000
      CP(51)      := CMDBUFADR+CSTATBUFF;                      <<01028>>27100000
      CMDBUFF(CSTATBUFF) := -1;  << INITIALIZE STATUS TO BAD >><<00799>>27102000
                                                               <<01028>>27104000
      IF FCODE = 0 THEN                                        <<01028>>27106000
        BEGIN                                                  <<01028>>27108000
          CP(20)      := 0;  << SET DSJ SWITCH FOR READ >>     <<01028>>27110000
          CP(23)      := WORDS&LSL(1); << BYTE COUNT TO READ >><<04306>>27112000
          CP(25)      := ABSOLUTE(DBBANK) + %100000;           <<01028>>27114000
          CP(26)      := ABSOLUTE(DB) + @BUFF;                 <<01028>>27116000
          CP(34).MEMX := ABSOLUTE(DBBANK).MEMX;                <<01028>>27118000
          CP(35)      := CMDBUFADR + CSPFD;                    <<01028>>27120000
          CP(39).MEMX := ABSOLUTE(DBBANK).MEMX;                <<01028>>27122000
          CP(40)      := CMDBUFADR + CDXFERCNT;                <<01028>>27124000
          CMDBUFF(CMOTIONCMD) := CMDREAD;                      <<01028>>27126000
          CMDBUFF(CSPFD) := %23;                               <<01028>>27128000
        END                                                    <<01028>>27130000
      ELSE  << MUST BE A COMMAND >>                            <<01028>>27132000
        BEGIN                                                  <<01028>>27134000
          CP(20) := 25;<<SET DSJ SWITCH TO BRANCH AROUND READ>><<01028>>27136000
          CASE *FCODE OF << RANGE CHECKED BY COLD'LOAD'MEDIA >><<01028>>27138000
            BEGIN                                              <<01028>>27140000
              ;                   << FCODE FOR READ >>         <<01028>>27142000
              CMDBUFF(CMOTIONCMD) := CMDREW'OFF;               <<01028>>27144000
              CMDBUFF(CMOTIONCMD) := CMDFSFILE;                <<01028>>27146000
              CP(9) := 36;        << READYTAPE >>              <<00799>>27148000
              CMDBUFF(CMOTIONCMD) := CMDBSREC;                 <<01028>>27150000
            END;  << END OF CASE >>                            <<01028>>27152000
        END;                                                   <<01028>>27154000
                                                               <<01028>>27156000
      INIT( DRT);                                              <<02510>>27160000
      IF <> THEN ERRMESSAGE( M2, DRT);                         <<02510>>27162000
      SIOP( DRT, ABSOLUTE(TAPECHANPROG));                      <<02510>>27164000
      IF <> THEN ERRMESSAGE( M2, DRT);                         <<02510>>27166000
                                                               <<02510>>27168000
      DO  << WIAT FOR CHAN PROG TO COMPLETE >>                 <<01028>>27170000
           <<POLL CHANNEL STATUS>>                             <<03002>>27174000
      UNTIL GETDRT(DRT,CHANSTAT).(0:2) = 0;                    <<03002>>27176000
                                                               <<01028>>27178000
      STATUS'CHECK;                                            <<01028>>27180000
                                                               <<01028>>27182000
    END  << SET UP & EXECUTE >>                                <<01028>>27184000
  UNTIL NOT RETRY;                                             <<01028>>27186000
                                                               <<01028>>27188000
  IF FCODE = 0 AND GOOD'IO THEN                                <<01028>>27190000
    MTAPE:=WORDS-INTEGER(CP(23)+1)&LSR(1);  <<RETURN XFER LOG>><<01028>>27192000
                                                               <<01028>>27194000
  TOS := OLDDB;    << RESTORE OLD DB >>                        <<01028>>27196000
  SET(DB);                                                     <<01028>>27198000
                                                               <<01028>>27200000
  IF GOOD'IO THEN                                              <<01028>>27202000
    IF LOGICAL(EOF) THEN CC := CCG                             <<01028>>27204000
    ELSE CC := CCE                                             <<01028>>27206000
  ELSE                                                         <<01028>>27208000
    CC := CCL;                                                 <<01028>>27210000
  RETURN;                                                      <<01028>>27212000
                                                               <<01028>>27214000
END;  << MTAPE >>                                              <<01028>>27216000
INTEGER PROCEDURE MT7976( FUNCTION, BUF, WORDS);               <<02517>>27218000
   VALUE FUNCTION, WORDS;                                      <<02517>>27220000
   INTEGER FUNCTION, WORDS;                                    <<02517>>27222000
   ARRAY BUF;                                                  <<02517>>27224000
   OPTION VARIABLE;                                            <<02517>>27226000
BEGIN                                                          <<02517>>27228000
   COMMENT                                                     <<02517>>27230000
                                                               <<02517>>27232000
                                                               <<02517>>27234000
        FUNCTION = 0 - READ,                                   <<02517>>27236000
                   1 - REWIND/OFFLINE,                         <<02517>>27238000
                   2 - FORWARD SPACE FILE,                     <<02517>>27240000
                   3 - WAIT FOR TAPE READY,                    <<02517>>27242000
                                                               <<02517>>27244000
        RETURNS                                                <<02517>>27246000
              CC = CCE - REQUEST COMPLETED,                    <<02517>>27248000
                   CCG - EOF READ,                             <<02517>>27250000
                   CCL - TRANSFER ERROR,                       <<02517>>27252000
                                                               <<02517>>27254000
        MT7976 IS GIVEN THE READ LENGTH ON A SUCCESSFULL READ  <<02517>>27256000
        MT7976 = ERROR MESSAGE NUMBER AND CCL ON IRRECOVERABLE <<02517>>27258000
        ERRORS.                                                <<02517>>27260000
   ;                                                           <<02517>>27262000
   INTEGER ARRAY BASEPGM(*) = PB :=                            <<02517>>27264000
     <<  0 >>        0, << JUMP TO START                   >>  <<02517>>27266000
     <<  1 >>       21,                                        <<02517>>27268000
                                                               <<02517>>27270000
     <<  2 >>[8/1,8/2], << CLEAR POLL / STOP TRANSFER      >>  <<02517>>27272000
     <<  3 >>[8/4,8/%10],<<ENABLE POLL / END TRANSACTION   >>  <<02517>>27274000
                                                               <<02517>>27276000
     <<  4*>>        0, << COMMAND BUFFER                  >>  <<02517>>27278000
     <<  5*>>        0,                                        <<02517>>27280000
                                                               <<02517>>27282000
     <<  6 >>        0, << TRANSFER COUNT BUFFER           >>  <<02517>>27284000
                                                               <<02517>>27286000
     <<  7 >>        0, << STATUS BUFFER                   >>  <<02517>>27288000
     <<  8 >>        0,                                        <<02517>>27290000
     <<  9 >>        0,                                        <<02517>>27292000
                                                               <<02517>>27294000
     << 10 >>        0, << DUMMY READ BUFFER               >>  <<02517>>27296000
                                                               <<02517>>27298000
     << 11 >>    %1401, << READ STATUS                     >>  <<02517>>27300000
     << 12 >>        5, << FIVE BYTES OF STATUS            >>  <<02517>>27302000
     << 13 >>        0,                                        <<02517>>27304000
     << 14 >>    %2000,                                        <<02517>>27306000
     << 15*>>        0, << STATUS BUFFER ADDRESS           >>  <<02517>>27308000
                                                               <<02517>>27310000
     << 16 >>    %2007, << STOP POLLING FOR DATA           >>  <<02517>>27312000
     << 17 >>        1,                                        <<02517>>27314000
     << 18 >>        0,                                        <<02517>>27316000
     << 19 >>   %42000,                                        <<02517>>27318000
     << 20*>>        0,                                        <<02517>>27320000
                                                               <<02517>>27322000
     << 21 >>     %600, << INT/HALT                        >>  <<02517>>27324000
     << 22 >>        1; << BAD CODE                        >>  <<02517>>27326000
   INTEGER ARRAY CTLPGM(*) = PB :=                             <<02517>>27328000
     <<  0 >>    %2001, << SEND COMMANDS                   >>  <<02517>>27330000
     <<  1 >>        0, << NR. OF COMMANDS                 >>  <<02517>>27332000
     <<  2 >>        1, << BURST SIZE = 1                  >>  <<02517>>27334000
     <<  3 >>  %100000,                                        <<02517>>27336000
     <<  4*>>        0, << ADDRESS OF COMMAND BUFFER       >>  <<02517>>27338000
                                                               <<02517>>27340000
     <<  5 >>        0, << JUMP COMPLETE                   >>  <<02517>>27342000
     <<  6 >>        2,                                        <<02517>>27344000
                                                               <<02517>>27346000
     <<  7 >>        0, << JUMP NEXT COMMAND               >>  <<02517>>27348000
     <<  8 >>       -9;                                        <<02517>>27350000
   INTEGER ARRAY READPGM(*) = PB :=                            <<02517>>27352000
     <<  0 >>    %1000, << WAIT FOR CMD COMPLETION         >>  <<02517>>27354000
     <<  1 >>        0,                                        <<02517>>27356000
                                                               <<02517>>27358000
     <<  2 >>    %2401, << DSJ                             >>  <<02517>>27360000
     <<  3 >>        0,                                        <<02517>>27362000
     <<  4 >>        0, << A-OK                            >>  <<02517>>27364000
     <<  5*>>        0, << ERROR JUMP                      >>  <<02517>>27366000
                                                               <<02517>>27368000
                                                               <<02517>>27370000
     <<  6 >>    %1400, << READ THE RECORD                 >>  <<02517>>27372000
     <<  7*>>        0,                                        <<02517>>27374000
     <<  8 >>        0,                                        <<02517>>27376000
     <<  9*>>        0, << BANK                            >>  <<02517>>27378000
     << 10*>>        0, << ADDRESS                         >>  <<02517>>27380000
                                                               <<02517>>27382000
     << 11 >>    %2007, << STOP POLLING FOR DATA           >>  <<02517>>27384000
     << 12 >>        1,                                        <<02517>>27386000
     << 13 >>        0,                                        <<02517>>27388000
     << 14 >>   %42000,                                        <<02517>>27390000
     << 15*>>        0,                                        <<02517>>27392000
                                                               <<02517>>27394000
     << 16 >>    %1402, << READ TRANSFER COUNT             >>  <<02517>>27396000
     << 17 >>        2,                                        <<02517>>27398000
     << 18 >>        0,                                        <<02517>>27400000
     << 19 >>    %2000,                                        <<02517>>27402000
     << 20*>>        0, << TRANSFER COUNT BUFFER           >>  <<02517>>27404000
                                                               <<02517>>27406000
     << 21 >>    %2401, << DSJ                             >>  <<02517>>27408000
     << 22 >>        0,                                        <<02517>>27410000
     << 23 >>        0, << A-OK                            >>  <<02517>>27412000
     << 24*>>        0, << ERROR JUMP                      >>  <<02517>>27414000
                                                               <<02517>>27416000
     << 25 >>    %1401, << READ STATUS                     >>  <<02517>>27418000
     << 26 >>        5,                                        <<02517>>27420000
     << 27 >>        0,                                        <<02517>>27422000
     << 28 >>    %2000,                                        <<02517>>27424000
     << 29*>>        0, << ADDRESS OF STATUS BUFFER        >>  <<02517>>27426000
                                                               <<02517>>27428000
     << 30 >>    %2007, << STOP POLLING FOR DATA           >>  <<02517>>27430000
     << 31 >>        1,                                        <<02517>>27432000
     << 32 >>        0,                                        <<02517>>27434000
     << 33 >>   %42000,                                        <<02517>>27436000
     << 34*>>        0;                                        <<02517>>27438000
   INTEGER ARRAY DSJPGM(*) = PB :=                             <<02517>>27440000
     <<  0 >>    %2401, << DSJ                             >>  <<02517>>27442000
     <<  1 >>        0,                                        <<02517>>27444000
     <<  2 >>        0, << A-OK                            >>  <<02517>>27446000
     <<  3*>>        0; << ERROR JUMP                      >>  <<02517>>27448000
   INTEGER ARRAY STATPGM(*) = PB :=                            <<02517>>27450000
     <<  0 >>    %1401, << READ STATUS                     >>  <<02517>>27452000
     <<  1 >>        5,                                        <<02517>>27454000
     <<  2 >>        0,                                        <<02517>>27456000
     <<  3 >>    %2000,                                        <<02517>>27458000
     <<  4*>>        0,                                        <<02517>>27460000
                                                               <<02517>>27462000
     <<  5 >>    %2007, << STOP POLLING FOR DATA           >>  <<02517>>27464000
     <<  6 >>        1,                                        <<02517>>27466000
     <<  7 >>        0,                                        <<02517>>27468000
     <<  8 >>   %42000,                                        <<02517>>27470000
     <<  9*>>        0;                                        <<02517>>27472000
   INTEGER ARRAY IDLEPGM(*) = PB :=                            <<02517>>27474000
     <<  0 >>    %2007, << ENABLE PARALLEL POLL FOR ALL    >>  <<02517>>27476000
     <<  1 >>        1, << SEND ONE BYTE                   >>  <<02517>>27478000
     <<  2 >>        0,                                        <<02517>>27480000
     <<  3 >>    %2000, << START LEFT BYTE                 >>  <<02517>>27482000
     <<  4 >>        0; << ADDRESS OF COMMAND              >>  <<02517>>27484000
   INTEGER ARRAY WAITPGM(*) = PB :=                            <<02517>>27486000
     <<  0 >>    %1000,                                        <<02517>>27488000
     <<  1 >>        0;                                        <<02517>>27490000
   INTEGER ARRAY INTHALTPGM(*) = PB :=                         <<02517>>27492000
     <<  0 >>     %600,                                        <<02517>>27494000
     <<  1 >>        0; << GOOD CODE                       >>  <<02517>>27496000
   EQUATE                                                      <<02517>>27498000
      BASE'SPFDCMD     =  2,                                   <<02517>>27500000
      BASE'ENAPOLL     =  3,                                   <<02517>>27502000
      BASE'ENDCMD      =  3,                                   <<02517>>27504000
      BASE'CMDBUF      =  4,                                   <<02517>>27506000
      BASE'TRANSBUF    =  6,                                   <<02517>>27508000
      BASE'STATBUF     =  7,                                   <<02517>>27510000
      BASE'DUMMY       = 10,                                   <<02517>>27512000
      BSTAT'ENTRY      = 11,                                   <<02517>>27514000
      BSTAT'STATBUF    = 15,                                   <<02517>>27516000
      BSTAT'STOPPOLL   = 20,                                   <<02517>>27518000
      BASE'LEN         = 23,                                   <<02517>>27520000
      CTL'BYTECNT      =  1,                                   <<02517>>27522000
      CTL'BUFADR       =  4,                                   <<02517>>27524000
      CTL'LEN          =  9,                                   <<02517>>27526000
      RD'DSJ1'BAD      =  5,                                   <<02517>>27528000
      RD'BYTECNT       =  7,                                   <<02517>>27530000
      RD'BANK          =  9,                                   <<02517>>27532000
      RD'ADR           = 10,                                   <<02517>>27534000
      RD'STOPPOLL1     = 15,                                   <<02517>>27536000
      RD'TRANSBUF      = 20,                                   <<02517>>27538000
      RD'DSJ2'BAD      = 24,                                   <<02517>>27540000
      RD'STATUS        = 29,                                   <<02517>>27542000
      RD'STOPPOLL2     = 34,                                   <<02517>>27544000
      RD'LEN           = 35,                                   <<02517>>27546000
      DSJBAD           =  3,                                   <<02517>>27548000
      DSJ'LEN          =  4,                                   <<02517>>27550000
      STAT'BUFADR      =  4,                                   <<02517>>27552000
      STAT'STOPPOLL    =  9,                                   <<02517>>27554000
      STAT'LEN         = 10,                                   <<02517>>27556000
      IDLE'ADR         =  4,                                   <<02517>>27558000
      IDLE'LEN         =  5,                                   <<02517>>27560000
      WAIT'LEN         =  2,                                   <<02517>>27562000
      INTHALT'LEN      =  2;                                   <<02517>>27564000
   EQUATE                                                      <<02517>>27566000
      CPLEN = BASE'LEN+CTL'LEN+RD'LEN+WAIT'LEN+INTHALT'LEN;    <<02517>>27568000
   EQUATE                                                      <<02517>>27570000
      READCMD     = %10,  << READ RECORD COMMAND             >><<02517>>27572000
      FSFCMD      = %13,  << FORWARD SPACE FILE              >><<02517>>27574000
      FSRCMD      = %11,  << FORWARD SPACE RECORD            >><<02517>>27576000
      RWOFFCMD    = %16,  << REWIND UNLOAD COMMAND           >><<02517>>27578000
      ERRMASK     = %15037;                                    <<02517>>27580000
   ARRAY UNITSEL(0:3) = PB := 0, 2, 3, 4;                      <<02517>>27582000
   ARRAY LOGPHYCMD(*) = PB := READCMD,RWOFFCMD,FSFCMD,0,FSRCMD;<<02517>>27584000
   INTEGER POINTER                                             <<02517>>27586000
      OPPNTR,   << CURRENT PROGRAM POINTER >>                  <<02517>>27588000
      CPPNTR;   << NEXT INSTUCTION POINTER >>                  <<02517>>27590000
   INTEGER ARRAY CPBUF(0:CPLEN);                               <<02517>>27592000
   BYTE ARRAY CMDBUF(*) = CPBUF(BASE'CMDBUF);                  <<02517>>27594000
   LOGICAL                                                     <<02517>>27596000
      STATUS,                                                  <<02561>>27598000
      STATUS1,                                                 <<02561>>27600000
      STATUS2;                                                 <<02561>>27602000
   INTEGER                                                     <<02517>>27604000
      ISTATUS = STATUS,                                        <<02517>>27606000
      RTN = MT7976,                                            <<02517>>27608000
      CPADR,                                                   <<02517>>27610000
      BANK,                                                    <<02517>>27612000
      ADDRESS,                                                 <<02517>>27614000
      CMDCNT,                                                  <<02517>>27618000
      IBANK,                                                   <<02517>>27620000
      IADR;                                                    <<02517>>27622000
   DEFINE                                                      <<02517>>27624000
      EOF         = STATUS.(0:1)#,                             <<02517>>27628000
      BOT         = STATUS.(1:1)#,                             <<02517>>27630000
      EOT         = STATUS.(2:1)#,                             <<02517>>27632000
      CMD'REJ     = STATUS.(4:1)#,                             <<02517>>27634000
      WRTPROTECT  = STATUS.(5:1)#,                             <<02517>>27636000
      TRACKERR    = STATUS.(6:1)#,                             <<02517>>27638000
      ONLINE      = STATUS.(7:1)#,                             <<02517>>27640000
      UNIT        = ISTATUS.(9:2)#,                            <<02517>>27642000
      TIMINGERR   = STATUS.(11:1)#,                            <<02517>>27644000
      TAPERUN     = STATUS.(12:1)#,                            <<02517>>27646000
      BUSY        = ISTATUS.(13:3)#,                           <<02517>>27648000
      PRIORERRABT = STATUS1.(8:3) = 5#,                        <<02561>>27650000
      MEMX        = (8:8)#,                                    <<02517>>27652000
      READ        = FUNCTION = 0#,                             <<02517>>27654000
      REWIND      = FUNCTION = 1#,                             <<02517>>27656000
      FSF         = FUNCTION = 2#,                             <<02517>>27658000
      FSR         = FUNCTION = 4#,                             <<02517>>27660000
      ERRCODE     = (0:3)#,                                    <<02517>>27662000
      NEWREQ      = ABS(ABSFLAGS).(14:1)#;                     <<02517>>27664000
                                                               <<02517>>27666000
   SUBROUTINE CONTROL( CODE);                                  <<02517>>27668000
      VALUE CODE;                                              <<02517>>27670000
      INTEGER CODE;                                            <<02517>>27672000
   BEGIN                                                       <<02517>>27674000
      IF CMDCNT = 0 THEN                                       <<02517>>27676000
         BEGIN                                                 <<02517>>27678000
         @OPPNTR := @CPPNTR;                                   <<02517>>27680000
         MOVE OPPNTR := CTLPGM,(CTL'LEN),2;                    <<02517>>27682000
         @CPPNTR := TOS;                                       <<02517>>27684000
         OPPNTR( CTL'BUFADR) := CPADR+BASE'CMDBUF;             <<02517>>27686000
         END;                                                  <<02517>>27688000
      CMDBUF( CMDCNT) := UNITSEL( SYSTAPEUNIT);                <<02517>>27690000
      CMDCNT := CMDCNT+1;                                      <<02517>>27692000
      CMDBUF( CMDCNT) := CODE;                                 <<02517>>27694000
      CMDCNT := CMDCNT+1;                                      <<02517>>27696000
      OPPNTR( CTL'BYTECNT) := CMDCNT;                          <<02517>>27698000
   END;                                                        <<02517>>27700000
                                                               <<02517>>27702000
   SUBROUTINE WAIT;                                            <<02517>>27704000
   BEGIN                                                       <<02517>>27706000
      MOVE CPPNTR := WAITPGM,(WAIT'LEN),2;                     <<02517>>27708000
      @CPPNTR := TOS;                                          <<02517>>27710000
   END;                                                        <<02517>>27712000
                                                               <<02517>>27714000
   SUBROUTINE INTHALT;                                         <<02517>>27716000
   BEGIN                                                       <<02517>>27718000
      MOVE CPPNTR := INTHALTPGM,(INTHALT'LEN),2;               <<02517>>27720000
      @CPPNTR := TOS;                                          <<02517>>27722000
   END;                                                        <<02517>>27724000
                                                               <<02517>>27726000
   SUBROUTINE STAT';                                           <<02517>>27728000
   BEGIN                                                       <<02517>>27730000
      @OPPNTR := @CPPNTR;                                      <<02517>>27732000
      MOVE OPPNTR := STATPGM,(STAT'LEN),2;                     <<02517>>27734000
      @CPPNTR := TOS;                                          <<02517>>27736000
      OPPNTR( STAT'BUFADR) := CPADR+BASE'STATBUF;              <<02517>>27738000
      OPPNTR( STAT'STOPPOLL) := CPADR+BASE'ENDCMD;             <<02517>>27740000
   END;                                                        <<02517>>27742000
                                                               <<02517>>27744000
   SUBROUTINE DSJ;                                             <<02517>>27746000
   BEGIN                                                       <<02517>>27748000
      @OPPNTR := @CPPNTR;                                      <<02517>>27750000
      MOVE OPPNTR := DSJPGM,(DSJ'LEN),2;                       <<02517>>27752000
      @CPPNTR := TOS;                                          <<02517>>27754000
      OPPNTR( DSJBAD) := @CPBUF( BSTAT'ENTRY)                  <<02517>>27756000
         -@OPPNTR( DSJBAD+1);                                  <<02517>>27758000
   END;                                                        <<02517>>27760000
                                                               <<02517>>27762000
   SUBROUTINE BUILD'READ( DUMMYREAD);                          <<02517>>27764000
      VALUE DUMMYREAD;                                         <<02517>>27766000
      LOGICAL DUMMYREAD;                                       <<02517>>27768000
   BEGIN                                                       <<02517>>27770000
      @OPPNTR := @CPPNTR;                                      <<02517>>27772000
      MOVE OPPNTR := READPGM,(RD'LEN),2;                       <<02517>>27774000
      @CPPNTR := TOS;                                          <<02517>>27776000
                                                               <<02517>>27778000
      OPPNTR( RD'DSJ1'BAD) := @CPBUF(BSTAT'ENTRY)              <<02517>>27780000
         -@OPPNTR( RD'DSJ1'BAD+1);                             <<02517>>27782000
      IF DUMMYREAD OR WORDS = 0 THEN                           <<02561>>27784000
         BEGIN                                                 <<02517>>27786000
         OPPNTR( RD'BYTECNT) := 2;                             <<02517>>27788000
         OPPNTR( RD'BANK).MEMX := 0;                           <<02517>>27790000
         OPPNTR( RD'ADR) := CPADR+BASE'DUMMY;                  <<02517>>27792000
         END                                                   <<02517>>27794000
      ELSE                                                     <<02517>>27796000
         BEGIN                                                 <<02517>>27798000
         OPPNTR( RD'BYTECNT) := WORDS&LSL(1);                  <<02517>>27800000
         OPPNTR( RD'BANK).MEMX := BANK;                        <<02517>>27802000
         OPPNTR( RD'ADR) := ADDRESS;                           <<02517>>27804000
         END;                                                  <<02517>>27806000
      OPPNTR( RD'STOPPOLL1) := CPADR+BASE'SPFDCMD;             <<02517>>27808000
      OPPNTR( RD'TRANSBUF) := CPADR+BASE'TRANSBUF;             <<02517>>27810000
      OPPNTR( RD'DSJ2'BAD) := @CPBUF(BSTAT'ENTRY)              <<02517>>27812000
         -@OPPNTR( RD'DSJ2'BAD+1);                             <<02517>>27814000
      OPPNTR( RD'STATUS) := CPADR+BASE'STATBUF;                <<02517>>27816000
      OPPNTR( RD'STOPPOLL2) := CPADR+BASE'ENDCMD;              <<02517>>27818000
   END;                                                        <<02517>>27822000
                                                               <<02517>>27824000
   SUBROUTINE LAUNCH;                                          <<02517>>27826000
   BEGIN                                                       <<02517>>27828000
      PUSH( DB );                                              <<02517>>27830000
      TOS := TOS+@CPBUF;                                       <<02517>>27832000
      IADR := TOS;   << ADDRESS >>                             <<02517>>27834000
      IBANK := TOS;  << BANK    >>                             <<02517>>27836000
      MABS( 0,CPADR,IBANK,IADR,@CPPNTR-@CPBUF);                <<02517>>27838000
      INIT( SYSTAPEDRT);                                       <<02517>>27840000
      IF <> THEN ERRMESSAGE( M2, SYSTAPEDRT);                  <<02517>>27842000
      SIOP( SYSTAPEDRT, CPADR);                                <<02517>>27844000
      IF <> THEN ERRMESSAGE( M2, SYSTAPEDRT);                  <<02517>>27846000
         << WAIT FOR PROGRAM TO COMPLETE >>                    <<02517>>27848000
      WHILE GETDRT(SYSTAPEDRT,CHANSTAT).(0:2) <>0 DO;          <<03002>>27850000
      STATUS := ABS(CPADR+BASE'STATBUF);                       <<02517>>27852000
      STATUS1 := ABS(X:=X+1);                                  <<02561>>27854000
      STATUS2 := ABS(X:=X+1);                                  <<02561>>27856000
   END;                                                        <<02517>>27858000
                                                               <<02517>>27860000
   SUBROUTINE WAITFORREADY;                                    <<02517>>27862000
   BEGIN                                                       <<02517>>27864000
      DO BEGIN                                                 <<02517>>27866000
         @OPPNTR := @CPPNTR;                                   <<02517>>27868000
         MOVE OPPNTR := IDLEPGM,(IDLE'LEN),2;                  <<02517>>27870000
         @CPPNTR := TOS;                                       <<02517>>27872000
         OPPNTR(IDLE'ADR) := CPADR+BASE'ENAPOLL;               <<02517>>27874000
         WAIT;                                                 <<02517>>27876000
         DSJ;                                                  <<02517>>27878000
         STAT';                                                <<02517>>27880000
         INTHALT;                                              <<02517>>27882000
         LAUNCH;                                               <<02517>>27884000
         @CPPNTR := @CPBUF(BASE'LEN);                          <<02517>>27886000
         END UNTIL ONLINE AND BUSY = 0 AND UNIT = SYSTAPEUNIT; <<02517>>27888000
   END;                                                        <<02517>>27890000
                                                               <<02517>>27892000
   CPADR := ABS( TAPECHANPROG);                                <<02517>>27894000
   PUSH( DB );                                                 <<02517>>27896000
   TOS := TOS+@BUF;                                            <<02517>>27898000
   ADDRESS := TOS;                                             <<02517>>27900000
   BANK := TOS;                                                <<02517>>27902000
START:                                                         <<02517>>27904000
   MOVE CPBUF := BASEPGM,(BASE'LEN),2;                         <<02517>>27906000
   @CPPNTR := TOS;                                             <<02517>>27908000
   CMDCNT := 0;                                                <<02517>>27910000
      << INITIALIZE BASE PROGRAM >>                            <<02517>>27912000
   CPBUF( BSTAT'STATBUF) := CPADR+BASE'STATBUF;                <<02517>>27914000
   CPBUF( BSTAT'STOPPOLL) := CPADR+BASE'ENDCMD;                <<02517>>27916000
   ZEROABS( TEMP'CPVA, 8);                                     <<02517>>27918000
                                                               <<02517>>27922000
   IF FUNCTION = 3 THEN                                        <<02517>>27924000
      BEGIN                                                    <<02517>>27926000
      WAITFORREADY;                                            <<02517>>27928000
      CC := CCE;                                               <<02517>>27930000
      RETURN;                                                  <<02517>>27932000
      END;                                                     <<02517>>27934000
                                                               <<02517>>27936000
   IF NEWREQ THEN                                              <<02517>>27938000
      BEGIN                                                    <<02517>>27940000
      IF READ THEN                                             <<02517>>27942000
         BEGIN                                                 <<02517>>27944000
         CONTROL( READCMD);                                    <<02517>>27946000
         CONTROL( READCMD);                                    <<02517>>27948000
         BUILD'READ( FALSE);                                   <<02517>>27950000
         NEWREQ := FALSE;                                      <<02517>>27952000
         END                                                   <<02517>>27954000
      ELSE                                                     <<02517>>27956000
         BEGIN                                                 <<02517>>27958000
         CONTROL( LOGPHYCMD(FUNCTION));                        <<02517>>27960000
         WAIT;                                                 <<02517>>27962000
         DSJ;                                                  <<02517>>27964000
         STAT';                                                <<02517>>27966000
         END;                                                  <<02517>>27968000
      END                                                      <<02517>>27970000
   ELSE                                                        <<02517>>27972000
      BEGIN                                                    <<02517>>27974000
      IF READ THEN                                             <<02517>>27976000
         BEGIN                                                 <<02517>>27978000
         CONTROL( READCMD);                                    <<02517>>27980000
         BUILD'READ( FALSE);                                   <<02517>>27982000
         END                                                   <<02517>>27984000
      ELSE                                                     <<02517>>27986000
         BEGIN                                                 <<02517>>27988000
         BUILD'READ( TRUE); << FINISH OLD REQUEST >>           <<02517>>27990000
         INTHALT;                                              <<02517>>27992000
         LAUNCH;                                               <<02517>>27994000
         IF ABS( TEMP'CPVA).ERRCODE <> 4 THEN                  <<02517>>27996000
            GO CHECKSTATUS;                                    <<02517>>27998000
         NEWREQ := TRUE;                                       <<02517>>28000000
         IF FSR THEN GO CHECKSTATUS;                           <<02517>>28002000
         IF FSF AND EOF THEN GO CHECKSTATUS;                   <<02517>>28004000
         GO START;                                             <<02517>>28006000
         END;                                                  <<02517>>28008000
      END;                                                     <<02517>>28010000
                                                               <<02517>>28012000
   INTHALT;                                                    <<02517>>28014000
   LAUNCH;                                                     <<02517>>28016000
                                                               <<02517>>28018000
CHECKSTATUS:                                                   <<02517>>28020000
   IF ABS( TEMP'CPVA).ERRCODE <> 4 THEN                        <<02517>>28022000
      ERRMESSAGE( M3, ABS(TEMP'CPVA));                         <<02517>>28024000
   IF ABS( TEMP'CPVA).(3:13) <> 0 THEN                         <<02517>>28026000
      BEGIN   << BETTER CHECK STATUS >>                        <<02517>>28028000
      IF CMD'REJ THEN                                          <<02561>>28032000
         BEGIN                                                 <<02561>>28034000
         IF NOT ONLINE THEN                                    <<02561>>28036000
            BEGIN                                              <<02561>>28038000
            MESSAGE( M2407, SYSTAPEUNIT);                      <<02561>>28040000
            WAITFORREADY;                                      <<02561>>28042000
            GO START; << TRY IT AGAIN !!! >>                   <<02561>>28044000
            END                                                <<02561>>28046000
         ELSE                                                  <<02561>>28048000
            MT7976 := M5;                                      <<02561>>28050000
         END;                                                  <<02561>>28052000
      IF TRACKERR THEN MT7976 := M7;                           <<02561>>28054000
      IF TIMINGERR THEN MT7976 := M8;                          <<02561>>28056000
      IF TAPERUN THEN MT7976 := M9;                            <<02561>>28058000
      IF RTN <> 0 THEN                                         <<02561>>28062000
         BEGIN                                                 <<02561>>28064000
         IF NOT NEWREQ THEN << BIG TROUBLE !!! >>              <<02561>>28066000
            BEGIN<<MT ABORTED SECOND REQUEST - SO FINISH IT OFF<<02561>>28068000
            @CPPNTR := @CPBUF(BASE'LEN);                       <<02561>>28070000
            BUILD'READ( TRUE);                                 <<02561>>28072000
            INTHALT;                                           <<02561>>28074000
            LAUNCH;                                            <<02561>>28076000
            NEWREQ := TRUE;                                    <<02561>>28078000
            END;                                               <<02561>>28080000
         CC := CCL;                                            <<02561>>28082000
         RETURN;                                               <<02561>>28084000
         END;                                                  <<02561>>28086000
      END;                                                     <<02561>>28088000
   CC := CCE;                                                  <<02561>>28090000
   IF READ THEN  << RETURN TRANSFER COUNT >>                   <<02561>>28092000
      BEGIN                                                    <<02561>>28094000
      MT7976 := (ABS(CPADR+BASE'TRANSBUF)+1)&LSR(1);           <<02561>>28096000
      IF EOF THEN                                              <<02561>>28098000
         BEGIN                                                 <<02561>>28100000
         CC := CCG;                                            <<02561>>28102000
         IF NOT NEWREQ THEN << BIG TROUBLE !!! >>              <<02561>>28104000
            BEGIN<<MT ABORTED OUR 2nd REQUEST-SO FINISH IT OFF <<02561>>28106000
            @CPPNTR := @CPBUF(BASE'LEN);                       <<02561>>28108000
            BUILD'READ( TRUE);                                 <<02561>>28110000
            INTHALT;                                           <<02561>>28112000
            LAUNCH;                                            <<02561>>28114000
            IF ABS( TEMP'CPVA).ERRCODE <> 4 THEN               <<02561>>28116000
               GO CHECKSTATUS;                                 <<02561>>28118000
            IF NOT (CMD'REJ LAND PRIORERRABT) THEN             <<02561>>28120000
               ERRMESSAGE( M374, 1);                           <<02561>>28122000
            NEWREQ := TRUE;                                    <<02561>>28124000
            END;                                               <<02561>>28126000
         END;                                                  <<02561>>28128000
      END;                                                     <<02561>>28130000
END;                                                           <<02561>>28132000
INTEGER PROCEDURE COLD'LOAD'MEDIA( FUNC, BUF, WORDC, RTN);     <<02510>>28136000
   VALUE FUNC, WORDC, RTN;                                     <<02510>>28138000
   INTEGER FUNC, WORDC;                                        <<02510>>28140000
   LOGICAL RTN;                                                <<02510>>28142000
   ARRAY BUF;                                                  <<02510>>28144000
   OPTION VARIABLE;                                            <<02510>>28146000
BEGIN                                                          <<02510>>28148000
   LOGICAL VAR = Q-4;                                          <<02510>>28150000
   INTEGER MSGNR = COLD'LOAD'MEDIA;                            <<02510>>28152000
   CC := CCE;                                                  <<02510>>28154000
   IF NOT VAR THEN RTN := FALSE;                               <<02510>>28156000
   IF SERIALDISCLOAD THEN                                      <<02510>>28158000
      COLD'LOAD'MEDIA := SDISCDVR( FUNC, BUF, WORDC)           <<02510>>28160000
   ELSE                                                        <<02510>>28162000
$IF X1=OFF   << ***** SERIES II,III UNIQUE ******* >>          <<02510>>28164000
      IF SERIESII'III THEN                                     <<02510>>28166000
         BEGIN                                                 <<02510>>28168000
         TOS := SYSTAPEDRT;                                    <<02510>>28170000
         ASSEMBLE( TIO 0 );                                    <<02510>>28172000
         IF <> THEN                                            <<02510>>28174000
            BEGIN                                              <<02510>>28176000
            IF STARFISH THEN                                   <<02510>>28178000
               GO HPIB'MTDVR                                   <<02510>>28180000
            ELSE                                               <<02510>>28182000
               ERRMESSAGE( M1, SYSTAPEDRT);                    <<02510>>28184000
            END;                                               <<02510>>28186000
         CASE FUNC OF                                          <<02510>>28188000
            BEGIN                                              <<02510>>28190000
            COLD'LOAD'MEDIA := READTAPE( BUF, WORDC);          <<02510>>28192000
            COLD'LOAD'MEDIA := TAPECTRL(%11); << REWIND UNLOAD <<02510>>28194000
            COLD'LOAD'MEDIA := TAPECTRL(%17); << FSF >>        <<02510>>28196000
            READYTAPE;                                         <<02510>>28198000
            END;                                               <<02510>>28200000
         END                                                   <<02510>>28202000
      ELSE                                                     <<02510>>28204000
$IF      << ******* RETURN TO COMMON CODE ********* >>         <<02510>>28206000
         BEGIN  << SERIES 33/44/55 >>                          <<02510>>28208000
HPIB'MTDVR:                                                    <<02510>>28210000
         COLD'LOAD'MEDIA := IF (SYSTAPESTYPE).(13:3) = 1 THEN  <<02561>>28212000
            MT7976( FUNC, BUF, WORDC)                          <<02561>>28214000
         ELSE                                                  <<02561>>28216000
            MTAPE( FUNC, BUF, WORDC);                          <<02561>>28218000
         END;                                                  <<02510>>28220000
   IF > THEN                                                   <<02510>>28222000
      CC := CCG                                                <<02510>>28224000
   ELSE                                                        <<02510>>28226000
      IF < THEN                                                <<02510>>28228000
         BEGIN                                                 <<02510>>28230000
         CC := CCL;                                            <<02510>>28232000
         IF NOT RTN THEN ERRMESSAGE(MSGNR); << DIE >>          <<02510>>28234000
         IF MSGNR = 7 OR MSGNR = 8 THEN                        <<02510>>28236000
            COLD'LOAD'MEDIA := 0                               <<02510>>28238000
         ELSE                                                  <<02510>>28240000
            BEGIN                                              <<02510>>28242000
            MESSAGE(MSGNR);                                    <<02510>>28244000
            COLD'LOAD'MEDIA := 1;                              <<02510>>28246000
            END;                                               <<02510>>28248000
         END;                                                  <<02510>>28250000
END;                                                           <<02510>>28252000
PROCEDURE NEXTREEL(BUF);                                       <<00071>>28254000
INTEGER ARRAY BUF;                                             <<00071>>28256000
BEGIN                                                          <<00071>>28258000
BYTE POINTER BBUF;                                             <<00071>>28260000
INTEGER LENGTH,WORDC;                                          <<00071>>28262000
LOGICAL FOUND;                                                 <<00071>>28264000
@BBUF:=@BUF&LSL(1);                                            <<00071>>28266000
WORDC:=COLD'LOAD'MEDIA(READ,BUF,1024);                         <<00678>>28268000
IF WORDC=40 AND BBUF=                                          <<00071>>28270000
"SYSDUMP/INITIAL DISC" THEN                                    <<00071>>28272000
   BEGIN <<GET NEXT FLOPPY DISC>>                              <<00071>>28274000
   IF SDISCREEL=0 THEN                                         <<00071>>28276000
      BEGIN                                                    <<00071>>28278000
      SDISCREEL:=BUF(10);                                      <<00071>>28280000
      SDISCDATE:=BUF(11);                                      <<00071>>28282000
      SDISCTIME1:=BUF(12);                                     <<00071>>28284000
      SDISCTIME2:=BUF(13);                                     <<00071>>28286000
      END;                                                     <<00071>>28288000
   SDISCREEL:=SDISCREEL+1;                                     <<00071>>28290000
   FOUND := FALSE;                                             <<03715>>28294000
   DO                                                          <<03715>>28296000
      BEGIN        << INSURE CORRECT FLOPPY MOUNTED >>         <<03715>>28298000
      COLD'LOAD'MEDIA(REWUNLOAD);                              <<03715>>28300000
      MESSAGE(M2331,SDISCREEL);   << MOUNT SERIAL DISC # N >>  <<03715>>28302000
                                                               <<03715>>28304000
      COLD'LOAD'MEDIA(TAPEREADY);                              <<03715>>28306000
      IF = THEN                   << SERIAL DISC READY AND >>  <<03715>>28308000
         BEGIN                    <<    VALID FORMAT       >>  <<03715>>28310000
         COLD'LOAD'MEDIA(READ,BUF,40);   << READ HEADER >>     <<03715>>28312000
         IF BBUF = "SYSDUMP/INITIAL DISC" AND                  <<03715>>28314000
            BUF(10) = SDISCREEL AND                            <<03715>>28316000
            BUF(11) = SDISCDATE AND                            <<03715>>28318000
            BUF(12) = SDISCTIME1 AND                           <<03715>>28320000
            BUF(13) = SDISCTIME2 THEN                          <<03715>>28322000
                                                               <<03715>>28324000
            FOUND := TRUE;                                     <<03715>>28326000
         END;                                                  <<03715>>28328000
      END                                                      <<03715>>28330000
   UNTIL FOUND;                                                <<03715>>28332000
   END'OF'TAPE:=FALSE; <<False>>                               <<03598>>28334000
   END;                                                        <<00071>>28336000
END;                                                           <<00071>>28338000
                                                               <<00071>>28340000
                                                                        28342000
          <<---------------------------                                 28344000
            READ FROM MULTI-REEL TAPE                                   28346000
          --------------------------->>                                 28348000
  PROCEDURE READTAPE' (WORDC);                                 <<01092>>28350000
    VALUE WORDC;                                               <<01092>>28352000
    INTEGER WORDC;                                                      28354000
    COMMENT:                                                   <<00.06>>28356000
                                                               <<KS.88>>28358000
************ WARNING ******************                        <<KS.88>>28360000
-----------------> THIS PROCEDURE SHOULD ONLY BE USED <------- <<KS.88>>28362000
                   BY THE FILE RESTORE PORTION OF INITIAL <----<<KS.88>>28364000
                                                               <<KS.88>>28366000
      READTAPE IS DESIGNED TO ABORT THE PROGRAM IF IT          <<00.06>>28368000
      DETECTS AN EOF-MARK WHERE NOT EXPECTED.  ONLY IF         <<03715>>28370000
      WORDC=0 WILL AN EOF-MARK BE EXPECTED.  EXCEPTION:        <<00.06>>28374000
      AN EOF-MARK DENOTING THE END-OF-TAPE IN THE              <<00.06>>28376000
      MIDDLE OF A MULTIPLE-REEL FILE WILL BE HANDLED           <<00.06>>28378000
      PROPERLY.  SECOND EXCEPTION: IF A DOUBLE EOF-            <<00.06>>28380000
      MARK IS DETECTED, MANUAL OVERRIDE OF THE ABORT           <<00.06>>28382000
      IS ALLOWED. (THIS SHOULD ONLY BE USED WHEN ABSOLUTELY    <<00.06>>28384000
      NECESSARY AS DOUBLE EOF DENOTES (1)TAPE FORMAT ERROR     <<00.06>>28386000
      OR (2)PARITY ERROR DURING READING OF TRAILER LABEL.)     <<00.06>>28388000
      STATUS RETURNED BY ROUTINE:                              <<00.06>>28390000
        CCL-TAPE TRANSFER ERROR                                <<01028>>28392000
        CCG-NO MORE TAPE SETS AVAILABLE                        <<00.06>>28394000
        CCE-RECORD READ OKAY                                   <<00.06>>28396000
;                                                              <<00.06>>28398000
      BEGIN                                                             28400000
DEFINE LBUF=RESTOREBUF#;<<MAKE THIS PROCEDURE USE RESTORE BUF>><<00678>>28402000
DEFINE BLBUF = BRESTOREBUF#;                                   <<03715>>28404000
        DOUBLE DATE;                                           <<00678>>28408000
        INTEGER NEWREEL;                                       <<00678>>28410000
        INTEGER DATE1=DATE,DATE2=DATE1+1,SAVX;                 <<00678>>28412000
          BYTE POINTER ITMPB;                                  <<00678>>28414000
          @ITMPB:=@ITMP&LSL(1);<<CONVERT ADDRESS TO BYTES>>    <<00678>>28416000
          STAT.(6:2) := CCE;  <<NORMAL RETURN>>                <<00678>>28418000
  AGN:    IF WORDC <> 0 THEN                                   <<00678>>28420000
          IF DATAFLAG THEN                                     <<00678>>28422000
            BEGIN  <<DATA IN BUFFER>>                          <<00678>>28424000
              DATAFLAG := FALSE;                               <<00678>>28426000
              RETURN;                                          <<00678>>28428000
            END                                                <<00678>>28430000
          ELSE                                                 <<00678>>28432000
            BEGIN  <<READ ARECORD>>                            <<00678>>28434000
              LEN := COLD'LOAD'MEDIA(READ, LBUF, WORDC, TRUE); <<01092>>28436000
              IF > THEN GO CHECKFOREOT;  <<EOF>>               <<00678>>28438000
              IF < THEN GO TO ERR'EXIT;                        <<01092>>28440000
              RETURN;                                          <<00678>>28442000
            END;                                               <<00678>>28444000
          DATAFLAG := FALSE;  <<FORWARD SPACE FILE>>           <<00678>>28446000
          COLD'LOAD'MEDIA(FWDSPFILE,,,TRUE);                   <<01092>>28448000
          IF < THEN GO TO ERR'1'EXIT;                          <<01092>>28450000
  CHECKFOREOT:                                                 <<00678>>28452000
          LEN := COLD'LOAD'MEDIA(READ, LBUF, RECSIZE, TRUE);   <<01092>>28454000
          IF > THEN                                            <<00678>>28456000
            BEGIN  <<DOUBLE EOF MARKS>>                        <<00678>>28458000
            <<USUALLY INDICATES TAPE FORMAT ERROR WHICH>>      <<00678>>28460000
            <<IS IRRECOVERABLE, BUT MAY INDICATE A >>          <<00678>>28462000
            <<PARITY ERROR DURING READING OF THE TAPE>>        <<00678>>28464000
            <<TRAILER LABEL, WHICH IS NOT FATAL.>>             <<00678>>28466000
            MESSAGE(M2279);    <<**WARNING** DOUBLE EOF MARK.>><<01103>>28468000
            IF HEDLABP THEN GO TO ERR'1'EXIT;                  <<01092>>28470000
            NEWREEL:=REEL+1;<<USE REEL# FROM HEADER>>          <<01092>>28472000
            REEL:=REEL+1;<<KEEP UP THE COUNTING>>              <<01092>>28474000
NXTREEL:    COLD'LOAD'MEDIA(REWUNLOAD,,,TRUE);                 <<01092>>28476000
            IF < THEN GO TO ERR'1'EXIT;                        <<01092>>28478000
            GETYESNO(@NOMORESETS, M2284);                      <<01103>>28480000
            << IS THERE ANOTHER TAPE TO READ? >>               <<01092>>28482000
            TOS:=@INBUF;<<FIRST PARAM FOR PRINT>>              <<00678>>28484000
            TOS:=0;<<SPACE FOR RETURN VALUE FROM ASCII>>       <<00678>>28486000
            TOS:=NEWREEL;                                      <<00678>>28488000
            MOVE BINBUF:="MOUNT REEL #",2;<<LEAVE DEST>>       <<00678>>28490000
            <<FOR ASCII>>                                      <<00678>>28492000
            TOS:=ASCII(*,*);                                   <<00678>>28494000
            TOS:=-TOS-12;<<ADD LENGTH OF "MOUNT REEL #">>      <<00678>>28496000
            PRINT(*,*,0); <<REQUEST NEXT REEL>>                <<00678>>28498000
            COLD'LOAD'MEDIA(TAPEREADY,,,TRUE);                 <<01092>>28500000
            IF > THEN            << SERIAL DISC NOT READY >>   <<03715>>28502000
               GOTO NXTREEL;     <<    OR BAD FORMAT      >>   <<03715>>28504000
            IF < THEN GO TO ERR'1'EXIT;                        <<01092>>28506000
            LEN:=COLD'LOAD'MEDIA(READ,LBUF,50,TRUE);           <<01092>>28508000
            IF < THEN GO TO ERR'EXIT;                          <<01092>>28510000
            IF LEN <> 40 OR BLBUF <> LABELTEXT THEN            <<00678>>28512000
              BEGIN  <<BAD LABEL>>                             <<00678>>28514000
              MESSAGE(M376);  <<NOT A RELOAD TAPE>>            <<01103>>28516000
              GOTO NXTREEL;                                    <<00678>>28518000
              END;                                             <<00678>>28520000
            TOS:=@CHDATE&LSL(1);                               <<00678>>28522000
            IF * <> ITMPB,(3) THEN                             <<00678>>28524000
              BEGIN  <<TAPE NOT A MEMBER OF THIS SET>>         <<00678>>28526000
              MESSAGE(M377);                                   <<01103>>28528000
              GOTO NXTREEL;                                    <<00678>>28530000
              END;                                             <<00678>>28532000
            IF REELNUM <> NEWREEL THEN                         <<00678>>28534000
              BEGIN  <<WRONG REEL>>                            <<00678>>28536000
              MESSAGE(M379);  << WRONG REEL >>                 <<01103>>28538000
              GOTO NXTREEL;                                    <<00678>>28540000
              END;                                             <<00678>>28542000
            COLD'LOAD'MEDIA(FWDSPFILE,,,TRUE);                 <<01092>>28544000
            IF < THEN GO TO ERR'1'EXIT;                        <<01092>>28546000
            COLD'LOAD'MEDIA(FWDSPFILE,,,TRUE);                 <<01092>>28548000
            IF < THEN GO TO ERR'1'EXIT;                        <<01092>>28550000
      LEN:=COLD'LOAD'MEDIA(READ,LBUF,RECSIZE,TRUE); <<READ FIRST>>      28552000
            <<RECORD OF NEW FILE>>                             <<00678>>28554000
            IF < THEN GO TO ERR'EXIT;                          <<01092>>28556000
            DATAFLAG:=TRUE;                                    <<00678>>28558000
            RETURN;                                            <<00678>>28560000
            END;                                               <<00678>>28562000
          IF < THEN GO TO ERR'EXIT;                            <<01092>>28564000
          IF LEN<>40 THEN                                      <<00678>>28566000
            BEGIN  <<NOT END OF TAPE>>                         <<00678>>28568000
              IF WORDC<>0 THEN GO TO ERR'1'EXIT;               <<01092>>28570000
              DATAFLAG := TRUE;  <<DATA IN BUFFER>>            <<00678>>28572000
              RETURN;                                          <<00678>>28574000
            END;                                               <<00678>>28576000
          IF ZFIELD=1 THEN <<END OF TAPE SET>>                 <<00678>>28578000
          IF WORDC<>0 THEN GO TO ERR'1'EXIT                    <<01092>>28580000
          ELSE                                                 <<00678>>28582000
            BEGIN  <<REQUEST ANOTHER TAPE SET>>                <<00678>>28584000
              DATE1 := CHDATE;                                 <<00678>>28586000
              DATE2 := CHHHMM;  <<SAVE DATE>>                  <<00678>>28588000
NEXTSET:      COLD'LOAD'MEDIA(REWUNLOAD,,,TRUE);               <<01092>>28590000
              IF < THEN GO TO ERR'1'EXIT;                      <<01092>>28592000
              GETYESNO(@NOMORESETS,M2276,NUSERFILES);          <<01103>>28594000
              <<FILES NOT FOUND;>>                             <<01062>>28596000
              <<ANOTHER TAPE SET AVAILABLE?>>                  <<00678>>28598000
              GETYESNO(@TREADY,M2330);                         <<01103>>28600000
              <<CHANGE INPUT DEVICE?>>                         <<00678>>28602000
              SD'ONLINE:=FALSE;  <<False>>                     <<03598>>28604000
              DO                                               <<00678>>28606000
                 BEGIN <<GET A VALID INPUT LDEV>>              <<00678>>28608000
                 SYSTAPELDEV:=GETVAL(M2011,2,HLDEV,1);         <<01103>>28610000
                 SYSTAPETYPE := LDT(SYSTAPELDEV*LDTSIZE+       <<02706>>28612000
                                LDT2).TYP;     << SAVE TYPE >> <<02706>>28614000
                 SYSTAPESTYPE := LPDT(SYSTAPELDEV*LPDTSIZE+    <<02706>>28616000
                                 LPDT1).SUBTYPE; <<& SUBTYPE>> <<02706>>28618000
                 SYSTAPEDRTUNIT := DVRTAB(SYSTAPELDEV*         <<03550>>28620000
                                   DVRSIZE); <<& DRT, UNIT  >> <<03550>>28622000
                 IF NON'DS'LDEV(SYSTAPELDEV) THEN              <<03550>>28626000
                   BEGIN  << HAVE A CONFIGURED DEVICE >>       <<03550>>28628000
                   INITDRT( SYSTAPEDRT);                       <<03550>>28630000
                   IF SYSTAPETYPE=TAPETYPE THEN                <<03550>>28632000
                     BEGIN    << WE HAVE A MAG TAPE >>         <<03550>>28634000
                     SERIALDISCLOAD := FALSE;                  <<03550>>28636000
                     SD'ONLINE := TRUE;  <<True>>              <<03598>>28638000
                     IF SYSTAPESTYPE.(13:3) = 1 THEN           <<03550>>28640000
                        << WE HAVE A 7976 TAPE DRIVE >>        <<03550>>28642000
                        MT7976(4,I,0); <<CLEAR PWR-ON STATUS>> <<03550>>28644000
                     END                                       <<03550>>28646000
                   ELSE IF SDISC'TYPE(SYSTAPETYPE,             <<03550>>28648000
                                      SYSTAPESTYPE) THEN       <<03550>>28650000
                     BEGIN   << VALID SERIAL DISC TYPE >>      <<03550>>28652000
                     SD'ONLINE := TRUE;  <<True>>              <<03598>>28654000
                     SERIALDISCLOAD := TRUE;                   <<03550>>28656000
                     END     << VALID SERIAL DISC TYPE >>      <<03550>>28658000
                   ELSE                                        <<03550>>28660000
                     MESSAGE( 2285);   << NOT A VALID COLD- >> <<03550>>28662000
                                       << LOAD DEVICE       >> <<03550>>28664000
                   END                                         <<03550>>28666000
                 ELSE                                          <<03550>>28668000
                   MESSAGE( 2285);  << NOT A VALID >>          <<03550>>28670000
                                    << DEVICE NO.  >>          <<03550>>28672000
                 END   <<GET A VALID INPUT LDEV>>              <<00678>>28674000
              UNTIL SD'ONLINE;                                 <<03715>>28676000
                                                               <<00678>>28678000
TREADY:                                                        <<00678>>28680000
                                                               <<00678>>28682000
              COLD'LOAD'MEDIA(TAPEREADY,,,TRUE);               <<01092>>28684000
              IF > THEN          << SERIAL DISC NOT READY >>   <<03715>>28686000
                 GOTO NEXTSET;   <<    OR BAD FORMAT      >>   <<03715>>28688000
              IF < THEN GO TO ERR'1'EXIT;                      <<01092>>28690000
              COLD'LOAD'MEDIA(FWDSPFILE,,,TRUE);               <<01092>>28692000
              IF < THEN GO TO ERR'1'EXIT;                      <<01092>>28694000
              COLD'LOAD'MEDIA(FWDSPFILE,,,TRUE);               <<01092>>28696000
              IF < THEN GO TO ERR'1'EXIT;                      <<01092>>28698000
              LEN:=COLD'LOAD'MEDIA(READ,LBUF,50,TRUE);         <<01092>>28700000
              IF < THEN GO TO ERR'EXIT;                        <<01092>>28702000
              IF LEN<>40 OR BLBUF<>LABELTEXT THEN              <<00678>>28704000
                BEGIN  <<BAD LABEL>>                           <<00678>>28706000
                  MESSAGE(M376);  <<NOT A RELOAD TAPE>>        <<01103>>28708000
                  GO NEXTSET;                                  <<00678>>28710000
                END;                                           <<00678>>28712000
              REEL:=REELNUM;<<SET REEL COUNT FROM HEADER>>     <<00678>>28714000
              <<LABEL TO BE USED IN CASE OF PARITY ERROR>>     <<00678>>28716000
              <<IN READING OF TRAILER LABEL>>                  <<00678>>28718000
              MOVE ITMP:=CHDATE,(3);<<SET CREATION DATE>>      <<00678>>28720000
              <<FOR SAME REASON>>                              <<00678>>28722000
              HEDLABP:=FALSE;<<NO HEADER LABEL PARITY ERR>>    <<00678>>28724000
              TOS := DATE;                                     <<00678>>28726000
              TOS := CHDATE;                                   <<00678>>28728000
              TOS := CHHHMM;                                   <<00678>>28730000
              ASSEMBLE(DCMP);                                  <<00678>>28732000
              IF < THEN                                        <<00678>>28734000
                BEGIN  <<WRONG ORDER>>                         <<00678>>28736000
                  MESSAGE(M378); << MUST HAVE EARILIER DATE >> <<01103>>28738000
                  <<WRONG SET-MUST BE EARLIER DATE>>           <<00678>>28740000
                  GO NEXTSET;                                  <<00678>>28742000
  NOMORESETS:     STAT.(6:2) := CCG;  <<NO MORE TAPE SETS AVAILABLE>>   28744000
                  RETURN;                                      <<00678>>28746000
                END;                                           <<00678>>28748000
              COLD'LOAD'MEDIA(FWDSPFILE,,,TRUE);               <<01092>>28750000
              IF < THEN GO TO ERR'1'EXIT;                      <<01092>>28752000
              READTAPE'(0);  <<SKIP DIRECTORY>>                <<00678>>28754000
              IF < THEN GO TO ERR'1'EXIT;                      <<01092>>28756000
              IF > THEN GO NOMORESETS;                         <<01092>>28758000
              RETURN;                                          <<00678>>28760000
            END;                                               <<00678>>28762000
          SAVX := XFIELD;  <<SAVE CONTINUATION FLAG>>          <<00678>>28764000
          NEWREEL := REELNUM+1;                                <<00678>>28766000
          REEL:=REEL+1;<<COUNT REELS AS THEY ARE READ IN>>     <<00678>>28768000
          <<CASE A PARITY ERROR OCCURS DURING READING OF>>     <<00678>>28770000
          <<THE TRAILER LABEL.  "REEL" WILL BE USED TO>>       <<00678>>28772000
          <<BE SURE THE PROPER REEL FOLLOWS THE ERROR>>        <<00678>>28774000
          MOVE ITMP := CHDATE,(3);  <<SAVE OLD DATE>>          <<00678>>28776000
  NEXTREEL:                                                    <<00678>>28778000
          COLD'LOAD'MEDIA(REWUNLOAD,,,TRUE);                   <<01092>>28780000
          IF < THEN GO TO ERR'1'EXIT;                          <<01092>>28782000
          TOS := @INBUF;                                       <<00678>>28784000
          TOS := 0;                                            <<00678>>28786000
          TOS := NEWREEL;                                      <<00678>>28788000
          MOVE BINBUF := "MOUNT REEL #",2;                     <<00678>>28790000
          TOS := ASCII(*,*);                                   <<00678>>28792000
          TOS := -TOS-12;                                      <<00678>>28794000
          PRINT(*,*,0);  <<REQUEST NEXT REEL>>                 <<00678>>28796000
          COLD'LOAD'MEDIA(TAPEREADY,,,TRUE);                   <<01092>>28798000
          IF > THEN              << SERIAL DISC NOT READY >>   <<03715>>28800000
             GOTO NEXTREEL;      <<    OR BAD FORMAT      >>   <<03715>>28802000
          IF < THEN GO TO ERR'1'EXIT;                          <<01092>>28804000
          LEN:=COLD'LOAD'MEDIA(READ,LBUF,50,TRUE);             <<01092>>28806000
          IF < THEN GO TO ERR'EXIT;                            <<01092>>28808000
          IF LEN<>40 OR BLBUF<>LABELTEXT THEN                  <<00678>>28810000
            BEGIN  <<BAD LABEL>>                               <<00678>>28812000
              MESSAGE(M376);  <<NOT A RELOAD TAPE>>            <<01103>>28814000
              GOTO NEXTREEL;                                   <<00678>>28816000
            END;                                               <<00678>>28818000
          TOS := @CHDATE&LSL(1);                               <<00678>>28820000
          IF *<>ITMPB,(3) THEN                                 <<00678>>28822000
            BEGIN  <<TAPE NOT A MEMBER OF THIS SET>>           <<00678>>28824000
              MESSAGE(M377);                                   <<01103>>28826000
              GO NEXTREEL;                                     <<00678>>28828000
            END;                                               <<00678>>28830000
          IF REELNUM<>NEWREEL THEN                             <<00678>>28832000
            BEGIN                                              <<00678>>28834000
              MESSAGE(M379);  <<WRONG REEL>>                   <<01103>>28836000
              GO NEXTREEL;                                     <<00678>>28838000
            END;                                               <<00678>>28840000
          COLD'LOAD'MEDIA(FWDSPFILE,,,TRUE);                   <<01092>>28842000
          IF < THEN GO TO ERR'1'EXIT;                          <<01092>>28844000
          IF SAVX=0 THEN GO AGN  <<FILE CONTINUED ON NEXT TAPE>>        28846000
          ELSE IF WORDC<>0 THEN GO TO ERR'1'EXIT;              <<01092>>28848000
          RETURN;                                              <<01092>>28850000
ERR'1'EXIT:                                                    <<01092>>28852000
          LEN := 1;                                            <<01092>>28854000
                                                               <<01092>>28856000
                                                               <<01092>>28858000
ERR'EXIT:                                                      <<01092>>28860000
          CC := CCL;                                           <<01092>>28862000
          RETURN;                                              <<01092>>28864000
                                                               <<01092>>28866000
      END <<READTAPE'>> ;                                      <<00678>>28868000
                                                               <<04546>>28870000
$CONTROL SEGMENT=RESIDENT                                      <<04546>>28872000
   <<-------------------------->>                              <<04546>>28874000
   << UNLOCK THE CS80 DEVICES  >>                              <<04546>>28876000
   <<-------------------------->>                              <<04546>>28878000
PROCEDURE UNLOCK'CS80;                                         <<04546>>28880000
BEGIN                                                          <<04546>>28882000
COMMENT  UNLOCK THE CS80 DEVICES BEFORE EXITING INITIAL;       <<04546>>28884000
   LDEV := 0;                                                  <<04546>>28886000
   WHILE (LDEV:=LDEV+1) <= HLDEV DO                            <<04546>>28888000
     IF NON'DS'LDEV(LDEV) THEN                                 <<04546>>28890000
       IF LDT(LDEV*LDTSIZE+LDT2).TYP = DISC3 THEN              <<04546>>28892000
         DISC(UNLOCK'DEV,LDEV,0D,DTEMP,2);                     <<04546>>28894000
END; <<UNLOCK'CS80>>                                           <<04546>>28896000
                                                               <<04546>>28898000
$PAGE "MEMORY MANAGEMENT PROCEDURES"                           <<01384>>28900000
$CONTROL SEGMENT=FILEIO                                        <<03603>>28902000
PROCEDURE SSEA(DCOREADDR, VALUE');                             <<01384>>28904000
  VALUE DCOREADDR, VALUE';                                     <<01384>>28906000
  DOUBLE  DCOREADDR;                                           <<01384>>28908000
  INTEGER VALUE';                                              <<01384>>28910000
  BEGIN                                                        <<01384>>28912000
  TOS := DCOREADDR;                                            <<01384>>28914000
  TOS := VALUE';                                               <<01384>>28916000
  ASSEMBLE( SSEA );                                            <<02510>>28918000
  END;  << SSEA >>                                             <<01384>>28920000
LOGICAL PROCEDURE LSEA(DCOREADDR);                             <<01384>>28922000
  VALUE DCOREADDR;                                             <<01384>>28924000
  DOUBLE DCOREADDR;                                            <<01384>>28926000
  BEGIN                                                        <<01384>>28928000
  TOS := DCOREADDR;                                            <<01384>>28930000
  ASSEMBLE(LSEA);                                              <<01384>>28932000
  LSEA := TOS;                                                 <<01384>>28934000
  END;  << LSEA >>                                             <<01384>>28938000
INTEGER PROCEDURE ROUND(NUMBER);                               <<01384>>28940000
  VALUE NUMBER;                                                <<01384>>28942000
  LOGICAL NUMBER;                                              <<01384>>28944000
  COMMENT:  THIS PROCEDURE ROUNDS UP THE NUMBER(POSITIVE)      <<01384>>28946000
  PASSED TO IT TO MAKE IT DIVISIBLE BY 4;                      <<01384>>28948000
  BEGIN                                                        <<01384>>28950000
  ROUND := (NUMBER+3)&LSR(2)&LSL(2);                           <<01384>>28952000
  END;  << ROUND >>                                            <<01384>>28954000
DOUBLE PROCEDURE MAM(LENGTH, TEMPORARY);                       <<MPEIV>>28956000
VALUE LENGTH, TEMPORARY;                                       <<MPEIV>>28958000
LOGICAL LENGTH,     << LENGTH OF MEMORY REQUESTED >>           <<MPEIV>>28960000
        TEMPORARY;  << TEMPORARY ALLOCATION, DON'T RESERVE >>  <<MPEIV>>28962000
OPTION VARIABLE;                                               <<MPEIV>>28964000
                                                               <<MPEIV>>28966000
COMMENT:  EACH CELL OF THE ARRAY ADDRESS POINTS TO THE FIRST   <<MPEIV>>28968000
AVAILABLE WORD IN ITS ASSOCIATED BANK.  THUS, THE MEMORY       <<MPEIV>>28970000
ADDRESSES THAT ARE LESS THAN ADDRESS(BANK#) ARE IN USE  AND    <<MPEIV>>28972000
THE HIGHER ONES ARE FREE.  NOTE THAT ADDRESS(BANK#) IS THE     <<MPEIV>>28974000
AMOUNT OF THE BANK IN USE WHILE -ADDRESS(BANK#) IS THE         <<MPEIV>>28976000
AMOUNT OF FREE SPACE IN THAT BANK.                             <<MPEIV>>28978000
;                                                              <<MPEIV>>28980000
                                                               <<MPEIV>>28982000
BEGIN                                                          <<MPEIV>>28984000
DOUBLE  CUR'DL,                                                <<MPEIV>>28986000
        DCOREADDR;                                             <<MPEIV>>28988000
                                                               <<MPEIV>>28990000
LOGICAL DONE,                                                  <<MPEIV>>28992000
        I,                                                     <<MPEIV>>28994000
        CUR'DL1  = CUR'DL,                                     <<MPEIV>>28996000
        CUR'DL2  = CUR'DL+1,                                   <<MPEIV>>28998000
        BANK     = DCOREADDR,                                  <<MPEIV>>29000000
        COREADDR = DCOREADDR+1,                                <<MPEIV>>29002000
        VAR  = Q-4;                                            <<MPEIV>>29004000
                                                               <<MPEIV>>29006000
IF NOT VAR THEN TEMPORARY := TRUE;                             <<MPEIV>>29008000
                                                               <<MPEIV>>29010000
I := 0;                                                        <<MPEIV>>29012000
DONE := FALSE;                                                 <<MPEIV>>29014000
DO                                                             <<MPEIV>>29016000
  BEGIN                                                        <<MPEIV>>29018000
  BANK := I;                                                   <<MPEIV>>29020000
  IF LENGTH <= -(ADDRESS(BANK)+3) THEN                         <<MPEIV>>29022000
    BEGIN                   << ^ INSURE 3 WDS FOR TRAILER >>   <<MPEIV>>29024000
    COREADDR := ADDRESS(BANK);                                 <<MPEIV>>29026000
    << COMPUTE ABSOLUTE DL ADDRESS >>                          <<MPEIV>>29028000
    PUSH(DL,DB);                                               <<MPEIV>>29030000
    ASSEMBLE(CAB, ADD);  << ABSOLUTE DL ADDRESS >>             <<MPEIV>>29032000
    CUR'DL := TOS;                                             <<MPEIV>>29034000
    IF CUR'DL <= DCOREADDR+DOUBLE(LENGTH) THEN                 <<MPEIV>>29036000
      ERRMESSAGE(M350);  << OUT OF MEMORY >>                   <<MPEIV>>29038000
    IF BANK=0 AND COREADDR+LENGTH < HCLIMIT OR                 <<03603>>29040000
      BANK <> 0 THEN                                           <<MPEIV>>29042000
      BEGIN                                                    <<MPEIV>>29044000
      DONE := TRUE;                                            <<MPEIV>>29046000
      IF NOT TEMPORARY THEN                                    <<MPEIV>>29048000
        ADDRESS(BANK) := ADDRESS(BANK) + LENGTH;               <<MPEIV>>29050000
      END;                                                     <<MPEIV>>29052000
    END;                                                       <<MPEIV>>29054000
  END                                                          <<MPEIV>>29056000
UNTIL (I:=I+1) = NUM'BANKS OR DONE;                            <<04777>>29058000
                                                               <<MPEIV>>29060000
IF NOT DONE THEN ERRMESSAGE(M350);  << OUT OF MEMORY >>        <<MPEIV>>29062000
                                                               <<MPEIV>>29064000
MAM := DCOREADDR;                                              <<MPEIV>>29066000
                                                               <<MPEIV>>29068000
<< ZERO MEMORY SPACE >>                                        <<MPEIV>>29070000
TOS := DCOREADDR;  << STARTING ADDRESS >>                      <<MPEIV>>29072000
TOS := 0;                                                      <<MPEIV>>29074000
ASSEMBLE(SSEA; INCA,DDUP; DECA);                               <<MPEIV>>29076000
TOS := LENGTH-1;                                               <<MPEIV>>29078000
ASSEMBLE(MABS 5);                                              <<MPEIV>>29080000
                                                               <<MPEIV>>29082000
END;  << MAM >>                                                <<MPEIV>>29084000
PROCEDURE STARTMAM;                                            <<MPEIV>>29086000
                                                               <<MPEIV>>29088000
COMMENT:                                                       <<MPEIV>>29090000
;                                                              <<MPEIV>>29092000
BEGIN                                                          <<MPEIV>>29094000
BANK0 := MEMLOC;  << SAVE FOR BANK 0 MESSAGE >>                <<MPEIV>>29096000
ADDRESS(0) := MEMLOC;                                          <<MPEIV>>29098000
ADDRESS(NUM'BANKS):= -1;                                       <<04777>>29100000
MEMLOC := %177777;                                             <<MPEIV>>29102000
END;  << STARTMAM >>                                           <<MPEIV>>29104000
PROCEDURE DLSIZE(WORDS);                                       <<MPEIV>>29106000
  VALUE WORDS;                                                 <<MPEIV>>29108000
  INTEGER WORDS;                                               <<MPEIV>>29110000
                                                               <<MPEIV>>29112000
  COMMENT:  THIS PROCEDURE EXPANDS AND CONTRACTS               <<MPEIV>>29114000
  INITIALS' DL AREA BY THE AMOUNT WORDS.  IF WORDS             <<MPEIV>>29116000
  IS A POSITIVE VALUE THE DL IS EXPANDED: A NEGATIVE           <<MPEIV>>29118000
  VALUE WILL CONTRACT THE DL AREA.                             <<MPEIV>>29120000
  ;                                                            <<MPEIV>>29122000
                                                               <<MPEIV>>29124000
  BEGIN                                                        <<MPEIV>>29126000
  DOUBLE  CUR'DL,      << CURRENT ABSOLUTE DL ADDRESS >>       <<MPEIV>>29128000
          NEW'DL;      <<   NEW      "     "      "   >>       <<MPEIV>>29130000
                                                               <<MPEIV>>29132000
  LOGICAL NEW'DL1      = NEW'DL,                               <<MPEIV>>29134000
          NEW'DL2      = NEW'DL+1;                             <<MPEIV>>29136000
                                                               <<MPEIV>>29138000
  LOGICAL L'WORDS      = WORDS;                                <<MPEIV>>29140000
                                                               <<MPEIV>>29142000
<< COMPUTE ABSOLUTE DL ADDRESS >>                              <<MPEIV>>29144000
  PUSH(DL,DB);                                                 <<MPEIV>>29146000
  ASSEMBLE(CAB, ADD);  << ABSOLUTE DL ADDRESS >>               <<MPEIV>>29148000
  CUR'DL := TOS;                                               <<MPEIV>>29150000
                                                               <<MPEIV>>29152000
  IF WORDS > 0 THEN                                            <<MPEIV>>29154000
    BEGIN  << EXPAND DL AREA >>                                <<MPEIV>>29156000
    NEW'DL := CUR'DL - DOUBLE(L'WORDS);                        <<MPEIV>>29158000
    PUSH (Z,DL);                                               <<04261>>29160000
    ASSEMBLE (SUB);  <<TOS HOLDS CURRENT SIZE OF STACK>>       <<04261>>29162000
    IF (TOS+L'WORDS > MAXSTACKSIZE) OR  <<EXCEED STK SIZE LMT>><<04261>>29164000
       (NEW'DL2 <= ADDRESS(NEW'DL1)) <<DL OVRLAPS IN USE MEM>> <<04261>>29166000
       THEN ERRMESSAGE(M350);  <<OUT OF MEMORY>>               <<04261>>29168000
                                                               <<04261>>29170000
  << CLEAR NEW DL AREA JUST TO BE NICE >>                      <<MPEIV>>29172000
    TOS := NEW'DL;                                             <<MPEIV>>29174000
    TOS := 0;                                                  <<MPEIV>>29176000
    ASSEMBLE(SSEA; INCA,DDUP; DECA);                           <<MPEIV>>29178000
    TOS := L'WORDS-1;                                          <<MPEIV>>29180000
    ASSEMBLE(MABS 5);                                          <<MPEIV>>29182000
    END  << EXPAND DL AREA >>                                  <<MPEIV>>29184000
                                                               <<MPEIV>>29186000
  ELSE  << * * * * * * * * * * * * * * * * * * * >>            <<MPEIV>>29188000
                                                               <<MPEIV>>29190000
    BEGIN  << CONTRACT DL AREA >>                              <<MPEIV>>29192000
    WORDS := (-WORDS);                                         <<MPEIV>>29194000
    NEW'DL := CUR'DL + DOUBLE(L'WORDS);                        <<MPEIV>>29196000
    END;  << CONTRACT DL AREA >>                               <<MPEIV>>29198000
                                                               <<MPEIV>>29200000
<< SET NEW DL VALUE >>                                         <<MPEIV>>29202000
  TOS := NEW'DL;                                               <<MPEIV>>29204000
  PUSH (DB);                                                   <<MPEIV>>29206000
  ASSEMBLE(DSUB, DELB);  << DB RELATIVE DL VALUE >>            <<MPEIV>>29208000
  SET(DL);                                                     <<MPEIV>>29210000
                                                               <<MPEIV>>29212000
  END;  << DLSIZE >>                                           <<MPEIV>>29214000
$CONTROL SEGMENT=MAINSEG4                                      <<03553>>29216000
PROCEDURE PUTONARL(ADDRESS,SIZE);                              <<MPEIV>>29218000
VALUE ADDRESS,SIZE;                                            <<MPEIV>>29220000
DOUBLE ADDRESS;                                                <<MPEIV>>29222000
INTEGER SIZE;  << AVAILABLE REGION SIZE IN PAGES >>            <<MPEIV>>29224000
OPTION PRIVILEGED,UNCALLABLE,INTERNAL;                         <<MPEIV>>29226000
                                                               <<MPEIV>>29228000
COMMENT                                                        <<MPEIV>>29230000
PLACES THE REGION WHOSE BASE ADDRESS IS GIVEN BY THE ADDRESS   <<MPEIV>>29232000
PARAMETER AT THE HEAD OF THE LIST OF AVAILABLE REGIONS OF SIZE <<MPEIV>>29234000
PAGES.                                                         <<MPEIV>>29236000
                                                               <<03553>>29238000
WARNING!  THIS PROCEDURE MUST STAY IN THE SAME SEGMENT AS      <<03553>>29240000
INITMEMORYLISTS.                                               <<03553>>29242000
;                                                              <<MPEIV>>29244000
                                                               <<MPEIV>>29246000
BEGIN                                                          <<MPEIV>>29248000
TOS:=ADDRESS;                                                  <<MPEIV>>29250000
TOS:=TOS+RBTOPLDISP;                                           <<MPEIV>>29252000
TOS:=0D;                                                       <<MPEIV>>29254000
ASSEMBLE(SDEA); <<ZERO PREV LINK>>                             <<MPEIV>>29256000
TOS:=TOS+PLTONLDISP;                                           <<MPEIV>>29258000
TOS:=ARLD(SIZE);  <<CURRENT HEAD OF LIST>>                     <<MPEIV>>29260000
IF = THEN                                                      <<MPEIV>>29262000
   BEGIN  <<LIST WAS EMPTY>>                                   <<MPEIV>>29264000
   ASSEMBLE(SDEA);  <<ZERO OUT NEXT LINK>>                     <<MPEIV>>29266000
   TOS:=TOS+NLTORBDISP;                                        <<MPEIV>>29268000
   ARLD(X):=TOS;  <<THIS REGION'S ADDRESS TO HEAD OF LIST>>    <<MPEIV>>29270000
   TOS:=X;                                                     <<MPEIV>>29272000
   TOS:=ARSBM(X:=S0&LSR(4)); <<WORD IN BITMAP>>                <<MPEIV>>29274000
   ASSEMBLE(XBX;TSBC 0,X;XBX);  <<MASK BIT IN WORD>>           <<MPEIV>>29276000
   ARSBM(X):=TOS;  <<UPDATE BITMAP OF AVAILABLE REG SIZES>>    <<MPEIV>>29278000
   IF S0 > MAXAVAILREG THEN MAXAVAILREG:=TOS;<<UPDATE MAX REG>><<MPEIV>>29280000
   END                                                         <<MPEIV>>29282000
ELSE                                                           <<MPEIV>>29284000
   BEGIN  <<LIST IS NON-EMPTY>>                                <<MPEIV>>29286000
   TOS:=TOS+RBTOPLDISP;  <<PREVIOUS LINK OF CURRENT HEAD>>     <<MPEIV>>29288000
   TOS:=ADDRESS;                                               <<MPEIV>>29290000
   ASSEMBLE(DDUP);                                             <<MPEIV>>29292000
   ARLD(X):=TOS;  <<LINK NEW REGION TO HEAD>>                  <<MPEIV>>29294000
   ASSEMBLE(SDEA); <<FIX UP PREVIOUS LINK OF OLD HEAD>>        <<MPEIV>>29296000
   TOS:=TOS+PLTORBDISP;                                        <<MPEIV>>29298000
   ASSEMBLE(SDEA); <<OLD HEAD'S BASE TO NEW'S NEXT LINK>>      <<MPEIV>>29300000
   END;                                                        <<MPEIV>>29302000
END;  <<PUTONARL>>                                             <<MPEIV>>29304000
                                                               <<MPEIV>>29306000
                                                               <<MPEIV>>29308000
$CONTROL SEGMENT=MAINSEG4                                      <<03553>>29310000
PROCEDURE INITHEADERS(REGIONBASE,REGIONSIZE);                  <<MPEIV>>29312000
VALUE REGIONBASE,REGIONSIZE;                                   <<MPEIV>>29314000
DOUBLE REGIONBASE;                                             <<MPEIV>>29316000
INTEGER REGIONSIZE;                                            <<MPEIV>>29318000
                                                               <<MPEIV>>29320000
                                                               <<MPEIV>>29322000
COMMENT                                                        <<MPEIV>>29324000
THIS PROCEDURE FIXES UP THE REGION HEADERS AND TRAILERS        <<MPEIV>>29326000
FOR THE AVAILABLE SPACE AT GENERATION TIME                     <<MPEIV>>29328000
                                                               <<03553>>29330000
WARNING!  THIS PROCEDURE MUST STAY IN THE SAME SEGMENT AS      <<03553>>29332000
INITMEMORYLISTS.                                               <<03553>>29334000
;                                                              <<MPEIV>>29336000
BEGIN                                                          <<MPEIV>>29338000
<<ZERO OUT THE HEADER>>                                        <<MPEIV>>29340000
TOS:=REGIONBASE;                                               <<MPEIV>>29342000
TOS:=TOS-HEADERLENGTH;                                         <<MPEIV>>29344000
ASSEMBLE(ZERO;SSEA;INCA,DDUP;DECA);                            <<MPEIV>>29346000
TOS:=HEADERLENGTH-1;                                           <<MPEIV>>29348000
ASSEMBLE(MABS);                                                <<MPEIV>>29350000
TOS:=0;                                                        <<MPEIV>>29352000
TOS.REGAVAILABLEFLAG:=1;                                       <<MPEIV>>29354000
TOS.REGCLEAREDFLAG:=1;                                         <<MPEIV>>29356000
TOS:=REGIONSIZE;                                               <<MPEIV>>29358000
ASSEMBLE(DDUP,DDUP);                                           <<MPEIV>>29360000
TOS:=REGIONBASE;                                               <<MPEIV>>29362000
TOS:=TOS+RBTORASDISP;                                          <<MPEIV>>29364000
ASSEMBLE(DXCH;SDEA);                                           <<MPEIV>>29366000
TOS:=TOS+RASTOSSDISP;TOS:=REGIONSIZE;ASSEMBLE(SSEA);           <<MPEIV>>29368000
TOS:=0;                                                        <<MPEIV>>29370000
TOS:=REGIONSIZE;                                               <<MPEIV>>29372000
ASSEMBLE(DLSL PAGEPOWER);                                      <<MPEIV>>29374000
TOS:=0;                                                        <<MPEIV>>29376000
TOS:=SSTOPTRASDISP;                                            <<MPEIV>>29378000
ASSEMBLE(DADD,DELB;ADD);                                       <<MPEIV>>29380000
ASSEMBLE(DXCH;SDEA);                                           <<MPEIV>>29382000
TOS:=TOS+TRASTOTSSDISP;                                        <<MPEIV>>29384000
TOS:=REGIONSIZE;                                               <<MPEIV>>29386000
ASSEMBLE(SSEA);                                                <<MPEIV>>29388000
END  <<INITHEADERS>>;                                          <<MPEIV>>29390000
<<>>                                                           <<MPEIV>>29392000
<<INITIALIZE MEMORY LISTS>>                                    <<MPEIV>>29394000
<<>>                                                           <<MPEIV>>29396000
                                                               <<MPEIV>>29398000
$CONTROL SEGMENT=MAINSEG4                                      <<03553>>29400000
PROCEDURE INITMEMORYLISTS(OLDDB);                              <<MPEIV>>29402000
VALUE OLDDB;                                                   <<MPEIV>>29404000
DOUBLE OLDDB;  << VAALUE OF INITIALS' DB >>                    <<MPEIV>>29406000
                                                               <<MPEIV>>29408000
COMMENT                                                        <<MPEIV>>29410000
THIS PROCEDURE LINKS THE AVAILABLE SPACE IN EACH BANK          <<MPEIV>>29412000
INTO THE AVAILABLE REGION LISTS AND SET THE ASSIGNED AND       <<MPEIV>>29414000
AVAILABLE REGION HEADERS.                                      <<MPEIV>>29416000
                                                               <<03553>>29418000
WARNING!  THIS PROCEDURE MUST NOT DO ANY EXTERNAL PCAL'S,      <<03553>>29420000
BECAUSE IT CAN WIPE OUT INITIAL'S CST TABLE.  FOR THIS REASON  <<03553>>29422000
IT MUST ALSO OCCUPY THE SAME SEGMENT AS THE PROCEDURE WHICH    <<03553>>29424000
CALLS IT.                                                      <<03553>>29426000
;                                                              <<MPEIV>>29428000
BEGIN                                                          <<MPEIV>>29430000
DOUBLE  DCOREADDR;                                             <<MPEIV>>29432000
                                                               <<MPEIV>>29434000
LOGICAL RSIZE,         << AVAILABLE REGION SIZE >>             <<MPEIV>>29436000
        USEDRSIZE,     << ASSIGNED REGION SIZE >>              <<MPEIV>>29438000
        TEMP,          << USED FOR BUILDING WORDS >>           <<MPEIV>>29440000
        LASTFULLBANK,  << # OF LAST BANK OF 64K >>             <<MPEIV>>29442000
        BANK           = DCOREADDR,                            <<MPEIV>>29444000
        COREADDR       = DCOREADDR+1;                          <<MPEIV>>29446000
                                                               <<03553>>29448000
SUBROUTINE SSEA(DCOREADDR, VALUE');                            <<03553>>29450000
VALUE DCOREADDR, VALUE';                                       <<03553>>29452000
DOUBLE                                                         <<03553>>29454000
   DCOREADDR;   << ABSOLUTE CORE ADDRESS--BANK AND OFFSET >>   <<03553>>29456000
INTEGER                                                        <<03553>>29458000
   VALUE';                                                     <<03553>>29460000
COMMENT                                                        <<03553>>29462000
STORES A GIVEN INTEGER INTO A GIVEN EXTENDED CORE ADDRESS.     <<03553>>29464000
THIS IS A SUBROUTINE IN ORDER TO AVOID A PCAL.                 <<03553>>29466000
;                                                              <<03553>>29468000
BEGIN                                                          <<03553>>29470000
TOS := DCOREADDR;       << STACK DOUBLE-WORD ADDRESS >>        <<03553>>29472000
TOS := S3;              << STACK VALUE'--CANNOT USE IT BY >>   <<03553>>29474000
                        <<    NAME BECAUSE THERE ARE      >>   <<03553>>29476000
                        <<    THINGS ON THE STACK.        >>   <<03553>>29478000
ASSEMBLE( SSEA;DDEL);                                          <<03553>>29480000
END;   << SSEA >>                                              <<03553>>29482000
                                                               <<MPEIV>>29484000
                                                               <<MPEIV>>29486000
MEMORYPAGESIZE:=MMPAGESIZE;                                    <<MPEIV>>29488000
FIRSTMEMBASE := 0;                                             <<MPEIV>>29490000
IF LASTBASE = -1 THEN LASTFULLBANK := LASTBANK                 <<MPEIV>>29492000
ELSE LASTFULLBANK := LASTBANK-1;                               <<MPEIV>>29494000
                                                               <<MPEIV>>29496000
DCOREADDR := 0D;                                               <<MPEIV>>29498000
DO                                                             <<MPEIV>>29500000
   BEGIN                                                       <<MPEIV>>29502000
 << CAREFUL HERE - WE WILL LEAVE THE DOUBLE WORD DB ADDRESS  >><<MPEIV>>29504000
 << ON THE STACK.                                            >><<MPEIV>>29506000
   TOS := OLDDB;                                               <<MPEIV>>29508000
   ASSEMBLE(XCHD);  << RESET DB TO INITIALS' STK >>            <<MPEIV>>29510000
   IF BANK <> 0 AND ADDRESS(BANK) = HEADERLENGTH THEN          <<MPEIV>>29512000
     << EMPTY BANK - FREE REGION STARTS AT ADDR 0 >>           <<MPEIV>>29514000
     COREADDR := 0                                             <<MPEIV>>29516000
   ELSE                                                        <<MPEIV>>29518000
     IF BANK <> 0 THEN  << BANK NOT EMPTY >>                   <<MPEIV>>29520000
       BEGIN  << FILL ASSIGNED REGION HEADER >>                <<MPEIV>>29522000
       COREADDR := 0;  <<START ADDR OF ASSIGNED REGION HEADER>><<MPEIV>>29524000
     << ZERO ASSIGNED REGION HEADER >>                         <<MPEIV>>29526000
       TOS := DCOREADDR;                                       <<MPEIV>>29528000
       TOS := 0;                                               <<MPEIV>>29530000
       ASSEMBLE(SSEA; INCA,DDUP; DECA);                        <<MPEIV>>29532000
       TOS := HEADERLENGTH-1;                                  <<MPEIV>>29534000
       ASSEMBLE(MABS 5);                                       <<MPEIV>>29536000
                                                               <<MPEIV>>29538000
       TEMP := 0;                                              <<MPEIV>>29540000
       TEMP.REGASSIGNEDFLAG := 1;  << ASSIGNED REGION >>       <<MPEIV>>29542000
       TEMP.REGFZFLAG := 1;  << FROZEN REGION >>               <<MPEIV>>29544000
       SSEA(DCOREADDR+0D, TEMP);   << ASSIGNED/FROZEN >>       <<MPEIV>>29546000
       USEDRSIZE := (ADDRESS(BANK) + 3 + MMPAGESIZE            <<03553>>29548000
                     - 1)&LSR(PAGEPOWER);                      <<03553>>29550000
         << PAGES IN USE PLUS 3 WORDS FOR TRAILLER >>          <<MPEIV>>29552000
       SSEA(DCOREADDR+1D, USEDRSIZE);  << REGION SIZE ROUNDED>><<MPEIV>>29554000
       SSEA(DCOREADDR+9D, USEDRSIZE);  << SUB REGION SIZE >>   <<MPEIV>>29556000
       COREADDR := USEDRSIZE&LSL(PAGEPOWER);  << ROUNDED >>    <<MPEIV>>29558000
       END                                                     <<MPEIV>>29560000
     ELSE                                                      <<MPEIV>>29562000
       BEGIN                                                   <<MPEIV>>29564000
       << BANK 0 - NO REGION HEADER IN LOW CORE JUST GET >>    <<MPEIV>>29566000
       << ADDRESS OF FREE REGION >>                            <<MPEIV>>29568000
       USEDRSIZE := (ADDRESS(BANK) + 3 + MMPAGESIZE            <<03553>>29570000
                     - 1)&LSR(PAGEPOWER);                      <<03553>>29572000
         << PAGES IN USE PLUS 3 WDS FOR TRAILER >>             <<MPEIV>>29574000
       COREADDR := USEDRSIZE&LSL(PAGEPOWER);  << ROUNDED >>    <<MPEIV>>29576000
       END;                                                    <<MPEIV>>29578000
   ASSEMBLE(XCHD; DDEL);  << DB BACK TO SYSGLOB >>             <<MPEIV>>29580000
                                                               <<MPEIV>>29582000
   << ROUND UP AVAILABLE REGION ADDR TO A PAGE BOUNDARY>>      <<MPEIV>>29584000
   IF COREADDR = 0 THEN RSIZE := MAXHOLESIZE                   <<MPEIV>>29586000
   ELSE RSIZE := -COREADDR/MMPAGESIZE;                         <<MPEIV>>29588000
                         <<  ^ SAVE 3 WORDS FOR TRAILER >>     <<MPEIV>>29590000
                                                               <<MPEIV>>29592000
   <<IF AT LEAST A PAGE LONG, LINK IT INTO THE ARL>>           <<MPEIV>>29594000
   IF RSIZE <> 0 THEN                                          <<MPEIV>>29596000
     BEGIN                                                     <<MPEIV>>29598000
     IF COREADDR <> 0 THEN                                     <<MPEIV>>29600000
       BEGIN  << SOME USED, SOME UNUSED MEMORY - SET TRAILER >><<MPEIV>>29602000
       TEMP := 0;                                              <<MPEIV>>29604000
       TEMP.REGASSIGNEDFLAG := 1;  << ASSIGNED REGION >>       <<MPEIV>>29606000
       TEMP.REGFZFLAG := 1;  << FROZEN REGION >>               <<MPEIV>>29608000
       SSEA(DCOREADDR-1D, USEDRSIZE);  << REGION SIZE >>       <<MPEIV>>29610000
       SSEA(DCOREADDR-2D, TEMP);  << ASSIGNED/FROZEN >>        <<MPEIV>>29612000
       SSEA(DCOREADDR-3D, USEDRSIZE);  << SUBSIZE >>           <<MPEIV>>29614000
       END;                                                    <<MPEIV>>29616000
     COREADDR := COREADDR + HEADERLENGTH;                      <<MPEIV>>29618000
     << POINT TO 1ST WORD OF AVAILABLE REGION >>               <<MPEIV>>29620000
     IF FIRSTMEMBASE = 0 THEN                                  <<MPEIV>>29622000
       BEGIN  << SAVE 1ST FREE REGION ADDRESS IN SYSGLOB >>    <<MPEIV>>29624000
       FIRSTMEMBANK := BANK;                                   <<MPEIV>>29626000
       FIRSTMEMBASE := COREADDR;                               <<MPEIV>>29628000
       END;                                                    <<MPEIV>>29630000
     INITHEADERS(DCOREADDR, RSIZE);                            <<MPEIV>>29632000
     PUTONARL(DCOREADDR, RSIZE);                               <<MPEIV>>29634000
     END;                                                      <<MPEIV>>29636000
   END                                                         <<MPEIV>>29638000
UNTIL (BANK := BANK+1) > LASTFULLBANK;                         <<MPEIV>>29640000
                                                               <<MPEIV>>29642000
<<>>                                                           <<MPEIV>>29644000
<< LINK IN THE LAST PARTIAL BANK >>                            <<MPEIV>>29646000
<<>>                                                           <<MPEIV>>29648000
                                                               <<MPEIV>>29650000
IF LASTFULLBANK <> LOGICAL(LASTBANK) THEN                      <<MPEIV>>29652000
   BEGIN                                                       <<MPEIV>>29654000
   RSIZE := (LASTBASE+1)&LSR(PAGEPOWER);                       <<MPEIV>>29656000
   BANK := LASTBANK;                                           <<MPEIV>>29658000
   COREADDR := HEADERLENGTH;                                   <<MPEIV>>29660000
   INITHEADERS(DCOREADDR, RSIZE);                              <<MPEIV>>29662000
   PUTONARL(DCOREADDR, RSIZE);                                 <<MPEIV>>29664000
   END;                                                        <<MPEIV>>29666000
END;  <<INITMEMORYLISTS>>                                      <<MPEIV>>29668000
$CONTROL SEGMENT=FILEIO                                                 29670000
          <<-----------------------------------------                   29672000
            CHECK FOR SYSTEM-INITIAL MEMORY OVERLAP                     29674000
          ----------------------------------------->>                   29676000
  PROCEDURE CHECKMEM;                                                   29678000
    COMMENT                                                             29680000
      CHECKS THAT THE SYSTEM BEING BUILT IN LOW CORE DOES NOT OVERLAP   29682000
    WITH INITIAL'S STACK OR THE CST AND SIO PROGRAM BUFFER WHICH MAY    29684000
    BE AT THE UPPER END OF BANK 0;                                      29686000
      BEGIN                                                             29688000
          IF MEMLOC = %177777 THEN ERRMESSAGE(M374,5);         <<01384>>29690000
          PUSH(DL,DB);                                                  29692000
          ASSEMBLE(XCH);  <<DBBANK ON TOS>>                             29694000
          IF TOS<>0 THEN                                                29696000
            BEGIN  <<INITIAL'S STACK NOT IN BANK 0>>                    29698000
              DDEL;                                                     29700000
              TOS := HCLIMIT;                                  <<03603>>29702000
            END                                                         29704000
          ELSE ASSEMBLE(ADD);  <<ABSOLUTE DL VALUE>>                    29706000
          IF TOS  < LOGICAL(MEMLOC) THEN ERRMESSAGE(M351);     <<01103>>29708000
                 <<OUT OF CORE RESIDENT MEMORY>>                        29710000
      END <<CHECKMEM>> ;                                                29712000
          <<-----------------------------------                         29714000
            GET SPACE FOR AND INITIALIZE TABLE                          29716000
          ------------------------------------>>                        29718000
  INTEGER PROCEDURE INITTABLE(ENTRYNUM,ENTRYSIZE,LOWCORE);              29720000
    VALUE ENTRYNUM,ENTRYSIZE,LOWCORE;                                   29722000
    INTEGER ENTRYNUM,ENTRYSIZE;                                         29724000
    LOGICAL LOWCORE;                                                    29726000
    COMMENT                                                             29728000
      GET SPACE IN MEMORY FOR A TABLE, INITIALIZES IT TO ZEROES AND     29730000
    RETURNS THE ADDRESS OF THE TABLE;                                   29732000
      BEGIN                                                             29734000
          LOGICAL LCLIMIT; << STARFISH USES LAST THREE DRT'S >><<02510>>29736000
                                                               <<02510>>29738000
          IF MEMLOC = %177777 THEN ERRMESSAGE(M374,5);         <<01384>>29740000
          LCLIMIT := IF STARFISH THEN %764 ELSE SYSBASE;       <<02510>>29742000
          TOS := 0;  <<FIRST WORD OF 2 WORD ABSOLUTE ADDRESS>>          29744000
          MEMSEG := ((ENTRYNUM*ENTRYSIZE+3)&LSR(2))&LSL(2);             29746000
          IF LOWCORE AND LOGICAL(LCMEMLOC+MEMSEG)<=LCLIMIT THEN<<02510>>29748000
            BEGIN   <<WILL FIT IN LOW CORE AREA>>                       29750000
              TOS := LCMEMLOC;                                          29752000
              LCMEMLOC := S0+MEMSEG;                                    29754000
            END                                                         29756000
          ELSE                                                          29758000
            BEGIN  <<MUST GET IT FROM OTHER AREA>>                      29760000
              TOS := MEMLOC;                                            29762000
                TOS := S0+MEMSEG;                                       29764000
                IF > AND MEMLOC<0 THEN                                  29766000
                  ERRMESSAGE(M351);<<WRAP AROUND IN BANK 0>>   <<01103>>29768000
                MEMLOC := TOS;                                          29770000
              CHECKMEM;                                                 29772000
            END;                                                        29774000
          INITTABLE := S0;                                              29776000
          TOS := 0;                                                     29778000
          ASSEMBLE(SSEA; INCA,DDUP; DECA);                              29780000
          TOS := MEMSEG-1;                                              29782000
          ASSEMBLE(MABS);  <<ZERO TABLE>>                               29784000
      END <<INITTABLE>> ;                                               29786000
          <<---------------------                                       29788000
            INITIALIZE FREE LIST                                        29790000
          ---------------------->>                                      29792000
  PROCEDURE INITFREELIST(COREADR,ENTRYNUM,ENTRYSIZE,FIRSTENTRY);        29794000
    VALUE COREADR,ENTRYNUM,ENTRYSIZE,FIRSTENTRY;                        29796000
    INTEGER COREADR,ENTRYNUM,ENTRYSIZE,FIRSTENTRY;                      29798000
    COMMENT                                                             29800000
      INITIALIZE FREE LIST FOR TABLE BEGINNING AT ENTRY FIRSTENTRY;     29802000
      BEGIN                                                             29804000
        INTEGER ARRAY TABLE(*)=DB+0;                                    29806000
        INTEGER PREVENTRYINX:=0;                               <<MPEIV>>29808000
          TOS := 0;                                                     29810000
          TOS := COREADR;                                               29812000
          ASSEMBLE(XCHD);  <<SET DB TO TABLE>>                          29814000
          TABLE := ENTRYNUM-1;                                          29816000
          TABLE(1) := ENTRYSIZE;                                        29818000
          TABLE(2) := ENTRYNUM-FIRSTENTRY;  <<# OF UNALLOCATED ENTRIES>>29820000
          TABLE(3) := FIRSTENTRY*ENTRYSIZE; <<PTR TO FIRST AVAILABLE>>  29822000
        IF ENTRYSIZE >= 5 THEN                                 <<MPEIV>>29824000
          TABLE(4) := (ENTRYNUM-1)*ENTRYSIZE;                  <<MPEIV>>29826000
          DO                                                            29828000
            BEGIN  <<INITIALIZE FREE LIST>>                             29830000
              TABLE(FIRSTENTRY*ENTRYSIZE) := %100000;                   29832000
              TOS := X+ENTRYSIZE;                                       29834000
              TABLE(X:=X+1) := TOS; <<PTR TO NEXT ENTRY>>               29836000
              IF ENTRYSIZE >= 5 THEN                           <<MPEIV>>29838000
                BEGIN                                          <<MPEIV>>29840000
                TABLE(X:=X+1):=PREVENTRYINX;                   <<MPEIV>>29842000
                X:=X-1;                                        <<MPEIV>>29844000
                END;                                           <<MPEIV>>29846000
              PREVENTRYINX := FIRSTENTRY*ENTRYSIZE;            <<MPEIV>>29848000
            END                                                         29850000
          UNTIL (FIRSTENTRY:=FIRSTENTRY+1)=ENTRYNUM;                    29852000
          TABLE(X) := 0;   <<STOPPER>>                                  29854000
          SET(DB);                                                      29856000
      END <<INITFREELIST>> ;                                            29858000
                                                                        29860000
          <<-------------------------------                             29862000
            GET NEXT ENTRY FROM FREE LIST                               29864000
          ------------------------------->>                             29866000
  INTEGER PROCEDURE GETENTRY(TABIX);                                    29868000
    VALUE TABIX;                                                        29870000
    INTEGER TABIX;   <<ABSOLUTE ADDRESS OF TABLE POINTER>>              29872000
    COMMENT                                                             29874000
      RETRIEVES THE NEXT FREE ENTRY FROM THE SPECIFIED TABLE AND        29876000
    RETURNS ITS NUMBER. IF NO FREE ENTRIES ARE LEFT, PRINTS AN ERROR    29878000
    MESSAGE AND HALTS;                                                  29880000
      BEGIN                                                             29882000
   INTEGER RETURNVALUE=GETENTRY;                               <<01691>>29884000
        INTEGER ARRAY MESSIX(1:7)=PB :=                        <<01103>>29886000
            M300,M301,M302,M0,M0,M0,M303;                      <<01103>>29888000
        INTEGER TABADR;   <<ABSOLUTE ADDRESS OF TABLE BASE>>            29890000
        INTEGER ENTRYSIZE,                                     <<MPEIV>>29892000
          NEWHEAD;                                             <<MPEIV>>29894000
          TOS := ABSOLUTE(TABIX)+SYSBASE;                               29896000
          X := S0;                                                      29898000
          TABADR := TOS;  <<TABLE ADDRESS (ABSOLUTE)>>                  29900000
          TOS := ABSOLUTE(X:=X+2); <<# OF UNASSIGNED ENTRIES>>          29902000
IF = THEN ERRMESSAGE(MESSIX(TABIX-SYSBASE)); <<OUT OF ENTS>>   <<01103>>29904000
          ABSOLUTE(X) := TOS-1;                                         29906000
          TOS := ABSOLUTE(X:=X+1);   <<INDEX OF FIRST FREE ENTRY>>      29908000
          GETENTRY := S0/ABSOLUTE(X:=X-2);  <<ENTRY NUMBER>>            29910000
          ENTRYSIZE:=ABSOLUTE(X);                              <<MPEIV>>29912000
          TOS := ABSOLUTE(X:=X+TOS);  <<LINK>>                          29914000
          NEWHEAD:=S0;                                         <<MPEIV>>29916000
          ABSOLUTE(X) := 0;                                             29918000
          ABSOLUTE(X:=X-1) := 0;  <<ZERO ENTRY>>                        29920000
          ABSOLUTE(TABADR+3) := TOS;  <<NEW PTR TO FIRST FREE ENTRY>>   29922000
          IF ENTRYSIZE >4 THEN ABSOLUTE(TABADR+NEWHEAD+2):=0;  <<MPEIV>>29924000
         IF TABIX=SYSPCB THEN PCB(RETURNVALUE*PCBSIZE+         <<01691>>29926000
         PQPTRWORDNUM):=0;                                     <<01691>>29928000
      END <<GETENTRY>> ;                                                29930000
                                                               <<03004>>29932000
            <<----------------------------------->>            <<03004>>29934000
            <<    RETURN ENTRY TO FREE LIST      >>            <<03004>>29936000
            <<----------------------------------->>            <<03004>>29938000
  PROCEDURE RETURNENTRY( TABIX, ENTRYNUM);                     <<03004>>29940000
  COMMENT                                                      <<03004>>29942000
     RETURNS AN ENTRY ALLOCATED BY GETENTRY TO ITS             <<03004>>29944000
     FREE LIST.  THE RETURNED ENTRY BECOMES FIRST              <<03004>>29946000
     ON THE FREE LIST;                                         <<03004>>29948000
  VALUE TABIX, ENTRYNUM;                                       <<03004>>29950000
  INTEGER TABIX,   << ABS. LOCATION CONTAINING LIST POINTER>>  <<03004>>29952000
          ENTRYNUM; << ENTRY NUMBER TO BE FREED            >>  <<03004>>29954000
     BEGIN                                                     <<03004>>29956000
     INTEGER TABADR,   << ABSOLUTE ADDRESS OF TABLE HEADER >>  <<03004>>29958000
             ENTRYSIZE, << SIZE OF EACH ENTRY >>               <<03004>>29960000
             SAVE;     << TEMP FOR POINTER TO FREE ENTRY >>    <<03004>>29962000
                                                               <<03004>>29964000
     TABADR := ABSOLUTE( TABIX) + SYSBASE;                     <<03004>>29966000
     ENTRYSIZE := ABSOLUTE( TABADR+1);                         <<03004>>29968000
                                                               <<03004>>29970000
     << IF THERE WERE NO FREE ENTRIES REMAINING, MAKE      >>  <<03004>>29972000
     << POINTER IN NEW FREE ENTRY ZERO.                    >>  <<03004>>29974000
     IF ABSOLUTE( TABADR+2) = 0 THEN                           <<03004>>29976000
        SAVE := 0                                              <<03004>>29978000
     ELSE                                                      <<03004>>29980000
        SAVE := ABSOLUTE( TABADR+3);                           <<03004>>29982000
                                                               <<03004>>29984000
     << ADD ONE TO NUMBER OF FREE ENTRIES >>                   <<03004>>29986000
     ABSOLUTE( TABADR+2) := ABSOLUTE( TABADR+2) + 1;           <<03004>>29988000
                                                               <<03004>>29990000
     << SET NEW FIRST FREE ENTRY >>                            <<03004>>29992000
     ABSOLUTE( TABADR+3) := ENTRYNUM*ENTRYSIZE;                <<03004>>29994000
                                                               <<03004>>29996000
     << SET POINTER IN NEW FIRST FREE ENTRY >>                 <<03004>>29998000
     ABSOLUTE( TABADR + ABSOLUTE( TABADR+3) + 1) := SAVE;      <<03004>>30000000
     END   << RETURNENTRY >>;                                  <<03004>>30002000
                                                               <<03004>>30004000
          <<----------------------------------->>              <<03004>>30006000
          <<        RELEASE CST ENTRY          >>              <<03004>>30008000
          <<----------------------------------->>              <<03004>>30010000
  PROCEDURE DELETECST( CSTNUM);                                <<03004>>30012000
  COMMENT                                                      <<03004>>30014000
       RELEASE A PREVIOUSLY ALLOCATED CST ENTRY;               <<03004>>30016000
  VALUE CSTNUM;                                                <<03004>>30018000
  INTEGER CSTNUM;   << PHYSICAL CST ENTRY NUMBER >>            <<03004>>30020000
     BEGIN                                                     <<03004>>30022000
     RETURNENTRY( SYSCST, CSTNUM);  << RETURN TO FREE LIST >>  <<03004>>30024000
     SEGXFORM( CSTNUM) := %177400; <<RESET SEG TRANSFORM TAB>> <<03004>>30026000
     SEGREF( CSTNUM) := -1;   <<RESET SEG REFERENCE TABLE>>    <<03004>>30028000
     END   << DELETECST >>;                                    <<03004>>30030000
          <<-------------------------                                   30032000
            INSERT SEGMENT INTO CST                                     30034000
          ------------------------->>                                   30036000
  PROCEDURE INSERTCST(CSTN,DISCADR,SEGSIZE,LINKED,SYSTEM);     <<03603>>30038000
    VALUE CSTN,DISCADR,SEGSIZE,LINKED,SYSTEM;                  <<03603>>30040000
    INTEGER CSTN,         <<SEGMENT #>>                                 30042000
            SEGSIZE;      <<SEGMENT SIZE AND FLAGS>>                    30046000
    DOUBLE DISCADR;       <<LDEV , DISC ADDRESS>>              <<03603>>30048000
    LOGICAL LINKED,       <<0=CORE RESIDENT,1=LINKED MEM,2=ABSENT>>     30050000
            SYSTEM;       <<SEGMENT BELONGS TO SYSTEM>>                 30052000
    COMMENT                                                             30054000
      ADDS AN ENTRY TO THE CST TABLE.  IF THE SEGMENT IS IN             30056000
    LINKED MENORY, CALLS FIXLINK TO PUT INFORMATION IN LINK;   <<00652>>30058000
      BEGIN                                                             30060000
        INTEGER DISCADR1=DISCADR, DISCADR2=DISCADR+1;                   30062000
          TOS := SEGSIZE.(2:14)&LSR(2);                                 30064000
          IF SEGSIZE<0 THEN ASSEMBLE(TSBC 1);  <<PRIV MODE>>            30066000
          IF LINKED=2 THEN ASSEMBLE(TSBC 0); <<ABSENT>>        <<00652>>30068000
        IF CSTN.(2:1) <> 0 THEN                                <<00652>>30070000
          BEGIN                 <<CSTX ENTRY>>                 <<00652>>30072000
            X:=CSTBLK(CSTN.(3:7))+CSTN.(10:6)&LSL(2)           <<00652>>30074000
               -ABSOLUTE(DFC);                                 <<00652>>30076000
            CST(X):=TOS;                                       <<00652>>30078000
          END ELSE                                             <<00652>>30080000
          BEGIN                 <<SHARABLE CST ENTRY>>         <<00652>>30082000
            CST(CSTN&LSL(2)):=TOS;                             <<00652>>30084000
          END;                                                 <<00652>>30086000
          TOS:=0;                                              <<MPEIV>>30088000
          IF LINKED=0 THEN                                     <<MPEIV>>30090000
             BEGIN <<SEG IS CORE RESIDENT>>                    <<MPEIV>>30092000
             TOS.SEGRESIDENTFLAG:=1;                           <<MPEIV>>30094000
             END;                                              <<MPEIV>>30096000
          TOS.SYSTEMFLAG := SYSTEM;                            <<01862>>30098000
          CST(X:=X+1):=TOS;                                    <<MPEIV>>30100000
          CST(X:=X+1) := DISCADR1;                             <<03603>>30102000
                                                               <<MPEIV>>30106000
          CST(X:=X+1) := DISCADR2;                                      30108000
      END <<INSERTCST>> ;                                               30110000
$INCLUDE INCLVMC                                               <<MPEIV>>30112000
          <<-------------------------                                   30114000
            INSERT SEGMENT INTO DST                                     30116000
          ------------------------->>                                   30118000
  PROCEDURE INSERTDST(COREADR,DSTN,SEGSIZE,MAXSIZE,BANK);      <<01384>>30120000
    VALUE DSTN,COREADR,SEGSIZE,MAXSIZE,BANK;                   <<01384>>30122000
    INTEGER DSTN,         <<SEGMENT NUMBER>>                            30124000
            COREADR,      <<CORE ADDRESS>>                              30126000
            SEGSIZE,      <<SEGMENT SIZE>>                              30128000
            BANK,                                              <<01384>>30130000
            MAXSIZE;      <<=0 - NOT IN LINKED MEMORY                   30132000
                            =-1 - USE SEGSIZE FOR MAXIMUM SIZE          30134000
                            >0 - MAXIMUM SIZE OF SEGMENT>>              30136000
    OPTION VARIABLE;                                           <<01384>>30138000
    COMMENT                                                             30140000
      INSERTS A DST DESCRIPTOR INTO THE DST TABLE. IF MAXSIZE  <<01440>>30142000
    = 0 THEN DO NOT GET OVERLAY SPACE AND SET THE CORE RESIDENT<<01440>>30144000
    BIT.  IF THE SEGMENT IS TO BE ABSENT, THE CORE RESIDENT BIT<<01440>>30146000
    BE CLEARED BY PROCEDURE ABSENT.                            <<01440>>30148000
;                                                              <<01440>>30150000
      BEGIN                                                             30152000
          LOGICAL VAR = Q-4;                                   <<01384>>30154000
          DEFINE BANK'PASSED =VAR.(15:1)#;                     <<01384>>30156000
          IF NOT BANK'PASSED THEN BANK := 0;                   <<01384>>30158000
          DST(DSTN&LSL(2)) := SEGSIZE&LSR(2);                           30160000
          TOS:=DST(X:=X+1);                                    <<MPEIV>>30162000
          TOS.SYSTEMFLAG:=1;                                   <<MPEIV>>30164000
          IF MAXSIZE=0 THEN TOS.SEGRESIDENTFLAG:=1;            <<MPEIV>>30166000
          DST(X):=TOS;                                                  30168000
          DST(X:=X+1) := BANK;                                 <<MPEIV>>30170000
          DST(X:=X+1) := COREADR;                                       30172000
      END <<INSERTDST>> ;                                               30174000
                                                                        30176000
          <<-------------------------------                             30178000
            MAKE DATA SEGMENT NON-PRESENT                               30180000
          ------------------------------->>                             30182000
  PROCEDURE ABSENT(DSTN,MAXSIZE);                                       30184000
    VALUE DSTN,MAXSIZE;                                                 30186000
    INTEGER DSTN,      <<DST NUMBER>>                                   30188000
            MAXSIZE;   <<IF -1, USE SEGMENT SIZE, OTHERWISE MAXIMUM     30190000
                         SEGMENT SIZE>>                                 30192000
    COMMENT                                                             30194000
      WRITES THE SPECIFIED DATA SEGMENT TO VIRTUAL MEMORY AND UPDATES   30196000
    THE DST TO REFLECT THIS;                                            30198000
      BEGIN                                                             30200000
        INTEGER SIZE,DISCADR;                                           30202000
          TOS := WRITE;                                                 30204000
          TOS := SYSDISC;                                               30206000
          SIZE := (DST(DSTN&LSL(2))+1)&LSL(2);                          30208000
          TOS := GETSWAPREGION(DSTN, IF MAXSIZE=-1 THEN SIZE   <<MPEIV>>30210000
            ELSE MAXSIZE, SYSDISC);                            <<MPEIV>>30212000
          IF DS0 = 0D THEN ERRMESSAGE(M330, SYSDISC);          <<01682>>30214000
          << OUT OF VIRTUAL MEMORY ON LDEV 1 >>                <<01682>>30216000
          TOS:=DST(X:=X+2); <<BANK>>                           <<MPEIV>>30218000
          TOS := DST(X:=X+1);  <<CORE ADDRESS>>                         30220000
          TOS := DS3;  <<DISC ADDRESS>>                                 30222000
          DST(X) := TOS;  <<LOW ORDER DISC ADDRESS>>                    30224000
          << CORE RESIDENT BIT SHOULD BE CLEAR - SEE INSERTDST <<01440>>30226000
          TOS.(0:8) := SYSDISC;                                         30228000
          DST(X:=X-1) := TOS;                                           30230000
          TOS:=DST(X:=X-1);                                    <<MPEIV>>30232000
         TOS.DISCCOPYVALIDFLAG:=1;                             <<MPEIV>>30234000
          TOS.SYSTEMFLAG:=1;                                   <<MPEIV>>30236000
          TOS.SEGRESIDENTFLAG:=0;  <<SET IN INSERT DST>>       <<MPEIV>>30238000
          DST(X):=TOS;                                         <<MPEIV>>30240000
          DST(X) := DST(X:=X-1) + %100000;  << SET ABSENT BIT>><<MPEIV>>30242000
          DISC'(*,*,*,*,SIZE);   <<WRITE TO DISC>>                      30244000
      END <<ABSENT>> ;                                                  30246000
                                                                        30248000
          <<----------------------                                      30250000
            INITIALIZE I/O TABLE                                        30252000
          ---------------------->>                                      30254000
  PROCEDURE INITIOTABLE(ENTRYNUM,SECONDPART,ENTRYSIZE,DSTN,SYSIX);      30256000
    VALUE ENTRYNUM,SECONDPART,ENTRYSIZE,DSTN,SYSIX;                     30258000
    INTEGER ENTRYNUM,SECONDPART,ENTRYSIZE,DSTN,SYSIX;                   30260000
    COMMENT                                                             30262000
      INITIALIZE FREE LIST AND HEADER INFO FOR ONE OF THE I/O TABLES.   30264000
    1/SECONDPART GIVES THE PORTION OF ENTRIES TO BE PUT IN THE          30266000
    SECONDARY PART OF THE TABLE;                                        30268000
      BEGIN                                                             30270000
        INTEGER ARRAY TABLE(*)=DB+0;                                    30272000
        INTEGER I := 0;                                        <<03004>>30274000
      INTEGER HEADSIZE;                                        <<01639>>30276000
       IF DSTN=DISCREQTABDSTN THEN HEADSIZE:=ENTRYSIZE         <<01639>>30278000
       ELSE HEADSIZE:=IOHEADSIZE;                              <<01639>>30280000
          TOS := 0;  <<BANK ADDRESS>>                                   30282000
       TOS:=INITTABLE(ENTRYNUM*ENTRYSIZE+HEADSIZE,1,IF SYSIX=  <<01639>>30284000
            SYSTBUF THEN 0 ELSE 1);  <<TBUFS ABOVE SYSDB>>              30286000
          ASSEMBLE(DUP,DUP);                                            30288000
          TOS := TOS-SYSBASE;                                           30290000
          ABSOLUTE(SYSIX) := TOS;  <<SYSDB RELATIVE TABLE PTR>>         30292000
          INSERTDST(*,DSTN,MEMSEG,0);                                   30294000
          ASSEMBLE(XCHD);   <<SET DB TO TABLE>>                         30296000
          IF SYSIX=SYSTBUF THEN                                         30298000
            BEGIN <<TERMINAL BUFFERS>>                                  30300000
            TOS := ENTRYNUM;                                            30302000
            ASSEMBLE(DUP,DUP);                                          30304000
            TOS := SECONDPART;                                          30306000
            ASSEMBLE(DIV,DEL;SUB,XCH);<<COMPUTE # OF PRIMARY ELEMENTS>> 30308000
            END                                                         30310000
          ELSE                                                          30312000
            BEGIN <<SYSTEM BUFFERS OR IOQ'S>>                           30314000
            TOS := ENTRYNUM;                                            30316000
            TOS := S0-SECONDPART; <<# OF PRIMARY ELEMENTS>>             30318000
            ASSEMBLE(XCH);                                              30320000
            END;                                                        30322000
          TOS := TOS&LSL(8);                                            30324000
          ASSEMBLE(ADD);                                                30326000
          TABLE := TOS;  <<# OF ENTRIES>>                               30328000
          TABLE(1) := ENTRYSIZE;                                        30330000
         TOS:=HEADSIZE;                                        <<01639>>30332000
          IF SYSIX=SYSSBUF THEN TOS:=TOS+1;  <<LINKED DIFFERENTLY>>     30334000
          TABLE(2) := S0;  <<INDEX OF FIRST FREE ELEMENT>>              30336000
          X := S0;                                                      30338000
          IF SYSIX=SYSSBUF THEN X:=X-1 ELSE                             30340000
         IF DSTN=DISCREQTABDSTN THEN X:=X+1 ELSE               <<01639>>30342000
            IF SYSIX=SYSIOQ THEN X:=X+1;                                30344000
          WHILE (I:=I+1) < ENTRYNUM DO                         <<03004>>30346000
            BEGIN  <<INITIALIZE FREE LIST>>                             30348000
              TOS := TOS+ENTRYSIZE;                                     30350000
              TABLE(X) := S0;                                           30352000
              X := X+ENTRYSIZE;                                         30354000
            END;                                               <<03004>>30356000
          TABLE(3) := TOS;  <<TAIL INDEX>>                              30360000
          SET(DB);  <<RESET TO STACK>>                                  30362000
      END <<INITIOTABLE>> ;                                             30364000
                                                                        30366000
          <<----------------------                                      30368000
            GET I/O PROCESS NAME                                        30370000
          ---------------------->>                                      30372000
  PROCEDURE GETIOPROCNAME;                                              30374000
    COMMENT                                                             30376000
      RETRIEVES THE I/O PROCESS NAME FROM THE EXTERNAL LIST OF          30378000
    THE DRIVER PROGRAM FILE;                                            30380000
      BEGIN                                                             30382000
        INTEGER EXTINDEX:=0,I,N,EXTRECORD,IOPROCSTT;                    30384000
          IF (IOPROCSTT:=OBINFO(INDEX+3).(8:8))=0 THEN                  30386000
            BEGIN  <<DEFAULT IS SYSTEM I/O PROCESS>>                    30388000
              MOVE IOPROCNAME := SYSIOPROC,(16);                        30390000
              RETURN;                                                   30392000
            END;                                                        30394000
          EXTRECORD := REC0(13);  <<EXTERNAL LIST RECORD #>>            30396000
          FREAD(DVRFNUM,D'L(EXTRECORD)),DVREXT,256);                    30398000
  NEXT:   TOS := DVREXT(EXTINDEX).(4:4);  <<# OF CHARS>>                30400000
          X := TOS&LSR(1)+EXTINDEX+1;                                   30402000
          I := 0;                                                       30404000
          N := DVREXT(X);  <<# OF EXTERNAL REFERENCES>>                 30406000
          WHILE (I:=I+1) <= N DO                                        30408000
          IF DVREXT(X:=X+1).(0:8)=IOPROCSTT THEN                        30410000
            BEGIN  <<FOUND IT>>                                         30412000
              IOPROCNAME := " ";                                        30414000
              MOVE IOPROCNAME(1) := IOPROCNAME,(15);                    30416000
              TOS := @IOPROCNAME;                                       30418000
              TOS := @DVREXT(EXTINDEX)&LSL(1);                 <<04306>>30420000
              TOS := BPS0.(12:4)+1;  <<CHARACTER COUNT>>                30422000
              ASSEMBLE(MVB);                                            30424000
              RETURN;                                                   30426000
            END;                                                        30428000
          I := DVREXT(X:=X+1).(0:2);                                    30430000
          TOS := (IF = THEN 1 ELSE IF I=3 THEN DVREXT(X).(2:6)+2 ELSE 2)30432000
            +X;                                                         30434000
          IF S0>127 THEN                                                30436000
            BEGIN  <<MUST READ ANOTHER RECORD>>                         30438000
              MOVE DVREXT := DVREXT(128),(128);                         30440000
              TOS := TOS-X;                                             30442000
              FREAD(DVRFNUM,D'L(EXTRECORD:=EXTRECORD+1)),DVREXT(128),   30444000
                128);                                                   30446000
            END;                                                        30448000
          EXTINDEX := TOS;                                              30450000
          GOTO NEXT;                                                    30452000
      END <<GETIOPROCNAME>> ;                                           30454000
                                                                        30456000
          <<-------------------------------                             30458000
            ADD ENTRY TO I/O PROCESS LIST                               30460000
          ------------------------------->>                             30462000
  PROCEDURE ADDIOPROC;                                                  30464000
    COMMENT                                                             30466000
      ADDS AN ENTRY TO THE I/O PROCESS LIST, INCLUDING PROCESS NAME,    30468000
    DRIVER TYPE, CORE RESIDENT FLAG, RELATIVE PRIORITY, AND             30470000
    RESOURCE QUEUE NUMBER;                                              30472000
      BEGIN                                                             30474000
          DLT'(DLTINDEX).QNUMB := NIOPROC;  <<PTR TO ENTRY>>            30476000
          TOS := @IOPROC(NIOPROC*IOPROCSIZE)&LSL(1);           <<04306>>30478000
          MOVE * := IOPROCNAME,(16);  <<MOVE IN NAME>>                  30480000
          IOPROC(X:=X+8).DRVRTYPE := DVRTYPE;                           30482000
          IOPROC(X).CORERES := RESIDENT;                                30484000
          IF DVRTYPE=2 THEN                                             30486000
            BEGIN  <<ASSIGN RESOURCE QUEUE NUMBER>>                     30488000
              TOS := NPROCQ+1;                                          30490000
              NPROCQ := S0;                                             30492000
              TOS := TOS+1;                                             30494000
              IOPROC(X).QNUMB := TOS;                                   30496000
            END                                                         30498000
          ELSE DIT(DPCBN) := NIOPROC;  <<HAS OWN PROCESS>>              30500000
          IF IOPROCNAME=SYSIOPROC,(16) THEN TOS := 0                    30502000
          ELSE TOS := DBINFO(1).(8:8);  <<RELATIVE PRIORITY>>           30504000
          IOPROC(NIOPROC*IOPROCSIZE+9) := TOS;                          30506000
          NIOPROC := NIOPROC+1;                                         30508000
      END <<ADDIOPROC>> ;                                               30510000
$PAGE "DISC FREE SPACE PROCEDURES"                                      30512000
$CONTROL SEGMENT=DISCSPACE                                              30514000
$PAGE "LDEVTOTYPE"                                                      30516000
INTEGER PROCEDURE Ldevtotype (ldev);                           <<03551>>30518000
   VALUE ldev;                                                          30520000
   INTEGER ldev;                                                        30522000
                                                                        30524000
<<==============================================================        30526000
                                                                        30528000
      This procedure returns the type of a device, given its            30530000
   ldev.                                                                30532000
                                                                        30534000
   Parameters:                                                          30536000
      ldev - logical device number of the device.                       30538000
                                                                        30540000
   Returns:                                                             30542000
      type (an integer code) of the device.                             30544000
                                                                        30546000
   Assumptions on entry:                                                30548000
      DB is at the stack.                                               30550000
                                                                        30552000
   Exit conditions:                                                     30554000
      DB is unchanged.                                                  30556000
                                                                        30558000
   Globals:                                                             30560000
                                                                        30562000
      Input:                                                            30564000
         ldt                                                            30566000
                                                                        30568000
      Equates:                                                          30570000
         ldtsize                                                        30572000
         ldt2                                                           30574000
                                                                        30576000
      Defines:                                                          30578000
         typ                                                            30580000
                                                                        30582000
   Externals:                                                           30584000
      None.                                                             30586000
                                                                        30588000
   Intrinsics:                                                          30590000
      None.                                                             30592000
                                                                        30594000
   Callers:                                                             30596000
      Get'Disc'Info                                                     30598000
                                                                        30600000
   Fix ID:                                                              30602000
         This procedure was added as part of the new disc free          30604000
      space map changes.  The fix number on the procedure header        30606000
      applies to the whole procedure.                                   30608000
                                                                        30610000
   Changes:                                                             30612000
                                                                        30614000
                                                                        30616000
==============================================================>>        30618000
                                                                        30620000
BEGIN                                                                   30622000
                                                                        30624000
   INTEGER return'value = Ldevtotype;                                   30626000
                                                                        30628000
   << - - - - - - - - - - >>                                            30630000
                                                                        30632000
   return'value := ldt ((ldev * ldtsize) + ldt2).typ;                   30634000
                                                                        30636000
END;   << Ldevtotype >>                                                 30638000
$PAGE "LDEVTOSUBTYPE"                                                   30640000
INTEGER PROCEDURE Ldevtosubtype (ldev);                        <<03551>>30642000
   VALUE ldev;                                                          30644000
   INTEGER ldev;                                                        30646000
                                                                        30648000
<<==============================================================        30650000
                                                                        30652000
      This procedure returns the subtype of a device, given             30654000
   its ldev.                                                            30656000
                                                                        30658000
   Parameters:                                                          30660000
      ldev - logical device number of the device.                       30662000
                                                                        30664000
   Returns:                                                             30666000
      subtype (an integer code) of the device.                          30668000
                                                                        30670000
   Assumptions on entry:                                                30672000
      DB is at the stack.                                               30674000
                                                                        30676000
   Exit conditions:                                                     30678000
      DB is unchanged.                                                  30680000
                                                                        30682000
   Globals:                                                             30684000
                                                                        30686000
      Input:                                                            30688000
         lpdt                                                           30690000
                                                                        30692000
      Equates:                                                          30694000
         lpdtsize                                                       30696000
         lpdt1                                                          30698000
                                                                        30700000
      Defines:                                                          30702000
         subtype                                                        30704000
                                                                        30706000
   Externals:                                                           30708000
      None.                                                             30710000
                                                                        30712000
   Intrinsics:                                                          30714000
      None.                                                             30716000
                                                                        30718000
   Callers:                                                             30720000
      Get'Disc'Info                                                     30722000
                                                                        30724000
   Fix ID:                                                              30726000
         This procedure was added as part of the new disc free          30728000
      space map changes.  The fix number on the procedure header        30730000
      applies to the whole procedure.                                   30732000
                                                                        30734000
   Changes:                                                             30736000
                                                                        30738000
                                                                        30740000
==============================================================>>        30742000
                                                                        30744000
BEGIN                                                                   30746000
                                                                        30748000
   INTEGER return'value = Ldevtosubtype;                                30750000
                                                                        30752000
   << - - - - - - - - - - >>                                            30754000
                                                                        30756000
   return'value := lpdt ((ldev * lpdtsize) + lpdt1).subtype;            30758000
                                                                        30760000
END;   << Ldevtosubtype >>                                              30762000
$PAGE "GET'DISC'INFO"                                                   30764000
PROCEDURE Get'Disc'Info (ldev, disc'label, read'label, dtt,    <<03551>>30766000
                         type, sub'type, disc'size,                     30768000
                         bit'map'address, bit'map'size'pages,           30770000
                         dt'address, dt'size'words, dt'dirty'flag,      30772000
                         dt'check'sum, sectors'per'track,               30774000
                         default'logical'pack'size,                     30776000
                         max'logical'pack'size, tracks'per'cylinder,    30778000
                         starting'head'number, track'multiplier);       30780000
                                                                        30782000
                                                                        30784000
   VALUE ldev, read'label;                                              30786000
   INTEGER ldev;                                                        30788000
   ARRAY disc'label;                                                    30790000
   LOGICAL read'label;                                                  30792000
   INTEGER ARRAY dtt;                                                   30794000
   INTEGER type;                                                        30796000
   INTEGER sub'type;                                                    30798000
   DOUBLE disc'size;                                                    30800000
   DOUBLE bit'map'address;                                              30802000
   INTEGER bit'map'size'pages;                                          30804000
   DOUBLE dt'address;                                                   30806000
   INTEGER dt'size'words;                                               30808000
   LOGICAL dt'dirty'flag;                                               30810000
   LOGICAL dt'check'sum;                                                30812000
   INTEGER sectors'per'track;                                           30814000
   INTEGER default'logical'pack'size;                                   30816000
   INTEGER max'logical'pack'size;                                       30818000
   INTEGER tracks'per'cylinder;                                         30820000
   INTEGER starting'head'number;                                        30822000
   INTEGER track'multiplier;                                            30824000
   OPTION VARIABLE,PRIVILEGED,UNCALLABLE;                               30826000
                                                                        30828000
<<==============================================================        30830000
                                                                        30832000
      This procedure returns all sorts of information about a           30834000
   particular disc ldev.  The information returned is de-               30836000
   scribed below, but a few notes are necessary about the               30838000
   "disc'label", "read'label", and "dtt" parameters.  If                30840000
   "disc'label" is passed and "read'label" is FALSE or omit-            30842000
   ted, then "disc'label" is assumed to be a valid copy of              30844000
   the "disc'label" for the ldev. If "read'label" is TRUE,              30846000
   then the disc label is read into the buffer.  If                     30848000
   "disc'label" is not passed and a copy of the disc label is           30850000
   needed to return other info that was requested, then a               30852000
   local buffer is allocated and the disc label is read into            30854000
   it.  The "dtt" buffer is used for returning the defective            30856000
   tracks table only. If it is not passed, and the DTT is               30858000
   needed, a local buffer is allocated and the DTT read into            30860000
   it.                                                                  30862000
                                                                        30864000
      Note: The only return values that are supported for               30866000
   floppy discs are disc'label, dtt, type, sub'type,                    30868000
   bit'map'address, bit'map'size'pages, dt'address,                     30870000
   dt'size'words, dt'dirty'flag and dt'check'sum. All other             30872000
   attempts to get values for floppies will result in a nasty           30874000
   message and a HALT.                                                  30876000
                                                                        30878000
   Parameters:                                                          30880000
      ldev - Logical device number of disc drive.                       30882000
      disc'label - (optional) - buffer for disc label or                30884000
                   containing disc label, see above comment.            30886000
      read'label - (optional) - TRUE = read in disc label,              30888000
                   FALSE don't read label, see above comment.           30890000
      dtt - (optional) - buffer for returning defective                 30892000
            tracks table, (NOT for defective sectors devices).          30894000
      type - (optional) - for return of device type code.               30896000
      subtype - (optional) - For return of subtype code.                30898000
      disc'size - (optional) - For return of logical size of            30900000
                  disc in sectors.                                      30902000
      bit'map'address - (optional) - For return of disc                 30904000
                        addreess of disc free space bit map.            30906000
      bit'map'size'pages - (optional) - For return of the               30908000
                           size of the bit map (in pages).              30910000
      dt'address - (optional) - For return of the disc                  30912000
                   address of the disc free space descriptor            30914000
                   table.                                               30916000
      dt'size'words - (optional) - For return  of the size of           30918000
                      the descriptor table (in words).                  30920000
      dt'dirty'flag - (optional) - For return of the value of           30922000
                      the descriptor table dirty flag from              30924000
                      the disc label.                                   30926000
      dt'check'sum - (optional) - For return of the                     30928000
                     descriptor table checksum from the disc            30930000
                     label.                                             30932000
      sectors'per'track - (optional) - For return of the the            30934000
                          number of sectors per track.                  30936000
      default'logical'pack'size - (optional) - For return of            30938000
                                  default logical pack size.            30940000
      max'logical'pack'size - (optional) - For return of                30942000
                              maximum logical pack size.                30944000
      tracks'per'cylinder - (optional) - For return of number           30946000
                            of tracks per cylinder.                     30948000
      starting'head'number - (optional) - For return of                 30950000
                             starting head number.                      30952000
      track'multiplier - (optional) - For return of the track multipli  30954000
                         multiplier.  This value is to convert a        30956000
                         track number to a cylinder & head number.  It  30958000
                         is only needed for the 7900 disc.  For all     30960000
                         other discs it has a value of 1.               30962000
                                                                        30964000
   Assumptions on entry:                                                30966000
      DB is at the stack.                                               30968000
                                                                        30970000
   Exit conditions:                                                     30972000
      DB is unchanged.                                                  30974000
                                                                        30976000
   Globals:                                                             30978000
                                                                        30980000
      Others:                                                           30982000
         mh'tracks'per'cylinder {INCDISC2}                              30984000
         mh'sectors'per'track {INCDISC2}                                30986000
         mh'default'logical'pack'size {INCDISC2}                        30988000
         fh'log'pack'size {INCDISC2}                                    30990000
         mh'max'log'pack'size {INCDISC2}                                30992000
         mh'tracks'per'cylinder {INCDISC2}                              30994000
         mh'starting'head'number {INCDISC2}                             30996000
                                                                        30998000
      Equates:                                                          31000000
         sector'size                                                    31002000
         mh'disc'type {INCDISC1}                                        31004000
         fh'disc'type {INCDISC1}                                        31006000
         floppy'disc'type {INCDISC1}                                    31008000
         cs'80'type {INCDISC1}                                          31010000
         dtt'logical'pack'size {INCDISC1}                               31012000
         fh'sectors'per'track {INCDISC2}                                31014000
         bits'per'page                                                  31016000
         disc'lab'map'high {INCDISC1}                                   31018000
         disc'lab'map'low {INCDISC1}                                    31020000
         disc'lab'dt'high {INCDISC1}                                    31022000
         disc'lab'dt'low {INCDISC1}                                     31024000
         dt'entry'size                                                  31026000
         disc'lab'dirty'dt'flag {INCDISC1}                              31028000
         disc'lab'dt'check'sum {INCDISC1}                               31030000
         fh'tracks'per'cylinder {INCDISC2}                              31032000
         fh'starting'head'number {INCDISC2}                             31034000
         mh'track'multiplier {INCDISC2}                                 31036000
         fh'track'multiplier {INCDISC2}                                 31038000
         m401                                                           31040000
                                                                        31042000
      Defines:                                                          31044000
         disc'label'address {INCDISC1}                                  31046000
         dtt'disc'address {INCDISC1}                                    31048000
         DBL                                                            31050000
                                                                        31052000
   Externals:                                                           31054000
      Disc                                                              31056000
      Ldevtotype                                                        31058000
      Ldevtosubtype                                                     31060000
      Errmessage                                                        31062000
                                                                        31064000
   Intrinsics:                                                          31066000
      None.                                                             31068000
                                                                        31070000
   Callers:                                                             31072000
      Access'Dfs'Map                                                    31074000
      Get'Disc'Defect'Entry                                             31076000
      Init'Disc'Free'Space'Map                                          31078000
                                                                        31080000
   Fix ID:                                                              31082000
         This procedure was added as part of the new disc               31084000
      free space map changes.  The fix number on the                    31086000
      procedure header applies to the whole procedure.                  31088000
                                                                        31090000
   Changes:                                                             31092000
                                                                        31094000
                                                                        31096000
==============================================================>>        31098000
                                                                        31100000
BEGIN                                                                   31102000
                                                                        31104000
   << Parameter map definitions >>                                      31106000
                                                                        31108000
   LOGICAL pmap0 = Q-5,                                                 31110000
           pmap1 = Q-4;                                                 31112000
                                                                        31114000
   DEFINE                                                               31116000
      passed'ldev = pmap0.(13:1)#,                                      31118000
      passed'disc'label = pmap0.(14:1)#,                                31120000
      passed'read'label = pmap0.(15:1)#,                                31122000
      passed'dtt = pmap1.(0:1)#,                                        31124000
      passed'type = pmap1.(1:1)#,                                       31126000
      passed'sub'type = pmap1.(2:1)#,                                   31128000
      passed'disc'size = pmap1.(3:1)#,                                  31130000
      passed'b'm'address = pmap1.(4:1)#,                                31132000
      passed'b'm'size'pages = pmap1.(5:1)#,                             31134000
      passed'dt'address = pmap1.(6:1)#,                                 31136000
      passed'dt'size'words = pmap1.(7:1)#,                              31138000
      passed'dt'dirty'flag = pmap1.(8:1)#,                              31140000
      passed'dt'check'sum = pmap1.(9:1)#,                               31142000
      passed'sectors'per'track = pmap1.(10:1)#,                         31144000
      passed'default'logical'pack'size = pmap1.(11:1)#,                 31146000
      passed'max'logical'pack'size = pmap1.(12:1)#,                     31148000
      passed'tracks'per'cylinder = pmap1.(13:1)#,                       31150000
      passed'starting'head'number = pmap1.(14:1)#,                      31152000
      passed'track'multiplier = pmap1.(15:1)#;                          31154000
                                                                        31156000
   << Local vars to hold values that are needed to generate             31158000
      info that is to be returned.                          >>          31160000
                                                                        31162000
   INTEGER local'type;                                                  31164000
   INTEGER local'sub'type;                                              31166000
   DOUBLE local'disc'size;                                              31168000
   INTEGER local'bit'map'size'pages;                                    31170000
   ARRAY buf'disc'size (0:1);                                           31172000
   DOUBLE ARRAY d'buf'disc'size (*) = buf'disc'size;                    31174000
                                                                        31176000
$INCLUDE INCDISC1                                                       31178000
                                                                        31180000
$SET X7=ON                                                              31182000
$INCLUDE INCDISC2                                                       31184000
                                                                        31186000
                                                                        31188000
   << - - - - - - - - - - >>                                            31190000
                                                                        31192000
   << Check and see if we need to allocate a buffer for the             31194000
      disc label, but only if we really need it.             >>         31196000
                                                                        31198000
   IF (passed'b'm'address OR passed'dt'address OR passed'dt'dirty)      31200000
   AND NOT passed'disc'label THEN                                       31202000
      BEGIN  << Allocate disc label buffer >>                           31204000
                                                                        31206000
         PUSH (S);                                                      31208000
         @disc'label := TOS + 1;  << ptr to buffer >>                   31210000
         TOS := sector'size + 1;  << size of buffer >>                  31212000
         ASSEMBLE (ADDS 0);                                             31214000
                                                                        31216000
         << Remember to read the label >>                               31218000
                                                                        31220000
         read'label := TRUE;                                            31222000
                                                                        31224000
      END    << Allocate disc label buffer >>                           31226000
   ELSE                                                                 31228000
      IF NOT passed'read'label THEN                                     31230000
         read'label := FALSE;                                           31232000
                                                                        31234000
   << Read disc label if needed >>                                      31236000
                                                                        31238000
   IF read'label THEN                                                   31240000
      Disc (0, ldev, disc'label'address, disc'label, sector'size);      31242000
                                                                        31244000
                                                                        31246000
   << Read in defective tracks table, if we will need it. >>            31248000
                                                                        31250000
   IF passed'dtt OR (passed'disc'size LAND                              31252000
   NOT (local'type = cs'80'type)) OR                                    31254000
   passed'b'm'size'pages OR passed'dt'size'words THEN                   31256000
      BEGIN  << Read in DTT >>                                          31258000
                                                                        31260000
         << Allocate buffer for DTT if not passsed >>                   31262000
                                                                        31264000
         IF NOT passed'dtt THEN                                         31266000
            BEGIN  << Allocate DTT buffer >>                            31268000
                                                                        31270000
               PUSH (S);                                                31272000
               @dtt := TOS + 1;                                         31274000
               TOS := sector'size + 1;                                  31276000
               ASSEMBLE (ADDS 0);                                       31278000
                                                                        31280000
            END;   << Allocate DTT buffer >>                            31282000
                                                                        31284000
         Disc (0, ldev, dtt'disc'address, dtt, sector'size);            31286000
                                                                        31288000
      END;   << Read in DTT >>                                          31290000
                                                                        31292000
   << Get type and sub'type >>                                          31294000
                                                                        31296000
   local'type := Ldevtotype (ldev);                                     31298000
   local'sub'type := Ldevtosubtype (ldev);                              31300000
                                                                        31302000
   IF NOT((local'type = mh'disc'type) LOR                               31304000
   (local'type = fh'disc'type) LOR                                      31306000
   (local'type = floppy'disc'type) LOR                                  31308000
   (local'type = cs'80'type)) THEN                                      31310000
      Errmessage (m401);                                                31312000
                                                                        31314000
   << Determine size of disc and size of bit map. >>                    31316000
                                                                        31318000
   IF passed'disc'size OR passed'b'm'size'pages OR                      31320000
   passed'dt'size'words THEN                                            31322000
      BEGIN  << Calculate size of disc >>                               31324000
                                                                        31326000
         IF local'type = mh'disc'type THEN                              31328000
            local'disc'size := DBL(dtt(dtt'logical'pack'size)) *        31330000
                  DBL(mh'tracks'per'cylinder (local'sub'type)) *        31332000
                  DBL(mh'sectors'per'track (local'sub'type))            31334000
                                                                        31336000
         ELSE                                                           31338000
         IF local'type = fh'disc'type THEN                              31340000
            local'disc'size := DBL(dtt(dtt'logical'pack'size)) *        31342000
                  DBL(fh'sectors'per'track)                             31344000
         ELSE                                                           31346000
         IF local'type = floppy'disc'type THEN                          31348000
            Errmessage (m401)                                           31350000
         ELSE                                                           31352000
         IF local'type = cs'80'type THEN                                31354000
            BEGIN << Command set 80 disc >>                             31356000
                                                                        31358000
               Disc (13, ldev, 0D, buf'disc'size, 2);                   31360000
                                                                        31362000
               local'disc'size := d'buf'disc'size (0) + 1D;             31364000
                                                                        31366000
            END   << Command set 80 disc >>                             31368000
         ELSE ;                                                         31370000
                                                                        31372000
         local'bit'map'size'pages := local'disc'size // bits'per'page;  31374000
         IF (local'disc'size MODD bits'per'page) <> 0 THEN              31376000
            local'bit'map'size'pages := local'bit'map'size'pages + 1;   31378000
                                                                        31380000
      END;   << Calculate size of disc >>                               31382000
                                                                        31384000
                                                                        31386000
   << Return values for passed parameters. >>                           31388000
                                                                        31390000
   IF passed'type THEN                                                  31392000
      type := local'type;                                               31394000
                                                                        31396000
                                                                        31398000
   IF passed'sub'type THEN                                              31400000
      sub'type := local'sub'type;                                       31402000
                                                                        31404000
                                                                        31406000
   IF passed'disc'size THEN                                             31408000
      disc'size := local'disc'size;                                     31410000
                                                                        31412000
                                                                        31414000
   IF passed'b'm'address THEN                                           31416000
      BEGIN  << return bit map address >>                               31418000
                                                                        31420000
         TOS := disc'label (disc'lab'map'high);                         31422000
         TOS := disc'label (disc'lab'map'low);                          31424000
         bit'map'address := TOS;                                        31426000
                                                                        31428000
      END;   << Return bit map address >>                               31430000
                                                                        31432000
                                                                        31434000
   IF passed'b'm'size'pages THEN                                        31436000
      bit'map'size'pages := local'bit'map'size'pages;                   31438000
                                                                        31440000
                                                                        31442000
   IF passed'dt'address THEN                                            31444000
      BEGIN  << Descriptor table address >>                             31446000
                                                                        31448000
         TOS := disc'label (disc'lab'dt'high);                          31450000
         TOS := disc'label (disc'lab'dt'low);                           31452000
         dt'address := TOS;                                             31454000
                                                                        31456000
      END;   << descriptor table address >>                             31458000
                                                                        31460000
                                                                        31462000
   IF passed'dt'size'words THEN                                         31464000
      BEGIN  << Return size of descriptor table >>                      31466000
                                                                        31468000
         dt'size'words := local'bit'map'size'pages * dt'entry'size;     31470000
                                                                        31472000
         << Increment size if it is odd, thus making it even. This      31474000
            is necessary so "Make'Check'Sum" will have an even          31476000
            number of words to work with.  This will mean that a        31478000
            word may be wasted. Big shit.                         >>    31480000
                                                                        31482000
         IF dt'size'words.(15:1) = 1 THEN                               31484000
            dt'size'words := dt'size'words + 1;                         31486000
                                                                        31488000
      END;   << Return size of descriptor table >>                      31490000
                                                                        31492000
                                                                        31494000
   IF passed'dt'dirty'flag THEN                                         31496000
      dt'dirty'flag := disc'label (disc'lab'dirty'dt'flag);             31498000
                                                                        31500000
                                                                        31502000
   IF passed'dt'check'sum THEN                                          31504000
         dt'check'sum := disc'label (disc'lab'dt'check'sum);            31506000
                                                                        31508000
                                                                        31510000
   IF passed'sectors'per'track THEN                                     31512000
      BEGIN   << Return sectors per track >>                            31514000
                                                                        31516000
         IF local'type = mh'disc'type THEN                              31518000
            sectors'per'track := mh'sectors'per'track (local'sub'type)  31520000
                                                                        31522000
         ELSE                                                           31524000
         IF local'type = fh'disc'type THEN                              31526000
            sectors'per'track := fh'sectors'per'track                   31528000
                                                                        31530000
         ELSE                                                           31532000
         IF local'type = floppy'disc'type THEN                          31534000
            Errmessage (m401)                                           31536000
                                                                        31538000
         ELSE                                                           31540000
         IF local'type = cs'80'type THEN                                31542000
            sectors'per'track := 0   << Not valid for cs'80 >>          31544000
                                                                        31546000
         ELSE ;                                                         31548000
                                                                        31550000
      END;    << Return sectors per track >>                            31552000
                                                                        31554000
                                                                        31556000
   IF passed'default'logical'pack'size THEN                             31558000
      BEGIN  << Return default logical pack size >>                     31560000
                                                                        31562000
         IF local'type = mh'disc'type THEN                              31564000
            default'logical'pack'size :=                                31566000
                  mh'default'log'pack'size (local'sub'type)             31568000
                                                                        31570000
         ELSE                                                           31572000
         IF local'type = fh'disc'type THEN                              31574000
            default'logical'pack'size :=                                31576000
                  fh'log'pack'size (local'sub'type)                     31578000
                                                                        31580000
         ELSE                                                           31582000
         IF local'type = floppy'disc'type THEN                          31584000
            Errmessage (m401)                                           31586000
                                                                        31588000
         ELSE                                                           31590000
         IF local'type = cs'80'type THEN                                31592000
            default'logical'pack'size := 0  << Not valid for cs 80 >>   31594000
                                                                        31596000
         ELSE;                                                          31598000
                                                                        31600000
      END;   << Return default logical pack size >>                     31602000
                                                                        31604000
                                                                        31606000
   IF passed'max'logical'pack'size THEN                                 31608000
      BEGIN  << Return max logical pack size >>                         31610000
                                                                        31612000
         IF local'type = mh'disc'type THEN                              31614000
            max'logical'pack'size :=                                    31616000
                  mh'max'log'pack'size (local'sub'type)                 31618000
                                                                        31620000
         ELSE                                                           31622000
         IF local'type = fh'disc'type THEN                              31624000
            max'logical'pack'size :=                                    31626000
                  fh'log'pack'size (local'sub'type)                     31628000
                                                                        31630000
         ELSE                                                           31632000
         IF local'type = floppy'disc'type THEN                          31634000
            Errmessage (m401)                                           31636000
                                                                        31638000
         ELSE                                                           31640000
         IF local'type = cs'80'type THEN                                31642000
            max'logical'pack'size := 0   << Not calid for cs 80 >>      31644000
                                                                        31646000
         ELSE;                                                          31648000
                                                                        31650000
      END;   << Return max logical pack size >>                         31652000
                                                                        31654000
                                                                        31656000
   IF passed'tracks'per'cylinder THEN                                   31658000
      BEGIN  << Return tracks per cylinder >>                           31660000
                                                                        31662000
         IF local'type = mh'disc'type THEN                              31664000
            tracks'per'cylinder :=                                      31666000
                  mh'tracks'per'cylinder (local'sub'type)               31668000
                                                                        31670000
         ELSE                                                           31672000
         IF local'type = fh'disc'type THEN                              31674000
               tracks'per'cylinder := fh'tracks'per'cylinder            31676000
                                                                        31678000
         ELSE                                                           31680000
         IF local'type = floppy'disc'type THEN                          31682000
            Errmessage (m401)                                           31684000
                                                                        31686000
         ELSE                                                           31688000
         IF local'type = cs'80'type THEN                                31690000
            tracks'per'cylinder := 0  << Not valid for cs 80 dev >>     31692000
                                                                        31694000
         ELSE;                                                          31696000
                                                                        31698000
     END;   << Return tracks per cylinder >>                            31700000
                                                                        31702000
                                                                        31704000
   IF passed'starting'head'number THEN                                  31706000
      BEGIN  << Return starting head number >>                          31708000
                                                                        31710000
         IF local'type = mh'disc'type THEN                              31712000
            starting'head'number :=                                     31714000
                  mh'starting'head'number (local'sub'type)              31716000
                                                                        31718000
         ELSE                                                           31720000
         IF local'type = fh'disc'type THEN                              31722000
            starting'head'number := fh'starting'head'number             31724000
                                                                        31726000
         ELSE                                                           31728000
         IF local'type = floppy'disc'type THEN                          31730000
            Errmessage (m401)                                           31732000
                                                                        31734000
         ELSE                                                           31736000
         IF local'type = cs'80'type THEN                                31738000
            starting'head'number := 0   << Not valid for cs'80 dev >>   31740000
                                                                        31742000
         ELSE                                                           31744000
                                                                        31746000
      END;  << Return starting head number >>                           31748000
                                                                        31750000
   IF passed'track'multiplier THEN                                      31752000
      BEGIN  << Return track multiplier >>                              31754000
                                                                        31756000
         IF local'type = mh'disc'type THEN                              31758000
            track'multiplier :=                                         31760000
                  mh'track'multiplier (local'sub'type)                  31762000
                                                                        31764000
         ELSE                                                           31766000
         IF local'type = fh'disc'type THEN                              31768000
            track'multiplier := fh'track'multiplier                     31770000
                                                                        31772000
         ELSE                                                           31774000
         IF local'type = floppy'disc'type THEN                          31776000
            Errmessage (m401)                                           31778000
                                                                        31780000
         ELSE                                                           31782000
         IF local'type = cs'80'type THEN                                31784000
            track'multiplier := 1  << Not valid for cs'80 dev >>        31786000
                                                                        31788000
         ELSE                                                           31790000
                                                                        31792000
      END;   << Return track multiplier >>                              31794000
                                                                        31796000
END;   << Get'Disc'Info >>                                              31798000
$PAGE "INDLDFSC - DISC FREE SPACE COMMON CODE INCLUDE FILE"             31800000
$INCLUDE INCLDFSC                                                       31802000
$PAGE "WRITE'PAGE"                                                      31804000
PROCEDURE Write'Page;                                          <<03551>>31806000
                                                                        31808000
<<==============================================================        31810000
                                                                        31812000
      This procedure re-calculates the check sum and writes             31814000
   the page of the bit map currently in the global buffer               31816000
   back to disc.                                                        31818000
                                                                        31820000
   Assumptions on entry:                                                31822000
      DB is at the stack.                                               31824000
                                                                        31826000
   Exit conditions:                                                     31828000
      DB is unchanged.                                                  31830000
                                                                        31832000
   Globals:                                                             31834000
                                                                        31836000
      Input:                                                            31838000
         ldev'of'map'in'buffer - ldev of disc from which the            31840000
                                 page came.                             31842000
         add'of'map'page'in'buffer - disc address of page in            31844000
                                     the buffer.                        31846000
         bit'map'buffer - buffer containing page of map.                31848000
                                                                        31850000
      Equates:                                                          31852000
         check'sum'word                                                 31854000
         actual'words'per'page                                          31856000
                                                                        31858000
   Externals:                                                           31860000
      Make'Check'Sum                                                    31862000
      Disc                                                              31864000
                                                                        31866000
   Intrinsics:                                                          31868000
      None.                                                             31870000
                                                                        31872000
   Callers:                                                             31874000
      Set'Reset'Bit'Map                                                 31876000
                                                                        31878000
   Fix ID:                                                              31880000
         This procedure was added as part of the new disc               31882000
      free space map changes.  The fix number on the                    31884000
      procedure header applies to the whole procedure.                  31886000
                                                                        31888000
   Changes:                                                             31890000
                                                                        31892000
                                                                        31894000
==============================================================>>        31896000
                                                                        31898000
BEGIN                                                                   31900000
                                                                        31902000
   << Generate new check sum >>                                         31904000
                                                                        31906000
   bit'map'buffer (check'sum'word) := 0;                                31908000
   bit'map'buffer (check'sum'word) :=                                   31910000
      Make'Check'Sum (bit'map'buffer, actual'words'per'page);           31912000
                                                                        31914000
   << Write to disc >>                                                  31916000
                                                                        31918000
   Disc (1, ldev'of'map'in'buffer, add'of'map'page'in'buffer,           31920000
         bit'map'buffer, actual'words'per'page);                        31922000
                                                                        31924000
END; << Write'Page >>                                                   31926000
$PAGE "CHECK'DT'ENTRY"                                                  31928000
LOGICAL PROCEDURE Check'Dt'Entry (ldev'index, page);           <<03551>>31930000
   VALUE ldev'index, page;                                              31932000
   INTEGER ldev'index;                                                  31934000
   INTEGER page;                                                        31936000
                                                                        31938000
<<==============================================================        31940000
                                                                        31942000
      This procedure checks the descriptor table entry for a            31944000
   page of a disc free space map to see if the page has been            31946000
   flaged as bad.  It first calculates which sector of the              31948000
   descriptor table (which is on disc) is needed and the                31950000
   offset into the sector. If the sector is                             31952000
   already in the global buffer, then it is used, otherwise             31954000
   the sector must be read from disc.  Only the first word of           31956000
   the entry is check, although all are marked, as it                   31958000
   simplfies the case when an entry crosses sector boundries.           31960000
                                                                        31962000
   Parameters:                                                          31964000
      ldev'index - index from ldev to check. (see                       31966000
                   ldev'index'to'ldev array)                            31968000
      page - The page to check the descriptor entry for.                31970000
                                                                        31972000
   Returns:                                                             31974000
      TRUE if the page is o.k.,                                         31976000
      FALSE if the page has been marked as bad.                         31978000
                                                                        31980000
   Assumptions on entry:                                                31982000
      DB is at the stack.                                               31984000
                                                                        31986000
   Exit conditions:                                                     31988000
      DB is unchanged.                                                  31990000
                                                                        31992000
   Globals:                                                             31994000
                                                                        31996000
      Input:                                                            31998000
         ldev'of'dt'page'in'buffer - may be changed.                    32000000
         add'of'dt'page'in'buffer - may be changed.                     32002000
         dt'buffer - may be changed.                                    32004000
                                                                        32006000
      Others:                                                           32008000
         dt'disc'address                                                32010000
         ldev'index'to'ldev                                             32012000
                                                                        32014000
      Equates:                                                          32016000
         dt'entry'size                                                  32018000
         sector'size                                                    32020000
         bad'page                                                       32022000
                                                                        32024000
   Externals:                                                           32026000
      Disc                                                              32028000
                                                                        32030000
   Intrinsics:                                                          32032000
      None.                                                             32034000
                                                                        32036000
   Callers:                                                             32038000
      Access'Dfs'Map                                                    32040000
      Get'Page                                                          32042000
                                                                        32044000
   Fix ID:                                                              32046000
         This procedure was added as part of the new disc               32048000
      free space map changes.  The fix number on the                    32050000
      procedure header applies to the whole procedure.                  32052000
                                                                        32054000
   Changes:                                                             32056000
                                                                        32058000
                                                                        32060000
==============================================================>>        32062000
                                                                        32064000
BEGIN                                                                   32066000
                                                                        32068000
   DOUBLE sector'address;                                               32070000
   INTEGER offset;                                                      32072000
                                                                        32074000
   LOGICAL return'value = Check'Dt'Entry;                               32076000
                                                                        32078000
   << - - - - - - - - - - >>                                            32080000
                                                                        32082000
   << Calculate disc address of sector containing entry for the         32084000
      page, and the offset into that sector of the entry.       >>      32086000
                                                                        32088000
   sector'address := DOUBLE((page*dt'entry'size) / sector'size) +       32090000
                     dt'disc'address (ldev'index);                      32092000
   offset := (page * dt'entry'size) MOD sector'size;                    32094000
   IF offset <> 0 THEN                                                  32096000
      sector'address := sector'address + 1D;                            32098000
                                                                        32100000
   << See if page of DT is already in buffer, if not, read it in. >>    32102000
                                                                        32104000
   IF NOT ((ldev'index'to'ldev(ldev'index) = ldev'of'dt'page'in'buffer) 32106000
   LAND (sector'address = add'of'dt'page'in'buffer)) THEN               32108000
      BEGIN  << Must read page >>                                       32110000
                                                                        32112000
         Disc (0, ldev'index'to'ldev (ldev'index), sector'address,      32114000
               dt'buffer, sector'size);                                 32116000
                                                                        32118000
         << If any errors have occured, INITIAL has been halted >>      32120000
                                                                        32122000
      END;   << Must read page >>                                       32124000
                                                                        32126000
   << Check if page has been flaged as bad. >>                          32128000
                                                                        32130000
   IF dt'buffer (offset) = bad'page THEN                                32132000
      return'value := FALSE                                             32134000
   ELSE                                                                 32136000
      return'value := TRUE;                                             32138000
                                                                        32140000
END;  << Check'Dt'Entry >>                                              32142000
$PAGE "GET'PAGE"                                                        32144000
PROCEDURE Get'Page (ldev'index, page);                         <<03551>>32146000
   VALUE ldev'index, page;                                              32148000
   INTEGER ldev'index;                                                  32150000
   INTEGER page;                                                        32152000
                                                                        32154000
<<==============================================================        32156000
                                                                        32158000
      This procedure reads the specified page of a bit map              32160000
   into the global buffer.  First a check is made to see if             32162000
   the page is already there, if so, we just return.  If it             32164000
   is not and "dfs'map'problems" indicates there are some bad           32166000
   pages in the map, then it checks the descriptor table to             32168000
   see if the page has been flaged bad. If it is bad it                 32170000
   exits, returning error status.  If the page is o.k., then            32172000
   it is read into the buffer and the checksum is verfied.              32174000
   If the checksum is bad, then it returns error status,                32176000
   otherwise ok status.                                                 32178000
                                                                        32180000
   Parameters:                                                          32182000
      ldev'index - index refering to ldev of disc.                      32184000
      page - page to read into buffer.                                  32186000
                                                                        32188000
   Returns:                                                             32190000
      condition code = CCE - got it.                                    32192000
                       CCL - can't get, either page is flaged           32194000
                             as bad or checksum error.                  32196000
                                                                        32198000
   Assumptions on entry:                                                32200000
      DB is at the stack.                                               32202000
                                                                        32204000
   Exit conditions:                                                     32206000
      DB is unchanged.                                                  32208000
                                                                        32210000
   Globals:                                                             32212000
                                                                        32214000
      Input:                                                            32216000
         dfs'map'problems                                               32218000
         ldev'to'ldev'index                                             32220000
         bit'map'disc'address                                           32222000
                                                                        32224000
      Output:                                                           32226000
         ldev'of'map'in'buffer                                          32228000
         page'of'map'in'buffer                                          32230000
         add'of'map'in'buffer                                           32232000
         bit'map'buffer                                                 32234000
                                                                        32236000
      Others:                                                           32238000
         last'page'of'map                                               32240000
                                                                        32242000
      Equates:                                                          32244000
         cce                                                            32246000
         ccl                                                            32248000
         actual'words'per'page                                          32250000
         check'sum'word                                                 32252000
                                                                        32254000
      Defines:                                                          32256000
         cc                                                             32258000
                                                                        32260000
   Externals:                                                           32262000
      Disc                                                              32264000
      Check'Dt'Entry                                                    32266000
      Make'Check'Sum                                                    32268000
                                                                        32270000
   Intrinsics:                                                          32272000
      None.                                                             32274000
                                                                        32276000
   Callers:                                                             32278000
      Set'Reset'Bit'Map                                                 32280000
      Get'Disc'Space                                                    32282000
      Get'Specific'Disc'Space                                           32284000
                                                                        32286000
   Fix ID:                                                              32288000
         This procedure was added as part of the new disc               32290000
      free space map changes.  The fix number on the                    32292000
      procedure header applies to the whole procedure.                  32294000
                                                                        32296000
   Changes:                                                             32298000
                                                                        32300000
                                                                        32302000
==============================================================>>        32304000
                                                                        32306000
BEGIN                                                                   32308000
                                                                        32310000
   LOGICAL check'sum;                                                   32312000
                                                                        32314000
   << - - - - - - - - - - >>                                            32316000
                                                                        32318000
   IF NOT(0 <= page <= last'page'of'map (ldev'index)) THEN              32320000
      ERRMESSAGE (M325,1);                                     <<03632>>32322000
                                                                        32324000
   cc := cce;   << Preset OK status >>                                  32326000
                                                                        32328000
   << Check to see if it is already in a buffer. >>                     32330000
                                                                        32332000
   IF (ldev'index'to'ldev (ldev'index) = ldev'of'map'in'buffer) AND     32334000
   (page = page'of'map'in'buffer) THEN                                  32336000
                                                                        32338000
      RETURN;  << Already there >>                                      32340000
                                                                        32342000
   << If it is not in the buffer, we must read it in, but first,        32344000
      if it is known that there are any bad pages, then we must         32346000
      check the descriptor table to see if the page is bad.    >>       32348000
                                                                        32350000
   IF dfs'map'problems (ldev'index) > 0 THEN                            32352000
      IF NOT Check'Dt'Entry (ldev'index , page)                         32354000
      THEN                                                              32356000
         BEGIN   << Page is bad >>                                      32358000
                                                                        32360000
            cc := ccl;                                                  32362000
            RETURN;                                                     32364000
                                                                        32366000
         END;    << Page is bad >>                                      32368000
                                                                        32370000
   add'of'map'page'in'buffer := DOUBLE(page) +                          32372000
         bit'map'disc'address (ldev'index);                             32374000
                                                                        32376000
   Disc (0, ldev'index'to'ldev(ldev'index), add'of'map'page'in'buffer,  32378000
         bit'map'buffer, actual'words'per'page);                        32380000
                                                                        32382000
   << Verfiy checksum, if its bad, return nasty status >>               32384000
                                                                        32386000
   check'sum := bit'map'buffer (check'sum'word);                        32388000
   bit'map'buffer (check'sum'word) := 0;                                32390000
                                                                        32392000
   IF Make'Check'Sum (bit'map'buffer, actual'words'per'page) <>         32394000
   check'sum THEN                                                       32396000
      BEGIN   << Checksum is bad >>                                     32398000
                                                                        32400000
         << Mark buffer as empty >>                                     32402000
                                                                        32404000
         ldev'of'map'in'buffer := -1;                                   32406000
                                                                        32408000
         cc := ccl;  << Return status >>                                32410000
         RETURN;                                                        32412000
                                                                        32414000
      END;    << Checksum is bad >>                                     32416000
                                                                        32418000
   << Remember which page is in the buffer >>                           32420000
                                                                        32422000
   ldev'of'map'in'buffer := ldev'index'to'ldev (ldev'index);            32424000
   page'of'map'in'buffer := page;                                       32426000
                                                                        32428000
END;   << Get'Page >>                                                   32430000
$PAGE "SET'RESET'BIT'MAP"                                               32432000
PROCEDURE Set'Reset'Bit'Map (ldev'index, page'number,          <<03551>>32434000
                             word'number, bit'number,                   32436000
                             number'of'bits, set'bits);                 32438000
   VALUE ldev'index, page'number, word'number, bit'number,              32440000
         number'of'bits, set'bits;                                      32442000
   INTEGER ldev'index;                                                  32444000
   INTEGER page'number;                                                 32446000
   INTEGER word'number;                                                 32448000
   INTEGER bit'number;                                                  32450000
   DOUBLE number'of'bits;                                               32452000
   LOGICAL set'bits;                                                    32454000
   OPTION PRIVILEGED,UNCALLABLE;                                        32456000
                                                                        32458000
<<==============================================================        32460000
                                                                        32462000
      This procedure turns on or off a continuous set of bits           32464000
   in the map.  The block of bits starts at  the  page,  word           32466000
   and  bit  number  passed  to the procedure.  The pages are           32468000
   always written out after we have  processed  them.   If  a           32470000
   Get'Page  error occures while returning space, the page is           32472000
   just skiped.  If a Get'Page error  occures  while  getting           32474000
   space, the procedure is exited, returning a nasty status.            32476000
                                                                        32478000
   Parameters:                                                          32480000
      ldev'index - index for ldev of disc. (see                         32482000
                   ldev'index'to'ldev array)                            32484000
      page'number - number of page where block of bits                  32486000
                    starts.                                             32488000
      word'number - number of word in page where block of               32490000
                    bits starts.                                        32492000
      bit'number - number of bit in word where block starts.            32494000
      number'of'bits - number of bits to set/reset.                     32496000
      set'bits - TRUE to set bits,(i.e. returning space),               32498000
                 FALSE to reset bits, (i.e. getting space).             32500000
                                                                        32502000
   Returns:                                                             32504000
      condition code = CCE if alls o.k.                                 32506000
                       CCL if error from Get'Page.                      32508000
                                                                        32510000
   Assumptions on entry:                                                32512000
      DB must be at the stack.                                          32514000
                                                                        32516000
   Exit conditions:                                                     32518000
      DB is unchanged.                                                  32520000
                                                                        32522000
   Globals:                                                             32524000
                                                                        32526000
      Others:                                                           32528000
         last'page'of'map                                               32530000
         ds'page'ptr                                                    32532000
                                                                        32534000
      Equates:                                                          32536000
         max'disc'drives                                                32538000
         m325                                                           32540000
         words'per'page                                                 32542000
         bits'per'word                                                  32544000
         ccl                                                            32546000
         cce                                                            32548000
                                                                        32550000
      Defines:                                                          32552000
         DBL                                                            32554000
         cc                                                             32556000
                                                                        32558000
   Externals:                                                           32560000
      Errmessage                                                        32562000
      Get'Page                                                          32564000
      Write'Page                                                        32566000
                                                                        32568000
   Intrinsics:                                                          32570000
      None.                                                             32572000
                                                                        32574000
   Callers:                                                             32576000
      Get'Disc'Space                                                    32578000
      Return'Disc'Space                                                 32580000
      Get'Specific'Disc'Space                                           32582000
                                                                        32584000
   Fix ID:                                                              32586000
         This procedure was added as part of the new disc               32588000
      free space map changes.  The fix number on the                    32590000
      procedure header applies to the whole procedure.                  32592000
                                                                        32594000
   Changes:                                                             32596000
                                                                        32598000
                                                                        32600000
==============================================================>>        32602000
                                                                        32604000
BEGIN                                                                   32606000
                                                                        32608000
   LOGICAL set'pattern;   << a whole word of the value to  >>           32610000
                          << set the bits to. i.e. all     >>           32612000
                          << ones if set'bits = TRUE else  >>           32614000
                          << all zeros if set'bits = FALSE >>           32616000
                                                                        32618000
   LOGICAL test'pattern;  << inverse of set'pattern, used  >>           32620000
                          << to test if the bits are in    >>           32622000
                          << the correct state before      >>           32624000
                          << changing.                     >>           32626000
                                                                        32628000
   LOGICAL current'word;                                                32630000
   LOGICAL mask;          << for masking out partial words >>           32632000
   INTEGER bits'in'word;  << bits to set/reset in current word >>       32634000
                                                                        32636000
   << - - - - - - - - - - >>                                            32638000
                                                                        32640000
   << Do some error checking >>                                         32642000
                                                                        32644000
   IF NOT(0 <= ldev'index <= max'disc'drives - 1) THEN                  32646000
      ERRMESSAGE (M325,2);                                     <<03632>>32648000
   IF NOT(0 <= page'number <= last'page'of'map (ldev'index)) THEN       32650000
      ERRMESSAGE (M325,3);                                     <<03632>>32652000
   IF NOT(0 <= word'number <= words'per'page - 1) THEN                  32654000
      ERRMESSAGE (M325,4);                                     <<03632>>32656000
   IF NOT(0 <= bit'number <= bits'per'word - 1) THEN                    32658000
      ERRMESSAGE (M325,5);                                     <<03632>>32660000
                                                                        32662000
                                                                        32664000
   cc := cce;   << Preset o.k. status >>                                32666000
                                                                        32668000
                                                                        32670000
   << Assign patterns for test and changing bits according to           32672000
      whether this a a call to allocate or deallocate space.  >>        32674000
                                                                        32676000
   set'pattern := IF set'bits THEN %177777 ELSE 0;                      32678000
   test'pattern := NOT set'pattern;                                     32680000
                                                                        32682000
                                                                        32684000
   << scan through map, until all bits have been set/reset >>           32686000
                                                                        32688000
   WHILE page'number <= last'page'of'map (ldev'index) DO                32690000
      BEGIN  << scan map >>                                             32692000
                                                                        32694000
         << Read page into buffer >>                                    32696000
                                                                        32698000
         Get'Page (ldev'index, page'number);                            32700000
                                                                        32702000
         IF <> THEN                                                     32704000
            BEGIN  << error getting page >>                             32706000
                                                                        32708000
               << If we are returning space, then the error             32710000
                  doesn't matter, we can just skip this page.           32712000
                  IF getting space, the we must exit the procedure      32714000
                  and allow calling routines to handle the error >>     32716000
                                                                        32718000
               IF set'bits THEN                                         32720000
                  BEGIN  << returning space >>                          32722000
                                                                        32724000
                     number'of'bits := number'of'bits -                 32726000
                           DBL(bits'per'page);                          32728000
                     IF number'of'bits <= 0D THEN                       32730000
                         RETURN;                                        32732000
                                                                        32734000
                  END    << returning space >>                          32736000
               ELSE                                                     32738000
                                                                        32740000
                  BEGIN  << Getting space >>                            32742000
                                                                        32744000
                     cc := ccl;  << Return error status >>              32746000
                     RETURN;                                            32748000
                                                                        32750000
                  END    << Getting space >>                            32752000
                                                                        32754000
            END    << error getting page >>                             32756000
         ELSE                                                           32758000
            BEGIN  << No error >>                                       32760000
                                                                        32762000
               WHILE word'number < words'per'page DO                    32764000
                  BEGIN << scan page >>                                 32766000
                                                                        32768000
                     current'word := ds'page'ptr (word'number);         32770000
                                                                        32772000
                     << build mask for current word >>                  32774000
                                                                        32776000
                     mask := %100000;                                   32778000
                                                                        32780000
                     IF number'of'bits < DBL(16 - bit'number) THEN      32782000
                                                                        32784000
                        << all bits needed are in current word >>       32786000
                                                                        32788000
                        bits'in'word := INTEGER(number'of'bits) - 1     32790000
                                                                        32792000
                     ELSE                                               32794000
                                                                        32796000
                        << All bits not in current word >>              32798000
                                                                        32800000
                        bits'in'word := 15 - bit'number;                32802000
                                                                        32804000
                                                                        32806000
                     << Build mask for this word. >>                    32808000
                                                                        32810000
                     TOS := mask&ASR(bits'in'word);                     32812000
                     mask := TOS&LSR(bit'number);                       32814000
                                                                        32816000
                                                                        32818000
                     << Test if bits are currently in expected          32820000
                        state.                                 >>       32822000
                                                                        32824000
                     IF NOT ((current'word LAND mask) =                 32826000
                     (test'pattern LAND mask)) THEN                     32828000
                        BEGIN  << Bits not in correct state >>          32830000
                                                                        32832000
                           IF (set'bits LAND                   <<04841>>32834000
                               NOT ((current'word LAND mask)   <<04841>>32836000
                                   = (set'pattern LAND mask))) <<04841>>32838000
                           OR NOT set'bits THEN                <<04841>>32840000
                                                               <<04841>>32842000
                           << if releasing space that was   >> <<04841>>32844000
                           << already PARTIALLY released,   >> <<04841>>32846000
                           << or if getting space that has  >> <<04841>>32848000
                           << already been taken, then HALT >> <<04841>>32850000
                                                               <<04841>>32852000
                              ERRMESSAGE (M325,6);             <<04841>>32854000
                                                                        32856000
                                                                        32858000
                        END;   << Bits not in correct state >>          32860000
                                                                        32862000
                     << if we are returning space that was   >><<04841>>32864000
                     << already COMPLETELY released (ie. a   >><<04841>>32866000
                     << contiguous block), we ignore this    >><<04841>>32868000
                     << situation above and proceed normally >><<04841>>32870000
                                                                        32872000
                     << Set or reset bits in the word. >>               32874000
                                                                        32876000
                     ds'page'ptr(word'number) :=                        32878000
                           (set'pattern LAND mask) LOR                  32880000
                           (current'word LAND NOT mask);                32882000
                                                                        32884000
                     number'of'bits := number'of'bits -                 32886000
                           DBL(bits'in'word + 1);                       32888000
                                                                        32890000
                     << Exit procedure if all bits are set/reset. >>    32892000
                                                                        32894000
                     IF number'of'bits < 0D THEN   << Error check >>    32896000
                        ERRMESSAGE (M325,7);                   <<03632>>32898000
                                                                        32900000
                     IF number'of'bits = 0D THEN                        32902000
                        BEGIN << All done >>                            32904000
                                                                        32906000
                           Write'Page;                                  32908000
                                                                        32910000
                           RETURN;                                      32912000
                                                                        32914000
                        END;   << All done >>                           32916000
                                                                        32918000
                     word'number := word'number + 1;                    32920000
                     bit'number := 0;                                   32922000
                                                                        32924000
                  END;  << scan page >>                                 32926000
                                                                        32928000
                                                                        32930000
               << Write out page >>                                     32932000
                                                                        32934000
               Write'Page;                                              32936000
                                                                        32938000
               page'number := page'number + 1;                          32940000
                                                                        32942000
               word'number := 0;                                        32944000
               bit'number := 0;                                         32946000
                                                                        32948000
            END;   << not I/O error >>                                  32950000
                                                                        32952000
      END;  << scan map >>                                              32954000
                                                                        32956000
                                                                        32958000
   << We should never make it here >>                                   32960000
                                                                        32962000
   ERRMESSAGE (M325,8);                                        <<03632>>32964000
                                                                        32966000
END;  << Set'Reset'Bit'Map >>                                           32968000
$PAGE "ACCESS'DFS'MAP"                                                  32970000
INTEGER PROCEDURE Access'Dfs'Map (ldev);                       <<03551>>32972000
   VALUE ldev;                                                          32974000
   INTEGER ldev;                                                        32976000
                                                                        32978000
<<==============================================================        32980000
                                                                        32982000
      This procedure is use to gain access to the free space            32984000
   map for a particular disc ldev.  It will return an                   32986000
   "ldev-index" , which is use to get the entrys from the               32988000
   various arrays for this ldev. First the                              32990000
   "ldev'index'to'ldev" table is scaned to see if the ldev's            32992000
   free space map has previously been accessed, if the ldev             32994000
   is found, then "dfs'map'problems" is checked to see if the           32996000
   map is o.k. If it is alright, the index is returned and              32998000
   the condition code is set to CCE, if it has been damaged,            33000000
   a condition coide of CCL is returned.                                33002000
                                                                        33004000
      If the map for this ldev has not been previously ac-              33006000
   cessed, then an entry is made in the "ldev'index'to'ldev"            33008000
   table and the disc label is gotten.  The various array               33010000
   entries associated with the map are initialized. A check             33012000
   is made to see if this is a old free space map format                33014000
   pack, if it is, a message is sent to the console and                 33016000
   INITIAL is halted.  The disc label is also checked to see            33018000
   if the map has been flaged as damaged, if it has a non-              33020000
   fatal message is sent to the operator, "dfs'map'problems"            33022000
   entry for the ldev is marked  and the procedure returns a            33024000
   condition code of CCL. The descriptor table is flaged as             33026000
   dirty in the disc label, so that the descriptor table will           33028000
   be rebuilt when the system comes up.    If the map was ok,           33030000
   then the descriptor table is scanned to see if there are             33032000
   any bad pages.  If there are, then "dfs'map'problems" is             33034000
   set to indicate the fact that the descriptor table will              33036000
   have to be checked each time a page is read.  The pro-               33038000
   cedure then returns the index for the ldev and a condition           33040000
   code of CCE.                                                         33042000
                                                                        33044000
                                                                        33046000
   Parameters:                                                          33048000
      ldev - logical device number of disc drive.                       33050000
                                                                        33052000
   Returns:                                                             33054000
         Index for the ldev, this is used to access the entry           33056000
      for this ldev in the various arrays associated with               33058000
      disc free space management.                                       33060000
                                                                        33062000
      condition code = CCE if alls ok,                                  33064000
                       CCL if the bit map has been flaged as            33066000
                       damaged and space can not be                     33068000
                       allocated.                                       33070000
                                                                        33072000
   Assumptions on entry:                                                33074000
      DB must be at the stack.                                          33076000
                                                                        33078000
   Exit conditions:                                                     33080000
      DB is unchanged.                                                  33082000
                                                                        33084000
   Globals:                                                             33086000
                                                                        33088000
      Input:                                                            33090000
         ldev'index'to'ldev - an entry may be added.                    33092000
                                                                        33094000
      Output:                                                           33096000
         dfs'map'problems                                               33098000
         bit'map'disc'address                                           33100000
         disc'size                                                      33102000
         last'page'of'map                                               33104000
         dt'disc'address                                                33106000
         first'page'with'space                                          33108000
         size'of'last'allocation                                        33110000
                                                                        33112000
      Others:                                                           33114000
         dtt                                                            33116000
         lpdt                                                           33118000
                                                                        33120000
      Equates:                                                          33122000
         max'disc'drives                                                33124000
         m331                                                           33126000
         m332                                                           33128000
         m325                                                           33130000
         lpdtsize                                                       33132000
         lpdt1                                                          33134000
         sector'size                                                    33136000
         disc'lab'dfs'map'ok {INCDISC1}                                 33138000
         disc'lab'dirty'dt'flag {INCDISC1}                              33140000
                                                                        33142000
     Defines:                                                           33144000
        nsdv                                                            33146000
        disc'label'address {INCDISC1}                                   33148000
                                                                        33150000
   Externals:                                                           33152000
      Get'Disc'Info                                                     33154000
      Errmessage                                                        33156000
      Message                                                           33158000
      Disc                                                              33160000
      Check'Dt'Entry                                                    33162000
                                                                        33164000
   Intrinsics:                                                          33166000
      None.                                                             33168000
                                                                        33170000
   Callers:                                                             33172000
      Get'Disc'Space                                                    33174000
      Return'Disc'Space                                                 33176000
      Get'Specific'Disc'Space                                           33178000
      Init'Disc'Free'Space'Map                                          33180000
                                                                        33182000
   Fix ID:                                                              33184000
         This procedure was added as part of the new disc               33186000
      free space map changes.  The fix number on the                    33188000
      procedure header applies to the whole procedure.                  33190000
                                                                        33192000
   Changes:                                                             33194000
                                                                        33196000
                                                                        33198000
==============================================================>>        33200000
                                                                        33202000
BEGIN                                                                   33204000
                                                                        33206000
   INTEGER index;                                                       33208000
   INTEGER empty'entry;                                                 33210000
   INTEGER page;                                                        33212000
                                                                        33214000
   LOGICAL found;                                                       33216000
                                                                        33218000
   ARRAY disc'label (0:sector'size-1);                                  33220000
                                                                        33222000
   INTEGER return'value = Access'Dfs'Map;                               33224000
                                                                        33226000
$INCLUDE INCDISC1                                                       33228000
                                                                        33230000
   << - - - - - - - - - - >>                                            33232000
                                                                        33234000
   << Make sure that the disc is in the system domain, if it is         33236000
      not, HALT with a nasty message.                            >>     33238000
                                                                        33240000
   IF lpdt((ldev * lpdtsize) + lpdt1).nsdv = 1 THEN                     33242000
      ERRMESSAGE (M325,9);                                     <<03632>>33244000
                                                                        33246000
   << Scan "ldev'index'to'ldev" table to see if the free space map      33248000
      has already been accessed.                                  >>    33250000
                                                                        33252000
   index := 0;                                                          33254000
   empty'entry := -1;                                                   33256000
   found := FALSE;                                                      33258000
                                                                        33260000
   WHILE (index < max'disc'drives) AND NOT found DO                     33262000
      BEGIN  << Scan for ldev >>                                        33264000
                                                                        33266000
         IF ldev'index'to'ldev (index) = ldev THEN                      33268000
            found := TRUE                                               33270000
         ELSE                                                           33272000
            BEGIN  << Not the ldev we are looking for >>                33274000
                                                                        33276000
               IF ldev'index'to'ldev (index) < 0 AND                    33278000
               empty'entry < 0 THEN                                     33280000
                  empty'entry := index;                                 33282000
                                                                        33284000
               index := index + 1;                                      33286000
                                                                        33288000
            END;   << Not the ldev we are looking for >>                33290000
                                                                        33292000
                                                                        33294000
      END;   << Scan for ldev >>                                        33296000
                                                                        33298000
   << If found is TRUE then the ldev is in the table and index is       33300000
      the dfs'index for the ldev, otherwise index is the index of       33302000
      the next empty entry.                                        >>   33304000
                                                                        33306000
    IF found THEN                                                       33308000
       BEGIN  << Has been previously accessed >>                        33310000
                                                                        33312000
          << Check to see that the map was ok >>                        33314000
                                                                        33316000
           IF dfs'map'problems (index) >= 0 THEN                        33318000
              BEGIN  << Map ok >>                                       33320000
                                                                        33322000
                 return'value := index;                                 33324000
                 cc := cce;                                             33326000
                                                                        33328000
              END    << Map ok >>                                       33330000
          ELSE                                                          33332000
                                                                        33334000
             << Map is not ok >>                                        33336000
                                                                        33338000
             cc := ccl;                                                 33340000
                                                                        33342000
       END    << Has been previously accessed >>                        33344000
    ELSE                                                                33346000
       BEGIN  << First access >>                                        33348000
                                                                        33350000
          index := empty'entry;                                         33352000
          ldev'index'to'ldev (index) := ldev;                           33354000
                                                                        33356000
          << Retrieve a whole shitload of info about the disc,          33358000
             including the disc label.                         >>       33360000
                                                                        33362000
          Get'Disc'Info (ldev, disc'label, TRUE, dtt,  ,  ,             33364000
                disc'size (index), bit'map'disc'address (index),        33366000
                last'page'of'map (index), dt'disc'address (index));     33368000
                                                                        33370000
          last'page'of'map (index) := last'page'of'map (index) - 1;     33372000
                                                                        33374000
                                                                        33376000
          << Check to see if this is an old format system disc,         33378000
             if so, halt with nasty message.                    >>      33380000
                                                                        33382000
          IF bit'map'disc'address (index) = 0D OR                       33384000
          dt'disc'address (index) = 0D THEN                             33386000
             Errmessage (m331, ldev);                                   33388000
                                                                        33390000
          << Check if bit map has been flaged as bad, if it has         33392000
             remember it and return, if its ok remember that            33394000
             fact.                                               >>     33396000
                                                                        33398000
          IF NOT disc'label (disc'lab'dfs'map'ok) THEN                  33400000
             BEGIN  << Map is damaged >>                                33402000
                                                                        33404000
                Message (m332, ldev);                                   33406000
                                                                        33408000
                dfs'map'problems (index) := -1;                         33410000
                                                                        33412000
                cc := ccl;                                              33414000
                RETURN;                                                 33416000
                                                                        33418000
             END    << Map is damaged >>                                33420000
                                                                        33422000
          ELSE                                                          33424000
                                                                        33426000
             << Map ok >>                                               33428000
                                                                        33430000
             dfs'map'problems (index) := 0;                             33432000
                                                                        33434000
          << Flag descriptor table as dirty >>                          33436000
                                                                        33438000
          disc'label (disc'lab'dirty'dt'flag) := TRUE;                  33440000
                                                                        33442000
          Disc (1, ldev, disc'label'address, disc'label, sector'size);  33444000
                                                                        33446000
                                                                        33448000
         << Scan descriptor table to see if there are any               33450000
            bad pages.  If they are, we will have to look               33452000
            at the descriptor table every time we get a page. >>        33454000
                                                                        33456000
         dfs'map'problems (index) := 0;                                 33458000
         page := 0;                                                     33460000
                                                                        33462000
         WHILE (page <= last'page'of'map) AND                           33464000
         dfs'map'problems (index) = 0 DO                                33466000
            BEGIN  << Check for any bad pages >>                        33468000
                                                                        33470000
               IF NOT Check'Dt'Entry (index, page) THEN                 33472000
                  dfs'map'problems (index) := 1;                        33474000
                                                                        33476000
               page := page + 1;                                        33478000
                                                                        33480000
            END;   << Check for any bad pages >>                        33482000
                                                                        33484000
                                                                        33486000
                                                                        33488000
          << Init indicators that are used help find space >>           33490000
                                                                        33492000
          first'page'with'space (index) := -1;  << Only for reload >>   33494000
          size'of'last'allocation (index) := disc'size (index);         33496000
                                                                        33498000
          cc := cce;                                                    33500000
          return'value := index;                                        33502000
                                                                        33504000
       END;   << First access >>                                        33506000
                                                                        33508000
END;  << Access'Dfs'Map >>                                              33510000
$PAGE "GET'DISC'SPACE"                                                  33512000
INTEGER PROCEDURE Get'Disc'Space (ldev, number'of'sectors,     <<03551>>33514000
                                  disc'address);                        33516000
   VALUE ldev, number'of'sectors;                                       33518000
   INTEGER ldev;                                                        33520000
   DOUBLE number'of'sectors;                                            33522000
   DOUBLE disc'address;                                                 33524000
   OPTION PRIVILEGED;                                                   33526000
                                                                        33528000
COMMENT =======================================================<<03765>>33530000
                                                                        33532000
      This procedure allocates space on a system disc.  First           33534000
   the free space map for that disc is "accessed" via                   33536000
   Access'Dfs'Map. The map is then scanned until the re-                33538000
   quested space is found or the end of the map is reached.             33540000
   The page of the map to start the scan with is decided on             33542000
   by a couple of indicators.  If the size being requested     <<03765>>33544000
   is greater than the size of the last space                  <<03765>>33546000
   allocated or returned on this disc, then the search is      <<03765>>33548000
   started on the last page we allocated space from.  Otherwise<<03765>>33550000
   if "first'page'with'space" is greater or equal to 0, then it<<03765>>33552000
   indicates the first page which has any space on it. (This   <<03765>>33554000
   indicator is only used for reloads, and is only good if     <<03765>>33556000
   space has not been allocated in a specific place.)  If      <<03765>>33558000
   neither of these indicators                                 <<03765>>33560000
   prove usefull, then the search starts at page zero.  If              33562000
   space is found, then "Set'Reset'Bit'Map" is called to re-            33564000
   move it from the map.                                                33566000
                                                                        33568000
   Parameters:                                                          33570000
      ldev - logical device number of disc drive.                       33572000
      number'of'sectors - number of sectors to allocate.                33574000
      disc'address - for the return of disc sector address if           33576000
                     space is found.                                    33578000
                                                                        33580000
   Returns:                                                             33582000
      0 = o.k., space allocated.                                        33584000
      1 = No space available.                                           33586000
      2 = Error from Set'Reset'Bit'Map.                                 33588000
      3 = Free space map can not be accessed.                           33590000
                                                                        33592000
   Assumptions on entry:                                                33594000
      DB is at the free space data segment for the ldev and             33596000
      the data segment is locked.                                       33598000
                                                                        33600000
   Exit conditions:                                                     33602000
      DB is unchanged.                                                  33604000
                                                                        33606000
   Globals:                                                             33608000
                                                                        33610000
      Input:                                                            33612000
         first'page'with'space - may be altered.                        33614000
         size'of'last'allocation - may be altered.                      33616000
         last'page'allocated'from - may be altered.                     33618000
                                                                        33620000
      Others:                                                           33622000
         ds'word'number - changed.                                      33624000
         ds'bit'number - changed.                                       33626000
         ds'starting'word'number - changed.                             33628000
         ds'starting'bit'number - changed.                              33630000
         ds'bit'count - changed.                                        33632000
         last'page'of'map                                               33634000
                                                                        33636000
   Externals:                                                           33638000
      Access'Dfs'Map                                                    33640000
      Get'Page                                                          33642000
      Scan'Page                                                         33644000
      Set'Reset'Bit'Map                                                 33646000
      Convert'Map'To'Address                                            33648000
                                                                        33650000
   Intrinsics:                                                          33652000
      None.                                                             33654000
                                                                        33656000
   Callers:                                                             33658000
      Getdiscspace                                                      33660000
      Superdiscspace                                                    33662000
                                                                        33664000
   Fix ID:                                                              33666000
         This procedure was added as part of the new disc               33668000
      free space map changes.  The fix number on the                    33670000
      procedure header applies to the whole procedure.                  33672000
                                                                        33674000
   Changes:                                                             33676000
      Change made to alogorithm that decides which page to     <<03765>>33678000
   start looking for space on.  Very slow reloads prompted     <<03765>>33680000
   this change.  The real cause of slow reloads was that the   <<03765>>33682000
   index into the array first'page'with'space was accidently   <<03765>>33684000
   omitted  when resetting the indicators at the end of this   <<03765>>33686000
   procedure.                                                  <<03765>>33688000
                                                                        33690000
==============================================================;<<03765>>33692000
                                                                        33694000
BEGIN                                                                   33696000
                                                                        33698000
   DOUBLE continuous'space;                                             33700000
   LOGICAL found;                                                       33702000
   LOGICAL end'of'page;                                                 33704000
   INTEGER starting'page'number;                                        33706000
   INTEGER starting'word'number;                                        33708000
   INTEGER starting'bit'number;                                         33710000
   INTEGER ldev'index;                                                  33712000
                                                                        33714000
   INTEGER return'value = Get'Disc'Space;                               33716000
                                                                        33718000
   << - - - - - - - - - - >>                                            33720000
                                                                        33722000
                                                                        33724000
   << First access map, setting all important globals >>                33726000
                                                                        33728000
   ldev'index := Access'Dfs'Map (ldev);                                 33730000
                                                                        33732000
   IF <> THEN                                                           33734000
      BEGIN  << Can not access this map >>                              33736000
                                                                        33738000
         return'value := 3;                                             33740000
         RETURN;                                                        33742000
                                                                        33744000
      END;   << Can not access this map >>                              33746000
                                                                        33748000
COMMENT:                                                       <<03765>>33752000
      Decide which page to start looking for space on.  Use    <<03765>>33754000
      last'page'allocated'from if number'of'sectors >=         <<03765>>33756000
      size'of'last'allocation, otherwise use                   <<03765>>33758000
      first'page'with'space if it is >= 0, otherwise start at  <<03765>>33760000
      first page of map.                                       <<03765>>33762000
      ;                                                        <<03765>>33764000
                                                                        33766000
   ds'word'number := 0;                                                 33768000
   ds'bit'number := 0;                                                  33770000
                                                                        33772000
   IF number'of'sectors >= size'of'last'allocation (ldev'index)<<03765>>33776000
   THEN                                                        <<03765>>33778000
      ds'page'number := last'page'allocated'from (ldev'index)  <<03765>>33780000
   ELSE                                                        <<03765>>33782000
      IF first'page'with'space (ldev'index) >= 0               <<03765>>33784000
      THEN                                                     <<03765>>33786000
         ds'page'number := first'page'with'space (ldev'index)  <<03765>>33788000
      ELSE                                                     <<03765>>33790000
         ds'page'number := 0;                                  <<03765>>33792000
                                                                        33794000
   << Look for space >>                                                 33796000
                                                                        33798000
   continuous'space := 0D;                                              33800000
   found := FALSE;                                                      33802000
                                                                        33804000
   WHILE ds'page'number <= last'page'of'map (ldev'index) AND            33806000
   NOT found DO                                                         33808000
      BEGIN  << Scan map >>                                             33810000
                                                                        33812000
         Get'Page (ldev'index, ds'page'number);                         33814000
                                                                        33816000
         IF <> THEN                                                     33818000
                                                                        33820000
            << Can't get page, reset counter >>                         33822000
                                                                        33824000
            continuous'space := 0D                                      33826000
                                                                        33828000
         ELSE                                                           33830000
            BEGIN   << Got page >>                                      33832000
                                                                        33834000
               << Scan the page >>                                      33836000
                                                                        33838000
               DO                                                       33840000
                  BEGIN  << Scan page >>                                33842000
                                                                        33844000
                     end'of'page := Scan'Page;                          33846000
                                                                        33848000
                     IF continuous'space = 0D OR               <<04396>>33850000
                        ds'starting'word'number > 0 OR         <<04396>>33852000
                        ds'starting'bit'number > 0  THEN       <<04396>>33854000
                        BEGIN  << Start of a block >>                   33856000
                                                                        33858000
                           starting'page'number := ds'page'number;      33860000
                           starting'word'number :=                      33862000
                                 ds'starting'word'number;               33864000
                           starting'bit'number :=                       33866000
                                 ds'starting'bit'number;                33868000
                           continuous'space := 0D;             <<04396>>33870000
                                                                        33872000
                        END;   << Start of a block >>                   33874000
                                                                        33876000
                     continuous'space := continuous'space +             33878000
                           DOUBLE(ds'bit'count);                        33880000
                                                                        33882000
                     IF continuous'space >= number'of'sectors THEN      33884000
                        found := TRUE                                   33886000
                     ELSE                                               33888000
                        IF NOT end'of'page OR (end'of'page LAND         33890000
                        ds'bit'count = 0) THEN                          33892000
                                                                        33894000
                           << End of a block >>                         33896000
                                                                        33898000
                           continuous'space := 0D;                      33900000
                                                                        33902000
                  END   << Scan page >>                                 33904000
                                                                        33906000
               UNTIL found OR end'of'page;                              33908000
                                                                        33910000
            END;    << Got page >>                                      33912000
                                                                        33914000
         << Go on to next page >>                                       33916000
                                                                        33918000
         ds'page'number := ds'page'number + 1;                          33920000
         ds'word'number := 0;                                           33922000
         ds'bit'number := 0;                                            33924000
                                                                        33926000
      END;   << Scan map >>                                             33928000
                                                                        33930000
                                                                        33932000
   << At this point, if found is TRUE we have space >>                  33934000
                                                                        33936000
   IF NOT found THEN                                                    33938000
      return'value := 1  << No space available >>                       33940000
                                                                        33942000
   ELSE                                                                 33944000
      BEGIN  << Found space >>                                          33946000
                                                                        33948000
         << Mark in bit map >>                                          33950000
                                                                        33952000
         Set'Reset'Bit'Map (ldev'index, starting'page'number,           33954000
               starting'word'number, starting'bit'number,               33956000
               number'of'sectors, FALSE);                               33958000
                                                                        33960000
         IF <> THEN                                                     33962000
            << Error >>                                                 33964000
            return'value := 2                                           33966000
         ELSE                                                           33968000
            BEGIN  << ok >>                                             33970000
                                                                        33972000
               << Convert bit map address to sector address and         33974000
                  return to caller.                             >>      33976000
                                                                        33978000
               ds'page'number := starting'page'number;                  33980000
               ds'word'number := starting'word'number;                  33982000
               ds'bit'number := starting'bit'number;                    33984000
                                                                        33986000
               disc'address := Convert'Map'To'Address;                  33988000
                                                                        33990000
                                                                        33992000
               << Reset indicators >>                                   33994000
                                                                        33996000
               IF first'page'with'space (ldev'index) >= 0 THEN          33998000
FIRST'PAGE'WITH'SPACE(LDEV'INDEX):=DS'PAGE'NUMBER;             <<03765>>34000000
                                                                        34002000
               last'page'allocated'from (ldev'index) :=                 34004000
                     ds'page'number;                                    34006000
               size'of'last'allocation (ldev'index) :=                  34008000
                     number'of'sectors;                                 34010000
                                                                        34012000
               << Return got-it status >>                               34014000
                                                                        34016000
               return'value := 0;                                       34018000
                                                                        34020000
            END;   << ok >>                                             34022000
                                                                        34024000
      END;   << Found space >>                                          34026000
                                                                        34028000
END;  << Get'Disc'Space >>                                              34030000
$PAGE "RETURN'DISC'SPACE"                                               34032000
PROCEDURE Return'Disc'Space (ldev, disc'address,               <<03551>>34034000
                             number'of'sectors);                        34036000
   VALUE ldev, disc'address, number'of'sectors;                         34038000
   INTEGER ldev;                                                        34040000
   DOUBLE disc'address, number'of'sectors;                              34042000
                                                                        34044000
COMMENT =======================================================<<03776>>34046000
                                                                        34048000
      This procedure deallocates disc space and returnes it             34050000
   to the free space pool.  If any error occures, or the map            34052000
   can not be accessed, then the procedure just returns,                34054000
   looking as if it work.  The indicators used to help find             34056000
   space, "size'of'last'allocation" & "first'page'with'space"           34058000
   are ajusted if necessary and "Set'Reset'Bit'Map" is called           34060000
   to mark the space as free.                                           34062000
                                                                        34064000
   Parameters:                                                          34066000
      ldev - Logical device number of disc drive.                       34068000
      disc'address - First sector address of space to return.           34070000
      number'of'sectors - Number of sectors to return.                  34072000
                                                                        34074000
   Assumptions on entry:                                                34076000
      DB must be at the stack.                                          34078000
                                                                        34080000
   Exit conditions:                                                     34082000
      DB is unchanged.                                                  34084000
                                                                        34086000
                                                                        34088000
   Globals:                                                             34090000
                                                                        34092000
      Output:                                                           34094000
         size'of'last'allocation                                        34096000
         last'page'allocated'from                                       34098000
         first'page'with'space                                          34100000
                                                                        34102000
      Others:                                                           34104000
         ds'disc'address - altered.                                     34106000
         ds'page'number - altered.                                      34108000
         ds'word'number - altered.                                      34110000
         ds'bit'number - altered.                                       34112000
                                                                        34114000
   Externals:                                                           34116000
      Access'Dfs'Map                                                    34118000
      Convert'Address'To'Map                                            34120000
      Set'Reset'Bit'Map                                                 34122000
                                                                        34124000
   Intrinsics:                                                          34126000
      None.                                                             34128000
                                                                        34130000
   Callers:                                                             34132000
      Init'Disc'Free'Space'Map                                          34134000
      Retdiscspace                                                      34136000
      Vdevreplaced                                                      34138000
      Deletevdev                                                        34140000
      Mainseg2                                                          34142000
      Mainseg4                                                          34144000
                                                                        34146000
   Fix ID:                                                              34148000
         This procedure was added as part of the new disc               34150000
      free space map changes.  The fix number on the                    34152000
      procedure header applies to the whole procedure.                  34154000
                                                                        34156000
   Changes:                                                             34158000
         Made a fix so that the disc address used in "Convert' <<03776>>34160000
      Address'to'Map does not contain the vol number when      <<03776>>34162000
      calculating bit map addresses. (SR #28947)               <<03776>>34164000
==============================================================;<<03776>>34166000
                                                                        34168000
BEGIN                                                                   34170000
                                                                        34172000
   INTEGER ldev'index;                                                  34174000
   BYTE voln = disc'address;<<upper 8 bits contain vol num >>  <<03776>>34176000
                                                                        34178000
   << - - - - - - - - - - >>                                            34180000
                                                                        34182000
   ldev'index := Access'Dfs'Map (ldev);                                 34184000
   voln := 0; <<zero out vol num to correctly calc addresses>> <<03776>>34186000
                                                                        34188000
   IF <> THEN                                                           34190000
                                                                        34192000
      << Can't access, just return >>                                   34194000
                                                                        34196000
      RETURN;                                                           34198000
                                                                        34200000
   ds'disc'address := disc'address;                                     34202000
                                                                        34204000
   Convert'Address'To'Map;                                              34206000
                                                                        34208000
   << Before returning space, we must reset size of last allocation     34210000
      indicator and first page with space.                         >>   34212000
                                                                        34214000
   IF (number'of'sectors >= size'of'last'allocation (ldev'index)) AND   34216000
   (ds'page'number < last'page'allocated'from (ldev'index)) THEN        34218000
      BEGIN  << Reset last allocation indicator >>                      34220000
                                                                        34222000
         size'of'last'allocation (ldev'index) := number'of'sectors;     34224000
         last'page'allocated'from (ldev'index) := ds'page'number;       34226000
                                                                        34228000
      END;   << Reset last allocation indicator >>                      34230000
                                                                        34232000
   IF first'page'with'space (ldev'index) >= 0 AND                       34234000
   first'page'with'space (ldev'index) > ds'page'number THEN             34236000
      first'page'with'space (ldev'index) := ds'page'number;             34238000
                                                                        34240000
                                                                        34242000
   << Mark as free >>                                                   34244000
                                                                        34246000
   Set'Reset'Bit'Map (ldev'index, ds'page'number, ds'word'number,       34248000
       ds'bit'number, number'of'sectors, TRUE);                         34250000
                                                                        34252000
END;   << Return'Disc'Space >>                                          34254000
$PAGE "GET'SPECIFIC'DISC'SPACE"                                         34256000
INTEGER PROCEDURE Get'Specific'Disc'Space (ldev, disc'address, <<03551>>34258000
                                           number'of'sectors);          34260000
   VALUE ldev, disc'address, number'of'sectors;                         34262000
   INTEGER ldev;                                                        34264000
   DOUBLE disc'address, number'of'sectors;                              34266000
                                                                        34268000
<<==============================================================        34270000
                                                                        34272000
      This procedure allocates disc space in a specific place           34274000
   on a given ldev. After accessing the map, the specified              34276000
   area of the map is checked to see if the space is really             34278000
   free, if it is the space is then deleted from the map.               34280000
   The indicators "size'of'last'allcoation" and                         34282000
   "first'page'with'space" are reset, as they are nolonger              34284000
   meaningful after this allocation.                                    34286000
                                                                        34288000
   Parameters:                                                          34290000
      ldev - Logical device number of the disc drive.                   34292000
      disc'address - First sector address of the space                  34294000
                     desired.                                           34296000
      number'of'sectors - Number of sectors desired.                    34298000
                                                                        34300000
   Returns:                                                             34302000
      0 - Got the space.                                                34304000
      1 - Space not available.                                          34306000
      2 - Error from "Get'Page" or "Set'Reset'Bit'Map"                  34308000
      3 - Can't access map.                                             34310000
                                                                        34312000
   Assumptions on entry:                                                34314000
      DB is at the stack.                                               34316000
                                                                        34318000
   Exit conditions:                                                     34320000
      DB is unchanged.                                                  34322000
                                                                        34324000
   Globals:                                                             34326000
                                                                        34328000
      Output:                                                           34330000
         size'of'last'allcoation                                        34332000
         first'page'with'space                                          34334000
                                                                        34336000
      Others:                                                           34338000
         ds'disc'address - altered.                                     34340000
         ds'page'number - altered.                                      34342000
         ds'word'number - altered.                                      34344000
         ds'bit'number - altered.                                       34346000
         ds'bit'count - altered.                                        34348000
         ds'starting'word'number - altered.                             34350000
         ds'starting'bit'number - altered.                              34352000
         disc'size                                                      34354000
                                                                        34356000
   Externals:                                                           34358000
      Access'Dfs'Map                                                    34360000
      Convert'Address'To'Map                                            34362000
      Get'Page                                                          34364000
      Scan'Page                                                         34366000
      Set'Reset'Bit'Map                                                 34368000
                                                                        34370000
   Intrinsics:                                                          34372000
      None.                                                             34374000
                                                                        34376000
   Callers:                                                             34378000
      Init'Disc'Free'Space'Map                                          34380000
      Remdiscspace                                                      34382000
      Vdevreplace                                                       34384000
      Mainseg4                                                          34386000
                                                                        34388000
   Fix ID:                                                              34390000
         This procedure was added as part of the new disc               34392000
      free space map changes.  The fix number on the                    34394000
      procedure header applies to the whole procedure.                  34396000
                                                                        34398000
   Changes:                                                             34400000
                                                                        34402000
                                                                        34404000
==============================================================>>        34406000
                                                                        34408000
BEGIN                                                                   34410000
                                                                        34412000
   LOGICAL done;                                                        34414000
   LOGICAL end'of'page;                                                 34416000
   INTEGER ldev'index;                                                  34418000
   DOUBLE sector'count;                                                 34420000
                                                                        34422000
   INTEGER starting'page'number;                                        34424000
   INTEGER starting'word'number;                                        34426000
   INTEGER starting'bit'number;                                         34428000
                                                                        34430000
   INTEGER return'value = Get'Specific'Disc'Space;                      34432000
                                                                        34434000
   << - - - - - - - - - - >>                                            34436000
                                                                        34438000
   ldev'index := Access'Dfs'map (ldev);                                 34440000
                                                                        34442000
   IF <> THEN                                                           34444000
      BEGIN  << Free space disabled >>                                  34446000
                                                                        34448000
         return'value := 3;                                             34450000
         RETURN;                                                        34452000
                                                                        34454000
      END;   << Free space disabled >>                                  34456000
                                                                        34458000
                                                                        34460000
   sector'count := 0D;  << Used for counting available sectors >>       34462000
                                                                        34464000
   << Convert sector address to map address >>                          34466000
                                                                        34468000
   ds'disc'address := disc'address;                                     34470000
                                                                        34472000
   Convert'Address'To'Map;                                              34474000
                                                                        34476000
   << Remember where space starts >>                                    34478000
                                                                        34480000
   starting'page'number := ds'page'number;                              34482000
   starting'word'number := ds'word'number;                              34484000
   starting'bit'number := ds'bit'number;                                34486000
                                                                        34488000
   done := FALSE;   << Flag to indicate no more searching >>            34490000
                                                                        34492000
                                                                        34494000
   << Scan to see if space is all free >>                               34496000
                                                                        34498000
   WHILE NOT done DO                                                    34500000
      BEGIN  << Scan for space >>                                       34502000
                                                                        34504000
         << Get page into a buffer >>                                   34506000
                                                                        34508000
         Get'Page (ldev'index, ds'page'number);                         34510000
                                                                        34512000
         IF <> THEN                                                     34514000
            BEGIN  << Can't get page >>                                 34516000
                                                                        34518000
               return'value := 2;                                       34520000
               RETURN;                                                  34522000
                                                                        34524000
            END;   << Can't get page >>                                 34526000
                                                                        34528000
            << Scan the page. If enough space was found the search      34530000
               will end.  If no space was found, or the end of the      34532000
               page was not reached, then the search will end, as       34534000
               we have found a block of allocated space.  If space      34536000
               is found and it is the first page, we will make          34538000
               sure that the space really starts in the right spot,     34540000
               as Scan'Page would have skiped over any allocated        34542000
               space at the beginning of the block we are looking       34544000
               for.                                              >>     34546000
                                                                        34548000
            end'of'page := Scan'Page;                                   34550000
                                                                        34552000
            << Count space that was found >>                            34554000
                                                                        34556000
            sector'count := sector'count + DBL(ds'bit'count);           34558000
                                                                        34560000
            << If this is the first page of the block, make             34562000
               damn sure that the block really starts at the            34564000
               specified address.                          >>           34566000
                                                                        34568000
            IF (starting'page'number = ds'page'number) AND              34570000
            ((starting'word'number <> ds'starting'word'number)          34572000
            OR (starting'bit'number <> ds'starting'bit'number))         34574000
            THEN                                                        34576000
               BEGIN  << Not the space we are looking for >>            34578000
                                                                        34580000
                  done := TRUE;                                         34582000
                  sector'count := 0D;                                   34584000
                                                                        34586000
               END;   << Not the space we are looking for >>            34588000
                                                                        34590000
                                                                        34592000
            << If we have found enough space or found no space          34594000
               or did not reach the end of the page, then we            34596000
               are done scanning pages.                        >>       34598000
                                                                        34600000
            IF sector'count >= number'of'sectors OR                     34602000
            ds'bit'count = 0 OR NOT end'of'page THEN                    34604000
               done := TRUE;                                            34606000
                                                                        34608000
         <<DB MUST BE POINTING AT DFSDSTN                             >>34610000
                                                                        34612000
            ds'page'number := ds'page'number + 1;                       34614000
            ds'word'number := 0;                                        34616000
            ds'bit'number := 0;                                         34618000
                                                                        34620000
      END;   << Scan for space >>                                       34622000
                                                                        34624000
                                                                        34626000
   << If the space was not found return the appropriate status,         34628000
      otherwise, if its there, delete the space from the map   >>       34630000
                                                                        34632000
   IF sector'count < number'of'sectors THEN                             34634000
      return'value := 1                                                 34636000
                                                                        34638000
   ELSE                                                                 34640000
      BEGIN  << Delete space from map >>                                34642000
                                                                        34644000
         << Reset map address, as it was changed by the scan >>         34646000
                                                                        34648000
         Convert'Address'To'Map;                                        34650000
                                                                        34652000
         Set'Reset'Bit'Map (ldev'index, ds'page'number, ds'word'number  34654000
               , ds'bit'number, number'of'sectors, FALSE);              34656000
                                                                        34658000
         IF = THEN                                                      34660000
            return'value := 0   << Got the space >>                     34662000
                                                                        34664000
         ELSE                                                           34666000
            return'value := 2;  << Did not get it because an            34668000
                                      error occured.            >>      34670000
                                                                        34672000
      END;   << Delete space from map >>                                34674000
                                                                        34676000
                                                                        34678000
   << reset size of last allocation first page with space indicators    34680000
      as they are no longer meaningful.                             >>  34682000
                                                                        34684000
   size'of'last'allocation (ldev'index) := disc'size (ldev'index);      34686000
   first'page'with'space (ldev'index) := -1;                            34688000
                                                                        34690000
END;  << Get'Specific'Disc'Space >>                                     34692000
$PAGE "GET'DISC'DEFECT'ENTRY"                                           34694000
LOGICAL PROCEDURE Get'Disc'Defect'Entry (ldev, entry'counter,  <<03551>>34696000
                        starting'sector'address, length, entry'code);   34698000
   VALUE ldev;                                                          34700000
   INTEGER ldev;                                                        34702000
   INTEGER entry'counter;                                               34704000
   DOUBLE starting'sector'address;                                      34706000
   DOUBLE length;                                                       34708000
   INTEGER entry'code;                                                  34710000
                                                                        34712000
<<==============================================================        34714000
                                                                        34716000
      This procedure returns a entry from the defective                 34718000
   tracks or defective sectors tables for a disc.  Each call            34720000
   returns the next entry, so several calls will be needed to           34722000
   look at the entire table. A counter is passed to the pro-            34724000
   cedure which indicates how many entries have been re-                34726000
   turned.  The counter must be initialized to zero for the             34728000
   first in a series of calls for a particular ldev.  It is             34730000
   incremented for each call, and the series of calls must              34732000
   not be interupted by a call for another ldev.                        34734000
                                                                        34736000
   NOTE: Defective sectors have not been implemnted yet.....            34738000
                                                                        34740000
                                                                        34742000
   Parameters:                                                          34744000
      ldev - Logical device number of disc drive.                       34746000
      entry'counter - Counter of entries returned.  Must be             34748000
                      zero for the first call, and will be              34750000
                      incrementer by THIS procedure.                    34752000
      starting'sector'address - For return of first sector of           34754000
                                defective area.                         34756000
      length - For return of length, in sectors, of defective           34758000
               area.                                                    34760000
      Code - Integer code indicating the type of entry.                 34762000
             0 = Suspect                                                34764000
             1 = Suspect alternate                                      34766000
             2 = Deleted                                                34768000
             3 = Reassigned                                             34770000
             4 = Deleted alternate (this is a kludge that was added     34772000
                 so we don't try to take deleted alternates out of      34774000
                 the free space map.  There should be a entry in the    34776000
                 DTT to tell about such things, but we must test our    34778000
                 selves.)                                               34780000
                                                                        34782000
   Returns:                                                             34784000
      TRUE if an entry was returned.                                    34786000
      FALSE if no entry was return returned and there are no            34788000
            more entries.                                               34790000
                                                                        34792000
   Assumptions on entry:                                                34794000
      DB is at the stack.                                               34796000
                                                                        34798000
   Exit conditions:                                                     34800000
      DB is unchanged.                                                  34802000
                                                                        34804000
   Globals:                                                             34806000
                                                                        34808000
      Input:                                                            34810000
         dtt - This is initialized on the first call in a               34812000
         series of calls for a specific ldev, and must not be           34814000
         changed during the series.                                     34816000
                                                                        34818000
      Equates:                                                          34820000
         sector'size                                                    34822000
         dtt'number'of'entries {INCDISC1}                               34824000
         dtt'first'entry {INCDISC1}                                     34826000
                                                                        34828000
      Defines:                                                          34830000
         DBL                                                            34832000
         dtt'disc'address {INCDISC1}                                    34834000
         dtt'track'number {INCDISC1}                                    34836000
         dtt'track'code {INCDISC1}                                      34838000
                                                                        34840000
   Externals:                                                           34842000
      Get'Disc'Info                                                     34844000
      Disc                                                              34846000
                                                                        34848000
   Intrinsics:                                                          34850000
      None.                                                             34852000
                                                                        34854000
   Callers:                                                             34856000
      Check'If'On'Defect                                                34858000
      Init'Disc'Free'Space'Map                                          34860000
                                                                        34862000
   Fix ID:                                                              34864000
         This procedure was added as part of the new disc               34866000
      free space map changes.  The fix number on the                    34868000
      procedure header applies to the whole procedure.                  34870000
                                                                        34872000
   Changes:                                                             34874000
                                                                        34876000
                                                                        34878000
==============================================================>>        34880000
                                                                        34882000
BEGIN                                                                   34884000
                                                                        34886000
   INTEGER sectors'per'track;                                           34888000
                                                                        34890000
   DOUBLE logical'disc'size;                                            34892000
                                                                        34894000
   LOGICAL return'value = Get'Disc'Defect'Entry;                        34896000
                                                                        34898000
$INCLUDE INCDISC1                                                       34900000
                                                                        34902000
                                                                        34904000
   << - - - - - - - - - - >>                                            34906000
                                                                        34908000
   << Get logical disc size (sectors) & sectors'per'track >>            34910000
                                                                        34912000
   Get'Disc'Info (ldev,  ,  ,  ,  ,  , logical'disc'size,  ,  ,  ,  ,   34914000
                  ,  , sectors'per'track);                              34916000
                                                                        34918000
   << If this is the first call for this ldev, (i.e. entry'counter =    34920000
      zero), then read the DTT into a global buffer.                >>  34922000
                                                                        34924000
   IF entry'counter = 0 THEN                                            34926000
      Disc (0, ldev, dtt'disc'address, dtt, sector'size);               34928000
                                                                        34930000
                                                                        34932000
   << Compare entry'counter to the number of entries.  If               34934000
      none are left, set return status and exit.          >>            34936000
                                                                        34938000
   IF entry'counter = dtt (dtt'number'of'entries) THEN                  34940000
      BEGIN  << No more entries >>                                      34942000
                                                                        34944000
         return'value := FALSE;                                         34946000
         RETURN;                                                        34948000
                                                                        34950000
      END;   << No more entries >>                                      34952000
                                                                        34954000
   << Get info to return. >>                                            34956000
                                                                        34958000
   starting'sector'address := DBL(sectors'per'track) *                  34960000
      DBL(dtt (dtt'first'entry + entry'counter).dtt'track'number);      34962000
                                                                        34964000
   entry'code := dtt (dtt'first'entry + entry'counter).dtt'track'code;  34966000
                                                                        34968000
   << Check to see if this is a deleted alternate >>                    34970000
                                                                        34972000
   IF entry'code = dtt'deleted AND                                      34974000
   starting'sector'address >= logical'disc'size THEN                    34976000
      entry'code := 4;                                                  34978000
                                                                        34980000
                                                                        34982000
   length := DBL (sectors'per'track);                                   34984000
                                                                        34986000
                                                                        34988000
   << Increment counter and return got-it status >>                     34990000
                                                                        34992000
   entry'counter := entry'counter + 1;                                  34994000
   return'value := TRUE;                                                34996000
                                                                        34998000
END;  << Get'Disc'Defect'Entry >>                                       35000000
$PAGE "CHECK'IF'ON'DEFECT"                                              35002000
LOGICAL PROCEDURE Check'If'On'Defect (ldev, starting'address,  <<03551>>35004000
                                      length, reassigned'ok,            35006000
                                      next'possible'address);           35008000
   VALUE ldev, starting'address, length, reassigned'ok;                 35010000
   INTEGER ldev;                                                        35012000
   LOGICAL reassigned'ok;                                               35014000
   DOUBLE starting'address, length, next'possible'address;              35016000
   OPTION VARIABLE;                                                     35018000
                                                                        35020000
<<==============================================================        35022000
                                                                        35024000
      This procedure checks a specified continuous block of             35026000
   disc space to see if it is on any sort of defective area             35028000
   of the disc.  If it is on a defect, then the address fol-            35030000
   lowing the first defect that overlaps is returned.  This             35032000
   does not mean that the area could start at the returned              35034000
   address and not be on a defect.  Another call to this rou-           35036000
   tine is required to see if it is ok at the address.                  35038000
   For now, this routine does not check is an area on a cs'80           35040000
   disc is on a spared track, it just says ok.  Note, there             35042000
   can be no defective tracks on a cs'80 device.                        35044000
                                                                        35046000
                                                                        35048000
   Parameters:                                                          35050000
      ldev - Logical device number of disc drive.                       35052000
      starting'address - First sector address of block to               35054000
                         check.                                         35056000
      length - Length of block in sectors.                              35058000
      reassigned'ok - (optional) - If it is TRUE, then                  35060000
                      reassigned areas are considered o.k.,             35062000
                      if FALSE or omited, the reassigned                35064000
                      areas are considered defective and the            35066000
                      block will not be aproved if it over-             35068000
                      laps a reassigned area.                           35070000
      next'possible'address - First sector address of area              35072000
                              following the first overlaping            35074000
                              defect.                                   35076000
                                                                        35078000
   Returns:                                                             35080000
      TRUE - Area is nopt on a defect.                                  35082000
      FALSE - Area is on a defect.                                      35084000
                                                                        35086000
   Assumptions on entry:                                                35088000
      DB is at the stack.                                               35090000
                                                                        35092000
   Exit conditions:                                                     35094000
      DB is unchanged.                                                  35096000
                                                                        35098000
   Globals:                                                             35100000
                                                                        35102000
      Equates:                                                          35104000
         dtt'reassigned   {INCDISC1}                                    35106000
         cs'80'type  {INCDISC1}                                         35108000
                                                                        35110000
   Externals:                                                           35112000
      Ldevtotype                                                        35114000
                                                                        35116000
   Intrinsics:                                                          35118000
      Get'Disc'Defect'Entry                                             35120000
                                                                        35122000
   Callers:                                                             35124000
      Init'Disc'Free'Space'Map                                          35126000
                                                                        35128000
   Fix ID:                                                              35130000
         This procedure was added as part of the new disc               35132000
      free space map changes.  The fix number on the                    35134000
      procedure header applies to the whole procedure.                  35136000
                                                                        35138000
   Changes:                                                             35140000
                                                                        35142000
                                                                        35144000
==============================================================>>        35146000
                                                                        35148000
BEGIN                                                                   35150000
                                                                        35152000
   DOUBLE ending'address;                                               35154000
                                                                        35156000
   INTEGER defect'entry'counter;                                        35158000
   LOGICAL end'of'defect'table;                                         35160000
                                                                        35162000
   DOUBLE defect'starting'address;                                      35164000
   DOUBLE defect'ending'address;                                        35166000
   DOUBLE defect'length;                                                35168000
   INTEGER defect'code;                                                 35170000
                                                                        35172000
   LOGICAL pmap = Q-4;                                                  35174000
   DEFINE passed'reassigned'ok = pmap.(14:1)#,                          35176000
          passed'next'possible'address = pmap.(15:1)#;                  35178000
                                                                        35180000
   LOGICAL return'value = Check'If'On'Defect;                           35182000
                                                                        35184000
$INCLUDE INCDISC1                                                       35186000
                                                                        35188000
   << - - - - - - - - - - >>                                            35190000
                                                                        35192000
   IF Ldevtotype (ldev) = cs'80'type THEN                               35194000
      BEGIN  << cs'80'type >>                                           35196000
                                                                        35198000
         return'value := TRUE;                                          35200000
         RETURN;                                                        35202000
                                                                        35204000
      END;   << cs'80'type >>                                           35206000
                                                                        35208000
   IF NOT passed'reassigned'ok THEN                                     35210000
      reassigned'ok := FALSE;  << Default >>                            35212000
                                                                        35214000
                                                                        35216000
   << Calculate ending address of area to check >>                      35218000
                                                                        35220000
   ending'address := starting'address + length - 1D;                    35222000
                                                                        35224000
   return'value := TRUE;  << Preset to ok status >>                     35226000
                                                                        35228000
   << Set up counter of defective entries >>                            35230000
                                                                        35232000
   defect'entry'counter := 0;                                           35234000
                                                                        35236000
   DO                                                                   35238000
      BEGIN  << Scan defect table >>                                    35240000
                                                                        35242000
         end'of'defect'table :=                                         35244000
               NOT Get'Disc'Defect'Entry (ldev, defect'entry'counter,   35246000
                     defect'starting'address, defect'length,            35248000
                     defect'code);                                      35250000
                                                                        35252000
         IF (NOT end'of'defect'table) AND                               35254000
         ((NOT reassigned'ok LAND defect'code = dtt'reassigned) LOR     35256000
         (defect'code <> dtt'reassigned)) THEN                          35258000
            BEGIN  << Got a defect entry >>                             35260000
                                                                        35262000
               << Test if they overlap >>                               35264000
                                                                        35266000
               defect'ending'address := defect'starting'address +       35268000
                                        defect'length;                  35270000
                                                                        35272000
               IF                                                       35274000
               ((defect'ending'address >= starting'address) LAND        35276000
               (defect'starting'address <= ending'address)) OR          35278000
               ((defect'starting'address <= starting'address) LAND      35280000
               (defect'ending'address >= ending'address))               35282000
               THEN                                                     35284000
                  return'value := FALSE;   << Overlap >>                35286000
                                                                        35288000
                                                                        35290000
            END;   << Got a defect entry >>                             35292000
                                                                        35294000
      END    << Scan defect table >>                                    35296000
   UNTIL end'of'defect'table OR NOT return'value;                       35298000
                                                                        35300000
                                                                        35302000
   << If the space overlaps a defective area, then give back            35304000
      a address just past the end of the defective area.    >>          35306000
                                                                        35308000
   IF NOT return'value AND passed'next'possible'address THEN            35310000
      next'possible'address := defect'ending'address + 1D;              35312000
                                                                        35314000
END;  << Check'If'On'Defect >>                                          35316000
$PAGE "INIT'DISC'FREE'SPACE'MAP"                                        35318000
PROCEDURE Init'Disc'Free'Space'Map (ldev, use'old'map);        <<03551>>35320000
   VALUE ldev, use'old'map;                                             35322000
   INTEGER ldev;                                                        35324000
   LOGICAL use'old'map;                                                 35326000
   OPTION VARIABLE;                                                     35328000
                                                                        35330000
<<==============================================================        35332000
                                                                        35334000
      This procedure initialize the descriptor table to the             35336000
   all free state.  The parameter use'old'map deteremines               35338000
   where the map is to be placed.  This parameter is provided           35340000
   for a recover lost disc space. If it is present and TRUE,            35342000
   the old space for the map is used, provided there are no             35344000
   deleted tracks overlaping the free space map or descriptor           35346000
   table, reassigned is o.k.  If it overlaps a deleted track,           35348000
   INITIAL is HALTed with a nasty message.  If use'old'map if           35350000
   FALSE on omitted, then it is assumed to be a reload and              35352000
   space is searched for that is not on a defective or re-              35354000
   assigned track.  Once we have decided where the map is               35356000
   going to go, the descriptor table is initialized to zeros.           35358000
   The bit map is initialized and the system reserve area,              35360000
   the descriptor table, bit map and all deleted tracks are             35362000
   removed from the free space map.                                     35364000
                                                                        35366000
   Parameters:                                                          35368000
      ldev - Logical device number of disc drive.                       35370000
      use'old'map - (optional) - If TRUE, then the space form           35372000
                                 the old map will be used. If           35374000
                                 FALSE or omitted, then we              35376000
                                 will not necessarly use the            35378000
                                 old space.                             35380000
   Assumptions on entry:                                                35382000
      DB must be at the stack.                                          35384000
                                                                        35386000
   Exit conditions:                                                     35388000
      DB is unchanged.                                                  35390000
                                                                        35392000
   Globals:                                                             35394000
                                                                        35396000
      Output:                                                           35398000
         first'page'with'space                                          35400000
         ldev'index'to'ldev - entry will be initialized.                35402000
                                                                        35404000
      Others:                                                           35406000
         ldev'of'dt'page'in'buffer - altered.                           35408000
         add'of'dt'page'in'buffer - altered.                            35410000
         dt'buffer - altered.                                           35412000
         ldev'of'map'in'buffer - altered.                               35414000
         bit'map'buffer - altered.                                      35416000
                                                                        35418000
      Equates:                                                          35420000
         sector'size                                                    35422000
         m333                                                           35424000
         check'sum'word                                                 35426000
         actual'words'per'page                                          35428000
         m325                                                           35430000
         ldev'1'reserved'area'size                                      35432000
         other'disc'reserved'area'size                                  35434000
         disc'lab'dt'low {INCDISC1}                                     35436000
         disc'lab'dt'high {INCDISC1}                                    35438000
         disc'lab'map'low {INCDISC1}                                    35440000
         disc'lab'map'high {INCDISC1}                                   35442000
         disc'lab'dirty'dt'flag {INCDISC1}                              35444000
         cs'80'type {INCDISC1}                                          35446000
         disc'lab'dfs'map'ok {INCDISC1}                                 35448000
                                                                        35450000
      Defines:                                                          35452000
         DBL                                                            35454000
         disc'label'map'address {INCDISC1}                              35456000
                                                                        35458000
   Externals:                                                           35460000
      Get'Disc'Info                                                     35462000
      Check'If'On'Defect                                                35464000
      Errmessage                                                        35466000
      Disc                                                              35468000
      Make'Check'Sum                                                    35470000
      Return'Disc'Space                                                 35472000
      Get'Disc'Defect'Entry                                             35474000
      Get'Specific'Disc'Space                                           35476000
      Access'Dfs'Map                                                    35478000
                                                                        35480000
   Intrinsics:                                                          35482000
      None.                                                             35484000
                                                                        35486000
   Callers:                                                             35488000
      Mainseg1                                                          35490000
                                                                        35492000
   Fix ID:                                                              35494000
         This procedure was added as part of the new disc               35496000
      free space map changes.  The fix number on the                    35498000
      procedure header applies to the whole procedure.                  35500000
                                                                        35502000
   Changes:                                                             35504000
                                                                        35506000
                                                                        35508000
==============================================================>>        35510000
                                                                        35512000
BEGIN                                                                   35514000
                                                                        35516000
   ARRAY disc'label (0:sector'size-1);                                  35518000
   DOUBLE disc'size;                                                    35520000
   DOUBLE bit'map'disc'address;                                         35522000
   INTEGER bit'map'size'pages;                                          35524000
   DOUBLE dt'disc'address;                                              35526000
   INTEGER dt'size'words;                                               35528000
   INTEGER dt'size'sectors;                                             35530000
   DOUBLE reserved'area'size;                                           35532000
                                                                        35534000
   LOGICAL found;                                                       35536000
   INTEGER count;                                                       35538000
                                                                        35540000
   INTEGER defect'entry'counter;                                        35542000
   INTEGER entry'code;                                                  35544000
   LOGICAL end'of'defect'table;                                         35546000
   DOUBLE sector'address;                                               35548000
   DOUBLE length;                                                       35550000
   INTEGER index;                                                       35552000
                                                                        35554000
$INCLUDE INCDISC1                                                       35556000
                                                                        35558000
   INTEGER type;                                                        35560000
                                                                        35562000
   LOGICAL pmap = Q-4;                                                  35564000
   DEFINE passed'use'old'map = pmap.(15:1)#;                            35566000
                                                                        35568000
   << - - - - - - - - - - >>                                            35570000
                                                                        35572000
   << Set size of reserved area at the start of the disc >>             35574000
                                                                        35576000
   IF ldev = 1 THEN                                                     35578000
      reserved'area'size := DBL (ldev'1'reserved'area'size)             35580000
   ELSE                                                                 35582000
      reserved'area'size := DBL (other'disc'reserved'arae'size);        35584000
                                                                        35586000
                                                                        35588000
   Get'Disc'Info (ldev, disc'label, TRUE,  ,type ,  , disc'size,        35590000
                  bit'map'disc'address, bit'map'size'pages,             35592000
                  dt'disc'address, dt'size'words);                      35594000
                                                                        35596000
   dt'size'sectors := dt'size'words / sector'size;                      35598000
   IF (dt'size'words MOD sector'size) <> 0 THEN                         35600000
      dt'size'sectors := dt'size'sectors + 1;                           35602000
                                                                        35604000
   IF passed'use'old'map AND use'old'map THEN                           35606000
      BEGIN  << Re-initialize current map >>                            35608000
                                                                        35610000
         found := Check'If'On'Defect (ldev, dt'disc'address,            35612000
                     DBL(dt'size'sectors), TRUE);                       35614000
                                                                        35616000
         IF found THEN                                                  35618000
            found := Check'If'On'Defect (ldev, bit'map'disc'address,    35620000
                     DBL(bit'map'size'pages * page'size), TRUE);        35622000
                                                                        35624000
         IF NOT found THEN                                              35626000
                                                                        35628000
               << Tellop about the problem and die >>                   35630000
                                                                        35632000
               Errmessage (m333, ldev);                                 35634000
                                                                        35636000
      END    << Re-initialize current map >>                            35638000
   ELSE                                                                 35640000
      BEGIN  << Find a place for the map >>                             35642000
                                                                        35644000
         << Find a place for the descriptor table and map that is not   35646000
            on a defective or reassigned track.                       >>35648000
                                                                        35650000
         dt'disc'address := reserved'area'size;                         35652000
         found := FALSE;                                                35654000
                                                                        35656000
         WHILE NOT found DO                                             35658000
            found := Check'If'On'Defect (ldev, dt'disc'address,         35660000
                     DBL(dt'size'words +                                35662000
                     (bit'map'size'pages/page'size)), FALSE,            35664000
                     dt'disc'address);                                  35666000
                                                                        35668000
         bit'map'disc'address := dt'disc'address + DBL(dt'size'sectors);35670000
                                                                        35672000
         << Set stuff in disc label >>                                  35674000
                                                                        35676000
         TOS := dt'disc'address;                                        35678000
         disc'label (disc'lab'dt'low) := TOS;                           35680000
         disc'label (disc'lab'dt'high) := TOS;                          35682000
                                                                        35684000
         TOS := bit'map'disc'address;                                   35686000
         disc'label (disc'lab'map'low) := TOS;                          35688000
         disc'label (disc'lab'map'high) := TOS;                         35690000
                                                                        35692000
      END;   << Find a place for the map >>                             35694000
                                                                        35696000
      << Update disc label >>                                           35698000
                                                                        35700000
      disc'label (disc'lab'dirty'dt'flag) := TRUE;                      35702000
      disc'label (disc'lab'dfs'map'ok) := TRUE;                         35704000
                                                                        35706000
      Disc (1, ldev, disc'label'address, disc'label, sector'size);      35708000
                                                                        35710000
   << Delete entry in "ldev'index'to'ldev" table for this               35712000
      ldev.  This will force "Access'Dfs'map" to re-init                35714000
      the info for this ldev.                             >>            35716000
                                                                        35718000
   index := 0;                                                          35720000
                                                                        35722000
   WHILE index < max'disc'drives DO                                     35724000
      IF ldev'index'to'ldev (index) = ldev THEN                         35726000
         BEGIN  << Found entry >>                                       35728000
                                                                        35730000
            ldev'index'to'ldev (index) := -1;                           35732000
            index := max'disc'drives;                                   35734000
                                                                        35736000
         END    << Found entry >>                                       35738000
      ELSE                                                              35740000
         index := index + 1;                                            35742000
                                                                        35744000
   << Zero out descriptor table >>                                      35746000
                                                                        35748000
   ldev'of'dt'page'in'buffer := -1;                                     35750000
   add'of'dt'page'in'buffer := -1D;                                     35752000
                                                                        35754000
   dt'buffer (0) := 0;                                                  35756000
   MOVE dt'buffer (1) := dt'buffer (0), (sector'size-1);                35758000
                                                                        35760000
   FOR count := 0 UNTIL dt'size'sectors-1 DO                            35762000
      Disc (1, ldev, dt'disc'address + DBL(count), dt'buffer,           35764000
            sector'size);                                               35766000
                                                                        35768000
   << Initialize bit map to no free space state. >>                     35770000
                                                                        35772000
   ldev'of'map'in'buffer := -1;                                         35774000
                                                                        35776000
   bit'map'buffer (0) := 0;                                             35778000
   MOVE bit'map'buffer (1) := bit'map'buffer (0),                       35780000
                                 (actual'words'per'page-1);             35782000
                                                                        35784000
   bit'map'buffer (check'sum'word) := Make'Check'Sum (bit'map'buffer,   35786000
                                         actual'words'per'page);        35788000
                                                                        35790000
   FOR count := 0 UNTIL bit'map'size'pages-1 DO                         35792000
      Disc (1, ldev, bit'map'disc'address + DBL(count), bit'map'buffer, 35794000
            actual'words'per'page);                                     35796000
                                                                        35798000
   << Set all space as available except reserved area >>                35800000
                                                                        35802000
   Return'Disc'Space (ldev, reserved'area'size,                         35804000
                      disc'size - reserved'area'size);                  35806000
                                                                        35808000
                                                                        35810000
   << Remove all defective tracks from free space map, if it            35812000
      is not a CS'80 disc.                                    >>        35814000
                                                                        35816000
   IF type <> cs'80'type THEN                                           35818000
      BEGIN  << Take out defective tracks >>                            35820000
                                                                        35822000
         defect'entry'counter := 0;                                     35824000
                                                                        35826000
         DO                                                             35828000
            BEGIN  << Remove defective areas >>                         35830000
                                                                        35832000
               end'of'defect'table := NOT Get'Disc'Defect'entry (ldev,  35834000
                    defect'entry'counter, sector'address, length,       35836000
                    entry'code);                                        35838000
                                                                        35840000
               IF NOT end'of'defect'table AND                           35842000
               entry'code = dtt'deleted THEN                            35844000
                  BEGIN  << Delete area >>                              35846000
                                                                        35848000
                     TOS := Get'Specific'Disc'Space (ldev,              35850000
                                          sector'address, length);      35852000
                     IF TOS <> 0 THEN ERRMESSAGE (M325,10);    <<03632>>35854000
                                                                        35856000
                  END;   << delete area >>                              35858000
                                                                        35860000
            END    << Remove defective areas >>                         35862000
         UNTIL end'of'defect'table;                                     35864000
                                                                        35866000
      END;  << Take out defective tracks >>                             35868000
                                                                        35870000
                                                                        35872000
   << Remove space occupied by free space descriptor table and          35874000
      bit map from free space.                                 >>       35876000
                                                                        35878000
   TOS := Get'Specific'Disc'Space (ldev, dt'disc'address,               35880000
                                   DBL(dt'size'sectors));               35882000
   IF TOS <> 0 THEN ERRMESSAGE (M325,11);                      <<03632>>35884000
                                                                        35886000
   TOS := Get'Specific'Disc'Space (ldev, bit'map'disc'address,          35888000
                DBL(bit'map'size'pages * page'size));                   35890000
   IF TOS <> 0 THEN  ERRMESSAGE (M325,12);                     <<03632>>35892000
                                                                        35894000
                                                                        35896000
   index := Access'Dfs'Map (ldev);                                      35898000
   first'page'with'space (index) := 0; << First page >>                 35900000
                                                                        35902000
END;   << Init'Disc'Free'Space'Map >>                                   35904000
$PAGE "CHECK'IF'OVERLAPS'DFS'DATA'STRUCTURES"                  <<03613>>35906000
LOGICAL PROCEDURE Check'If'Overlaps'Dfs'Data'Structures (ldev, <<03613>>35908000
                     first'sector'address, last'sector'address);        35910000
   VALUE ldev, first'sector'address, last'sector'address;               35912000
   INTEGER ldev;                                                        35914000
   DOUBLE first'sector'address, last'sector'address;                    35916000
                                                                        35918000
<<==============================================================        35920000
                                                                        35922000
      This procedure checks to see if the specified area of             35924000
   the disc overlaps the descriptor table or bitmap of the              35926000
   ldev. This is used to see if the disc free space map disc            35928000
   resident data structure overlap a defective area on the              35930000
   disc.                                                                35932000
                                                                        35934000
   Parameters:                                                          35936000
      ldev - ldev number of the disc.                                   35938000
      first'sector'address - address of the first sector of             35940000
                             the area to check.                         35942000
      last'sector'address - address of the last sector of the           35944000
                            area to check.                              35946000
                                                                        35948000
   Returns:                                                             35950000
      TRUE - if there is some overlap.                                  35952000
      FALSE - if there is no overlap.                                   35954000
                                                                        35956000
   Assumptions on entry:                                                35958000
      DB is at the stack.                                               35960000
                                                                        35962000
   Exit conditions:                                                     35964000
      DB is unchanged.                                                  35966000
                                                                        35968000
   Globals:                                                             35970000
                                                                        35972000
      Equates:                                                          35974000
         sector'size                                                    35976000
         page'size                                                      35978000
                                                                        35980000
   Externals:                                                           35982000
      Get'Disc'Info                                                     35984000
                                                                        35986000
   Intrinsics:                                                          35988000
      None.                                                             35990000
                                                                        35992000
   Callers:                                                             35994000
      Mainseg1                                                          35996000
                                                                        35998000
   Fix ID:                                                              36000000
         This procedure was added as part of the new disc               36002000
      free space map changes.  The fix number on the                    36004000
      procedure header applies to the whole procedure.                  36006000
                                                                        36008000
   Changes:                                                             36010000
                                                                        36012000
                                                                        36014000
==============================================================>>        36016000
                                                                        36018000
BEGIN                                                                   36020000
                                                                        36022000
   DOUBLE bit'map'address;                                              36024000
   INTEGER bit'map'size'pages;                                          36026000
   DOUBLE ending'bit'map'address;                                       36028000
                                                                        36030000
   DOUBLE dt'address;                                                   36032000
   INTEGER dt'size'words;                                               36034000
   DOUBLE ending'dt'address;                                            36036000
                                                                        36038000
   LOGICAL return'value = Check'If'Overlaps'Dfs'Data'Structures;        36040000
                                                                        36042000
   << - - - - - - - - - - >>                                            36044000
                                                                        36046000
   << Get starting addresses and sizes of descriptor table              36048000
      and bitmap.                                           >>          36050000
                                                                        36052000
   Get'Disc'Info (ldev,  ,  ,  ,  ,  ,  , bit'map'address,              36054000
                  bit'map'size'pages, dt'address, dt'size'words);       36056000
                                                                        36058000
   << Calculate ending address of DT and bitmap >>                      36060000
                                                                        36062000
   ending'bit'map'address := bit'map'address + DBL (bit'map'size'pages *36064000
                             sector'size * page'size) - 1D;             36066000
                                                                        36068000
   ending'dt'address := dt'address + DBL (dt'size'words / sector'size)  36070000
                        -1D;                                            36072000
                                                                        36074000
   << Round up DT ending address if necessary >>                        36076000
                                                                        36078000
   IF (dt'size'words MOD sector'size) <> 0 THEN                         36080000
      ending'dt'address := ending'dt'address + 1D;                      36082000
                                                                        36084000
   << Check is there is any overlap >>                                  36086000
                                                                        36088000
   IF                                                                   36090000
   ((bit'map'address <= first'sector'address)                           36092000
                    LAND                                                36094000
    (ending'bit'map'address >= first'sector'address))                   36096000
                     OR                                                 36098000
   ((bit'map'address <= last'sector'address)                            36100000
                    LAND                                                36102000
    (ending'bit'map'address >= last'sector'address))                    36104000
                     OR                                                 36106000
   ((bit'map'address <= first'sector'address)                           36108000
                    LAND                                                36110000
    (ending'bit'map'address >= last'sector'address))                    36112000
                     OR                                                 36114000
   ((dt'address <= first'sector'address)                                36116000
                    LAND                                                36118000
    (ending'dt'address >= first'sector'address))                        36120000
                     OR                                                 36122000
   ((dt'address <= last'sector'address)                                 36124000
                    LAND                                                36126000
    (ending'dt'address >= last'sector'address))                         36128000
                     OR                                                 36130000
   ((dt'address <= first'sector'address)                                36132000
                    LAND                                                36134000
    (ending'dt'address >= last'sector'address))                         36136000
   THEN                                                                 36138000
      return'value := TRUE                                              36140000
   ELSE                                                                 36142000
      return'value := FALSE;                                            36144000
                                                                        36146000
END;  << Check'If'Overlaps'Dfs'Data'Structures >>                       36148000
$PAGE "MISC. DISCSPACE ROUTINES"                               <<03613>>36150000
  DOUBLE PROCEDURE GETDISCSPACE(LDEV,NSECT);                            36154000
    VALUE LDEV,NSECT;                                                   36156000
    INTEGER LDEV;                                                       36158000
    DOUBLE NSECT;                                                       36160000
      BEGIN                                                             36162000
      DOUBLE return'value = Getdiscspace;                      <<03551>>36164000
         TOS := Get'Disc'Space (ldev, nsect, return'value);    <<03551>>36166000
          IF TOS <> 0 THEN TOS := CCL ELSE TOS := CCE;                  36170000
          CC := TOS;                                                    36174000
      END <<GETDISCSPACE>> ;                                            36176000
  PROCEDURE RETDISCSPACE(LDEV,NSECT,DADDR);                             36178000
    VALUE LDEV,NSECT,DADDR;                                             36180000
    INTEGER LDEV;                                                       36182000
    DOUBLE NSECT,DADDR;                                                 36184000
      BEGIN                                                             36186000
         Return'Disc'Space (ldev, daddr, nsect);               <<03551>>36188000
         cc := cce;                                            <<03551>>36190000
      END <<RETDISCSPACE>> ;                                            36194000
  PROCEDURE REMDISCSPACE(LDEV,NSECT,DADDR);                             36196000
    VALUE LDEV,NSECT,DADDR;                                             36198000
    INTEGER LDEV;                                                       36200000
    DOUBLE NSECT,DADDR;                                                 36202000
      BEGIN                                                             36204000
                                                               <<03551>>36206000
         << Test to see if DADDR is neg, aside from the >>     <<03551>>36208000
         << first 8 bits. This is because the allocation>>     <<03551>>36210000
         << of LOADMAP on RELOAD - RESTORE is strange.  >>     <<03551>>36212000
                                                               <<03551>>36214000
         IF daddr = [16/%377,16/%177777]D OR daddr < 0D THEN   <<03551>>36216000
            BEGIN  << Negative >>                              <<03551>>36218000
               cc := ccl;                                      <<03551>>36220000
               RETURN;                                         <<03551>>36222000
            END;   << Negative >>                              <<03551>>36224000
                                                               <<03551>>36226000
         TOS := Get'Specific'Disc'Space (ldev, daddr, nsect);  <<03551>>36228000
         IF TOS <> 0 THEN TOS := ccl ELSE TOS := cce;          <<03551>>36230000
          CC := TOS;                                                    36232000
      END <<REMDISCSPACE>> ;                                            36234000
INTEGER PROCEDURE GETVOL(LDEV);                                <<MPEIV>>36238000
  VALUE LDEV;                                                  <<MPEIV>>36240000
  INTEGER LDEV;                                                <<MPEIV>>36242000
  COMMENT: CONVERT LDEV TO SYSTEM DOMAIN VOLUME NUMBER.        <<MPEIV>>36244000
  ;                                                            <<MPEIV>>36246000
  BEGIN                                                        <<MPEIV>>36248000
  INTEGER I := 0;                                              <<MPEIV>>36250000
  CC := CCE;                                                   <<MPEIV>>36252000
  IF LDEV > 0 THEN                                             <<MPEIV>>36254000
    WHILE (I:=I+1) <= HVOL DO                                  <<MPEIV>>36256000
      IF VTAB(I*VTABSIZE+VTAB12).VTABLDEV=LDEV THEN            <<MPEIV>>36258000
        BEGIN  << FOUND IT >>                                  <<MPEIV>>36260000
        GETVOL := I;                                           <<MPEIV>>36262000
        RETURN;                                                <<MPEIV>>36264000
        END;                                                   <<MPEIV>>36266000
  CC := CCL;                                                   <<MPEIV>>36268000
  END; << GETVOL >>                                            <<MPEIV>>36270000
INTEGER PROCEDURE GETLDEV(VOLUME);                             <<MPEIV>>36272000
  VALUE VOLUME;                                                <<MPEIV>>36274000
  INTEGER VOLUME;                                              <<MPEIV>>36276000
  BEGIN                                                        <<MPEIV>>36278000
  COMMENT: CONVERT VOLUME NUMBER TO LDEV.                      <<MPEIV>>36280000
  ;                                                            <<MPEIV>>36282000
  INTEGER LDEV = GETLDEV;                                      <<03603>>36284000
  IF VOLUME <= HVOL THEN                                       <<MPEIV>>36286000
    BEGIN                                                      <<MPEIV>>36288000
    GETLDEV := VTAB(VOLUME*VTABSIZE+VTAB12).VTABLDEV;          <<MPEIV>>36290000
    CC := IF 1 <= LDEV <= HLDEV THEN CCE ELSE CCG;             <<03603>>36292000
    END                                                        <<MPEIV>>36294000
  ELSE                                                         <<MPEIV>>36296000
    CC := CCL;                                                 <<MPEIV>>36298000
  END;  << GETLDEV >>                                          <<MPEIV>>36300000
          <<--------------------------------------                      36302000
            GET DISC SPACE IN ANY NUMBER OF WAYS                        36304000
          -------------------------------------->>                      36306000
  INTEGER PROCEDURE SUPERDISCSPACE(LDEV,NUMBLOCKS,TYPEWORD,BLOCKSIZES,  36308000
    BLOCKADDRS);                                                        36310000
    VALUE LDEV,NUMBLOCKS,TYPEWORD;                                      36312000
    INTEGER LDEV,NUMBLOCKS,TYPEWORD;                                    36314000
    DOUBLE ARRAY BLOCKSIZES,BLOCKADDRS;                                 36316000
    COMMENT                                                             36318000
      GETS DISC SPACE ACCORDING TO WHAT TYPE OF COLD LOAD THIS IS AND   36320000
    THE VALUE OF LDEV. SPECIFICALLY, IF LDEV<0 THEN -LDEV IS THE ONLY   36322000
    DEVICE ON WHICH SPACE CAN BE GOTTEN, IF LDEV>0, THEN ANY DEVICE IS  36324000
    OK, BUT LDEV SHOULD BE TRIED FIRST, AND IF LDEV=0 ANY DEVICE IS OK. 36326000
    FOR RESTORES, FIRST WE TRY TO GET BACK THE SAME SPACE AS BEFORE. IF 36328000
    THIS FAILS, WE ATTEMPT TO GET ANY SPACE ON THE SAME DEVICE AS       36330000
    BEFORE. IF THIS FAILS, WE TRY TO GET SPACE ACCORDING TO THE         36332000
    SPREAD METHOD. FOR COMPACTS, WE ATTEMPT TO GET SPACE IN THE SAME    36334000
    BLOCK AS BEFORE (BLOCKS ARE DEFINED TO BE THE AREAS CREATED WHEN    36336000
    SPACE IS REMOVED FOR DEFECTIVE TRACKS). IF THIS FAILS, WE AGAIN     36338000
    DEFAULT TO SPREAD. FOR SPREAD, WE FIRST ATTEMPT TO GET SPACE        36340000
    IN THE CLASS SPECIFIED IN THE FILE LABEL(SEARCH=0).IF THIS FAILS,   36342000
    WE ATTEMP TO GET SPACE ON A DEVICE WITH SAME TYPE AND SUBTYPE       36344000
    (SEARCH=1). IF THIS FAILS,WE TRY FOR SPACE ON A DEVICE WITH         36346000
    SAME TYPE (SEARCH=2). IF THIS FAILS, WE TRY FOR SPACE IN            36348000
    CLASS DISC. IF THIS FAILS, WE RERURN CCL,SINCE NO SPACE IS          36350000
    AVAILABLE. IN ANY CASE WHERE SPACE WAS FOUND,SUPERDISCSPACE         36352000
    RETURNS THE LOGICAL DEVICE NUMBER OF THE DISC ON WHICH THE          36354000
    FIRST EXTENT RESIDES.                                               36356000
     ** NOTE **  SUPERDISCSPACE ASSUMES THAT ALL REQUESTS               36358000
     FOR SPACE OTHER THAN FILES,E.G. MESSAGE CATALOGUE AND              36360000
     INITIAL SEGMENTS, ARE MADE WITH LDEV<0;                            36362000
    << NOTE: This routine no longers trys to get space >>      <<03551>>36364000
    <<       between blocks.                           >>      <<03551>>36366000
      BEGIN                                                             36368000
        INTEGER TYPE,SUBTYP,SEARCH:=-1,I,J,VOLUME,INDEX;                36370000
        INTEGER K,EXTLDEV,NCHAR,DVCX;                                   36372000
        DOUBLE DTEMP;                                                   36374000
        INTEGER POINTER STARTVOL;                                       36376000
        LOGICAL ONLYLDEV,CLASSUSED:=FALSE;                              36378000
  SUBROUTINE RETURNSPACE;                                               36380000
    BEGIN                                                               36382000
    K := -1;                                                            36384000
    WHILE (K:=K+1)<I DO                                                 36386000
      IF BLOCKSIZES(K)<>0D THEN                                         36388000
        BEGIN                                                           36390000
        TOS := BLOCKADDRS(K);                                  <<00071>>36392000
        TOS := S1.(0:8);                                                36394000
        TOS := TOS*VTABSIZE+VTAB12;                                     36396000
        X := TOS;                                                       36398000
        EXTLDEV := VTAB(X).VTABLDEV;                                    36400000
        S1.(0:8) := 0;  <<ZERO VOLUME NUMBER>>                          36402000
        DTEMP := TOS;                                                   36404000
        RETDISCSPACE(EXTLDEV,BLOCKSIZES(K),DTEMP);                      36406000
        IF <> THEN MESSAGE(M328);  << RETURNING SPACE >>       <<01442>>36408000
        END;                                                            36410000
    I := 0;                                                             36412000
    END  <<RETURNSPACE>>;                                               36414000
                                                                        36416000
          ONLYLDEV := LDEV.(0:1);                                       36418000
          IF <> THEN LDEV := -LDEV;                                     36420000
          I :=  0;                                                      36422000
          IF RESTORING THEN                                             36424000
            BEGIN <<TRY TO GET SOME SPECIFIC SPACE>>                    36426000
            IF LDEV=0 THEN GOTO ANYWHERE;                               36428000
            DO                                                          36430000
              IF BLOCKSIZES(I)<>0D THEN                                 36432000
                IF ONLYLDEV THEN                                        36434000
                  BEGIN                                                 36436000
                  EXTLDEV := LDEV;                                      36438000
                  DTEMP := BLOCKADDRS(I)&DLSL(8)&DLSR(8);               36440000
                  GOTO OPTIONREST;                                      36442000
                  END                                                   36444000
                ELSE                                                    36446000
                BEGIN                                                   36448000
                TOS := BLOCKADDRS(I);                                   36450000
                TOS := S1.(0:8)*VTABSIZE;                               36452000
                X := TOS;                                               36454000
                TOS := @VNAME;                                          36456000
                TOS := @OLDVTAB(X)&LSL(1);                     <<04306>>36458000
                MOVE *:=*,(8);                                          36460000
                K := 0;                                                 36462000
                WHILE (K:=K+1) <= HVOL DO                      <<03550>>36464000
                  BEGIN                                                 36466000
                  TOS := @VTAB(K*VTABSIZE)&LSL(1);             <<04306>>36468000
                  IF *=VNAME,(8)  THEN                                  36470000
                    BEGIN  <<FOUND IT>>                                 36472000
                    TOS := VTAB(X+VTAB12).VTABLDEV;                     36474000
                    GOTO GOTIT;                                         36476000
                    END;                                                36478000
                  END;                                                  36480000
                TOS := 0;                                               36482000
  GOTIT:        IF S0=0 THEN                                            36484000
                  BEGIN <<VOLUME NO LONGER EXIST>>                      36486000
                  DEL;                                                  36488000
                  GOTO ANYWHERE;                                        36490000
                  END                                                   36492000
                ELSE EXTLDEV := TOS;                                    36494000
                S1.(0:8) := 0;                                          36496000
                DTEMP := TOS;                                           36498000
  OPTIONREST:   IF OPT=REST THEN                                        36500000
                  BEGIN                                                 36502000
                  REMDISCSPACE(EXTLDEV,BLOCKSIZES(I),DTEMP);            36504000
                  IF <> THEN GOTO ANYTHIS;                              36506000
                  END                                                   36508000
                ELSE                                                    36510000
                  BEGIN <<TRY TO GET SPACE IN SAME BLOCK>>              36512000
                  TOS := Get'Disc'Space (extldev,              <<03551>>36514000
                                   blocksizes(i), dtemp);      <<03551>>36516000
                  IF TOS<>0 THEN                                        36518000
                    BEGIN  <<UNABLE TO GET IT>>                         36520000
  ANYTHIS:          TOS :=GETDISCSPACE(EXTLDEV,BLOCKSIZES(I));          36522000
                    IF <> THEN                                          36524000
                      IF ONLYLDEV THEN                                  36526000
                        BEGIN                                           36528000
                        DDEL;                                           36530000
                        RETURNSPACE;                                    36532000
                        GOTO ERROR;                                     36534000
                        END                                             36536000
                      ELSE GOTO ANYWHERE;                               36538000
                    DTEMP := TOS;                                       36540000
                    END;                                                36542000
                  END;                                                  36544000
                IF I=0 THEN SUPERDISCSPACE:=EXTLDEV;                    36546000
                TOS := DTEMP;                                           36548000
                TOS := GETVOL(EXTLDEV);                                 36550000
                S2.(0:8) := TOS;                                        36552000
                BLOCKADDRS(I) := TOS;                                   36554000
                END                                                     36556000
              UNTIL (I:=I+1)=NUMBLOCKS;                                 36558000
            GOTO FOUND;                                                 36560000
            END                                                         36562000
          ELSE IF ONLYLDEV THEN GOTO TRY <<THIS DEVICE ONLY>>           36564000
          ELSE                                                          36566000
            BEGIN  <<GET SPACE ANYWHERE>>                               36568000
  ANYWHERE: SEARCH := 0;                                                36570000
            IF NOT(FLCLASSB=NUMERIC) THEN                      <<03631>>36572000
              BEGIN  <<NOT NUMERIC>>                                    36574000
              TOS := @FLCLASSB;                                         36576000
              ASSEMBLE(DUP,DUP);                                        36578000
              MOVE *:=* WHILE AN,1;                                     36580000
              ASSEMBLE(XCH,SUB);                                        36582000
              NCHAR := TOS;                                             36584000
              DVCX := 0;                                                36586000
              J := 0;                                                   36588000
              WHILE(J:=J+1)<=LDT(DCNUM) DO                              36590000
                IF FLCLASSB=DVCLTAB(DVCX),(NCHAR) THEN                  36592000
                  IF NCHAR=8 OR DVCLTAB(DVCX+NCHAR)=" " THEN            36594000
                    GOTO GOTCLASS                                       36596000
                  ELSE                                                  36598000
                    BEGIN                                               36600000
  NEXTCLASS:        TOS := DVCLTAB(DVCX+10);                            36602000
                    ASSEMBLE(DUP,NOT);                                  36604000
                    IF TOS THEN TOS := TOS+1;                           36606000
                    DVCX := TOS+DVCX+11;                                36608000
                    END                                                 36610000
                ELSE GOTO NEXTCLASS;                                    36612000
              GOTO TRYTYPE;                                             36614000
  GOTCLASS:   J := 0;                                                   36616000
              DVCX := DVCX+10;                                          36618000
              INDEX:=INTEGER(DVCLTAB(DVCX-2));<<CYCLICAL POINTER>>      36620000
              IF INDEX>=INTEGER(DVCLTAB(DVCX)) THEN INDEX:=0;           36622000
              CLASSUSED := TRUE;                                        36624000
              WHILE(J:=J+1)<=INTEGER(DVCLTAB(DVCX)) DO                  36626000
                BEGIN                                                   36628000
                LDEV := INTEGER(DVCLTAB(DVCX+INDEX+1));                 36630000
                IF LPDT(LDEV*LPDTSIZE+LPDT1).NSDV<>0 OR NOT    <<03631>>36632000
                  SYSDISC'TYPE( LDT(LDEV*LDTSIZE+LDT2).TYP,    <<03631>>36634000
                       LPDT(LDEV*LPDTSIZE+LPDT1).SUBTYPE) THEN <<03631>>36636000
                  GOTO NEXTLDEV;                               <<03631>>36638000
                DO IF BLOCKSIZES(I)<>0D THEN                            36640000
                  BEGIN                                                 36642000
                  TOS := GETDISCSPACE(LDEV,BLOCKSIZES(I));              36644000
                  IF <> THEN                                            36646000
                    BEGIN                                               36648000
                    DDEL;                                               36650000
                    GOTO NEXTLDEV;                                      36652000
                    END;                                                36654000
                  IF I=0 THEN SUPERDISCSPACE:=LDEV;                     36656000
                  TOS := GETVOL(LDEV);                                  36658000
                  S2.(0:8) := TOS;                                      36660000
                  BLOCKADDRS(I) := TOS;                                 36662000
                  END                                                   36664000
                UNTIL (I:=I+1)=NUMBLOCKS;                               36666000
                GOTO FOUND;                                             36668000
  NEXTLDEV:    INDEX:= (INDEX+1) MOD INTEGER(DVCLTAB(DVCX));   <<03631>>36670000
              END;                                                      36672000
            RETURNSPACE;                                                36674000
            END                                                         36676000
          ELSE                                                          36678000
            BEGIN                                                       36680000
            TOS := @FLCLASSB; <<CLASS IS LOGICAL DEVICE #>>             36682000
            DUPLICATE;DUPLICATE;                                        36684000
            MOVE *:=* WHILE N,1;                                        36686000
            ASSEMBLE(XCH,SUB);                                          36688000
            NCHAR := TOS;                                               36690000
            J := 0;                                                     36692000
            LDEV := 0;                                                  36694000
            TOS := @FLCLASSB;                                           36696000
            DO                                                          36698000
              BEGIN <<CONVERT FROM ASCII>>                              36700000
              TOS := LDEV*10;                                           36702000
              TOS := TOS+INTEGER(BPS1)-%60;                             36704000
              LDEV := TOS;                                              36706000
              END                                                       36708000
            UNTIL (J:=J+1)=NCHAR;                                       36710000
            IF NON'DS'LDEV(LDEV) AND                           <<03549>>36712000
               SYSDISC'TYPE( LDT(LDEV*LDTSIZE+LDT2).TYP,       <<03549>>36714000
                    LPDT(LDEV*LPDTSIZE+LPDT1).SUBTYPE) AND     <<03631>>36716000
               LPDT(LDEV*LPDTSIZE+LPDT1).NSDV=0 THEN           <<03631>>36718000
               GOTO TRY;                                       <<03549>>36720000
            END;                                                        36722000
  TRYTYPE:TYPE := TYPEWORD.(8:6);                                       36724000
          SUBTYP := TYPEWORD.(4:4);                                     36726000
          SEARCH := 1;                                                  36728000
          IF TYPE=MHDISCTYPE THEN                              <<03550>>36730000
             @STARTVOL := @MHVOLS                              <<03550>>36732000
          ELSE IF TYPE=DISC3 THEN                              <<03550>>36734000
             @STARTVOL := @CS80VOLS                            <<03550>>36736000
          ELSE                                                 <<03550>>36738000
             @STARTVOL := @FHVOLS;                             <<03550>>36740000
          VOLUME := STARTVOL(INDEX:=SUBTYP);                            36744000
  SEARCH1'2:                                                            36746000
          LDEV:= GETLDEV(VOLUME);                              <<03631>>36748000
          IF <> THEN GOTO NEXT;                                <<03631>>36750000
          IF LDT(LDEV*LDTSIZE+LDT2).TYP=TYPE THEN                       36752000
          IF LPDT(LDEV*LPDTSIZE+LPDT1).SUBTYPE=SUBTYP THEN              36754000
          IF SEARCH=2 THEN GOTO NEXT <<ALREADY TRIED>> ELSE GOTO TRY    36756000
          ELSE IF SEARCH=1 THEN GOTO NEXT <<WRONG SUBTYPE>>             36758000
          ELSE <<SEARCH=2,TYPE MATCHES,SUBTYPE DOESN'T>>                36760000
            BEGIN  <<TRY THIS DEVICE>>                                  36762000
  TRY:      DO IF BLOCKSIZES(I)<>0D THEN                                36764000
              BEGIN                                                     36766000
              TOS := GETDISCSPACE(LDEV,BLOCKSIZES(I));                  36768000
              IF <> THEN                                                36770000
                BEGIN <<NOT ENOUGH SPACE ON THIS DEVICE>>               36772000
                DDEL;                                                   36774000
                IF SEARCH=1 OR SEARCH=2 THEN RETURNSPACE;               36776000
                IF SEARCH=0 THEN GO TRYTYPE ELSE GOTO NEXT;             36778000
                END;                                                    36780000
              IF I=0 THEN SUPERDISCSPACE:=LDEV;                         36782000
              TOS := GETVOL(LDEV);                                      36784000
              S2.(0:8) := TOS;                                          36786000
              BLOCKADDRS(I) := TOS;                                     36788000
              END                                                       36790000
            UNTIL (I:=I+1)=NUMBLOCKS;                                   36792000
            GOTO FOUND;                                                 36794000
            END                                                         36796000
          ELSE GOTO NEXT;    <<DIFFERENT TYPE>>                         36798000
          END;   <<MATCHES THAT UNNEEDED BEGIN>>                        36800000
  NEXT:  IF SEARCH=3 THEN                                               36802000
           BEGIN <<DEVICE CLASS DISC SEARCH>>                           36804000
           DO                                                  <<03631>>36806000
             BEGIN                                             <<03631>>36808000
             INDEX:= (INDEX+1) MOD NDISCDEV;                   <<03631>>36810000
             IF INDEX=DISCLDEV THEN GOTO ERROR;                <<03631>>36812000
             LDEV := DISCLASS(INDEX); <<NEXT ONE TO TRY>>      <<03631>>36814000
             END                                               <<03631>>36816000
           UNTIL LPDT(LDEV*LPDTSIZE+LPDT1).NSDV=0;             <<03631>>36818000
           GOTO TRY;                                                    36820000
           END;                                                         36822000
         IF ONLYLDEV THEN GOTO ERROR; <<CAN'T TRY ANY OTHER>>           36824000
         IF (VOLUME:=VOLUME+1) > HVOL THEN VOLUME := 1;        <<03550>>36826000
         IF VOLUME=STARTVOL(INDEX) THEN                                 36828000
         IF (SEARCH:=SEARCH+1)=3 THEN                                   36830000
           BEGIN  <<TRY DEVICE CLASS DISC>>                             36832000
           IF NDISCDEV=0 THEN GOTO ERROR;  <<NOTHING IN DISC>>          36834000
           INDEX:= DISCLDEV-1;                                 <<03631>>36836000
           J:= 0;                                              <<03631>>36838000
           WHILE (J:= J+1)<=NDISCDEV DO                        <<03631>>36840000
             BEGIN                                             <<03631>>36842000
             INDEX:= (INDEX+1) MOD NDISCDEV;                   <<03631>>36844000
             LDEV := DISCLASS(INDEX);                          <<03631>>36846000
             IF LPDT(LDEV*LPDTSIZE+LPDT1).NSDV=0 THEN          <<03631>>36848000
               GOTO TRY;                                       <<03631>>36850000
             END;                                              <<03631>>36852000
           GOTO ERROR;                                         <<03631>>36854000
           END                                                          36856000
         ELSE VOLUME := STARTVOL(INDEX:=-1); <<TYPESEARCH ONLY>>        36858000
         GOTO SEARCH1'2;                                                36860000
  FOUND:  CASE *(SEARCH+1) OF                                           36862000
          BEGIN                                                         36864000
          ;                                                             36866000
              IF CLASSUSED THEN                                         36868000
                BEGIN <<UPDATE  CYCLICAL POINTER FOR THIS CLASS>>       36870000
                IF(INDEX:=INDEX+1)=INTEGER(DVCLTAB(DVCX)) THEN INDEX:=0;36872000
                DVCLTAB(X:=X-2) := INDEX;                               36874000
                END;                                                    36876000
              GOTO TYPE1;                                               36878000
  TYPE1:      BEGIN  <<UPDATE CYCLICAL PTR FOR TYPE OR SUBTYPE SEARCH>> 36880000
                IF (VOLUME:=VOLUME+1)>HVOL THEN VOLUME:=1;              36882000
                STARTVOL(INDEX) := VOLUME;                              36884000
              END;                                                      36886000
              BEGIN  <<UPDATE CYCLICAL PTR FOR DEVICE CLASS DISC>>      36888000
                IF (INDEX:=INDEX+1)=NDISCDEV THEN INDEX:=0;             36890000
                DISCLDEV := INDEX;                                      36892000
              END;                                                      36894000
            END;                                                        36896000
          TOS := CCE;                                                   36898000
          GOTO EXIT;                                                    36900000
  ERROR:  TOS := CCL;                                                   36902000
          RETURNSPACE;   <<IN CASE SEARCH=3>>                           36904000
  EXIT:   STAT.(6:2) := TOS;                                            36906000
      END <<SUPERDISCSPACE>> ;                                          36908000
          <<-----------------------------                               36910000
            REMOVE OR RETURN DISC SPACE                                 36912000
          ----------------------------->>                               36914000
  PROCEDURE REMRETDSPACE(NSECT,DADDR);                                  36916000
    VALUE NSECT,DADDR;                                                  36918000
    LOGICAL NSECT;                                                      36920000
    DOUBLE DADDR;                                                       36922000
    COMMENT                                                             36924000
      RETURN (FOR COLD LOAD FROM TAPE) OR REMOVE (FOR COLD LOAD FROM    36926000
    DISC) THE DISC SPACE OF LENGTH LEN STARTING AT ADDRESS DADDR;       36928000
      BEGIN                                                             36930000
          TOS := SYSDISC;                                               36932000
          TOS := 0;                                                     36934000
          TOS := NSECT;                                                 36936000
          TOS := DADDR;                                                 36938000
          IF LOADFROMTAPE THEN TOS := @RETDISCSPACE <<RETURN IT>>       36940000
          ELSE TOS := @REMDISCSPACE;  <<REMOVE IT>>                     36942000
          ASSEMBLE(PCAL 0);                                             36944000
          IF <> THEN ERRMESSAGE(M325,13);<<DISC SPACE ERROR>>  <<03632>>36946000
      END <<REMRETDSPACE>> ;                                            36948000
$PAGE "DIRECTORY ROUTINES"                                              36952000
$CONTROL SEGMENT=SETUP                                                  36954000
          <<-----------------                                           36956000
            DIRECTORY ERROR                                             36958000
          ----------------->>                                           36960000
  PROCEDURE DIRERROR(REGISTERS,FNAME);                                  36962000
    VALUE REGISTERS;                                                    36964000
    DOUBLE REGISTERS;                                                   36966000
    BYTE ARRAY FNAME;                                                   36968000
      BEGIN                                                             36970000
        INTEGER A=REGISTERS+1,    <<S-0 AFTER DIRECTORY CALL>>          36972000
                B=REGISTERS;      <<S-1 AFTER DIRECTORY CALL>> <<01103>>36974000
          IF A=2 AND B=0 THEN                                           36976000
            BEGIN  <<FILE NOT FOUND>>                                   36978000
              MOVE BLINE := "FILE ",2;                         <<01103>>36980000
              TOS := TOS+MOVEAN(BPS0,FNAME,8);                 <<01103>>36982000
              MOVE * := ".PUB.SYS NOT ON DISC",2;                       36984000
              PRINTLINE;                                       <<01103>>36986000
              ERRMESSAGE(M0);  <<DIE>>                         <<01103>>36988000
            END;                                                        36990000
          ERRMESSAGE(M277,A,B);                                <<01103>>36992000
      END <<DIRERROR>> ;                                                36994000
$CONTROL SEGMENT=DIRECTORY2                                    <<03668>>36996000
            <<--------------------------------->>              <<03668>>36998000
            <<      COMPACT A FILE NAME        >>              <<03668>>37000000
            <<--------------------------------->>              <<03668>>37002000
INTEGER PROCEDURE MOVE'FNAME( STRING, FNAME, GUNAME, ANAME);   <<03714>>37004000
BYTE ARRAY                                                     <<03668>>37006000
   STRING;      << STRING FOR RESULT >>                        <<03668>>37008000
ARRAY                                                          <<03668>>37010000
   FNAME,       << 4-WORD ARRAY HOLDING FILE NAME >>           <<03714>>37012000
   GUNAME,      << 4-WORD ARRAY HOLDING GROUP NAME >>          <<03714>>37014000
   ANAME;       << 4-WORD ARRAY HOLDING ACCOUNT NAME >>        <<03714>>37016000
                                                               <<03714>>37018000
                                                               <<03668>>37020000
COMMENT                                                        <<03668>>37022000
COMPACTS A FILE NAME BY REMOVING ALL OF THE BLANKS AND         <<03668>>37024000
PUTS PERIODS BETWEEN THE FILE AND GROUP NAME, AND THE          <<03668>>37026000
GROUP AND ACCOUNT NAMES.  IT PUTS THE RESULT INTO              <<03668>>37028000
'STRING' AND RETURNS THE LENGTH OF THE STRING IN BYTES.        <<03668>>37030000
;                                                              <<03668>>37032000
BEGIN                                                          <<03668>>37034000
BYTE ARRAY                                                     <<03668>>37036000
   BFNAME(*) = FNAME,                                          <<03714>>37038000
   BGUNAME(*) = GUNAME,                                        <<03714>>37040000
   BANAME(*) = ANAME;                                          <<03714>>37042000
BYTE                                                           <<03668>>37044000
   BDOT := ".";          << A PERIOD >>                        <<03668>>37046000
INTEGER                                                        <<03668>>37048000
   BYTES;      << TEMP. FOR NO. OF BYTES MOVED >>              <<03668>>37050000
                                                               <<03668>>37052000
BYTES := MOVEAN( STRING,               << MOVE FILE NAME >>    <<03668>>37054000
                 BFNAME, 8);                                   <<03668>>37056000
STRING(BYTES) := BDOT;                 << MOVE "." >>          <<03668>>37058000
BYTES := BYTES + 1;                                            <<03668>>37060000
BYTES := MOVEAN( STRING(BYTES),        << MOVE GROUP NAME >>   <<03668>>37062000
                 BGUNAME,8) + BYTES;                           <<03714>>37064000
STRING(BYTES) := BDOT;                 << MOVE "." >>          <<03668>>37066000
BYTES := BYTES + 1;                                            <<03668>>37068000
BYTES := MOVEAN( STRING(BYTES),        << MOVE ACCOUNT NAME >> <<03668>>37070000
                 BANAME,8) + BYTES;                            <<03714>>37072000
MOVE'FNAME := BYTES;   << RETURN NO. OF BYTES IN STRING >>     <<03668>>37074000
END;   << MOVE'FNAME >>                                        <<03668>>37076000
$CONTROL SEGMENT=SETUP                                         <<03668>>37078000
          <<-----------------                                           37080000
            PRINT FILE NAME                                             37082000
          ----------------->>                                           37084000
  PROCEDURE PRINTFNAME(NAME);                                           37086000
    ARRAY NAME;                                                         37088000
      BEGIN                                                             37090000
          MOVE LINE := NAME,(4);                               <<01103>>37092000
          LINE(4) := " .";                                     <<01103>>37094000
          MOVE LINE(5) := NAME(4),(4);                         <<01103>>37096000
          LINE(9) := " .";                                     <<01103>>37098000
          MOVE LINE(10) := NAME(8),(4);                        <<01103>>37100000
          PRINTLINE;                                           <<01103>>37102000
      END <<PRINTFNAME>> ;                                              37104000
                                                                        37106000
                                                                        37108000
          <<--------------------------                                  37110000
            PRINT FILE NAME/REASON                                      37112000
          -------------------------->>                                  37114000
PROCEDURE PRINTFNR( NAME, REASON);                             <<01103>>37116000
   VALUE REASON;                                               <<01103>>37118000
   BYTE ARRAY NAME;                                            <<01103>>37120000
   INTEGER REASON;                                             <<01103>>37122000
BEGIN                                                          <<01103>>37124000
   BYTE ARRAY HEADING(*) = PB :=                               <<01103>>37126000
      "FILE NAME",19(" "),"REASON";                            <<01103>>37128000
   BYTE ARRAY MESS(*) = PB :=                                  <<01103>>37130000
      "INSUFFICIENT DISC SPACE",                               <<01103>>37132000
      "TAPE PARITY ERROR",                                     <<01103>>37134000
      "TAPE FORMAT ERROR",                                     <<01442>>37136000
      "FILE LABEL CHECKSUM ERROR",                             <<01442>>37138000
      "SPECIFIED SPACE NOT IN DISC FREE SPACE MAP",            <<03668>>37140000
      "ON DELETED OR NEWLY REASSIGNED DISC AREA",              <<03668>>37142000
      "DEFECTIVE FILE LABEL";                                  <<03668>>37144000
   INTEGER ARRAY MSGSTART(1:8) = PB := 0,23,40,57,82,          <<03668>>37146000
                                       124,164,184;            <<03668>>37148000
                                                               <<01103>>37150000
   IF NOT HEADING'PRINTED THEN                                 <<01103>>37152000
      BEGIN                                                    <<01103>>37154000
      MOVE BLINE := HEADING,(34);                              <<01103>>37156000
      PRINTLINE;                                               <<01103>>37158000
      BLANKLINE;                                               <<01103>>37160000
      HEADING'PRINTED := TRUE;                                 <<01103>>37162000
      END;                                                     <<01103>>37164000
   MOVE BLINE := NAME,(8);                                     <<01103>>37166000
   BLINE(8) := ".";                                            <<01103>>37168000
   MOVE BLINE(9) := NAME(8),(8);                               <<01103>>37170000
   BLINE(17) := ".";                                           <<01103>>37172000
   MOVE BLINE(18) := NAME(16),(8);                             <<01103>>37174000
   IF 1 <= REASON <= 7 THEN   << VALID REASON? >>              <<03668>>37176000
      MOVE BLINE(28) := MESS(MSGSTART(REASON)),                <<01103>>37178000
           (MSGSTART(REASON+1)-MSGSTART(REASON));              <<01103>>37180000
   PRINTLINE;                                                  <<01103>>37182000
END;  << PRINTFNR >>                                           <<01103>>37184000
                                                                        37186000
                                                                        37188000
$PAGE                                                                   37190000
$CONTROL SEGMENT=DIRECTORY1                                             37192000
                                                                        37194000
          <<-------------                                               37196000
            EXCHANGE DB                                                 37198000
          ------------->>                                               37200000
  PROCEDURE EXCHANGEDB(DSTN);                                           37202000
    VALUE DSTN;                                                         37204000
    INTEGER DSTN;                                                       37206000
    COMMENT                                                             37208000
      SETS DB TO THE DATA SEGMENT REQUESTED, OR TO THE STACK IF DSTN=0; 37210000
      BEGIN                                                             37212000
          IF DSTN=0 THEN                                                37214000
            BEGIN  <<STACK>>                                            37216000
              TOS := ABSOLUTE(DBBANK);                                  37218000
              TOS := ABSOLUTE(DB);                                      37220000
            END                                                         37222000
          ELSE                                                          37224000
            BEGIN  <<DATA SEGMENT>>                                     37226000
              TOS := DST(DSTN&LSL(2)+2).(8:8);<<HI ORDER ADDR>><<01756>>37228000
              TOS := DST(X:=X+1);                                       37230000
            END;                                                        37232000
          ASSEMBLE(XCHD 0);   <<SET DB TO NEW VALUE>>                   37234000
      END <<EXCHANGEDB>> ;                                              37236000
                                                                        37238000
  PROCEDURE DIRDISC(WRITE,ADDR,BUF,WORDS);                              37240000
    VALUE WRITE,ADDR,WORDS;                                             37242000
    INTEGER WRITE,WORDS;                                                37244000
    DOUBLE ADDR;                                                        37246000
    ARRAY BUF;                                                          37248000
    COMMENT                                                             37250000
      PERFORM A DISC TRANSFER TO/FROM ONE OF THE DIRECTORY DATA         37252000
    SEGMENTS;                                                           37254000
      BEGIN                                                             37256000
          TOS := ABSOLUTE(DBBANK);                                      37258000
          TOS := ABSOLUTE(DB);                                          37260000
          ASSEMBLE(XCHD);  <<SET DB TO STACK>>                          37262000
          TOS := WRITE;                                                 37264000
          TOS := SYSDISC;                                               37266000
          TOS := ADDR;                                                  37268000
          TOS := DS5;  <<OLD DB VALUE>>                                 37270000
          TOS := TOS+@BUF;  <<ABSOLUTE BUFFER ADDRESS>>                 37272000
          DISC'(*,*,*,*,WORDS);                                         37274000
          ASSEMBLE(XCHD 0);                                             37276000
      END <<DIRDISC>> ;                                                 37278000
$CONTROL SEGMENT=DIRECTORY2                                             37282000
          <<-------------------------                                   37286000
            WRITE FROM TAPE TO DISC                                     37288000
          ------------------------->>                                   37290000
INTEGER PROCEDURE WRITEDISC( DISCADR);                         <<03603>>37294000
   VALUE DISCADR;                                              <<03603>>37296000
   DOUBLE DISCADR;                                             <<03603>>37298000
BEGIN                                                          <<03603>>37300000
   INTEGER                                                     <<03603>>37302000
      LEN;                                                     <<03603>>37304000
   LOGICAL                                                     <<03603>>37306000
      NRSECTORS;                                               <<03603>>37308000
   DOUBLE                                                      <<03603>>37310000
      NRWORDS;                                                 <<03603>>37312000
                                                               <<03603>>37314000
   WRITEDISC := TAPEBUF(2); << NR. SECTORS >>                  <<03603>>37316000
   NRSECTORS := TAPEBUF(2);                                    <<03603>>37318000
   NRWORDS := NRSECTORS**128;                                  <<03603>>37320000
   WHILE NRWORDS <> 0D DO                                      <<03603>>37322000
      BEGIN                                                    <<03603>>37324000
      LEN := IF NRWORDS > DOUBLE(TAPERECSIZE) THEN             <<03603>>37326000
         TAPERECSIZE ELSE LOGICAL(NRWORDS);                    <<03603>>37328000
      COLD'LOAD'MEDIA( READ,TAPEBUF,LEN);                      <<03603>>37330000
      WHILE END'OF'TAPE DO                                     <<03603>>37332000
         BEGIN                                                 <<03603>>37334000
         NEXTREEL(TAPEBUF);                                    <<03603>>37336000
         COLD'LOAD'MEDIA(READ,TAPEBUF,LEN);                    <<03603>>37338000
         END;                                                  <<03603>>37340000
      DISC(WRITE,SYSDISC,DISCADR,TAPEBUF,LEN);                 <<03603>>37342000
      DISCADR := DISCADR+DOUBLE(TAPERECSIZE/128);              <<03603>>37344000
      NRWORDS := NRWORDS-DOUBLE(LEN);                          <<03603>>37346000
      END;                                                     <<03603>>37348000
END;                                                           <<03603>>37350000
$PAGE "FILE PROCEDURES"                                                 37352000
$CONTROL SEGMENT=FILEIO                                                 37354000
          <<-------------------                                         37356000
            GET EXTENT LENGTH                                           37358000
          ------------------->>                                         37360000
  LOGICAL PROCEDURE GETEXTLEN(EXTENT);                                  37362000
    VALUE EXTENT;                                                       37364000
    INTEGER EXTENT;                                                     37366000
    COMMENT                                                             37368000
      RETURNS THEN LENGTH OF THE SPECIFIED EXTENT FOR THE FILE WHOSE    37370000
    LABEL IS IN FLAB;                                                   37372000
      BEGIN                                                             37374000
          IF EXTENT<>FLNUMEXTS THEN GOTO NOTLAST                        37376000
          ELSE                                                          37378000
            BEGIN                                                       37380000
              TOS := FLFLIM;                                            37382000
              TOS := FLBLKSIZE;                                         37384000
              TOS := FLRECSIZE;                                         37386000
              IF = THEN TOS := TOS+128                                  37388000
              ELSE IF < THEN TOS := (-TOS+1)&LSR(1);                    37390000
              ASSEMBLE(DIV,DEL);                                        37392000
              X := TOS;   <<BLOCKING FACTOR>>                           37394000
              <<COMPUTE FILE LIMIT IN BLOCKS>>                          37396000
              ASSEMBLE(ZERO,CAB; LDXA,LDIV; CAB,LDXA; LDIV);            37398000
              IF TOS <> 0 THEN TOS := TOS+1D;                           37400000
              X := (FLBLKSIZE+127)&LSR(7);                              37402000
              ASSEMBLE(LDXA,LMPY; CAB,LDXA; MPY,ZERO;DADD,ZERO);        37404000
              TOS := FLSECTOFF;                                         37406000
              ASSEMBLE(DADD);                                           37408000
              TOS := FLEXTSIZE;                                         37410000
              ASSEMBLE(LDIV,TEST);                                      37412000
              IF = THEN                                                 37414000
  NOTLAST:      TOS := FLEXTSIZE;                                       37416000
            END;                                                        37418000
          GETEXTLEN := TOS;                                             37420000
      END <<GETEXTLEN>> ;                                               37422000
DOUBLE PROCEDURE RELEASE'FILE'SPACE;                           <<03603>>37424000
BEGIN                                                          <<03603>>37426000
   INTEGER                                                     <<03603>>37428000
      I := 0,                                                  <<03603>>37430000
      LDEV;                                                    <<03603>>37432000
   DOUBLE                                                      <<03603>>37434000
      EXTADR,                                                  <<03603>>37436000
      DUM1;                                                    <<03603>>37438000
   BYTE                                                        <<03603>>37440000
      EXTVOL = EXTADR;                                         <<03603>>37442000
   DOUBLE                                                      <<03603>>37444000
      SECTORS = RELEASE'FILE'SPACE;                            <<03603>>37446000
                                                               <<03603>>37448000
   WHILE I <= FLNUMEXTS DO                                     <<03603>>37450000
      BEGIN                                                    <<03603>>37452000
      EXTADR := FLABDBL(EXT0+I);                               <<03603>>37454000
      IF <> THEN                                               <<03603>>37456000
         BEGIN                                                 <<03603>>37458000
         LDEV := GETLDEV(EXTVOL);                              <<03603>>37460000
         IF <> THEN ERRMESSAGE( M452);                         <<03603>>37462000
         EXTVOL := 0;                                          <<03603>>37464000
         DUM1 := D'L(GETEXTLEN(I)));                           <<03603>>37466000
         RETDISCSPACE(LDEV,DUM1,EXTADR);                       <<03603>>37468000
         IF = THEN                                             <<03603>>37470000
            SECTORS := SECTORS+DUM1                            <<03603>>37472000
         ELSE                                                  <<03603>>37474000
            MESSAGE( M328); << RETURNING SPACE >>              <<03603>>37476000
         END;                                                  <<03603>>37478000
      I := I+1;  << NEXT EXTENT >>                             <<03603>>37480000
      END;                                                     <<03603>>37482000
END;                                                           <<03603>>37484000
$CONTROL SEGMENT=DIRECTORY2                                    <<03668>>37486000
       <<--------------------------------->>                   <<03668>>37488000
       <<          PURGE A FILE           >>                   <<03668>>37490000
       <<--------------------------------->>                   <<03668>>37492000
INTEGER PROCEDURE FPURGE(FNAME, GUNAME, ANAME);                <<03668>>37494000
ARRAY                                                          <<03668>>37496000
   FNAME,       << 4-WORD ARRAY HOLDING FILE NAME >>           <<03668>>37498000
   GUNAME,      << 4-WORD ARRAY HOLDING GROUP NAME >>          <<03668>>37500000
   ANAME;       << 4-WORD ARRAY HOLDING ACCOUNT NAME >>        <<03668>>37502000
                                                               <<03668>>37504000
COMMENT                                                        <<03668>>37506000
PURGES A FILE.  FPURGE RELEASES THE SPACE HELD BY THE          <<03668>>37508000
GIVEN FILE AND REMOVES THE DIRECTORY ENTRY.   IF THE           <<03668>>37510000
FILE WAS NOT FOUND IN THE DIRECTORY, IT RETURNS WITH           <<03668>>37512000
AN ERROR NUMBER.  THE RETURNS ARE:                             <<03668>>37514000
                                                               <<03668>>37516000
             0   FILE PURGED OK                                <<03668>>37518000
             2   FILE NOT FOUND                                <<03668>>37520000
             4   FILE PURGED BUT UNABLE TO RELEASE SPACE       <<03668>>37522000
                 DUE TO FILE LABEL CHECKSUM ERROR              <<03668>>37524000
                                                               <<03668>>37526000
;                                                              <<03668>>37528000
BEGIN                                                          <<03668>>37530000
DOUBLE                                                         <<03668>>37532000
   DUM1,        << THESE THREE DOUBLES ARE USED FOR A     >>   <<03668>>37534000
   DUM2,        << CALL TO DIRECFIND.  DO NOT TOUCH THIS  >>   <<03668>>37536000
   FILEADR;     << DECLARATION.  FILEADR IS THE VOLUME    >>   <<03668>>37538000
                << AND ADDRESS OF THE FILE LABEL.         >>   <<03668>>37540000
ARRAY                                                          <<03668>>37542000
   FILENT(*) = DUM1;     << ARRAY FOR DIRECTORY ENTRY >>       <<03668>>37544000
INTEGER                                                        <<03668>>37546000
   FILEADR1 = FILEADR,    << HIGH ORDER WORD OF FILEADR >>     <<03668>>37548000
   FILEADR2 = FILEADR+1,  << LOW ORDER WORD OF FILEADR  >>     <<03668>>37550000
   LDEV;                  << LOGICAL DEVICE NO. OF LABEL >>    <<03668>>37552000
BYTE                                                           <<03668>>37554000
   VOLUME = FILEADR;      << VOLUME NO. OF FILE LABEL >>       <<03668>>37556000
DOUBLE                                                         <<03668>>37558000
   DTEMP,      << DOUBLE WORD TEMP. >>                         <<03668>>37560000
   SECTORS;    << NO. OF SECTORS IN FILE >>                    <<03668>>37562000
INTEGER                                                        <<03668>>37564000
   SECTORS1 = SECTORS,    << HIGH ORDER WORD OF SECTORS >>     <<03668>>37566000
   SECTORS2 = SECTORS+1,  << LOW ORDER WORD OF SECTORS >>      <<03668>>37568000
   DTEMP2 = DTEMP+1;      << LOW ORDER WORD OF DTEMP >>        <<03668>>37570000
                                                               <<03668>>37572000
FPURGE := 0;     << INITIALIZE RETURN >>                       <<03668>>37574000
                                                               <<03668>>37576000
<< GET THE DIRECTORY ENTRY FOR THE FILE >>                     <<03668>>37578000
                                                               <<03668>>37580000
DTEMP := DIRECFIND(FILETYPE,0,ANAME,GUNAME,FNAME,FILENT);      <<03668>>37582000
IF < THEN                                                      <<03668>>37584000
   DIRERROR( DTEMP, BBUF);    << DIRECTORY ERROR >>            <<03668>>37586000
IF > THEN                                                      <<03668>>37588000
   IF DTEMP2 <> 2 THEN         << ERROR OTHER THAN  >>         <<03668>>37590000
      DIRERROR(DTEMP, BBUF)    <<   FILE NOT FOUND  >>         <<03668>>37592000
                                                               <<03668>>37594000
   ELSE                                                        <<03668>>37596000
      BEGIN                                                    <<03668>>37598000
      FPURGE := 2;     << RETURN FILE NOT FOUND >>             <<03668>>37600000
      RETURN;                                                  <<03668>>37602000
      END;                                                     <<03668>>37604000
                                                               <<03668>>37606000
LDEV := GETLDEV(VOLUME);                                       <<03668>>37608000
IF <> THEN ERRMESSAGE( M452);    << INVALID VOLUME NO. >>      <<03668>>37610000
                                                               <<03668>>37612000
FILEADR1 := FILEADR1.(9:7);   << GET RID OF THE VOLUME PART >> <<03668>>37614000
DISC(READ,LDEV,FILEADR,FLAB,128);    << READ THE FILE LABEL >> <<03668>>37616000
                                                               <<03668>>37618000
SECTORS := 0D;     << INITIALIZE NO. SECTORS RELEASED >>       <<03668>>37620000
                                                               <<03668>>37622000
CHECKSUM;          << TAKE FILE LABEL CHECKSUM >>              <<03668>>37624000
IF TOS = FLCHECKSUM THEN              << IF GOOD CHECKSUM,  >> <<03668>>37626000
   SECTORS := -RELEASE'FILE'SPACE     <<    RELEASE SPACE   >> <<03668>>37628000
ELSE                                                           <<03668>>37630000
   BEGIN                                                       <<03668>>37632000
   MESSAGE( M450);        << DON'T TRY RELEASING SPACE >>      <<03668>>37634000
   FPURGE := 4;                                                <<03668>>37636000
   END;                                                        <<03668>>37638000
                                                               <<03668>>37640000
<< REMOVE THE FILE DIRECTORY ENTRY >>                          <<03668>>37642000
                                                               <<03668>>37644000
DTEMP := DIRECPURGEFILE(SECTORS1,SECTORS2,ANAME,GUNAME,FNAME); <<03668>>37646000
IF <> THEN                                                     <<03668>>37648000
   DIRERROR(DTEMP,BBUF);    << DIRECTORY ERROR >>              <<03668>>37650000
                                                               <<03668>>37652000
END;   << FPURGE >>                                            <<03668>>37654000
$CONTROL SEGMENT=DIRECTORY2                                    <<03715>>37656000
     <<--------------------------------------------->>         <<03715>>37658000
     << ADD A FILE TO LIST OF FILES WHICH LOST DATA >>         <<03715>>37660000
     <<--------------------------------------------->>         <<03715>>37662000
LOGICAL PROCEDURE ADD'BADFILE(FNAME);                          <<03715>>37664000
ARRAY                                                          <<03715>>37666000
   FNAME;    << 12-WORD ARRAY CONTAINING FILE NAME >>          <<03715>>37668000
                                                               <<03715>>37670000
COMMENT                                                        <<03715>>37672000
THIS PROCEDURE ADDS A FILE NAME TO AN ARRAY CONTAINING A       <<03715>>37674000
LIST OF FILES WHICH LOST DATA DURING SPARING AND WHICH         <<03715>>37676000
THE USER WILL BE GIVEN THE OPPORTUNITY TO SAVE.  IF THERE      <<03715>>37678000
IS NO ROOM IN THE TABLE, IT RETURNS FALSE.                     <<03715>>37680000
;                                                              <<03715>>37682000
BEGIN                                                          <<03715>>37684000
EQUATE                                                         <<03715>>37686000
   ENT'SIZE = 12,      << SIZE OF FILE ENTRY IN WORDS >>       <<03715>>37688000
   NUM'ENTRIES = 0,    << NUMBER OF FILE ENTRIES IN TABLE >>   <<03715>>37690000
   EMPTY = 0;          << SIGNIFIES EMPTY ENTRY >>             <<03715>>37692000
INTEGER                                                        <<03715>>37694000
   INDEX;             << CURRENT INDEX INTO TABLE >>           <<03715>>37696000
                                                               <<03715>>37698000
                                                               <<03715>>37700000
<< FIND FIRST EMPTY ENTRY >>                                   <<03715>>37702000
                                                               <<03715>>37704000
ADD'BADFILE := FALSE;     << INITIALIZE RETURN >>              <<03715>>37706000
INDEX := 0;                                                    <<03715>>37708000
                                                               <<03715>>37710000
WHILE (INDEX := INDEX + ENT'SIZE)         << SEARCH UNTIL   >> <<03715>>37712000
       <= (LDMAP'SIZE - ENT'SIZE) DO      <<   END OF TABLE >> <<03715>>37714000
                                                               <<03715>>37716000
   IF LDMAPBUF(INDEX) = EMPTY THEN                             <<03715>>37718000
      BEGIN                            << FOUND EMPTY ENTRY >> <<03715>>37720000
                                       << SAVE FILE NAME    >> <<03715>>37722000
      MOVE LDMAPBUF(INDEX) := FNAME,(ENT'SIZE);                <<03715>>37724000
                                    << INCREMENT FILE COUNT >> <<03715>>37726000
      LDMAPBUF(NUM'ENTRIES) := LDMAPBUF(NUM'ENTRIES) + 1;      <<03715>>37728000
      ADD'BADFILE := TRUE;                                     <<03715>>37730000
      RETURN;                          << SUCCESSFUL RETURN >> <<03715>>37732000
      END;                                                     <<03715>>37734000
                                                               <<03715>>37736000
END;   << ADD'BADFILE >>                                       <<03715>>37738000
$CONTROL SEGMENT=DIRECTORY2                                    <<03668>>37740000
     <<------------------------------------------------>>      <<03668>>37742000
     << REMOVE FILE FROM LIST OF FILES WHICH LOST DATA >>      <<03668>>37744000
     <<------------------------------------------------>>      <<03668>>37746000
PROCEDURE REMOVE'BADFILE(FNAME);                               <<03668>>37748000
ARRAY                                                          <<03668>>37750000
   FNAME;      << 12-WORD ARRAY CONTAINING FILE NAME >>        <<03668>>37752000
                                                               <<03668>>37754000
COMMENT                                                        <<03668>>37756000
REMOVES THE GIVEN FILE NAME FROM THE TABLE OF FILES            <<03668>>37758000
WHICH LOST DATA.                                               <<03668>>37760000
;                                                              <<03668>>37762000
BEGIN                                                          <<03668>>37764000
EQUATE                                                         <<03668>>37766000
   ENT'SIZE = 12,     << SIZE OF ENTRY IN TABLE >>             <<03668>>37768000
   NUM'ENTRIES = 0,   << NUMBER OF FILE ENTRIES IN TABLE >>    <<03668>>37770000
   EMPTY = 0;         << SIGNIFIES EMPTY ENTRY >>              <<03668>>37772000
INTEGER                                                        <<03668>>37774000
   INDEX;             << CURRENT INDEX INTO TABLE >>           <<03668>>37776000
BYTE ARRAY                                                     <<03668>>37778000
   BLDMAPBUF(*)=LDMAPBUF,     << BYTE POINTER TO TABLE >>      <<03668>>37780000
   BFNAME(*)=FNAME;   << BYTE POINTER TO FILE NAME >>          <<03668>>37782000
                                                               <<03668>>37784000
                                                               <<03668>>37786000
INDEX := 0;                                                    <<03668>>37788000
                                                               <<03668>>37790000
WHILE (INDEX := INDEX + ENT'SIZE)      << SEARCH ALL TABLE >>  <<03715>>37792000
       <= (LDMAP'SIZE - ENT'SIZE) DO                           <<03715>>37794000
   BEGIN                                                       <<03668>>37796000
                                                               <<03668>>37798000
   IF LDMAPBUF(INDEX) <> EMPTY THEN                            <<03668>>37800000
                                                               <<03668>>37802000
      << IF WE FIND THE FILE NAME WE'RE LOOKING FOR, >>        <<03668>>37804000
      << REMOVE IT FROM THE LIST.                    >>        <<03668>>37806000
                                                               <<03668>>37808000
      IF BFNAME = BLDMAPBUF(INDEX*2),(ENT'SIZE*2) THEN         <<03668>>37810000
         BEGIN                                                 <<03668>>37812000
         LDMAPBUF(NUM'ENTRIES) := LDMAPBUF(NUM'ENTRIES) - 1;   <<03668>>37814000
         LDMAPBUF(INDEX) := EMPTY;                             <<03668>>37816000
         END;                                                  <<03668>>37818000
                                                               <<03668>>37820000
   END;                                                        <<03715>>37824000
                                                               <<03668>>37826000
END;   << REMOVE'BADFILE >>                                    <<03668>>37828000
$CONTROL SEGMENT=DIRECTORY2                                    <<03668>>37830000
      <<------------------------------------------->>          <<03668>>37832000
      <<  ASK IF USER WANTS TO SAVE DAMAGED FILES  >>          <<03668>>37834000
      <<------------------------------------------->>          <<03668>>37836000
PROCEDURE FILE'DAMAGE;                                         <<03668>>37838000
                                                               <<03668>>37840000
COMMENT                                                        <<03668>>37842000
THIS PROCEDURE LETS THE USER DECIDE WHAT TO DO WITH FILES      <<03668>>37844000
WHICH LOST DATA DURING SPARING (REASSIGNING).  THE USER        <<03668>>37846000
IS GIVEN THE OPTION OF PURGING ALL FILES WHICH LOST DATA,      <<03668>>37848000
OR SAVING ANY SELECTED FILE.                                   <<03668>>37850000
                                                               <<03668>>37852000
                                                               <<03668>>37854000
                                                               <<03668>>37856000
;                                                              <<03668>>37858000
BEGIN                                                          <<03668>>37860000
EQUATE                                                         <<03668>>37862000
   ENT'SIZE = 12,    << SIZE OF FILE ENTRY IN TABLE >>         <<03668>>37864000
   NUM'ENTRIES = 0,  << NUMBER OF FILE ENTRIES IN TABLE >>     <<03668>>37866000
   EMPTY = 0;        << SIGNIFIES AN EMPTY ENTRY >>            <<03668>>37868000
INTEGER                                                        <<03668>>37870000
   INDEX,            << INDEX INTO TABLE >>                    <<03668>>37872000
   BYTES;            << TEMP. FOR NO. OF BYTES IN A STRING >>  <<03668>>37874000
BYTE ARRAY                                                     <<03668>>37876000
   STRING(0:27);     << STRING TO HOLD FILE NAME >>            <<03668>>37878000
                                                               <<03668>>37880000
IF LDMAPBUF(NUM'ENTRIES) = 0 THEN     << IF NO BAD FILES,  >>  <<03668>>37882000
   RETURN;                            <<    JUST RETURN    >>  <<03668>>37884000
                                                               <<03668>>37886000
BLANKLINE;                                                     <<03668>>37888000
MESSAGE(M2286);       << FOLLOWING FILES LOST DATA >>          <<03668>>37890000
                                                               <<03668>>37892000
INDEX := 0;                                                    <<03668>>37894000
WHILE (INDEX := INDEX + ENT'SIZE)       << PRINT ALL FILES >>  <<03715>>37896000
       <= (LDMAP'SIZE - ENT'SIZE) DO    << WHICH LOST DATA >>  <<03715>>37898000
                                                               <<03668>>37900000
   IF LDMAPBUF(INDEX) <> EMPTY THEN                            <<03668>>37902000
      BEGIN                                                    <<03668>>37904000
      BYTES := MOVE'FNAME( BINBUF, LDMAPBUF(INDEX),            <<03714>>37906000
                                   LDMAPBUF(INDEX+4),          <<03714>>37908000
                                   LDMAPBUF(INDEX+8));         <<03714>>37910000
      PRINT( INBUF, -BYTES, 0);                                <<03668>>37912000
      END;                                                     <<03668>>37914000
                                                               <<03668>>37916000
                                                               <<03715>>37920000
BLANKLINE;                                                     <<03668>>37922000
                                                               <<03668>>37924000
IF LGETYESNO(M2287) THEN       << PURGE ALL FILES WHICH >>     <<03668>>37926000
   BEGIN                       <<    LOST DATA          >>     <<03668>>37928000
                                                               <<03668>>37930000
   BLANKLINE;                                                  <<03668>>37932000
   INDEX := 0;                                                 <<03668>>37934000
                                                               <<03668>>37936000
   WHILE (INDEX := INDEX + ENT'SIZE)    << SEARCH ALL TABLE >> <<03715>>37938000
          <= (LDMAP'SIZE - ENT'SIZE) DO                        <<03715>>37940000
                                                               <<03668>>37942000
      IF LDMAPBUF(INDEX) <> EMPTY THEN    << A REAL ENTRY >>   <<03668>>37944000
         BEGIN                                                 <<03668>>37946000
         BYTES := MOVE'FNAME( BINBUF, LDMAPBUF(INDEX),         <<03714>>37948000
                                      LDMAPBUF(INDEX+4),       <<03714>>37950000
                                      LDMAPBUF(INDEX+8));      <<03714>>37952000
         MOVE BINBUF(BYTES) := " PURGED";                      <<03668>>37954000
         PRINT( INBUF, -BYTES-7, 0);                           <<03668>>37956000
         FPURGE(LDMAPBUF(INDEX),LDMAPBUF(INDEX+4),             <<03668>>37958000
                                LDMAPBUF(INDEX+8));            <<03668>>37960000
                                                               <<03668>>37962000
         END;                                                  <<03668>>37964000
                                                               <<03668>>37966000
   END                                                         <<03668>>37972000
                                                               <<03668>>37974000
ELSE                                                           <<03668>>37976000
   BEGIN       << ASK USER WHETHER TO SAVE EACH FILE >>        <<03668>>37978000
                                                               <<03668>>37980000
   BLANKLINE;                                                  <<03668>>37982000
                                                               <<03668>>37984000
   INDEX := 0;                                                 <<03668>>37986000
                                                               <<03668>>37988000
   WHILE (INDEX := INDEX + ENT'SIZE)    << SEARCH ALL TABLE >> <<03715>>37990000
          <= (LDMAP'SIZE - ENT'SIZE) DO                        <<03715>>37992000
                                                               <<03668>>37994000
      IF LDMAPBUF(INDEX) <> EMPTY THEN                         <<03668>>37996000
         BEGIN                                                 <<03668>>37998000
                                                               <<03668>>38000000
         STRING(0) := MOVE'FNAME( STRING(1), LDMAPBUF(INDEX),  <<03714>>38002000
                                          LDMAPBUF(INDEX+4),   <<03714>>38004000
                                          LDMAPBUF(INDEX+8));  <<03714>>38006000
                                                               <<03668>>38008000
         IF NOT LGETYESNO(M2288,,,,,STRING) THEN   << SAVE? >> <<03668>>38010000
            BEGIN                                              <<03668>>38012000
            BYTES := MOVE'FNAME( BINBUF, LDMAPBUF(INDEX),      <<03714>>38014000
                                         LDMAPBUF(INDEX+4),    <<03714>>38016000
                                         LDMAPBUF(INDEX+8));   <<03714>>38018000
            MOVE BINBUF(BYTES) := " PURGED";                   <<03668>>38020000
            PRINT( INBUF, -BYTES-7, 0);                        <<03668>>38022000
                                                               <<03668>>38024000
            FPURGE( LDMAPBUF(INDEX), LDMAPBUF(INDEX+4),        <<03668>>38026000
                                     LDMAPBUF(INDEX+8));       <<03668>>38028000
                                                               <<03668>>38030000
            END;                                               <<03668>>38032000
         END;                                                  <<03668>>38034000
                                                               <<03668>>38036000
   END;                                                        <<03668>>38042000
END;   << FILE'DAMAGE >>                                       <<03668>>38044000
                                                               <<03668>>38046000
$CONTROL SEGMENT=FILEIO                                        <<03668>>38048000
          <<--------------                                              38050000
            REPLACE FILE                                                38052000
          -------------->>                                              38054000
  PROCEDURE FREPLACE(DONOTREAD);                                        38056000
    VALUE DONOTREAD;                                                    38058000
    LOGICAL DONOTREAD; <<TRUE IF DON'T READ NEW FILE FROM TAPE>>        38060000
    OPTION VARIABLE;                                                    38062000
    COMMENT                                                             38064000
      DELETES THE FILE WHOSE FIRST 1024 WORDS ARE IN LBUF FROM THE      38066000
    DIRECTORY, RETURNS ITS SPACE AND INSERTS A NEW COPY READ FROM TAPE; 38068000
      BEGIN                                                             38070000
        LOGICAL VAR=Q-4;                                                38072000
        DOUBLE DUM1,DUM2,FILEADR;                                       38074000
        ARRAY FILENT(*)=DUM1;                                           38076000
        INTEGER I,LEN,FILEADR1=FILEADR,                        <<03603>>38078000
          FILEADR2=FILEADR1+1,LDEV;                                     38080000
        BYTE VOLUME = FILEADR;                                 <<03603>>38082000
        DOUBLE SECTORS;                                                 38084000
        INTEGER SECTORS1=SECTORS,SECTORS2=SECTORS+1;                    38086000
        DOUBLE DTEMP, DISCADR, WORDS;                          <<03603>>38088000
        LOGICAL FIRSTTIME; << THE FIRST REC. OF TAPE HAS >>    <<03603>>38090000
                           << ALREADY BEEN READ BEFORE   >>    <<03603>>38092000
                           << ENTERING FREPLACE          >>    <<03603>>38094000
        DOUBLE ARRAY SIZES(0:31);                              <<03603>>38096000
                                                               <<03603>>38098000
          MOVE FLAB := TAPEBUF,(128);                          <<03603>>38100000
          CHECKSUM;                                            <<03603>>38102000
          IF TOS <> FLCHECKSUM THEN                            <<03603>>38104000
             ERRMESSAGE( M451);                                <<03603>>38106000
          TOS := DIRECFIND(FILETYPE,0,TAPEBUF(8),TAPEBUF(4),   <<03603>>38108000
             TAPEBUF,FILENT);                                  <<03603>>38110000
          IF < THEN DIRERROR(*,BLBUF);                                  38112000
          IF > THEN IF S0<>2 THEN DIRERROR(*,BLBUF)                     38114000
          ELSE GOTO READNEW;                                            38116000
          DDEL;                                                         38118000
          SECTORS := 0D;                                                38120000
          IF RELOAD THEN NUSERFILES:=NUSERFILES-1                       38122000
          ELSE                                                          38124000
           BEGIN                                                        38126000
            LDEV := GETLDEV(VOLUME);                           <<03603>>38128000
            IF <> THEN ERRMESSAGE( M452);                      <<03603>>38130000
            FILEADR1 := FILEADR1.(9:7);                                 38132000
            DISC(READ,LDEV,FILEADR,FLAB,128);                           38134000
            CHECKSUM;                                          <<03603>>38138000
            IF TOS = FLCHECKSUM THEN                           <<03603>>38140000
               SECTORS := -RELEASE'FILE'SPACE                  <<03603>>38142000
            ELSE                                               <<03603>>38144000
               MESSAGE( M450);                                 <<03603>>38146000
           END;                                                         38148000
          TOS := DIRECPURGEFILE(SECTORS1,SECTORS2,TAPEBUF(8),  <<03603>>38150000
             TAPEBUF(4),TAPEBUF);                              <<03603>>38152000
          IF <> THEN DIRERROR(*,BLBUF);                                 38154000
  READNEW:DDEL;                                                         38156000
          MOVE FLAB := TAPEBUF,(128);                          <<03603>>38158000
          I := 0;                                                       38160000
          SECTORS := 0D;                                                38162000
          DO IF FLABDBL(EXT0+I)=0D THEN SIZES(I):=0D                    38164000
          ELSE                                                          38166000
            BEGIN  <<CALCULATE EXTENT SIZE>>                            38168000
              TOS := 0;                                                 38170000
              TOS := GETEXTLEN(I);                                      38172000
              ASSEMBLE(DDUP);                                           38174000
              SECTORS := TOS+SECTORS;                                   38176000
              SIZES(I) := TOS;                                          38178000
            END                                                         38180000
          UNTIL (I:=I+1) > FLNUMEXTS;                                   38182000
          SUPERDISCSPACE(-SYSDISC,FLNUMEXTS+1,0,SIZES,FLEXT0);          38184000
          IF <> THEN ERRMESSAGE(M326, SYSDISC); <<OUT OF DISC>><<MPEIV>>38186000
          FILEADR := FLABDBL(EXT0);                                     38188000
          VOLUME := SYSVOL;                                    <<03603>>38190000
          FLCLASS := "1 ";                                              38192000
          IF VAR AND DONOTREAD THEN GO WRITELAB;                        38194000
          FIRSTTIME := TRUE; << FIRST REC. ALREADY READ >>     <<03603>>38196000
          I := 0;                                                       38198000
          DO                                                            38200000
            BEGIN  <<READ FILE FROM TAPE>>                     <<03603>>38202000
            DISCADR := FLABDBL(EXT0+I);                        <<03603>>38206000
            IF <> THEN                                         <<03603>>38208000
               BEGIN                                           <<03603>>38210000
               TOS := FLABDBL(X);                              <<03603>>38212000
               BS1 := SYSVOL; << INSERT SYSTEM VOL NR. >>      <<03603>>38214000
               FLABDBL(X) := TOS;                              <<03603>>38216000
               END;                                            <<03603>>38218000
            WORDS := SIZES(I) * 128D;                          <<03603>>38220000
            WHILE WORDS <> 0D DO                               <<03603>>38222000
               BEGIN                                           <<03603>>38224000
               LEN := IF WORDS > DOUBLE(TAPERECSIZE) THEN      <<03603>>38226000
                  TAPERECSIZE ELSE LOGICAL(WORDS);             <<03603>>38228000
               IF NOT FIRSTTIME THEN                           <<03603>>38230000
                  BEGIN  << MUST READ REC. FROM TAPE >>        <<03603>>38232000
                  COLD'LOAD'MEDIA( READ, TAPEBUF, LEN);        <<03603>>38234000
                  WHILE END'OF'TAPE DO                         <<03603>>38236000
                     BEGIN                                     <<03603>>38238000
                     NEXTREEL( TAPEBUF);                       <<03603>>38240000
                     COLD'LOAD'MEDIA( READ, TAPEBUF, LEN);     <<03603>>38242000
                     END;                                      <<03603>>38244000
                  END;                                         <<03603>>38246000
               FIRSTTIME := FALSE;                             <<03603>>38248000
               DISC(WRITE,SYSDISC,DISCADR,TAPEBUF,LEN);        <<03603>>38250000
               DISCADR := DISCADR+DOUBLE(LEN/128);             <<03603>>38252000
               WORDS := WORDS-DOUBLE(LEN);                     <<03603>>38254000
               END;                                            <<03603>>38256000
          END UNTIL (I:=I+1) > FLNUMEXTS;                      <<03603>>38258000
  WRITELAB:FLCLID := COLDLOADID;                                        38260000
          FLFCBVECT := 0;                                               38262000
          TOS := 0;                                                     38264000
          I := 0;                                                       38266000
          DO IF BFLAB=PROTECTED(I*8),(8) THEN TOS.(15:1):=1             38268000
          UNTIL (I:=I+1)=NPROTECTED;                                    38270000
          TOS.(4:4) := SYSDISCSUBTYPE;                                  38272000
          TOS.(8:6) := SYSDISCTYPE;                                     38274000
          FLAB(28) := TOS;                                              38276000
          TOS := DIRECINSERTFILE(SECTORS,FLAB(8),FLAB(4),FLAB,FILEADR); 38278000
          IF <> THEN DIRERROR(*,BFLAB);                                 38280000
          DDEL;                                                         38282000
          VOLUME := 0;                                         <<03603>>38284000
          FLPVINFO:=0; <<IN CASE SYSTEM PROG CAME FROM PV>>    <<00678>>38286000
          CHECKSUM;           <<NEW CHECKSUM ON TOS>>                   38288000
          FLCHECKSUM := TOS;  <<UPDATE FLAB>>                           38290000
          DISC(WRITE,SYSDISC,FILEADR,FLAB,128);                         38292000
      END <<FREPLACE>> ;                                                38294000
          <<--------------------------------                            38296000
            GET DISC SPACE FOR SPOOL FILES                              38298000
          -------------------------------->>                            38300000
                                                                        38302000
  LOGICAL PROCEDURE VDEVREPLACED(XDDEP);                                38304000
    VALUE XDDEP;                                                        38306000
    INTEGER XDDEP;                                                      38308000
      COMMENT: GETS SPACE FOR SPOOLFILES DURING RECOVER                 38310000
         LOST DISC SPACE;                                               38312000
      BEGIN                                                             38314000
        INTEGER I,J,LDEV;                                               38316000
        DOUBLE FILEADR,    <<DISC ADDRESS OF FILE LABEL>>               38318000
               EXTADR,     <<DISC ADDRESS OF EXTENT>>                   38320000
               NUMSECTORS; <<# OF SECTORS IN EXTENT>>                   38322000
          TOS := XDD(XDDEP+FLABADR1);                                   38324000
          LDEV := S0.(0:8);                                             38326000
          TOS := TOS.(8:8);                                             38328000
          TOS := XDD(X:=X+1);                                           38330000
          FILEADR := TOS;                                               38332000
          DISC(READ,LDEV,FILEADR,FLAB,128);                             38334000
          I := -1;                                                      38336000
          WHILE (I:=I+1)<=FLNUMEXTS DO                                  38338000
            BEGIN                                                       38340000
            TOS := FLABDBL(EXT0+I);                                     38342000
            IF = THEN                                                   38344000
              BEGIN                                                     38346000
              DDEL;                                                     38348000
              GOTO NEXTEXT;                                             38350000
              END;                                                      38352000
            J := S1.(0:8);  <<VOLUME INDEX>>                            38354000
            IF = OR J>HVOL THEN GOTO DISCERR;                           38356000
            S1.(0:8) := 0;                                              38358000
            EXTADR := TOS;  <<ADDRESS OF EXTENT>>                       38360000
            LDEV := VTAB(J*VTABSIZE+VTAB12).VTABLDEV;                   38362000
            IF = OR LDEV>HLDEV THEN GOTO DISCERR;                       38364000
            NUMSECTORS := IF I<FLNUMEXTS THEN                           38366000
              DOUBLE(FLEXTSIZE) ELSE DOUBLE(FLLASTEXTSIZE);             38368000
            TOS := Get'Specific'Disc'Space (ldev,extadr,       <<03551>>38370000
                                            numsectors);       <<03551>>38372000
            IF TOS <> 0 THEN                                   <<03551>>38374000
  DISCERR:                                                              38376000
              BEGIN  <<DISC ERROR>>                                     38378000
              VDEVREPLACED := FALSE;                                    38380000
              XDD(XDDEP) := 0;                                          38382000
              J := -1;                                                  38384000
            WHILE (J:=J+1)<I DO                                         38386000
                BEGIN  <<RETURN SPACE ALREADY GOTTEN>>                  38388000
                TOS := FLABDBL(EXT0+J);                                 38390000
                IF <> THEN                                     <<00.+4>>38392000
                  BEGIN                                        <<00.+4>>38394000
                  LDEV := VTAB(S1.(0:8)*VTABSIZE+VTAB12).VTABLDEV;      38396000
                  S1.(0:8) := 0;                               <<00.+4>>38398000
                  EXTADR := TOS;                               <<00.+4>>38400000
                  Return'Disc'Space (ldev, extadr,             <<03551>>38402000
                                     DOUBLE(flextsize));       <<03551>>38404000
                  END;                                         <<00.+4>>38406000
                END;                                                    38408000
              RETURN;                                                   38410000
              END;                                                      38412000
  NEXTEXT:  END;                                                        38414000
          VDEVREPLACED := TRUE;                                         38416000
    END <<VDEVREPLACED>>;                                               38418000
                                                                        38420000
          <<----------------------                                      38422000
            REMOVE XDD SUB ENTRY                                        38424000
          ---------------------->>                                      38426000
                                                                        38428000
  PROCEDURE REMOVEXDDSUBENTRY(XDDEP);                                   38430000
    VALUE XDDEP;                                                        38432000
    INTEGER XDDEP;                                                      38434000
      BEGIN                                                             38436000
        COMMENT:REMOVES ENTRY POINTED TO XDDEP FROM THE                 38438000
         QUEUE AND FIXES UP LINKS;                                      38440000
        INTEGER I,J,                                                    38442000
                HEADP,  <<INDEX TO HEAD>>                               38444000
                PREX;  <<INDEX TO ENTRY THAT PRECEEDS CURRENT>>         38446000
          PREX:=HEADP:=XDD(XDDEP+XDDHEADX)*XDDHEADSIZE+1;               38448000
          WHILE XDD(PREX) <> XDDEP AND    <<SEARCH TIL FOUND>> <<02614>>38450000
            XDD(PREX) >= XDD(SUBAREAP) DO << OR DETECT ERROR>> <<02614>>38452000
            PREX := XDD(PREX)+LINKW;                                    38454000
          IF XDD(PREX) < XDD(SUBAREAP)  << ERROR: ENTRY NOT >> <<02614>>38456000
            THEN GOTO REMXDDXIT;        << IN LIST--SHOULD  >> <<02614>>38458000
                                        <<NOT HAPPEN--IGNORE>> <<02614>>38460000
          XDD(PREX) := XDD(XDDEP+LINKW);                                38462000
          IF XDD(PREX)=CHAINEND THEN                                    38464000
            BEGIN <<FIX UP TAIL>>                                       38466000
            IF PREX<>HEADP THEN                                         38468000
              TOS := PREX-LINKW ELSE TOS := HEADP;                      38470000
            XDD(HEADP+1) := TOS;                                        38472000
            END;                                                        38474000
  REMXDDXIT:                                                   <<02614>>38476000
      END <<REMOVEXDDSUBENTRY>>;                                        38478000
                                                                        38480000
          <<--------------------                                        38482000
            DELETE SPOOL FILES                                          38484000
          -------------------->>                                        38486000
                                                                        38488000
   PROCEDURE DELETEVDEV(XDDEP);                                         38490000
    VALUE XDDEP;                                                        38492000
    INTEGER XDDEP;                                                      38494000
      COMMENT: RETURNS SPACE TO DISC FREE SPACE TABLE                   38496000
        FOR SPOOL FILES DELETED ON WARMSTART;                           38498000
      BEGIN                                                             38500000
        INTEGER LDEV;        <<LDEV # OF SPOOL FILE>>          <<03603>>38504000
        DOUBLE  FILEADR;     <<DISC ADDRESS OF FILE LABEL>>    <<03603>>38506000
          TOS := XDD(XDDEP+FLABADR1);                                   38510000
          IF S0=0 THEN GO REMOVE;                                       38512000
          LDEV := S0.(0:8);                                             38514000
          TOS := TOS.(8:8);                                             38516000
          TOS := XDD(X:=X+1);                                           38518000
          FILEADR := TOS;                                               38520000
          DISC(READ,LDEV,FILEADR,FLAB,128);                             38522000
          RELEASE'FILE'SPACE;                                  <<03603>>38526000
  REMOVE: REMOVEXDDSUBENTRY(XDDEP);                                     38528000
      END  <<DELETEVDEV>>;                                              38530000
                                                                        38532000
  PROCEDURE SCHEDULEJMATENTRIES;                                        38534000
    BEGIN                                                               38536000
    INTEGER TEMP,                                                       38538000
            CURX, <<INDEX TO ENTRY CURRENTLY BEING ADDED>>              38540000
            PREX, <<INDEX TO ENTRY PRECEDING CURRENT>>                  38542000
            FOLX; <<INDEX TO ENTRY FOLLOWING CURRENT>>                  38544000
    EQUATE TIME1 = 19,                                                  38546000
           TIME2 = 20;                                                  38548000
    DEFINE INPRI = (12:4)#;                                             38550000
          JMAT(SCHEDHEADP) := 0;  <<MAKE QUEUE EMPTY>>                  38552000
          JMAT(SCHEDTAILP) := SCHEDHEADP;                               38554000
          CURX := 0;                                                    38556000
          TEMP := JMAT(0).(8:8)&LSL(7)-JMATSUBSIZE;                     38558000
          WHILE(CURX:=CURX+JMATSUBSIZE)<=TEMP DO                        38560000
            BEGIN                                                       38562000
            IF JMAT(CURX)<>NULL THEN                                    38564000
            IF JMAT(SCHEDHEADP)=NULL THEN                               38566000
              BEGIN <<EMPTY QUEUE>>                                     38568000
              JMAT(CURX+LINKW) := CHAINEND;                             38570000
              TOS := CURX;                                              38572000
              JMAT(SCHEDHEADP) := S0;                                   38574000
              JMAT(SCHEDTAILP) := TOS;                                  38576000
              END                                                       38578000
            ELSE                                                        38580000
              BEGIN                                                     38582000
              IF JMAT(CURX).STATEFLD=ERRORSTATE THEN                    38584000
  ADDTOFRONT:   BEGIN                                                   38586000
                JMAT(CURX+LINKW) := JMAT(SCHEDHEADP);                   38588000
                JMAT(SCHEDHEADP) := CURX;                               38590000
                GOTO ENDOFLOOP;                                         38592000
                END;                                                    38594000
              FOLX := JMAT(SCHEDHEADP);                                 38596000
              IF JMAT(FOLX).STATEFLD<>ERRORSTATE THEN GO FINDPRI;       38598000
              PREX := FOLX;                                             38600000
              WHILE(FOLX:=JMAT(PREX+LINKW))<>NULL DO                    38602000
                IF JMAT(FOLX).STATEFLD<>ERRORSTATE THEN                 38604000
                  GO FINDPRI ELSE PREX := FOLX;                         38606000
  ADDTOEND:   JMAT(CURX+LINKW) := CHAINEND;                             38608000
              JMAT(PREX+LINKW) := CURX;                                 38610000
              JMAT(SCHEDTAILP) := CURX;                                 38612000
              GOTO ENDOFLOOP;                                           38614000
  FINDPRI:    WHILE JMAT(FOLX).INPRI>JMAT(CURX).INPRI DO                38616000
                BEGIN                                                   38618000
                PREX := FOLX;                                           38620000
                IF (FOLX:=JMAT(PREX+LINKW))=CHAINEND THEN GO            38622000
                  ADDTOEND;                                             38624000
                END;                                                    38626000
  TESTAGAIN:  IF JMAT(FOLX).INPRI=JMAT(CURX).INPRI THEN                 38628000
                BEGIN                                                   38630000
                IF JMAT(FOLX+TIME1)>JMAT(CURX+TIME1) THEN GO ADDHERE;   38632000
                IF JMAT(FOLX+TIME1)=JMAT(CURX+TIME1) THEN               38634000
                  BEGIN                                                 38636000
                  TOS := JMAT(FOLX+TIME2);                              38638000
                  TOS := JMAT(X:=X+1);                                  38640000
                  TOS := JMAT(CURX+TIME2);                              38642000
                  TOS := JMAT(X:=X+1);                                  38644000
                  ASSEMBLE(DCMP);                                       38646000
                  IF >= THEN GO ADDHERE;                                38648000
                  END;                                                  38650000
                PREX := FOLX;                                           38652000
                IF(FOLX:=JMAT(PREX+LINKW))=CHAINEND THEN                38654000
                  GO ADDTOEND ELSE GO TESTAGAIN;                        38656000
                END                                                     38658000
              ELSE                                                      38660000
  ADDHERE:      BEGIN                                                   38662000
                IF JMAT(SCHEDHEADP)=FOLX THEN GO ADDTOFRONT;            38664000
                JMAT(CURX+LINKW) := JMAT(PREX+LINKW);                   38666000
                JMAT(PREX+LINKW) := CURX;                               38668000
                END;                                                    38670000
              END;                                                      38672000
  ENDOFLOOP:END;                                                        38674000
      END  <<SCHEDULEJMATENTRIES>>;                                     38676000
$PAGE                                                                   38678000
$CONTROL SEGMENT=FILEIO                                                 38680000
                                                                        38682000
                                                                        38684000
          <<-----------                                                 38686000
            OPEN FILE                                                   38688000
          ----------->>                                                 38690000
  INTEGER PROCEDURE FOPEN(NAME);                                        38692000
    BYTE ARRAY NAME;                                                    38694000
    COMMENT                                                             38696000
      READS THEN FILELABEL FOR THE REQUESTED FILE AND MOVES THE INFO    38698000
    INTO THE FCB;                                                       38700000
      BEGIN                                                             38702000
        DOUBLE DUM1,DUM2,FILEADR;                                       38704000
        INTEGER FILEADR1=FILEADR;                                       38706000
        POINTER FILENAME;                                      <<04306>>38708000
        ARRAY FILENTRY(*)=DUM1;                                <<04306>>38710000
        BYTE VOLUME = FILEADR;                                 <<03603>>38712000
        INTEGER FCBNDX;                                                 38714000
        INTEGER I, LDEV;                                       <<03603>>38716000
          @FILENAME := WORDADDRESS(NAME);                      <<04306>>38718000
          TOS := DIRECFIND(FILETYPE,0,SYSACCT,PUBGRP,FILENAME,FILENTRY);38720000
          IF <> THEN DIRERROR(*,NAME);                                  38722000
          DDEL;                                                         38724000
          LDEV := GETLDEV(VOLUME);                             <<03603>>38726000
          IF <> THEN ERRMESSAGE( M452);                        <<03603>>38728000
          VOLUME := 0;                                         <<03603>>38730000
          DISC(READ,LDEV,FILEADR,FLAB,128);                    <<03716>>38732000
          CHECKSUM;                                            <<03603>>38734000
          IF TOS <> FLCHECKSUM THEN                            <<03603>>38736000
             ERRMESSAGE( M450);                                <<03603>>38738000
          TOS := FCBHD;                                                 38740000
          ASSEMBLE(DUP,DUP; STAX);                                      38742000
          FCBNDX := TOS;                                                38744000
          TOS := FCBSIZE;                                               38746000
          ASSEMBLE(DIV,DEL);                                            38748000
          FOPEN := TOS;                                                 38750000
          FCBHD := FCB(X);                                              38752000
          MOVE FCB(FCBNDX+FCBEXTMAP) := FLEXTMAP,(64);                  38754000
          I := 0;                                                       38756000
          WHILE I <= FLNUMEXTS DO                              <<03603>>38758000
             BEGIN                                             <<03603>>38760000
             TOS := FCB(FCBNDX+FCBEXTMAP+I&LSL(1));            <<03603>>38762000
             IF <> THEN                                        <<03603>>38764000
                BEGIN                                          <<03603>>38766000
                BS0 := GETLDEV(BS0);                           <<03603>>38768000
                IF <> THEN ERRMESSAGE( M452);                  <<03603>>38770000
                FCB(X) := TOS;                                 <<03603>>38772000
                END                                            <<03603>>38774000
             ELSE                                              <<03603>>38776000
                DEL;                                           <<03603>>38778000
             I := I+1; << NEXT EXTENT >>                       <<03603>>38780000
             END;                                              <<03603>>38782000
          FCB(FCBNDX+FCBLDEV) := LDEV;                         <<03603>>38784000
          FCB(FCBNDX+FCBEXTSIZE) := FLEXTSIZE;                          38786000
          FCB(FCBNDX+FCBNEXTWORD) := FLNEXTWORD;                        38788000
          FCBDBL(FCBNDX&LSR(1)+FCBEOF) := FLEOF;                        38790000
          FCBDBL(FCBNDX&LSR(1)+FCBFILESIZE) := FLFLIM;                  38792000
      END <<FOPEN>> ;                                                   38794000
          <<------------                                                38796000
            CLOSE FILE                                                  38798000
          ------------>>                                                38800000
  PROCEDURE FCLOSE(FILENUM);                                            38802000
    VALUE FILENUM;                                                      38804000
    INTEGER FILENUM;                                                    38806000
      BEGIN                                                             38808000
          FCB(FILENUM*FCBSIZE) := FCBHD;                                38810000
          FCBHD := X;                                                   38812000
      END <<FCLOSE>> ;                                                  38814000
                                                                        38816000
          <<---------------------                                       38818000
            FILE WRITE AND READ                                         38820000
          --------------------->>                                       38822000
  PROCEDURE FWRITE'(FILENUM,RECORD,COREADR,WORDS);                      38824000
    VALUE FILENUM,RECORD,COREADR,WORDS;                                 38826000
    INTEGER FILENUM,WORDS;                                              38828000
    DOUBLE RECORD,COREADR;                                              38830000
      BEGIN                                                             38832000
        ENTRY FREAD';                                                   38834000
        LOGICAL WRITE:=1;                                               38836000
        INTEGER FCBNDX,FCBDNDX;                                         38838000
        INTEGER WORD1,NREC;                                    <<03603>>38840000
        DOUBLE DISCADR;                                        <<03603>>38842000
        BYTE LDEV = DISCADR;                                   <<03603>>38844000
          GO AROUND;                                                    38846000
  FREAD': WRITE := 0;                                                   38848000
  AROUND:                                                               38850000
          TOS := FILENUM*FCBSIZE;                                       38852000
          DUPLICATE;                                                    38854000
          FCBDNDX := TOS&LSR(1);                                        38856000
          FCBNDX := TOS;                                                38858000
          TOS := 0;                                                     38860000
          TOS := WORDS;                                                 38862000
          IF = THEN RETURN;                                             38864000
          WORD1 := S0;                                                  38866000
          TOS := (TOS+127)&LSR(7);                                      38868000
          NREC := S0;                                                   38870000
          TOS := TOS+RECORD;                                            38872000
          TOS := IF WRITE THEN FCBDBL(FCBFILESIZE+FCBDNDX)              38874000
          ELSE FCBDBL(FCBDNDX+FCBEOF)+1D;                               38876000
          ASSEMBLE(DCMP);                                               38878000
IF >THEN IF WRITE THEN ERRMESSAGE(M28) ELSE ERRMESSAGE(M2455); <<01103>>38880000
AGAIN:                                                         <<03603>>38884000
          TOS := RECORD+DOUBLE(FCB(FCBNDX+FCBSECTOFF));                 38886000
          TOS := FCB(FCBNDX+FCBEXTSIZE);                                38888000
          ASSEMBLE(LDIV);                                               38890000
          TOS := FCB(FCBNDX+FCBEXTSIZE)-S0;  <<# OF RECS LEFT>>         38892000
          IF S0<NREC THEN                                               38894000
            BEGIN                                                       38896000
              ASSEMBLE(DUP,DUP);                                        38898000
              NREC := -TOS+NREC;                                        38900000
              ASSEMBLE(ZERO,XCH);                                       38902000
              RECORD := TOS+RECORD;                                     38904000
              WORD1 := TOS&LSL(7);                                      38906000
            END                                                         38908000
          ELSE                                                          38910000
            BEGIN                                                       38912000
              DEL;                                                      38914000
              WORD1 := WORDS;                                           38916000
            END;                                                        38918000
          ASSEMBLE(STBX,DELB;ZERO,XCH);   <<EXTENT # IN X>>             38920000
          X := X+FCBEXTMAP+FCBDNDX;                                     38922000
          DISCADR := TOS+FCBDBL(X); <<DISC ADDRESS>>           <<03603>>38924000
          DISC'(WRITE,LDEV,DISCADR,COREADR,WORD1);             <<03603>>38928000
          WORDS := WORDS-WORD1;                                         38930000
          IF <= THEN RETURN;                                            38932000
          COREADR := COREADR+DOUBLE(WORD1);                    <<03603>>38934000
          GO AGAIN;                                                     38936000
      END <<FWRITE' AND FREAD'>> ;                                      38938000
  PROCEDURE FWRITE(FILENUM,RECORD,BUF,WORDS);                           38940000
    VALUE FILENUM,RECORD,WORDS;                                         38942000
    INTEGER FILENUM,WORDS;                                              38944000
    DOUBLE RECORD;                                                      38946000
    ARRAY BUF;                                                          38948000
      BEGIN                                                             38950000
        ENTRY FREAD;                                                    38952000
        LOGICAL WRITE := 1;                                             38954000
          GO AROUND;                                                    38956000
  FREAD:  WRITE := 0;                                                   38958000
  AROUND:                                                               38960000
          TOS := FILENUM;                                               38962000
          TOS := RECORD;                                                38964000
          PUSH(DB);                                                     38966000
          TOS := TOS+@BUF;                                              38968000
          TOS := WORDS;                                                 38970000
          IF WRITE THEN TOS:=@FWRITE' ELSE TOS:=@FREAD';                38972000
          ASSEMBLE(PCAL 0);                                             38974000
      END <<FWRITE AND FREAD>> ;                                        38976000
$PAGE "SL AND PROGRAM FILE PROCEDURES"                                  38978000
$CONTROL SEGMENT=SL'PROGRAM                                             38980000
          <<----------------------------------->>              <<00.DL>>38982000
          <<ENTER PROGRAM NAME IN LOADMAP ARRAY>>              <<00.DL>>38984000
          <<----------------------------------->>              <<00.DL>>38986000
  PROCEDURE LDMAP( LOWCST, NSEG, NAME);                        <<03004>>38988000
    VALUE LOWCST, NSEG;                                        <<03004>>38990000
    INTEGER LOWCST,  << FIRST PHYS. CODE SEGMENT USED >>       <<03004>>38992000
            NSEG;    << NO. OF CODE SEGMENTS USED >>           <<03004>>38994000
    BYTE ARRAY NAME;                                                    38996000
    BEGIN                                                      <<03004>>38998000
    BYTE POINTER BLDMAPBUF;                                    <<03004>>39000000
    INTEGER LMBX,   << INDEX TO BLDMAPBUF >>                   <<03004>>39002000
            CSTN;   << CURRENT CST NO.  >>                     <<03004>>39004000
      CSTN := LOWCST - 1;                                      <<03004>>39006000
      WHILE ( CSTN := CSTN+1) < LOWCST+NSEG DO                 <<03004>>39008000
        BEGIN    << PRINT ALL CODE SEGMENTS FOR FILE >>        <<03004>>39010000
        @BLDMAPBUF := BYTEADDRESS(LDMAPBUF);                   <<04306>>39012000
        LMBX:=CSTN MOD 50 * 128 + CSTN / 50 * 32 ;             <<00.DL>>39014000
          NTOA(CSTN,8,BLDMAPBUF(LMBX+2));                      <<01103>>39016000
          MOVE BLDMAPBUF(X:=X+2) := NAME,(8);                  <<00.DL>>39018000
          IF LOADMAP THEN PRINT(LDMAPBUF(LMBX&LSR(1)),-14,0);  <<01103>>39020000
        END;                                                   <<03004>>39022000
    END     << LDMAP >>;                                       <<03004>>39024000
                                                                        39026000
          <<-----------------------------                               39028000
            READ SEGMENT TRANSFER TABLE                                 39030000
          ----------------------------->>                               39032000
  PROCEDURE READSTT(CSTN);                                              39034000
    VALUE CSTN;                                                         39036000
    INTEGER CSTN;    <<PHYSICAL CST NUMBER>>                            39038000
    COMMENT                                                             39040000
      READS THE SEGMENT TRANSFER TABLE OF SEGMENT CSTN INTO BUFFER STT  39042000
    AND SETS STTINDEX TO POINT AT THE LAST WORD;                        39044000
      BEGIN                                                             39046000
          TOS := CST(CSTN&LSL(2)+2);                                    39048000
          STTLDEV := S0.(0:8);  <<LOGICAL DEVICE #>>                    39050000
          TOS:=TOS.(8:8);                                      <<MPEIV>>39052000
          TOS := CST(X:=X+1);                                           39054000
          STTADR := TOS;                                                39056000
          TOS := CST(X:=X-3).(4:12)&LSL(2)-1; <<SEG LENGTH-1>>          39058000
          TOS := 128;                                                   39060000
          ASSEMBLE(DIV);                                                39062000
          STTINDEX := TOS+256;   <<POINTER TO PL>>                      39064000
          ASSEMBLE(DUP,ZERO; XCH);                                      39066000
          TOS := TOS-2D;                                                39068000
          STTADR := TOS+STTADR;  <<ADDRESS OF LAST 3 SECTORS>>          39070000
          DISC(READ,STTLDEV,STTADR,STT,384); <<READ STT>>               39072000
      END <<READSTT>> ;                                                 39074000
         <<----------------------------------->>               <<03004>>39076000
         << GET STT OF CST OR PROGRAM SEGMENT >>               <<03004>>39078000
         <<----------------------------------->>               <<03004>>39080000
  PROCEDURE UPDATESTT( CSTN, DNAME);                           <<03004>>39082000
  COMMENT                                                      <<03004>>39084000
     THIS PROCEDURE PUTS THE STT OF A SEGMENT                  <<03004>>39086000
     IN THE ARRAY 'STT', WITH 'STTINDEX' SET TO INDEX TO       <<03004>>39088000
     THE BEGINNING OF THE STT.  IF 'CSTN' < 0 ON ENTRY,        <<03004>>39090000
     -CSTN-1 IS THE LOGICAL SEGMENT WHOSE STT WE WANT, AND     <<03004>>39092000
     'DNAME' GIVES THE FILE NAME OF THE PROGRAM.               <<03004>>39094000
     IF 'CSTN' >= 0, THEN IT GIVES                             <<03004>>39096000
     THE PHYSICAL CST # OF THE SEGMENT AND WE GET TO THE       <<03004>>39098000
     STT VIA THE CST ENTRY, WHETHER THE SEGMENT IS CORE        <<03004>>39100000
     RESIDENT OR ABSENT;                                       <<03004>>39102000
  VALUE CSTN;                                                  <<03004>>39104000
  INTEGER CSTN;      << PHYSICAL CST# IF >= 0,           >>    <<03004>>39106000
                     << IF < 0, -CSTN-1 IS LOGICAL CST # >>    <<03004>>39108000
  BYTE ARRAY DNAME;  << FILE NAME IF CSTN < 0 >>               <<03004>>39110000
  OPTION VARIABLE;                                             <<03004>>39112000
     BEGIN                                                     <<03004>>39114000
     INTEGER PROGFNUM,   << FILE NUMBER >>                     <<03004>>39116000
             NSEG,       << NO. OF SEGMENTS IN PROGRAM FILE >> <<03004>>39118000
             K,I,                                              <<03004>>39120000
             CSTP,       << INDEX TO CURRENT CST ENTRY >>      <<03004>>39122000
             SEGSIZE;    << SEGMENT SIZE (WORDS) >>            <<03004>>39124000
     LOGICAL SBANK,      << SOURCE BANK FOR MABS >>            <<03004>>39126000
             SADDR,      << SOURCE ADDR  "    "  >>            <<03004>>39128000
             DBANK,      << DEST.  BANK  "    "  >>            <<03004>>39130000
             DADDR;      << DEST.  ADDR  "    "  >>            <<03004>>39132000
                                                               <<03004>>39134000
                                                               <<03004>>39136000
     CSTP := CSTN&LSL(2);  << POINTER TO 1ST WORD OF CST    >> <<03004>>39138000
                           <<ENTRY, USED FOR PHYS. CST ONLY >> <<03004>>39140000
     IF CSTN < 0 THEN                                          <<03004>>39142000
        BEGIN             << GET STT FROM FILE >>              <<03004>>39144000
        PROGFNUM := FOPEN( DNAME);  << OPEN FILE >>            <<03004>>39146000
        FREAD( PROGFNUM, 0D, PREC0, 128);  << READ RECORD 0>>  <<03004>>39148000
        NSEG := PREC0(1);   << NO. OF SEGMENTS IN FILE >>      <<03004>>39150000
        K := 28 + (NSEG+1)&LSR(1);                             <<03004>>39152000
        STTADR := FCBDBL( PROGFNUM*FCBDSIZE) + D'L(FCB(        <<03004>>39154000
                  PROGFNUM*FCBSIZE + FCBSECTOFF) +             <<03004>>39156000
                  PREC0(4)  ));  <<ADDRESS OF 1ST SEGMENT>>    <<03004>>39158000
        I := -1;                                               <<03004>>39160000
        CSTN := -CSTN - 1;  <<LOGICAL CST# OF SEGMENT>>        <<03004>>39162000
        WHILE (I:=I+1) < CSTN DO                               <<03004>>39164000
           BEGIN                                               <<03004>>39166000
           SEGSIZE := PREC0(K+I).(2:14);                       <<03004>>39168000
           STTADR := STTADR + DOUBLE((SEGSIZE+127)&LSR(7));    <<03004>>39170000
           END;                                                <<03004>>39172000
                                                               <<03004>>39174000
        SEGSIZE := PREC0(K+I).(2:14) - 1;  <<SEG. SIZE - 1>>   <<03004>>39176000
        << SET FINAL DISC ADDRESS >>                           <<03004>>39178000
        STTADR := STTADR + DOUBLE( SEGSIZE/128) - 2D;          <<03004>>39180000
        STTINDEX := 256 + (SEGSIZE MOD 128);                   <<03004>>39182000
                                                               <<03004>>39184000
        STTLDEV := FCB(PROGFNUM*FCBSIZE+FCBLDEV);<<FILE LDEV>> <<03004>>39186000
        DISC( READ,STTLDEV,STTADR,STT,384);                    <<03004>>39188000
        FCLOSE( PROGFNUM);                                     <<03004>>39190000
        END                                                    <<03004>>39192000
                                                               <<03004>>39194000
     ELSE IF CST(CSTP) < 0 THEN                                <<03004>>39196000
        BEGIN              << ABSENT SEGMENT >>                <<03004>>39198000
        READSTT(CSTN);                                         <<03004>>39200000
        END                                                    <<03004>>39202000
                                                               <<03004>>39204000
     ELSE                                                      <<03004>>39206000
        BEGIN              << CORE RESIDENT SEGMENT >>         <<03004>>39208000
        SEGSIZE := CST(CSTP).(4:12)&LSL(2);                    <<03004>>39210000
        SBANK := CST(CSTP+2);   << BANK OF SEGMENT >>          <<03004>>39212000
        SADDR := CST(CSTP+3)+SEGSIZE-1;  << BANK OFFSET OF  >> <<03004>>39214000
                                         <<LAST WORD OF SEG.>> <<03004>>39216000
        PUSH(DB);                                              <<03004>>39218000
        DADDR := TOS + @STT(383);  << GET BANK AND BANK     >> <<03004>>39220000
        DBANK := TOS;              << OFFSET OF THE LAST    >> <<03004>>39222000
                                   << WORD OF 'STT'         >> <<03004>>39224000
        MABS( DBANK,DADDR,SBANK,SADDR,-384);  << MOVE STT >>   <<03004>>39226000
        STTINDEX := 383;  << POINTER TO START OF STT >>        <<03004>>39228000
        END;                                                   <<03004>>39230000
     END;    << UPDATESTT >>                                   <<03004>>39232000
                                                                        39234000
          <<-------------------------------------                       39236000
            CONVERT LOGICAL CST TO PHYSICAL CST                         39238000
          ------------------------------------->>                       39240000
  INTEGER PROCEDURE PHYSCST(LCST);                                      39242000
    VALUE LCST;                                                         39244000
    INTEGER LCST;                                                       39246000
      BEGIN                                                             39248000
        INTEGER I;                                                      39250000
          I := FREECSTN-1;                                              39252000
  LOOP:   IF SEGXFORM(I:=I+1)&LSR(8)=LCST THEN                          39254000
          IF (SAGL=0) OR (SEGENTTAB(I)=0) THEN                          39256000
            BEGIN                                                       39258000
              PHYSCST := I;                                             39260000
              RETURN;                                                   39262000
            END;                                                        39264000
          GOTO LOOP;                                                    39266000
      END <<PHYSCST>> ;                                                 39268000
                                                                        39270000
          <<-------------------------------                             39272000
            FIX-UP SEGMENT TRANSFER TABLE                               39274000
          ------------------------------->>                             39276000
  PROCEDURE FIXSTT(CSTN);                                               39278000
    VALUE CSTN;                                                         39280000
    INTEGER CSTN;    <<PHYSICAL CST NUMBER>>                            39282000
    COMMENT                                                             39284000
      CONVERTS ALL LOGICAL CST REFERENCES IN THE STT OF SEGMENT CSTN    39286000
    TO PHYSICAL REFERENCES;                                             39288000
      BEGIN                                                             39290000
        INTEGER NUMENTS,I;                                              39292000
          READSTT(CSTN);   <<READ IN STT>>                              39294000
          NUMENTS := -(STT(STTINDEX).(8:8));                            39296000
          I := 0;                                                       39298000
          WHILE (I:=I-1) >= NUMENTS DO                                  39300000
            BEGIN                                                       39302000
              TOS := STT(STTINDEX+I);                                   39304000
              IF < THEN                                                 39306000
                BEGIN   <<EXTERNAL LABEL>>                              39308000
                  X := S0.(8:8);                                        39310000
                  IF X=%377 THEN                                        39312000
                    BEGIN  <<UNSATISFIED EXTERNAL>>                     39314000
                      DEL;                                              39316000
                      TOS := %104001;  <<LINK TO ININ>>                 39318000
                    END                                                 39320000
                  ELSE TOS.(8:8) := PHYSCST(X);                         39322000
                END;                                                    39324000
              STT(STTINDEX+I) := TOS;                          <<01025>>39326000
            END;                                                        39328000
          DISC(WRITE,STTLDEV,STTADR,STT,384);                           39330000
      END <<FIXSTT>> ;                                                  39332000
                                                                        39334000
          <<-------------------                                         39336000
            READ CODE SEGMENT                                           39338000
          ------------------->>                                         39340000
PROCEDURE READCODE(CSTN, LINKED);                              <<01384>>39342000
  VALUE CSTN, LINKED;                                          <<01384>>39344000
  INTEGER CSTN;    << CST NUMBER >>                            <<01384>>39346000
  LOGICAL LINKED;  <<0=CORE RESIDENT,1=LINKED MEM,2=ABSENT>>   <<01384>>39348000
  BEGIN                                                        <<01384>>39350000
    DOUBLE  DISCADDR,                                          <<01384>>39352000
            DCOREADDR;                                         <<01384>>39354000
    LOGICAL MEMSEG,                                            <<01384>>39356000
            LDEV,                                              <<01384>>39358000
            BANK     = DCOREADDR,                              <<MPEIV>>39360000
            COREADDR = DCOREADDR+1;                            <<MPEIV>>39362000
    LOGICAL CSTINDX;  << INDEX TO CST ENTRY >>                 <<01384>>39364000
                                                               <<MPEIV>>39366000
  << COMPUTE CST ENTRY INDEX >>                                <<01384>>39368000
    IF CSTN.(2:1) = 1 THEN  << CSTX ENTRY >>                   <<01384>>39370000
      CSTINDX := CSTBLK(CSTN.(3:7)) + CSTN.(10:6)&LSL(2) -     <<01384>>39372000
                 ABSOLUTE(DFC)                                 <<01384>>39374000
    ELSE                                                       <<01384>>39376000
      CSTINDX := CSTN&LSL(2);                                  <<01384>>39378000
                                                               <<01384>>39380000
    MEMSEG := CST(CSTN*4).(4:12) * 4;  << SEGMENT LENGTH >>    <<MPEIV>>39382000
    LDEV := CST(X:=X+2).(0:8);                                 <<MPEIV>>39384000
    TOS := CST(X).(8:8);  << HODA >>                           <<MPEIV>>39386000
    TOS := CST(X:=X+1);  << LODA >>                            <<MPEIV>>39388000
    DISCADDR := TOS;                                           <<MPEIV>>39390000
    DCOREADDR := MAM(MEMSEG, CORERES');                        <<MPEIV>>39392000
    DISC'(READ,LDEV,DISCADDR,DCOREADDR,MEMSEG);                <<01384>>39394000
                                                               <<01384>>39396000
  << UPDATE CST >>                                             <<01384>>39398000
    TOS := 0;  << NO BITS SET >>                               <<MPEIV>>39400000
    TOS.SYSTEMFLAG := 1;                                       <<MPEIV>>39402000
    IF NOT LINKED THEN TOS.SEGRESIDENTFLAG := 1;               <<MPEIV>>39404000
    CST(CSTINDX + 1) := TOS;  << CST WORD 1 >>                 <<MPEIV>>39406000
    CST(X:=X+1) := BANK;  << CST WORD 2 >>                     <<MPEIV>>39408000
    CST(X:=X+1) := COREADDR;  << CST WORD 3 >>                 <<MPEIV>>39410000
  END;  << READCODE >>                                         <<01384>>39412000
                                                               <<03004>>39414000
         <<-------------------------------------->>            <<03004>>39416000
         <<  SEE IF DRIVER NEEDS CST ENTRY       >>            <<03004>>39418000
         <<-------------------------------------->>            <<03004>>39420000
  LOGICAL PROCEDURE DUMMYDRIVER( INTRINDEX, FIRSTCST,          <<03004>>39422000
                          LASTCST, ONEINHNDLR);                <<03004>>39424000
  COMMENT                                                      <<03004>>39426000
      THIS PROCEDURE CHECKS TO SEE IF ANY OF THE DRIVER        <<03004>>39428000
      ENTRY POINTS ARE INTERNAL TO A DRIVER SEGMENT.  IF       <<03004>>39430000
      NOT, THE DRIVER IS A DUMMY DRIVER AND NEED NOT           <<03004>>39432000
      BE ALLOCATED A CST ENTRY.  THIS PROCEDURE USES THE       <<03004>>39434000
      GLOBALS DLT ( POINTER TO CURRENT DLT ENTRY), INTR        <<03004>>39436000
      (POINTER TO TABLE CONTAINING INT. HANDLER PLABELS),      <<03004>>39438000
      STT (ARRAY CONTAINING STT FOR DRIVER OUTER BLOCK),       <<03630>>39440000
      AND STTINDEX (INDEX TO LAST WORD OF STT).                <<03630>>39442000
      THIS PROCEDURE RETURNS TRUE IF IT'S A DUMMY DRIVER,      <<03004>>39444000
      FALSE OTHERWISE;                                         <<03004>>39446000
  VALUE INTRINDEX, FIRSTCST, LASTCST, ONEINHNDLR;              <<03004>>39448000
  INTEGER INTRINDEX, << INDEX INTO TEMP TABLE CONTAINING >>    <<03004>>39450000
                     << ALL STT NO.'S FOR INTERRUPT      >>    <<03004>>39452000
                     << HANDLERS                         >>    <<03004>>39454000
          FIRSTCST,  << 1ST PHYS CST ALLOCATED TO DRIVER >>    <<03004>>39456000
          LASTCST;   << LAST PHYS CST FOR DRIVER         >>    <<03004>>39458000
  LOGICAL ONEINHNDLR;<< TRUE IF GUARANTEED ONLY 1 INT.   >>    <<03004>>39460000
                     << HANDLER FOR DRIVER, AND NOT TO   >>    <<03004>>39462000
                     << USE TEMP INTR TABLE              >>    <<03004>>39464000
     BEGIN                                                     <<03004>>39466000
     EQUATE NUMPLABELS = 6; <<NO. OF DLT ENTRIES TO CHECK>>    <<03004>>39468000
                                                               <<03004>>39470000
     << DLTENTRY CONTAINS INDICES TO DLT WORDS WHICH >>        <<03004>>39472000
     << CONTAIN PLABELS                              >>        <<03004>>39474000
     INTEGER ARRAY DLTENTRY(0:NUMPLABELS-1)=PB:=               <<03004>>39476000
              1,2,3,6,7,4;                                     <<03004>>39478000
     INTEGER STTNUM, << TEMP FOR STT NUMBER >>                 <<03004>>39480000
             TEMP, MAX, I, J;                                  <<03004>>39482000
                                                               <<03004>>39484000
     DUMMYDRIVER := TRUE;                                      <<03004>>39486000
                                                               <<03004>>39488000
     << IF ONLY ONE INTERRUPT HANDLER, USE DLT ENTRY 4   >>    <<03004>>39490000
     << TO CHECK INTERRUPT HANDLER PLABEL                >>    <<03004>>39492000
     MAX := IF ONEINHNDLR THEN NUMPLABELS                      <<03004>>39494000
                          ELSE NUMPLABELS-1;                   <<03004>>39496000
     I := 0;                                                   <<03004>>39498000
     WHILE I<MAX DO   << CHECK DLT ENTRIES TO SEE IF ANY >>    <<03004>>39500000
        BEGIN         << DRIVER ENTRY POINTS ARE INTERNAL>>    <<03004>>39502000
        J := DLTENTRY(I);                                      <<03004>>39504000
        IF FIRSTCST <= DLT(J).(8:8) <= LASTCST THEN            <<03004>>39506000
               DUMMYDRIVER := FALSE;                           <<03004>>39508000
        I := I+1;                                              <<03004>>39510000
        END;                                                   <<03004>>39512000
                                                               <<03004>>39514000
     IF ONEINHNDLR THEN RETURN;                                <<03004>>39516000
                                                               <<03004>>39518000
     << DRIVER MAY HAVE MORE THAN 1 INTERRUPT HANDLER--  >>    <<03004>>39520000
     << CHECK ALL OF THEM TO SEE IF THEY ARE INTERNAL    >>    <<03004>>39522000
                                                               <<03004>>39524000
     MAX := INTEGER( INTR( INTRINDEX));                        <<03004>>39526000
     I := 1;                                                   <<03004>>39528000
     WHILE I <= MAX DO                                         <<03004>>39530000
        BEGIN                                                  <<03004>>39532000
        STTNUM := INTEGER( INTR( INTRINDEX+I));                <<03004>>39534000
        IF STTNUM > 0 THEN                                     <<03004>>39536000
           BEGIN                                               <<03004>>39538000
           TEMP := STT( STTINDEX-STTNUM);                      <<03004>>39540000
           IF TEMP.(0:1) = 0 OR    << IF IN SAME SEGMENT OR >> <<03630>>39542000
              TEMP.(0:1) = 1 AND   <<   SOME DRIVER SEGMENT >> <<03630>>39544000
              (FIRSTCST <= TEMP.(8:8) <= LASTCST) THEN         <<03630>>39546000
                  DUMMYDRIVER := FALSE;                        <<03004>>39548000
           END;                                                <<03004>>39550000
        I := I+1;                                              <<03004>>39552000
        END                                                    <<03004>>39554000
     END;    << DUMMYDRIVER >>                                 <<03004>>39556000
          <<---------------------------------                           39558000
            ALLOCATE SYSTEM LIBRARY SEGMENT                             39560000
          --------------------------------->>                           39562000
                                                                        39564000
  INTEGER PROCEDURE ALLOCATE(LCST,TOG);                                 39566000
    VALUE LCST,TOG;                                                     39568000
    INTEGER LCST;    <<LOGICAL CST NUMBER>>                             39570000
    INTEGER TOG;                                                        39572000
    COMMENT                                                             39574000
      ALLOCATE THE SYSTEM LIBRARY SEGMENT SPECIFIED BY LCST IF TOG IS   39576000
    TRUE OR THE ALLOCATE BIT IS SET.  FIXES UP THE STT OF THE SEGMENT   39578000
    WITH THE CORRECT LOGICAL CST NUMBERS. SETS CONDITION CODE TO EQUAL  39580000
    IF SEGMENT IS ALLOCATED;                                            39582000
      BEGIN                                                             39584000
      EQUATE S=6,P=4;                                                   39586000
        DEFINE ALLOC     =    (4:1)#,                                   39588000
               SYSSEG     =   (6:1)#,                                   39590000
               CRRES   =    (5:1)#,                                     39592000
               SATISFIED =    (0:2)#;                                   39594000
        INTEGER EXTINDEX,EXTREC,FLAGS,I,                                39596000
                SEGTYPE=ALLOCATE,                                       39598000
                SEGLEN,SEGADR,NC,CONCODE:=CCG;                          39600000
        BYTE POINTER BLDMAPBUF;                                         39602000
        INTEGER LMBX := 0; <<INDEX TO BLDMAPBUF>>                       39604000
        SUBROUTINE LCSTTOSTT;                                           39606000
        BEGIN                                                           39608000
              TOS := SEGLEN;                                            39610000
              TOS := 128;                                               39612000
              ASSEMBLE(DIV);                                            39614000
              EXTINDEX := TOS;        <<FIRST EXTERNAL INDEX>>          39616000
              EXTREC := TOS+SEGADR+1;<<ADDR OF EXTERNAL LIST>>          39618000
              FREAD(SLFNUM,DOUBLE(EXTREC),EXTLIST,256);                 39620000
  NEXTEXT:    TOS := EXTLIST(EXTINDEX);                                 39622000
              NC := S0.(4:4);                                           39624000
              IF = THEN                                                 39626000
                BEGIN                                                   39628000
                  DEL;                                                  39630000
                  RETURN;                                               39632000
                END;                                                    39634000
              EXTINDEX := X+1+NC&LSR(1);                                39636000
              IF TOS.SATISFIED=0 THEN                                   39638000
                BEGIN      <<PRINT UNSATISFIED MESSAGE>>                39640000
                  TOS := @EXTLIST(X)&LSL(1);                   <<04306>>39642000
                  MOVE BINBUF := * ,(16);                      <<01103>>39644000
                  INBUF.(0:4) := 0;                            <<01103>>39646000
                  TOS := @BINBUF(17);                          <<01103>>39648000
                  TOS := @REFTAB(INDEX+8)&LSL(1);              <<04306>>39650000
MOVENAME':        MOVE * := * WHILE AN,0;                      <<01103>>39652000
                  IF BPS0 = "'" THEN                           <<01103>>39654000
                     BEGIN                                     <<01103>>39656000
                     MOVE * := *,(1),1;                        <<01103>>39658000
                     GO MOVENAME';                             <<01103>>39660000
                     END;                                      <<01103>>39662000
                  DEL;                                         <<01103>>39664000
                  BINBUF(16) := TOS-@BINBUF(17);               <<01103>>39666000
                  MESSAGE(M2457,,,,,BINBUF,BINBUF(16));        <<01103>>39668000
                  X := STTINDEX-EXTLIST(EXTINDEX).(1:7);                39670000
                  STT(X) := %100377;                                    39672000
                END                                                     39674000
              ELSE                                                      39676000
                BEGIN                                                   39678000
                  TOS := EXTLIST(EXTINDEX);                             39680000
                  X := -(S0&LSR(8))+STTINDEX;                           39682000
                  TOS := TOS LAND %377;                                 39684000
                  STT(X).(8:8) := TOS;   <<FIX UP SIT ENTRY>>           39686000
                END;                                                    39688000
              I := EXTLIST(EXTINDEX+1).(0:2);                           39690000
              TOS := (IF = THEN 1 ELSE IF I=3 THEN EXTLIST(X).(2:6)+2   39692000
                      ELSE 2)+X;                                        39694000
              IF S0>127 THEN                                            39696000
                BEGIN   <<GET NEXT RECORD>>                             39698000
                  TOS := TOS-128;                                       39700000
                  FREAD(SLFNUM,DOUBLE(EXTREC:=EXTREC+1),EXTLIST,256);   39702000
                END;                                                    39704000
              EXTINDEX := TOS;                                          39706000
              GOTO NEXTEXT;                                             39708000
        END <<LCSTTOSTT>> ;                                             39710000
          @BLDMAPBUF := @LDMAPBUF&LSL(1);                      <<04306>>39712000
          I:= FREECSTN;                                        <<02.EB>>39714000
          DO IF SEGXFORM(I)&LSR(8) = LCST THEN GOTO NOALLOC    <<02.EB>>39716000
          UNTIL (I:=I+1)=HCST;                                 <<02.EB>>39718000
          TOS := LCST;                                                  39720000
          TOS := 4;                                                     39722000
          ASSEMBLE(DIV);                                                39724000
          INDEX := TOS&LSL(5);<<INDEX INTO REF TABLE RECORD>>           39726000
          I := TOS;           <<REFERENCE TABLE RECORD NUMBER>>         39728000
          FREAD(SLFNUM,DOUBLE(SLREC1(I)),REFTAB,128);                   39730000
          IF (FLAGS:=REFTAB(INDEX+3)) < 0 THEN GOTO NOALLOC; <<UNUSED>> 39732000
          IF LOGICAL(FLAGS.SYSSEG) THEN                                 39734000
            BEGIN   <<SYSTEM SEGMENT>>                                  39736000
              ALLOCATE := S;                                            39738000
              GOTO ALLOCATEIT;                                          39740000
            END;                                                        39742000
          IF TOG <> 0 THEN GO PALLOC;                          <<03.EB>>39744000
          IF NOT LOGICAL(FLAGS.ALLOC) THEN GOTO NOALLOC                 39746000
          ELSE                                                          39748000
            BEGIN   <<ALLOCATE SEGMENT>>                                39750000
  PALLOC:     ALLOCATE := P;                                            39752000
  ALLOCATEIT:                                                           39754000
              CONCODE := CCE;                                           39756000
              CSTN := GETENTRY(SYSCST);                                 39758000
              SEGXFORM(CSTN) := LCST&LSL(8)+(FLAGS.(4:3)&LSL(3));       39760000
              SEGREF(X) := 1;                                           39762000
              LMBX:=CSTN MOD 50*128+CSTN/50*32;                <<00.DL>>39764000
                  NTOA(CSTN,8,BLDMAPBUF(LMBX+2));              <<01103>>39766000
                  TOS := @LDMAPBUF(LMBX&LSR(1));  <<FOR PRINT>>         39768000
                  TOS := @BLDMAPBUF(LMBX);                              39770000
                  TOS := S0+4;                                          39772000
                  TOS := @REFTAB(INDEX+8)&LSL(1);              <<04306>>39774000
  MOVENAME:       MOVE * := * WHILE AN,0;  <<SEG NAME>>                 39776000
                  IF BPS0="'" THEN                                      39778000
                    BEGIN                                               39780000
                      MOVE * := *,(1),1;                                39782000
                      GOTO MOVENAME;                                    39784000
                    END;                                                39786000
                  DEL;                                                  39788000
                  MOVE * := " (",2;                            <<01103>>39790000
                  TOS := TOS + LNTOA(LCST,8,BPS0);             <<01103>>39792000
                  BPS0 := ")";                                 <<01103>>39794000
                  ASSEMBLE(INCA,SUB);  <<CHARACTER COUNT>>              39796000
                  IF LOADMAP THEN PRINT(*,*,0) ELSE DDEL;      <<00.DL>>39798000
              TOS := CSTN;    <<SEGMENT NUMBER>>                        39800000
              SEGLEN := REFTAB(INDEX).(2:14);                           39804000
              TOS := 0;   <<FOR DISC ADDRESS>>                          39806000
              TOS := REFTAB(X:=X+1);   <<STARTING RECORD #>>            39808000
              SEGADR := S0;                                             39810000
              TOS := TOS+FCB(SLFNUM*FCBSIZE+FCBSECTOFF);  <<OFFSET>>    39812000
              TOS := FCB(SLFNUM*FCBSIZE+FCBEXTSIZE);  <<EXTENT SIZE>>   39814000
              ASSEMBLE(DIV,XCH);                                        39816000
              X := TOS+SLFNUM*FCBDSIZE;                                 39818000
              TOS := FCBDBL(X);                                         39820000
              ASSEMBLE(DADD);  <<SEGMENT DISC ADDRESS>>                 39822000
              TOS := REFTAB(INDEX);  <<SEGMENT LENGTH AND FLAGS>>       39824000
              TOS := 0;  <<CORE RESIDENT SEGMENT>>                      39826000
              IF NOT LOGICAL(FLAGS).CRRES THEN TOS:=TOS+2;  <<ABSENT>>  39828000
              TOS := 0;                                                 39830000
              IF SEGTYPE=S THEN TOS := TOS+1;<<SYSTEM>>                 39832000
              INSERTCST(*,*,*,*,*);                            <<03603>>39834000
              READSTT(CSTN);                                            39836000
              LCSTTOSTT;                                                39838000
              DISC(WRITE,STTLDEV,STTADR,STT,384);                       39840000
            END;                                                        39842000
  NOALLOC:STAT.(6:2) := CONCODE;                                        39844000
      END <<ALLOCATE>> ;                                                39846000
                                                                        39848000
          <<-------------------------------------------------           39850000
            ALLOCATE SL SEGMENT AND ALL THOSE IT REFERENCES             39852000
          ------------------------------------------------->>           39854000
  PROCEDURE ALLOCATEALL(LCST,TOG);                                      39856000
    VALUE LCST,TOG;                                                     39858000
    INTEGER LCST;    <<LOGICAL CST NUMBER>>                             39860000
    LOGICAL TOG;     <<ALWAYS ALLOCATE IF TRUE>>                        39862000
    COMMENT                                                             39864000
      CALL ALLOCATE TO ALLOCATE SEGMENT LCST. IF ALLOCATED, SCANS       39866000
    REFERENCED SEGMENT LIST AND ALLOCATES ALL REFERENCED SEGMENTS NOT   39868000
    PREVIOUSLY ALLOCATED;                                               39870000
      BEGIN                                                             39872000
        INTEGER I,J;                                                    39874000
          J := ALLOCATE(LCST,TOG);                                      39876000
          IF <> THEN RETURN;                                            39878000
          MOVE REFSEG := REFTAB(INDEX+16),(16);                         39880000
          I := -1;                                                      39882000
          DO                                                            39884000
            BEGIN                                                       39886000
              I := I+1;                                                 39888000
              IF LOGICAL(REFSEG(I.(0:12))&CSL(I.(12:4)+1)) THEN         39890000
                ALLOCATE(I,J);                                          39892000
            END                                                         39894000
          UNTIL I=255;                                                  39896000
      END <<ALLOCATEALL>> ;                                             39898000
                                                                        39900000
          <<--------------------                                        39902000
            GET EXTERNAL LABEL                                          39904000
          -------------------->>                                        39906000
  INTEGER PROCEDURE EXTLABEL(NAME);                                     39908000
    BYTE ARRAY NAME;   <<NAME OF EXTERNAL (AND CHAR COUNT)>>            39910000
    COMMENT                                                             39912000
      RETURNS THE LOGICAL EXTERNAL LABEL OF AN EXTERNAL PROCEDURE       39914000
    NAME IN BYTE ARRAY NAME (ZERO IF NOT FOUND);                        39916000
      BEGIN                                                             39918000
        INTEGER NC,I,J,LINK;                                            39920000
          TOS := NAME&CSL(8)+NAME(1);                                   39922000
          TOS := S0.(4:4);                                              39924000
          X := S0-1;                                                    39926000
          NC := TOS;                                                    39928000
          TOS := TOS.(4:12);  <<STRIP LEADING BITS>>                    39930000
          TOS := NAME(X)&CSL(8);    <<CHARACTER NC-1>>                  39932000
          TOS := NAME(X:=X+1);                                          39934000
          ASSEMBLE(ADD,DECX);                                           39936000
          IF = THEN TOS:=TOS.(4:12);  <<ONLY ONE CHARACTER IN NAME>>    39938000
          TOS := 95;                                                    39940000
          ASSEMBLE(LDIV,DELB);   <<HASH>>                               39942000
          LINK := SLREC0(TOS+33);                                       39944000
  NEXTREC:IF = THEN RETURN;  <<NO MORE RECORDS--NOT FOUND>>             39946000
          FREAD(SLFNUM,DOUBLE(LINK),EXTLIST,128);                       39948000
          I := 4;                                                       39950000
  NEXTENT:TOS := BEXTLIST(I).(12:4);   <<NUMBER OF CHARS>>              39952000
          IF S0<>NC THEN GOTO NEXT;                                     39954000
          IF BEXTLIST(X:=X+1)<>NAME(1),(NC) THEN                        39956000
            BEGIN                                                       39958000
  NEXT:       IF NOT LOGICAL(S0) THEN TOS:=TOS+1;  <<FILL CHARACTER>>   39960000
              X := TOS+I+3;                                             39962000
              J := BEXTLIST(X).(8:2);  <<P FLAG>>                       39964000
              TOS :=(IF = THEN 2 ELSE IF J=3 THEN 2*BEXTLIST(X).(10:6)+439966000
                      ELSE 4)+X;                                        39968000
              IF S0>=2*EXTLIST(1) THEN                                  39970000
                BEGIN   <<RECORD EXHAUSTED>>                            39972000
                  LINK := EXTLIST;                                      39974000
                  GOTO NEXTREC;                                         39976000
                END;                                                    39978000
              I := TOS;                                                 39980000
              GOTO NEXTENT;                                             39982000
            END;                                                        39984000
          X := I+NC+1;                                                  39986000
          IF NOT LOGICAL(NC) THEN X:=X+1;                               39988000
          TOS := BEXTLIST(X)&LSL(8);                                    39990000
          TOS := TOS+BEXTLIST(X:=X+1);                                  39992000
          ASSEMBLE(TSBC 0);                                             39994000
          EXTLABEL := TOS;   <<EXTERNAL LABEL>>                         39996000
      END <<EXTLABEL>> ;                                                39998000
                                                                        40000000
          <<-----------------------------                               40002000
            GET PHYSICAL EXTERNAL LABEL                                 40004000
          ----------------------------->>                               40006000
  INTEGER PROCEDURE PLABEL(NAME);                                       40008000
    BYTE ARRAY NAME;    <<NAME OF EXTERNAL>>                            40010000
    COMMENT                                                             40012000
      RETURNS THE PHYSICAL EXTERNAL LABEL OF AN EXTERNAL PROCEDURE      40014000
    REFERENCE;                                                          40016000
      BEGIN                                                             40018000
          TOS := EXTLABEL(NAME);    <<GET LOGICAL EXTERNAL LABEL>>      40020000
          IF S0=0 THEN RETURN;                                          40022000
          X := LOGICAL(S0) LAND %377;                                   40024000
          PLABEL := (TOS LAND %177400)+LOGICAL(PHYSCST(X));             40026000
      END <<PLABEL>> ;                                                  40028000
                                                                        40030000
          <<--------------------                                        40032000
            GET INTERNAL LABEL                                          40034000
          -------------------->>                                        40036000
  INTEGER PROCEDURE INTLABEL(EXTLAB);                                   40038000
    VALUE EXTLAB;                                                       40040000
    INTEGER EXTLAB;  <<EXTERNAL LABEL>>                                 40042000
    COMMENT                                                             40044000
      RETURNS THE INTERNAL LABEL FOR THE PROCEDURE WITH THE EXTERNAL    40046000
    LABEL EXTLAB;                                                       40048000
      BEGIN                                                             40050000
      DOUBLE  DCOREADDR;                                       <<01384>>40052000
      LOGICAL BANK     = DCOREADDR,                            <<01384>>40054000
              COREADDR = DCOREADDR+1;                          <<01384>>40056000
          TOS := EXTLAB;                                                40058000
          IF = THEN RETURN;                                             40060000
          X := TOS.(8:8)&LSL(2);                                        40062000
          TOS := CST(X);                                                40064000
          IF < THEN                                                     40066000
            BEGIN   <<ABSENT>>                                          40068000
              READSTT(EXTLAB.(8:8));                                    40070000
              TOS := STT(STTINDEX-EXTLAB.(1:7));                        40072000
            END                                                         40074000
          ELSE                                                          40076000
            BEGIN  <<IN CORE>>                                          40078000
              BANK := CST(X:=X+2).(8:8);                       <<MPEIV>>40080000
              TOS := TOS.(4:12)&LSL(2)+CST(X:=X+1)-1;          <<01384>>40082000
              COREADDR := TOS-EXTLAB.(1:7);                    <<01384>>40084000
              TOS := LSEA(DCOREADDR);                          <<01384>>40086000
            END;                                                        40088000
          ASSEMBLE(TRBC 1);   <<UNCALLABLE BIT>>                        40090000
          INTLABEL := TOS;                                              40092000
      END <<INTLABEL>> ;                                                40094000
                                                                        40096000
          <<--------------------                                        40098000
            GET LABEL FROM STT                                          40100000
          -------------------->>                                        40102000
  INTEGER PROCEDURE STTLABEL(STTX);                                     40104000
    VALUE STTX;                                                         40106000
    INTEGER STTX;                                                       40108000
      BEGIN                                                             40110000
          TOS := STT(STTINDEX-STTX);                                    40112000
          IF >= THEN                                                    40114000
            BEGIN  <<INTERNAL - CONVERT TO EXTERNAL>>                   40116000
              TOS := STTX&LSL(8)+CSTINDEX;                              40118000
              TOS.(0:1) := 1;                                           40120000
            END;                                                        40122000
          STTLABEL := TOS;                                              40124000
      END <<STTLABEL>> ;                                                40126000
                                                                        40128000
          <<------------------------------------                        40130000
            MAKE SEGMENT TABLE DIRECTORY ENTRY                          40132000
          ------------------------------------>>                        40134000
  PROCEDURE SEGDIRENT(FID,ENTTYPE,FIRSTCST,LASTCST);                    40136000
    VALUE ENTTYPE,FIRSTCST,LASTCST,FID;                                 40138000
    DOUBLE FID;                                                         40140000
    INTEGER ENTTYPE,      <<ENTRY TYPE>>                                40142000
            FIRSTCST,     <<FIRST CST IN LIST>>                         40144000
            LASTCST;      <<LAST CST IN LIST>>                          40146000
    COMMENT                                                             40148000
      SEARCHES THE SEGMENT TABLE DIRECTORY FOR A MATCHING ENTRY.  IF    40150000
    FOUND, ADDS THE CST'S IN THE LIST TO THE ENTRY.  OTHERWISE MAKES A  40152000
    NEW ENTRY INCLUDING THE FILE ID, ENTRY TYPE AND BITMAP              40154000
    OF USED CST'S;                                                      40156000
      BEGIN                                                             40158000
        INTEGER LINK,I,NWG,NCST;                                        40160000
        SUBROUTINE SETBIT(CSTN,CSTMAP,ENTSTART);                        40162000
        VALUE CSTN,ENTSTART;                                            40164000
        INTEGER CSTN,         <<CST NUMBER>>                            40166000
                ENTSTART;     <<STARTING ADDRESS OF ENTRY>>             40168000
        ARRAY CSTMAP;         <<BITMAP OF REFERENCED CST'S>>            40170000
        BEGIN                                                           40172000
          SEGENTTAB(CSTN) := ENTSTART;  <<STARTING ADDRESS OF ENTRY>>   40174000
          TOS := CSTMAP(CSTN.(0:12));                                   40176000
          X := S4.(12:4);   <<BIT POSITION>>                            40178000
          ASSEMBLE(TSBC 0,X);  <<SET THE BIT>>                          40180000
          X := S4.(0:12);                                               40182000
          ASSEMBLE(STOR S3,I,X);                                        40184000
        END <<SETBIT>> ;                                                40186000
          TOS := FID;                                                   40188000
          LINK := 0;                                                    40190000
  NEXT:   TOS := SEGDIR(LINK);                                          40192000
          IF TOS=0 THEN GOTO NOTFOUND;                                  40194000
          ASSEMBLE(DDUP);                                               40196000
          TOS := SEGDIR(X:=X+1);                                        40198000
          TOS := SEGDIR(X:=X+1);                                        40200000
          ASSEMBLE(DCMP);                                               40202000
          IF = THEN                                                     40204000
            BEGIN  <<ENTRY MATCH>>                                      40206000
              I := FIRSTCST;                                            40208000
              DO                                                        40210000
                BEGIN                                                   40212000
              SETBIT (I,SEGDIR (LINK+4),LINK);                 <<00211>>40214000
                  I := I+1;                                             40216000
                END                                                     40218000
              UNTIL I>LASTCST;                                          40220000
              RETURN;                                                   40222000
            END;                                                        40224000
          LINK := LINK+16;                                     <<00211>>40226000
          GOTO NEXT;                                                    40228000
  NOTFOUND:                                                             40230000
          NWG := SEGDIR(SAGL+1);   <<NUMBER OF GARBAGE WORDS>>          40232000
          NCST := LASTCST-FIRSTCST+1;   <<# OF CST'S>>                  40234000
          SEGDIR(SAGL) := ENTTYPE;                                      40236000
          X := X+2;                                                     40238000
          SEGDIR(X) := TOS;   <<2ND WORD OF FID>>                       40240000
          SEGDIR(X:=X-1) := TOS;  <<1ST WORD OF FID>>                   40242000
          SEGDIR (SAGL+3) := 0;  <<PVINFO WORD>>               <<00211>>40244000
          SEGDIR (X:=X+1) := 0; <<CST BITBAP>>                 <<00211>>40246000
          MOVE SEGDIR(X:=X+1) := SEGDIR(X:=X-1),(11);                   40248000
          I := FIRSTCST;                                                40250000
          DO                                                            40252000
            BEGIN                                                       40254000
              SETBIT (I,SEGDIR(SAGL+4),SAGL);                  <<00211>>40256000
              I := I+1;                                                 40258000
            END                                                         40260000
          UNTIL I>LASTCST;                                              40262000
          TOS := SAGL+16;                                      <<00211>>40264000
          X := S0;                                                      40266000
          SAGL := TOS;                                                  40268000
          SEGDIR(X) := 0;                                               40270000
          SEGDIR (X:=X+1) := NWG-16;                           <<00211>>40272000
      END <<SEGDIRENT>> ;                                               40274000
$PAGE                                                                   40276000
$CONTROL SEGMENT=PROCESS                                                40278000
INTEGER PROCEDURE ALCSTBLOCK(N);                               <<MPEIV>>40280000
   VALUE      N;                                               <<MPEIV>>40282000
   INTEGER    N;                                               <<MPEIV>>40284000
   OPTION     UNCALLABLE,PRIVILEGED;                           <<MPEIV>>40286000
   BEGIN                                                       <<MPEIV>>40288000
     INTEGER  EIX=ALCSTBLOCK,CSTX,MAX;                         <<MPEIV>>40290000
         EIX _ 0;                                              <<MPEIV>>40292000
         X _ (CSTX:=ABSOLUTE(DFS))+2;                          <<MPEIV>>40294000
         N:=N+2;                                               <<MPEIV>>40296000
         DST(X) _ DST(X)-N;        <<DEC FREE COUNT>>          <<MPEIV>>40298000
         CSTX _ CSTX+DST(X_X+1);     <<INDEX TO NEXT FREE>>    <<MPEIV>>40300000
         CSTX:=CSTX+4; <<FIRST ENTRY FOR BITMAP>>              <<MPEIV>>40302000
         DST(X) _ DST(X)+N&LSL(2); <<NEW NEXT FREE>>           <<MPEIV>>40304000
         MAX _ CSTBLK(0);             <<TABLE SIZE>>           <<MPEIV>>40306000
         WHILE (EIX_EIX+1) <= MAX DO                           <<MPEIV>>40308000
          IF CSTBLK(EIX) = -1 THEN                             <<MPEIV>>40310000
           GOTO FOUNDL;                <<ALLOCATE ENTRY>>      <<MPEIV>>40312000
         ERRMESSAGE(M304);           << OUT OF CSTBLK >>       <<MPEIV>>40314000
FOUNDL : CSTBLK(X) _ CSTX;            <<SAVE INDEX>>           <<MPEIV>>40316000
         <<ZERO OUT THE BITMAP>>                               <<MPEIV>>40318000
         DST(X:=CSTX-4):=0;                                    <<MPEIV>>40320000
         DST(X:=X+1):=0;                                       <<MPEIV>>40322000
         DST(X:=X+1):=0;                                       <<MPEIV>>40324000
         DST(X:=X+1):=0;                                       <<MPEIV>>40326000
         DST(CSTX):=(N:=N-2);                                  <<MPEIV>>40328000
         DST(X_X+1) _ %125252;       <<CHECK WORD>>            <<MPEIV>>40330000
         DST(X_X+1) _ 0;             <<# SHARING BLOCK>>       <<MPEIV>>40332000
         DST(X_X+1) _ 0;                                       <<MPEIV>>40334000
         WHILE (N_N-1) >= 0 DO                                 <<MPEIV>>40336000
          BEGIN                        <<CLEAR ENTRIES>>       <<MPEIV>>40338000
           DST(X_X+1) _ %100000;                               <<MPEIV>>40340000
           DST(X_X+1) _ 0;                                     <<MPEIV>>40342000
           DST(X_X+1) _ 0;                                     <<MPEIV>>40344000
           DST(X_X+1) _ 0;                                     <<MPEIV>>40346000
          END;                                                 <<MPEIV>>40348000
   END <<ALCSTBLOCK>> ;                                        <<MPEIV>>40350000
          <<---------------------                                       40352000
            PROGRAM FILE LOADER                                         40354000
          --------------------->>                                       40356000
PROCEDURE LOAD(NAME,CSTSEG,DSTSTACK,STACKSIZE,GLOBSIZE,        <<00652>>40358000
      START,LINKED,LOAD'IN'CSTX,CSTBLKINDEX,FIRSTCST,NSEG);    <<03004>>40360000
  VALUE LOAD'IN'CSTX;                                          <<00652>>40362000
    VALUE STACKSIZE,LINKED;                                             40364000
    BYTE ARRAY NAME;      <<PROGRAM FILE NAME>>                         40366000
    INTEGER CSTSEG,       <<PHYSICAL CST OF O.B. SEG>>         <<03004>>40368000
            DSTSTACK,     <<DST OF DATA SEGMENT>>                       40370000
            STACKSIZE,    <<SIZE OF STACK (=0 IF NONE)>>                40372000
            GLOBSIZE,     <<SIZE OF DB AREA>>                           40374000
            START;        <<ENTRY POINT>>                               40376000
  INTEGER CSTBLKINDEX,     << PROGRAM CST BLOCK INDEX >>       <<03004>>40378000
          FIRSTCST,        << FIRST PHYSICAL CST FOR PROGRAM>> <<03004>>40380000
          NSEG;            << NO. OF CODE SEGMENTS IN FILE >>  <<03004>>40382000
  LOGICAL LOAD'IN'CSTX;    <<TRUE IF PGM TO BE LOADED IN CSTX>><<00652>>40384000
    LOGICAL LINKED;       <<TRUE IF PROGRAM IN LINKED MEMORY>>          40386000
    COMMENT                                                             40388000
      LOADS THE PROGRAM FILE NAME, GETTING A CST AND A DST AND FIXING   40390000
    UP ALL EXTERNAL REFERENCES;                                         40392000
      BEGIN                                                             40394000
        INTEGER PROGFNUM,          <<PROGRAM FILE NUMBER>>              40396000
                GLOBRECORD,       <<DATA SEG STARTING REC #>>           40398000
                CODERECORD,       <<CODE SEG STARTING REC #>>           40400000
                EXTRECORD,        <<EXTERNAL  LIST STARTING REC #>>     40402000
                DATASIZE,         <<SIZE OF DATA SEGMENT>>              40404000
                SEGSIZE,          <<SEGMENT SIZE>>                      40408000
                CURCST,           <<CURRENT CST #>>                     40412000
                OLDCST,           <<OLD CST IN STT ENTRY>>              40414000
                INDEX,            <<EXTERNAL LIST INDEX>>               40416000
                NC,               <<NUMBER OF CHARACTERS>>              40418000
                NR,               <<NUMBER OF REFERENCES>>              40420000
                I,J,K,L,M,N,      <<TEMPS>>                             40422000
                NEXTS := 0,       <<NUMBER OF SATISFIED EXTERNALS>>     40424000
                LINKSIZE := 0;    <<SIZE OF MEM LINK>>                  40426000
          INTEGER CLABEL;  <<SPECIAL FORM FOR CSTX ENTRY>>     <<00652>>40428000
          DOUBLE  DCOREADDR;  << ADDRESS OF MEMORY SECTION >>  <<01384>>40430000
          LOGICAL BANK     = DCOREADDR,                        <<01384>>40432000
                  COREADDR = DCOREADDR+1;                      <<01384>>40434000
        INTEGER POINTER EXTP;     <<POINTER TO SATISFIED EXTS TABLE>>   40436000
        DOUBLE DISCADR;           <<SEGMENT DISC ADDRESS>>              40438000
          IF LINKED THEN LINKSIZE := 8;                                 40440000
          PROGFNUM := FOPEN(NAME);                                      40442000
          TOS := FLAB(28);                                              40444000
          TOS.(14:2) := 0;  << RESET READ BIT >>                        40446000
          TOS.(0:4) := 2;   << SET LOAD BIT,CLEAR S,R,X BITS>>          40448000
          FLAB(X) := TOS;                                               40450000
         FLCLID := ABSOLUTE(COLD'LOAD'ID);                              40452000
         FLFCBVECT := 0;                                                40454000
          CHECKSUM;          <<NEW CHECKSUM>>                           40456000
          FLCHECKSUM := TOS; <<UPDATE LABEL>>                           40458000
          DISC(WRITE,SYSDISC,FLEXT0,FLAB,128);                          40460000
          FREAD(PROGFNUM,0D,PREC0,128);  <<PROG FILE RECORD 0>>         40462000
          NSEG := PREC0(1);   <<# OF SEGMENTS>>                         40464000
          START := PREC0(10);   <<ENTRY POINT>>                         40466000
          GLOBSIZE := PREC0(2);   <<GLOBAL AREA SIZE>>                  40468000
          GLOBRECORD := PREC0(3);   <<GLOBAL AREA STARTING RECORD>>     40470000
          CODERECORD := PREC0(4);   <<CODE STARTING RECORD>>            40472000
          EXTRECORD := PREC0(13);     <<EXTERNAL STARTING RECORD>>      40474000
          MAXD := PREC0(7);  <<MAXDATA>>                                40476000
          DLVALUE := IF PREC0(6)=-1 THEN 0 ELSE PREC0(X);               40478000
          IF NAME="ININ    " THEN FIRSTCST:=ININCSTN                    40480000
          ELSE                                                          40482000
            BEGIN                                                       40484000
            IF LOAD'IN'CSTX THEN                               <<00652>>40486000
              BEGIN         <<PGM LOADED IN CSTX>>             <<00652>>40488000
                FIRSTCST:=%301;                                <<00652>>40490000
                CSTBLKINDEX:=ALCSTBLOCK(NSEG);<<PGM BLOCK INDEX<<00652>>40492000
              END ELSE                                         <<00652>>40494000
              BEGIN         <<PGM LOADED IN SHARABLE CST>>     <<00652>>40496000
                FIRSTCST:=GETENTRY(SYSCST);                    <<00652>>40498000
                I:=0;                                          <<00652>>40500000
                WHILE (I:=I+1)<NSEG DO GETENTRY(SYSCST);       <<00652>>40502000
                CSTBLKINDEX:=0;                                <<00652>>40506000
              END;                                             <<00652>>40508000
            END;                                                        40510000
          CSTSEG := FIRSTCST+PREC0(9);   <<MAIN SEG>>                   40512000
          IF EXTRECORD=0 THEN GOTO LOADSEGS;                            40514000
          @EXTP := @EXTSAT;  <<POINTER TO SATISFIED EXTERNAL TABLE>>    40516000
          INDEX := 0;                                                   40518000
          FREAD(PROGFNUM,DOUBLE(EXTRECORD),EXTBUF,256);                 40520000
          EXTRECORD := EXTRECORD+1;                                     40522000
  NEXTEXT:NC := EXTBUF(INDEX).(4:4);  <<# OF CHARS IN EXTERNAL>>        40524000
          IF = THEN GOTO FIXSL;  <<NONE LEFT>>                          40526000
          TOS := EXTLABEL(EXTBUF(INDEX));  <<GET EXTERNAL LABEL>>       40528000
          IF S0=0 THEN                                                  40530000
            BEGIN  <<NOT FOUND>>                                        40532000
              BINBUF := MOVEAN(BINBUF(1),NAME,8);              <<01103>>40534000
              EXTBUF(INDEX).(0:4) := 0;                        <<01103>>40536000
              MESSAGE(M2456,,,,,EXTBUF(INDEX),BINBUF);         <<01103>>40538000
              I := EXTBUF(INDEX+NC&LSR(1)+1)+1;                         40540000
              GOTO INCINX;                                              40542000
            END;                                                        40544000
          TOS := LOGICAL(S0) LAND %377;  <<LOGICAL CST #>>              40546000
          DUPLICATE;                                                    40548000
          ALLOCATEALL(*,6);  <<ALLOCATE ALL REFERENCES>>                40550000
          ASSEMBLE(ZERO,XCH);                                           40552000
          TOS := PHYSCST(*);  <<CONVERT TO PHYSICAL CST>>               40554000
          TOS.(8:8) := TOS;                                             40556000
          MOVE EXTP := EXTBUF(INDEX+NC&LSR(1)+1),(I:=EXTBUF(X)+1);      40558000
          NEXTS := NEXTS+1;                                             40560000
          EXTP(I) := TOS;                                               40562000
          @EXTP := @EXTP+I+1;  <<BUMP TABLE POINTER>>                   40564000
  INCINX: X := INDEX+NC&LSR(1)+I+1;                                     40566000
          NC := EXTBUF(X).(0:2);   <<P FLAG>>                           40568000
          TOS:=(IF = THEN 1 ELSE IF NC=3 THEN EXTBUF(X).(2:6)+2 ELSE 2) 40570000
                +X; <<PTR TO NEXT EXTERNAL ENTRY>>                      40572000
          IF S0>127 THEN                                                40574000
            BEGIN   <<OVERFLOWS RECORD>>                                40576000
              MOVE EXTBUF := EXTBUF(128),(X);                           40578000
              TOS := TOS-X;                                             40580000
              FREAD(PROGFNUM,DOUBLE(EXTRECORD:=EXTRECORD+1),BUF(128),X);40582000
            END;                                                        40584000
          INDEX := TOS;   <<NEW EXTBUF PTR>>                            40586000
          GOTO NEXTEXT;                                                 40588000
  FIXSL:  IF CSTN>(I:=FIRSTCST+NSEG-1) AND NAME<>"ININ    " THEN        40590000
            BEGIN   <<SOME SL SEGS ALLOCATED>>                          40592000
              DO FIXSTT(I:=I+1) UNTIL I>=CSTN;                          40594000
              TOS := ABSOLUTE(SLDISCADR1);                              40596000
              TOS := ABSOLUTE(X:=X+1);                                  40598000
              SEGDIRENT(*,SLTYP,FIRSTCST+NSEG,                          40600000
                  CSTN);                                                40602000
            END;                                                        40604000
  LOADSEGS:                                                             40606000
          K := 28+(NSEG+1)&LSR(1);  <<FIRST SEGMENT INDEX>>             40608000
          DISCADR := FCBDBL(PROGFNUM*FCBDSIZE)+D'L(FCB(PROGFNUM*        40610000
              FCBSIZE+FCBSECTOFF)+CODERECORD));                         40612000
          I := 0;                                                       40614000
          DO                                                            40616000
            BEGIN                                                       40618000
              IF LOAD'IN'CSTX THEN                             <<00652>>40620000
                BEGIN         <<PGM LOADED IN CSTX>>           <<00652>>40622000
                  CURCST:=(CSTBLK(CSTBLKINDEX)+4               <<00652>>40624000
                           -ABSOLUTE(DFC))/4 + I;              <<00652>>40626000
                  CLABEL:=%20000;                              <<00652>>40628000
                  CLABEL.(3:7):=CSTBLKINDEX;                   <<00652>>40630000
                  CLABEL.(10:6):=I+1;                          <<00652>>40632000
                END ELSE                                       <<00652>>40634000
                BEGIN         <<PGM LOADED IN SHARABLE CST>>   <<00652>>40636000
                  CURCST:=FIRSTCST+I;                          <<00652>>40638000
                  CLABEL:=CURCST;                              <<00652>>40640000
                END;                                           <<00652>>40642000
              INSERTCST(CLABEL,DISCADR,SEGSIZE:=PREC0(K+I),    <<03603>>40644000
                  LINKED,1);                                   <<03603>>40646000
              READSTT(CURCST);                                          40648000
              N := -(STT(STTINDEX).(8:8));                              40650000
              J := 0;                                                   40652000
              WHILE (J:=J-1) >= N DO                                    40654000
                BEGIN                                                   40656000
                  TOS := STT(STTINDEX+J);  <<GET LABEL>>                40658000
                  IF >= THEN                                            40660000
                    BEGIN                                               40662000
                      DEL;                                              40664000
                      GOTO NEXTLAB;                                     40666000
                    END;                                                40668000
                  OLDCST := LOGICAL(S0) LAND %377;                      40670000
                  L := 0;                                               40672000
                  DO IF INTEGER(BPREC0(56+L))=OLDCST THEN               40674000
                    BEGIN  <<INTRA-PROGRAM REFERENCE>>                  40676000
                      TOS.(8:8) := L+FIRSTCST;                          40678000
                      GOTO SETLAB;                                      40680000
                    END                                                 40682000
                  UNTIL (L:=L+1)=NSEG;                                  40684000
                  DEL;                                                  40686000
                  TOS := (-J)&LSL(8)+I;                                 40688000
                  @EXTP := @EXTSAT;                                     40690000
                  L := -1;                                              40692000
                  WHILE (L:=L+1) < NEXTS DO                             40694000
                    BEGIN  <<SEARCH SATISFIED EXTERNALS>>               40696000
                      NR := EXTP;   <<NUMBER OF REFERENCES>>            40698000
                      M := 1;                                           40700000
                      DO IF S0=EXTP(M) THEN                             40702000
                        BEGIN  <<FOUND IT>>                             40704000
                          DEL;                                          40706000
                          TOS := EXTP(NR+1);                            40708000
                          GOTO SETLAB;                                  40710000
                        END                                             40712000
                      UNTIL (M:=M+1) > NR;                              40714000
                      @EXTP := @EXTP+NR+2;  <<POINT TO NEXT ENTRY>>     40716000
                    END;                                                40718000
                  DEL;                                                  40720000
                  TOS := %104001;   <<NOT FOUND>>                       40722000
  SETLAB:         STT(STTINDEX+J) := TOS;                               40724000
  NEXTLAB:      END;                                                    40726000
              DISC(WRITE,STTLDEV,STTADR,STT,384);  <<WRITE OUT STT>>    40728000
            IF NOT LOAD'IN'CSTX THEN                           <<00652>>40730000
              BEGIN         <<PGM LOADED IN SHARABLE CST>>     <<00652>>40732000
              TOS := I&LSL(8)+%300;                                     40734000
              IF LINKED=0 THEN ASSEMBLE(TSBC 11);  <<CORE RESIDENT>>    40736000
              ASSEMBLE(TSBC 12);   <<SYSTEM>>                           40738000
              SEGXFORM(CURCST) := TOS;                                  40740000
              SEGREF(X) := 1;                                           40742000
              END;                                             <<00652>>40744000
              IF LINKED<>2 THEN                                         40748000
                READCODE(CLABEL, LINKED);                      <<01384>>40750000
              DISCADR := DISCADR+DOUBLE((SEGSIZE.(2:14)+127)&LSR(7));   40752000
            END                                                         40754000
          UNTIL (I:=I+1)=NSEG;                                          40756000
          I := 0;   <<RESET CST REMAP ARRAY>>                           40758000
          DO BPREC0(56+I) := FIRSTCST+I UNTIL (I:=I+1)=NSEG;            40760000
          FWRITE(PROGFNUM,0D,PREC0,128);                                40762000
          IF STACKSIZE=0 THEN GOTO CLOSEFILE;  <<NO STACK>>             40764000
          I := IF LINKED=0 THEN PCBXCRSIZE ELSE PCBXLKSIZE;    <<01384>>40766000
          DATASIZE := ((I+GLOBSIZE+DLVALUE+STACKSIZE+3+        <<01384>>40768000
            (IF LINKED<>0 THEN 128 ELSE 0))&LSR(2))&LSL(2);    <<01384>>40770000
          DSTSTACK := GETENTRY(SYSDST);                        <<01384>>40772000
         DST(DSTSTACK&LSL(2)+1).STKFLAG:=1;                    <<MPEIV>>40774000
         DST(X).DISCCOPYVALIDFLAG:=1;                          <<MPEIV>>40776000
          IF LINKED <> ABSENT' THEN                            <<01384>>40778000
            DCOREADDR := MAM(DATASIZE, CORERES')               <<MPEIV>>40780000
          ELSE                                                 <<01384>>40782000
            DCOREADDR := MAM(DATASIZE);                        <<01384>>40784000
          TOS := PROGFNUM;                                              40786000
          TOS := 0;                                                     40788000
          TOS := GLOBRECORD;                                            40790000
          TOS := DCOREADDR;  << S-1 = BANK; S-0 = COREADDR >>  <<01384>>40792000
          TOS := TOS+DLVALUE+I;                                <<01384>>40794000
          FREAD'(*,*,*,GLOBSIZE);  <<READ DB AREA>>                     40796000
          IF MAXD=-1 THEN MAXD:=DATASIZE;                               40798000
          INSERTDST(COREADDR,DSTSTACK,DATASIZE,                <<01384>>40800000
            IF LINKED=1 THEN DATASIZE+1540 ELSE 0,BANK);       <<01384>>40802000
  CLOSEFILE:                                                            40804000
          FCLOSE(PROGFNUM);                                             40806000
      END <<LOAD>> ;                                                    40808000
$PAGE "SYSTEM PROCESS PROCEDURES"                                       40810000
PROCEDURE BROTHER(PCBSYSIX,PCBN);                              <<MPEIV>>40812000
VALUE PCBSYSIX,PCBN;                                           <<MPEIV>>40814000
INTEGER PCBSYSIX,PCBN;                                         <<MPEIV>>40816000
                                                               <<MPEIV>>40818000
BEGIN                                                          <<MPEIV>>40820000
INTEGER LINK;                                                  <<MPEIV>>40822000
X:=PCBSYSIX;                                                   <<MPEIV>>40824000
FATHERSONINFO.FATHERPINFIELD:=PROGPCBN;                        <<MPEIV>>40826000
X:=PROGPCBN*PCBSIZE+ABSOLUTE(SYSPCB);                          <<MPEIV>>40828000
IF FATHERSONINFO.SONPINFIELD = 0 THEN <<JBIV>>                 <<MPEIV>>40830000
FATHERSONINFO.SONPINFIELD:=PCBN ELSE                           <<MPEIV>>40832000
   BEGIN                                                       <<MPEIV>>40834000
   LINK:=FATHERSONINFO.SONPINFIELD*PCBSIZE;                    <<MPEIV>>40836000
   DO X:=LINK+ABSOLUTE(SYSPCB)                                 <<MPEIV>>40838000
   UNTIL (LINK:=(BROTHERINFO.BROTHERPINFIELD)*PCBSIZE)=0;      <<MPEIV>>40840000
   BROTHERINFO.BROTHERPINFIELD:=PCBN;                          <<MPEIV>>40842000
   END;                                                        <<MPEIV>>40844000
END <<BROTHER>>;                                               <<MPEIV>>40846000
                                                                        40848000
          <<----------------                                            40850000
            CREATE PROCESS                                              40852000
          ---------------->>                                            40854000
<<CREATED PROCESSES ARE LOADED INTO THE CSTX AREA.  EACH>>     <<00652>>40856000
<<PROCESS HAS ITS OWN PRIVATE WORKING SET.  PROCREATED  >>     <<00652>>40858000
<<PROCESSES ARE LOADED IN THE SHARABLE CST AREA.  EACH  >>     <<00652>>40860000
<<PROCESS SHARES THE SYSTEM PROCESS WORKING SET.        >>     <<00652>>40862000
  INTEGER PROCEDURE CREATE(NAME,LOGPCBN,PRIORITY,STACKSIZE,             40864000
              STATBIT,PROCTYPE,RESABSDB,SON,LINKED,XINIT);              40866000
    VALUE LOGPCBN,PRIORITY,STACKSIZE,STATBIT,PROCTYPE,SON,              40868000
              RESABSDB,LINKED,XINIT;                                    40870000
    BYTE ARRAY NAME;          <<NAME OF PROGRAM FILE>>                  40872000
    INTEGER LOGPCBN,          <<LOGICAL PCB NUMBER>>                    40874000
            PRIORITY,         <<PROCESS PRIORITY>>                      40876000
            STACKSIZE,        <<INITIAL STACKSIZE>>                     40878000
            STATBIT,          <<BIT IN PCB STATUS WORD>>                40880000
            PROCTYPE,         <<PROCESS TYPE>>                          40882000
            XINIT;            <<INITIAL VALUE FOR X>>                   40884000
    LOGICAL SON,              <<TRUE IF SON OF PROGENITOR>>             40886000
            RESABSDB,         <<BIT 0=1 MEANS RESIDENT,                 40888000
                                BIT 15=1 MEANS ABSOLUTE DB>>            40890000
            LINKED;          <<0 IF CORE RESIDENT,2 IF LINKED>><<MPEIV>>40892000
                                                               <<MPEIV>>40894000
      BEGIN                                                             40896000
        INTEGER PCBXSIZE,     <<SIZE OF PCBX>>                          40898000
                PXFIXSIZE,                                              40900000
                GLOB,         <<SIZE OF GLOBAL AREA>>                   40902000
                DSTN,         <<STACK DST>>                             40904000
                N,                                                      40906000
                NSEG,         <<NO. OF CODE SEGMENTS>>         <<03004>>40908000
                FIRSTCST,     <<PHYS. CST OF 1ST SEGMENT>>     <<03004>>40910000
                TEMP,                                          <<01384>>40912000
                PCBN=CREATE;  <<PCB NUMBER>>                   <<01384>>40914000
        INTEGER POINTER PCBENT=TABIX;  << PTR TO PCB ENTRY >>  <<01384>>40916000
        DOUBLE  MARKER,       <<PTR TO STACK MARKER>>          <<01384>>40918000
                PCBX;         <<PTR TO PCBX>>                  <<01384>>40920000
        LOGICAL MARKER1 = MARKER,                              <<01384>>40922000
                MARKER2 = MARKER+1,                            <<01384>>40924000
                PCBX1   = PCBX,                                <<01384>>40926000
                PCBX2   = PCBX+1;                              <<01384>>40928000
        INTEGER CSTBLKINDEX;  <<PGM CSTBLK INDEX>>             <<00652>>40930000
        LOGICAL CREATEFLAG:=TRUE;                              <<00652>>40932000
        DOUBLE  DCOREADDR;                                     <<01384>>40934000
        INTEGER BANK     = DCOREADDR,                          <<01384>>40936000
                COREADDR = DCOREADDR+1;                        <<01384>>40938000
        ENTRY PROCREATE;                                                40940000
          IF STACKSIZE <> 0 THEN STACKSIZE:=STACKSIZE+256;     <<MPEIV>>40942000
          LOAD(NAME,CSTINDEX,DSTN,STACKSIZE,GLOB,PROCSTART,             40944000
          LINKED,TRUE,CSTBLKINDEX,FIRSTCST,NSEG); <<LOAD PROG>><<03004>>40946000
                                                               <<03004>>40948000
          GO AROUND;                                                    40950000
  PROCREATE:                                                            40952000
          CREATEFLAG:=FALSE;    <<NOT A CREATE>>               <<00652>>40954000
          IF STACKSIZE <> 0 THEN STACKSIZE:=STACKSIZE+256;     <<MPEIV>>40956000
          TOS := 0;                                                     40958000
          TOS := PLABEL(NAME);                                          40960000
          CSTINDEX := S0.(8:8);                                         40962000
          PROCSTART := INTLABEL(*);                                     40964000
          CSTBLKINDEX:=0;       <<NOT IN CSTX>>                <<00652>>40966000
          TOS := 0;                                                     40968000
          TOS := IF LINKED=0 THEN PCBXCRSIZE ELSE PCBXLKSIZE;           40970000
          TOS:=TOS+STACKSIZE+(IF LINKED=0 THEN 0 ELSE 128);    <<00277>>40972000
                    <<SIZE OF DATA SEGMENT>>                   <<00277>>40974000
          MAXD := ((S0+3)&LSR(2))&LSL(2);                      <<00277>>40976000
          MEMSEG := ROUND(*);                                  <<01384>>40978000
          DSTN := GETENTRY(SYSDST);                            <<01384>>40980000
          IF LINKED <> ABSENT' THEN  << GET STACK SPACE >>     <<01384>>40982000
            DCOREADDR := MAM(MEMSEG, CORERES')                 <<MPEIV>>40984000
          ELSE                                                 <<01384>>40986000
            DCOREADDR := MAM(MEMSEG);                          <<01384>>40988000
          GLOB := 0;                                                    40990000
          DLVALUE := 0;                                                 40992000
          INSERTDST(COREADDR,DSTN,MEMSEG,IF LINKED=0 THEN 0    <<MPEIV>>40994000
            ELSE MAXD+1540,BANK);                              <<01384>>40996000
        DST(DSTN&LSL(2)+1).DISCCOPYVALIDFLAG:=1;               <<MPEIV>>40998000
        DST(X).STKFLAG:=1;                                     <<MPEIV>>41000000
                                                               <<01384>>41002000
  AROUND:                                                               41004000
          PCBN := IF SON THEN GETENTRY(SYSPCB) ELSE PROGPCBN;           41006000
          IF LOGPCBN >= 0                                               41008000
            THEN ABSOLUTE(LPROCTAB+LOGPCBN) := PCBN*PCBSIZE;            41010000
          IF LINKED=0 THEN                                              41012000
            BEGIN  <<CORE RESIDENT STACK>>                              41014000
              TOS := PCBXCRSIZE;                                        41016000
              TOS := PXFIXCRSIZE;                                       41018000
            END                                                         41020000
          ELSE                                                          41022000
            BEGIN  <<LINKED MEMORY STACK>>                              41024000
            TOS := PCBXLKSIZE;                                          41026000
              TOS := PXFIXLKSIZE;                                       41028000
            END;                                                        41030000
          PXFIXSIZE := TOS;                                             41032000
          PCBXSIZE := TOS;                                              41034000
                                                               <<01384>>41036000
          BANK := DST(DSTN&LSL(2)+2).(8:8);                    <<01756>>41038000
          COREADDR := DST(X:=X+1);                             <<01384>>41040000
          DBVALUE := COREADDR+PCBXSIZE+DLVALUE;                <<01384>>41042000
          ZVALUE := GLOB+STACKSIZE-17;                                  41044000
                                                               <<01384>>41046000
        << SET UP MARKER >>                                    <<01384>>41048000
          MARKER1 := BANK;                                     <<01384>>41050000
          MARKER2 := DBVALUE + GLOB;                           <<01384>>41052000
          SSEA(MARKER+0D, 0);  << PARM FOR TERMINATE >>        <<01384>>41054000
          SSEA(MARKER+1D, 0);  << TERMINATE MARKER >>          <<01384>>41056000
          SSEA(MARKER+2D, ABSOLUTE(TERMINTLAB));               <<01384>>41058000
          TEMP := ABSOLUTE(TERMEXTLAB).(8:8);                  <<01384>>41060000
          TEMP.(0:2) := 3;                                     <<01384>>41062000
          SSEA(MARKER+3D, TEMP);                               <<01384>>41064000
          SSEA(MARKER+4D, 4);                                  <<01384>>41066000
          SSEA(MARKER+5D, XINIT);  << START UP MARKER >>       <<01384>>41068000
          SSEA(MARKER+6D, PROCSTART);                          <<01384>>41070000
          SSEA(MARKER+7D, %140000+CSTINDEX);                   <<01384>>41072000
          SSEA(MARKER+8D, 4);                                  <<01384>>41074000
          IF RESABSDB THEN  << VALUE FOR DB >>                 <<01384>>41076000
            BEGIN                                              <<01384>>41078000
            SSEA(MARKER+9D, 0);                                <<01384>>41080000
            SSEA(MARKER+10D, SYSBASE);                         <<01384>>41082000
            END                                                <<01384>>41084000
          ELSE                                                 <<01384>>41086000
            BEGIN                                              <<01384>>41088000
            SSEA(MARKER+9D, BANK);                             <<01384>>41090000
            SSEA(MARKER+10D, DBVALUE);                         <<01384>>41092000
            END;                                               <<01384>>41094000
          SVALUE := GLOB+10;                                   <<01384>>41096000
                                                               <<01384>>41098000
        << SET UP PXGLOB AREA >>                               <<01384>>41100000
          PCBX := DCOREADDR;                                   <<01384>>41102000
          SSEA(PCBX+0D, PCBXSIZE);        << OFFSET TO DL >>   <<01384>>41104000
          SSEA(PCBX+1D, PCBXSIZE+DLVALUE);<< OFFSET TO DB >>   <<01384>>41106000
          SSEA(PCBX+2D, -1);              << ATTRIBUTES >>     <<01384>>41108000
          SSEA(PCBX+3D, CONSOLELDEV);     << JOB INPUT LDEV >> <<01384>>41110000
          SSEA(PCBX+4D, CONSOLELDEV);     << JOB OUTPUT LDEV>> <<01384>>41112000
          TEMP := %4000;                  << DUPLICATIVE BIT>> <<01384>>41114000
          TEMP.(5:1) := 1;                << INTERACTIVE >>    <<01384>>41116000
          IF LINKED<>0 THEN                                    <<01384>>41118000
            BEGIN                                              <<01384>>41120000
            SSEA(PCBX+5D, SJDTDSTN);      << JDT DST >>        <<01384>>41122000
            TEMP.(6:10) := SJITDSTN;      << JIT DST >>        <<01384>>41124000
            END;                                               <<01384>>41126000
          SSEA(PCBX+6D, TEMP);                                 <<01384>>41128000
                                                               <<01384>>41130000
        << SET UP PXFIXED AREA >>                              <<01384>>41132000
          PCBX2 := PCBX2 + PXGLOB;                             <<01384>>41134000
          SSEA(PCBX+0D, PXFIXSIZE);<< LENGTH OF FILE AREA >>   <<01384>>41136000
          SSEA(PCBX+1D, SVALUE);   << S-DB >>                  <<01384>>41138000
          SSEA(PCBX+2D, ZVALUE);   << Z-DB >>                  <<01384>>41140000
          SSEA(PCBX+3D, GLOB);     << Q-DB >>                  <<01384>>41142000
          SSEA(PCBX+4D, DLVALUE);  << DB-DL >>                 <<01384>>41144000
          SSEA(PCBX+5D, -1);       << GENERAL RESOURCE CAP. >> <<01384>>41146000
          IF LINKED<>0 THEN                                             41148000
            BEGIN  <<STACK IN LINKED MEMORY>>                           41150000
            SSEA(PCBX+13D, MAXD);  << MAXIMUM DL TO Z >>       <<01384>>41152000
            N := MAXD + 1536;                                  <<MPEIV>>41154000
            TEMP:=((N+NWORDPAGE-1)/NWORDPAGE)*NWORDPAGE;       <<01384>>41156000
            SSEA(PCBX+20D, TEMP);  << USED VIRTUAL DISC SPACE>><<01384>>41158000
            SSEA(PCBX+23D, STACKSIZE);<<CURRENT MAXSTACK SIZE>><<01964>>41160000
            END;                                                        41162000
          PCBX2 := PCBX2 + LOGICAL(PXFIXSIZE);                 <<01384>>41164000
          IF LINKED<>0 THEN                                             41166000
            BEGIN                                                       41168000
            SSEA(PCBX+0D, PXFILE);  << LENGTH OF FILE AREA >>  <<01384>>41170000
            PCBX2 := PCBX2 + PXFILE;                           <<01384>>41172000
            END;                                                        41174000
          SSEA(PCBX+0D, 0);  << EXTRA PCBX PTR >>              <<01384>>41176000
          SSEA(PCBX+1D, PCBXSIZE-PXGLOB-PXFIXSIZE);<<FILEAREA>><<01384>>41178000
          SSEA(PCBX+2D, PCBXSIZE-PXGLOB);  << FIXED AREA PTR >><<01384>>41180000
          SSEA(PCBX+3D, PCBXSIZE);  << PTR TO GLOBAL AREA >>   <<01384>>41182000
                                                               <<01384>>41184000
          IF LINKED=2 THEN ABSENT(DSTN,N);  <<WRITE OUT STACK>><<01384>>41186000
                                                               <<MPEIV>>41188000
                                                               <<MPEIV>>41190000
TOS:=0;                                                        <<MPEIV>>41192000
TOS:=SYSBASE;                                                  <<MPEIV>>41194000
ASSEMBLE(XCHD);                                                <<MPEIV>>41196000
X:=ABSOLUTE(SYSPCB)+PCBN*PCBSIZE;                              <<MPEIV>>41198000
IF SON THEN BROTHER(X,PCBN);                                   <<MPEIV>>41200000
IF INTEGER(RESABSDB) < 0 THEN QUEUEINGINFO.PROCRESIDENTFLAG:=1 <<MPEIV>>41202000
ELSE                                                           <<MPEIV>>41204000
   BEGIN  <<NOT A CORE RESIDENT PROCESS>>                      <<MPEIV>>41206000
   X:=PCBN*PCBSIZE+ABSOLUTE(SYSPCB);                           <<MPEIV>>41208000
   PIINFONIMPPIN.PSIMFIELD:=7;                                 <<MPEIV>>41210000
   TOS:=RESABORTINFO;                                          <<MPEIV>>41212000
   TOS.SARFLAG:=1;                                             <<MPEIV>>41214000
   RESABORTINFO:=TOS;                                          <<MPEIV>>41216000
   WAKEMASK.MEMWAITFLAG:=1;                                    <<MPEIV>>41218000
   TOS:=GETENTRY(SYSSWAPTAB);<<ENTRY NUMBER>>                  <<MPEIV>>41220000
   TOS:=TOS*SWAPTABSIZE;                                       <<MPEIV>>41222000
   TOS:=TOS+ABSOLUTE(SYSSWAPTAB);                              <<MPEIV>>41224000
   X:=ABSOLUTE(SYSPCB)+PCBN*PCBSIZE;                           <<MPEIV>>41226000
   SLLPTR:=S0;                                                 <<MPEIV>>41228000
   X:=TOS;<<FIX UP SLL SO PROC'S STACK WILL GET SWAPPED IN>>   <<MPEIV>>41230000
   TOS:=0;                                                     <<MPEIV>>41232000
   TOS.SLLSWAPREQFLAG:=1;                                      <<MPEIV>>41234000
   SLLSCHEDTOIOMSG:=TOS;                                       <<MPEIV>>41236000
   TOS:=GETENTRY(SYSSWAPTAB);                                  <<MPEIV>>41238000
   TOS:=TOS*SWAPTABSIZE;                                       <<MPEIV>>41240000
   TOS:=TOS+SWAPTABSYSBASEINX;                                 <<MPEIV>>41242000
   SLLFIRSTINX:=S0;                                            <<MPEIV>>41244000
   SLLMEMREQINX:=S0;                                           <<MPEIV>>41246000
   SLLSEGCNT:=1;                                               <<MPEIV>>41248000
   X:=TOS; <<FILL IN SLLENTRY FOR STACK>>                      <<MPEIV>>41250000
   SLLSEGIDENT:=DSTN;                                          <<MPEIV>>41252000
   SLLFLAGS.SLLSTKENTRYFLAG:=1;                                <<MPEIV>>41254000
                                                               <<MPEIV>>41256000
   END;                                                        <<MPEIV>>41258000
X:=PCBN*PCBSIZE+ABSOLUTE(SYSPCB);                              <<MPEIV>>41260000
IF RESABSDB THEN DBXDSINFO.ABSDBFLAG:=1;                       <<MPEIV>>41262000
STKINFO.STACKFIELD:=DSTN;                                      <<MPEIV>>41264000
                                                               <<MPEIV>>41266000
TOS:=WAKEMASK;                                                 <<MPEIV>>41268000
X:=STATBIT;                                                    <<MPEIV>>41270000
IF <> THEN ASSEMBLE(TSBC 0,X);                                 <<MPEIV>>41272000
X:=PCBN*PCBSIZE+ABSOLUTE(SYSPCB);                              <<MPEIV>>41274000
WAKEMASK:=TOS;                                                 <<MPEIV>>41276000
PBX:=CSTBLKINDEX;                                              <<MPEIV>>41278000
QUEUEINGINFO.PRIFIELD:=PRIORITY;                               <<MPEIV>>41280000
QUEUEINGINFO.LQFLAG:=1;                                        <<MPEIV>>41282000
TOS:=PROCSTATE;                                                <<MPEIV>>41284000
TOS.LIVFLAG:=1;                                                <<MPEIV>>41286000
TOS.PROCESSTYPEFIELD:=PROCTYPE;                                <<MPEIV>>41288000
PROCSTATE:=TOS;                                                <<MPEIV>>41290000
ASSEMBLE(XCHD);                                                <<MPEIV>>41292000
END <<CREATE>> ;                                               <<MPEIV>>41294000
                                                                        41296000
$PAGE         "DEVICE TABLES MANIPULATION PROCEDURES"                   41298000
$CONTROL SEGMENT=MAINSEG1                                               41300000
          <<--------------------------                                  41302000
            CONVERT ASCII AND EBCDIC                                    41304000
          -------------------------->>                                  41306000
PROCEDURE CONVERT(CODE,INSTRING,OUTSTRING,STRINGLENGTH);                41308000
VALUE CODE,STRINGLENGTH;                                                41310000
INTEGER CODE,STRINGLENGTH;                                              41312000
BYTE ARRAY INSTRING,OUTSTRING;                                          41314000
BEGIN                                                                   41316000
     INTEGER I := -1;                                                   41318000
     ARRAY ASCI(0:255)=PB:=                                             41320000
                                                                        41322000
          << EBCDIC TO ASCII CONVERSION TABLE >>                        41324000
                                                                        41326000
          %000, %001, %002, %003, %000, %011, %000, %177,               41328000
          %000, %000, %000, %013, %014, %015, %016, %017,               41330000
          %020, %021, %022, %023, %000, %000, %010, %000,               41332000
          %030, %031, %000, %000, %034, %035, %036, %037,               41334000
          %000, %000, %000, %000, %000, %012, %027, %033,               41336000
          %000, %000, %000, %000, %000, %005, %006, %007,               41338000
          %000, %000, %026, %000, %000, %000, %000, %004,               41340000
          %000, %000, %000, %000, %024, %025, %000, %032,               41342000
          %040, %000, %000, %000, %000, %000, %000, %000,               41344000
          %000, %000, %133, %056, %074, %050, %053, %041,               41346000
          %046, %000, %000, %000, %000, %000, %000, %000,               41348000
          %000, %000, %135, %044, %052, %051, %073, %136,               41350000
          %055, %057, %000, %000, %000, %000, %000, %000,               41352000
          %000, %000, %174, %054, %045, %137, %076, %077,               41354000
          %000, %000, %000, %000, %000, %000, %000, %000,               41356000
          %000, %140, %072, %043, %100, %047, %075, %042,               41358000
          %000, %141, %142, %143, %144, %145, %146, %147,               41360000
          %150, %151, %000, %000, %000, %000, %000, %000,               41362000
          %000, %152, %153, %154, %155, %156, %157, %160,               41364000
          %161, %162, %000, %000, %000, %000, %000, %000,               41366000
          %000, %176, %163, %164, %165, %166, %167, %170,               41368000
          %171, %172, %000, %000, %000, %000, %000, %000,               41370000
          %000, %000, %000, %000, %000, %000, %000, %000,               41372000
          %000, %000, %000, %000, %000, %000, %000, %000,               41374000
          %173, %101, %102, %103, %104, %105, %106, %107,               41376000
          %110, %111, %000, %000, %000, %000, %000, %000,               41378000
          %175, %112, %113, %114, %115, %116, %117, %120,               41380000
          %121, %122, %000, %000, %000, %000, %000, %000,               41382000
          %134, %000, %123, %124, %125, %126, %127, %130,               41384000
          %131, %132, %000, %000, %000, %000, %000, %000,               41386000
          %060, %061, %062, %063, %064, %065, %066, %067,               41388000
          %070, %071, %000, %000, %000, %000, %000, %000;               41390000
                                                                        41392000
     ARRAY EBCDIC(0:255)=PB:=                                           41394000
                                                                        41396000
          << ASCII TO EBCDIC CONVERSION TABLE >>                        41398000
                                                                        41400000
          %000, %001, %002, %003, %067, %055, %056, %057,               41402000
          %026, %005, %045, %013, %014, %015, %016, %017,               41404000
          %020, %021, %022, %023, %074, %075, %062, %046,               41406000
          %030, %031, %077, %047, %034, %035, %036, %037,               41408000
          %100, %117, %177, %173, %133, %154, %120, %175,               41410000
          %115, %135, %134, %116, %153, %140, %113, %141,               41412000
          %360, %361, %362, %363, %364, %365, %366, %367,               41414000
          %370, %371, %172, %136, %114, %176, %156, %157,               41416000
          %174, %301, %302, %303, %304, %305, %306, %307,               41418000
          %310, %311, %321, %322, %323, %324, %325, %326,               41420000
          %327, %330, %331, %342, %343, %344, %345, %346,               41422000
          %347, %350, %351, %112, %340, %132, %137, %155,               41424000
          %171, %201, %202, %203, %204, %205, %206, %207,               41426000
          %210, %211, %221, %222, %223, %224, %225, %226,               41428000
          %227, %230, %231, %242, %243, %244, %245, %246,               41430000
          %247, %250, %251, %300, %152, %320, %241, %007,               41432000
          %000, %000, %000, %000, %000, %000, %000, %000,               41434000
          %000, %000, %000, %000, %000, %000, %000, %000,               41436000
          %000, %000, %000, %000, %000, %000, %000, %000,               41438000
          %000, %000, %000, %000, %000, %000, %000, %000,               41440000
          %000, %000, %000, %000, %000, %000, %000, %000,               41442000
          %000, %000, %000, %000, %000, %000, %000, %000,               41444000
          %000, %000, %000, %000, %000, %000, %000, %000,               41446000
          %000, %000, %000, %000, %000, %000, %000, %000,               41448000
          %000, %000, %000, %000, %000, %000, %000, %000,               41450000
          %000, %000, %000, %000, %000, %000, %000, %000,               41452000
          %000, %000, %000, %000, %000, %000, %000, %000,               41454000
          %000, %000, %000, %000, %000, %000, %000, %000,               41456000
          %000, %000, %000, %000, %000, %000, %000, %000,               41458000
          %000, %000, %000, %000, %000, %000, %000, %000,               41460000
          %000, %000, %000, %000, %000, %000, %000, %000,               41462000
          %000, %000, %000, %000, %000, %000, %000, %000;               41464000
                                                                        41466000
     CASE * CODE OF                                                     41468000
     BEGIN                                                              41470000
          WHILE(I:=I+1)<STRINGLENGTH DO                                 41472000
          BEGIN     <<CASE 0, CONVERT EBCDIC TO ASCII>>                 41474000
               X := INSTRING(I);                                        41476000
               TOS := ASCI(X);                                          41478000
               OUTSTRING(I) := TOS;                                     41480000
          END;                                                          41482000
          WHILE(I:=I+1)<STRINGLENGTH DO                                 41484000
          BEGIN     <<CASE 1, CONVERT ASCII TO EBCDIC>>                 41486000
               X := INSTRING(I);                                        41488000
               TOS := EBCDIC(X);                                        41490000
               OUTSTRING(I) := TOS;                                     41492000
          END;                                                          41494000
     END;                                                               41496000
END <<CONVERT>>;                                                        41498000
                                                                        41500000
$CONTROL SEGMENT=CONFIGURE                                              41502000
         <<------------------------------------>>              <<03550>>41504000
         << CHECK FOR SYSTEM-DISC TYPE DEVICES >>              <<03550>>41506000
         <<------------------------------------>>              <<03550>>41508000
LOGICAL PROCEDURE SYSDISC'TYPE( TYPE, SUBTYP);                 <<03550>>41510000
VALUE TYPE, SUBTYP;                                            <<03550>>41512000
INTEGER TYPE,     << DEVICE TYPE >>                            <<03550>>41514000
        SUBTYP;   << DEVICE SUBTYPE >>                         <<03550>>41516000
COMMENT                                                        <<03550>>41518000
THIS PROCEDURE RETURNS TRUE IF THE DEVICE WITH                 <<03550>>41520000
THE GIVEN TYPE AND SUBTYPE IS A VALID SYSTEM-                  <<03550>>41522000
DOMAIN DISC.  IT RETURNS FALSE OTHERWISE.                      <<03550>>41524000
;                                                              <<03550>>41526000
BEGIN                                                          <<03550>>41528000
IF TYPE = DISC0 OR                                             <<03550>>41530000
   TYPE = DISC1 OR                                             <<03550>>41532000
   TYPE = DISC3 AND SUBTYP <> LINUS THEN                       <<03550>>41534000
   SYSDISC'TYPE := TRUE                                        <<03550>>41536000
ELSE                                                           <<03550>>41538000
   SYSDISC'TYPE := FALSE;                                      <<03550>>41540000
END;  << SYSDISC'TYPE >>                                       <<03550>>41542000
          <<----------------------------------->>              <<03550>>41544000
          << CHECK FOR SERIAL-DISC TYPE DEVICE >>              <<03550>>41546000
          <<----------------------------------->>              <<03550>>41548000
LOGICAL PROCEDURE SDISC'TYPE( TYPE, SUBTYP);                   <<03550>>41550000
VALUE TYPE, SUBTYP;                                            <<03550>>41552000
INTEGER TYPE,     << DEVICE TYPE >>                            <<03550>>41554000
        SUBTYP;   << DEVICE SUBTYPE >>                         <<03550>>41556000
COMMENT                                                        <<03550>>41558000
THIS PROCEDURE RETURNS TRUE IF THE DEVICE WITH                 <<03550>>41560000
THE GIVEN TYPE AND SUBTYPE CAN BE A SERIAL DISC.               <<03550>>41562000
IT RETURNS FALSE OTHERWISE.  ALL REMOVABLE DISCS               <<03550>>41564000
EXCEPT THE 7900 CAN BE SERIAL DISCS.                           <<03550>>41566000
;                                                              <<03550>>41568000
BEGIN                                                          <<03550>>41570000
IF TYPE=DISC0 AND (SUBTYP=UH7905 OR SUBTYP=UH7906              <<03550>>41572000
                OR SUBTYP=S7920  OR SUBTYP=S7925 ) OR          <<03550>>41574000
   TYPE=DISC2 OR                                               <<03550>>41576000
   TYPE=DISC3 AND (SUBTYP=S7935 OR SUBTYP=LINUS) THEN          <<03550>>41578000
                                                               <<03550>>41580000
   SDISC'TYPE := TRUE    << IT CAN BE A SERIAL DISC >>         <<03550>>41582000
ELSE                                                           <<03550>>41584000
   SDISC'TYPE := FALSE;  << IT CAN'T BE SERIAL >>              <<03550>>41586000
END;  << SDISC'TYPE >>                                         <<03550>>41588000
         <<----------------------------->>                     <<03550>>41590000
         <<   IDENTIFY HPIB DEVICE      >>                     <<03550>>41592000
         <<----------------------------->>                     <<03550>>41594000
INTEGER PROCEDURE IDENTIFY( DRT);                              <<03550>>41596000
VALUE DRT;                                                     <<03550>>41598000
INTEGER DRT;   << DRT # OF DEVICE TO IDENTIFY >>               <<03550>>41600000
COMMENT                                                        <<03550>>41602000
THIS PROCEDURE RETURNS THE HPIB DEVICE IDENTIFICATION          <<03550>>41604000
CODE OF THE DEVICE ON THE GIVEN DRT.  IT WORKS ALSO            <<03550>>41606000
FOR HPIB DEVICES CONNECTED TO STARFISH ON THE                  <<03550>>41608000
SERIES II/III.  IF NO DEVICE EXISTS ON THE GIVEN DRT           <<03550>>41610000
OR IF THE DEVICE IS NOT AN HPIB DEVICE THE PROCEDURE           <<03550>>41612000
RETURNS 0.  NOTE:  THE DRT MUST BE INITIALIZED BEFORE          <<03550>>41614000
CALLING THIS PROCEDURE ( I.E., CPVA POINTER SET).              <<03550>>41616000
;                                                              <<03550>>41618000
BEGIN                                                          <<03550>>41620000
DEFINE ERRCODE = (0:3)#;                                       <<03550>>41622000
EQUATE IDENTCODE = 1,    << INDEX TO ID RETURN WORD >>         <<03550>>41626000
       IDENTSIZE = 4;    << CHANNEL PROGRAM SIZE    >>         <<03550>>41628000
ARRAY IDENTPGM(0:IDENTSIZE-1)=PB := << CHANNEL PROGRAM >>      <<03550>>41630000
      %3000,      << DEVICE IDENTIFY >>                        <<03550>>41632000
          0,      << ID RETURN BYTES >>                        <<03550>>41634000
                                                               <<03550>>41636000
       %600,      << INTERRUPT/HALT  >>                        <<03550>>41638000
          0;                                                   <<03550>>41640000
ARRAY BUF(0:IDENTSIZE-1);  << TO BUILD CHAN. PROG. >>          <<03550>>41642000
INTEGER SBANK,             << BANK OF 'BUF' >>                 <<03550>>41644000
        SADDRESS,          << ADDRESS OF 'BUF' >>              <<03550>>41646000
        CPADR;             << ABS. ADDR. OF CHAN PROG >>       <<03550>>41648000
                                                               <<03550>>41650000
<< GET ADDRESS OF CHANNEL PROGRAM AREA >>                      <<03550>>41652000
CPADR := ABS( CHANPROG);                                       <<03550>>41654000
<< MOVE CHANNEL PROGRAM INTO LOCAL BUFFER >>                   <<03550>>41656000
MOVE BUF := IDENTPGM,(IDENTSIZE);                              <<03550>>41658000
<< COMPUTE ABSOLUTE ADDRESS OF 'BUF' >>                        <<03550>>41660000
PUSH(DB);                                                      <<03550>>41662000
SADDRESS := TOS + @BUF;                                        <<03550>>41664000
SBANK := TOS;                                                  <<03550>>41666000
                                                               <<03550>>41668000
IF SERIESII'III THEN     << ON SERIES II/III  >>               <<03550>>41670000
   IF STARFISH THEN      << SYSTEM HAS A STARFISH >>           <<03550>>41672000
     BEGIN                                                     <<03550>>41674000
     TOS := DRT;       << IF TIO 0 RETURNS CCE, A      >>      <<03550>>41676000
     ASSEMBLE( TIO 0); << SERIES II/III DEVICE IS ON   >>      <<03550>>41678000
     IF = THEN GO NO'DEVICE'EXIT; << THAT DRT, SO QUIT >>      <<03550>>41680000
     END                                                       <<03550>>41682000
   ELSE      << NO STARFISH ON THIS SYSTEM >>                  <<03550>>41684000
     GO NO'DEVICE'EXIT;   << RETURN NO DEVICE >>               <<03550>>41686000
                                                               <<03550>>41688000
<< MOVE CHANNEL PROGRAM TO BANK 0 >>                           <<03550>>41690000
MABS(0,CPADR,SBANK,SADDRESS,IDENTSIZE);                        <<03550>>41692000
ZEROABS(GETDRT(DRT,DBI),7);   <<CLEAR THE CPVA AREA>>          <<03550>>41694000
INIT( DRT);        << INITIALIZE THE CHANNEL >>                <<03550>>41696000
IF <> THEN GO NO'DEVICE'EXIT;                                  <<03550>>41698000
SIOP( DRT, CPADR); << START THE CHANNEL PROGRAM >>             <<03550>>41700000
IF <> THEN GO NO'DEVICE'EXIT;                                  <<03550>>41702000
                                                               <<03550>>41704000
<< WAIT FOR CHANNEL PROGRAM COMPLETION >>                      <<03550>>41706000
WHILE GETDRT(DRT,CHANSTAT).(0:2) <> 0 DO;                      <<03550>>41708000
                                                               <<03550>>41710000
IF ABS(GETDRT(DRT,DBI)).ERRCODE = 4 THEN                       <<03550>>41712000
   << GOOD RETURN--A DEVICE RESPONDED >>                       <<03550>>41714000
   IDENTIFY := ABS( CPADR+IDENTCODE)                           <<03550>>41716000
ELSE                                                           <<03550>>41718000
                                                               <<03550>>41720000
NO'DEVICE'EXIT:  << NO RETURN--NO DEVICE ON DRT >>             <<03550>>41722000
                                                               <<03550>>41724000
   IDENTIFY := 0;                                              <<03550>>41726000
END;    << IDENTIFY >>                                         <<03550>>41728000
          <<-------------------------                                   41730000
            FORMAT CS DRIVER ENTRY                                      41732000
          ------------------------>>                                    41734000
  INTEGER PROCEDURE FORMATCSDVRENTRY(DVRNAME);                 <<00.06>>41736000
    BYTE ARRAY DVRNAME;                                                 41738000
    <<FORMATS EACH DRIVER ENTRY IN THE CS DATA SEGMENT>>       <<00.06>>41740000
    <<PARAMETER PASSED:                               >>       <<00.06>>41742000
    <<     DVRNAME   -   NAME OF DRIVER               >>       <<00.06>>41744000
    <<                                                >>       <<00.06>>41746000
    <<RETURN:                                         >>       <<00.06>>41748000
    <<     FORMATCSDVRENTRY - STT # OF DRIVER         >>       <<00.06>>41750000
    <<                        INITIALIZATION ROUTINE  >>       <<00.06>>41752000
      BEGIN                                                             41754000
        EQUATE CAPSECTSTDSIZE=12;                                       41756000
        INTEGER DVRFNUM,                                                41758000
                CAPSECTSIZE,                                            41760000
                INDEX,                                                  41762000
                 L,                                                     41764000
                DVRENTSIZE,                                             41766000
                BINDEX:=0,                                              41768000
                DBRECX:=0;                                              41770000
        INTEGER ARRAY DBAREA(*)=LBUF(128),                              41772000
                      PBAREA(*)=LBUF(128);                              41774000
        BYTE ARRAY DBAREAB(*)=DBAREA;                                   41776000
        SUBROUTINE READDBREC(BYTEX);                                    41778000
        VALUE BYTEX;                                                    41780000
        LOGICAL BYTEX;                                                  41782000
          BEGIN                                                         41784000
  AGAIN:  IF BYTEX AND BINDEX>=DBRECX&LSL(8) OR NOT BYTEX AND INDEX>=   41786000
            DBRECX&LSL(7) THEN                                          41788000
            BEGIN  <<READ NEXT RECORD>>                                 41790000
              FREAD(DVRFNUM,DOUBLE(DBRECX+REC0(3)),DBAREA(DBRECX&LSL(7))41792000
                ,128);                                                  41794000
              DBRECX := DBRECX+1;                                       41796000
              GO AGAIN;                                                 41798000
            END;                                                        41800000
          END <<READDBREC>> ;                                           41802000
                                                                        41804000
          DVRFNUM := FOPEN(DVRNAME);                                    41806000
          FREAD(DVRFNUM,0D,REC0,128);                                   41808000
          READDBREC(1);  <<READ FIRST DB AREA RECORD>>                  41810000
          BINDEX := CAPSECTSTDSIZE;                                     41812000
          BINDEX := INTEGER(DBAREAB(BINDEX))+X+1;  <<MODE SIZE>>        41814000
          READDBREC(1);                                                 41816000
          BINDEX := INTEGER(DBAREAB(BINDEX))+X+1;  <<PROTOCOL SIZE>>    41818000
          READDBREC(1);                                                 41820000
          BINDEX := INTEGER(DBAREAB(BINDEX))+X+1; <<TRANSCODE SIZE>>    41822000
          READDBREC(1);                                                 41824000
          INDEX := (BINDEX+1)&LSR(1);  <<SIZE IN WORDS>>                41826000
          CAPSECTSIZE := INDEX;                                         41828000
          INDEX := DBAREA(INDEX)+X+1;  <<LCM SIZE>>                     41830000
          READDBREC(0);                                                 41832000
          INDEX := DBAREA(INDEX)+X+1;  <<EDITOR SIZE>>                  41834000
          READDBREC(0);                                                 41836000
          INDEX := DBAREA(INDEX)+X+1;  <<PHYS DRIVER SIZE>>             41838000
          READDBREC(0);                                                 41840000
          INDEX := DBAREA(INDEX)+X+1; <<SIO PROGRAM SIZE>>              41842000
          READDBREC(0);                                                 41844000
          DVRENTSIZE := INDEX+DRINFOSIZE;  <<SIZE OF DRIVER ENTRY>>     41846000
          TOS := @CSDVRAREA-DVRENTSIZE;                                 41848000
          ASSEMBLE(DUP,DUP);                                            41850000
          SET(DL);  <<EXPAND DRIVER WORK AREA>>                         41852000
          CHECKMEM;                                                     41854000
          TOS := @CSDVRAREA;                                            41856000
          TOS := CSDVRAREASIZE;                                         41858000
          ASSEMBLE(MOVE 3);                                             41860000
          @CSDVRAREA := TOS;  <<NEW POINTER TO DRIVER WORK AREA>>       41862000
          @DRIVERENTRY := @CSDVRAREA(CSDVRAREASIZE);                    41864000
          CSDVRAREASIZE := X+DVRENTSIZE;                                41866000
        <<FORMAT DRIVER ENTRY>>                                         41868000
          DRENTRYSIZE := DVRENTSIZE;                                    41870000
          TOS := @DRNAME&LSL(1);                               <<04306>>41872000
          MOVE * := DVRNAME,(8);                                        41874000
          DRCAPSECTSIZE := CAPSECTSIZE;  <<SIZE OF CAPABILITY SECTION>> 41876000
          MOVE DRRETRIES'FLAGS := DBAREA,(INDEX);                       41878000
          CSTAB(X) := CSTAB(DRIVERENTNUM)+1;                            41880000
          TOS := REC0(10);                                              41882000
          TOS := 128;                                                   41884000
          ASSEMBLE(DIV);                                                41886000
          INDEX := TOS;                                                 41888000
          L := TOS;                                                     41890000
          FREAD(DVRFNUM,DOUBLE(L+REC0(4)),PBAREA,256);                  41892000
          DRLCMPLABEL := PBAREA(INDEX).(8:8);                           41894000
          DRSLCPLABEL := PBAREA(INDEX+1).(8:8);                         41896000
          DRPHYSDVRPLABEL := PBAREA(INDEX+2).(8:8);                     41898000
          DREDITORPLABEL := PBAREA(INDEX+3).(8:8);                      41900000
          FORMATCSDVRENTRY := PBAREA(INDEX+4).(8:8);           <<00.06>>41902000
          DRIHPLABEL := PBAREA(INDEX+6).(8:8);                          41904000
          FCLOSE(DVRFNUM);                                              41906000
      END <<FORMATCSDVRENTRY>> ;                                        41908000
$CONTROL SEGMENT=CONFIGURE                                              41910000
          <<-----------------                                           41912000
            GET CLASS INDEX                                             41914000
          ----------------->>                                           41916000
  INTEGER PROCEDURE CLINDEX(CLNAME);                                    41918000
    BYTE ARRAY CLNAME;                                                  41920000
      BEGIN                                                             41922000
        INTEGER INDEX := 10,I:=0;                                       41924000
          WHILE (I:=I+1)<=LDT(DCNUM) DO                                 41926000
          IF DVCLTAB(INDEX-10)=CLNAME,(8) THEN                          41928000
            BEGIN   <<FOUND IT>>                                        41930000
              CLINDEX := I;                                             41932000
              RETURN;                                                   41934000
            END                                                         41936000
          ELSE                                                          41938000
            BEGIN   <<BUMP INDEX>>                                      41940000
              TOS := DVCLTAB(INDEX);                                    41942000
              ASSEMBLE(DUP,NOT);                                        41944000
              IF TOS THEN TOS := TOS+1;                                 41946000
              INDEX := TOS+INDEX+11;                                    41948000
            END;                                                        41950000
      END <<CLINDEX>> ;                                                 41952000
                                                                        41954000
$CONTROL SEGMENT=MAINSEG1                                               41956000
          <<------------------                                          41958000
            GET PHONE NUMBER                                            41960000
          ------------------>>                                          41962000
  INTEGER PROCEDURE GETPHNB(ERRLABEL,ADDR,SPEC);                        41964000
    VALUE ERRLABEL,SPEC;                                                41966000
    INTEGER ERRLABEL,SPEC;                                              41968000
    BYTE ARRAY ADDR;                                                    41970000
      BEGIN                                                             41972000
        EQUATE BLANK=%6440;                                             41974000
        EQUATE SPACE=%40;                                      <<04256>>41976000
        EQUATE DELETE=%177;                                    <<04256>>41978000
        INTEGER CONCODE:=CCG;                                           41980000
          TOS := @ADDR;                                                 41982000
          SCAN BPINBUF WHILE BLANK,1;                                   41984000
          IF CARRY THEN CONCODE:=CCE;                                   41986000
          ASSEMBLE(DUP,DDUP);                                           41990000
  MOVEUPS:MOVE *:=* WHILE ANS,0;  <<UPSHIFT LOWER CASE>>       <<04256>>41992000
          IF INTEGER(BPS0) >= SPACE AND INTEGER(BPS0) < DELETE <<04256>>41994000
            THEN                                               <<04256>>41996000
            BEGIN                                                       41998000
            ASSEMBLE(INCA,INCB);                                        42000000
            GO MOVEUPS;                                                 42002000
            END;                                                        42004000
          SCAN * WHILE BLANK;                                           42006000
          IF NOCARRY  THEN                                              42008000
  ERROR:    BEGIN                                                       42010000
            MESSAGE(M2453);                                    <<01103>>42012000
            RETURNP:=ERRLABEL;                                          42014000
            ASSEMBLE(EXIT 4);                                           42016000
            END;                                                        42018000
          ASSEMBLE(XCH,SUB);  <<CALCULATE LENGTH>>                      42020000
          IF S0>30 THEN GO ERROR;                              <<04256>>42022000
          GETPHNB := S0;                                                42024000
          ASSEMBLE(MVB 3);                                              42026000
          STAT.(6:2):=CONCODE;                                          42028000
      END  <<GETPHNB>>;                                                 42030000
                                                                        42032000
          <<----------------------------                                42034000
            LIST ADDIIIONAL CS DRIVERS                                  42036000
          ---------------------------->>                                42038000
                                                                        42040000
  PROCEDURE LISTDVRS;                                                   42042000
    BEGIN                                                               42044000
        ARRAY HED(0:10)=PB:="ADDITIONAL CS DRIVERS";                    42046000
        INTEGER I:=-1,J:=0,K,L;                                         42048000
          MOVE LINE(12) := HED,(11);                           <<00888>>42050000
          PRINTLINE;                                           <<00888>>42052000
                                                                        42054000
          L := CTAB0(NUMADVRS);                                         42056000
          WHILE I<L DO                                                  42058000
            BEGIN                                                       42060000
            K:=-1;                                                      42062000
            WHILE (K:=K+1)<=5 AND (I:=I+1)<L DO                         42064000
              MOVE LINE(K*6):=CSDVR(I*4),(4);                  <<00888>>42066000
            PRINTLINE;                                         <<00888>>42068000
            END;                                                        42070000
    END  <<LISTDVRS>>;                                                  42072000
                                                                        42074000
$CONTROL SEGMENT=CONFIGURE                                              42076000
          <<----------------                                            42078000
            GET CLASS NAME                                              42080000
          ---------------->>                                            42082000
  PROCEDURE CLNAME(CLINDEX,NAME);                                       42084000
    VALUE CLINDEX;                                                      42086000
    INTEGER CLINDEX;                                                    42088000
    BYTE ARRAY NAME;                                                    42090000
      BEGIN                                                             42092000
        INTEGER I:=0;                                                   42094000
          X := 10;                                                      42096000
          WHILE (I:=I+1) < CLINDEX DO                                   42098000
            BEGIN                                                       42100000
              TOS := DVCLTAB(X);                                        42102000
              ASSEMBLE(DUP,NOT);                                        42104000
              IF TOS THEN TOS := TOS+1;                                 42106000
              X := TOS+X+11;                                            42108000
            END;                                                        42110000
          MOVE NAME := DVCLTAB(X-10),(8);                               42112000
      END <<CLNAME>> ;                                                  42114000
                                                               <<03004>>42116000
$CONTROL SEGMENT=SETUP                                         <<03004>>42118000
          <<------------------------------------>>             <<03004>>42120000
          <<  COUNT NO. OF TERMINALS CONFIGURED >>             <<03004>>42122000
          <<------------------------------------>>             <<03004>>42124000
  INTEGER PROCEDURE TERMCOUNT( NONLYNX);                       <<03004>>42126000
  COMMENT                                                      <<03004>>42128000
     TERMCOUNT RETURNS THE NO. OF LOGICAL DEVICES CONFIGURED   <<03004>>42130000
     WHICH ARE TERMINALS.  IF THE PARAMETER NONLYNX IS         <<03004>>42132000
     TRUE, THEN IT COUNTS ADCC- OR ATC-CONNECTED TERMINALS     <<03004>>42134000
     ONLY;                                                     <<03004>>42136000
  VALUE NONLYNX;                                               <<03004>>42138000
  LOGICAL NONLYNX;    << TRUE IF COUNT OF ADCC- OR ATC-    >>  <<03004>>42140000
                      << CONNECTED TERMINALS ONLY IS       >>  <<03004>>42142000
                      << REQUESTED.                        >>  <<03004>>42144000
     BEGIN                                                     <<03004>>42146000
     INTEGER LDEV,    << CURRENT LDEV  >>                      <<03004>>42148000
             COUNT,   << CURRENT COUNT >>                      <<03004>>42150000
             SUBTYP,  << DEVICE SUBTYPE>>                      <<03004>>42152000
             DEVTYP;  << DEVICE TYPE   >>                      <<03004>>42154000
     INTEGER POINTER DVRENT;    << CURRENT POINTER TO      >>  <<03004>>42156000
                                << DRIVER TABLE ENTRY      >>  <<03004>>42158000
     COUNT := 0;                                               <<03004>>42160000
     LDEV := 1;                                                <<03004>>42162000
     DO              << CHECK ALL LDEV'S >>                    <<03004>>42164000
        BEGIN                                                  <<03004>>42166000
        @DVRENT := @DVRTAB( LDEV*DVRSIZE); <<SET POINTER TO >> <<03004>>42168000
                                           <<DVR. TAB. ENTRY>> <<03004>>42170000
        DEVTYP  := LDT( LDEV*LDTSIZE+LDT2).TYP;                <<03004>>42172000
        SUBTYP  := LPDT( LDEV*LPDTSIZE+LPDT1).SUBTYPE;         <<03004>>42174000
                                                               <<03004>>42176000
        << CONSIDER ONLY TERMINAL DEVICES >>                   <<03004>>42178000
        IF DEVTYP = TERMDEVTYPE OR DEVTYP = 32 AND             <<03004>>42180000
          (SUBTYP=14 OR SUBTYP=15) THEN                        <<03004>>42182000
                                                               <<03004>>42184000
           << COUNT AS A TERMINAL ONLY IF NOT A DS DEVICE  >>  <<03004>>42186000
           << AND THE DRT IS NON-ZERO (DEVICE EXISTS)      >>  <<03004>>42188000
           IF (DVRENT(DVR1).DSBIT = 0) AND                     <<03004>>42190000
                          (DVRENT.DRTFIELD <> 0) THEN          <<03004>>42192000
               BEGIN                                           <<03004>>42194000
               COUNT := COUNT + 1;    << BUMP COUNTER >>       <<03004>>42196000
               <<IF REQUESTED, DO NOT COUNT LYNX TERMINALS>>   <<03004>>42198000
               IF NONLYNX THEN                                 <<03004>>42200000
                  IF LDTX(LDEV*LDTXSIZE+LDTX2).TERMBOARD       <<03004>>42202000
                     = LYNX'TERM THEN                          <<03004>>42204000
                     COUNT := COUNT - 1;                       <<03004>>42206000
               END;                                            <<03004>>42208000
        LDEV := LDEV + 1;                                      <<03004>>42210000
        END                                                    <<03004>>42212000
     UNTIL LDEV > HLDEV;  << DO UNTIL CHECKED ALL LDEV'S >>    <<03004>>42214000
     TERMCOUNT := COUNT;  << RETURN TOTAL >>                   <<03004>>42216000
     END;   << TERMCOUNT >>                                    <<03004>>42218000
$CONTROL SEGMENT=SETUP                                         <<03708>>42222000
          <<------------------------------->>                  <<03708>>42224000
          <<  CHECK INPUT TERMINAL SPEED   >>                  <<03708>>42226000
          <<------------------------------->>                  <<03708>>42228000
LOGICAL PROCEDURE CHECKSPEED( TSPEED, SPEEDCDE );              <<03708>>42230000
INTEGER                                                        <<03708>>42232000
   TSPEED,       << SPEED (CHARS/SEC), PASSED OR RETURNED >>   <<03708>>42234000
   SPEEDCDE;     << BAUDRATE CODE, PASSED OR RETURNED >>       <<03708>>42236000
COMMENT                                                        <<03708>>42238000
THIS PROCEDURE CONVERTS THE TERMINAL SPEED (CHARS/SEC)         <<03708>>42240000
TO ITS INTERNAL BAUD RATE CODE AND VICE-VERSA.                 <<03708>>42242000
IF 'TSPEED' IS NEGATIVE, WE CONVERT 'SPEEDCDE' TO              <<03708>>42244000
CHARS/SEC, RETURNING THE RESULT IN 'TSPEED'.  IF               <<03708>>42246000
'TSPEED' IS POSITIVE, WE CONVERT IT TO THE BAUDRATE            <<03708>>42248000
CODE, RETURNING THE RESULT IN 'SPEEDCDE'.  IN EITHER           <<03708>>42250000
CASE, THE PROCEDURE RETURNS TRUE IF THE CONVERSION WAS         <<03708>>42252000
VALID, FALSE OTHERWISE.                                        <<03708>>42254000
;                                                              <<03708>>42256000
BEGIN                                                          <<03708>>42258000
EQUATE                                                         <<03708>>42260000
   UNUSED  = 32000;    << INDICATES UNUSED SPEED CODE >>       <<03708>>42262000
EQUATE                                                         <<03708>>42264000
   START'III = 0,    << STARTING ARRAY INDEX >>                <<03708>>42266000
   HIGH'III  = 7;    << ENDING ARRAY INDEX   >>                <<03708>>42268000
INTEGER ARRAY                        << ALLOWED SPEEDS FOR >>  <<03708>>42270000
   SPEEDS'III(START'III:HIGH'III) = PB :=                      <<03708>>42272000
   0,240,120,60,30,15,10,14;         << ATC IN CHARS/SEC   >>  <<03708>>42274000
EQUATE                                                         <<03708>>42276000
   START'33 = 6,    << STARTING ARRAY INDEX >>                 <<03708>>42278000
   HIGH'33  = 18;   << ENDING ARRAY INDEX FOR ATP >>           <<03708>>42280000
INTEGER ARRAY                       << ALLOWED SPEEDS FOR  >>  <<03708>>42282000
   SPEEDS'33(START'33:HIGH'33) = PB :=                         <<03708>>42284000
   60,240,960,480,UNUSED,120,       << ADCC, ATP.   (CODES >>  <<03708>>42286000
   UNUSED,30,15,10,1920,3840,180;   << 10,12 ARE NOT USED) >>  <<03708>>42288000
INTEGER                                                        <<03708>>42290000
   I,             << INDEX VAR. >>                             <<03708>>42292000
   STARTSPEED,    << INDEX OF FIRST SPEED >>                   <<03708>>42294000
   HIGHSPEED;     << INDEX OF LAST SPEED  >>                   <<03708>>42296000
INTEGER ARRAY                                                  <<03708>>42298000
   SPEEDS(0:HIGH'33);     << LOCAL ARRAY FOR SPEEDS >>         <<03708>>42300000
                                                               <<03708>>42302000
CHECKSPEED := FALSE;                                           <<03708>>42304000
                                                               <<03708>>42306000
IF SERIESII'III THEN                                           <<03708>>42308000
   BEGIN              << SET UP PARAMETERS FOR ATC SPEEDS >>   <<03708>>42310000
   STARTSPEED := START'III;                                    <<03708>>42312000
   HIGHSPEED := HIGH'III;                                      <<03708>>42314000
   MOVE SPEEDS(START'III) :=                                   <<03708>>42316000
        SPEEDS'III(START'III),(HIGH'III - START'III + 1);      <<03708>>42318000
   END                                                         <<03708>>42320000
                                                               <<03708>>42322000
ELSE                                                           <<03708>>42324000
   BEGIN         << SET UP PARAMETERS FOR ADCC, ATP SPEEDS >>  <<03708>>42326000
   STARTSPEED := START'33;                                     <<03708>>42328000
   HIGHSPEED := HIGH'33;                                       <<03708>>42330000
   MOVE SPEEDS(START'33) :=                                    <<03708>>42332000
        SPEEDS'33(START'33),(HIGH'33 - START'33 + 1);          <<03708>>42334000
   END;                                                        <<03708>>42336000
                                                               <<03708>>42338000
IF TSPEED < 0 THEN                                             <<03708>>42340000
   BEGIN   << CONVERT FROM BAUDRATE CODE TO CHARS/SEC >>       <<03708>>42342000
   IF STARTSPEED <= SPEEDCDE <= HIGHSPEED THEN                 <<03708>>42344000
      BEGIN                                                    <<03708>>42346000
      TSPEED := SPEEDS(SPEEDCDE);                              <<03708>>42348000
      IF TSPEED < UNUSED THEN                                  <<03708>>42350000
         CHECKSPEED := TRUE;                                   <<03708>>42352000
      END;                                                     <<03708>>42354000
   END                                                         <<03708>>42356000
                                                               <<03708>>42358000
ELSE                                                           <<03708>>42360000
   BEGIN   << CONVERT FROM CHARS/SEC TO BAUDRATE CODE >>       <<03708>>42362000
   I := STARTSPEED - 1;                                        <<03708>>42364000
   WHILE (I:=I+1) <= HIGHSPEED DO    << COMPARE AGAINST >>     <<03708>>42366000
      IF SPEEDS(I) = TSPEED THEN     <<    ALL SPEEDS   >>     <<03708>>42368000
         BEGIN      << VALID SPEED >>                          <<03708>>42370000
         SPEEDCDE  := I;                                       <<03708>>42372000
         CHECKSPEED := TRUE;                                   <<03708>>42374000
         END;                                                  <<03708>>42376000
   END;                                                        <<03708>>42378000
END;   << CHECKSPEED >>                                        <<03708>>42380000
$CONTROL SEGMENT=MAINSEG1                                               42382000
          <<--------------------------------                            42384000
            GET ID AND COMPONENT SEQUENCES                              42386000
          -------------------------------->>                            42388000
                                                                        42390000
  INTEGER PROCEDURE GETSEQ(ERRLABEL,ADDR);                              42392000
    VALUE ERRLABEL;                                                     42394000
    INTEGER ERRLABEL;                                                   42396000
    BYTE ARRAY ADDR;                                                    42398000
      <<GETSEQ                                               >>         42400000
      <<                                                     >>         42402000
      BEGIN                                                             42404000
        INTEGER TYPE,LEN,I,J,INDEX;                                     42406000
        LOGICAL TEMP,FINISHED;                                          42408000
        EQUATE QUOT=%42,<<">>                                           42410000
               CR  =%15,<<CARRIAGE RETURN>>                             42412000
               MAXSEQLEN=16,<<MAX LENGTH IN BYTES>>                     42414000
               ATYP=0,  <<INPUT TYPE ASCII >>                           42416000
               ETYP=1,  <<INPUT TYPE EBCDIC>>                           42418000
               OTYP=2,  <<INPUT TYPE OCTAL >>                           42420000
               HTYP=3;  <<INPUT TYPE HEX   >>                           42422000
        BYTE POINTER PNTR;                                              42424000
          SCAN BPINBUF WHILE BLANK,1;                                   42426000
          IF CARRY THEN RETURN; <<NO INPUT>>                            42428000
          IF BPS0="A" OR BPS0=QUOT THEN TYPE:=ATYP                      42430000
          ELSE IF BPS0="E" THEN TYPE:=ETYP                              42432000
               ELSE IF BPS0="O" THEN TYPE:=OTYP                         42434000
                    ELSE IF BPS0="H" THEN TYPE:=HTYP                    42436000
                         ELSE BEGIN                                     42438000
  ERROR:                      MESSAGE(M2453);                  <<01103>>42440000
                              RETURNP := ERRLABEL;                      42442000
                              ASSEMBLE(EXIT 3);                         42444000
                              END;                                      42446000
          IF TYPE=ATYP OR TYPE=ETYP THEN                                42448000
            BEGIN  <<STRING ASCII OR EBCDIC>>                           42450000
            IF BPS0="A" OR BPS0="E" THEN TOS:=TOS+1;                    42452000
            IF BPS0<>QUOT THEN GOTO ERROR;                              42454000
            @PNTR := TOS+1;  <<POINT TO FIRST CHARACTER>>               42456000
            LEN := -1;  <<INDEX TO ADR(ALSO COUNTER>>                   42458000
  GETCHAR:  FINISHED := FALSE;                                          42460000
            WHILE NOT FINISHED DO                                       42462000
              BEGIN <<GET A CHARACTER>>                                 42464000
              IF PNTR=CR THEN GOTO ERROR;                               42466000
              IF PNTR=QUOT THEN FINISHED:=TRUE;                         42468000
              LEN := LEN+1;                                             42470000
              ADDR(LEN) := PNTR;                                        42472000
              @PNTR := @PNTR+1;                                         42474000
              END;                                                      42476000
            IF LEN>MAXSEQLEN THEN GOTO ERROR;                           42478000
            IF PNTR=QUOT THEN                                           42480000
              BEGIN <<DOUBLE QUOTES>>                                   42482000
              @PNTR := @PNTR+1; <<A QUOT IS IN SEQUENCE>>               42484000
              GOTO GETCHAR;                                             42486000
              END;                                                      42488000
            SCAN PNTR WHILE BLANK;                                      42490000
            IF NOCARRY THEN GOTO ERROR;                                 42492000
            I := -1;                                                    42494000
            WHILE(I:=I+1)<LEN DO                                        42496000
              IF NOT(%40<=INTEGER(ADDR(I))<=%176) THEN                  42498000
                  TYPE := OTYP;                                         42500000
            IF TYPE=ETYP THEN CONVERT(1,ADDR,ADDR,LEN);                 42502000
            END                                                         42504000
          ELSE                                                          42506000
            BEGIN  <<OCTAL OR HEX>>                                     42508000
            FINISHED := FALSE;                                          42510000
            TOS := TOS+1;                                               42512000
            IF BPS0<>"(" THEN GOTO ERROR;                               42514000
            TOS := TOS+1;                                               42516000
            LEN := 0;                                                   42518000
  NEXTNUM:  SCAN * WHILE BLANK,1;<<FIND FIRST DIGIT>>                   42520000
            IF CARRY THEN GOTO ERROR;                                   42522000
            IF BPS0=SPECIAL THEN GOTO ERROR;                            42524000
            ASSEMBLE(DUP,DDUP);                                         42526000
            MOVE *:=* WHILE AN,0;                                       42528000
            SCAN * WHILE BLANK,1;                                       42530000
            IF BPS0<>"," THEN FINISHED:=TRUE;                           42532000
            TEMP := TOS+1;                                              42534000
            ASSEMBLE(XCH,SUB);<<COMPUTE LENGTH>>                        42536000
            IF TYPE=OTYP AND S0>3 OR TYPE=HTYP AND S0>2                 42538000
               THEN GOTO ERROR; <<TOO MANY DIGITS>>                     42540000
            J := TOS;   <<# OF DIGITS>>                                 42542000
            @PNTR := TOS;<<START FIRST DIGIT IN THIS NUM>>              42544000
            IF TYPE=OTYP THEN                                           42546000
              BEGIN <<OCTAL>>                                           42548000
              I := -1;                                                  42550000
              WHILE(I:=I+1)<J DO                                        42552000
                IF PNTR(I)>%67 THEN GOTO ERROR;<<NOT OCTAL>>            42554000
              ADDR(LEN) := BINARY(PNTR,J);                              42556000
              END                                                       42558000
            ELSE                                                        42560000
              BEGIN <<HEX>>                                             42562000
              I := J;                                                   42564000
              WHILE(I:=I-1)>=0 DO                                       42566000
                BEGIN                                                   42568000
                X := PNTR(I);                                           42570000
                IF ("0"<=X<="9") THEN TOS:=X-%60                        42572000
                ELSE IF ("A"<=X<="F") THEN TOS:=X-%67                   42574000
                     ELSE GOTO ERROR;                                   42576000
                END;                                                    42578000
              IF J=2 THEN                                               42580000
                BEGIN <<TWO DIGITS IN THIS NUMBER>>                     42582000
                TOS := TOS*%20;                                         42584000
                TOS := TOS+TOS; <<ADD TOP TWO WORDS>>                   42586000
                END;                                                    42588000
              ADDR(LEN):=TOS;                                           42590000
              END;                                                      42592000
            LEN := LEN+1;                                               42594000
            IF NOT FINISHED THEN                                        42596000
              BEGIN                                                     42598000
              TOS := TEMP;                                              42600000
              GOTO NEXTNUM;                                             42602000
              END;                                                      42604000
            IF LEN>MAXSEQLEN THEN GOTO ERROR;                           42606000
            TOS := TEMP-1;                                              42608000
            IF BPS0<>")" THEN GOTO ERROR;                               42610000
            TOS := TOS+1;                                               42612000
            SCAN * WHILE BLANK;                                         42614000
            IF NOCARRY THEN GOTO ERROR;                                 42616000
            END;                                                        42618000
        GETSEQ := TYPE&LSL(6)+LEN;                                      42620000
        END <<GETSEQ>>;                                                 42622000
                                                                        42624000
$CONTROL SEGMENT=CONFIGURE                                              42626000
           <<------------------                                         42628000
             LIST I/O DEVICES                                           42630000
           ------------------>>                                         42632000
  PROCEDURE LISTIODEV;                                                  42634000
    COMMENT                                                             42636000
      PRINTS A LISTING OF THE I/O DEVICE CONFIGURATION ON THE JOB       42638000
    LIST DEVICE;                                                        42640000
      BEGIN                                                             42642000
        INTEGER ARRAY HEAD1(0:34)=PB:=                                  42644000
         "LOG DRT U  C T SUB               REC   OUTPUT ",     <<03004>>42646000
         " MODE   DRIVER   DEVICE ";                                    42648000
        INTEGER ARRAY HEAD2(0:35)=PB:=                                  42650000
         "DEV  #  N  H Y TYPE  TERMINAL    WIDTH  DEV ",       <<03004>>42652000
         "           NAME    CLASSES  ";                                42654000
        INTEGER ARRAY HEAD3(0:15)=PB:=                         <<03004>>42656000
         " #      I  A P      TYPE SPEED  ";                   <<03708>>42658000
        INTEGER ARRAY HEAD4(0:6)=PB:=                          <<00.06>>42660000
         "        T  N E";                                     <<00.06>>42662000
        INTEGER TSPEED,                                        <<03004>>42666000
                SPEEDCDE;                                      <<03004>>42668000
        LOGICAL FIRSTCLASS;                                             42670000
          MOVE LINE := HEAD1,(35);                             <<00888>>42672000
          PRINTLINE;                                           <<00888>>42674000
          MOVE LINE := HEAD2,(35);                             <<00888>>42676000
          PRINTLINE;                                           <<00888>>42678000
          MOVE LINE := HEAD3,(16);                             <<03004>>42680000
          PRINTLINE;                                           <<00888>>42682000
          MOVE LINE := HEAD4,(7);                             <<<00888>>42684000
          PRINTLINE;                                           <<00888>>42686000
          LDEV:=0;                                                      42688000
          WHILE (LDEV:=LDEV+1) <= HLDEV DO                              42690000
           BEGIN                                                        42692000
           DRTN := DVRTAB(LDEV*DVRSIZE);                                42694000
           IF DVRTAB(LDEV*DVRSIZE+1).DSBIT=1 OR                <<03002>>42696000
              DVRTAB(LDEV*DVRSIZE).DRTFIELD <> 0               <<03002>>42698000
           THEN BEGIN                                          <<03002>>42700000
              @DVRENT := @DVRTAB(LDEV*DVRSIZE);                <<03002>>42702000
              @LDTENT := @LDT(LDEV*LDTSIZE);                            42704000
              @LDTXENT := @LDTX(LDEV*LDTXSIZE);                <<00.06>>42706000
              @LPDTENT := @LPDT(LDEV*LPDTSIZE);                         42708000
              ASCII(LDEV,BLINE);    <<LOGICAL DEVICE #>>       <<00888>>42710000
              IF LOGICAL(DVRENT(DVR1).DSBIT) THEN              <<03002>>42712000
                BEGIN <<DS DEVICE>>                                     42714000
                BLINE(3)  := "#";                              <<00888>>42716000
                ASCII(DVRENT(DVR1).DSDRTN,BLINE(4));           <<00888>>42718000
                END                                                     42720000
              ELSE ASCII(DRTN.DRTFIELD,BLINE(4)); <<DRT #>>    <<03002>>42722000
              ASCII(DRTN.UNITFIELD,BLINE(8));  <<UNIT #>>      <<03002>>42724000
              ASCII(DVRENT(DVR1).DVRCHAN,BLINE(11)); <<CHANNEL #>>      42726000
              ASCII(LDTENT(LDT2).TYP,BLINE(13));  <<TYPE>>    <<00888>> 42728000
              ASCII(LPDTENT(LPDT1).SUBTYPE,BLINE(16)); <<SUBTYPE>>      42730000
              I := LPDTENT(LPDT1).SUBTYPE;  << DEV. SUBTYPE >> <<03004>>42732000
              IF LDTENT(LDT2).TYP=TERMDEVTYPE OR               <<03004>>42734000
                 LDTENT(LDT2).TYP=32 AND                       <<03004>>42736000
                 ( I=14 OR I=15) THEN                          <<03004>>42738000
                BEGIN <<TERMINAL>>                             <<00.06>>42740000
                IF LDTENT(LDT4).TERMTYP=%37 THEN               <<00.06>>42742000
                  MOVE BLINE(21) := "??"                       <<03708>>42744000
                ELSE ASCII(LDTENT(LDT4).TERMTYP,BLINE(21));    <<03708>>42746000
                SPEEDCDE := LDTXENT.TERMSPEED; <<SPEED CODE>>  <<03004>>42748000
                TSPEED := -1; <<SET PARAMETER FOR CHECKSPEED>> <<03004>>42750000
                CHECKSPEED( TSPEED,SPEEDCDE); <<CONVERT SPEED>><<03004>>42752000
                IF SPEEDCDE = 0 THEN MOVE BLINE(26) := "??"    <<03708>>42754000
                ELSE ASCII(TSPEED,BLINE(26));                  <<03708>>42756000
                                                               <<03004>>42758000
                END;                                           <<00.06>>42764000
              ASCII(LDTENT(LDT2).RECW,BLINE(33)); <<RECORD WIDTH>>      42766000
              IF LOGICAL(LDTENT(LDT3).OUTCL) THEN                       42768000
                BEGIN    <<OUTPUT DEVICE IS CLASS INDEX>>               42770000
                  TOS := LDTENT(LDT3).OUTDEV;                           42772000
                  IF = THEN DEL                                         42774000
                  ELSE CLNAME(*,BLINE(38));                    <<00888>>42776000
                END                                                     42778000
              ELSE ASCII(LDTENT(LDT3).OUTDEV,BLINE(40));       <<00888>>42780000
              IF LOGICAL(LDTXENT.LDTX'SA) THEN BLINE(46):="E"; <<01853>>42782000
              IF LOGICAL(LPDTENT(LPDT1).AJOBS) THEN BLINE(47):="J";     42784000
                      <<ACCEPT JOBS/SESSIONS>>                          42786000
              IF LOGICAL(LPDTENT(LPDT1).ADATA) THEN BLINE(48):="A";     42788000
                          <<ACCEPT DATA>>                               42790000
              IF LOGICAL(LPDTENT(LPDT1).INTRACT) THEN BLINE(49):="I";   42792000
                                      <<INTERACTIVE>>                   42794000
              IF LOGICAL(LPDTENT(LPDT1).DUPLIC) THEN BLINE(50):="D";    42796000
                                      <<DUPLICATIVE>>                   42798000
              IF LDTENT(LDT3).SPOOLST<>0 THEN BLINE(51) := "S";         42800000
              IF LOGICAL(DVRENT(DVR1).CRBIT) THEN BLINE(53):="*";       42802000
                                      <<CORE RESIDENT DRIVER>>          42804000
              TOS := @BLINE(54);                               <<00888>>42806000
              TOS := @DVRENT(DVR2)&LSL(1);                     <<04306>>42808000
              MOVE * := *,(8);  <<DRIVER NAME>>                         42810000
              FIRSTCLASS := TRUE;                                       42812000
              I := 0;                                                   42814000
              INDEX := 10;                                              42816000
              WHILE (I:=I+1) <= LDT(DCNUM) DO                           42818000
                BEGIN   <<SCAN DEVICE CLASSES>>                         42820000
                  J := 0;                                               42822000
                  WHILE (J:=J+1) <= INTEGER(DVCLTAB(INDEX)) DO          42824000
                  IF INTEGER(DVCLTAB(INDEX+J)) = LDEV THEN              42826000
                    BEGIN    <<DEVICE IS IN THIS CLASS>>                42828000
                      IF FIRSTCLASS THEN FIRSTCLASS := FALSE            42830000
                      ELSE                                              42832000
                          PRINTLINE;                           <<00888>>42834000
                      MOVE BLINE(63) := DVCLTAB(INDEX-10),(8);          42836000
                                         <<MOVE DEVICE CLASS TO BUFFER>>42838000
                    END;                                                42840000
                  TOS := DVCLTAB(INDEX);                                42842000
                  ASSEMBLE(DUP,NOT);                                    42844000
                  IF TOS THEN TOS := TOS+1;                             42846000
                  INDEX := TOS+INDEX+11;                                42848000
                END;                                                    42850000
              PRINTLINE;                                       <<00888>>42852000
            END;                                                        42854000
           END;                                                         42856000
      END <<LISTIODEV>> ;                                               42858000
   <<--------------                                                     42860000
     LIST CLASSES                                                       42862000
   -------------->>                                                     42864000
   PROCEDURE LISTCLASSES;                                               42866000
   <<LISTS DEVICE CLASSES FOLLOWED CLASS TYPE AND LOGICAL DEV. #'S>>    42868000
     BEGIN                                                              42870000
       EQUATE SDISC = 31; <<CLASS ACCESS TYPE FOR SERIAL DISC>><<SD.00>>42872000
      EQUATE FDISC = 7;  <<CLASS ACCESS TYPE FOR >>            <<01115>>42874000
                         <<FOREIGN DISCS>>                     <<01115>>42876000
       INTEGER ARRAY HED1(0:13)=PB:=                                    42878000
           "  CLASS     ACCESS  LOGICAL ";                              42880000
       INTEGER ARRAY HED2(0:13)=PB:=                                    42882000
           "  NAME      TYPE    DEVICES ";                              42884000
       INTEGER INDEX:=10,BINDX:=20;                                     42886000
          MOVE LINE := HED1,(14);                              <<00888>>42888000
          PRINTLINE;                                           <<00888>>42890000
          MOVE LINE := HED2,(14);                              <<00888>>42892000
          PRINTLINE;                                           <<00888>>42894000
          I := -1;                                                      42896000
          WHILE (I:=I+1)<LDT(DCNUM) DO                                  42898000
            BEGIN                                                       42900000
            MOVE BLINE:= DVCLTAB(INDEX-10),(8);                <<00888>>42902000
            TOS := DVCLTAB(INDEX-1);<<CLASS ACCESS TYPE & TERMACC BIT>> 42904000
            DUPLICATE;                                                  42906000
            TOS := TOS LAND 7;                                          42908000
            IF TOS<>0 THEN                                              42910000
              BEGIN                                                     42912000
              IF S0=SDISC THEN                                 <<SD.00>>42914000
                 BEGIN                                         <<SD.00>>42916000
                 DEL;                                          <<SD.00>>42918000
                 MOVE BLINE(12):="SD";                         <<00888>>42920000
                 END                                           <<SD.00>>42922000
              ELSE                                             <<01115>>42924000
              IF S0=FDISC THEN                                 <<01115>>42926000
                 BEGIN                                         <<01115>>42928000
                 DEL;                                          <<01115>>42930000
                 MOVE BLINE(12):="FD";                         <<01115>>42932000
                 END                                           <<01115>>42934000
              ELSE                                             <<SD.00>>42936000
                 BEGIN                                         <<SD.00>>42938000
                 ASSEMBLE(ZERO,XCH);                           <<SD.00>>42940000
                 ASCII(*,BLINE(12));                           <<00888>>42942000
                 END;                                          <<SD.00>>42944000
              END                                                       42946000
            ELSE                                                        42948000
              BEGIN                                                     42950000
              TOS := (TOS LAND %77)&LSR(3);<<CLEAR TERMACC BIT>>        42952000
              CASE TOS OF                                               42954000
                BEGIN                                                   42956000
                MOVE BLINE(12):="DA";                          <<00888>>42958000
                MOVE BLINE(12):="IN";                          <<00888>>42960000
                MOVE BLINE(12):="I/O,C";                       <<00888>>42962000
                MOVE BLINE(12):="I/O,NC";                      <<00888>>42964000
                MOVE BLINE(12):="OUT";                         <<00888>>42966000
                END;                                                    42968000
              END;                                                      42970000
            IF (N:=(INTEGER(DVCLTAB(INDEX))))<>0 THEN                   42972000
              BEGIN                                                     42974000
              K := 0;                                                   42976000
              WHILE (K:=K+1)<=N DO                                      42978000
                BEGIN                                                   42980000
                LDEV := INTEGER(DVCLTAB(INDEX+K));                      42982000
                IF (LDEV>99) AND (BINDX>69) OR                          42984000
                   (LDEV>9) AND (BINDX>70) OR (BINDX>71)                42986000
                THEN                                                    42988000
                  BEGIN <<WON'T FIT ON THIS LINE>>                      42990000
                  PRINTLINE;                                   <<00888>>42992000
                  BINDX := 20;                                          42994000
                  END;                                                  42996000
                M := ASCII(LDEV,BLINE(BINDX));                 <<00888>>42998000
                BINDX := BINDX + M;                                     43000000
                IF K<N THEN                                             43002000
                  BEGIN                                                 43004000
                  BLINE(BINDX) := ",";                         <<00888>>43006000
                  BINDX :=BINDX+1;                                      43008000
                  END;                                                  43010000
                END;                                                    43012000
              PRINTLINE;                                       <<00888>>43014000
              END;                                                      43016000
            TOS := N;                                                   43018000
            ASSEMBLE(DUP,NOT);                                          43020000
            IF TOS THEN TOS:=TOS+1;                                     43022000
            INDEX := TOS+INDEX+11;                                      43024000
            BINDX := 20;                                                43026000
            END;                                                        43028000
     END  <<LISTCLASSES>>;                                              43030000
                                                                        43032000
  PROCEDURE PUTINTEMPCLASS(LDEV);                              <<00.03>>43034000
  VALUE LDEV;                                                  <<00.03>>43036000
  INTEGER LDEV;                                                <<00.03>>43038000
  OPTION FORWARD;                                              <<00.03>>43040000
                                                               <<00.03>>43042000
          <<--------------------------------                            43044000
            REMOVE DEVICE CLASS REFERENCES                              43046000
          -------------------------------->>                            43048000
  PROCEDURE REMOVECLASSREFS;                                            43050000
    COMMENT                                                             43052000
      REMOVE REFERENCES TO LOGICAL DEVICE LDEV FROM DEVICE CLASS TABLE; 43054000
      BEGIN                                                             43056000
        INTEGER INDEX:=10,           <<DEVICE CLASS TABLE INDEX>>       43058000
                I:=0,                <<DEVICE CLASS NUMBER>>            43060000
                J,                   <<INDEX WITHIN CLASS>>             43062000
                K,                   <<LOGICAL DEVICE NUMBER INDEX>>    43064000
                N;                   <<NUMBER OF DEVICES IN CLASS>>     43066000
          WHILE(I:=I+1) <= LDT(DCNUM) DO                                43068000
            BEGIN                                                       43070000
              J := 0;                                                   43072000
              WHILE (J:=J+1) <= (N:=INTEGER(DVCLTAB(INDEX))) DO         43074000
              IF INTEGER(DVCLTAB(INDEX+J))=LDEV THEN                    43076000
                BEGIN   <<IN THIS CLASS>>                               43078000
                  IF N=1 THEN                                           43080000
                    BEGIN  <<CLASS MUST BE REMOVED>>                    43082000
                      MOVE DEVCLASS:=DVCLTAB(INDEX-10),(8);    <<00.03>>43084000
                      TOS := @DVCLTAB(INDEX-10);                        43086000
                      TOS := S0+12;                                     43088000
                      ASSEMBLE(DUP,NEG);                                43090000
                      TOS := TOS+@DVCLTAB(DVCLSIZE);<<# BYTES TO MOVE>> 43092000
                      ASSEMBLE(MVB 3);  <<MOVE REST OF TABLE>>          43094000
                      DVCLTABINCR := DVCLTABINCR-6; <<6 WORDS SHORTER>> 43096000
                      DVCLSIZE := DVCLSIZE-12;                          43098000
                      LDT(X) := LDT(DCNUM)-1; <<# DEVICES>>             43100000
                      K := 0;                                           43102000
                      WHILE (K:=K+1)<=HLDEV DO <<SEARCH LDT FOR CLASS>> 43104000
                      IF LOGICAL(LDT((M:=K*LDTSIZE)+LDT3).OUTCL) THEN   43106000
                        BEGIN <<OUTPUT DEVICE IS CLASS>>                43108000
                          TOS := LDT(M+LDT3).OUTDEV;  <<INDEX>>         43110000
                          IF S0=I THEN                         <<00.03>>43112000
                            BEGIN <<OUTPT DEV IS DELETD CLAS>> <<00.03>>43114000
                            LDT(M+LDT3).OUTDEV := 0;           <<00.03>>43116000
                            PUTINTEMPCLASS(K);                 <<00.03>>43118000
                            END                                <<00.03>>43120000
                          ELSE IF S0>I THEN LDT(M+LDT3).OUTDEV := S0-1; 43122000
                          DEL;                                          43124000
                        END;                                            43126000
                      I := I-1;  <<ONE LESS CLASS>>                     43128000
                      GOTO NEXTCL;                                      43130000
                    END;                                                43132000
                <<REMOVE LDEV FROM CLASS>>                              43134000
                  TOS := @DVCLTAB(X);                                   43136000
                  DVCLTAB(INDEX-2) := 1;   <<RESET CYCLICAL PTR>>       43138000
                  ASSEMBLE(DUP,INCA);                                   43140000
                  TOS := N-J;                                           43142000
                  ASSEMBLE(MVB 2);  <<MOVE REST OF THIS CLASS>>         43144000
                  IF LOGICAL(N) THEN BPS0 := 0  <<FILLER BYTE>>         43146000
                  ELSE                                                  43148000
                    BEGIN                                               43150000
                      TOS := @DVCLTAB(INDEX+N);                         43152000
                      ASSEMBLE(DUP,INCA; INCA,DUP; NEG);                43154000
                      TOS := TOS+@DVCLTAB(DVCLSIZE);                    43156000
                      ASSEMBLE(MVB 3);    <<MOVE  REST OF TABLE>>       43158000
                      DVCLSIZE := DVCLSIZE-2;  <<2 LESS BYTES>>         43160000
                      DVCLTABINCR := DVCLTABINCR-1;                     43162000
                    END;                                                43164000
                  DEL;                                                  43166000
                  DVCLTAB(X) := INTEGER(DVCLTAB(INDEX))-1;              43168000
                  J := J-1;                                             43170000
                END;                                                    43172000
              TOS := N;     <<UPDATE TABLE POINTER>>                    43174000
              ASSEMBLE(DUP,NOT);                                        43176000
              IF TOS THEN TOS:=TOS+1;                                   43178000
              INDEX := TOS+INDEX+11;                                    43180000
  NEXTCL:   END;                                                        43182000
          IF DVCLTABINCR<>0 THEN MOVEDLTABLES; <<COMPACT TABLES>>       43184000
      END <<REMOVECLASSREFS>> ;                                         43186000
             <<----------------------                          <C0.00   43188000
               PUT IN TEMPORARY CLASS                                   43190000
               --------------------->>                                  43192000
   PROCEDURE PUTINTEMPCLASS(LDEV);                             <<00.03>>43194000
        VALUE LDEV;                                            <<00.03>>43196000
        INTEGER LDEV;                                          <<00.03>>43198000
     BEGIN                                                              43200000
     COMMENT                                                            43202000
       TEMPCLASS CONTAINS,IN BYTE ZERO, THE NUMBER OF UNDEFINED         43204000
       CLASSES USED AS OUTPUT DEVICES AND,IN BYTES 2+3,THE SIZE         43206000
       OF TEMPCLASS(IN BYTES). THE REMAINDER OF TEMPCLASS IS            43208000
       SIMILAR TO DVCLTAB EXCEPT THE CYCLICAL POINTER AND THE           43210000
       ACCESS TYPE ARE NOT INCLUDED IN TEMPCLASS. THE NAME IS           43212000
       FOLLOWED BY THE NUMBER OF DEVICES AND THE DEVICE #'S             43214000
       THAT REQUIRE THIS CLASS AS  OUTPUT DEVICE;                       43216000
        INTEGER INDEX:=12,I:=0;                                         43218000
          WHILE (I:=I+1)<=TCLASS DO                                     43220000
            BEGIN                                                       43222000
            IF TEMPCLASS(INDEX-8)=DEVCLASS,(8),2 THEN GO ENTEXST;       43224000
            TOS := TEMPCLASS(INDEX);                                    43226000
            ASSEMBLE(DELB,DUP;NOT);                                     43228000
            IF TOS THEN TOS:=TOS+1;                                     43230000
            INDEX := TOS+INDEX+9;                                       43232000
            END;                                                        43234000
          MOVE TEMPCLASS(INDEX-8):=DEVCLASS,(8);                        43236000
          TEMPCLASS(INDEX):=1;                                          43238000
          TEMPCLASS(X:=X+1):=LDEV;                                      43240000
          TCLASS := TCLASS + 1;                                         43242000
          TCLASS(X) := TCLASS(1) + 10;                                  43244000
          RETURN;                                                       43246000
   ENTEXST:                                                             43248000
          I := 0;                                                       43250000
          IF LOGICAL(N:=BPS0) THEN                                      43252000
            BEGIN    <<MUST MAKE ROOM FOR NEW ENTRY>>                   43254000
            TOS := @TEMPCLASS(TCLASS(1)-1);<<LAST BYTE>>                43256000
            ASSEMBLE(DUP,INCB,INCB,DUP;NEG);                            43258000
            TOS := TOS + @TEMPCLASS(INDEX+N);                           43260000
            ASSEMBLE(MVB 2);                                            43262000
            BPS0 := 0;  <<FILLER BYTE>>                                 43264000
            TOS := TOS - 1;                                             43266000
            TCLASS(X) := TCLASS(1) + 2;                                 43268000
            END                                                         43270000
          ELSE TOS := S0+N+1;                                           43272000
          BPS0 := LDEV;                                                 43274000
          BPS1 := BPS1 + 1;                                             43276000
     END <<PUTINTEMPCLASS>>;                                            43278000
                                                                        43280000
   <<--------------                                                     43282000
     DELETE CLASS                                              <C0.00   43284000
   -------------->>                                                     43286000
   INTEGER PROCEDURE DELETECLASS(ERRLABEL);                             43288000
       VALUE ERRLABEL;                                                  43290000
       INTEGER ERRLABEL;                                                43292000
       BEGIN                                                            43294000
        INTEGER ARRAY ERR(0:13);                                        43296000
        BYTE ARRAY BERR(*)=ERR;                                         43298000
        INTEGER INDEX:=10,I:=0;                                         43300000
        WHILE (I:=I+1)<=LDT(DCNUM)  DO                                  43302000
          IF DVCLTAB(INDEX-10)=DEVCLASS,(8) THEN                        43304000
            BEGIN <<FOUND IT>>                                          43306000
            DELETECLASS := I;                                           43308000
            GO PURGECL;                                                 43310000
            END                                                         43312000
          ELSE                                                          43314000
            BEGIN <<BUMP INDEX>>                                        43316000
            TOS := DVCLTAB(INDEX);                                      43318000
            ASSEMBLE(DUP,NOT);                                          43320000
            IF TOS THEN TOS:=TOS+1;                                     43322000
            INDEX := TOS+INDEX+11;                                      43324000
            END;                                                        43326000
        MOVE BERR := "CLASS ",2;                                        43328000
        MOVE * := DEVCLASS,(8),2;                                       43330000
        MOVE * := " DOESN'T EXIST";                                     43332000
        PRINT(ERR,-28,0);                                               43334000
        RETURNP := ERRLABEL;                                            43336000
        ASSEMBLE(EXIT 2); <<DELETE DELETECLASS'S VALUE>>                43338000
   PURGECL:                                                             43340000
        TOS := @DVCLTAB(INDEX-10);                                      43342000
        DUPLICATE;                                                      43344000
        TOS := DVCLTAB(INDEX);                                          43346000
        ASSEMBLE(DUP,NOT);                                              43348000
        IF TOS THEN TOS := TOS+1;                                       43350000
        I:= S0;                                                         43352000
        TOS :=TOS+TOS+11;                                               43354000
        DUPLICATE;                                                      43356000
        TOS := -TOS+@DVCLTAB+DVCLSIZE;                                  43358000
        ASSEMBLE(MVB 3);                                                43360000
        LDT(X) := LDT(DCNUM)-1;                                         43362000
        DVCLSIZE := DVCLSIZE-I-11;                                      43364000
          DVCLTABINCR := -(I+2)&LSR(1)-5;                               43366000
          MOVEDLTABLES;                                                 43368000
        END <<DELETECLASS>>;                                            43370000
                                                                        43372000
   <<--------------------                                               43374000
     DETERMINE CLASS TYPE                                      <C0.00   43376000
   -------------------->>                                               43378000
                                                                        43380000
   PROCEDURE DETERMCTYP(ERRLABEL,INDEX,ASKIO);                 <<03611>>43382000
     VALUE ERRLABEL,INDEX,ASKIO;                               <<03611>>43384000
     LOGICAL ASKIO;                                            <<03611>>43386000
     INTEGER INDEX,ERRLABEL;                                            43388000
        BEGIN                                                           43392000
        <<THIS PROCEDURE DETERMINES THE TYPE OF THE CLASS >>            43394000
        <<TO WHIC INDEX POINTS TO IN DVCLTAB.  INDEX POINTS>>           43396000
        <<PASS THE CLASS NAME TO THE # OF DEVICES IN THE CLASS>>        43398000
        SWITCH SW:=CER,DAC,SIP,CER,CIO,CER,SIP,CER,NCIO,CER,SIP,        43400000
                   CER,NCIO,CER,SIP,CER,SOU,CER,CER,CER,SOU,CER,        43402000
                   CER,CER,SOU,CER,CER,CER,SOU,CER,CER,CER,CER;         43404000
        LOGICAL ALLSAME:=TRUE;                                          43406000
        LOGICAL ALL'SAME'RANGE:= TRUE;                         <<03611>>43408000
        LOGICAL CANBESERIAL := TRUE;                           <<03550>>43410000
        INTEGER I,J,L,N,TEMP,DTYP,DRANGE,TYPE,SUBTYP,          <<03611>>43412000
                CURRENT'CLASS'ACCESS'TYPE;                     <<03611>>43414000
        BYTE ARRAY MESSAGE'BUFFER(0:8);                        <<03611>>43416000
          EQUATE SDISC=31, FDISC=7;                            <<01115>>43418000
          N := DVCLTAB(INDEX);                                          43420000
          I := 0;                                                       43422000
          TEMP := 0;                                                    43424000
          CURRENT'CLASS'ACCESS'TYPE:= DVCLTAB(INDEX-1);        <<03611>>43426000
          DTYP :=LDT(DVCLTAB(INDEX+1)*LDTSIZE+LDT2).TYP;                43428000
          DRANGE :=LDT(DVCLTAB(INDEX+1)*LDTSIZE+LDT2).RANGE;   <<03611>>43430000
          WHILE (I:=I+1)<=N DO                                          43432000
            BEGIN                                                       43434000
            L := DVCLTAB(INDEX+I);   << LDEV >>                <<03550>>43436000
            TYPE := LDT(L*LDTSIZE+LDT2).TYP;                   <<03550>>43438000
            SUBTYP := LPDT(L*LPDTSIZE+LPDT1).SUBTYPE;          <<03550>>43440000
            IF DTYP <> TYPE THEN ALLSAME := FALSE;             <<03550>>43442000
            J := LDT(L*LDTSIZE+LDT2).RANGE;   << TYPE RANGE >> <<03550>>43444000
            IF DRANGE<>J THEN ALL'SAME'RANGE:= FALSE;          <<03611>>43446000
            CASE J OF                                                   43448000
             BEGIN                                             <<03550>>43450000
             BEGIN                                             <<03550>>43452000
             TEMP.DIRACC:=1;                                            43454000
             IF NOT SDISC'TYPE(TYPE,SUBTYP) THEN               <<03550>>43456000
                CANBESERIAL := FALSE;                          <<03550>>43458000
             END;                                              <<03550>>43460000
             TEMP.SERINP:=1;                                            43462000
             TEMP.CONIO :=1;                                            43464000
             TEMP.NCONIO:=1;                                            43466000
             TEMP.SEROUT:=1;                                            43468000
             END;                                                       43470000
            END;                                                        43472000
          GO SW(TEMP);                                                  43474000
   DAC:   IF CURRENT'CLASS'ACCESS'TYPE<>SDISC AND              <<03611>>43476000
             CURRENT'CLASS'ACCESS'TYPE<>FDISC THEN             <<03611>>43478000
          IF ALLSAME THEN DVCLTAB(INDEX-1):= DTYP              <<03611>>43480000
          ELSE DVCLTAB(INDEX-1):=DIRACCESS&LSL(3);                      43482000
          IF CANBESERIAL AND ASKIO THEN                        <<03611>>43486000
             IF LGETYESNO(M2327) THEN  <<SERIAL DISC CLASS?>>  <<03550>>43488000
                DVCLTAB(INDEX-1) := SDISC                      <<03550>>43490000
             ELSE IF LGETYESNO(M2334) THEN   <<FOREIGN DISC >> <<03550>>43492000
                DVCLTAB(INDEX-1) := FDISC;   << CLASS?      >> <<03550>>43494000
          RETURN;                                              <<03550>>43496000
   SIP:   IF ALLSAME THEN DVCLTAB(INDEX-1):=DTYP                        43498000
          ELSE IF ALL'SAME'RANGE OR ASKIO THEN                 <<03611>>43500000
                 DVCLTAB(INDEX-1):=SERINPUT&LSL(3);            <<03611>>43502000
          RETURN;                                                       43504000
   CIO:   IF ASKIO THEN                                        <<03611>>43506000
            BEGIN                                              <<03611>>43508000
            DVCLTAB(INDEX-1):= CONINOUT&LSL(3);                <<03611>>43510000
            GO PROMPT;                                         <<03611>>43512000
            END;                                               <<03611>>43514000
          IF CURRENT'CLASS'ACCESS'TYPE.(13:3)<>0 THEN          <<03611>>43516000
            DVCLTAB(INDEX-1):=CONINOUT&LSL(3);                 <<03611>>43518000
          RETURN;                                              <<03611>>43520000
   NCIO:  DVCLTAB(INDEX-1):= NCONINOUT&LSL(3);                 <<03611>>43522000
          IF ASKIO THEN GO PROMPT ELSE RETURN;                 <<03611>>43524000
   SOU:   IF ALLSAME THEN DVCLTAB(INDEX-1):=DTYP                        43528000
          ELSE IF ALL'SAME'RANGE OR ASKIO THEN                 <<03611>>43530000
                 DVCLTAB(INDEX-1):=SEROUTPUT&LSL(3);           <<03611>>43532000
          RETURN;                                                       43534000
   CER:   IF ALLSAME THEN                                      <<00888>>43536000
             DVCLTAB(INDEX-1):=DTYP                            <<03706>>43538000
          ELSE IF ASKIO THEN                                   <<03611>>43540000
             BEGIN                                             <<00888>>43542000
             MESSAGE'BUFFER(0):= " ";                          <<03611>>43544000
             MOVE MESSAGE'BUFFER(1):= MESSAGE'BUFFER,(9);      <<03611>>43546000
             MESSAGE'BUFFER:=                                  <<03611>>43548000
                 MOVEAN(MESSAGE'BUFFER(1),DEVCLASS,8);         <<03611>>43550000
             MESSAGE(M123,,,,,MESSAGE'BUFFER);                 <<03611>>43552000
             RETURNP := ERRLABEL;                              <<00888>>43554000
             END;                                              <<00888>>43556000
          RETURN;                                                       43558000
   PROMPT:MESSAGE(-M2350);                                     <<01103>>43560000
          READINPUT;                                                    43562000
          GETSTR(BTYP,@PROMPT,1,6,"/");                                 43564000
          IF BTYP="IN    " THEN DVCLTAB(X):=SERINPUT&LSL(3)             43566000
          ELSE IF BTYP="OUT   " THEN DVCLTAB(X):=SEROUTPUT&LSL(3)       43568000
               ELSE IF BTYP<>"IN/OUT" AND BTYP<>"IO    " THEN           43570000
                      BEGIN                                             43572000
                      MESSAGE(M2453);                          <<01103>>43574000
                      GO PROMPT;                                        43576000
                      END;                                              43578000
          IF DVCLTAB(X)&LSR(3)=CONINOUT THEN                            43580000
            BEGIN                                                       43582000
   NORNC:   MESSAGE(-M2351);                                   <<01103>>43584000
            READINPUT;                                                  43586000
            GETSTR(BTYP,@NORNC,1,2);                                    43588000
            IF BTYP="NC" THEN DVCLTAB(X):=NCONINOUT&LSL(3)              43590000
            ELSE IF BTYP<>"C " AND BTYP<>"CO" THEN                      43592000
                   BEGIN                                                43594000
                   MESSAGE(M2453);                             <<01103>>43596000
                   GO NORNC;                                            43598000
                   END;                                                 43600000
            END;                                                        43602000
          END  <<DETERMCTYP>>;                                          43604000
$CONTROL SEGMENT=MAINSEG1                                               43606000
                                                                        43608000
          <<--------------------------                                  43610000
            CHECK DEVICE CONSISTENCY                           <C0.00   43612000
          -------------------------->>                                  43614000
  PROCEDURE CHECKDEV(ERRLABEL);                                         43616000
    VALUE ERRLABEL;                                                     43618000
    INTEGER ERRLABEL;   <<ERROR RETURN>>                                43620000
    COMMENT                                                             43622000
      CHECK DEVICE TABLES FOR NON-EXISTENT OUTPUT DEVICES, DUPLICATELY  43624000
    DEFINED DRT-UNIT COMBINATIONS, AND DEVICE CLASSES WITH BOTH SHARABLE43626000
    AND NON-SHARABLE DEVICES. IF ANY OF THESE CONDITIONS ARE FOUND,     43628000
    PRINT A MESSAGE AND EXIT TO ERRLABEL;                               43630000
      BEGIN                                                             43632000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>43634000
        EQUATE CONSOLEDRTUNIT=[9/7,7/0];                       <<03002>>43636000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>43638000
        EQUATE CONSOLEDRTUNIT=[9/8,7/0];                       <<03002>>43640000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>43642000
        EQUATE SDISC=31;<<CLASS ACCESS TYPE FOR SERIAL DISCS>> <<SD.00>>43646000
        EQUATE FDISC=7;<<FOREIGN DISC CLASS ACCESS TYPE>>      <<01115>>43648000
        INTEGER LDEVRANGE,DTYP,TYPE,TYPE2,SUBTYP,BOARD;        <<03004>>43650000
        LOGICAL TERMERROR;                                     <<03004>>43652000
        LOGICAL ALLSAME;                                                43654000
        INTEGER I,J,K,N,INDEX,LDEV:=0,COLDLOADLDEV:=0;         <<00888>>43656000
       BYTE ARRAY CLASSNAME(0:9);                              <<01103>>43658000
        LOGICAL ERRORS:=FALSE,TOOBIGDRT:=FALSE;                         43660000
        LOGICAL OLDBIGDRT := FALSE;  <<DRT > CPU SUPPORTS>>    <<03002>>43662000
        LOGICAL BIGUSERMAXDRT := FALSE; <<USER MAX > CPU>>     <<03002>>43664000
        LOGICAL DISCFOUND := FALSE;                                     43666000
        LOGICAL ROCL;  << RETURN FROM STARFISH ROLL CALL >>    <<02707>>43668000
        INTEGER LEN1,LEN2;                                              43670000
        INTEGER ACCTYPE;                                       <<00071>>43672000
                                                               <<01103>>43676000
      SUBROUTINE MOVECLASS;                                    <<01103>>43678000
      BEGIN                                                    <<01103>>43680000
      CLASSNAME := MOVEAN(CLASSNAME(1),DVCLTAB(INDEX-10),8);   <<01103>>43682000
      END;                                                     <<01103>>43684000
                                                               <<01103>>43686000
          NDISCDEV := 0;                                                43688000
          CONSOLELDEV := 0;                                             43690000
          WHILE (LDEV:=LDEV+1) <= HLDEV DO                              43692000
           BEGIN                                                        43694000
           DRTN := DVRTAB(LDEV*DVRSIZE);                                43696000
           IF DRTN.DRTFIELD<>0 AND                             <<03002>>43698000
              DVRTAB(LDEV*DVRSIZE+1).DSBIT=0 THEN              <<03002>>43700000
             BEGIN <<NON-DS DEVICE>>                                    43702000
              IF DRTN.DRTFIELD>CTAB0(DRTNUM)                   <<03002>>43704000
              THEN TOOBIGDRT:=TRUE;                            <<03002>>43706000
              IF DRTN.DRTFIELD > MAXDRT  <<CANT SUPPORT>>      <<03002>>43708000
              THEN OLDBIGDRT := TRUE;                          <<03002>>43710000
              IF CTAB0(DRTNUM) > MAXDRT  <<USER CHOSEN MAX>>   <<03002>>43712000
              THEN BIGUSERMAXDRT := TRUE;<<IS > CPU MAX>>      <<03002>>43714000
                                                               <<02707>>43716000
              << IF THERE'S A STARFISH ON THE SYSTEM, DON'T >> <<02707>>43718000
              << ALLOW DRTS 125-127.  THESE ARE USED FOR    >> <<02707>>43720000
              << STARFISH'S MAILBOX.                        >> <<02707>>43722000
              IF STARFISH THEN                                 <<02707>>43724000
                 IF 125 <= DRTN.DRTFIELD <= 127 THEN           <<03022>>43726000
                    BEGIN                                      <<02707>>43728000
                    MESSAGE( M135, LDEV);                      <<02707>>43730000
                    ERRORS := TRUE;                            <<02707>>43732000
                    END;                                       <<02707>>43734000
                                                               <<02707>>43736000
              @LDTENT := @LDT(LDEV*LDTSIZE);                            43738000
              TYPE := LDTENT(LDT2).TYP;                        <<03550>>43740000
              SUBTYP := LPDT(LDEV*LPDTSIZE+LPDT1).SUBTYPE;     <<03550>>43742000
              I := LDTENT(LDT3).OUTDEV;  <<OUTPUT DEVICE>>              43744000
                                                               <<01103>>43746000
              IF DRTN=CONSOLEDRTUNIT AND                       <<03550>>43748000
                TYPE=TERMDEVTYPE                               <<03550>>43750000
                THEN CONSOLELDEV := LDEV;                               43752000
              IF DRTN=SYSTAPEDRTUNIT AND    << RECORD COLD >>  <<03550>>43754000
              (SDISC'TYPE(TYPE,SUBTYP) LOR  << LOAD LDEV   >>  <<03550>>43756000
               TYPE=TAPETYPE) THEN                             <<03550>>43758000
                 COLDLOADLDEV:=LDEV;                           <<00888>>43760000
              IF LOGICAL(LPDT(LPDTSIZE*LDEV+LPDT1).AJOBS) AND I=0 THEN  43762000
                 << NO OUTPUT DEVICE FOR LOGICAL DEVICE n >>   <<01103>>43764000
                 BEGIN                                         <<01103>>43766000
                 MESSAGE( M116, LDEV);                         <<01103>>43768000
                 ERRORS := TRUE;                               <<01103>>43770000
                 END;                                          <<01103>>43772000
              IF LOGICAL(LDTENT(LDT3).OUTCL) THEN                       43774000
                BEGIN   <<OUTPUT DEVICE IS CLASS INDEX>>                43776000
                  IF I=0 THEN                                           43778000
                     << OUTPUT CLASS FOR DEVICE n NO LONGER EXITS >>    43780000
                     BEGIN                                     <<01103>>43782000
                     MESSAGE( M117, LDEV);                     <<01103>>43784000
                     ERRORS := TRUE;                           <<01103>>43786000
                     END                                       <<01103>>43788000
                  ELSE                                                  43790000
                  BEGIN                                                 43792000
                   INDEX := 10;                                         43794000
                   J := 0;                                              43796000
                   WHILE (J:=J+1)<I DO                                  43798000
                     BEGIN                                              43800000
                      TOS:=DVCLTAB(INDEX);                              43802000
                      ASSEMBLE(DUP,NOT);                                43804000
                      IF TOS THEN TOS := TOS + 1;                       43806000
                      INDEX := TOS + INDEX +11;                         43808000
                     END;                                               43810000
                  I:=LDT(INTEGER(DVCLTAB(INDEX+1))*LDTSIZE              43812000
                                +LDT2).TYP;                             43814000
                  IF (0<=I<=15) OR (24<=I<=31) THEN                     43816000
                     << DEVICE CLASS xxxxxxxx CAN NOT BE >>    <<01103>>43818000
                     << OUTPUT DEVICE                   >>     <<01103>>43820000
                     BEGIN                                     <<01103>>43822000
                     MOVECLASS;                                <<01103>>43824000
                     MESSAGE( M118,,,,,CLASSNAME);             <<01103>>43826000
                     ERRORS := TRUE;                           <<01103>>43828000
                     END;                                      <<01103>>43830000
                 END;                                                   43832000
                END                                                     43834000
              ELSE IF I <> 0 THEN                                       43836000
              IF DVRTAB(I*DVRSIZE).DRTFIELD=0 THEN             <<03002>>43838000
                  << LOGICAL DEVICE n DOES NOT EXIST >>        <<01103>>43840000
                  BEGIN                                        <<01103>>43842000
                  MESSAGE( M120, I);                           <<01103>>43844000
                  ERRORS := TRUE;                              <<01103>>43846000
                  END                                          <<01103>>43848000
              ELSE                                                      43850000
              BEGIN                                                     43852000
               INDEX := LDT(I*LDTSIZE+LDT2).TYP;                        43854000
               IF (0<=INDEX<=15) OR (24<=INDEX<=31) THEN                43856000
                  << LOGICAL DEVICE n CAN NOT BE OUTPUT DEVICE >>       43858000
                  BEGIN                                        <<01103>>43860000
                  MESSAGE( M119, I);                           <<01103>>43862000
                  ERRORS := TRUE;                              <<01103>>43864000
                  END;                                         <<01103>>43866000
              END;                                                      43868000
              INDEX := LDEV;                                            43870000
              WHILE (INDEX:=INDEX+1) <= HLDEV DO                        43872000
              IF DVRTAB( INDEX*DVRSIZE)=DRTN THEN              <<03004>>43876000
                BEGIN   << TWO DEVICES ON SAME DRT,UNIT >>     <<03004>>43878000
                TYPE2 := LDT(INDEX*LDTSIZE+LDT2).TYP;          <<03004>>43880000
                                                               <<03004>>43882000
                       << NOT BOTH CS DEVICES >>               <<03004>>43884000
                IF NOT ( CSDEV17<= TYPE <= CSDEV19 LAND        <<03004>>43886000
                         CSDEV17<= TYPE2<= CSDEV19)            <<03004>>43888000
                                                               <<03004>>43890000
$IF X1=ON  << ********** SERIES 33,44,55 UNIQUE *********** >> <<03004>>43892000
                   AND                                         <<03004>>43894000
                       << NOT BOTH TERMINALS >>                <<03004>>43896000
                   NOT ( TYPE=TERMDEVTYPE LAND                 <<03004>>43898000
                         TYPE2=TERMDEVTYPE)                    <<03004>>43900000
                                                               <<03004>>43902000
$IF        << ********* RETURNING TO COMMON CODE ********** >> <<03004>>43904000
                   AND                                         <<03004>>43906000
                       << NOT BOTH DISCS >>                    <<03004>>43908000
                   NOT( TYPE&LSR(3)   = DIRACCESS LAND         <<03004>>43910000
                        TYPE2&LSR(3)  = DIRACCESS )            <<03004>>43912000
                                                               <<03004>>43914000
                   THEN                                        <<03004>>43916000
                   BEGIN                                       <<03004>>43918000
                   << ERROR: MORE THAN 1 DEVICE ON  >>         <<03004>>43920000
                   << THE SAME DRT AND UNIT         >>         <<03004>>43922000
                   MESSAGE( M121, LDEV, INDEX);                <<03004>>43924000
                   ERRORS := TRUE;                             <<03004>>43926000
                   END;                                        <<03004>>43928000
                END;                                           <<03004>>43930000
$IF X1=ON  << ********** SERIES 33,44,55 UNIQUE *********** >> <<03004>>43932000
              << DO CHECKS FOR ALL TERMINAL DEVICES ( BUT >>   <<03004>>43934000
              << NOT MULTI-POINT )                        >>   <<03004>>43936000
              IF TYPE = TERMDEVTYPE OR                         <<03004>>43938000
                TYPE=32 AND (SUBTYP=14 OR SUBTYP=15) THEN      <<03004>>43940000
                 BEGIN   << CHECK TERMINALS >>                 <<03004>>43942000
                 << GET THE BOARD TYPE FOR THIS TERMINAL >>    <<03004>>43944000
                 BOARD := GETBOARDTYPE( DRTN.DRTFIELD);        <<03004>>43946000
                 IF BOARD = LYNX'BOARD THEN                    <<03004>>43948000
                    LDTX( LDEV*LDTXSIZE+LDTX2).TERMBOARD       <<03004>>43950000
                       := LYNX'TERM                            <<03004>>43952000
                 ELSE IF BOARD = ADCC'BOARD THEN               <<03004>>43954000
                    LDTX( LDEV*LDTXSIZE+LDTX2).TERMBOARD       <<03004>>43956000
                       := ADCC'TERM                            <<03004>>43958000
                 ELSE IF BOARD < 0 THEN                        <<03004>>43960000
                    BEGIN   << BOARD DOES NOT RESPOND >>       <<03004>>43962000
                    MESSAGE(M132, LDEV, DRTN.DRTFIELD);        <<03004>>43964000
                    ERRORS := TRUE;                            <<03004>>43966000
                    END                                        <<03004>>43968000
                 ELSE                                          <<03004>>43970000
                    BEGIN  << WRONG BOARD FOR TERMINAL >>      <<03004>>43972000
                    MESSAGE(M133, LDEV, DRTN.DRTFIELD);        <<03004>>43974000
                    ERRORS := TRUE;                            <<03004>>43976000
                    END;                                       <<03004>>43978000
                 IF BOARD = ADCC'BOARD THEN                    <<03004>>43980000
                    BEGIN   << DO CHECKS FOR ADCC TERMS.  >>   <<03004>>43982000
                    IF LDTX(LDEV*LDTXSIZE).TERMSPEED >         <<03004>>43984000
                       15 THEN                                 <<03004>>43986000
                       BEGIN  <<SPEED NOT SUPPORTED BY ADCC>>  <<03004>>43988000
                       MESSAGE( M131, LDEV);                   <<03004>>43990000
                       ERRORS := TRUE;                         <<03004>>43992000
                       END;                                    <<03004>>43994000
                    IF DRTN.UNITFIELD <> 0 THEN                <<03004>>43996000
                       BEGIN <<ADCC TERMS. MUST BE UNIT 0>>    <<03004>>43998000
                       MESSAGE( M112, LDEV);                   <<03004>>44000000
                       ERRORS := TRUE;                         <<03004>>44002000
                       END;                                    <<03004>>44004000
                    INDEX := 0;                                <<03004>>44006000
                    TERMERROR := FALSE;                        <<03004>>44008000
                    WHILE (INDEX := INDEX+1) <= HLDEV DO       <<03004>>44010000
                      IF DVRTAB( INDEX*DVRSIZE).DRTFIELD =     <<03004>>44012000
                        DRTN.DRTFIELD AND INDEX <> LDEV THEN   <<03004>>44014000
                        BEGIN  << 2 TERMS. ON SAME DRT >>      <<03004>>44016000
                        TERMERROR := TRUE;                     <<03004>>44018000
                        ERRORS := TRUE;                        <<03004>>44020000
                        END;                                   <<03004>>44022000
                    << TERMINAL DRT MUST BE UNIQUE >>          <<03004>>44024000
                    IF TERMERROR THEN MESSAGE( M113, LDEV);    <<03004>>44026000
                    END;                                       <<03004>>44028000
                 IF BOARD=LYNX'BOARD THEN                      <<03004>>44030000
                    BEGIN   << LYNX TERMS. MUST BE ON >>       <<03004>>44032000
                            << DEVICE 0               >>       <<03004>>44034000
                    IF (LOGICAL(DRTN.DRTFIELD) LAND %7)        <<03004>>44036000
                       <> 0 THEN                               <<03004>>44038000
                       BEGIN                                   <<03004>>44040000
                       MESSAGE( M134, LDEV,                    <<03004>>44042000
                        (LOGICAL(DRTN.DRTFIELD) LAND %770));   <<03004>>44044000
                       ERRORS := TRUE;                         <<03004>>44046000
                       END;                                    <<03004>>44048000
                    END;                                       <<03004>>44050000
                 END;                                          <<03004>>44052000
$IF        << ********** RETURNING TO COMMON CODE ********* >> <<03004>>44054000
            END;                                                        44056000
           END;                                                         44058000
          INDEX := 10;                                                  44060000
          I := 0;                                                       44062000
          WHILE (I:=I+1) <= LDT(DCNUM) DO                               44064000
            BEGIN    <<SEARCH DEVICE CLASS TABLE>>                      44066000
              N := DVCLTAB(INDEX);                                      44068000
              IF DVCLTAB(INDEX-10)="DISC    " THEN                      44070000
                BEGIN                                                   44072000
                  NDISCDEV := N;                                        44074000
                  @DISCLASS := INDEX+1;                                 44076000
                  DISCFOUND := TRUE;                                    44078000
                END;                                                    44080000
              TOS := DVCLTAB(INDEX-1); <<CLASS ACCESS & TERMACC BIT>>   44082000
              TOS := TOS LAND %77; <<CLEAR TERMACC BIT>>                44084000
              DUPLICATE;                                                44086000
              DVCLTAB(X) := TOS;                                        44088000
              ACCTYPE:=S0; <<SAVE CLASS ACCESS TYPE>>          <<00888>>44090000
              IF S0=SDISC THEN TOS:=TOS&LSR(3); <<SERIAL>>     <<SD.00>>44092000
              <<DISCS FIT IN CLASS TYPE "DIRECT ACCESS">>      <<SD.00>>44094000
              K := TOS&LSR(3);                                          44096000
              ALLSAME := TRUE;                                          44098000
              DTYP :=LDT(DVCLTAB(INDEX+1)*LDTSIZE+LDT2).TYP;            44100000
              J := 0;                                                   44102000
              IF K=DIRACCESS OR K=CONINOUT THEN                         44104000
                BEGIN                                                   44106000
              WHILE (J:=J+1) <= N DO                                    44108000
              IF LDT(INTEGER(DVCLTAB(INDEX+J))*LDTSIZE+LDT2).RANGE      44110000
                <> K THEN                                               44112000
                BEGIN  <<TYPE RANGES DIFFERENT>>                        44114000
                << DEVICES OF DIFFERENT TYPE RANGES IN CLASS xxxx >>    44116000
                MOVECLASS;                                     <<01103>>44118000
                MESSAGE( M122,,,,,CLASSNAME);                  <<01103>>44120000
                ERRORS := TRUE;                                <<01103>>44122000
                GOTO NEXTINDEX;                                <<01103>>44124000
                END                                                     44126000
              ELSE                                                      44128000
                BEGIN                                          <<00071>>44130000
                IF DTYP <>LDT(DVCLTAB(INDEX+J)*                         44132000
                       LDTSIZE+LDT2).TYP THEN ALLSAME:=FALSE;           44134000
                IF ACCTYPE=SDISC OR ACCTYPE=FDISC THEN         <<01115>>44136000
                   BEGIN                                       <<00071>>44138000
                   TYPE := LDT(DVCLTAB(INDEX+J)*               <<03550>>44140000
                   LDTSIZE+LDT2).TYP;                          <<00071>>44142000
                   SUBTYP := LPDT(DVCLTAB(INDEX+J)*            <<03550>>44144000
                   LPDTSIZE+LPDT1).SUBTYPE;                    <<00071>>44146000
                   IF NOT SDISC'TYPE(TYPE,SUBTYP) THEN         <<03550>>44150000
                      GOTO CLCOMER;                            <<03550>>44152000
                   END;                                        <<00071>>44154000
                END;                                           <<00071>>44156000
                END                                                     44158000
              ELSE                                                      44160000
                WHILE (J:=J+1)<=N DO                                    44162000
                  BEGIN                                                 44164000
                  LDEVRANGE:=LDT(INTEGER(DVCLTAB(INDEX+J))*             44166000
                           LDTSIZE+LDT2).RANGE;                         44168000
                  IF LDEVRANGE=DIRACCESS THEN                           44170000
   CLCOMER:         BEGIN   <<TYPE COMBINATION ERROR IN CLASS>>         44172000
                    << ILLEGAL TYPE COMBINATIONS IN CLASS xxxx >>       44174000
                    MOVECLASS;                                 <<01103>>44176000
                    MESSAGE( M123,,,,,CLASSNAME);              <<01103>>44178000
                    ERRORS := TRUE;                                     44180000
                    GO NEXTINDEX;                                       44182000
                    END;                                                44184000
                  IF (K=SERINPUT)                                       44186000
                     AND (LDEVRANGE=SEROUTPUT)                          44188000
                     OR (K=SEROUTPUT)                                   44190000
                     AND (LDEVRANGE=SERINPUT)                           44192000
                     OR (K=NCONINOUT)                                   44194000
                     AND (LDEVRANGE<>NCONINOUT)                         44196000
                     AND (LDEVRANGE<>CONINOUT)                          44198000
                  THEN GO CLCOMER;                                      44200000
                  IF DTYP <>LDT(DVCLTAB(INDEX+J)*LDTSIZE                44202000
                       +LDT2).TYP THEN ALLSAME:=FALSE;                  44204000
                  END;                                                  44206000
                IF INTEGER(DVCLTAB(INDEX-1))<>K&LSL(3) AND              44208000
                    NOT ALLSAME AND                            <<00071>>44210000
                    ACCTYPE<>SDISC AND ACCTYPE<>FDISC THEN     <<01115>>44212000
                    GOTO CLCOMER;                              <<00071>>44214000
                TOS := DVCLTAB(X); <<CLASS ACCESS TYPE & TERMACC BIT>>  44216000
                IF S0= TERMDEVTYPE AND ALLSAME THEN                     44218000
                  BEGIN <<ALL DEVICES IN CLASS ARE TERMINALS>>          44220000
                  TOS := TOS + %100; <<SET TERMACC BIT>>                44222000
                  DVCLTAB(X) := TOS; <<STORE IN CLASS TABLE>>           44224000
                  END                                                   44226000
                ELSE DEL;                                               44228000
  NEXTINDEX:  TOS := DVCLTAB(INDEX);                                    44230000
              ASSEMBLE(DUP,NOT);                                        44232000
              IF TOS THEN TOS:=TOS+1;                                   44234000
              INDEX := TOS+INDEX+11;  <<POINT TO NEXT CLASS>>           44236000
            END;                                                        44238000
          IF TOOBIGDRT OR BIGUSERMAXDRT                        <<03002>>44242000
          THEN BEGIN                                           <<03002>>44244000
             MESSAGE(M102,CTAB0(DRTNUM));                      <<03002>>44246000
             <<"USER SPECIFIED DRT MAX IS -DRT- ">>            <<03002>>44248000
             ERRORS := TRUE;                                   <<03002>>44250000
            END;                                               <<03002>>44252000
                                                               <<03002>>44254000
          IF OLDBIGDRT OR BIGUSERMAXDRT                        <<03002>>44256000
          THEN BEGIN                                           <<03002>>44258000
             MESSAGE(M128,MAXDRT);                             <<03002>>44260000
             <<"HIGEST DRT SUPPORTED BY THIS CPU IS -DRT">>    <<03002>>44262000
             ERRORS := TRUE;                                   <<03002>>44264000
          END;                                                 <<03002>>44266000
                                                               <<03002>>44268000
          IF OLDBIGDRT OR TOOBIGDRT                            <<03002>>44270000
          THEN BEGIN                                           <<03002>>44272000
                   <<AT LEAST ONE LDEV-DRT PAIR IS BAD>>       <<03002>>44274000
             MESSAGE (M129);  <<"FOLLOWING DRTS TO BE FIXED>>  <<03002>>44276000
             LDEV:= 0;                                         <<03002>>44278000
             WHILE (LDEV:=LDEV+1) <= HLDEV DO                  <<03002>>44280000
             BEGIN    <<FIND OFFENDERS>>                       <<03002>>44282000
                DRTN:=DVRTAB(LDEV*DVRSIZE);                    <<03002>>44284000
                IF DRTN <> 0 AND                               <<03002>>44286000
                   DVRTAB(LDEV*DVRSIZE+1).DSBIT=0              <<03002>>44288000
                THEN IF DRTN.DRTFIELD > CTAB0(DRTNUM)          <<03002>>44290000
                     OR DRTN.DRTFIELD > MAXDRT                 <<03002>>44292000
                     THEN MESSAGE(M2411,LDEV,DRTN.DRTFIELD);   <<03002>>44294000
             END;  <<WHILE LDEV<HLDEV>>                        <<03002>>44296000
          END;  <<IF TOOBIGDRT OR OLDBIGDRT >>                 <<03002>>44298000
                                                               <<03002>>44300000
          IF COLDLOADLDEV=0 AND OPT>COOL THEN                  <<00888>>44302000
             BEGIN                                             <<00888>>44304000
             MESSAGE(M108); <<CLD LOAD DEV MUST BE CONFIG>>    <<01103>>44306000
             ERRORS:=TRUE;                                     <<00888>>44308000
             END;                                              <<00888>>44310000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>44312000
          IF CONSOLELDEV=0 THEN                                         44314000
            BEGIN                                                       44316000
              MESSAGE(M109);<<SYSTEM CONSOLE MUST BE DRT 7>>   <<01103>>44318000
              ERRORS := TRUE;                                           44320000
            END;                                                        44322000
                                                               <<02707>>44324000
          << GIC CHANNELS ON STARFISH MUST NOT BE SET TO    >> <<02707>>44326000
          << 0, 1 OR 15, BECAUSE SYSTEM WILL NOT COME UP.   >> <<02707>>44328000
          << THIS IS TRUE WHETHER OR NOT DEVICE ARE CONFIG- >> <<02707>>44330000
          << URED ON THESE CHANNELS.  RESETSTARFISH ZEROES  >> <<02707>>44332000
          << THE LAST WORD OF EVERY DRT ON THE GIC CHANNEL. >> <<02707>>44334000
                                                               <<02707>>44336000
          IF STARFISH THEN                                     <<02707>>44338000
            BEGIN     << THERE'S A STARFISH ON THE SYSTEM >>   <<02707>>44340000
            ROCL := RIOC( 0, ROLLCALL);                        <<02707>>44342000
            IF <> THEN ERRMESSAGE( M29);  <<STARFISH ERROR>>   <<02707>>44344000
            IF ROCL.(15:1) OR ROCL.(1:1) OR ROCL.(0:1) THEN    <<02707>>44346000
               BEGIN                                           <<02707>>44348000
               MESSAGE( M136);  << MUST SWITCH GIC CHANNEL >>  <<02707>>44350000
               ERRORS := TRUE;  << THUMBWHEEL ON STARFISH  >>  <<02707>>44352000
               END;                                            <<02707>>44354000
            END;    << IF STARFISH >>                          <<02707>>44356000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>44358000
          IF CONSOLELDEV=0 THEN                                <<00888>>44360000
            BEGIN                                              <<00888>>44362000
              MESSAGE(M110);<<SYSTEM CONSOLE MUST BE DRT 8>>   <<01103>>44364000
              ERRORS := TRUE;                                  <<00888>>44366000
            END                                                <<00888>>44368000
          ELSE IF LDTX(CONSOLELDEV*LDTXSIZE).TERMSPEED=0 THEN  <<00888>>44370000
            BEGIN <<SPEED FOR SYSTEM CONSOLE MUST BE NON ZERO>><<00888>>44372000
            MESSAGE(M111); << IMPROPER SPEED FOR CONSOLE >>    <<01103>>44374000
            ERRORS := TRUE;                                    <<00888>>44376000
            END;                                               <<00888>>44378000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>44380000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>44382000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>44386000
          IF NOT NON'DS'LDEV(SYSDISC) OR                       <<03550>>44388000
            NOT SYSDISC'TYPE(LDT(SYSDISC*LDTSIZE+LDT2).TYP,    <<03550>>44390000
                LPDT(SYSDISC*LPDTSIZE+LPDT1).SUBTYPE) OR       <<03550>>44392000
            HLDEV=0 THEN                                       <<03550>>44394000
            BEGIN    << LDEV #1 IS NOT SYSTEM DISC >>          <<03550>>44396000
              MESSAGE(M105); <<SYSTEM DISC MUST BE LDEV 1>>    <<01103>>44398000
              ERRORS := TRUE;                                           44400000
            END;                                                        44402000
          IF DVRTAB(DVRSIZE).UNITFIELD<>0 THEN                 <<03002>>44404000
            BEGIN                                                       44406000
              MESSAGE(M103);<<SYSTEM DISC MUST BE UNIT 0>>     <<01103>>44408000
              ERRORS := TRUE;                                           44410000
            END;                                                        44412000
          IF NOT DISCFOUND THEN                                         44414000
            BEGIN  <<NO DEVICE IN CLASS DISC>>                          44416000
              MESSAGE(M107);                                   <<01103>>44418000
              ERRORS := TRUE;                                           44420000
            END;                                                        44422000
          IF ERRORS THEN RETURNP := ERRLABEL;                           44424000
      END <<CHECKDEV>> ;                                                44426000
$CONTROL SEGMENT=CONFIGURE                                              44428000
          <<------------------------                                    44430000
            MOVE TABLES IN DL AREA                                      44432000
          ------------------------>>                                    44434000
  PROCEDURE MOVEDLTABLES;                                               44436000
    OPTION PRIVILEGED,UNCALLABLE;                                       44438000
    COMMENT                                                             44440000
      EXPANDS AND CONTRACTS TABLES IN THE DL AREA, USING FOLLOWING      44442000
    GLOBALS:                                                            44444000
        TABLEPTRS - ARRAY OF POINTERS TO THE TABLES                     44446000
        TABLEINCRS - ARRAY CONTAINING NUMBER OF WORDS EACH TABLE IS TO  44448000
                     BE INCREMENTED OR DECREMENTED;                     44450000
      BEGIN                                                             44452000
        INTEGER ARRAY OFFSETS(0:EXPTABLES-1)=Q;    <<OFFSET FOR EACH    44454000
                                                     EXPANDABLE TABLE>> 44456000
        INTEGER I,J,       <<LOOP CONTROL>>                             44458000
                NWORDS,    <<NUMBER OF WORDS FOR CURRENT OFFSET>>       44460000
                LASTMOVED; <<INDEX OF LAST TABLE MOVED>>                44462000
        SUBROUTINE EXPAND;                                              44464000
        COMMENT                                                         44466000
          EXPANDS A PORTION OF THE DL AREA BY NWORDS WORDS AND ZEROES   44468000
        THE RESULTING HOLE. UPDATES POINTERS TO THOSE TABLES MOVED;     44470000
        BEGIN                                                           44472000
          IF NWORDS=0 THEN RETURN;                                      44474000
          TOS := TABLEPTRS(J:=LASTMOVED+1);                             44476000
          TOS := S0-NWORDS;   <<DESTINATION FOR MOVE>>                  44478000
          ASSEMBLE(XCH,DUP);                                            44480000
          TOS := TABLEPTRS(I);                                          44482000
          ASSEMBLE(SUB,NEG; MOVE 2); <<MOVE PORTION OF TABLE>>          44484000
          PS0 := 0;                                                     44486000
          ASSEMBLE(DUP,INCB);                                           44488000
          TOS := NWORDS-1;                                              44490000
          ASSEMBLE(MOVE 3);  <<ZERO EXPANDED AREA>>                     44492000
        <<UPDATE POINTERS TO MOVED TABLES>>                             44494000
          DO TABLEPTRS(X) := TABLEPTRS(J)-NWORDS UNTIL (J:=J+1)=I;      44496000
        END <<EXPAND>> ;                                                44498000
        SUBROUTINE CONTRACT;                                            44500000
        COMMENT                                                         44502000
          CONTRACTS A PORTION OF THE DL AREA BY -NWORDS WORDS. POINTERS 44504000
        TO THOSE TABLES MOVED ARE UPDATED;                              44506000
        BEGIN                                                           44508000
          IF NWORDS=0 THEN RETURN;                                      44510000
          TOS := TABLEPTRS(LASTMOVED)-1;  <<DESTINATION PTR>>           44512000
          TOS := S0+NWORDS;  <<SOURCE FOR MOVE>>                        44514000
          TOS := -S0+TABLEPTRS(I+1)-1;  <<NEGATIVE WORD COUNT>>         44516000
          ASSEMBLE (MOVE 3);  <<MOVE TABLES>>                           44518000
          DO TABLEPTRS(X) := TABLEPTRS(X)-NWORDS                        44520000
          UNTIL (X:=X+1)=LASTMOVED;  <<UPDATE PTRS TO MOVED TABLES>>    44522000
        END <<CONTRACT>> ;                                              44524000
          @DVCLTAB := WORDADDRESS(DVCLTAB);  << CONVERT TO >>  <<04306>>44526000
                                             << WORD PNTR  >>  <<04306>>44528000
          OFFSETS := 0;                                                 44530000
          MOVE OFFSETS(1) := OFFSETS,(EXPTABLES-1);                     44532000
          I := 0;                                                       44534000
          DO IF (NWORDS:=TABLEINCRS(I)) <> 0 THEN                       44536000
            BEGIN                                                       44538000
              X := 0;                                                   44540000
              DO OFFSETS(X) := OFFSETS(X)+NWORDS UNTIL (X:=X+1)>I;      44542000
              TABLEINCRS(I) := 0;                                       44544000
            END                                                         44546000
          UNTIL (I:=I+1) = EXPTABLES;                                   44548000
          NWORDS := OFFSETS;                                            44550000
          IF < THEN                                                     44552000
            BEGIN <<CONTRACTING TABLE>>                                 44554000
              LASTMOVED := EXPTABLES;                                   44556000
              NWORDS := OFFSETS(EXPTABLES-1);                           44558000
              I := X-1;                                                 44560000
              DO IF OFFSETS(I) <> NWORDS THEN                           44562000
                BEGIN <<NEXT PORTION OF TABLE TO BE CONTRACTED MORE,    44564000
                        SO MOVE EVERYTHING UP TO THIS POINT WHICH HASN'T44566000
                        BEEN MOVED YET>>                                44568000
                  CONTRACT;                                             44570000
                  LASTMOVED := I+1;                                     44572000
                  NWORDS := OFFSETS(I);                                 44574000
                END                                                     44576000
              UNTIL (I:=I-1)<0;                                         44578000
              CONTRACT;   <<FINISH MOVING REST OF TABLES>>              44580000
            END                                                         44582000
          ELSE                                                          44584000
            BEGIN  <<EXPANDING TABLE>>                                  44586000
              LASTMOVED := -1; <<INDEX TO LAST TABLE MOVED>>            44588000
              I := 1;                                                   44590000
              DO IF OFFSETS(I) <> NWORDS THEN                           44592000
                BEGIN <<NEXT PORTION TO BE MOVED A DIFFERENT AMOUNT, SO 44594000
                        MOVE EVERYTHING UP TO THIS POINT WHICH HASN'T   44596000
                        BEEN MOVED YET>>                                44598000
                  EXPAND;                                               44600000
                  LASTMOVED := I-1;                                     44602000
                  NWORDS := OFFSETS(I);                                 44604000
                END                                                     44606000
              UNTIL (I:=I+1)=EXPTABLES;                                 44608000
              EXPAND; <<FINISH MOVING REST OF TABLES>>                  44610000
            END;                                                        44612000
          @DVCLTAB := @DVCLTAB&LSL(1);   << CONVERT BACK TO >> <<04306>>44614000
                                         << BYTE POINTER    >> <<04306>>44616000
          TOS := TABLEPTRS;                                             44618000
          SET(DL);  <<NEW VALUE FOR DL>>                                44620000
          CHECKMEM;  <<CHECK FOR MEMORY OVERLAP>>                       44622000
      END <<MOVEDLTABLES>> ;                                            44624000
          <<------------------------                                    44626000
            SET POINTERS TO TABLES                                      44628000
          ------------------------>>                                    44630000
  PROCEDURE SETPOINTERS(CURRENTDL);                                     44632000
    VALUE CURRENTDL;                                                    44634000
    INTEGER CURRENTDL;   <<CURRENT UPPER LIMIT ON TABLES>>              44636000
    COMMENT                                                             44638000
      SETS POINTERS TO THE DEVICE TABLES BASED ON THEIR SIZES AS        44640000
    FOUND IN THE CTAB0 TABLE;                                           44642000
      BEGIN                                                             44644000
          TOS := CURRENTDL;                                             44646000
          NVOL := CTAB0(HVOL');  << MVOL/HVOL >>               <<RH.PV>>44648000
          << MVOL MAY BE ZERO WHEN COMING FROM NON-PV SYSTEM>> <<RH.PV>>44650000
          IF MVOL = 0 THEN MVOL := HVOL ELSE                   <<RH.PV>>44652000
          IF HVOL > MVOL THEN HVOL := MVOL;                    <<RH.PV>>44654000
          TOS := (MVOL+1) * VTABSIZE;                          <<RH.PV>>44656000
          ASSEMBLE(SUB,DUP);                                            44658000
          @VTAB := TOS;  <<PTR TO VOLUME TABLE>>                        44660000
          TOS := CTAB0(HLDEV');  <<HIGHEST LOGICAL DEVICE #>>  <<00.06>>44662000
          ASSEMBLE(DUP,INCB);                                  <<00.06>>44664000
          HLDEV := TOS;                                        <<00.06>>44666000
          TOS := TOS*LDTXSIZE;                                 <<00.06>>44668000
          ASSEMBLE(SUB,DUP);                                   <<00.06>>44670000
          @LDTX := TOS;  <<PTR TO LOGICAL DEVICE TABLE EXT>>   <<00.06>>44672000
          TOS := CTAB0(DVCLSIZE');  <<SIZE OF DEVICE CLASS TABLE>>      44674000
          DVCLSIZE := S0&LSL(1);                                        44676000
          ASSEMBLE(SUB,DUP);                                            44678000
          @DVCLTAB := TOS&LSL(1);   << BYTE POINTER TO      >> <<04306>>44680000
                                    <<  DEVICE CLASS TABLE  >> <<04306>>44682000
          TOS := TOS-(HLDEV+1)*LDTSIZE;                        <<00.06>>44684000
          @LDT := S0;   <<PTR TO LOGICAL DEVICE TABLE>>        <<00.06>>44686000
          TOS := TOS-(HLDEV+1)*LPDTSIZE;                                44688000
          @LPDT := S0;  <<PTR TO LOGICAL PHYSICAL DEVICE TABLE>>        44690000
          TOS := TOS-(HLDEV+1)*DVRSIZE;                                 44692000
          @DVRTAB := S0;  <<PTR TO DRIVER TABLE>>                       44694000
          TOS := TOS-CTAB0(CSTABSIZE);                                  44696000
          @CSTAB := S0;                                                 44698000
          SET(DL);                                                      44700000
      END <<SETPOINTERS>>;                                              44702000
                                                                        44704000
$CONTROL SEGMENT=MAINSEG1                                               44706000
          <<-----------------                                           44708000
            LIST CS DEVICES                                             44710000
          ----------------->>                                           44712000
                                                                        44714000
  PROCEDURE LISTCSDEV;                                                  44716000
    BEGIN                                                               44718000
     ARRAY GENHED1(0:35)=PB:=                                           44720000
      "LDN PM PRT LCL TC  RCV   LCL   CON  MODE   TRANSMIT ",           44722000
      " TM BUFFER D DRIVER ";                                           44724000
     ARRAY GENHED2(0:35)=PB:=                                           44726000
      "           MOD    TMOUT TMOUT TMOUT          SPEED    ",         44728000
      "   SIZE  C OPTIONS";                                             44730000
     ARRAY SWHED1(0:23)=PB:=                                            44732000
      "LDN CTRL  PHONE NUMBER LIST    LOCAL ID SEQUENCE";               44734000
     ARRAY SWHED2(0:26)=PB:=                                            44736000
      "     LEN                          REMOTE ID SEQUENCES ";         44738000
     ARRAY NSWHED1(0:25)=PB:=                                           44740000
      "LDN INCOM POLL   CIR  C/S NUM C P COMPONENT SEQUENCE";           44742000
     ARRAY NSWHED2(0:16)=PB:=                                           44744000
      "    DELAY REPET DELAY     COM T L ";                             44746000
     ARRAY HEX(*) = PB :=                                      <<03557>>44748000
            " 0 1 2 3 4 5 6 7 8 9 A B C D E F";                <<03557>>44750000
     LOGICAL SWTCHED:=FALSE,NONSWTCHED:=FALSE,REMOTE:=FALSE;            44752000
     ARRAY BUFR(0:35);                                                  44754000
     BYTE POINTER PHONE,IDLIST,CNTRLSEQ=PHONE;                          44756000
     INTEGER I,J,N,TEMP,PHINX,IDINX,LEN,CINX=PHINX;                     44758000
     INTEGER K,START,TYPE,LEN1,NUMS,NUMP;                               44760000
     EQUATE  QUOT   = %42,                                              44762000
             ETYP   = 1,                                                44764000
             OTYP   = 2,                                                44766000
             HTYP   = 3;                                                44768000
     BYTE ARRAY OUTTEMP(0:71);                                          44770000
     INTEGER POINTER CONTROL;                                           44772000
                                                                        44774000
  SUBROUTINE OCTTOASCI(INSTRING,OUTSTRING,LENGTH);                      44776000
     INTEGER LENGTH;                                                    44778000
     BYTE ARRAY INSTRING,OUTSTRING;                                     44780000
       BEGIN                                                            44782000
       MOVE OUTSTRING := "O(";                                          44784000
       I := -1;                                                         44786000
       J := 2;                                                          44788000
       WHILE(I:=I+1)<LENGTH DO                                          44790000
         BEGIN                                                          44792000
         TOS := LNTOA(INSTRING(I),8,OUTSTRING(J));             <<00935>>44794000
         TOS := TOS+J;                                                  44796000
         J := S0+1;                                                     44798000
         X := TOS;                                                      44800000
         OUTSTRING(X) := ",";                                           44802000
         END;                                                           44804000
       OUTSTRING(X) := ")";                                             44806000
       LENGTH := J;                                                     44808000
       END;  <<OCTTOASCI>>                                              44810000
                                                                        44812000
  SUBROUTINE HEXTOASCI(INSTRING,OUTSTRING,LENGTH);                      44814000
    INTEGER LENGTH;                                                     44816000
    BYTE ARRAY INSTRING,OUTSTRING;                                      44818000
      BEGIN                                                             44820000
      MOVE OUTSTRING := "H(";                                           44822000
      I := -1;                                                          44824000
      J := 2;                                                           44826000
      WHILE(I:=I+1)<LENGTH DO                                           44828000
        BEGIN                                                           44830000
        TOS := INSTRING(I);                                             44832000
        TOS := %20;                                                     44834000
        ASSEMBLE(DIV);                                                  44836000
        IF S1=0 THEN                                                    44838000
          BEGIN  <<ONE HEX DIGIT>>                                      44840000
          X := TOS;                                                     44842000
          DEL;                                                          44844000
          OUTSTRING(J) := HEX(X);                                       44846000
          J := J+1;                                                     44848000
          END                                                           44850000
        ELSE                                                            44852000
          BEGIN                                                         44854000
          ASSEMBLE(XCH);                                                44856000
          X := TOS;                                                     44858000
          K := TOS;                                                     44860000
          OUTSTRING(J) := HEX(X);                                       44862000
          J := J+1;                                                     44864000
          OUTSTRING(J) := HEX(K);                                       44866000
          J := J+1;                                                     44868000
          END;                                                          44870000
        OUTSTRING(J) := ",";                                            44872000
        J := J+1;                                                       44874000
        END;                                                            44876000
      OUTSTRING(X) := ")";                                              44878000
      LENGTH := J;                                                      44880000
      END;   <<HEXTOASCI>>                                              44882000
                                                                        44884000
          MOVE LINE := GENHED1,(36);                           <<00888>>44886000
          PRINTLINE;                                           <<00888>>44888000
          MOVE LINE := GENHED2,(36);                           <<00888>>44890000
          PRINTLINE;                                           <<00888>>44892000
          LDEV:=0;                                                      44894000
          WHILE(LDEV:=LDEV+1)<=HLDEV DO                                 44896000
            BEGIN                                                       44898000
            @LDTENT := @LDT+LDEV*LDTSIZE;                               44900000
            IF CSDEVICE THEN                                            44902000
              BEGIN  <<CS DEVICE>>                                      44904000
              @LPDTENT := @LPDT(LDEV&LSL(1));                           44906000
              INBUF := "  ";                                            44908000
              MOVE INBUF(1):=INBUF,(35);  <<BLANK BUFFER>>              44910000
              ASCII(LDEV,BINBUF);   <<LOGICAL DEVICE #>>                44912000
              N := CSDEF(LDEV);                                         44914000
              @CSLDTX := @CSTAB+CSXSTART;                               44916000
              I:=-1;                                                    44918000
              WHILE(I:=I+1)<N DO  <<FIND CSLDTX ENTRY>>                 44920000
                @CSLDTX := @CSLDTX+CSLDTX;                              44922000
              ASCII(CSLDTXHSI'CHAN,BINBUF(4));<<PORT MASK>>             44924000
              IF LDTENT(LDT2).TYP=CSDEV17 THEN                 <<01165>>44926000
                BEGIN                                          <<01165>>44928000
                BINBUF(7):="X"; BINBUF(12):="X";               <<01165>>44930000
                BINBUF(15):="X";                               <<01165>>44932000
                END                                            <<01165>>44934000
              ELSE                                             <<01165>>44936000
                BEGIN                                          <<01165>>44938000
              ASCII(CSLDTXPROTOCOL,BINBUF(7)); <<PROTOCOL>>             44940000
              ASCII(CSLDTXMODE,BINBUF(12)); <<LOCAL MODE>>              44942000
              ASCII(CSLDTXCODE,BINBUF(15));  <<TRANSMISSION CODE>>      44944000
                END;                                           <<01165>>44946000
              ASCII(CSLDTXRECV'TIMEOUT,BINBUF(18));                     44948000
                                 <<RECEIVE TIMEOUT>>                    44950000
              ASCII(CSLDTXLOCAL'TIMEOUT,BINBUF(24));                    44952000
                                 <<LOCAL TIMEOUT>>                      44954000
              ASCII(CSLDTXCONCT'TIMEOUT,BINBUF(30));                    44956000
                                 <<CONNECT TIMEOUT>>                    44958000
              IF LOGICAL(CSLDTXDIAL) THEN BINBUF(36):="O";              44960000
              IF 1<=CSLDTXANSWER<=2 THEN BINBUF(37):="I";               44962000
              IF CSLDTXANSWER=AUTOANSWER THEN BINBUF(38):="A";          44964000
              IF LOGICAL(CSLDTXDUAL'SPEED) THEN                         44966000
                BEGIN                                                   44968000
                BINBUF(39) := "D";                                      44970000
                IF LOGICAL(CSLDTXHALF'SPEED) THEN BINBUF(40):="H";      44972000
                END;                                                    44974000
              IF LOGICAL(CSLDTXSPEEDCHNGBLE) THEN BINBUF(41):="C";      44976000
              LDNTOA(CSLDTXINSPEED,10,BINBUF(43));             <<00935>>44978000
              ASCII(CSLDTXXMSN'MODE,BINBUF(54));                        44980000
              ASCII(CSLDTXPBUFFSIZE,BINBUF(57));                        44982000
              IF LOGICAL(CSLDTXDRCHANGEABLE) THEN BINBUF(63):="Y"       44984000
                ELSE BINBUF(63):="N";                                   44986000
              ASCII(CSLDTXDOPTIONS,BINBUF(66));                         44988000
              PRINT(INBUF,-72,0);                                       44990000
              IF SWITCHED THEN SWTCHED:=TRUE                            44992000
                ELSE IF NONSWITCHED AND SUPERVISED                      44994000
                     THEN NONSWTCHED:=TRUE;                             44996000
              END;                                                      44998000
            END;                                                        45000000
          IF SWTCHED THEN                                               45002000
            BEGIN  <<SWITCHED DEVICES PRESENT>>                         45004000
            MOVE INBUF:=SWHED1,(24);                                    45006000
            PRINT(INBUF,-48,0);                                         45008000
            MOVE INBUF:=SWHED2,(26);                                    45010000
            PRINT(INBUF,-52,0);                                         45012000
            LDEV := 0;                                                  45014000
            WHILE(LDEV:=LDEV+1)<=HLDEV DO                               45016000
              IF CSDEV17<=LDT(LDEV*LDTSIZE+LDT2).TYP<=CSDEV19 THEN      45018000
                IF LPDT(LDEV&LSL(1)+LPDT1).SUBTYPE=0 THEN               45020000
                  BEGIN   <<SWITCHED DEVICE>>                           45022000
                  INBUF := "  ";                                        45024000
                  MOVE INBUF(1):=INBUF,(35);                            45026000
                  ASCII(LDEV,BINBUF);                                   45028000
                  @CSLDTX := @CSTAB+CSXSTART;                           45030000
                  I:=-1;                                                45032000
                  WHILE(I:=I+1)<CSDEF(LDEV) DO                          45034000
                    @CSLDTX := @CSLDTX+CSLDTX;                          45036000
                  ASCII(0,BINBUF(4)); <<CONTROL SIZE>>         <<00.06>>45038000
                  IF CSLDTXPHLISTPTR<>0 THEN                            45040000
                    BEGIN <<POINT TO PHONE LIST>>                       45042000
                    @PHONE:=(@CSLDTX+CSLDTXPHLISTPTR)&LSL(1);  <<04306>>45044000
                                    <<BYTE POINTER TO PHONE LIST>>      45046000
                    NUMP := PHONE(NUMSEQ);  <<# OF PHONE SEQUENCES>>    45048000
                    END                                                 45050000
                  ELSE NUMP:=0;                                         45052000
                  IF CSLDTXIDLISTPTR<>0 THEN                            45054000
                    BEGIN                                               45056000
                    @IDLIST :=(@CSLDTX+CSLDTXIDLISTPTR)&LSL(1);<<04306>>45058000
                              <<BYTE POINTER TO ID LIST>>               45060000
                    NUMS := IDLIST(NUMSEQ);   <<# OF ID SEQUENCES>>     45062000
                    END                                                 45064000
                  ELSE NUMS:=0;                                         45066000
                  TEMP := 0;                                            45068000
                  PHINX:=IDINX:=3;                                      45070000
                  WHILE((NUMP>0) OR (NUMS>0)) DO                        45072000
                    BEGIN  <<MORE SEQUENCES OR A CONTINUATION>>         45074000
                    IF NUMP>0 THEN                                      45076000
                      BEGIN      <<MORE PHONE SEQUENCES>>               45078000
                      MOVE BINBUF(10):=PHONE(PHINX+1),(PHONE(PHINX));   45080000
                      PHINX:=PHINX+INTEGER(PHONE(PHINX))+1;             45082000
                      NUMP := NUMP-1;                                   45084000
                      END;                                              45086000
                    IF NUMS>0 OR TEMP>0 THEN                            45088000
                      BEGIN      <<MORE ID SEQUENCES>>                  45090000
                      IF TEMP>0 THEN                                    45092000
                        BEGIN <<CONTINUATION OF SEQUENCE>>              45094000
                        N:=(IF REMOTE THEN 35 ELSE 32);                 45096000
                        START := LEN;                                   45098000
                        LEN := TEMP;                                    45100000
                        TEMP := 0;                                      45102000
                        NUMS := NUMS-1;                                 45104000
                        REMOTE := TRUE;                                 45106000
                        END                                             45108000
                      ELSE                                              45110000
                        BEGIN <<NEW SEQUENCES>>                         45112000
                        START := 0;                                     45114000
                        TOS := IDLIST(IDINX);                           45116000
                        DUPLICATE;                                      45118000
                        TOS := TOS LAND %77;                            45120000
                        LEN := S0;                                      45122000
                        LEN1 := TOS;                                    45124000
                        TYPE := TOS&LSR(6);                             45126000
                        IF TYPE=OTYP THEN OCTTOASCI                     45128000
                           (IDLIST(IDINX+1),OUTTEMP,LEN)                45130000
                        ELSE IF TYPE=HTYP THEN HEXTOASCI                45132000
                                (IDLIST(IDINX+1),OUTTEMP,LEN)           45134000
                             ELSE                                       45136000
                               BEGIN                                    45138000
                               IF TYPE=ETYP THEN                        45140000
                                 BEGIN                                  45142000
                                 OUTTEMP := "E";                        45144000
                                 CONVERT(0,IDLIST(IDINX+1),             45146000
                                         OUTTEMP(2),LEN);               45148000
                                 END                                    45150000
                               ELSE                                     45152000
                                 BEGIN                                  45154000
                                 OUTTEMP := "A";                        45156000
                                 MOVE OUTTEMP(2):=IDLIST                45158000
                                      (IDINX+1),(LEN);                  45160000
                                 END;                                   45162000
                               OUTTEMP(1):=OUTTEMP(LEN+2):=QUOT;        45164000
                               LEN := LEN+3;                            45166000
                               END;                                     45168000
                        IDINX := IDINX+LEN1+1;                          45170000
                        IF REMOTE THEN                                  45172000
                          BEGIN                                         45174000
                          N := 34;                                      45176000
                          IF LEN>38 THEN                                45178000
                            BEGIN                                       45180000
                            TEMP := LEN-38;                             45182000
                            LEN := 38;                                  45184000
                            END                                         45186000
                          ELSE NUMS:=NUMS-1;                            45188000
                          END                                           45190000
                        ELSE                                            45192000
                          BEGIN <<LOCAL>>                               45194000
                          N := 31;                                      45196000
                          IF LEN>41 THEN                                45198000
                            BEGIN                                       45200000
                            TEMP := LEN-41;                             45202000
                            LEN := 41;                                  45204000
                            END                                         45206000
                          ELSE                                          45208000
                            BEGIN                                       45210000
                            NUMS := NUMS-1;                             45212000
                            REMOTE := TRUE;                             45214000
                            END;                                        45216000
                          END;                                          45218000
                        END; <<NEW SEQUENCES>>                          45220000
                      MOVE BINBUF(N):=OUTTEMP(START),(LEN);             45222000
                      END;<<MORE ID SEQUENCE>>                          45224000
                    PRINT(INBUF,-72,0);                                 45226000
                    INBUF := "  ";                                      45228000
                    MOVE INBUF(1) := INBUF,(35);                        45230000
                    END;<<MORE SEQUENCES OR A CONTIUATION>>             45232000
                  REMOTE := FALSE; <<FINISHED WITH DEVICE>>             45234000
                  IF CSLDTXPHLISTPTR=CSLDTXIDLISTPTR THEN               45236000
                    PRINT(INBUF,-72,0);<<NO PHONE #'S OR ID SEQUENCES>> 45238000
                  END; <<SWITCHED DEVICE>>                              45240000
            END; <<SWITCHED DEVICES PRESENT>>                           45242000
          IF NONSWTCHED THEN                                            45244000
            BEGIN <<NOSWITCHED SUPERVISED DEVICES EXIST>>               45246000
            MOVE  INBUF:=NSWHED1,(26);                                  45248000
            PRINT(INBUF,-52,0);                                         45250000
            MOVE INBUF:=NSWHED2,(17);                                   45252000
            PRINT(INBUF,-33,0);                                         45254000
            INBUF := "  ";                                              45256000
            MOVE INBUF(1):=INBUF,(35);                                  45258000
            LDEV := 0;                                                  45260000
            WHILE(LDEV:=LDEV+1)<=HLDEV DO                               45262000
              IF CSDEV17<=LDT(LDEV*LDTSIZE+LDT2).TYP<=CSDEV19 THEN      45264000
                IF LPDT(LDEV&LSL(1)+LPDT1).SUBTYPE<>0 THEN              45266000
                  BEGIN <<NONSWITCHED DEVICE>>                          45268000
                  @CSLDTX := @CSTAB+CSXSTART;                           45270000
                  I:=-1;                                                45272000
                  WHILE(I:=I+1)<CSDEF(LDEV) DO                          45274000
                    @CSLDTX := @CSLDTX+CSLDTX;                          45276000
                  IF NOT(SUPERVISED) THEN GOTO NEXTNSW;                 45278000
                  TOS := @CSLDTX+CSLDTXCONTPTR;                         45280000
                  @CONTROL  := S0;                                      45282000
                  IF CONTROLST THEN                            <<04306>>45284000
                    @CNTRLSEQ := (TOS+CONSEQSTART)&LSL(1)      <<04306>>45286000
                  ELSE @CNTRLSEQ:=(TOS+1)&LSL(1); <<TRIBUTARY>><<04306>>45288000
                  CINX := 0;                                            45290000
                  ASCII(LDEV,BINBUF);                                   45292000
                  IF TRIBUTARY THEN                                     45294000
                    BEGIN                                               45296000
                    ASCII(N:=CONTROL.(8:8),BINBUF(26));                 45298000
                    GO AROUND;                                          45300000
                    END;                                                45302000
                  ASCII(CONTROL(INTCOMDELAY),BINBUF(4));                45304000
                  ASCII(CONTROL,BINBUF(10));                            45306000
                  ASCII(CONTROL(CIRPDELAY),BINBUF(16));                 45308000
                  TOS := 0;                                             45310000
                  TOS:=(CONTROL(NUMCOMP)+CONTROL(REMOSTAT)-1)/          45312000
                        CONTROL(REMOSTAT);                              45314000
                  ASCII(*,BINBUF(22));                                  45316000
                  ASCII((N:=CONTROL(NUMCOMP)),BINBUF(26));              45318000
  AROUND:         NUMS := 0;                                            45320000
                  WHILE(NUMS:=NUMS+1)<=N DO                             45322000
                    BEGIN                                               45324000
                    TOS:=0;                                             45326000
                    TOS := CNTRLSEQ(CINX); <<SEQUENCE TYPE>>            45328000
                    TOS := TOS LAND 3;                                  45330000
                    ASCII(*,BINBUF(30));                                45332000
                    TOS := CNTRLSEQ(CINX);                              45334000
                    TOS:=TOS&LSR(2);                                    45336000
                    IF TOS>0 THEN BINBUF(32):="Y"                       45338000
                      ELSE BINBUF(32):="N";                             45340000
                    TOS := CNTRLSEQ(CINX+1);                            45342000
                    DUPLICATE;                                          45344000
                    TYPE := TOS&LSR(6);                                 45346000
                    TOS := TOS LAND %77;                                45348000
                    LEN1 := LEN := TOS;                                 45350000
                    IF TYPE=OTYP THEN OCTTOASCI                         45352000
                       (CNTRLSEQ(CINX+2),BINBUF(34),LEN)                45354000
                    ELSE IF TYPE=HTYP THEN HEXTOASCI                    45356000
                            (CNTRLSEQ(CINX+2),BINBUF(34),LEN)           45358000
                         ELSE                                           45360000
                           BEGIN                                        45362000
                           IF TYPE=ETYP THEN                            45364000
                             BEGIN                                      45366000
                             BINBUF(34) := "E";                         45368000
                             CONVERT(0,CNTRLSEQ(CINX+2),                45370000
                                     BINBUF(36),LEN);                   45372000
                             END                                        45374000
                           ELSE                                         45376000
                             BEGIN                                      45378000
                             BINBUF(34) := "A";                         45380000
                             MOVE BINBUF(36):=                          45382000
                                  CNTRLSEQ(CINX+2),(LEN);               45384000
                             END;                                       45386000
                           BINBUF(35):=BINBUF(LEN+36):=QUOT;            45388000
                           END;                                         45390000
                    CINX:=CINX+LEN1+2;                                  45392000
                    PRINT(INBUF,-72,0);                                 45394000
                    INBUF:="  ";                                        45396000
                    MOVE INBUF(1):=INBUF,(35);                          45398000
                    END;                                                45400000
  NEXTNSW:        END;                                                  45402000
            END;                                                        45404000
          END <<LISTCSDEV>>;                                            45406000
$PAGE "MAINSEG1 -- I/O CONFIGURATION CHANGES"                  <<MPEIV>>45408000
PROCEDURE IOCHANGE;                                            <<MPEIV>>45410000
BEGIN                                                          <<MPEIV>>45412000
        INTEGER TYPE,UNIT,IDINX,PHINX,CSINDX,LASTPOLLENT,      <<MPEIV>>45414000
                NEW'LDEV,BINDX=PHINX;                          <<03611>>45416000
        BYTE POINTER PHONE,IDLIST,BCSLDTX=PHONE;               <<MPEIV>>45418000
        EQUATE SDISC=31, FDISC=7;                              <<MPEIV>>45420000
          LOGICAL DSDEVICE;                                    <<MPEIV>>45422000
        INTEGER SPEEDCDE ;  << OCTAL CODE FOR TERM. SPEED >>   <<03004>>45426000
        INTEGER  TINDEX;     <<TEMPORARY CLASS INDEX>>         <<MPEIV>>45428000
        INTEGER TEMP;                                          <<MPEIV>>45430000
        INTEGER SUBTYP;  << DEVICE SUBTYPE >>                  <<03550>>45432000
        INTEGER OLDDRT;  << LDEV'S OLD DRT NUMBER >>           <<03557>>45434000
        LOGICAL ERROR := FALSE,LAST=ERROR;                     <<MPEIV>>45436000
        INTEGER ARRAY IBTEMP(0:40);                            <<03635>>45438000
        BYTE ARRAY BTEMP(*) = IBTEMP;                          <<03635>>45440000
        SUBROUTINE ZEROLDTX;  <<ZEROES THE LDTX ENTRY>>        <<04328>>45442000
          BEGIN                   <<FOR A GIVEN LDEV>>         <<04328>>45444000
          TOS := @LDTX(LDEV * LDTXSIZE);                       <<04328>>45446000
          PS0 := 0;                                            <<04328>>45448000
          ASSEMBLE (DUP,INCB);                                 <<04328>>45450000
          TOS := LDTXSIZE-1;                                   <<04328>>45452000
          ASSEMBLE (MOVE 3);                                   <<04328>>45454000
          END;                                                 <<04328>>45456000
          TCLASS  := 0;      <<NO ENTRIES IN TEMPCLASS>>       <<MPEIV>>45458000
          TCLASS(1)    := 4;  <<TEMPCASS LENGTH IS FOUR BYTES>><<MPEIV>>45460000
  REQOLIO:IF LGETYESNO(M2009) THEN   <<LIST I/O DEVICES>>      <<MPEIV>>45462000
            LISTIODEV;                                         <<MPEIV>>45464000
          IF CSPRESENT AND LGETYESNO(M2100) THEN LISTCSDEV;    <<MPEIV>>45466000
          GETNEWVAL(M2010,CTAB0(DRTNUM),LOWESTDRT,MAXDRT);     <<03002>>45468000
  REQLDEV:LDEV := GETVAL(M2011,0,255,2);  <<LOGICAL DEVICE #?>><<MPEIV>>45470000
          IF LDEV=0 THEN GOTO REQOSP;                          <<MPEIV>>45472000
  REQDRTN:DSDEVICE := FALSE;                                   <<MPEIV>>45474000
          MESSAGE(-M2012);   <<DRTN?>>                         <<MPEIV>>45476000
          READINPUT;                                           <<MPEIV>>45478000
          SCAN BPINBUF WHILE BLANK,1; <<DELETE LEADING BLANKS>><<MPEIV>>45480000
          IF BPS0="#" THEN                                     <<MPEIV>>45482000
            BEGIN  <<DS DEVICE>>                               <<MPEIV>>45484000
            DSDEVICE := TRUE;                                  <<MPEIV>>45486000
            @BPINBUF := TOS+1;                                 <<MPEIV>>45488000
            DRTN := INVAL(@REQDRTN);                           <<MPEIV>>45490000
            IF <= THEN                                         <<MPEIV>>45492000
              BEGIN <<NOT FOLLOWED BY CR>>                     <<MPEIV>>45494000
              MESSAGE(M2453);                                  <<MPEIV>>45496000
              GO REQDRTN;                                      <<MPEIV>>45498000
              END;                                             <<MPEIV>>45500000
            IF NOT NON'DS'LDEV(DRTN) THEN                      <<03599>>45504000
              BEGIN <<DS DEV LINKED TO DS OR NON EXISTING DEV>><<MPEIV>>45506000
              MESSAGE(M114); << ILLEGAL MASTER DEVICE >>       <<MPEIV>>45508000
              GO REQDRTN;                                      <<MPEIV>>45510000
              END;                                             <<MPEIV>>45512000
            END                                                <<MPEIV>>45514000
          ELSE                                                 <<MPEIV>>45516000
            BEGIN <<REAL DEVICE>>                              <<MPEIV>>45518000
            DRTN := INVAL(@REQDRTN);                           <<MPEIV>>45520000
            IF <= OR 1<=DRTN<=LOWESTDRT-1 OR                   <<MPEIV>>45522000
        DRTN<0 OR DRTN > MAXDRT THEN                           <<03002>>45524000
              BEGIN                                            <<MPEIV>>45526000
              MESSAGE(M2453);                                  <<MPEIV>>45528000
              GO REQDRTN;                                      <<MPEIV>>45530000
              END;                                             <<MPEIV>>45532000
            END;                                               <<MPEIV>>45534000
                                                               <<03599>>45538000
          IF LDEV'EXISTS(LDEV) THEN                            <<03599>>45540000
            BEGIN  << OLD LDEV IS REAL OR CS DEVICE >>         <<03599>>45542000
              IF DRTN=0 AND LDEV=HLDEV THEN                    <<03599>>45544000
                BEGIN  << MUST COMPACT TABLES >>               <<03599>>45546000
                  DO UNTIL LDEV'EXISTS(HLDEV:=HLDEV-1)         <<03599>>45548000
                           OR HLDEV=0;                         <<03599>>45550000
                  TOS:=HLDEV-LDEV;                             <<03599>>45552000
                  ASSEMBLE(DUP,DDUP);<<# OF LDEV'S ELIMINATED>><<MPEIV>>45554000
                  LPDTINCR := TOS*LPDTSIZE;                    <<MPEIV>>45556000
                  LDTINCR := TOS*LDTSIZE;                      <<MPEIV>>45558000
                  DVRTABINCR := TOS*DVRSIZE;                   <<MPEIV>>45560000
                  LDTXINCR := TOS*LDTXSIZE;                    <<MPEIV>>45562000
                  TYPE:=LDT(LDEV*LDTSIZE+LDT2).TYP;            <<MPEIV>>45564000
                  MOVEDLTABLES;  <<COMPACT TABLES>>            <<MPEIV>>45566000
                  GO KILLCSDEV;                                <<MPEIV>>45568000
                END                                            <<MPEIV>>45570000
              ELSE                                             <<MPEIV>>45572000
                BEGIN  <<ZERO ENTRY>>                          <<MPEIV>>45574000
                  TOS := @DVRTAB(LDEV*DVRSIZE);                <<MPEIV>>45576000
                  PS0 := 0;                                    <<MPEIV>>45578000
                  ASSEMBLE(DUP,INCB);                          <<MPEIV>>45580000
                  TOS := DVRSIZE-1;                            <<MPEIV>>45582000
                  ASSEMBLE(MOVE 3); <<ZERO DRIVER TABLE ENTRY>><<MPEIV>>45584000
                  TOS := @LPDT(LDEV*LPDTSIZE);                 <<MPEIV>>45586000
                  PS0 := 0;                                    <<MPEIV>>45588000
                  ASSEMBLE(DUP,INCB);                          <<MPEIV>>45590000
                  TOS := LPDTSIZE-1;                           <<MPEIV>>45592000
                  ASSEMBLE(MOVE 3);  << ZERO LPDT ENTRY >>     <<MPEIV>>45594000
                  TOS := @LDT(LDEV*LDTSIZE);                   <<MPEIV>>45596000
                  TYPE := PS0(LDT2).TYP;                       <<MPEIV>>45598000
                  PS0 := 0;                                    <<MPEIV>>45600000
                  ASSEMBLE(DUP,INCB);                          <<MPEIV>>45602000
                  TOS := LDTSIZE-1;                            <<MPEIV>>45604000
                  ASSEMBLE(MOVE 3);  << ZERO LDT ENTRY >>      <<MPEIV>>45606000
                  ZEROLDTX;   <<CALL TO SUBROUTINE>>           <<04328>>45610000
  KILLCSDEV: IF CSDEV17<=TYPE<=CSDEV19 THEN                    <<MPEIV>>45612000
               BEGIN <<DELETE CSLDIX ENTRY>>                   <<MPEIV>>45614000
               CSTAB(X) := CSTAB(CSLDTXENTNUM)-1;              <<MPEIV>>45616000
               TOS := CSDEF(LDEV);                             <<MPEIV>>45618000
               CSDEF(X) := 0;                                  <<MPEIV>>45620000
               X := 0;                                         <<MPEIV>>45622000
               DO                                              <<MPEIV>>45624000
                 IF S0<=CSDEF(X) THEN                          <<MPEIV>>45626000
                   CSDEF(X):=CSDEF(X)-1                        <<MPEIV>>45628000
               UNTIL (X:=X+1)=CSDEFSIZE;                       <<MPEIV>>45630000
               TEMP := TOS;                                    <<MPEIV>>45632000
               @CSLDTX := @CSTAB+CSXSTART;                     <<MPEIV>>45634000
               I := -1;                                        <<MPEIV>>45636000
               WHILE (I:=I+1) < TEMP DO                        <<MPEIV>>45638000
                 @CSLDTX := CSLDTX+@CSLDTX;                    <<MPEIV>>45640000
               TEMP := CSLDTX;   <<CONTRACT CSLDTX>>           <<MPEIV>>45642000
               TOS := @CSLDTX;                                 <<MPEIV>>45644000
               TOS := S0+TEMP;                                 <<MPEIV>>45646000
               TOS := -S0+CSTAB+@CSTAB;                        <<MPEIV>>45648000
               ASSEMBLE(MOVE 3);                               <<MPEIV>>45650000
               TOS := CSTAB-TEMP;                              <<MPEIV>>45652000
               CSTAB := S0;                                    <<MPEIV>>45654000
               CSTAB(DRIVERENTPTR) := S0;                      <<MPEIV>>45656000
               CSTAB(4) := TOS;                                <<MPEIV>>45658000
               CSTABINCR := -TEMP; <<DECREASE TABLE>>          <<MPEIV>>45660000
               MOVEDLTABLES;                                   <<MPEIV>>45662000
               END;                                            <<MPEIV>>45664000
                END;                                           <<MPEIV>>45666000
              REMOVECLASSREFS;<<REMOVE REFERENCES TO THIS DEV>><<MPEIV>>45668000
              IF (TEMP := TCLASS) > 0 THEN                     <<MPEIV>>45670000
                BEGIN <<CHECK IF IN TEMPCLASS>>                <<MPEIV>>45672000
                I := 0;                                        <<MPEIV>>45674000
                INDEX := 12;                                   <<MPEIV>>45676000
                DO                                             <<MPEIV>>45678000
                  BEGIN                                        <<MPEIV>>45680000
                  J := 0;                                      <<MPEIV>>45682000
                  N := TEMPCLASS(INDEX);                       <<MPEIV>>45684000
                  WHILE(J:=J+1)<=N DO                          <<MPEIV>>45686000
                    BEGIN                                      <<MPEIV>>45688000
                    TOS := TEMPCLASS(INDEX+J); <<LDEV #>>      <<MPEIV>>45690000
                    IF TOS = LDEV THEN                         <<MPEIV>>45692000
                      BEGIN <<DELETE FROM TEMPCLASS>>          <<MPEIV>>45694000
                      IF N=1 THEN                              <<MPEIV>>45696000
                        BEGIN <<DELETE WHOLE CLASS>>           <<MPEIV>>45698000
                        TOS := @TEMPCLASS(INDEX-8);            <<MPEIV>>45700000
                        TOS := S0+10;                          <<MPEIV>>45702000
                        ASSEMBLE(DUP,NEG);                     <<MPEIV>>45704000
                        TOS := TOS+@TEMPCLASS+TCLASS(1);       <<MPEIV>>45706000
                        ASSEMBLE(MVB 3);<<MOVE REST OF TABLES>><<MPEIV>>45708000
                        TCLASS(X) := TCLASS(1)-10;             <<MPEIV>>45710000
                        TCLASS := TCLASS-1;                    <<MPEIV>>45712000
                        END                                    <<MPEIV>>45714000
                      ELSE                                     <<MPEIV>>45716000
                        BEGIN <<REMOVE LDEV FROM CLASS>>       <<MPEIV>>45718000
                        TOS := @TEMPCLASS(X);                  <<MPEIV>>45720000
                        ASSEMBLE(DUP,INCA);                    <<MPEIV>>45722000
                        TOS := N-J;                            <<MPEIV>>45724000
                        ASSEMBLE(MVB 2);<<MOVE REST OF CLASS>> <<MPEIV>>45726000
                        IF LOGICAL(N) THEN                     <<MPEIV>>45728000
                          BEGIN <<FILLER BYTE>>                <<MPEIV>>45730000
                          BPS0 := 0;                           <<MPEIV>>45732000
                          DEL;                                 <<MPEIV>>45734000
                          END                                  <<MPEIV>>45736000
                        ELSE                                   <<MPEIV>>45738000
                          BEGIN<<1 WORD DELETED-MOVE REST>>    <<MPEIV>>45740000
                          TOS := @TEMPCLASS(INDEX+N);          <<MPEIV>>45742000
                          ASSEMBLE(DUP,INCA;INCA,DUP;NEG);     <<MPEIV>>45744000
                          TOS := TOS+@TEMPCLASS+TCLASS(1);     <<MPEIV>>45746000
                          ASSEMBLE(MVB 3);                     <<MPEIV>>45748000
                          TCLASS(X) := TCLASS(1)-2;            <<MPEIV>>45750000
                          END;                                 <<MPEIV>>45752000
                        TEMPCLASS(X) := TEMPCLASS(INDEX)-1;    <<MPEIV>>45754000
                        END;                                   <<MPEIV>>45756000
                      GO CLASSESCLEAN;                         <<MPEIV>>45758000
                      END;                                     <<MPEIV>>45760000
                    END;                                       <<MPEIV>>45762000
                  TOS := N;                                    <<MPEIV>>45764000
                  ASSEMBLE(DUP,NOT);                           <<MPEIV>>45766000
                  IF TOS THEN TOS := TOS+1; <<FILLER BYTE>>    <<MPEIV>>45768000
                  INDEX := TOS+INDEX+9;                        <<MPEIV>>45770000
                  END                                          <<MPEIV>>45772000
                UNTIL(I:=I+1)=TEMP;                            <<MPEIV>>45774000
              END;                                             <<MPEIV>>45776000
  CLASSESCLEAN:                                                <<MPEIV>>45778000
              IF DRTN=0 THEN GO REQLDEV;                       <<MPEIV>>45780000
            END                                                <<MPEIV>>45782000
          ELSE IF DRTN=0 THEN                                  <<MPEIV>>45784000
            BEGIN                                              <<MPEIV>>45786000
              MESSAGE(M2410);  <<NO SUCH DEVICE>>              <<MPEIV>>45788000
              GO REQLDEV;                                      <<MPEIV>>45790000
            END                                                <<MPEIV>>45792000
          ELSE IF LDEV>HLDEV THEN                              <<MPEIV>>45794000
            BEGIN  <<MUST EXPAND TABLES>>                      <<MPEIV>>45796000
              TOS := LDEV-HLDEV;                               <<MPEIV>>45798000
              ASSEMBLE(DUP,DDUP);                              <<MPEIV>>45800000
              LPDTINCR := TOS*LPDTSIZE;                        <<MPEIV>>45802000
              LDTINCR := TOS*LDTSIZE;                          <<MPEIV>>45804000
              LDTXINCR := TOS*LDTXSIZE;                        <<MPEIV>>45806000
              DVRTABINCR := TOS*DVRSIZE;                       <<MPEIV>>45808000
              MOVEDLTABLES;                                    <<MPEIV>>45810000
              HLDEV := LDEV;                                   <<MPEIV>>45812000
             END                                               <<04328>>45814000
           ELSE <<ADDING AN LDEV THAT DIDNT PREVIOUSLY EXIST>> <<04328>>45816000
             ZEROLDTX;    <<CALL TO SUBROUTINE>>               <<04328>>45818000
          @DVRENT := @DVRTAB(LDEV*DVRSIZE);                    <<MPEIV>>45820000
          @LDTENT := @LDT(LDEV*LDTSIZE);                       <<MPEIV>>45822000
          @LDTXENT := @LDTX(LDEV*LDTXSIZE);                    <<MPEIV>>45824000
          @LPDTENT := @LPDT(LDEV*LPDTSIZE);                    <<MPEIV>>45826000
 REQUNIT:UNIT:=GETVAL(M2013,0,MAXUNIT,1);<<UNIT#>>             <<03002>>45828000
          TOS := UNIT;                                         <<MPEIV>>45830000
          IF DSDEVICE THEN                                     <<MPEIV>>45832000
            BEGIN                                              <<MPEIV>>45834000
             DVRENT(DVR1).DSBIT:= 1;                           <<03002>>45836000
            DVRENT(DVR1).DSDRTN := DRTN;                       <<MPEIV>>45838000
            END                                                <<MPEIV>>45840000
          ELSE TOS.DRTFIELD := DRTN;                           <<03002>>45842000
          DVRENT := TOS;                                       <<MPEIV>>45844000
          DVRENT(DVR1).DVRCHAN := GETVAL(M2014,0,4,1);<<CHAN>> <<MPEIV>>45846000
          LDTENT(LDT3).FILEBIT := 1; <<BELONGS TO FILE SYSTEM>><<MPEIV>>45848000
          TYPE := GETVAL(M2015,0,63,1);  << TYPE? >>           <<03550>>45852000
          IF CSDEV AND UNIT<>0 OR TYPE=SDISC                   <<03550>>45854000
          OR TYPE=FDISC THEN                                   <<03550>>45856000
            BEGIN                                              <<03550>>45858000
            MESSAGE(M2140);   << ILLEGAL TYPE OR UNIT >>       <<03550>>45860000
            GO REQUNIT;                                        <<03550>>45862000
            END;                                               <<03550>>45864000
          LDTENT(LDT2).TYP := TYPE;  << PUT TYPE IN LDT >>     <<03550>>45866000
          IF CSDEV THEN                                        <<MPEIV>>45868000
            BEGIN     <<CS DEVICE>>                            <<MPEIV>>45870000
            LDTENT(LDT2).CSBIT := 1;                           <<MPEIV>>45872000
            CSTAB(X) := CSTAB(CSLDTXENTNUM)+1;                 <<MPEIV>>45874000
            @CSLDTX := @LBUF(512);                             <<MPEIV>>45876000
            CSLDTX := 0;                                       <<MPEIV>>45878000
            MOVE CSLDTX(1) := CSLDTX,(500);                    <<MPEIV>>45880000
            CSINDX := CONTRSTART;                              <<MPEIV>>45882000
            CSLDTXEXP:=1;  <<SET TABLE EXPANDED BIT>>          <<MPEIV>>45884000
            IF TYPE=CSDEV17 THEN CSLDTXMAX'DUMPS:=20;          <<MPEIV>>45886000
            END;                                               <<MPEIV>>45888000
  REQSTYP:SUBTYP := GETVAL(M2016,0,15,1);  << SUBTYPE? >>      <<03550>>45892000
          IF (TYPE=CSDEV17 OR TYPE=CSDEV18) AND                <<03550>>45894000
          SUBTYP<>0 AND SUBTYP<>1 AND                          <<03550>>45896000
          SUBTYP<>3 AND SUBTYP<>7 OR                           <<03550>>45898000
          TYPE=CSDEV19 AND SUBTYP<>0 AND SUBTYP<>3 THEN        <<03550>>45900000
            BEGIN                                              <<03550>>45902000
            MESSAGE(M2141);  << ILLEGAL TYPE OR SUBTYPE >>     <<03550>>45904000
            GO REQSTYP;                                        <<03550>>45906000
            END;                                               <<03550>>45908000
          LPDTENT(LPDT1).SUBTYPE := SUBTYP;                    <<03550>>45910000
          IF TYPE=TERMDEVTYPE OR                               <<03550>>45912000
          TYPE=32 AND                                          <<03550>>45914000
          (SUBTYP=14 OR SUBTYP=15) THEN                        <<03550>>45916000
            BEGIN                                              <<MPEIV>>45918000
            TOS := GETVAL(M2017,0,%36,2);   <<TERM TYPE>>      <<MPEIV>>45920000
            IF = THEN                                          <<MPEIV>>45922000
              BEGIN                                            <<MPEIV>>45924000
              DEL;                                             <<MPEIV>>45926000
              TOS := %37;                                      <<MPEIV>>45928000
              END;                                             <<MPEIV>>45930000
            LDTENT(LDT4).TERMTYP := TOS;                       <<MPEIV>>45932000
  REQSPEED: I := GETVAL(M2018,0,3840,2);  <<TERM SPEED>>       <<03004>>45936000
$IF X1=ON  << ********** SERIES 33,44,55 UNIQUE ********** >>  <<03004>>45940000
            IF I = 0 THEN I := 240;  << DEFAULT TO 240 >>      <<03004>>45942000
$IF        << ******** RETURNING TO COMMON CODE ********** >>  <<03004>>45944000
                                                               <<03708>>45946000
            << CALL CHECKSPEED TO CHECK TERM. SPEED REPLY >>   <<03004>>45948000
            IF CHECKSPEED( I, SPEEDCDE ) THEN                  <<03004>>45950000
                                                               <<03708>>45952000
              << SUBTYPES > 3 ARE TERMINALS WHICH ARE NON- >>  <<03708>>45954000
              << SPEEDSENSING, THEREFORE A VALID SPEED     >>  <<03708>>45956000
              << MUST BE ENTERED.                          >>  <<03708>>45958000
                                                               <<03708>>45960000
              IF NOT (SPEEDCDE = 0 LAND SUBTYP > 3) THEN       <<03708>>45962000
                 GOTO SPEEDOK;                                 <<03708>>45964000
                                                               <<03004>>45966000
            MESSAGE( M130);  << NOT A SUPPORTED SPEED    >>    <<03004>>45968000
            GO REQSPEED;     << REQUEST TERM SPEED AGAIN >>    <<03004>>45970000
  SPEEDOK:  LDTXENT.TERMSPEED := SPEEDCDE ;                    <<03004>>45972000
              END;      << TERMINAL SPECIFIC PROMPTS >>        <<03708>>45978000
          IF CSDEVICE THEN                                     <<01587>>45980000
            BEGIN                                              <<01587>>45982000
            IF TYPE=CSDEV19 THEN                               <<MPEIV>>45984000
              CSLDTXHSI'CHAN:=GETVAL(M2101,1,15,1);<<PORT MSK>><<MPEIV>>45986000
            IF TYPE<>CSDEV17 THEN                              <<MPEIV>>45988000
            BEGIN                                              <<MPEIV>>45990000
            CSLDTXPROTOCOL:=GETVAL(M2102,1,255,1);<<PROTOCOL>> <<MPEIV>>45992000
            CSLDTXMODE:= GETVAL(M2103,1,15,1);<<LOCAL MODE>>   <<MPEIV>>45994000
            CSLDTXCODE :=GETVAL(M2104,1,63,1);<<XMISSION CODE>><<MPEIV>>45996000
            END;                                               <<MPEIV>>45998000
            TOS := GETVAL(M2105,0,32767,2); <<RECEIVE TIMEOUT>><<MPEIV>>46000000
            IF = THEN                                          <<MPEIV>>46002000
              BEGIN  <<CARRIAGE RETURN>>                       <<MPEIV>>46004000
              DEL;                                             <<MPEIV>>46006000
              TOS := 20;                                       <<MPEIV>>46008000
              END;                                             <<MPEIV>>46010000
            CSLDTXRECV'TIMEOUT := TOS;                         <<MPEIV>>46012000
            TOS := GETVAL(M2106,0,32767,2);  <<LOCAL TIMEOUT>> <<MPEIV>>46014000
            IF = THEN                                          <<MPEIV>>46016000
              BEGIN  <<CARRIAGE RETURN>>                       <<MPEIV>>46018000
              DEL;                                             <<MPEIV>>46020000
              TOS := 60;                                       <<MPEIV>>46022000
              END;                                             <<MPEIV>>46024000
            CSLDTXLOCAL'TIMEOUT := TOS;                        <<MPEIV>>46026000
            TOS := GETVAL(M2107,0,32767,2);                    <<MPEIV>>46028000
            IF = THEN                                          <<MPEIV>>46030000
              BEGIN  <<CR>>                                    <<MPEIV>>46032000
              DEL;                                             <<MPEIV>>46034000
              TOS := 900;                                      <<MPEIV>>46036000
              END;                                             <<MPEIV>>46038000
            CSLDTXCONCT'TIMEOUT := TOS;                        <<MPEIV>>46040000
            IF HARDWIRED THEN GO SPEEDCH;                      <<MPEIV>>46042000
            IF NOT(MODEM) OR SWITCHED THEN                     <<MPEIV>>46044000
              BEGIN                                            <<MPEIV>>46046000
  REQDIAL:    MESSAGE(-M2108);  <<DIAL FACILITY?>>             <<MPEIV>>46048000
              READINPUT;                                       <<MPEIV>>46050000
              SCAN BINBUF WHILE BLANK,1;                       <<MPEIV>>46052000
              ASSEMBLE(DUP,DUP);                               <<MPEIV>>46054000
              MOVE * := * WHILE ANS;                           <<MPEIV>>46056000
              IF NOCARRY AND (BPS0<>"N") THEN                  <<MPEIV>>46058000
                 IF BPS0 = "Y" THEN                            <<MPEIV>>46060000
                    BEGIN                                      <<MPEIV>>46062000
                    CSLDTXDIAL := 1;                           <<MPEIV>>46064000
                    END                                        <<MPEIV>>46066000
                 ELSE                                          <<MPEIV>>46068000
                    BEGIN                                      <<MPEIV>>46070000
                    @BPINBUF := @BINBUF;                       <<MPEIV>>46072000
                    TOS:=INVAL(@DIALERR);                      <<MPEIV>>46074000
                    IF <= THEN                                 <<MPEIV>>46076000
                       BEGIN                                   <<MPEIV>>46078000
                       DEL;                                    <<MPEIV>>46080000
                       GO DIALERR;                             <<MPEIV>>46082000
                       END;                                    <<MPEIV>>46084000
                    IF 0<=S0<=255 THEN                         <<MPEIV>>46086000
                       BEGIN                                   <<MPEIV>>46088000
                       CSLDTXDIAL := 1;                        <<MPEIV>>46090000
                       CSLDTXAUTO'DIAL'LDN := TOS;             <<MPEIV>>46092000
                       END;                                    <<MPEIV>>46094000
                    END;                                       <<MPEIV>>46096000
              DEL; GO REQANSW;                                 <<MPEIV>>46098000
  DIALERR:    DEL;                                             <<MPEIV>>46100000
              MESSAGE(1);                                      <<MPEIV>>46102000
              GO REQDIAL;                                      <<MPEIV>>46104000
  REQANSW:    GETYESNO(@REQDUSP,M2109);  <<ANSWER FACILITY?>>  <<MPEIV>>46106000
              GETYESNO(@MANUAL,M2110);   <<AUTOMATIC ANSWER?>> <<MPEIV>>46108000
              CSLDTXANSWER := AUTOANSWER;                      <<MPEIV>>46110000
              GO REQDUSP;                                      <<MPEIV>>46112000
  MANUAL:     CSLDTXANSWER := MANLANSWER;                      <<MPEIV>>46114000
              END;                                             <<MPEIV>>46116000
  REQDUSP:  GETYESNO(@SPEEDCH,M2111); <<DUAL SPEED?>>          <<MPEIV>>46118000
            CSLDTXDUAL'SPEED := 1;                             <<MPEIV>>46120000
            GETYESNO(@REQTRSP,M2112); <<HALF SPEED?>>          <<MPEIV>>46122000
            CSLDTXHALF'SPEED := 1 ;                            <<MPEIV>>46124000
            GO REQTRSP;                                        <<MPEIV>>46126000
  SPEEDCH:  GETYESNO(@REQTRSP,M2113); <<SPEED CHANGEABLE?>>    <<MPEIV>>46128000
            CSLDTXSPEEDCHNGBLE:= 1;                            <<MPEIV>>46130000
  REQTRSP:  MESSAGE(-M2114);  <<TRANSMISSION SPEED?>>          <<MPEIV>>46132000
            READINPUT;                                         <<MPEIV>>46134000
            TOS := 0D;                                         <<MPEIV>>46136000
            TOS := @TRANSER;                                   <<MPEIV>>46138000
            TOS := DINVAL(*);                                  <<MPEIV>>46140000
            IF <= THEN                                         <<MPEIV>>46142000
  TRANSER:    BEGIN                                            <<MPEIV>>46144000
              MESSAGE(M2453);                                  <<MPEIV>>46146000
              GO REQTRSP;                                      <<MPEIV>>46148000
              END;                                             <<MPEIV>>46150000
            ASSEMBLE(DDUP);                                    <<MPEIV>>46152000
            CSLDTXINSPEED := DS1;                              <<MPEIV>>46154000
            CSLDTXOUTSPEED := TOS;                             <<MPEIV>>46156000
            CSLDTXXMSN'MODE:=GETVAL(M2115,0,3,1);<<XMISSION>>  <<MPEIV>>46158000
            CSLDTXPBUFFSIZE:=GETVAL(M2116,1,4095,1);<<PREFER >><<04255>>46160000
            GETYESNO(@REQDOP,M2117); <<DRIVER CHANGEABLE?>>    <<MPEIV>>46162000
            CSLDTXDRCHANGEABLE := 1;                           <<MPEIV>>46164000
  REQDOP:   CSLDTXDOPTIONS:=GETVAL(M2118,0,32767,1);<<DVR OPT>><<MPEIV>>46166000
            GO REQDVR;                                         <<MPEIV>>46168000
            END;                                               <<MPEIV>>46170000
          LDTENT(LDT2).RECW := GETVAL(M2019,1,255,1);<<REC WI>><<MPEIV>>46172000
                                   <<RECORD WIDTH#?>>          <<MPEIV>>46174000
  REQODEV:MESSAGE(-M2020);   <<OUTPUT DEVICE?>>                <<MPEIV>>46176000
          READINPUT;                                           <<MPEIV>>46178000
          TOS := INVAL(@TRYSTR);                               <<MPEIV>>46180000
          IF <= THEN GOTO ODEVERR;                             <<MPEIV>>46182000
          IF 0<=S0<=255 THEN GO SETODEV;                       <<MPEIV>>46184000
  ODEVERR:DEL;                                                 <<MPEIV>>46186000
  ODEVERR1:MESSAGE(M2453);                                     <<MPEIV>>46188000
          GO REQODEV;                                          <<MPEIV>>46190000
  TRYSTR: @BPINBUF := @BINBUF;                                 <<MPEIV>>46192000
          GETSTR(DEVCLASS,@ODEVERR1,1,8);                      <<MPEIV>>46194000
          TOS := CLINDEX(DEVCLASS);   <<GET CLASS INDEX>>      <<MPEIV>>46196000
          IF S0=0 THEN PUTINTEMPCLASS(LDEV);<<NO SUCH CLASS>>  <<MPEIV>>46198000
          LDTENT(LDT3).OUTCL := 1;                             <<MPEIV>>46200000
  SETODEV:LDTENT(LDT3).OUTDEV := TOS;                          <<MPEIV>>46202000
            << ACCEPT JOBS/SESSIONS >>                         <<MPEIV>>46204000
          LPDTENT(LPDT1).AJOBS := LGETYESNO(M2021);            <<MPEIV>>46206000
            << ACCEPT DATA >>                                  <<MPEIV>>46208000
          LPDTENT(LPDT1).ADATA := LGETYESNO(M2022);            <<MPEIV>>46210000
            << INTERACTIVE >>                                  <<MPEIV>>46212000
          LPDTENT(LPDT1).INTRACT := LGETYESNO(M2023);          <<MPEIV>>46214000
            << DUPLICATIVE >>                                  <<MPEIV>>46216000
          LPDTENT(LPDT1).DUPLIC := LGETYESNO(M2024);           <<01867>>46218000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<02022>>46220000
          IF TYPE=DISC0 OR TYPE=DISC1 THEN                     <<02022>>46222000
            LDTXENT.LDTX'SA := LGETYESNO(M2029); <<SEEKAHEAD?>><<02022>>46224000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<02022>>46226000
          TOS := @REQDVR;                                      <<MPEIV>>46228000
          GETYESNO(*,M2025);    <<INITIALLY SPOOLED>>          <<MPEIV>>46230000
          IF 8<=LDTENT(LDT2).TYP<=15 THEN                      <<MPEIV>>46232000
   INONLY:  LDTENT(LDT3).SPOOLST := 1                          <<MPEIV>>46234000
          ELSE IF 32<=LDTENT(LDT2).TYP<=39 THEN                <<MPEIV>>46236000
                 BEGIN                                         <<MPEIV>>46238000
   OUTONLY:      LDTENT(LDT3).SPOOLST := 2;                    <<MPEIV>>46240000
                 LDTENT(LDT4).SPOOLQUE := 1;                   <<MPEIV>>46242000
                 END                                           <<MPEIV>>46244000
               ELSE IF 16<=LDTENT(LDT2).TYP<=31 THEN           <<MPEIV>>46246000
                      BEGIN                                    <<MPEIV>>46248000
   ASKAGAIN:          MESSAGE(-M2308);                         <<MPEIV>>46250000
                      READINPUT;                               <<MPEIV>>46252000
                      GETSTR(BBUF,@ASKAGAIN,1,3);              <<MPEIV>>46254000
                      IF BBUF ="IN " THEN GO INONLY            <<MPEIV>>46256000
                        ELSE IF BBUF  ="OUT" THEN GO OUTONLY;  <<MPEIV>>46258000
                      MESSAGE(M2453);                          <<MPEIV>>46260000
                      GO ASKAGAIN;                             <<MPEIV>>46262000
                      END;                                     <<MPEIV>>46264000
  REQDVR: MESSAGE(-M2026); <<DRIVER NAME? >>                   <<MPEIV>>46266000
          READINPUT;                                           <<MPEIV>>46268000
          SCAN BPINBUF WHILE BLANK,1; <<DELETE LEADING BLANKS>><<MPEIV>>46270000
          IF BPS0="*" THEN                                     <<MPEIV>>46272000
            BEGIN   <<CORE RESIDENT DRIVER>>                   <<MPEIV>>46274000
              TOS := TOS+1;                                    <<MPEIV>>46276000
              IF CSDEVICE OR DSDEVICE THEN MESSAGE(M2406)      <<MPEIV>>46278000
                ELSE DVRENT(DVR1).CRBIT:=1;  <<CORE RESIDENT>> <<MPEIV>>46280000
            END;                                               <<MPEIV>>46282000
          @BPINBUF := TOS;                                     <<MPEIV>>46284000
          GETSTR(DVRENT(DVR2),@REQDVR,1,8); <<GET DRIVER NAME>><<MPEIV>>46286000
  IF CSDEVICE THEN                                             <<MPEIV>>46288000
     BEGIN                                                     <<MPEIV>>46290000
     IF SWITCHED THEN                                          <<MPEIV>>46292000
        BEGIN                                                  <<MPEIV>>46294000
            GETYESNO(@REQLID,M2120);<<PHONE LIST?>>            <<MPEIV>>46296000
          TOS := CSINDX;                                       <<MPEIV>>46298000
          CSLDTXPHLISTPTR := S0;                               <<MPEIV>>46300000
          @PHONE :=(TOS+@CSLDTX)&LSL(1);                       <<04306>>46302000
          PHINX := 4;   <<POINT PAST SEQUENCE LENGTH>>         <<MPEIV>>46304000
          J:=0;                                                <<MPEIV>>46306000
  PHONENB:MESSAGE(-M2121);   <<PHONE NUMBER>>                  <<MPEIV>>46308000
          READINPUT;                                           <<MPEIV>>46310000
          I:=GETPHNB(@PHONENB,BTEMP,"-");                      <<MPEIV>>46312000
          IF > THEN                                            <<MPEIV>>46314000
            BEGIN                                              <<MPEIV>>46316000
            MOVE PHONE(PHINX):=BTEMP,(I);                      <<MPEIV>>46318000
            PHONE(X:=X-1) := I;                                <<MPEIV>>46320000
            PHINX := PHINX+I+1;<<POINT PAST NEXT SEQUENCE LEN>><<MPEIV>>46322000
            J:=J+1;                                            <<MPEIV>>46324000
            GO PHONENB;                                        <<MPEIV>>46326000
            END;                                               <<MPEIV>>46328000
          IF J<=0 THEN                                         <<MPEIV>>46330000
           BEGIN  <<NO PHONE LIST>>                            <<MPEIV>>46332000
           CSLDTXPHLISTPTR := 0;                               <<MPEIV>>46334000
           END                                                 <<MPEIV>>46336000
          ELSE                                                 <<MPEIV>>46338000
            BEGIN                                              <<MPEIV>>46340000
            PHONE(NUMSEQ) := J; <<# OF PHONE SEQUENCES>>       <<MPEIV>>46342000
            TOS := PHINX&LSR(1);                               <<MPEIV>>46344000
            CSLDTX(CSINDX) := S0-1; <<SIZE OF LIST IN WORDS>>  <<MPEIV>>46346000
            CSINDX := TOS+CSINDX;                              <<MPEIV>>46348000
            END;                                               <<MPEIV>>46350000
        END;                                                   <<MPEIV>>46352000
     IF CONTENTION OR LDTENT(LDT2).TYP=CSDEV17 THEN            <<MPEIV>>46354000
                                                                        46356000
        BEGIN                                                  <<MPEIV>>46358000
        IF SWITCHED THEN                                       <<MPEIV>>46360000
          BEGIN                                                <<MPEIV>>46362000
  REQLID: TOS:=CSINDX;                                         <<MPEIV>>46364000
          CSLDTXIDLISTPTR := S0;                               <<MPEIV>>46366000
          @IDLIST := (TOS+@CSLDTX)&LSL(1);                     <<04306>>46368000
          IDINX := 4;                                          <<MPEIV>>46370000
          J := 0;                                              <<MPEIV>>46372000
          I:=0;                                                <<MPEIV>>46374000
  REQLIDS:MESSAGE(-M2122); <<LOCAL ID SEQUENCE?>>              <<MPEIV>>46376000
          READINPUT;                                           <<MPEIV>>46378000
          SCAN BPINBUF WHILE BLANK,1;                          <<MPEIV>>46380000
          IF CARRY THEN                                        <<MPEIV>>46382000
            BEGIN                                              <<MPEIV>>46384000
            DEL;                                               <<MPEIV>>46386000
            IDLIST(IDINX-1):=0;<<NULL LOCAL ID>>;              <<MPEIV>>46388000
            IDINX:=IDINX+1;   <<POINT TO 1ST REMOTE ID>>       <<MPEIV>>46390000
            END                                                <<MPEIV>>46392000
          ELSE                                                 <<MPEIV>>46394000
            BEGIN                                              <<MPEIV>>46396000
            TOS := GETSEQ(@REQLIDS,BTEMP);                     <<MPEIV>>46398000
            DUPLICATE;                                         <<MPEIV>>46400000
            TOS := TOS LAND %77;                               <<MPEIV>>46402000
            TEMP := TOS;          <<LENGTH>>                   <<MPEIV>>46404000
            IDLIST(IDINX-1):=TOS;       <<LENGTH AND IN TYPE>> <<MPEIV>>46406000
            MOVE IDLIST(IDINX):=BTEMP,(TEMP);                  <<MPEIV>>46408000
            IDINX := IDINX+TEMP+1;  <<BUMP INDEX>>             <<MPEIV>>46410000
            I := I+1;                                          <<MPEIV>>46412000
            END;                                               <<MPEIV>>46414000
  REQRIDS:  MESSAGE(-M2123); <<REMOTE ID SEQUENCE?>>           <<MPEIV>>46416000
          READINPUT;                                           <<MPEIV>>46418000
          TOS := GETSEQ(@REQRIDS,BTEMP);                       <<MPEIV>>46420000
          IF S0=0 THEN                                         <<MPEIV>>46422000
            BEGIN <<NO INPUT>>                                 <<MPEIV>>46424000
            DEL;                                               <<MPEIV>>46426000
            IF I<=0 THEN                                       <<MPEIV>>46428000
              BEGIN     <<NULL ID LIST>>                       <<MPEIV>>46430000
              CSLDTXIDLISTPTR := 0;                            <<MPEIV>>46432000
              GO REQCLSS;                                      <<MPEIV>>46434000
              END;                                             <<MPEIV>>46436000
            IDLIST(NUMSEQ) := I;                               <<MPEIV>>46438000
            TOS := IDINX&LSR(1);                               <<MPEIV>>46440000
            CSLDTX(CSINDX) := S0-1;  <<SIZE OF LIDT IN WORDS>> <<MPEIV>>46442000
            CSINDX := TOS+CSINDX;                              <<MPEIV>>46444000
            GO REQCLSS;                                        <<MPEIV>>46446000
            END;                                               <<MPEIV>>46448000
          DUPLICATE;                                           <<MPEIV>>46450000
          TOS := TOS LAND %77;  <<LENGTH>>                     <<MPEIV>>46452000
          TEMP := TOS;                                         <<MPEIV>>46454000
          IDLIST(IDINX-1) := TOS;                              <<MPEIV>>46456000
          MOVE IDLIST(IDINX) := BTEMP,(TEMP);                  <<MPEIV>>46458000
          IDINX := IDINX+TEMP+1;                               <<MPEIV>>46460000
          I := I+1;                                            <<MPEIV>>46462000
          GO REQRIDS;                                          <<MPEIV>>46464000
          END;                                                 <<MPEIV>>46466000
        END                                                    <<MPEIV>>46468000
     ELSE                                                      <<MPEIV>>46470000
        IF CONTROLST THEN                                      <<MPEIV>>46472000
          BEGIN                                                <<MPEIV>>46474000
  REQIDLAY: CSLDTX(CSINDX+INTCOMDELAY)                         <<MPEIV>>46476000
               :=GETVAL(M2124,0,32767,1);<<INTRCOMPONNT DELAY>><<MPEIV>>46478000
            TOS := GETVAL(M2125,0,32767,1);<<#OF POLLS REPEAT>><<MPEIV>>46480000
            CSLDTX(CSINDX) := S0;                              <<MPEIV>>46482000
            IF TOS=0 THEN GO REQCPST;                          <<MPEIV>>46484000
  REQCIRP:  CSLDTX(CSINDX+CIRPDELAY)                           <<MPEIV>>46486000
               := GETVAL(M2126,0,32767,1);<<CIRC. POLL DELAY>> <<MPEIV>>46488000
  REQCPST:  I := GETVAL(M2127,0,255,1);<<COMPONENTS/STATION>>  <<MPEIV>>46490000
  REQNCOM:  N := GETVAL(M2128,0,63,1);   <<# OF COMPONENTS>>   <<MPEIV>>46492000
            CSLDTXCONTPTR:=CSINDX;                             <<MPEIV>>46494000
            IF CONTROLST THEN CSINDX:=CSINDX+CONSEQSTART       <<MPEIV>>46496000
            ELSE CSINDX:=CSINDX+1; <<TRIBUTARY>>               <<MPEIV>>46498000
            @BCSLDTX:=@CSLDTX&LSL(1);<<BYTE PTR FOR SEQUENCES>><<04306>>46500000
            BINDX := CSINDX&LSL(1);<<INDEX FOR BYTE ARRAY>>    <<MPEIV>>46502000
            IF CONTROLST THEN BCSLDTX(BINDX-2):=(N+I-1)/I;     <<MPEIV>>46504000
               <<DETERMINE # OF STATIONS IF CONTROL STATION>>  <<MPEIV>>46506000
            BCSLDTX(BINDX-1) := N;    <<# OF COMPONENTS>>      <<MPEIV>>46508000
            LASTPOLLENT := 0;                                  <<MPEIV>>46510000
            I := -1;                                           <<MPEIV>>46512000
            WHILE(I:=I+1)<N  DO                                <<MPEIV>>46514000
              BEGIN                                            <<MPEIV>>46516000
              TOS := GETVAL(M2129,0,2,1);<<COMPONENT TYPE>>    <<MPEIV>>46518000
              BCSLDTX(BINDX) := S0;                            <<MPEIV>>46520000
              IF TOS<>2 OR NOT(CONTROLST) THEN                 <<MPEIV>>46522000
                GO REQCOMPSEQ;                                 <<MPEIV>>46524000
              GETYESNO(@REQCOMPSEQ,M2130);<<COMPONENT IN POLL>><<MPEIV>>46526000
              IF LASTPOLLENT=0  THEN                           <<MPEIV>>46528000
                 BEGIN                                         <<MPEIV>>46530000
                 CSLDTX(CONTRSTART+FIRSTCOMP) := I;            <<MPEIV>>46532000
                 LASTPOLLENT := BINDX;                         <<MPEIV>>46534000
                 TOS := BCSLDTX(BINDX);                        <<MPEIV>>46536000
                 TOS.(8:6) := I;                               <<MPEIV>>46538000
                 BCSLDTX(X) := TOS;                            <<MPEIV>>46540000
                 END                                           <<MPEIV>>46542000
              ELSE                                             <<MPEIV>>46544000
                 BEGIN                                         <<MPEIV>>46546000
                 TOS := BCSLDTX(LASTPOLLENT);                  <<MPEIV>>46548000
                 TOS.(8:6) := I;                               <<MPEIV>>46550000
                 BCSLDTX(X) := TOS;                            <<MPEIV>>46552000
                 LASTPOLLENT := BINDX;                         <<MPEIV>>46554000
                 END;                                          <<MPEIV>>46556000
  REQCOMPSEQ: MESSAGE(-M2131); <<COMPONENT SEQUENCE?>>         <<MPEIV>>46558000
              READINPUT;                                       <<MPEIV>>46560000
              TOS := GETSEQ(@REQCOMPSEQ,BTEMP);                <<MPEIV>>46562000
              IF S0=0 THEN                                     <<MPEIV>>46564000
                BEGIN                                          <<MPEIV>>46566000
                DEL;                                           <<MPEIV>>46568000
  BADSEQ:       MESSAGE(M2453);                                <<MPEIV>>46570000
                GO REQCOMPSEQ;                                 <<MPEIV>>46572000
                END;                                           <<MPEIV>>46574000
              DUPLICATE;                                       <<MPEIV>>46576000
              TOS := TOS LAND %77;<<LENGTH>>                   <<MPEIV>>46578000
              IF S0>8 THEN                                     <<MPEIV>>46580000
                BEGIN                                          <<MPEIV>>46582000
                DDEL;                                          <<MPEIV>>46584000
                GOTO BADSEQ;                                   <<MPEIV>>46586000
                END;                                           <<MPEIV>>46588000
              DUPLICATE;                                       <<MPEIV>>46590000
              TOS := @BCSLDTX+BINDX+2; <<SEQUENCE START>>      <<MPEIV>>46592000
              TOS := @BTEMP;   <<GET READY FOR MOVE BYTES>>    <<MPEIV>>46594000
              ASSEMBLE(CAB;MVB 3;XCH); <<ROVE SEQ INTO CSLDTX>><<MPEIV>>46596000
              BCSLDTX(BINDX+1) := TOS;  <<IN TYPE AND LENGTH>> <<MPEIV>>46598000
              BINDX := TOS+BINDX+2;<<POINT PAST THIS SEQUENCE>><<MPEIV>>46600000
              END;                                             <<MPEIV>>46602000
            IF N>0 THEN CSINDX := (BINDX+1)&LSR(1);            <<MPEIV>>46604000
          END;                                                 <<MPEIV>>46606000
     END;                                                      <<MPEIV>>46608000
  REQCLSS:MESSAGE(-M2027);  <<DEVICE CLASSES>>                 <<MPEIV>>46610000
          READINPUT;                                           <<MPEIV>>46612000
  NEXTCLASS:                                                   <<MPEIV>>46614000
          MORE := FALSE;                                       <<MPEIV>>46616000
          GETSTR(DEVCLASS,@CLSERR,2,8); <<CLASS NAME>>         <<MPEIV>>46618000
          IF = THEN GO PUTINCS;  <<NO CLASS>>                  <<MPEIV>>46620000
          IF < THEN MORE := TRUE;   <<FOLLOWED BY COMMA>>      <<MPEIV>>46622000
          INDEX := 10;                                         <<MPEIV>>46624000
          I := -1;                                             <<MPEIV>>46626000
          WHILE (I:=I+1) < LDT(DCNUM) DO                       <<MPEIV>>46628000
            BEGIN                                              <<MPEIV>>46630000
              IF DVCLTAB(INDEX-10) = DEVCLASS,(8),2 THEN       <<MPEIV>>46632000
                GOTO ENTEXST;                                  <<MPEIV>>46634000
              TOS := DVCLTAB(INDEX);   <<UPDATE TABLE POINTER>><<MPEIV>>46636000
              ASSEMBLE(DELB,DUP; NOT);                         <<MPEIV>>46638000
              IF TOS THEN TOS:=TOS+1;                          <<MPEIV>>46640000
              INDEX := TOS+INDEX+11;                           <<MPEIV>>46642000
            END;                                               <<MPEIV>>46644000
          DVCLTABINCR := 6; <<MAKE ROOM FOR NEW ENTRY>>        <<MPEIV>>46646000
          MOVEDLTABLES;                                        <<MPEIV>>46648000
          MOVE DVCLTAB(DVCLSIZE):=DEVCLASS,(8),2;<<CLASS NAME>><<MPEIV>>46650000
          BPS0 := 1;   <<CYCLICAL POINTER>>                    <<MPEIV>>46652000
          TOS := TOS+1;                                        <<MPEIV>>46654000
          IF SDISC'TYPE(TYPE,SUBTYP) THEN  <<SERIAL-TYPE DISC>><<03550>>46658000
             BEGIN <<CREATING A DISC CLASS--COULD BE SERIAL>>  <<MPEIV>>46660000
             BTEMP := MOVEAN( BTEMP(1), DEVCLASS, 8);          <<MPEIV>>46662000
             MESSAGE(-M2028,,,,,BTEMP);                        <<MPEIV>>46664000
             TEMP:=SDISC;                                      <<MPEIV>>46666000
             READINPUT(IBTEMP); <<GET RESPONSE>>               <<MPEIV>>46668000
             MOVE BTEMP:= BTEMP WHILE ANS;                     <<03705>>46670000
             IF BTEMP="Y" THEN GO ISSDISC;                     <<MPEIV>>46672000
             MOVE BTEMP:="IS ",2;                              <<MPEIV>>46674000
             ASSEMBLE(DUP);                                    <<MPEIV>>46676000
             MOVE *:=DEVCLASS WHILE AN,1;                      <<MPEIV>>46678000
             ASSEMBLE(DUP,CAB;SUB);                            <<MPEIV>>46680000
             TEMP:=TOS;                                        <<MPEIV>>46682000
             MOVE *:=" A FOREIGN DISC CLASS?";                 <<MPEIV>>46684000
             PRINT(IBTEMP,-TEMP-25,%320);                      <<MPEIV>>46686000
             TEMP:=FDISC;                                      <<MPEIV>>46688000
             READINPUT(IBTEMP);                                <<MPEIV>>46690000
             MOVE BTEMP:= BTEMP WHILE ANS;                     <<03705>>46692000
             IF BTEMP<>"Y" THEN                                <<MPEIV>>46694000
               TEMP:=TYPE;                                     <<03611>>46696000
ISSDISC:                                                       <<MPEIV>>46698000
             BPS0:=BYTE(TEMP);                                 <<MPEIV>>46700000
             END                                               <<MPEIV>>46702000
          ELSE                                                 <<MPEIV>>46704000
             BPS0:=LDT(LDEV*LDTSIZE+LDT2).TYP;                 <<MPEIV>>46706000
          TOS := TOS+1;                                        <<MPEIV>>46708000
          BPS0 := 1;    <<ONE ENTRY IN CLASS>>                 <<MPEIV>>46710000
          TOS := TOS+1;                                        <<MPEIV>>46712000
          BPS0 := LDEV;    <<DEVICE NUMBER OF ENTRY>>          <<MPEIV>>46714000
          DEL;                                                 <<MPEIV>>46716000
          DVCLSIZE := DVCLSIZE+12;                             <<MPEIV>>46718000
          LDT(X) := LDT(DCNUM)+1;                              <<MPEIV>>46720000
          IF MORE THEN GO NEXTCLASS ELSE GO PUTINCS;           <<MPEIV>>46722000
  ENTEXST:I := 0;                                              <<MPEIV>>46724000
          TOS := TOS+2;   <<POINT TO # OF DEVICES IN CLASS>>   <<MPEIV>>46726000
          WHILE (I:=I+1) <= INTEGER(BPS0) DO                   <<MPEIV>>46728000
          IF INTEGER(DVCLTAB(INDEX+I))=LDEV THEN               <<MPEIV>>46730000
            BEGIN    <<DUPLICATE ENTRY>>                       <<MPEIV>>46732000
              DEL;                                             <<MPEIV>>46734000
              MESSAGE(M2453);                                  <<MPEIV>>46736000
  CLSERR:     REMOVECLASSREFS;                                 <<MPEIV>>46738000
              GO REQCLSS;                                      <<MPEIV>>46740000
            END;                                               <<MPEIV>>46742000
          IF LOGICAL(N:=BPS0) THEN                             <<MPEIV>>46744000
            BEGIN    <<MUST MAKE ROOM FOR NEW ENTRY>>          <<MPEIV>>46746000
              DVCLTABINCR := 1; <<ADD 1 WORD>>                 <<MPEIV>>46748000
              MOVEDLTABLES;                                    <<MPEIV>>46750000
              TOS := TOS-2;  <<COUNT WRD HAS MOVED BY 2 BYTES>><<MPEIV>>46752000
              TOS := @DVCLTAB(DVCLSIZE-1);<<PTR TO END OF TAB>><<MPEIV>>46754000
              ASSEMBLE(DUP,INCB, INCB,DUP; NEG);               <<MPEIV>>46756000
              TOS := TOS+@DVCLTAB(INDEX+N);                    <<MPEIV>>46758000
              ASSEMBLE(MVB 2);                                 <<MPEIV>>46760000
              BPS0 := 0;      <<FILLER BYTE FOR ALIGNMENT>>    <<MPEIV>>46762000
              TOS := TOS-1;                                    <<MPEIV>>46764000
              DVCLSIZE := DVCLSIZE+2;                          <<MPEIV>>46766000
            END                                                <<MPEIV>>46768000
          ELSE TOS := S0+N+1;<<INSERT OVER FORMER FILLER BYTE>><<MPEIV>>46770000
          BPS0 := LDEV;    <<INSERT NEW ENTRY>>                <<MPEIV>>46772000
          BPS1 := BPS1+1;  <<BUMP BOUNT OF ENTRIES>>           <<MPEIV>>46774000
          DDEL;                                                <<MPEIV>>46776000
          DETERMCTYP(@SAMEPLACE,INDEX,FALSE);                  <<03611>>46778000
SAMEPLACE:IF MORE THEN GO NEXTCLASS;                           <<03611>>46780000
  PUTINCS:IF CSDEV17<=LDT(LDEV*LDTSIZE+LDT2).TYP<=CSDEV19 THEN <<MPEIV>>46782000
            BEGIN   <<MOVE CS DEVICE INTO CSTAB>>              <<MPEIV>>46784000
            TOS := CSINDX;                                     <<MPEIV>>46786000
            CSLDTX := S0;                                      <<MPEIV>>46788000
            CSTABINCR := TOS; <<INCREASE TABLE>>               <<MPEIV>>46790000
            MOVEDLTABLES;                                      <<MPEIV>>46792000
            TOS := @CSTAB+CSTAB;   <<FIRST FREE BYTE>>         <<MPEIV>>46794000
            DUPLICATE;                                         <<MPEIV>>46796000
            MOVE *:=CSLDTX,(CSINDX);                           <<MPEIV>>46798000
            CSTAB := CSTAB+CSINDX; <<UPDATE SEGMENT SIZE>>     <<MPEIV>>46800000
            I := -1;                                           <<MPEIV>>46802000
            @CSLDTX := @CSTAB + CSXSTART;                      <<MPEIV>>46804000
            DO I:=I+1                                          <<MPEIV>>46806000
            UNTIL(@CSLDTX:=@CSLDTX+CSLDTX)>S0;                 <<MPEIV>>46808000
            DEL;                                               <<MPEIV>>46810000
            CSDEF(LDEV) := I;                                  <<MPEIV>>46812000
            END;                                               <<MPEIV>>46814000
          GO REQLDEV;                                          <<MPEIV>>46816000
  REQOSP: I:=0;                                                <<MPEIV>>46818000
          J:=0;                                                <<MPEIV>>46820000
          WHILE (I:=I+1) <= HLDEV DO                           <<MPEIV>>46822000
            IF DVRTAB(I*DVRSIZE) <> 0 OR  <<COUNT USED DRTS>>  <<03002>>46824000
               DVRTAB(I*DVRSIZE + 1).DSBIT = 1 THEN J:=J+1;    <<03002>>46826000
          IF J=255 THEN                                        <<MPEIV>>46828000
            BEGIN                                              <<MPEIV>>46830000
            CTAB0(MAXSPOOLF) := 0;                             <<MPEIV>>46832000
            GO NLIOREQ;                                        <<MPEIV>>46834000
            END;                                               <<MPEIV>>46836000
  MAXOSPOOL:                                                   <<MPEIV>>46838000
          GETNEWVAL(M2352,CTAB0(MAXSPOOLF),0,255-J);           <<MPEIV>>46840000
          IF CTAB0(MAXSPOOLF)>(255-J) THEN                     <<MPEIV>>46842000
            <<MUST MAKE THIS TEST IN THE CASE WHERE A LARGE>>  <<MPEIV>>46844000
            <<NUMBER OF REAL DEVICES HAVE BEEN ADDED AND   >>  <<MPEIV>>46846000
            <<THE NUMBER OF OPEN SPOOLFILES WAS NOT CHANGED>>  <<MPEIV>>46848000
            BEGIN <<MUST CHANGE MAX # OF OPEN SPOOLFILES>>     <<MPEIV>>46850000
            MESSAGE(M2355);  << MAX OPEN SPOOLFILES >>         <<MPEIV>>46852000
            MESSAGE(M2356); << MAX ALLOWED IN CURRENT CONF >>  <<MPEIV>>46854000
            MOVE  BINBUF := "IS ";                             <<MPEIV>>46856000
            I := ASCII(255-J,BINBUF(3));                       <<MPEIV>>46858000
            PRINT(INBUF,-I-3,0);                               <<MPEIV>>46860000
            GOTO MAXOSPOOL;                                    <<MPEIV>>46862000
            END;                                               <<MPEIV>>46864000
  NLIOREQ:IF LGETYESNO(M2009) THEN LISTIODEV;                  <<MPEIV>>46866000
            << LIST I/O DEVICES >>                             <<MPEIV>>46868000
          IF CSPRESENT AND LGETYESNO(M2100) THEN LISTCSDEV;    <<MPEIV>>46870000
            << LIST CS DEVICES >>                              <<MPEIV>>46872000
   REQCLC:TOS := @UPDODEV;                                     <<MPEIV>>46874000
          GETYESNO(*,M2300);    <<CLASS CHANGES?>>             <<MPEIV>>46876000
   REQLOC:IF LGETYESNO(M2301) THEN LISTCLASSES;                <<MPEIV>>46878000
           GETYESNO(@REQACLS,M2302); <<DELETE CLASSES>>        <<MPEIV>>46880000
           ERROR := FALSE;                                     <<MPEIV>>46882000
   GETCLASSN:                                                  <<MPEIV>>46884000
          MESSAGE(-M2304);  <<CLASS NAMES>>                    <<MPEIV>>46886000
          READINPUT;                                           <<MPEIV>>46888000
   NEXTCL:MORE := FALSE;                                       <<MPEIV>>46890000
          GETSTR(DEVCLASS,@REQLIC,2,8);                        <<MPEIV>>46892000
          IF = AND LAST  THEN GO DCLERR;                       <<MPEIV>>46894000
          IF < THEN MORE := LAST  := TRUE ELSE LAST:=FALSE;    <<MPEIV>>46896000
          I := DELETECLASS(@REQLOC);                           <<MPEIV>>46898000
          K := 0;                                              <<MPEIV>>46900000
          WHILE (K:=K+1) <=HLDEV DO                            <<MPEIV>>46902000
          IF LOGICAL(LDT((M:=K*LDTSIZE)+LDT3).OUTCL) THEN      <<MPEIV>>46904000
            BEGIN <<OUTPUT DEVICE IS CLASS>>                   <<MPEIV>>46906000
            TOS := LDT(M+LDT3).OUTDEV; <<INDEX TO CLASS TABLE>><<MPEIV>>46908000
            IF S0=I THEN                                       <<MPEIV>>46910000
              BEGIN <<OUTPUT DEVICE IS DELETED CLASS>>         <<MPEIV>>46912000
              LDT(M+LDT3).OUTDEV := 0;                         <<MPEIV>>46914000
              PUTINTEMPCLASS(K);                               <<MPEIV>>46916000
              END                                              <<MPEIV>>46918000
            ELSE IF S0>I THEN LDT(M+LDT3).OUTDEV:=S0-1;        <<MPEIV>>46920000
            DEL;                                               <<MPEIV>>46922000
            END;                                               <<MPEIV>>46924000
          IF MORE THEN GO NEXTCL ELSE GO REQACLS;              <<MPEIV>>46926000
   REQLIC:GETYESNO(@GETCLASSN,M2301); << LIST CLASSES? >>      <<MPEIV>>46928000
          LISTCLASSES;                                         <<MPEIV>>46930000
          GO GETCLASSN;                                        <<MPEIV>>46932000
   DCLERR:MESSAGE(M2453);                                      <<MPEIV>>46934000
          GO GETCLASSN;                                        <<MPEIV>>46936000
   REQACLS:GETYESNO(@REQLNC,M2303);<<ADD CLASSES>>             <<MPEIV>>46938000
   REQNCL:MESSAGE(-M2307); <<CLASS NAME>>                      <<MPEIV>>46940000
          READINPUT;                                           <<MPEIV>>46942000
          GETSTR(DEVCLASS,@REQNCL ,3,8);                       <<MPEIV>>46944000
          IF = THEN GO REQLNC; <<CARRIAGE RETURN>>             <<MPEIV>>46946000
   REQDEVS:I := 0;                                             <<MPEIV>>46948000
          MESSAGE(-M2305);  <<LOGICAL DEVICES #'S>>            <<MPEIV>>46950000
          READINPUT;                                           <<MPEIV>>46952000
   GETNDEV:I:=I+1;                                             <<MPEIV>>46954000
          MORE := FALSE;                                       <<MPEIV>>46956000
          TOS := INVAL(@CLASERR);                              <<MPEIV>>46958000
          IF = THEN                                            <<MPEIV>>46960000
   CLASERR: BEGIN                                              <<MPEIV>>46962000
              MESSAGE(M2453);                                  <<MPEIV>>46964000
              TOS:=I;                                          <<MPEIV>>46966000
              ASSEMBLE(SUBS 0);  <<DELETE INPUT FROM STACK>>   <<MPEIV>>46968000
              GO TO REQDEVS;  <<TRY AGAIN>>                    <<MPEIV>>46970000
             END;                                              <<MPEIV>>46972000
          IF < THEN MORE:= TRUE;                               <<MPEIV>>46974000
          NEW'LDEV:= S0;                                       <<03611>>46976000
          IF NOT LDEV'EXISTS(NEW'LDEV) THEN                    <<03611>>46978000
            GO CLASERR;   <<DEVICE NOT DEFINE>>                <<MPEIV>>46980000
          IF MORE THEN GO GETNDEV;                             <<MPEIV>>46982000
          INDEX := 10;                                         <<MPEIV>>46984000
          J:= -1;                                              <<MPEIV>>46986000
          WHILE (J:=J+1)<LDT(DCNUM) DO                         <<MPEIV>>46988000
            BEGIN                                              <<MPEIV>>46990000
            IF DVCLTAB(INDEX-10)=DEVCLASS,(8),2 THEN GO OLDENT;<<MPEIV>>46992000
            TOS := DVCLTAB(INDEX);                             <<MPEIV>>46994000
            ASSEMBLE(DELB,DUP;NOT);                            <<MPEIV>>46996000
            IF TOS THEN TOS:=TOS+1;                            <<MPEIV>>46998000
            INDEX := TOS+INDEX+11;                             <<MPEIV>>47000000
            END;                                               <<MPEIV>>47002000
          X := DVCLSIZE;        <<FIRST FREE BYTE>>            <<MPEIV>>47004000
          INDEX := X+10;                                       <<MPEIV>>47006000
          DVCLTABINCR := (I+2)&LSR(1)+5;                       <<MPEIV>>47008000
          MOVEDLTABLES;                                        <<MPEIV>>47010000
          MOVE DVCLTAB(X):=DEVCLASS,(8),2;                     <<MPEIV>>47012000
          BPS0 := 1;  <<CYCLICAL POINTER>>                     <<MPEIV>>47014000
          TOS := TOS + 1;                                      <<MPEIV>>47016000
          BPS0 := 0;  <<CLASS ACCESS TYPE>>                    <<MPEIV>>47018000
          TOS := TOS + 1;                                      <<MPEIV>>47020000
          BPS0 := I;  <<# DEVICES IN CLASS>>                   <<MPEIV>>47022000
          TOS := TOS+1;                                        <<MPEIV>>47024000
          X := -I-1;                                           <<MPEIV>>47026000
          WHILE (X:=X+1)<0  DO                                 <<MPEIV>>47028000
            BEGIN                                              <<MPEIV>>47030000
            BPS0 := IAS0(X);                                   <<MPEIV>>47032000
            TOS := TOS + 1;                                    <<MPEIV>>47034000
            END;                                               <<MPEIV>>47036000
          TOS := I;                                            <<MPEIV>>47038000
          J := S0+1;     <<SAVE STACK DECREMENT>>              <<MPEIV>>47040000
          IF NOT(TOS) THEN                                     <<MPEIV>>47042000
            BEGIN  <<INCLUDE FILLER BYTE>>                     <<MPEIV>>47044000
            I := I+1;                                          <<MPEIV>>47046000
            BPS0 := 0;                                         <<MPEIV>>47048000
            END;                                               <<MPEIV>>47050000
          DVCLSIZE := DVCLSIZE+I+11;                           <<MPEIV>>47052000
          LDT(X) := LDT(DCNUM)+1;                              <<MPEIV>>47054000
          TOS := J;                                            <<MPEIV>>47056000
          ASSEMBLE(SUBS 0);                                    <<MPEIV>>47058000
          DETERMCTYP(@REQLOC,INDEX,TRUE);<<DETERMINE CLASS TP>><<03611>>47060000
          GO REQNCL;                                           <<MPEIV>>47062000
  OLDENT: TOS := TOS+2;     <<CLASS ALREADY EXISTED>>          <<MPEIV>>47064000
          K := -I-1;                                           <<MPEIV>>47066000
          WHILE (K:=K+1)<0 DO                                  <<MPEIV>>47068000
            BEGIN                                              <<MPEIV>>47070000
            M := 0;                                            <<MPEIV>>47072000
            WHILE (M:=M+1)<=INTEGER(BPS0) DO                   <<MPEIV>>47074000
              IF IAS0(K)=INTEGER(BPS0(M)) THEN                 <<MPEIV>>47076000
                BEGIN <<DUPLICATE ENTRIES>>                    <<MPEIV>>47078000
                MESSAGE(M2306);                                <<MPEIV>>47080000
                TOS := I+1;                                    <<MPEIV>>47082000
                ASSEMBLE(SUBS 0);                              <<MPEIV>>47084000
                GETYESNO(@REQDEVS,M2301); << LIST CLASSES? >>  <<MPEIV>>47086000
                LISTCLASSES;                                   <<MPEIV>>47088000
                GO REQDEVS;                                    <<MPEIV>>47090000
                END;                                           <<MPEIV>>47092000
            END;                                               <<MPEIV>>47094000
          TOS := TOS-@DVCLTAB;  <<SAVE DISPLACEMENT>>          <<MPEIV>>47096000
          DVCLTABINCR := (I+1)&LSR(1);                         <<MPEIV>>47098000
          MOVEDLTABLES;                                        <<MPEIV>>47100000
          TOS := TOS+@DVCLTAB;                                 <<MPEIV>>47102000
          IF LOGICAL(N:=BPS0) THEN      <<IF N+I IS EVEN THEN>><<MPEIV>>47104000
            IF LOGICAL(I) THEN J:=I+1   <<FILLER BYTE WILL BE>><<MPEIV>>47106000
            ELSE  J:=I                  <<NEEDED             >><<MPEIV>>47108000
          ELSE IF LOGICAL(I) THEN J:=I-1                       <<MPEIV>>47110000
               ELSE J := I;                                    <<MPEIV>>47112000
          TOS := @DVCLTAB+DVCLSIZE-1;                          <<MPEIV>>47114000
          DUPLICATE;                                           <<MPEIV>>47116000
          TOS := TOS+J;                                        <<MPEIV>>47118000
          DUPLICATE;                                           <<MPEIV>>47120000
          TOS := -TOS+@DVCLTAB+INDEX+N;                        <<MPEIV>>47122000
          ASSEMBLE(CAB,XCH;MVB 3);                             <<MPEIV>>47124000
          DVCLSIZE := DVCLSIZE+J;                              <<MPEIV>>47126000
          BPS0 := N+I;                                         <<MPEIV>>47128000
          X := -I-1;                                           <<MPEIV>>47130000
          TOS := TOS+N+1;                                      <<MPEIV>>47132000
          WHILE (X:=X+1)<0 DO                                  <<MPEIV>>47134000
            BEGIN                                              <<MPEIV>>47136000
            BPS0 := IAS0(X);                                   <<MPEIV>>47138000
            TOS := TOS+1;                                      <<MPEIV>>47140000
            END;                                               <<MPEIV>>47142000
          IF NOT(LOGICAL(N+I)) THEN  BPS0:=0;<<FILLER BYTE>>   <<MPEIV>>47144000
          TOS := I+1;                                          <<MPEIV>>47146000
          ASSEMBLE(SUBS 0);                                    <<MPEIV>>47148000
          GO REQNCL;                                           <<MPEIV>>47150000
   REQLNC:GETYESNO(@UPDODEV,M2301);<<LIST CLASSES>>            <<MPEIV>>47152000
          LISTCLASSES;                                         <<MPEIV>>47154000
   UPDODEV:TINDEX := 4;                                        <<MPEIV>>47156000
          K := 0;                                              <<MPEIV>>47158000
          ERROR := FALSE;                                      <<MPEIV>>47160000
          INDEX := 12;                                         <<MPEIV>>47162000
          TEMP := TCLASS;                                      <<MPEIV>>47164000
          WHILE (K:=K+1)<=TEMP DO                              <<MPEIV>>47166000
            BEGIN                                              <<MPEIV>>47168000
            N := INTEGER(TEMPCLASS(INDEX));                    <<MPEIV>>47170000
            TOS := CLINDEX(TEMPCLASS(INDEX-8));                <<MPEIV>>47172000
            IF S0=0 THEN <<NO CLASS BY THIS NAME>>             <<MPEIV>>47174000
              BEGIN  <<ILLEGAL OUTPUT CLASS>>                  <<MPEIV>>47176000
              DEL;                                             <<MPEIV>>47178000
              BINBUF := MOVEAN(BINBUF(1),TEMPCLASS(INDEX-8),8);<<MPEIV>>47180000
              MESSAGE( M115,,,,,BINBUF);                       <<MPEIV>>47182000
              J:=L:=M:=0;                                      <<MPEIV>>47184000
              WHILE (J:=J+1)<=N DO                             <<MPEIV>>47186000
                BEGIN                                          <<MPEIV>>47188000
               L:=ASCII(INTEGER(TEMPCLASS(INDEX+J)),BINBUF(M));<<MPEIV>>47190000
                X := M+L;                                      <<MPEIV>>47192000
                BINBUF(X) := ",";                              <<MPEIV>>47194000
                M := X+1;                                      <<MPEIV>>47196000
                IF M>69 AND J<N THEN                           <<MPEIV>>47198000
                  BEGIN                                        <<MPEIV>>47200000
                  PRINT(INBUF,-M+1,0);                         <<MPEIV>>47202000
                  M := 0;                                      <<MPEIV>>47204000
                  END;                                         <<MPEIV>>47206000
                END;                                           <<MPEIV>>47208000
              PRINT(INBUF,-M+1,0);                             <<MPEIV>>47210000
              TOS := N;                                        <<MPEIV>>47212000
              ASSEMBLE(DUP,NOT);          <<MAKE TEMPCLASS >>  <<MPEIV>>47214000
              IF TOS THEN TOS := TOS+1;   <<LOOK UNCHANGED >>  <<MPEIV>>47216000
              I:=TOS+9;                                        <<MPEIV>>47218000
              MOVE TEMPCLASS(TINDEX):=TEMPCLASS(INDEX-8),(I);  <<MPEIV>>47220000
              TINDEX := TINDEX+I;                              <<MPEIV>>47222000
              INDEX := INDEX+I;                                <<MPEIV>>47224000
              ERROR :=TRUE;                                    <<MPEIV>>47226000
              END                                              <<MPEIV>>47228000
            ELSE                                               <<MPEIV>>47230000
              BEGIN                                            <<MPEIV>>47232000
              J := 0;                                          <<MPEIV>>47234000
              WHILE (J:=J+1)<=N DO                             <<MPEIV>>47236000
                BEGIN                                          <<MPEIV>>47238000
                LDEV := TEMPCLASS(INDEX+J);                    <<MPEIV>>47240000
                IF DVRTAB(LDEV*DVRSIZE).DRTFIELD<>0 THEN       <<03002>>47242000
                   LDT(LDEV*LDTSIZE+LDT3).OUTDEV := S0;        <<MPEIV>>47244000
                END;                                           <<MPEIV>>47246000
              DEL;                                             <<MPEIV>>47248000
              TCLASS := TCLASS-1;                              <<MPEIV>>47250000
              TOS := N;                                        <<MPEIV>>47252000
              ASSEMBLE(DUP,NOT);                               <<MPEIV>>47254000
              IF TOS THEN TOS:=TOS+1;                          <<MPEIV>>47256000
              TCLASS(X) := -S0 -9+TCLASS(1);                   <<MPEIV>>47258000
              INDEX := TOS+INDEX+9;                            <<MPEIV>>47260000
              END;                                             <<MPEIV>>47262000
            END;                                               <<MPEIV>>47264000
         IF ERROR THEN GO REQOLIO;                             <<MPEIV>>47266000
          GETYESNO(@REQADVRC,M2009);  <<LIST I/O DEVICES>>     <<MPEIV>>47268000
          LISTIODEV;                                           <<MPEIV>>47270000
  REQADVRC:IF CTAB0(NUMADVRS)>0 THEN                           <<MPEIV>>47272000
            BEGIN <<DELETE DVRS FROM CS LIST IF CONFIGURED>>   <<MPEIV>>47274000
            I := -1;                                           <<MPEIV>>47276000
            TOS := @CSDVR&LSL(1);                              <<04306>>47278000
            WHILE(I:=I+1)<CTAB0(NUMADVRS) DO                   <<MPEIV>>47280000
              BEGIN <<CHECK IF CONFIGURED>>                    <<MPEIV>>47282000
              J := 0;                                          <<MPEIV>>47284000
              WHILE(J:=J+1)<=CTAB0(DRTNUM) DO                  <<MPEIV>>47286000
                BEGIN                                          <<MPEIV>>47288000
                DUPLICATE;                                     <<MPEIV>>47290000
                TOS := @DVRTAB(J*DVRSIZE)&LSL(1);              <<04306>>47292000
                IF *=*,(8) THEN                                <<MPEIV>>47294000
                  BEGIN <<DELETE FROM CS LIST>>                <<MPEIV>>47296000
                  DUPLICATE;                                   <<MPEIV>>47298000
                  TOS:=S0+8; <<MOVE ALL FOLLOWING DVRS UP>>    <<MPEIV>>47300000
                  TOS:=-S0+CTAB0(NUMADVRS)*CSDVRSIZE;<<LENGTH>><<MPEIV>>47302000
                  ASSEMBLE(MVB 3);                             <<MPEIV>>47304000
                  CTAB0(X) := CTAB0(NUMADVRS)-1;               <<MPEIV>>47306000
                  I:=I-1;  <<REFLECT DELETED DVR IN COUNT>>    <<MPEIV>>47308000
                  GOTO NEXTCSD;                                <<MPEIV>>47310000
                  END;                                         <<MPEIV>>47312000
                END;                                           <<MPEIV>>47314000
              TOS := TOS+8; <<NEXT CS DRIVER>>                 <<MPEIV>>47316000
  NEXTCSD:    END;                                             <<MPEIV>>47318000
            DEL;                                               <<MPEIV>>47320000
            END;                                               <<MPEIV>>47322000
          IF CTAB0(NUMADVRS)>0 THEN                            <<MPEIV>>47324000
            IF LGETYESNO(M2151) THEN<<LIST ADDITIONAL DRIVERS>><<MPEIV>>47326000
               LISTDVRS;                                       <<MPEIV>>47328000
END;  << IOCHANGE >>                                           <<MPEIV>>47330000
$PAGE          "VOLUME TABLE PROCEDURES"                                47332000
$CONTROL SEGMENT=SETUP                                                  47334000
          <<-------------                                               47336000
            FIND VOLUME                                                 47338000
          ------------->>                                               47340000
  INTEGER PROCEDURE FINDVOL(NAME);                                      47342000
    BYTE ARRAY NAME;                                                    47344000
    COMMENT                                                             47346000
      SEARCHES THE VOLUME TABLE FOR THE VOLUME SPECIFIED BY NAME.       47348000
    IF NOT FOUND, RETURNS CCG. OTHERWISE RETURNS CCE AND THE INDEX      47350000
    OF THE ENTRY IN FINDVOL;                                            47352000
      BEGIN                                                             47354000
        INTEGER I:=0;                                                   47356000
          WHILE (I:=I+1)<=HVOL DO                                       47358000
            BEGIN                                                       47360000
              TOS := @VTAB(I*VTABSIZE)&LSL(1);                          47362000
              IF * = NAME,(8) THEN                                      47364000
                BEGIN                                                   47366000
                  FINDVOL := X;                                         47368000
                  CC := CCE;                                            47370000
                  RETURN;                                               47372000
                END;                                                    47374000
            END;                                                        47376000
          CC := CCG;                                                    47378000
      END <<FINDVOL>> ;                                                 47380000
                                                                        47382000
          <<------------                                                47384000
            ADD VOLUME                                                  47386000
          ------------>>                                                47388000
  INTEGER PROCEDURE ADDVOL(NAME,PVTYP);                        <<RH.PV>>47390000
    VALUE PVTYP;                                               <<RH.PV>>47392000
    BYTE ARRAY NAME;                                                    47394000
    LOGICAL PVTYP;  <<TRUE IMPLIES DUMMY PV ENTRY>>            <<RH.PV>>47396000
    OPTION VARIABLE;                                           <<RH.PV>>47398000
    COMMENT                                                             47400000
      ADDS THE VOLUME SPECIFIED BY NAME TO THE VOLUME TABLE. IF THERE   47402000
    IS NO ROOM, RETURNS CCG. OTHERWISE, RETURNS CCE AND THE INDEX OF    47404000
    WHERE IT WAS INSERTED IN ADDVOL;                                    47406000
      BEGIN                                                             47408000
        LOGICAL PMAP = Q-4;                                    <<RH.PV>>47410000
        INTEGER I:=0;                                                   47412000
          CC := CCE;                                           <<01035>>47414000
          IF NOT PMAP THEN PVTYP := FALSE;                     <<01035>>47416000
          IF PVTYP THEN                                        <<01035>>47418000
            BEGIN  << PRIVATE VOLUME ENTRY >>                  <<01035>>47420000
              I := HVOL;                                       <<01035>>47422000
              MVOL := MVOL + 1;                                <<01035>>47424000
              << SAVE SPACE EVEN IF VOL NOT MOUNTED >>         <<01035>>47426000
              IF MVOL > 64 THEN                                <<01035>>47428000
                BEGIN                                          <<01035>>47430000
                   MESSAGE(M200);                              <<01103>>47432000
                   CC := CCG;                                  <<01035>>47434000
                   RETURN;                                     <<01035>>47436000
                END;                                           <<01035>>47438000
              VTABINCR := VTABSIZE;                            <<01035>>47440000
              MOVEDLTABLES;  << ALLOCATE & ZERO NEW ENTRY >>   <<01035>>47442000
              DO I:=I+1  <<RETURN INDEX TO NEXT UNUSED ENTRY>> <<01035>>47444000
                UNTIL VTAB(VTABSIZE*I) = 0;                    <<01035>>47446000
              ADDVOL := X;                                     <<01035>>47448000
            END                                                <<01035>>47450000
          ELSE                                                 <<01035>>47452000
            BEGIN  << SYSTEM VOLUME ENTRY >>                   <<01035>>47454000
              I := 0;                                          <<01035>>47456000
              DO I:=I+1                                        <<01035>>47458000
                UNTIL VTAB(VTABSIZE*I)=0 OR I > HVOL;          <<01035>>47460000
              IF I > HVOL THEN                                 <<01035>>47462000
                BEGIN                                          <<01035>>47464000
                  IF I > 64 THEN                               <<01035>>47466000
                    BEGIN                                      <<01035>>47468000
                      MESSAGE(M200);                           <<01103>>47470000
                      CC := CCG;                               <<01035>>47472000
                      RETURN;                                  <<01035>>47474000
                    END;                                       <<01035>>47476000
                  HVOL := I;                                   <<01120>>47478000
                  VTABINCR := VTABSIZE;                        <<01035>>47480000
                  MOVEDLTABLES;                                <<01035>>47482000
                END;                                           <<01035>>47484000
              TOS := @VTAB(VTABSIZE*I)&LSL(1);                 <<04306>>47486000
              ADDVOL := X;                                     <<01035>>47488000
              MOVE * := NAME, (8);                             <<01035>>47490000
            END;                                               <<01035>>47492000
    END;  << ADDVOL >>                                         <<01035>>47494000
                                                               <<01035>>47496000
                                                               <<01035>>47498000
                                                               <<01035>>47500000
                                                               <<01035>>47502000
                                                               <<01035>>47504000
                                                                        47506000
          <<-------------------                                         47508000
            LIST VOLUME TABLE                                           47510000
          ------------------->>                                         47512000
  PROCEDURE LISTVOL;                                                    47514000
    COMMENT                                                             47516000
      PRINTS A LISTING OF THE VOLUME TABLE;                             47518000
      BEGIN                                                             47520000
        INTEGER J,I:=0;                                                 47522000
         MOVE BLINE := "VOLUME #    NAME    LOG DEV #";        <<00888>>47524000
         PRINTLINE;                                            <<00888>>47526000
          WHILE (I:=I+1) <= HVOL DO                                     47528000
          IF VTAB(I*VTABSIZE)<>0 THEN                                   47530000
            BEGIN                                                       47532000
              ASCII (I,BLINE (3));                             <<00888>>47534000
              MOVE LINE (5) := VTAB (I*VTABSIZE),(4);          <<00888>>47536000
              ASCII(VTAB(X:=X+VTAB12).VTABLDEV,BLINE(23));     <<00888>>47538000
              PRINTLINE;                                       <<00888>>47540000
            END;                                                        47542000
      END <<LISTVOL>> ;                                                 47544000
        <<---------------------------------->>                 <<MPEIV>>47546000
        <<  LIST VIRTUAL DEVICE ALLOCATION  >>                 <<MPEIV>>47548000
        <<---------------------------------->>                 <<MPEIV>>47550000
                                                               <<MPEIV>>47552000
PROCEDURE LISTVM;                                              <<MPEIV>>47554000
COMMENT:  PRINT LISTING OF THE VIRTUAL MEMORY ALLOCATION ON    <<MPEIV>>47556000
SYSTEM VOLUMES.                                                <<MPEIV>>47558000
;                                                              <<MPEIV>>47560000
BEGIN                                                          <<MPEIV>>47562000
DOUBLE  SECTORS;     << # OF SECTORS ALLOCATED >>              <<MPEIV>>47564000
INTEGER LDEV,         << LDEV# OF CORRESPONDING VOLUME >>      <<MPEIV>>47566000
        SECTORS1      = SECTORS,                               <<MPEIV>>47568000
        SECTORS2      = SECTORS+1,                             <<MPEIV>>47570000
        VOLUME := 0;  << VOLUME INDEX >>                       <<MPEIV>>47572000
                                                               <<MPEIV>>47574000
MOVE BLINE := "VOLUME NAME   LDEV #   VM ALLOCATION";          <<MPEIV>>47576000
PRINTLINE;                                                     <<MPEIV>>47578000
WHILE (VOLUME := VOLUME+1) <= HVOL DO                          <<MPEIV>>47580000
  IF VTAB(VOLUME*VTABSIZE) <> 0 THEN                           <<MPEIV>>47582000
    BEGIN                                                      <<MPEIV>>47584000
    MOVE LINE(1) := VTAB(VOLUME*VTABSIZE), (4);  << VOL NAME>> <<MPEIV>>47586000
    LDEV := GETLDEV(VOLUME);                                   <<MPEIV>>47588000
    LNTOA(LDEV, 10, BLINE(15));  << LOGICAL NUMBER TO ASCII >> <<MPEIV>>47590000
    SECTORS1 := VTAB(VOLUME*VTABSIZE+VTAB10);                  <<MPEIV>>47592000
    SECTORS2 := VTAB(X:=X+1);                                  <<MPEIV>>47594000
    LDNTOA((SECTORS/1024D), 10, BLINE(24)); <<DOUBLE TO ASCII>><<MPEIV>>47596000
    PRINTLINE;                                                 <<MPEIV>>47598000
    END;                                                       <<MPEIV>>47600000
END;  << LISTVM >>                                             <<MPEIV>>47602000
PROCEDURE VERIFYVM;                                            <<MPEIV>>47604000
                                                               <<MPEIV>>47606000
COMMENT:  THIS PROCEDURE IS USED TO DETERMINE IF THE           <<MPEIV>>47608000
VALUES FOR VIRTUAL MEMORY IN THE VOLUME TABLE ARE VALID        <<MPEIV>>47610000
OR IF THEY SHOULD BE REPLACED BY DEFAULT VALUES AND NEW        <<MPEIV>>47612000
SPACE OBTAINED.  THE PROBLEM ARISES WHEN A SPLIT VIRTUAL       <<MPEIV>>47614000
MEMORY SYSTEM IS UPDATED BY A PRE-SPLIT VM SYSTEM AND          <<MPEIV>>47616000
A RECOVER LOST DISC SPACE IS DONE TO RECOVER THE VM            <<MPEIV>>47618000
SPACE. THEN IF YOU UPDATE FORWARD AGAIN, SINCE THE VTAB        <<MPEIV>>47620000
EXISTED CONTINOUSLY IT WILL SHOW THE SPACE STILL               <<MPEIV>>47622000
ALLOCATED FOR VM AND USE IT.  TO MAKE THIS DETERMINATION       <<MPEIV>>47624000
AN ADDITIONAL COLDLOADID IS KEPT IN THE VTAB.  ONLY            <<MPEIV>>47626000
SPLIT VM SYSTEMS WILL KNOW TO UPDATE THIS NUMBER.              <<MPEIV>>47628000
;                                                              <<MPEIV>>47630000
BEGIN                                                          <<MPEIV>>47632000
LOGICAL VOLUME;                                                <<MPEIV>>47634000
                                                               <<MPEIV>>47636000
IF VTAB(VMINTEGRITY) <> COLDLOADID THEN                        <<MPEIV>>47638000
  BEGIN  << LAST RESTART WAS PRE-SPLIT VM - USE DEFAULTS >>    <<MPEIV>>47640000
  MESSAGE(M2219);  << WARNING - USING VM DEFAULT SIZE >>       <<MPEIV>>47642000
  VOLUME := 0;                                                 <<MPEIV>>47644000
  WHILE (VOLUME := VOLUME+1) <= LOGICAL(HVOL) DO               <<MPEIV>>47646000
    IF VTAB(VOLUME*VTABSIZE+VTAB12).VTABLDEV = SYSDISC THEN    <<MPEIV>>47648000
      BEGIN  << VM SIZE DEFAULTS TO 0 EXCEPT SYSDISC >>        <<MPEIV>>47650000
      INFO(VIRMEMSECT) := L'(INFO(VIRMEMSECT)) /               <<MPEIV>>47652000
        NWORDPAGE * NWORDPAGE;  << ROUND DOWN >>               <<MPEIV>>47654000
      TOS := INFOD(VIRMEMADR);                                 <<MPEIV>>47656000
      VTAB(VOLUME*VTABSIZE+VTAB9) := TOS;                      <<MPEIV>>47658000
      VTAB(VOLUME*VTABSIZE+VTAB8) := TOS;                      <<MPEIV>>47660000
      VTAB(VOLUME*VTABSIZE+VTAB10) := 0;                       <<MPEIV>>47662000
      VTAB(VOLUME*VTABSIZE+VTAB11) := INFO(VIRMEMSECT);        <<MPEIV>>47664000
      VTAB(VOLUME*VTABSIZE+VTAB12).VMS := 1;                   <<MPEIV>>47666000
      END  << SYSTEM DISC >>                                   <<MPEIV>>47668000
    ELSE                                                       <<MPEIV>>47670000
      BEGIN  << NOT SYSDISC >>                                 <<MPEIV>>47672000
      VTAB(VOLUME*VTABSIZE+VTAB8) := 0;                        <<MPEIV>>47674000
      VTAB(X:=X+1) := 0;                                       <<MPEIV>>47676000
      VTAB(X:=X+1) := 0;                                       <<MPEIV>>47678000
      VTAB(X:=X+1) := 0;                                       <<MPEIV>>47680000
      VTAB(X:=X+1).VMS := 0;                                   <<MPEIV>>47682000
      END;  << NOT SYSDISC >>                                  <<MPEIV>>47684000
  END;  << INTEGRITY <> COLDLOADID >>                          <<MPEIV>>47686000
END;  << VERIFYVM >>                                           <<MPEIV>>47688000
                                                                        47690000
          <<-----------------                                           47692000
            GET VOLUME NAME                                             47694000
          ----------------->>                                           47696000
  PROCEDURE GETVNAME(CRLABEL);                                          47698000
    VALUE CRLABEL;                                                      47700000
    INTEGER CRLABEL;                                                    47702000
    COMMENT                                                             47704000
      PROMPTS THE OPERATOR FOR A VOLUME NAME. IF A CARRIAGE RETURN      47706000
    IS ENTERED, EXITS TO THE LABEL SPECIFIED BY CRLABEL. OTHERWISE      47708000
    PLACES THE VOLUME NAME ENTERED IN BYTE ARRAY VNAME;                 47710000
      BEGIN                                                             47712000
  REQVNAME:                                                             47714000
          MESSAGE(-M2204);  <<ENTER VOLUME NAME>>              <<01103>>47716000
          READINPUT;                                                    47718000
          SCAN BINBUF WHILE BLANK;                                      47720000
          IF CARRY THEN                                                 47722000
            BEGIN  <<CARRAIGE RETURN INPUT>>                            47724000
              RETURNP := CRLABEL;                                       47726000
              RETURN;                                                   47728000
            END;                                                        47730000
          GETSTR(VNAME,@REQVNAME,1,8);                                  47732000
      END <<GETVNAME>> ;                                                47734000
PROCEDURE RELEASEVM(LDEV, VDSLEN, VDSTART);                    <<MPEIV>>47736000
VALUE LDEV, VDSLEN, VDSTART;                                   <<MPEIV>>47738000
DOUBLE  VDSLEN,   << LENGTH OF VIRTUAL MEMORY >>               <<MPEIV>>47740000
        VDSTART;  << STARTING SECTOR OF V.M. >>                <<MPEIV>>47742000
LOGICAL LDEV;     << LDEV OF DEVICE CONTAINING THIS V.M. >>    <<MPEIV>>47744000
                                                               <<MPEIV>>47746000
COMMENT:  THIS PROCEDURE WILL RELEASE THE DISC SPACE           <<MPEIV>>47748000
ALLOCATED TO VIRTUAL MEMORY IN THE FREE SPACE TABLE OF THE     <<MPEIV>>47750000
LDEV SPECIFIED (BUT IT WON'T ALTER THE VOLUME TABLE ENTRY).    <<MPEIV>>47752000
THE RELEASED SPACE WILL THEN BE CHECKED FOR DEFECTIVE TRACKS   <<MPEIV>>47754000
THAT WERE IN VIRTUAL MEMORY AND DELETE THEM FROM THE DFS       <<MPEIV>>47756000
TABLE.  IF IT IS A RELOAD THEN THE FREE SPACE TABLES WILL BE   <<MPEIV>>47758000
REINITIALIZED SO NOTHING NEEDS TO BE DONE.  IF VDSLEN IS ZERO  <<MPEIV>>47760000
THEN THERE IS NO SPACE TO BE RELEASED.                         <<MPEIV>>47762000
;                                                              <<MPEIV>>47764000
BEGIN                                                          <<MPEIV>>47766000
DOUBLE  VDSTOP,   << LAST SECTOR OF VIRTUAL MEMORY >>          <<MPEIV>>47768000
        BADLENGTH,<< LENGTH OF BAD AREA TO REMOVE >>           <<MPEIV>>47770000
        FSECT,    << 1ST SECT. OF BAD AREA TO DEL. FROM DFS>>  <<MPEIV>>47772000
        LSECT;    << LAST SECT. OF BAD AREA TO DEL. FROM DFS >><<MPEIV>>47774000
                                                               <<MPEIV>>47776000
LOGICAL TYPE,     << DISC TYPE >>                              <<MPEIV>>47778000
        STYPE,    << DISC SUB TYPE >>                          <<MPEIV>>47780000
        TRACKLEN; << LENGTH OF 1 TRACK ON THIS DISC >>         <<MPEIV>>47782000
INTEGER I;        << WHILE LOOP COUNTER - DTT ENTRY # >>       <<MPEIV>>47784000
                                                               <<MPEIV>>47786000
IF RELOAD OR VDSLEN=0D THEN RETURN;  << SEE COMMENT >>         <<MPEIV>>47788000
                                                               <<MPEIV>>47790000
RETDISCSPACE(LDEV, VDSLEN, VDSTART);                           <<MPEIV>>47792000
IF <> THEN MESSAGE(M328);  << DISC SPACE ERROR >>              <<MPEIV>>47794000
                                                               <<MPEIV>>47796000
<< INITIALIZE VARAIBLES >>                                     <<MPEIV>>47798000
VDSTOP := VDSTART + VDSLEN - 1D;                               <<MPEIV>>47800000
TYPE := LDT(LDEV+LDTSIZE+LDT2).TYP;                            <<MPEIV>>47802000
STYPE := LPDT(LDEV*LPDTSIZE+LPDT1).SUBTYPE;                    <<MPEIV>>47804000
IF TYPE = MHDISCTYPE THEN                                      <<MPEIV>>47806000
  TRACKLEN := MHINFO(STYPE*MHINFOSIZE+MHSECTRK)                <<MPEIV>>47808000
ELSE                                                           <<MPEIV>>47810000
  TRACKLEN := 32;                                              <<MPEIV>>47812000
<< FILL DEFECTIVE TRACKS TABLE >>                              <<MPEIV>>47814000
DISC(READ, LDEV, 1D, DTT, 128);                                <<MPEIV>>47816000
                                                               <<MPEIV>>47818000
IF TYPE=DISC0 OR TYPE=DISC1 THEN                               <<03549>>47820000
BEGIN                                                          <<03549>>47822000
I := 0;                                                        <<MPEIV>>47824000
WHILE (I:=I+1) <= DTT DO                                       <<MPEIV>>47826000
  IF DTT(I).(14:2) = 2 THEN                                    <<MPEIV>>47828000
    BEGIN  << DELETED TRACK >>                                 <<MPEIV>>47830000
    FSECT := D'( DTT(I)&LSR(2) ) * D'(TRACKLEN);               <<MPEIV>>47832000
    LSECT := FSECT + D'(TRACKLEN) - 1D;                        <<MPEIV>>47834000
    IF FSECT <= VDSTOP AND LSECT >= VDSTART THEN               <<MPEIV>>47836000
      BEGIN  << AT LEAST PARTIALLY IN VIRTUAL MEMORY >>        <<MPEIV>>47838000
      << REMOVE SPACE OF BAD TRACK THAT WAS IN VIRTUAL    >>   <<MPEIV>>47840000
      << MEMORY FROM FREE SPACE TABLE.                    >>   <<MPEIV>>47842000
      IF VDSTART > FSECT THEN                                  <<MPEIV>>47844000
        << PART OF BAD TRACK OVERLAPS FRONT OF VM >>           <<MPEIV>>47846000
        FSECT := VDSTART;  << ADJUST STARTING SECTOR >>        <<MPEIV>>47848000
      IF LSECT > VDSTOP THEN                                   <<MPEIV>>47850000
        << PART OF BAD TRACK OVERLAPS END OF VM >>             <<MPEIV>>47852000
        LSECT := VDSTOP;  << ADJUST ENDING SECTOR >>           <<MPEIV>>47854000
      BADLENGTH := (LSECT-FSECT) + 1D;                         <<MPEIV>>47856000
      REMDISCSPACE(LDEV, BADLENGTH, FSECT);                    <<MPEIV>>47858000
      IF <> THEN ERRMESSAGE(M329);  << DISC SPACE ERROR >>     <<MPEIV>>47860000
      END;  << BAD TRACK IN V.M. >>                            <<MPEIV>>47862000
    END;  << DELETED TRACK >>                                  <<MPEIV>>47864000
END;                                                           <<03549>>47866000
END;  << RELEASEVM >>                                          <<MPEIV>>47868000
PROCEDURE GETVM(LDEV, VDSLEN, VDSTART, SPECIFIC);              <<MPEIV>>47870000
VALUE LDEV, VDSLEN, SPECIFIC;                                  <<MPEIV>>47872000
DOUBLE  VDSLEN,   << LENGTH OF V.M. TO GET >>                  <<MPEIV>>47874000
        VDSTART;  << STARTING SECTOR OF V.M. (MAY BE INPUT  >> <<MPEIV>>47876000
                  << OR OUTPUT PARAMETER). SEE COMMENT.      >><<MPEIV>>47878000
LOGICAL LDEV,     << LDEV TO GET V.M. SPACE FROM >>            <<MPEIV>>47880000
        SPECIFIC; << TRUE - GET SPECIFIC SPACE REQUESTED >>    <<MPEIV>>47882000
OPTION VARIABLE;                                               <<MPEIV>>47884000
                                                               <<MPEIV>>47886000
COMMENT:  THIS PROCEDURE IS USED TO LOCATE SPACE FOR VIRTUAL   <<MPEIV>>47888000
MEMORY AND REMOVE IT FORM THE FREE SPACE TABLE. IF THE         <<MPEIV>>47890000
PARAMETER SPECIFIC IS TRUE THEN THE ONLY SPACE WE WILL ATTEMPT <<MPEIV>>47892000
TO LOCATE IS THAT STARTING AT SECTOR "VDSTART" FOR "VDSLEN"    <<MPEIV>>47894000
SECTORS.  IF SPECIFIC IS FALSE OR NOT PASSED THEN WE WILL      <<MPEIV>>47896000
LOCATE ANY SPACE OF LENGTH "VDSLEN" AND RETURN THE STARTING    <<MPEIV>>47898000
SECTOR IN VDSTART.                                             <<MPEIV>>47900000
  RETURN CODES:                                                <<MPEIV>>47902000
    CCE - NORMAL RETURN, SPACE FOUND,                          <<MPEIV>>47904000
    CCL - ABNORMAL RETURN, NO SPACE FOUND.                     <<MPEIV>>47906000
;                                                              <<MPEIV>>47908000
BEGIN                                                          <<MPEIV>>47910000
DOUBLE  FSECT,         << 1ST SECTOR OF BAD TRACK >>           <<MPEIV>>47912000
        LSECT,         << LAST   "    "    "      "   >>       <<MPEIV>>47914000
        BADLENGTH,     << LENGTH OF BAD AREA TO REMOVE >>      <<MPEIV>>47916000
        VDSTOP;        << LAST SECTOR OF VIRTUAL MEMORY >>     <<MPEIV>>47918000
                                                               <<MPEIV>>47920000
LOGICAL TYPE,          << DISC TYPE >>                         <<MPEIV>>47922000
        STYPE,         << DISC SUB TYPE >>                     <<MPEIV>>47924000
        TRACKLEN,      << LENGTH OF 1 TRACK ON THIS DISC >>    <<MPEIV>>47926000
        REASSIGNSRETURNED,                                     <<01819>>47928000
        VAR = Q-4;                                             <<MPEIV>>47930000
INTEGER I;             << WHILE LOOP COUNTER - DTT ENTRY # >>  <<MPEIV>>47932000
                                                               <<MPEIV>>47934000
IF NOT VAR THEN SPECIFIC := FALSE;                             <<MPEIV>>47936000
CC := CCE;                                                     <<MPEIV>>47938000
                                                               <<MPEIV>>47940000
TYPE := LDT(LDEV*LDTSIZE+LDT2).TYP;                            <<03549>>47944000
STYPE := LPDT(LDEV*LPDTSIZE+LPDT1).SUBTYPE;                    <<03549>>47946000
                                                               <<03549>>47948000
<< FILL DEFECTIVE TRACKS TABLE >>                              <<03549>>47950000
DISC(READ, LDEV, 1D, DTT, 128);                                <<03549>>47952000
                                                               <<03549>>47954000
IF RELOAD THEN                                                 <<03549>>47956000
   BEGIN                            << REMOVE REASSIGNED    >> <<03549>>47958000
   REM'RET'REASS(FALSE,LDEV,DTT);   << TRACKS FROM DFSM SO  >> <<03549>>47960000
   REASSIGNSRETURNED := FALSE;      << THERE WON'T BE ANY   >> <<03549>>47962000
                                    << IN VIRTUAL MEMORY    >> <<03549>>47964000
   END                                                         <<03549>>47966000
                                                               <<03549>>47968000
ELSE                            << IF NOT A RELOAD, SPACE  >>  <<03549>>47970000
   REASSIGNSRETURNED := TRUE;   << MAY BE IN USE BY A FILE >>  <<03549>>47972000
                                                               <<MPEIV>>47974000
<< WE'RE READY, LET'S TRY AND FIND SOME SPACE >>               <<MPEIV>>47976000
IF SPECIFIC THEN                                               <<MPEIV>>47978000
  REMDISCSPACE(LDEV, VDSLEN, VDSTART)                          <<MPEIV>>47980000
ELSE                                                           <<MPEIV>>47982000
  VDSTART := GETDISCSPACE(LDEV, VDSLEN);                       <<MPEIV>>47984000
                                                               <<MPEIV>>47986000
IF <> THEN                                                     <<MPEIV>>47988000
  BEGIN  << DIDN'T GET SPACE >>                                <<MPEIV>>47990000
  RETURNDELETES(LDEV);  << RETURN ALL DELETES >>               <<03549>>47992000
  IF SPECIFIC THEN                                             <<MPEIV>>47994000
    REMDISCSPACE(LDEV, VDSLEN, VDSTART)                        <<MPEIV>>47996000
  ELSE                                                         <<MPEIV>>47998000
    VDSTART := GETDISCSPACE(LDEV, VDSLEN);                     <<MPEIV>>48000000
                                                               <<MPEIV>>48002000
  IF <> THEN                                                   <<01963>>48004000
  IF RELOAD THEN                                               <<01963>>48006000
    BEGIN  << BUMMER - STILL DIDN'T GET SPACE >>               <<MPEIV>>48008000
    REM'RET'REASS(TRUE,LDEV,DTT);  << RETURN SPACE FOR      >> <<03549>>48010000
                                   <<    REASSIGNED TRACKS  >> <<03549>>48012000
    REASSIGNSRETURNED := TRUE;                                 <<MPEIV>>48014000
    << LAST CHANCE TO GET SPACE >>                             <<MPEIV>>48016000
    IF SPECIFIC THEN                                           <<MPEIV>>48018000
      REMDISCSPACE(LDEV, VDSLEN, VDSTART)                      <<MPEIV>>48020000
    ELSE                                                       <<MPEIV>>48022000
      VDSTART := GETDISCSPACE(LDEV, VDSLEN);                   <<MPEIV>>48024000
    IF <> THEN CC := CCL;  << WE GAVE IT OUR BEST SHOT & LOST>><<MPEIV>>48026000
    END                                                        <<01819>>48028000
  ELSE  << SPACE NOT FOUND AND NOT RELOAD >>                   <<01819>>48030000
    CC := CCL;                                                 <<01963>>48032000
    << NOTHING LEFT TO TRY >>                                  <<01819>>48034000
                                                               <<MPEIV>>48036000
  IF TYPE=DISC0 OR TYPE=DISC1 THEN                             <<03549>>48038000
  BEGIN                                                        <<03549>>48040000
  << IF ANY PORTION OF DELETED TRACK IS OUTSIDE V.M. THEN>>    <<MPEIV>>48042000
  << DELETE THAT PORTION FROM THE DFS TABLE.  OR IF NO   >>    <<MPEIV>>48044000
  << V.M. SPACE WAS FOUND (CC <> CCE) THEN DELETE WHOLE  >>    <<MPEIV>>48046000
  << TRACK.                                              >>    <<MPEIV>>48048000
  VDSTOP := VDSTART + VDSLEN - 1D;                             <<MPEIV>>48050000
  I := 0;                                                      <<MPEIV>>48052000
                                                               <<03549>>48054000
  IF TYPE=MHDISCTYPE THEN                                      <<03549>>48056000
    TRACKLEN := MHINFOL(STYPE*MHINFOSIZE+MHSECTRK)             <<03549>>48058000
  ELSE                                                         <<03549>>48060000
    TRACKLEN := 32;                                            <<03549>>48062000
                                                               <<03549>>48064000
  WHILE (I:=I+1) <= DTT DO                                     <<MPEIV>>48066000
    IF DTT(I).(14:2) = 2 THEN                                  <<MPEIV>>48068000
      BEGIN  << DELETED TRACK >>                               <<MPEIV>>48070000
      FSECT := D'( DTT(I)&LSR(2) ) * D'(TRACKLEN);             <<MPEIV>>48072000
      LSECT := FSECT + D'(TRACKLEN) - 1D;                      <<MPEIV>>48074000
                                                               <<MPEIV>>48076000
      IF FSECT <= VDSTOP AND LSECT >= VDSTART AND CC = CCE THEN<<MPEIV>>48078000
        BEGIN  << AT LEAST PART IN VIRTUAL MEMORY >>           <<MPEIV>>48080000
        IF FSECT >= VDSTART AND LSECT <= VDSTOP THEN           <<MPEIV>>48082000
          << BAD TRACK COMPLETELY IN V.M. >>                   <<MPEIV>>48084000
          GO TO NEXTDTTENTRY;                                  <<MPEIV>>48086000
        IF FSECT < VDSTART THEN                                <<MPEIV>>48088000
          << PART OVERLAPS FRONT OF V.M. >>                    <<MPEIV>>48090000
          LSECT := VDSTART - 1D;  << STOP AT FRONT OF V.M. >>  <<MPEIV>>48092000
        IF LSECT > VDSTOP THEN                                 <<MPEIV>>48094000
          << PART OVERLAPS END OF V.M. >>                      <<MPEIV>>48096000
          FSECT := VDSTOP + 1D;  << START JUST PAST V.M. >>    <<MPEIV>>48098000
        END  << AT LEAST PARTIALLY IN VIRTUAL MEMORY >>        <<MPEIV>>48100000
      ELSE                                                     <<MPEIV>>48102000
        BEGIN                                                  <<MPEIV>>48104000
        << DELETE WHOLE TRACK FROM DFS TABLE - EITHER NOT IN >><<MPEIV>>48106000
        << NEWLY ALLOCATED SPACE OR NO SPACE ALLOCATED.      >><<MPEIV>>48108000
        END;                                                   <<MPEIV>>48110000
      BADLENGTH := (LSECT-FSECT) + 1D;                         <<MPEIV>>48112000
      REMDISCSPACE(LDEV, BADLENGTH, FSECT);                    <<MPEIV>>48114000
      IF <> THEN ERRMESSAGE(M329);                             <<MPEIV>>48116000
NEXTDTTENTRY:                                                  <<MPEIV>>48118000
      END;  << DELETED TRACK >>                                <<MPEIV>>48120000
  END;                                                         <<03549>>48122000
  END;  << DIDN'T GET SPACE ON FIRST TRY >>                    <<MPEIV>>48124000
IF NOT REASSIGNSRETURNED THEN                                  <<MPEIV>>48126000
  REM'RET'REASS(TRUE,LDEV,DTT);    << RETURN SPACE FOR      >> <<03549>>48128000
                                   <<    REASSIGNED TRACKS  >> <<03549>>48130000
END;  << GETVM >>                                              <<MPEIV>>48132000
$PAGE "DEFECTIVE TRACKS TABLE PROCEDURES"                               48134000
$CONTROL SEGMENT=DEFECTRACKS                                            48136000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>48138000
         <<--------------------------------------->>           <<03549>>48140000
         << GET AN AREA FROM A LIST OF DISC AREAS >>           <<03549>>48142000
         <<--------------------------------------->>           <<03549>>48144000
LOGICAL PROCEDURE GET'AREA(AREA'LIST,ENTRY',MAX'ENTRIES,       <<03549>>48146000
                                 LDEV,DISC'ADDR,LENGTH);       <<03549>>48148000
VALUE ENTRY',MAX'ENTRIES;                                      <<03549>>48150000
INTEGER ARRAY                                                  <<03549>>48152000
   AREA'LIST;    << ARRAY OF 5-WORD ENTRIES IN THE FORMAT: >>  <<03549>>48154000
                 <<    WORD    0:  LDEV                    >>  <<03549>>48156000
                 <<    WORDS 1-2:  LOGICAL DISC ADDRESS    >>  <<03549>>48158000
                 <<    WORDS 2-3:  DOUBLE WORD LENGTH      >>  <<03549>>48160000
INTEGER                                                        <<03549>>48162000
   ENTRY',        << ENTRY NO. TO BE OBTAINED >>               <<03549>>48164000
   MAX'ENTRIES,   << MAXIMUM NO. OF ENTRIES IN AREA'LIST >>    <<03549>>48166000
   LDEV;          << RETURN LOGICAL DEVICE NO. >>              <<03549>>48168000
DOUBLE                                                         <<03549>>48170000
   DISC'ADDR,    << RETURN DOUBLE WORD DISC ADDRESS >>         <<03549>>48172000
   LENGTH;       << RETURN DOUBLE WORD LENGTH >>               <<03549>>48174000
                                                               <<03549>>48176000
COMMENT                                                        <<03549>>48178000
GETS AN ENTRY FROM AN ARRAY OF DISC AREAS.  THIS PROCEDURE IS  <<03549>>48180000
USED, FOR ONE THING, TO GET AREAS OF DISC WHICH LOST DATA      <<03549>>48182000
DURING DEFECTIVE TRACKS/SECTORS PROCESSING.  RECOVER LOST DISC <<03549>>48184000
SPACE LOOKS AT THIS ARRAY TO DETERMINE WHICH FILES MAY BE      <<03549>>48186000
MURGED.  IF THE PASSED ENTRY DOES NOT EXIST, IT RETURNS        <<03549>>48188000
FALSE, TRUE OTHERWISE.                                         <<03549>>48190000
;                                                              <<03549>>48192000
BEGIN                                                          <<03549>>48194000
EQUATE                                                         <<03549>>48196000
   ENT'SIZE = 5;     << SIZE OF ENTRY IN AREA'LIST >>          <<03549>>48198000
DOUBLE                                                         <<03549>>48200000
   DADDR,            << TEMP. FOR DISC'ADDR >>                 <<03549>>48202000
   LEN;              << TEMP. FOR LENGTH >>                    <<03549>>48204000
INTEGER                                                        <<03549>>48206000
   DADDR1=DADDR,           << HIGH ORDER WORD OF DADDR >>      <<03549>>48208000
   DADDR2=DADDR+1,         << LOW ORDER WORD OF DADDR >>       <<03549>>48210000
   LEN1=LEN,               << HIGH ORDER WORD OF LEN >>        <<03549>>48212000
   LEN2=LEN+1,             << LOW ORDER WORD OF LEN >>         <<03549>>48214000
   INDEX;                  << CURRENT INDEX INTO AREA'LIST >>  <<03549>>48216000
                                                               <<03549>>48218000
IF ENTRY' < MAX'ENTRIES THEN                                   <<03549>>48220000
   BEGIN                                                       <<03549>>48222000
   INDEX := ENTRY' * ENT'SIZE;   << GET STARTING INDEX >>      <<03549>>48224000
   LDEV := AREA'LIST(INDEX);       << GET LDEV >>              <<03549>>48226000
   DADDR1 := AREA'LIST(INDEX+1);   << GET DISC     >>          <<03549>>48228000
   DADDR2 := AREA'LIST(INDEX+2);   <<    ADDRESS   >>          <<03549>>48230000
   LEN1 := AREA'LIST(INDEX+3);     << GET LENGTH   >>          <<03549>>48232000
   LEN2 := AREA'LIST(INDEX+4);                                 <<03549>>48234000
                                                               <<03549>>48236000
   DISC'ADDR := DADDR;     << COPY TO RETURN PARAMETERS >>     <<03549>>48238000
   LENGTH := LEN;                                              <<03549>>48240000
   GET'AREA := TRUE;       << SUCCESSFUL--RETURN TRUE >>       <<03549>>48242000
   END                                                         <<03549>>48244000
                                                               <<03549>>48246000
ELSE                                                           <<03549>>48248000
   GET'AREA := FALSE;      << ENTRY DOESN'T EXIST >>           <<03549>>48250000
END;   << GET'AREA >>                                          <<03549>>48252000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>48254000
        <<------------------------------------------>>         <<03549>>48256000
        <<   ADD AN ENTRY TO A LIST OF DISC AREAS   >>         <<03549>>48258000
        <<------------------------------------------>>         <<03549>>48260000
LOGICAL PROCEDURE ADD'AREA(AREA'LIST,ENTRY',MAX'ENTRIES,       <<03549>>48262000
                                 LDEV,DISC'ADDR,LENGTH);       <<03549>>48264000
VALUE ENTRY',MAX'ENTRIES,LDEV,DISC'ADDR,LENGTH;                <<03549>>48266000
INTEGER ARRAY                                                  <<03549>>48268000
   AREA'LIST;     << ARRAY OF 5-WORD ENTRIES IN THE FORMAT: >> <<03549>>48270000
                  <<    WORD    0:  LDEV                    >> <<03549>>48272000
                  <<    WORDS 1-2:  LOGICAL DISC ADDRESS    >> <<03549>>48274000
                  <<    WORDS 2-3:  DOUBLE WORD LENGTH      >> <<03549>>48276000
INTEGER                                                        <<03549>>48278000
   ENTRY',         << ENTRY NO. TO BE ADDED >>                 <<03549>>48280000
   MAX'ENTRIES,    << MAXIMUM NUMBER OF ENTRIES IN AREA'LIST >><<03549>>48282000
   LDEV;           << LOGICAL DEVICE NO. >>                    <<03549>>48284000
DOUBLE                                                         <<03549>>48286000
   DISC'ADDR,     << DOUBLE WORD DISC ADDRESS >>               <<03549>>48288000
   LENGTH;        << DOUBLE WORD LENGTH >>                     <<03549>>48290000
                                                               <<03549>>48292000
COMMENT                                                        <<03549>>48294000
ADDS AN ENTRY TO AN ARRAY OF DISC AREAS.  THIS PROCEDURE IS    <<03549>>48296000
USED, FOR ONE THING, TO LOG AREAS OF DISC WHICH LOST DATA      <<03549>>48298000
DURING DEFECTIVE TRACKS PROCESSING.  RECOVER LOST DISC SPACE   <<03549>>48300000
THEN LOOKS AT THIS ARRAY TO DETERMINE WHICH FILES MAY BE       <<03549>>48302000
PURGED.  IF THERE IS NO ROOM FOR THE ENTRY, IT RETURNS         <<03549>>48304000
FALSE, TRUE OTHERWISE.                                         <<03549>>48306000
;                                                              <<03549>>48308000
BEGIN                                                          <<03549>>48310000
EQUATE                                                         <<03549>>48312000
   ENT'SIZE = 5;   << SIZE OF ENTRY IN AREA'LIST >>            <<03549>>48314000
INTEGER                                                        <<03549>>48316000
   DISC'ADDR1=DISC'ADDR,   << HIGH ORDER WORD OF DISC'ADDR >>  <<03549>>48318000
   DISC'ADDR2=DISC'ADDR+1, << LOW ORDER WORD OF DISC'ADDR  >>  <<03549>>48320000
   LENGTH1=LENGTH,         << HIGH ORDER WORD OF LENGTH >>     <<03549>>48322000
   LENGTH2=LENGTH+1,       << LOW ORDER WORD OF LENGTH >>      <<03549>>48324000
   INDEX;                  << CURRENT INDEX INTO AREA'LIST >>  <<03549>>48326000
                                                               <<03549>>48328000
IF ENTRY' < MAX'ENTRIES THEN                                   <<03549>>48330000
   BEGIN                                                       <<03549>>48332000
   INDEX := ENTRY' * ENT'SIZE;    << GET STARTING INDEX >>     <<03549>>48334000
   AREA'LIST(INDEX)   := LDEV;     << PUT LDEV IN >>           <<03549>>48336000
   AREA'LIST(INDEX+1) := DISC'ADDR1;   << PUT DISC ADDRESS >>  <<03549>>48338000
   AREA'LIST(INDEX+2) := DISC'ADDR2;   <<    IN            >>  <<03549>>48340000
   AREA'LIST(INDEX+3) := LENGTH1;      << PUT LENGTH IN >>     <<03549>>48342000
   AREA'LIST(INDEX+4) := LENGTH2;                              <<03549>>48344000
   ADD'AREA := TRUE;         << SUCCESSFUL--RETURN TRUE >>     <<03549>>48346000
   END                                                         <<03549>>48348000
                                                               <<03549>>48350000
ELSE                                                           <<03549>>48352000
   ADD'AREA := FALSE;        << NO ROOM--RETURN FALSE >>       <<03549>>48354000
END;   << ADD'AREA >>                                          <<03549>>48356000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>48358000
          <<-----------------------                                     48360000
            GET TRACK DISPOSITION                                       48362000
          ----------------------->>                                     48364000
  INTEGER PROCEDURE GETDISP(LEGAL);                                     48366000
    VALUE LEGAL;                                                        48368000
    LOGICAL LEGAL;                                                      48370000
    COMMENT                                                             48372000
      ASKS THE OPERATOR FOR THE DISPOSTION OF A DEFECTIVE TRACK.        48374000
    LEGAL CONTAINS A BITMASK DEFINING THE LEGAL ANSWERS AND GETDISP     48376000
    RETURNS THE ANSWER GIVEN AS FOLLOWS:                                48378000
        ANSWER         LEGAL BIT    GETDISP RETURN                      48380000
        ------         ---------    --------------                      48382000
       IGNORE (CR)         15             0                             48384000
       RECOVER             14             1                             48386000
       DELETE              13             2                             48388000
       REASSIGN            12             3;                            48390000
                                                                        48392000
      BEGIN                                                             48394000
        INTEGER I;                                                      48396000
        BYTE ARRAY ANS(0:8)=PB:="REC","DEL","REA";                      48398000
  REQDISP:IF LEGAL=7 THEN TOS := -M2231  <<DELETE OR RECOVER>> <<01103>>48400000
          ELSE IF LEGAL=%14 THEN TOS := -M2232<<DELETE OR REA>><<01103>>48402000
                                                               <<03613>>48404000
          << Reassign, Recover, Ignore >>                      <<03613>>48406000
          ELSE IF legal = %13 THEN                             <<03613>>48408000
             TOS := -m2247                                     <<03613>>48410000
                                                               <<03613>>48412000
          ELSE TOS := -M2233;    <<DELETE,REASSIGN OR RECOVER>><<01103>>48414000
          MESSAGE(*);                                          <<01103>>48416000
          READINPUT;                                                    48418000
          SCAN BINBUF WHILE BLANK;                                      48420000
          IF CARRY THEN                                                 48422000
            BEGIN                                                       48424000
              X := 15;  <<IGNORE>>                                      48426000
              GOTO CHECKDISP;                                           48428000
            END;                                                        48430000
          GETSTR(BBUF,@REQDISP,1,8);                                    48432000
          I := 0;                                                       48434000
          DO IF BBUF=ANS(I*3),(3) THEN GOTO OK UNTIL (I:=I+1)=3;        48436000
  ERROR:  MESSAGE(M2453);  <<ILLEGAL INPUT>>                   <<01103>>48438000
          GO REQDISP;                                                   48440000
  OK:     X := 14-I;                                                    48442000
  CHECKDISP:                                                            48444000
          TOS := LEGAL;                                                 48446000
          ASSEMBLE(TBC 0,X);                                            48448000
          IF = THEN GOTO ERROR;  <<THAT ANSWER NOT ALLOWED>>            48450000
          GETDISP := 15-X;                                              48452000
      END <<GETDISP>> ;                                                 48454000
          <<--------------------------------------                      48456000
            CONVERT TRACK # TO CYLINDER AND HEAD                        48458000
          -------------------------------------->>                      48460000
  DOUBLE PROCEDURE CYLINDERHEAD(TRACK,SUBTYP);                          48462000
    VALUE TRACK,SUBTYP;                                                 48464000
    INTEGER TRACK,SUBTYP;                                               48466000
    COMMENT                                                             48468000
      CONVERTS THE TRACK NUMBER SUPPLIED INTO A CYLINDER NUMBER         48470000
    AND HEAD NUMBER BASED ON THE SUBTYPE OF THE DISC;                   48472000
      BEGIN                                                             48474000
        INTEGER CYLINDER=CYLINDERHEAD+1, HEAD=CYLINDERHEAD, INDEX;      48476000
          TOS := TRACK;                                                 48478000
          TOS := MHINFO((INDEX:=SUBTYP*MHINFOSIZE)+MHTRKCYL);<<TRK/CYL>>48480000
          ASSEMBLE(DIV);                                                48482000
          HEAD := TOS*MHINFO(INDEX+MHTRKMULT)+MHINFO(INDEX+MHSTHEAD);   48484000
          CYLINDER := TOS;  <<CYLINDER #>>                              48486000
      END <<CYLINDERHEAD>> ;                                            48488000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>48490000
          <<------------------------------------>>             <<03549>>48492000
          <<      CHECK FOR A VALID DTT         >>             <<03549>>48494000
          <<------------------------------------>>             <<03549>>48496000
LOGICAL PROCEDURE GOOD'DTT(DTT);                               <<03549>>48498000
INTEGER ARRAY                                                  <<03549>>48500000
   DTT;      << DEFECTIVE TRACKS TABLE >>                      <<03549>>48502000
                                                               <<03549>>48504000
COMMENT                                                        <<03549>>48506000
CHECKS FOR A VALID DEFECTIVE TRACKS TABLE.                     <<03549>>48508000
;                                                              <<03549>>48510000
BEGIN                                                          <<03549>>48512000
IF 0 <= DTT(0) <= MAXDTT THEN                                  <<03549>>48514000
   GOOD'DTT := TRUE                                            <<03549>>48516000
ELSE                                                           <<03549>>48518000
   GOOD'DTT := FALSE;                                          <<03549>>48520000
END;   << GOOD'DTT >>                                          <<03549>>48522000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>48524000
         <<------------------------------------>>              <<03549>>48526000
         <<  SORT THE DEFECTIVE TRACKS TABLE   >>              <<03549>>48528000
         <<------------------------------------>>              <<03549>>48530000
PROCEDURE SORTDTT(DTT);                                        <<03549>>48532000
INTEGER ARRAY                                                  <<03549>>48534000
   DTT;     << DEFECTIVE TRACKS TABLE >>                       <<03549>>48536000
                                                               <<03549>>48538000
COMMENT                                                        <<03549>>48540000
THIS PROCEDURE SORTS THE DEFECTIVE TRACKS TABLE IN             <<03549>>48542000
ORDER OF INCREASING TRACK #.                                   <<03549>>48544000
;                                                              <<03549>>48546000
BEGIN                                                          <<03549>>48548000
INTEGER                                                        <<03549>>48550000
   I,J,TEMP;    << SCRATCH VARIABLES >>                        <<03549>>48552000
                                                               <<03549>>48554000
I := 0;                                                        <<03549>>48556000
WHILE (I:=I+1) < DTT(0) DO                                     <<03549>>48558000
   BEGIN      << SORT TRACKS USING BUBBLESORT >>               <<03549>>48560000
   J := I;                                                     <<03549>>48562000
   WHILE (J:=J+1) <= DTT(0) DO                                 <<03549>>48564000
      IF DTT(I) > DTT(J) THEN                                  <<03549>>48566000
         BEGIN              << REVERSE THE ORDER >>            <<03549>>48568000
         TEMP := DTT(I);    <<   OF TWO ELEMENTS >>            <<03549>>48570000
         DTT(I) := DTT(J);                                     <<03549>>48572000
         DTT(J) := TEMP;                                       <<03549>>48574000
         END;                                                  <<03549>>48576000
   END;                                                        <<03549>>48578000
END;   << SORTDTT >>                                           <<03549>>48580000
          <<-------------------------------------                       48582000
            ADD ENTRY TO DEFECTIVE TRACKS TABLE                         48584000
          ------------------------------------->>                       48586000
  INTEGER PROCEDURE ADDDTTENTRY(TRACK);                                 48588000
    VALUE TRACK;                                                        48590000
    INTEGER TRACK;                                                      48592000
    COMMENT                                                             48594000
      ADDS THE ENTRY SPECIFIED BY TRACK TO THE DEFECTIVE TRACKS         48596000
    TABLE. IF THE ENTRY IS ALREADY IN THE TABLE OR THE TABLE IS         48598000
    FULL, RETURNS A ZERO, OTHERWISE A ONE;                              48600000
      BEGIN                                                             48602000
        INTEGER I:=0;                                                   48604000
          IF DTT=MAXDTT THEN RETURN;  <<TABLE FULL>>           <<00463>>48606000
          WHILE (I:=I+1) <= DTT DO                                      48608000
            BEGIN  <<FIND WHERE IT GOES>>                               48610000
              IF DTT(I)=TRACK THEN RETURN;  <<ALREADY IN TABLE>>        48612000
              IF > THEN                                                 48614000
                BEGIN  <<MAKE ROOM FOR IT>>                             48616000
                  MOVE DTT(DTT+1) := DTT(X:=X-1),(I-DTT-1);             48618000
                  GOTO ADD;                                             48620000
                END;                                                    48622000
            END;                                                        48624000
  ADD:    DTT(I) := TRACK;                                              48626000
          DTT := DTT+1;                                                 48628000
          ADDDTTENTRY := 1;                                             48630000
      END <<ADDDTTENTRY>> ;                                             48632000
          <<------------------------------------------                  48634000
            DELETE ENTRY FROM DEFECTIVE TRACKS TABLE                    48636000
          ------------------------------------------>>                  48638000
  INTEGER PROCEDURE DELDTTENTRY(TRACK);                                 48640000
    VALUE TRACK;                                                        48642000
    INTEGER TRACK;                                                      48644000
    COMMENT                                                             48646000
      REMOVES THE ENTRY WITH THE SPECIFIED TRACK NUMBER AND STATUS      48648000
    (FOUND IN TRACK) FROM THE DTT IF IT EXISTS AND RETURNS -1. IF       48650000
    IT DOES NOT EXIST, RETURNS ZERO;                                    48652000
      BEGIN                                                             48654000
        INTEGER I:=0;                                                   48656000
          WHILE (I:=I+1) <= DTT DO                                      48658000
          IF DTT(I) = TRACK THEN                                        48660000
            BEGIN  <<FOUND IT>>                                         48662000
              DELDTTENTRY := -1;                                        48664000
              MOVE DTT(I) := DTT(I+1),(DTT-I);                          48666000
              DTT := DTT-1;                                             48668000
              RETURN;                                                   48670000
            END;                                                        48672000
      END <<DELDTTENTRY>> ;                                             48674000
          <<---------------------------------------                     48676000
            DELETE ALL ENTRIES FOR TRACK FROM DTT                       48678000
          --------------------------------------->>                     48680000
  INTEGER PROCEDURE DELDTTENTRIES(TRACK);                               48682000
    VALUE TRACK;                                                        48684000
    INTEGER TRACK;                                                      48686000
    COMMENT                                                             48688000
      REMOVES ALL ENTRIES FOR THE SPECIFIED TRACK FROM THE DTT. (TRACK  48690000
    CONTAINS ONLY THE TRACK NUMBER RIGHT JUSTIFIED, NOT ANY STATUS      48692000
    BITS). RETURNS -(# OF WORDS REMOVED);                               48694000
      BEGIN                                                             48696000
        INTEGER COUNT=DELDTTENTRIES, I:=0;                              48698000
          WHILE (I:=I+1) <= DTT DO                                      48700000
          IF DTT(I)&LSR(2)=TRACK THEN                                   48702000
            BEGIN                                                       48704000
  ANOTHER:    COUNT := COUNT+1;                                         48706000
              IF DTT(I:=I+1)&LSR(2)=TRACK THEN GOTO ANOTHER;            48708000
              MOVE DTT(I-COUNT) := DTT(I),(DTT-I+1);                    48710000
              COUNT := -COUNT;                                          48712000
              DTT := DTT+COUNT;                                         48714000
              RETURN;                                                   48716000
            END;                                                        48718000
      END <<DELDTTENTRIES>> ;                                           48720000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>48722000
       <<--------------------------------------->>             <<03549>>48724000
       << INITIALIZE THE DEFECTIVE SECTOR TABLE >>             <<03549>>48726000
       <<--------------------------------------->>             <<03549>>48728000
PROCEDURE INIT'DSCT(DSCT);                                     <<03549>>48730000
INTEGER ARRAY                                                  <<03549>>48732000
   DSCT;       << DEFECTIVE SECTOR TABLE >>                    <<03549>>48734000
                                                               <<03549>>48736000
COMMENT                                                        <<03549>>48738000
INITIALIZES THE DEFECTIVE SECTOR TABLE--SETS UP THE HEADER.    <<03549>>48740000
;                                                              <<03549>>48742000
BEGIN                                                          <<03549>>48744000
                                                               <<03549>>48746000
DSCT(DSCT'NUM'ENTRIES) := 0;         << NO ENTRIES YET >>      <<03549>>48748000
DSCT(DSCT'FIRST'ENTRY) := 6;         << INDEX TO FIRST ENTRY>> <<03549>>48750000
DSCT(DSCT'ENTRY'SIZE)  := 2;         << WORDS PER ENTRY >>     <<03549>>48752000
DSCT(DSCT'MAX'ENTRIES) := MAX'DSCT;  << MAX. NO. OF ENTRIES >> <<03549>>48754000
DSCT(4) := 0;                                                  <<03549>>48756000
DSCT(5) := 0;                                                  <<03549>>48758000
                                                               <<03549>>48760000
END;   << INIT'DSCT >>                                         <<03549>>48762000
$CONTROL SEGMENT=RESIDENT                                      <<03668>>48764000
      <<---------------------------------------->>             <<03549>>48766000
      <<       CHECK FOR A VALID DSCT           >>             <<03549>>48768000
      <<---------------------------------------->>             <<03549>>48770000
LOGICAL PROCEDURE GOOD'DSCT(DSCT);                             <<03549>>48772000
INTEGER ARRAY                                                  <<03549>>48774000
   DSCT;     << DEFECTIVE SECTOR TABLE >>                      <<03549>>48776000
                                                               <<03549>>48778000
COMMENT                                                        <<03549>>48780000
CHECKS TO SEE IF THE DSCT IS VALID                             <<03549>>48782000
;                                                              <<03549>>48784000
BEGIN                                                          <<03549>>48786000
IF 0 <= DSCT(DSCT'NUM'ENTRIES) <= MAX'DSCT AND                 <<03549>>48788000
   DSCT(DSCT'FIRST'ENTRY) = 6 AND                              <<03549>>48790000
   DSCT(DSCT'ENTRY'SIZE)  = 2 AND                              <<03549>>48792000
   DSCT(DSCT'MAX'ENTRIES) = MAX'DSCT AND                       <<03549>>48794000
   DSCT(4) = 0 AND                                             <<03549>>48796000
   DSCT(5) = 0 THEN                                            <<03549>>48798000
   GOOD'DSCT := TRUE                                           <<03549>>48800000
ELSE                                                           <<03549>>48802000
   GOOD'DSCT := FALSE;                                         <<03549>>48804000
END;   << GOOD'DSCT >>                                         <<03549>>48806000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>48808000
        <<----------------------------------->>                <<03549>>48810000
        <<    CHECK FOR A VALID DISC LABEL   >>                <<03549>>48812000
        <<----------------------------------->>                <<03549>>48814000
LOGICAL PROCEDURE GOOD'LABEL(DLABEL,TYPE,SUBTYP);              <<03549>>48816000
VALUE TYPE, SUBTYP;                                            <<03549>>48818000
INTEGER ARRAY                                                  <<03549>>48820000
   DLABEL;      << DISC LABEL >>                               <<03549>>48822000
INTEGER                                                        <<03549>>48824000
   TYPE,        << DEVICE TYPE >>                              <<03549>>48826000
   SUBTYP;      << DEVICE SUBTYPE >>                           <<03549>>48828000
COMMENT                                                        <<03549>>48830000
CHECKS TO SEE IF THE DISC LABEL 'DLABEL' IS VALID FOR A        <<03549>>48832000
SYSTEM-DOMAIN DISC WITH THE GIVEN TYPE AND SUBTYPE.  IF SO,    <<03549>>48834000
GOOD'LABEL RETURNS TRUE, OTHERWISE FALSE.                      <<03549>>48836000
;                                                              <<03549>>48838000
BEGIN                                                          <<03549>>48840000
BYTE ARRAY                                                     <<03549>>48842000
   BLABEL(*) = DLABEL;                                         <<03549>>48844000
                                                               <<03549>>48846000
IF BLABEL(LABSYSID) = "3000" AND                               <<03549>>48848000
   TYPE = DLABEL(LAB6).LABDTYPE AND                            <<03549>>48850000
   SUBTYP = DLABEL(LAB6).LABDSUBTYPE THEN                      <<03549>>48852000
                                                               <<03549>>48854000
   GOOD'LABEL := TRUE                                          <<03549>>48856000
                                                               <<03549>>48858000
ELSE                                                           <<03549>>48860000
                                                               <<03549>>48862000
   GOOD'LABEL := FALSE;                                        <<03549>>48864000
END;   << GOOD'LABEL >>                                        <<03549>>48866000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>48870000
     <<------------------------------------------->>           <<03549>>48872000
     <<   VALIDATE DISC LABEL AND DTT OR DSCT     >>           <<03549>>48874000
     <<------------------------------------------->>           <<03549>>48876000
INTEGER PROCEDURE VALID'SYSDISC(TYPE,SUBTYP,DLABEL,            <<03549>>48878000
                                       DTT'OR'DSCT);           <<03549>>48880000
VALUE TYPE,SUBTYP;                                             <<03549>>48882000
INTEGER                                                        <<03549>>48884000
   TYPE,      << DEVICE TYPE OF DISC >>                        <<03549>>48886000
   SUBTYP;    << DEVICE SUBTYPE OF DISC >>                     <<03549>>48888000
INTEGER ARRAY                                                  <<03549>>48890000
   DLABEL,         << DISC LABEL >>                            <<03549>>48892000
   DTT'OR'DSCT;    << DTT (TYPES 0,1) OR DSCT (TYPE 3) >>      <<03549>>48894000
COMMENT                                                        <<03549>>48896000
THIS PROCEDURE CHECKS TO SEE IF THE LABEL AND DEFECTIVE        <<03549>>48898000
TRACKS TABLE OR DEFECTIVE SECTOR TABLE IS VALID FOR A          <<03549>>48900000
SYSTEM DOMAIN DISC.   THE RETURN VALUES ARE:                   <<03549>>48902000
              0   =  OK                                        <<03549>>48904000
              1   =  NOT A SYSTEM-DOMAIN DISC LABEL            <<03549>>48906000
              2   =  BAD DTT                                   <<03549>>48908000
              3   =  BAD DSCT                                  <<03549>>48910000
;                                                              <<03549>>48912000
BEGIN                                                          <<03549>>48914000
                                                               <<03549>>48916000
VALID'SYSDISC := 0;   << INIT. RETURN TO OK >>                 <<03549>>48918000
                                                               <<03549>>48920000
IF GOOD'LABEL(DLABEL,TYPE,SUBTYP) THEN   << GOOD DISC LABEL >> <<03549>>48922000
                                                               <<03549>>48924000
   IF TYPE=DISC0 OR TYPE=DISC1 THEN                            <<03549>>48926000
      IF NOT GOOD'DTT(DTT'OR'DSCT) THEN                        <<03549>>48928000
         VALID'SYSDISC := 2            << BAD DTT >>           <<03549>>48930000
      ELSE               << DO NOTHING >>                      <<03549>>48932000
                                                               <<03549>>48934000
   ELSE IF TYPE=DISC3 THEN                                     <<03549>>48936000
      IF NOT GOOD'DSCT(DTT'OR'DSCT) THEN                       <<03549>>48938000
         VALID'SYSDISC := 3            << BAD DSCT >>          <<03549>>48940000
      ELSE               << DO NOTHING >>                      <<03549>>48942000
                                                               <<03549>>48944000
   ELSE            << DO NOTHING >>                            <<03549>>48946000
                                                               <<03549>>48948000
ELSE                                                           <<03549>>48950000
   VALID'SYSDISC := 1;    << BAD DISC LABEL >>                 <<03549>>48952000
END;   << VALID'SYSDISC >>                                     <<03549>>48954000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>48956000
        <<------------------------------------------->>        <<03549>>48958000
        <<   CHECK FOR A VALID SYSTEM-DOMAIN DISC    >>        <<03549>>48960000
        <<------------------------------------------->>        <<03549>>48962000
INTEGER PROCEDURE VALID'DISC(LDEV);                            <<03549>>48964000
VALUE LDEV;                                                    <<03549>>48966000
INTEGER                                                        <<03549>>48968000
   LDEV;    << LOGICAL DEVICE NO. >>                           <<03549>>48970000
                                                               <<03549>>48972000
COMMENT                                                        <<03549>>48974000
THIS PROCEDURE DETERMINES IF THE GIVEN LDEV IS A VALID         <<03549>>48976000
SYSTEM-DOMAIN DISC.  IT PRINTS MESSAGES WHEN IT DETECTS        <<03549>>48978000
ERRORS, AND RETURNS ONE OF THE FOLLOWING VALUES:               <<03549>>48980000
                                                               <<03549>>48982000
                   0  =  OK                                    <<03549>>48984000
                   1  =  BAD LABEL                             <<03549>>48986000
                   2  =  BAD DTT                               <<03549>>48988000
                   4  =  DISC NOT ON-LINE                      <<03549>>48990000
                   5  =  NOT A DISC                            <<03549>>48992000
                                                               <<03549>>48994000
IF AN INVALID DSCT IS FOUND, IT IS REPAIRED AND WRITTEN OUT TO <<03549>>48996000
THE DISC--NO ERROR IS RETURNED.                                <<03549>>48998000
;                                                              <<03549>>49000000
BEGIN                                                          <<03549>>49002000
INTEGER ARRAY                                                  <<03549>>49004000
   DLABEL(0:127),          << DISC LABEL >>                    <<03549>>49006000
   DTT'OR'DSCT(0:127);     << DEFECTIVE TRACKS TABLE OR >>     <<03549>>49008000
                           << DEFECTIVE SECTOR TABLE    >>     <<03549>>49010000
DOUBLE                                                         <<03549>>49012000
   DTEMP;     << TEMP FOR DRIVER STATUS RETURN >>              <<03549>>49014000
INTEGER                                                        <<03549>>49016000
   TYPE,      << DEVICE TYPE >>                                <<03549>>49018000
   SUBTYP,    << DEVICE SUBTYPE >>                             <<03549>>49020000
   DTEMP2 = DTEMP+1;    << SECOND WORD OF STATUS RETURN >>     <<03549>>49022000
                                                               <<03549>>49024000
VALID'DISC := 0;                                               <<03549>>49026000
IF NON'DS'LDEV(LDEV) AND    << CHECK THAT IT'S A REAL DISC >>  <<03549>>49028000
   LDT(LDEV*LDTSIZE+LDT2).RANGE = DIRACCESS THEN               <<03549>>49030000
   BEGIN                                                       <<03549>>49032000
                                                               <<03549>>49034000
   DISC(RSTAT,LDEV,0D,DTEMP,2);    <<SEE IF DISC IS ON-LINE>>  <<03549>>49036000
   IF DTEMP2.NREADYF=1 THEN                                    <<03549>>49038000
      BEGIN                                                    <<03549>>49040000
      MESSAGE(M2408,LDEV);   << LDEV NOT READY >>              <<03549>>49042000
      VALID'DISC := 4;                                         <<03549>>49044000
      END                                                      <<03549>>49046000
                                                               <<03549>>49048000
   ELSE                                                        <<03549>>49050000
      BEGIN                                                    <<03549>>49052000
      TYPE := LDT(LDEV*LDTSIZE+LDT2).TYP;                      <<03549>>49054000
      SUBTYP := LPDT(LDEV*LPDTSIZE+LPDT1).SUBTYPE;             <<03549>>49056000
                                                               <<03549>>49058000
    << READ THE DISC LABEL AND THE DEFECTIVE TRACKS TABLE >>   <<03549>>49060000
    <<    OR THE DEFECTIVE SECTOR TABLE                   >>   <<03549>>49062000
                                                               <<03549>>49064000
      DISC(READ,LDEV,0D,DLABEL,128);                           <<03549>>49066000
      DISC(READ,LDEV,1D,DTT'OR'DSCT,128);                      <<03549>>49068000
                                                               <<03549>>49070000
    << CHECK DISC LABEL AND DTT OR DSCT FOR VALIDITY >>        <<03549>>49072000
                                                               <<03549>>49074000
      CASE (VALID'DISC := VALID'SYSDISC(TYPE,SUBTYP,DLABEL,    <<03549>>49076000
                                              DTT'OR'DSCT)) OF <<03549>>49078000
         BEGIN                                                 <<03549>>49080000
         <<  0 >> ;                    << ALL FINE >>          <<03549>>49082000
         <<  1 >> MESSAGE(M234,LDEV);  << BAD LABEL >>         <<03549>>49084000
         <<  2 >> MESSAGE(M235,LDEV);  << BAD DTT >>           <<03549>>49086000
         <<  3 >> BEGIN                                        <<03549>>49088000
                  MESSAGE(M2503,LDEV); << BAD DSCT--REPAIRED>> <<03549>>49090000
                                                               <<03549>>49092000
                  << BAD DSCT WAS FOUND--REINITIALIZE AND >>   <<03549>>49094000
                  << WRITE IT OUT                         >>   <<03549>>49096000
                                                               <<03549>>49098000
                  INIT'DSCT(DTT'OR'DSCT);                      <<03549>>49100000
                  DISC(WRITE,LDEV,1D,DTT'OR'DSCT,128);         <<03549>>49102000
                  VALID'DISC := 0;    << DON'T RETURN ERROR >> <<03549>>49104000
                  END;                                         <<03549>>49106000
         END;                                                  <<03549>>49108000
      END;                                                     <<03549>>49110000
   END                                                         <<03549>>49112000
                                                               <<03549>>49114000
ELSE                                                           <<03549>>49116000
   BEGIN                                                       <<03549>>49118000
   MESSAGE(M2235,LDEV);     << NOT A DISC >>                   <<03549>>49120000
   VALID'DISC := 5;                                            <<03549>>49122000
   END;                                                        <<03549>>49124000
END;   << VALID'DISC >>                                        <<03549>>49126000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>49128000
          <<-------------------------------------->>           <<03549>>49130000
          <<  GET THE LAST ENTRY FROM THE DSCT    >>           <<03549>>49132000
          <<-------------------------------------->>           <<03549>>49134000
LOGICAL PROCEDURE GET'DSCT'ENTRY( DSCT, DISC'ADDRESS);         <<03549>>49136000
INTEGER ARRAY                                                  <<03549>>49138000
   DSCT;       << DEFECTIVE SECTOR TABLE >>                    <<03549>>49140000
DOUBLE                                                         <<03549>>49142000
   DISC'ADDRESS;   << RETURN DISC ADDRESS--LAST >>             <<03549>>49144000
                   <<    ENTRY IN THE DSCT      >>             <<03549>>49146000
COMMENT                                                        <<03549>>49148000
THIS PROCEDURE RETURNS THE CURRENT LAST ENTRY IN THE DSCT.     <<03549>>49150000
IT DOES NOT REMOVE THE ENTRY FROM THE DSCT.  IF THERE ARE      <<03549>>49152000
NO ENTRIES IN THE TABLE, IT RETURNS FALSE, OTHERWISE TRUE.     <<03549>>49154000
;                                                              <<03549>>49156000
BEGIN                                                          <<03549>>49158000
DOUBLE                                                         <<03549>>49160000
   TEMP;      << TEMP. FOR DISC'ADDRESS >>                     <<03549>>49162000
INTEGER                                                        <<03549>>49164000
   TEMP1=TEMP,      << HIGH ORDER WORD OF TEMP >>              <<03549>>49166000
   TEMP2=TEMP+1,    << LOW ORDER WORD OF TEMP  >>              <<03549>>49168000
   INDEX;           << CURRENT INDEX INTO DSCT >>              <<03549>>49170000
                                                               <<03549>>49172000
IF DSCT(DSCT'NUM'ENTRIES) > 0 THEN                             <<03549>>49174000
   BEGIN                                                       <<03549>>49176000
                                                               <<03549>>49178000
 << DETERMINE THE INDEX TO THE LAST ENTRY >>                   <<03549>>49180000
                                                               <<03549>>49182000
   INDEX := DSCT(DSCT'FIRST'ENTRY) +                           <<03549>>49184000
            (DSCT(DSCT'NUM'ENTRIES) - 1) *                     <<03549>>49186000
            DSCT(DSCT'ENTRY'SIZE);                             <<03549>>49188000
                                                               <<03549>>49190000
   TEMP1 := DSCT(INDEX);     << GET THE ENTRY >>               <<03549>>49192000
   TEMP2 := DSCT(INDEX+1);                                     <<03549>>49194000
   DISC'ADDRESS := TEMP;     << COPY IT TO RETURN PARAMETER >> <<03549>>49196000
   GET'DSCT'ENTRY := TRUE;   << RETURN SUCCESSFUL >>           <<03549>>49198000
   END                                                         <<03549>>49200000
                                                               <<03549>>49202000
ELSE                                                           <<03549>>49204000
   GET'DSCT'ENTRY := FALSE;   << NO MORE ENTRIES >>            <<03549>>49206000
END;   << GET'DSCT'ENTRY >>                                    <<03549>>49208000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>49210000
           <<---------------------------------->>              <<03549>>49212000
           <<   REMOVE THE LAST DSCT ENTRY     >>              <<03549>>49214000
           <<---------------------------------->>              <<03549>>49216000
PROCEDURE REMOVE'DSCT'ENTRY( DSCT);                            <<03549>>49218000
INTEGER ARRAY                                                  <<03549>>49220000
   DSCT;    << DEFECTIVE SECTOR TABLE >>                       <<03549>>49222000
                                                               <<03549>>49224000
COMMENT                                                        <<03549>>49226000
REMOVES THE LAST ENTRY IN THE DSCT AND UPDATES THE TABLE       <<03549>>49228000
HEADER ACCORDINGLY.  THIS PROCEDURE DOES NOT POST THE          <<03549>>49230000
DSCT TO DISC.                                                  <<03549>>49232000
;                                                              <<03549>>49234000
BEGIN                                                          <<03549>>49236000
INTEGER                                                        <<03549>>49238000
   INDEX;      << CURRENT INDEX INTO THE DSCT >>               <<03549>>49240000
                                                               <<03549>>49242000
IF DSCT(DSCT'NUM'ENTRIES) > 0 THEN                             <<03549>>49244000
   BEGIN                                                       <<03549>>49246000
                                                               <<03549>>49248000
 << DETERMINE THE INDEX TO THE LAST DSCT ENTRY >>              <<03549>>49250000
                                                               <<03549>>49252000
   INDEX := DSCT(DSCT'FIRST'ENTRY) +                           <<03549>>49254000
            (DSCT(DSCT'NUM'ENTRIES) - 1) *                     <<03549>>49256000
            DSCT(DSCT'ENTRY'SIZE);                             <<03549>>49258000
                                                               <<03549>>49260000
   I := -1;                                                    <<03549>>49262000
   WHILE (I:=I+1) < DSCT(DSCT'ENTRY'SIZE) DO   << ZERO THE  >> <<03549>>49264000
      DSCT(INDEX + I) := 0;                    <<   ENTRY   >> <<03549>>49266000
                                                               <<03549>>49268000
   DSCT(DSCT'NUM'ENTRIES) :=         << DECREMENT THE NO.  >>  <<03549>>49270000
      DSCT(DSCT'NUM'ENTRIES) - 1;    <<    OF DSCT ENTRIES >>  <<03549>>49272000
   END;                                                        <<03549>>49274000
END;   << REMOVE'DSCT'ENTRY >>                                 <<03549>>49276000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03630>>49278000
       <<---------------------------------------->>            <<03630>>49280000
       <<  GET INFORMATION ABOUT A CS'80 DEVICE  >>            <<03630>>49282000
       <<---------------------------------------->>            <<03630>>49284000
PROCEDURE CS80'INFO( LDEV,SECTORS'PER'TRACK,NUM'HEADS,         <<03630>>49286000
                                              NUM'CYLS);       <<03630>>49288000
VALUE LDEV;                                                    <<03630>>49290000
INTEGER                                                        <<03630>>49292000
   LDEV;                 << LOGICAL DEVICE NO. >>              <<03630>>49294000
LOGICAL                                                        <<03630>>49296000
   SECTORS'PER'TRACK,    << RETURN NO. OF SECTORS PER TRACK >> <<03630>>49298000
   NUM'HEADS;            << RETURN NO. OF HEADS ON DISC >>     <<03630>>49300000
DOUBLE                                                         <<03630>>49302000
   NUM'CYLS;             << RETURN NO. OF CYLINDERS ON DISC >> <<03630>>49304000
                                                               <<03630>>49306000
COMMENT                                                        <<03630>>49308000
RETURNS INFORMATION ABOUT A CS80 DEVICE, OBTAINED FROM THE     <<03630>>49310000
DESCRIBE COMMAND.                                              <<03630>>49312000
;                                                              <<03630>>49314000
BEGIN                                                          <<03630>>49316000
EQUATE                                                         <<03630>>49318000
   DESCRIBE = 17;           << DESCRIBE COMMAND OPCODE >>      <<03630>>49320000
DOUBLE                                                         <<03630>>49322000
   TEMP;                                                       <<03630>>49324000
INTEGER                                                        <<03630>>49326000
   TEMP1 = TEMP,        << HIGH ORDER WORD OF TEMP >>          <<03630>>49328000
   TEMP2 = TEMP + 1;    << LOW ORDER WORD OF TEMP  >>          <<03630>>49330000
ARRAY                                                          <<03630>>49332000
   DESC'BUFF(0:18);      << DESCRIBE COMMAND RESULTS >>        <<03630>>49334000
BYTE ARRAY                                                     <<03630>>49336000
   DESC'BUFF'B(*) = DESC'BUFF;                                 <<03630>>49338000
                                                               <<03630>>49340000
DISC(DESCRIBE,LDEV,0D,DESC'BUFF,19);   << GET DESCRIBE INFO >> <<03630>>49342000
                                                               <<03630>>49344000
SECTORS'PER'TRACK := DESC'BUFF(14) + 1;   << SECTORS PER    >> <<03630>>49346000
                                          <<    TRACK       >> <<03630>>49348000
NUM'HEADS := LOGICAL(DESC'BUFF'B(27)) + 1;  << NO. OF HEADS >> <<03630>>49350000
                                                               <<03630>>49352000
TEMP1.(0:8) := 0;                    << NO. OF       >>        <<03630>>49354000
TEMP1.(8:8) := DESC'BUFF'B(24);      <<   CYLINDERS  >>        <<03630>>49356000
TEMP2.(0:8) := DESC'BUFF'B(25);                                <<03630>>49358000
TEMP2.(8:8) := DESC'BUFF'B(26);                                <<03630>>49360000
NUM'CYLS := TEMP + 1D;                                         <<03630>>49362000
END;   << CS80'INFO >>                                         <<03630>>49364000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03630>>49366000
     <<--------------------------------------------------->>   <<03630>>49368000
     << CONVERT CS'80 PHYSICAL ADDRESS TO LOGICAL ADDRESS >>   <<03630>>49370000
     <<--------------------------------------------------->>   <<03630>>49372000
DOUBLE PROCEDURE CS80'PHYS'TO'LOG( LDEV,CYL,HEAD,SECTOR);      <<03630>>49374000
VALUE LDEV,CYL,HEAD,SECTOR;                                    <<03630>>49376000
INTEGER                                                        <<03630>>49378000
   LDEV;        << LOGICAL DEVICE NO. >>                       <<03630>>49380000
DOUBLE                                                         <<03630>>49382000
   CYL;         << CYLINDER NO. >>                             <<03630>>49384000
LOGICAL                                                        <<03630>>49386000
   HEAD,        << HEAD NO. >>                                 <<03630>>49388000
   SECTOR;      << SECTOR NO. >>                               <<03630>>49390000
                                                               <<03630>>49392000
COMMENT                                                        <<03630>>49394000
CONVERT THE GIVEN CYLINDER, HEAD, AND SECTOR TO A LOGICAL      <<03630>>49396000
DISC ADDRESS, ON THE GIVEN CS'80 DISC LDEV.  THE PROCEDURE     <<03630>>49398000
RETURNS A DOUBLE-WORD CONTAINING THE LOGICAL DISC ADDRESS.     <<03630>>49400000
WE CALL CS80'INFO TO GET THE DISC SIZE PARAMETERS.             <<03630>>49402000
;                                                              <<03630>>49404000
BEGIN                                                          <<03630>>49406000
LOGICAL                                                        <<03630>>49408000
   SECTORS'PER'TRACK,     << NO. OF SECTORS PER TRACK >        <<03630>>49410000
   NUM'HEADS;             << NO. OF HEADS ON DISC >>           <<03630>>49412000
DOUBLE                                                         <<03630>>49414000
   NUM'CYLS,              << NO. OF CYLINDERS ON DISC >>       <<03630>>49416000
   SECTORS'PER'CYL;       << NO. OF SECTORS PER CYLINDER >>    <<03630>>49418000
                                                               <<03630>>49420000
CS80'INFO( LDEV, SECTORS'PER'TRACK,    << GET DISC SIZE    >>  <<03630>>49422000
                 NUM'HEADS,            <<    PARAMETERS    >>  <<03630>>49424000
                 NUM'CYLS          );                          <<03630>>49426000
                                                               <<03630>>49428000
SECTORS'PER'CYL := DOUBLE( NUM'HEADS*SECTORS'PER'TRACK);       <<03630>>49430000
                                                               <<03630>>49432000
CS80'PHYS'TO'LOG := CYL * SECTORS'PER'CYL +                    <<03630>>49434000
                    DOUBLE( HEAD * SECTORS'PER'TRACK) +        <<03630>>49436000
                    DOUBLE( SECTOR);                           <<03630>>49438000
END;   << CS80'PHYS'TO'LOG >>                                  <<03630>>49440000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03630>>49442000
      <<--------------------------------------------->>        <<03630>>49444000
      <<  FIND THE NEXT SPARE TRACK ON A CS'80 DISC  >>        <<03630>>49446000
      <<--------------------------------------------->>        <<03630>>49448000
LOGICAL PROCEDURE GET'NEXT'SPARE( FOUND'CYL, FOUND'HEAD,       <<03630>>49450000
                                  NEXT'CYL, NEXT'HEAD,         <<03630>>49452000
                                  SPARE'TABLE'B, NUM'HEADS);   <<03630>>49454000
VALUE NUM'HEADS;                                               <<03630>>49456000
LOGICAL                                                        <<03630>>49458000
   FOUND'CYL,        << RETURN CYLINDER NO. >>                 <<03630>>49460000
   FOUND'HEAD,       << RETURN HEAD NO.     >>                 <<03630>>49462000
   NEXT'CYL,         << RETURN VALUE USED IN A SEQUENCE OF >>  <<03630>>49464000
                     << CALLS, INITIALLY ZERO              >>  <<03630>>49466000
   NEXT'HEAD;        << RETURN VALUE USED IN A SEQUENCE OF >>  <<03630>>49468000
                     << CALLS, INIITALLY ZERO              >>  <<03630>>49470000
BYTE ARRAY                                                     <<03630>>49472000
   SPARE'TABLE'B;    << SPARE TRACK TABLE >>                   <<03630>>49474000
LOGICAL                                                        <<03630>>49476000
   NUM'HEADS;        << NO. OF HEADS ON DISC >>                <<03630>>49478000
                                                               <<03630>>49480000
COMMENT                                                        <<03630>>49482000
GETS THE NEXT SPARE TRACK FROM THE SPARE TRACK TABLE RETURNED  <<03630>>49484000
BY A CS'80 DISC.  INITIALLY, NEXT'CYL AND NEXT'HEAD SHOULD BE  <<03630>>49486000
SET TO ZERO BY THE CALLER.  GET'NEXT'SPARE STARTS ITS SEARCH   <<03630>>49488000
FROM THESE VALUES AND FINDS THE NEXT SPARE TRACK.  TRACKS ARE  <<03630>>49490000
RETURNED IN INCREASING ORDER FIRST BY CYLINDER, THEN HEAD.     <<03630>>49492000
NEXT'CYL AND NEXT'HEAD ARE SET ON EACH RETURN, TO BE USED IN   <<03630>>49494000
THE NEXT CALL.  THEY SHOULD NOT BE SET AGAIN BY THE CALLER.    <<03630>>49496000
FOUND'CYL AND FOUND'HEAD CONTAIN THE CYLINDER AND HEAD OF THE  <<03630>>49498000
SPARE TRACK ON RETURN.  GET'NEXT'SPARE RETURNS TRUE IF A       <<03630>>49500000
SPARE TRACK WAS FOUND, FALSE IF THERE ARE NO MORE.             <<03630>>49502000
;                                                              <<03630>>49504000
BEGIN                                                          <<03630>>49506000
EQUATE                                                         <<03630>>49508000
   INITIAL'VAL = 65000;                                        <<03630>>49510000
INTEGER                                                        <<03630>>49512000
   INDEX,            << INDEX INTO SPARE'TABLE'B >>            <<03630>>49514000
   LOGICAL'SPARES,   << NO. OF LOGICAL SPARES ON A HEAD >>     <<03630>>49516000
   SPARE'INDEX;      << INDEX VAR. >>                          <<03630>>49518000
LOGICAL                                                        <<03630>>49520000
   CYL,              << CURRENT CYLINDER NO. >>                <<03630>>49522000
   HEAD,             << CURRENT HEAD NO. >>                    <<03630>>49524000
   I;                << INDEX FOR A LOOP >>                    <<03630>>49526000
                                                               <<03630>>49528000
FOUND'CYL := INITIAL'VAL;        << INITIALIZE TO     >>       <<03630>>49530000
FOUND'HEAD := INITIAL'VAL;       <<    NOTHING FOUND  >>       <<03630>>49532000
INDEX := 0;                                                    <<03630>>49534000
I := 0;                                                        <<03630>>49536000
                                                               <<03630>>49538000
WHILE I < NUM'HEADS DO       << SEARCH THROUGH SPARE TRACK  >> <<03630>>49540000
   BEGIN                     <<   TABLE                     >> <<03630>>49542000
   HEAD := SPARE'TABLE'B(INDEX);                               <<03630>>49544000
   LOGICAL'SPARES := SPARE'TABLE'B(INDEX+4);                   <<03630>>49546000
   SPARE'INDEX := 0;                                           <<03630>>49548000
                                                               <<03630>>49550000
   << SEARCH ALL SPARE TRACKS ON THIS HEAD >>                  <<03630>>49552000
                                                               <<03630>>49554000
   WHILE SPARE'INDEX < LOGICAL'SPARES DO                       <<03630>>49556000
      BEGIN                                                    <<03630>>49558000
                                                               <<03630>>49560000
      CYL.(0:8) := SPARE'TABLE'B( INDEX+5+(SPARE'INDEX*3)+0);  <<03630>>49562000
      CYL.(8:8) := SPARE'TABLE'B( INDEX+5+(SPARE'INDEX*3)+1);  <<03630>>49564000
                                                               <<03630>>49566000
      << DETERMINE IF CYL AND HEAD ARE THE NEXT CYLINDER    >> <<03630>>49568000
      << AND HEAD BEYOND NEXT'CYL AND NEXT'HEAD IN ORDER.   >> <<03630>>49570000
      << IF SO, MAKE THEM THE NEW FOUND'CYL AND FOUND'HEAD. >> <<03630>>49572000
                                                               <<03630>>49574000
      IF (NEXT'CYL < CYL LAND CYL < FOUND'CYL) OR              <<03630>>49576000
         (CYL = NEXT'CYL OR CYL = FOUND'CYL) AND               <<03630>>49578000
         (NEXT'HEAD <= HEAD LAND HEAD < FOUND'HEAD) THEN       <<03630>>49580000
         BEGIN                                                 <<03630>>49582000
         FOUND'CYL := CYL;                                     <<03630>>49584000
         FOUND'HEAD := HEAD;                                   <<03630>>49586000
         END;                                                  <<03630>>49588000
                                                               <<03630>>49590000
      SPARE'INDEX := SPARE'INDEX + 1;                          <<03630>>49592000
      END;   << WHILE SPARE'INDEX < LOGICAL'SPARES >>          <<03630>>49594000
                                                               <<03630>>49596000
   INDEX := INDEX + 5 + (3 * LOGICAL'SPARES);                  <<03630>>49598000
   I := I + 1;                                                 <<03630>>49600000
   END;   << WHILE I < NUM'HEADS >>                            <<03630>>49602000
                                                               <<03630>>49604000
IF FOUND'CYL < INITIAL'VAL THEN     << FOUND ANOTHER SPARE >>  <<03630>>49606000
   BEGIN                            <<    TRACK            >>  <<03630>>49608000
                                                               <<03630>>49610000
   NEXT'HEAD := (FOUND'HEAD + 1) MOD NUM'HEADS;                <<03630>>49612000
                                                               <<03630>>49614000
   IF NEXT'HEAD = 0 THEN          << IF NEXT HEAD # ROLLED >>  <<03630>>49616000
      NEXT'CYL := FOUND'CYL + 1   <<   OVER, INCREMENT     >>  <<03630>>49618000
   ELSE                           <<   NEXT CYLINDER #     >>  <<03630>>49620000
      NEXT'CYL := FOUND'CYL;                                   <<03630>>49622000
                                                               <<03630>>49624000
   GET'NEXT'SPARE := TRUE;                                     <<03630>>49626000
   END                                                         <<03630>>49628000
                                                               <<03630>>49630000
ELSE                                                           <<03630>>49632000
   GET'NEXT'SPARE := FALSE;    << NO MORE SPARE TRACKS >>      <<03630>>49634000
END;   << GET'NEXT'SPARE >>                                    <<03630>>49636000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03630>>49638000
        <<------------------------------------->>              <<03630>>49640000
        <<  LIST SPARE TRACKS ON A CS'80 DISC  >>              <<03630>>49642000
        <<------------------------------------->>              <<03630>>49644000
PROCEDURE LIST'CS80'SPARES( LDEV);                             <<03630>>49646000
VALUE LDEV;                                                    <<03630>>49648000
INTEGER                                                        <<03630>>49650000
   LDEV;    << LOGICAL DEVICE NO. >>                           <<03630>>49652000
                                                               <<03630>>49654000
COMMENT                                                        <<03630>>49656000
LIST SPARE TRACK INFORMATION FOR A CS'80 DISC.  THE            <<03630>>49658000
PASSED LDEV MUST BE A CS80'DISC.  THE SPARE TRACK TABLE        <<03630>>49660000
IS READ FROM THE DISC.  WE CALL CS80'INFO TO GET DISC          <<03630>>49662000
SIZE PARAMETERS, GET'NEXT'SPARE TO LOCATE THE NEXT SPARE       <<03630>>49664000
TRACK IN ORDER IN THE SPARE TRACK TABLE, AND                   <<03630>>49666000
CS80'PHYS'TO'LOG TO CONVERT A PHYSICAL ADDRESS (CYLINDER,      <<03630>>49668000
HEAD, AND SECTOR) TO A LOGICAL ADDRESS.                        <<03630>>49670000
                                                               <<03630>>49672000
NOTE: THE DIFFERENCE BETWEEN TOTAL'SPARES AND                  <<03630>>49674000
TOTAL'LOGICAL'SPARES IS THAT IF THE TRACK DESIGNATED BY        <<03630>>49676000
A PARTICULAR LOGICAL ADDRESS IS SPARED MORE THAN ONCE,         <<03630>>49678000
SEVERAL SPARE TRACKS ARE USED BUT ONLY ONE LOGICAL             <<03630>>49680000
SPARE TRACK IS USED.                                           <<03630>>49682000
;                                                              <<03630>>49684000
BEGIN                                                          <<03630>>49686000
EQUATE                                                         <<03630>>49688000
   READ'SPARES = 19,    << READ SPARE TABLE OPCODE >>          <<03630>>49690000
   TH1'SIZE    = 34,    << BYTE LENGTH OF TABLE'HEAD1 >>       <<03630>>49692000
   TH2'SIZE    = 37,    << BYTE LENGTH OF TABLE'HEAD2 >>       <<03630>>49694000
   TH3'SIZE    = 52,    << BYTE LENGTH OF TABLE'HEAD3 >>       <<03630>>49696000
   DASH'SIZE   = 55;    << BYTE LENGTH OF DASH'LINE   >>       <<03630>>49698000
LOGICAL                                                        <<03630>>49700000
   SECTORS'PER'TRACK,    << NO. OF SECTORS PER TRACK >>        <<03630>>49702000
   SPARE'OPS,            << SPARE OPERATIONS ON A HEAD >>      <<03630>>49704000
   NUM'HEADS,            << NO. OF HEADS ON THE DISC >>        <<03630>>49706000
   I,                    << INDEX VAR. >>                      <<03630>>49708000
   CYL,                  << CYLINDER NO. >>                    <<03630>>49710000
   HEAD,                 << HEAD NO. >>                        <<03630>>49712000
   NEXT'CYL,             << PARAMETER FOR GET'NEXT'SPARE >>    <<03630>>49714000
   NEXT'HEAD;            << PARAMETER FOR GET'NEXT'SPARE >>    <<03630>>49716000
INTEGER                                                        <<03630>>49718000
   TOTAL'SPARES,           << NO. SPARE TRACKS USED >>         <<03630>>49720000
   TOTAL'LOGICAL'SPARES,   << NO. LOGICAL SPARE TRACKS >>      <<03630>>49722000
   LOGICAL'SPARES,         << LOGICAL SPARE TRACKS ON HEAD >>  <<03630>>49724000
   LEN,                    << LENGTH OF BYTE STRING >>         <<03630>>49726000
   SUBTYP,                 << DEVICE SUBTYPE OF LDEV >>        <<03630>>49728000
   INDEX;                  << INDEX INTO SPARE'TABLE'B >>      <<03630>>49730000
DOUBLE                                                         <<03630>>49732000
   NUM'CYLS,             << NO. OF CYLINDERS ON THE DISC >>    <<03630>>49734000
   SPARE'OPS'TOTAL,      << TOTAL SPARE OPERATIONS ON DISC >>  <<03630>>49736000
   DISC'ADDRESS;         << LOGICAL DISC ADDRESS >>            <<03630>>49738000
BYTE ARRAY                                                     <<03630>>49740000
   STRING(0:13);                                               <<03630>>49742000
INTEGER ARRAY                                                  <<03630>>49744000
   AVAIL'SPARES(0:MAXSUBTYPES-1) = PB :=   << SPARE TRACKS  >> <<03630>>49746000
      -1,24,56,-1,-1,-1,-1,-1,78,-1,       << AVAILABLE BY  >> <<03668>>49748000
      -1,-1,-1,-1,-1,-1;                   << CS'80 SUBTYPE >> <<03630>>49750000
ARRAY                                                          <<03630>>49752000
   SPARE'TABLE(0:255);     << SPARE TRACK TABLE >>             <<03630>>49754000
BYTE ARRAY                                                     <<03630>>49756000
   SPARE'TABLE'B(*) = SPARE'TABLE;                             <<03630>>49758000
BYTE ARRAY                                                     <<03630>>49760000
   TAB'HEAD1(0:TH1'SIZE-1) = PB :=                             <<03630>>49762000
      "                     SPARED TRACKS";                    <<03630>>49764000
BYTE ARRAY                                                     <<03630>>49766000
   TAB'HEAD2(0:TH2'SIZE-1) = PB :=                             <<03630>>49768000
      "   LOGICAL         FIRST         LAST";                 <<03630>>49770000
BYTE ARRAY                                                     <<03630>>49772000
   TAB'HEAD3(0:TH3'SIZE-1) = PB :=                             <<03630>>49774000
      "  CYL   HEAD     SECTOR(%)     SECTOR(%)      STATUS";  <<03630>>49776000
BYTE ARRAY                                                     <<03630>>49778000
   DASH'LINE(0:DASH'SIZE-1) = PB :=                            <<03630>>49780000
      "---------------------------------------------------",   <<03630>>49782000
      "----";                                                  <<03630>>49784000
                                                               <<03630>>49786000
<< GET DISC SIZE PARAMETERS >>                                 <<03630>>49788000
                                                               <<03630>>49790000
CS80'INFO( LDEV, SECTORS'PER'TRACK, NUM'HEADS, NUM'CYLS);      <<03630>>49792000
                                                               <<03630>>49794000
<< READ THE SPARE TRACK TABLE FROM THE DISC >>                 <<03630>>49796000
                                                               <<03630>>49798000
DISC(READ'SPARES, LDEV, 0D, SPARE'TABLE, 256);                 <<03630>>49800000
                                                               <<03630>>49802000
SPARE'OPS'TOTAL := 0D;                                         <<03630>>49804000
TOTAL'LOGICAL'SPARES := 0;                                     <<03630>>49806000
TOTAL'SPARES := 0;                                             <<03630>>49808000
INDEX := 0;                                                    <<03630>>49810000
I := 0;                                                        <<03630>>49812000
                                                               <<03630>>49814000
<< LOOP THROUGH THE SPARE TRACK TABLE AND COMPUTE THE >>       <<03630>>49816000
<< TOTAL NO. OF SPARE OPERATIONS AND THE TOTAL NO. OF >>       <<03630>>49818000
<< SPARE TRACKS USED.                                 >>       <<03630>>49820000
                                                               <<03630>>49822000
WHILE I < NUM'HEADS DO                                         <<03630>>49824000
   BEGIN                                                       <<03630>>49826000
                                                               <<03630>>49828000
   SPARE'OPS.(0:8) := SPARE'TABLE'B(INDEX+1);                  <<03630>>49830000
   SPARE'OPS.(8:8) := SPARE'TABLE'B(INDEX+2);                  <<03630>>49832000
   SPARE'OPS'TOTAL := SPARE'OPS'TOTAL +                        <<03630>>49834000
                      DOUBLE(SPARE'OPS);                       <<03630>>49836000
                                                               <<03630>>49838000
   TOTAL'SPARES := TOTAL'SPARES +                              <<03630>>49840000
                   INTEGER(SPARE'TABLE'B(INDEX+3));            <<03630>>49842000
                                                               <<03630>>49844000
   LOGICAL'SPARES := INTEGER(SPARE'TABLE'B(INDEX+4));          <<03630>>49846000
   TOTAL'LOGICAL'SPARES := TOTAL'LOGICAL'SPARES +              <<03630>>49848000
                           LOGICAL'SPARES;                     <<03630>>49850000
                                                               <<03630>>49852000
   INDEX := INDEX + 5 + (3 * LOGICAL'SPARES);                  <<03630>>49854000
   I := I + 1;                                                 <<03630>>49856000
   END;                                                        <<03630>>49858000
                                                               <<03630>>49860000
<< PRINT THE TOTALS:  NO. OF SPARE OPERATIONS ON THE DISC, >>  <<03630>>49862000
<< NO. OF SPARE TRACKS USED, AND THE NO. OF SPARE TRACKS   >>  <<03630>>49864000
<< AVAILABLE                                               >>  <<03630>>49866000
                                                               <<03630>>49868000
BLANKLINE;                                                     <<03630>>49870000
LEN := LDNTOA(SPARE'OPS'TOTAL,10,STRING(1));                   <<03630>>49872000
STRING(0) := LEN.(8:8);                                        <<03630>>49874000
MESSAGE( M2504,,,,, STRING);        << SPARE OPERATIONS >>     <<03630>>49876000
MESSAGE( M2505, TOTAL'SPARES);      << SPARE TRACKS USED >>    <<03630>>49878000
                                                               <<03630>>49880000
SUBTYP := LPDT(LDEV*LPDTSIZE+LPDT1).SUBTYPE;                   <<03630>>49882000
                                                               <<03630>>49884000
MESSAGE( M2506,AVAIL'SPARES(SUBTYP)      << SPARE TRACKS  >>   <<03630>>49886000
                  - TOTAL'SPARES    );   <<    AVAILABLE  >>   <<03630>>49888000
                                                               <<03630>>49890000
<< IF THERE ARE ANY SPARE TRACKS, PRINT THE SPARE TRACK >>     <<03630>>49892000
<< HEADER, THEN LOOP AND PRINT ALL SPARE TRACK ENTRIES  >>     <<03630>>49894000
                                                               <<03630>>49896000
IF TOTAL'LOGICAL'SPARES > 0 THEN                               <<03630>>49898000
   BEGIN                                                       <<03630>>49900000
                                                               <<03630>>49902000
   BLANKLINE;                                                  <<03630>>49904000
   MOVE BINBUF := TAB'HEAD1,(TH1'SIZE);    << PRINT HEADER >>  <<03630>>49906000
   PRINT(INBUF, -TH1'SIZE, 0);                                 <<03630>>49908000
   MOVE BINBUF := TAB'HEAD2,(TH2'SIZE);                        <<03630>>49910000
   PRINT(INBUF, -TH2'SIZE, 0);                                 <<03630>>49912000
   MOVE BINBUF := TAB'HEAD3,(TH3'SIZE);                        <<03630>>49914000
   PRINT(INBUF, -TH3'SIZE, 0);                                 <<03630>>49916000
   MOVE BINBUF := DASH'LINE,(DASH'SIZE);    << PRINT FIRST >>  <<03630>>49918000
   PRINT(INBUF, -DASH'SIZE, 0);             <<   DASH LINE >>  <<03630>>49920000
                                                               <<03630>>49922000
   NEXT'CYL := 0;       << INITIALIZE PARAMETERS FOR CALL >>   <<03630>>49924000
   NEXT'HEAD := 0;      <<    TO GET'NEXT'SPARE           >>   <<03630>>49926000
                                                               <<03630>>49928000
   << LOOP AND PRINT ALL SPARE TRACK ENTRIES >>                <<03630>>49930000
                                                               <<03630>>49932000
   WHILE GET'NEXT'SPARE(CYL, HEAD, NEXT'CYL, NEXT'HEAD,        <<03630>>49934000
                        SPARE'TABLE'B, NUM'HEADS    ) DO       <<03630>>49936000
      BEGIN                                                    <<03630>>49938000
                                                               <<03630>>49940000
      INBUF(0) := "  ";                 << BLANK THE BUFFER >> <<03630>>49942000
      MOVE INBUF(1) := INBUF,(30);                             <<03630>>49944000
      ASCII( CYL, BINBUF(2));                                  <<03630>>49946000
      ASCII( HEAD, BINBUF(9));                                 <<03630>>49948000
                                                               <<03630>>49950000
      << CONVERT CYL AND HEAD TO A LOGICAL DISC ADDRESS >>     <<03630>>49952000
                                                               <<03630>>49954000
      DISC'ADDRESS := CS80'PHYS'TO'LOG( LDEV, DOUBLE(CYL),     <<03630>>49956000
                                             HEAD, 0      );   <<03630>>49958000
                                                               <<03630>>49960000
      LDNTOA(DISC'ADDRESS, 8, BINBUF(18));                     <<03630>>49962000
      LDNTOA(DISC'ADDRESS+DOUBLE(SECTORS'PER'TRACK-1),         <<03630>>49964000
                                        8, BINBUF(32));        <<03630>>49966000
                                                               <<03630>>49968000
      MOVE BINBUF(44) := "REASSIGNED";                         <<03630>>49970000
                                                               <<03630>>49972000
      PRINT(INBUF, -54, 0);     << PRINT THE ENTRY >>          <<03630>>49974000
      END;   << WHILE GET'NEXT'SPARE >>                        <<03630>>49976000
                                                               <<03630>>49978000
   MOVE BINBUF := DASH'LINE,(DASH'SIZE);    << PRINT FINAL  >> <<03630>>49980000
   PRINT(INBUF, -DASH'SIZE, 0);             <<    DASH LINE >> <<03630>>49982000
   END;                                                        <<03630>>49984000
                                                               <<03630>>49986000
BLANKLINE;                                                     <<03630>>49988000
END;   << LIST'CS80'SPARES >>                                  <<03630>>49990000
          <<-----------------------------                               49992000
            LIST DEFECTIVE TRACKS TABLE                                 49994000
          ----------------------------->>                               49996000
  PROCEDURE LISTDTT(LDEV);                                     <<03549>>49998000
  VALUE LDEV;                                                  <<03549>>50000000
  INTEGER                                                      <<03549>>50002000
    LDEV;   << LOGICAL DEVICE NO. OF DISC >>                   <<03549>>50004000
    COMMENT                                                    <<03549>>50006000
    LIST THE DEFECTIVE TRACKS TABLE ON THE GIVEN LDEV.         <<03549>>50008000
                                                               <<03549>>50010000
    ;                                                          <<03549>>50012000
      BEGIN                                                             50014000
        BYTE ARRAY MHEAD1(0:52)=PB:=                                    50016000
          "            FIRST     LAST                  ALTERNATE";      50018000
        BYTE ARRAY MHEAD2(0:52)=PB:=                                    50020000
          "CYL HEAD  SECTOR(%) SECTOR(%)    STATUS     CYL  HEAD";      50022000
        BYTE ARRAY FHEAD1(0:21)=PB:="        FIRST     LAST";           50024000
        BYTE ARRAY FHEAD2(0:33)=PB:=                                    50026000
          "TRACK SECTOR(%) SECTOR(%)   STATUS";                         50028000
        BYTE ARRAY STATS(0:69)=PB:="   SUSPECT     SUSPECT ALT  ",      50030000
          "    DELETED     REASSIGNED  UNREADABLE ALT";                 50032000
        INTEGER I,TYPE,SUBTYP,TRACK,DISP,ALT,INDEX;            <<03549>>50034000
        INTEGER ARRAY DTT(0:127);                              <<03549>>50038000
                                                               <<03549>>50040000
          TYPE := LDT(LDEV*LDTSIZE+LDT2).TYP;                  <<03549>>50042000
          SUBTYP := LPDT(LDEV*LPDTSIZE+LPDT1).SUBTYPE;         <<03549>>50044000
                                                               <<03549>>50046000
          DISC(READ,LDEV,1D,DTT,128);                          <<03549>>50048000
                                                               <<03549>>50050000
          IF TYPE = MHDISCTYPE THEN                            <<03549>>50052000
            BEGIN  <<MOVING HEAD DISC>>                                 50054000
              TOS := 0;                                                 50056000
              TOS := MHINFO((INDEX:=SUBTYP*MHINFOSIZE)+MHMAXLPS)*       50058000
                MHINFO(INDEX+MHTRKCYL)-DTT(DTTALT); <<# OF AVAIL ALTS>> 50060000
              TOS := 0;                                                 50062000
              TOS := DTT(DTTLPS);  <<LOGICAL PACK SIZE>>                50064000
              MOVE BINBUF := "LOGICAL PACK SIZE = ",2;                  50066000
              I := ASCII(*,*);                                          50068000
              MOVE BINBUF(20+I) := " CYLINDERS  ",2;                    50070000
              TOS := ASCII(*,*);  <<# OF AVAILABLE ALTERNATES>>         50072000
              I := TOS+I;                                               50074000
              MOVE BINBUF(32+I) := " ALTERNATE TRACKS AVAILABLE";       50076000
              PRINT(INBUF,-59-I,0);                                     50078000
              IF DTT=0 THEN MESSAGE(M2226)<<NO ENTRIES IN TAB>><<01103>>50080000
              ELSE                                                      50082000
                BEGIN  <<PRINT TABLE>>                                  50084000
                  MOVE BLINE := MHEAD1,(53);                   <<00888>>50086000
                  PRINTLINE;                                   <<00888>>50088000
                  MOVE BLINE := MHEAD2,(53);                   <<00888>>50090000
                  PRINTLINE;                                   <<00888>>50092000
                  I := 0;                                               50094000
                  WHILE (I:=I+1)<=DTT DO                                50096000
                    BEGIN  <<LIST EACH ENTRY>>                          50098000
                      INBUF := "  ";                                    50100000
                      MOVE INBUF(1) := INBUF,(26);                      50102000
                      TOS := CYLINDERHEAD(TRACK:=DTT(I)&LSR(2),SUBTYP); 50104000
                      ASSEMBLE(ZERO,XCH);                               50106000
                      ASCII(*,BINBUF);  <<CYLINDER #>>                  50108000
                      ASSEMBLE(ZERO,XCH);                               50110000
                      ASCII(*,BINBUF(5));  <<HEAD #>>                   50112000
                      TOS := 0;                                         50114000
                      TOS := TRACK;                                     50116000
                      TOS := TOS**LOGICAL(MHINFO(INDEX+MHSECTRK));      50118000
                      ASSEMBLE(DDUP,DZRO; DXCH,CAB);                    50120000
                      TOS := MHINFO(INDEX+MHSECTRK);                    50122000
                      ASSEMBLE(DECA,DADD);  <<LAST SECTOR>>             50124000
                      LDNTOA(*,8,BINBUF(21));  <<LAST SECTOR>> <<00935>>50126000
                      LDNTOA(*,8,BINBUF(11));  <<FIRST SECTOR>><<00935>>50128000
                      DISP := DTT(I).(14:2);  <<RECORD TYPE>>           50130000
                      IF DISP=0 AND TRACK=DTT(X:=X+1)&LSR(2) THEN       50132000
                        DISP := 4;  <<UNREADABLE ALTERNATE>>            50134000
                      MOVE BINBUF(29) := STATS(DISP*14),(14);           50136000
                      TOS := @INBUF;  <<FOR PRINT>>                     50138000
                      IF LOGICAL(DISP) THEN                             50140000
                        BEGIN  <<THERE IS AN ALTERNATE I.E. TRACK IS    50142000
                              EITHER REASSIGNED OR SUSPECT ALTERNATE>>  50144000
                          ALT := ALTTRACK(LDEV,TRACK); <<GET ALT>>      50146000
                          IF ALT=-2 THEN                                50148000
                            BEGIN <<CAN'T READ ALTERNATE>>              50150000
                              TOS := ADDDTTENTRY(TRACK&LSL(2));         50152000
                                  <<ADD SUSPECT TRACK ENTRY TO TABLE>>  50154000
                              IF TOS=1 THEN                             50156000
                                BEGIN   <<ENTRY ADDED TO TABLE>>        50158000
                                  MOVE BINBUF(29) := STATS(56),(14);    50160000
                                        <<UNREADABLE ALTERNATE>>        50162000
                                  DISC(WRITE,LDEV,1D,DTT,128);          50164000
                                END;                                    50166000
                              GOTO NOALT;                               50168000
                            END;                                        50170000
                          TOS := CYLINDERHEAD(ALT,SUBTYP);              50172000
                          ASSEMBLE(ZERO,XCH);                           50174000
                          ASCII(*,BINBUF(44)); <<ALTERNATE CYLINDER>>   50176000
                          ASSEMBLE(ZERO,XCH);                           50178000
                          ASCII(*,BINBUF(50));  <<ALTERNATE HEAD>>      50180000
                          TOS := -52;  <<LINE COUNT>>                   50182000
                        END                                             50184000
                      ELSE                                              50186000
  NOALT:                TOS := -44;  <<BYTE COUNT FOR LINE>>            50188000
                      PRINT(*,*,0);                                     50190000
                      IF DTT(I+1)=TRACK&LSL(2)+3 THEN I:=I+1; <<SKIP>>  50192000
                    END;                                                50194000
                END;                                                    50196000
            END                                                         50198000
          ELSE                                                          50200000
            BEGIN  <<FIXED HEAD DISC>>                                  50202000
              IF DTT=0 THEN MESSAGE(M2226)<<NO ENTRIES IN TAB>><<01103>>50204000
              ELSE                                                      50206000
                BEGIN  <<PRINT HEADING>>                                50208000
                  MOVE BLINE := FHEAD1,(22);                   <<00888>>50210000
                  PRINTLINE;                                   <<00888>>50212000
                  MOVE BLINE := FHEAD2,(34);                   <<00888>>50214000
                  PRINTLINE;                                   <<00888>>50216000
                  I := 0;                                               50218000
                  WHILE (I:=I+1)<=DTT DO                                50220000
                    BEGIN  <<LIST EACH ENTRY>>                          50222000
                      TOS := DTT(I);                                    50224000
                      DISP := S0.(14:2);                                50226000
                      TRACK := TOS&LSR(2);                              50228000
                      ASCII(TRACK,BLINE(1)); <<TRACK #>>       <<00888>>50230000
                      TOS := 0D;                                        50232000
                      TOS := TRACK&LSL(5);  <<STARTING SECTOR>>         50234000
                      ASSEMBLE(DUP,DZRO,CAB);                           50236000
                      TOS := TOS+31; <<LAST SECTOR>>                    50238000
                      LDNTOA(*,8,BLINE(18));                   <<00935>>50240000
                      LDNTOA(*,8,BLINE(8));  <<FIRST SECTOR>>  <<00935>>50242000
                      MOVE BLINE(24) := STATS(DISP*14),(14);   <<00888>>50244000
                      PRINTLINE;                               <<00888>>50246000
                    END;                                                50248000
                END;                                                    50250000
            END;                                                        50252000
      END <<LISTDTT>> ;                                                 50258000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>50260000
        <<----------------------------------------->>          <<03549>>50262000
        << LIST DEFECTIVE TRACK/SECTOR INFORMATION >>          <<03549>>50264000
        <<----------------------------------------->>          <<03549>>50266000
PROCEDURE LIST'DEFECTS;                                        <<03549>>50268000
                                                               <<03549>>50270000
COMMENT                                                        <<03549>>50272000
THIS PROCEDURE ASKS IF THE USER WISHES TO LIST DEFECTIVE       <<03549>>50274000
TRACK/SECTOR INFORMATION.  IF SO, IT REQUESTS AN LDEV.         <<03549>>50276000
IF THE LDEV IS A TYPE 0 OR TYPE 1 DISC, WE CALL LISTDTT        <<03549>>50278000
TO LIST THE DEFECTIVE TRACKS TABLE.  IF THE LDEV IS TYPE       <<03549>>50280000
3, WE CALL LIST'CS80'SPARES TO LIST SPARED TRACK/SECTOR        <<03549>>50282000
INFORMATION.                                                   <<03549>>50284000
;                                                              <<03549>>50286000
BEGIN                                                          <<03549>>50288000
INTEGER                                                        <<03549>>50290000
   TYPE,       << DEVICE TYPE >>                               <<03549>>50292000
   LDEV;       << LOGICAL DEVICE NO. >>                        <<03549>>50294000
LOGICAL                                                        <<03549>>50296000
   GOOD'LDEV;  << TRUE IF LDEV IS VALID SYSTEM DOMAIN DISC >>  <<03549>>50298000
                                                               <<03549>>50300000
IF LGETYESNO(M2225) THEN        << LIST DEFECTIVE TRACK/ >>    <<03549>>50302000
   BEGIN                        << SECTOR INFORMATION?   >>    <<03549>>50304000
                                                               <<03549>>50306000
   WHILE TRUE DO                                               <<03549>>50308000
      BEGIN               << DO UNTIL LDEV=0 IS ENTERED >>     <<03549>>50310000
                                                               <<03549>>50312000
      GOOD'LDEV := FALSE;                                      <<03549>>50314000
      WHILE NOT GOOD'LDEV DO                                   <<03549>>50316000
         BEGIN            << PROMPT FOR LDEV UNTIL VALID >>    <<03549>>50318000
                                                               <<03549>>50320000
         LDEV := GETVAL(M2011,0,HLDEV,2);   << LDEV? >>        <<03549>>50322000
         IF LDEV = 0 THEN                                      <<03549>>50324000
            RETURN;        << THAT'S ALL, FOLKS >>             <<03549>>50326000
                                                               <<03549>>50328000
         IF VALID'DISC(LDEV) = 0 THEN   << VALID SYSTEM-    >> <<03549>>50330000
            GOOD'LDEV := TRUE;          <<   DOMAIN DISCS   >> <<03549>>50332000
                                                               <<03549>>50334000
         END;                                                  <<03549>>50336000
      TYPE := LDT(LDEV*LDTSIZE+LDT2).TYP;                      <<03549>>50338000
                                                               <<03549>>50340000
      IF TYPE = DISC0 OR TYPE = DISC1 THEN                     <<03549>>50342000
         LISTDTT(LDEV)      << LIST DEFECTIVE TRACKS >>        <<03549>>50344000
                                                               <<03549>>50346000
      ELSE IF TYPE = DISC3 THEN                                <<03549>>50348000
         BEGIN                                                 <<03549>>50350000
         LIST'CS80'SPARES(LDEV);   << LIST SPARE TRACK INFO >> <<03630>>50352000
         END;                                                  <<03549>>50354000
      END;                                                     <<03549>>50356000
   END;                                                        <<03549>>50358000
END;   << LIST'DEFECTS >>                                      <<03549>>50360000
PROCEDURE BUILD'VDSMTAB;                                       <<MPEIV>>50362000
                                                               <<MPEIV>>50364000
COMMENT:  THIS PROCEDURE BUILDS THE 0 ENTRY, AND AN ENTRY      <<MPEIV>>50366000
FOR EACH SYSTEM VOLUME HAVING THE VDS ATTRIBUTE IN THE         <<MPEIV>>50368000
VDSMTAB.  DELETED TRACKS ARE REMOVED FROM VIRTUAL MEMORY       <<MPEIV>>50370000
BY MAKING THEM UNAVAILABLE IN THE APPROPRIATE BITMAP.          <<MPEIV>>50372000
;                                                              <<MPEIV>>50374000
BEGIN                                                          <<MPEIV>>50376000
DOUBLE  FSECT,         << 1ST SECTOR OF BAD TRACK >>           <<MPEIV>>50378000
        LSECT,         << LAST   "    "    "      "   >>       <<MPEIV>>50380000
        VDSLEN,        << VIRTUAL MEMORY LENGTH IN SECTORS >>  <<MPEIV>>50382000
        VDSLEN'PAGES,  << "      "      "     "   PAGES >>     <<MPEIV>>50384000
        VDSTART,       << STARTING SECTOR OF VIRTUAL MEM. >>   <<MPEIV>>50386000
        VDSTOP;        << LAST SECTOR OF V.M. >>               <<MPEIV>>50388000
                                                               <<MPEIV>>50390000
LOGICAL LDEV,          << LOGICAL DEVICE NUMBER >>             <<MPEIV>>50392000
        TYPE,          << DISC TYPE >>                         <<MPEIV>>50394000
        STYPE,         << DISC SUB TYPE >>                     <<MPEIV>>50396000
        VOLUME,        << VOLUME NUMBER OF DISC >>             <<MPEIV>>50398000
        TRACKLEN,      << LENGTH OF 1 TRACK ON THIS DISC >>    <<MPEIV>>50400000
        PAGE,          << PAGE BEING REMOVED FROM BITMAP >>    <<MPEIV>>50402000
        FPAGE,         << 1ST PAGE TO BE "     "    "    >>    <<MPEIV>>50404000
        LPAGE,         << LAST  "   "  " "     "    "    >>    <<MPEIV>>50406000
        LOGON1'BAD     := FALSE,                               <<MPEIV>>50408000
        LOGON2'BAD     := FALSE,                               <<MPEIV>>50410000
        BMLENGTH,      << BIT MAP LENGTH >>                    <<MPEIV>>50412000
        ENTRYSIZE,     << VDSMTAB VOLUME ENTRY SIZE >>         <<MPEIV>>50414000
        SYSENTRY,      << SYS DB REL. ADDR FOR LDEV1 VSMT ->>  <<MPEIV>>50416000
        SYSMAP,        << ENTRY AND BITMAP.                >>  <<MPEIV>>50418000
        VDSLEN1        =  VDSLEN,                              <<MPEIV>>50420000
        VDSLEN2        =  VDSLEN+1,                            <<MPEIV>>50422000
        VDSTART1       =  VDSTART,                             <<MPEIV>>50424000
        VDSTART2       =  VDSTART+1;                           <<MPEIV>>50426000
                                                               <<MPEIV>>50428000
                                                               <<MPEIV>>50430000
  TOS := INITTABLE(BMOFFSET, 1, FALSE);                        <<MPEIV>>50432000
  << GOT SPACE FOR ENTRY 0, NOW GET SPACE FOR EACH   >>        <<MPEIV>>50434000
  << VOLUME AS THEY ARE FOUND.                       >>        <<MPEIV>>50436000
  ABSOLUTE(SYSVDSMTAB) := S0-SYSBASE;<<SYSGLOB PTR TO VDSMTAB>><<MPEIV>>50438000
  INSERTDST(*, VDSMDSTN, MEMSEG, 0);                           <<MPEIV>>50440000
  << SINCE WE DON'T YET KNOW THE SIZE OF VDSMTAB THE DST     >><<MPEIV>>50442000
  << ENTRY WILL NEED TO BE CORRECTED AT END OF THIS PROCEDURE>><<MPEIV>>50444000
                                                               <<MPEIV>>50446000
<< SET UP ENTRY 0 >>                                           <<MPEIV>>50448000
  VDSMTAB(STARTENTRYINXWORD) := BMOFFSET;                      <<MPEIV>>50450000
  VDSMTAB(VMPAGESIZEWORD) := NWORDPAGE;                        <<MPEIV>>50452000
  VDSMTAB(SECTPERVMPAGEWORD) := NSECTPAGE;                     <<MPEIV>>50454000
  VDSMTAB(OFFSETTOBMWORD) := BMOFFSET;                         <<MPEIV>>50456000
  VDSMTAB(TOTALVMPAGESWORD) := 0;  << # PAGES IN USE >>        <<MPEIV>>50458000
                                                               <<MPEIV>>50460000
<< MAKE VDSMTAB ENTRY FOR EACH VMS VOLUME >>                   <<MPEIV>>50462000
<< AND CHECK VM AREA IF DELETED TRACKS    >>                   <<MPEIV>>50464000
  VOLUME := 0;                                                 <<MPEIV>>50466000
  WHILE (VOLUME := VOLUME+1) <= LOGICAL(HVOL) DO               <<MPEIV>>50468000
    IF VTAB(VOLUME*VTABSIZE) <> 0 AND                          <<MPEIV>>50470000
      VTAB(VOLUME*VTABSIZE+VTAB12).VMS = 1 THEN                <<MPEIV>>50472000
      BEGIN                                                    <<MPEIV>>50474000
                                                               <<MPEIV>>50476000
    << COMPUTE VOLUME INFORMATION >>                           <<MPEIV>>50478000
      VDSTART1 := VTAB(VOLUME*VTABSIZE+VTAB8);                 <<MPEIV>>50480000
      VDSTART2 := VTAB(X:=X+1);                                <<MPEIV>>50482000
      VDSLEN1 := VTAB(X:=X+1);                                 <<MPEIV>>50484000
      VDSLEN2 := VTAB(X:=X+1);                                 <<MPEIV>>50486000
      VDSLEN'PAGES := VDSLEN/DOUBLE(NSECTPAGE);                <<MPEIV>>50488000
      VDSTOP := VDSTART + VDSLEN - 1D;                         <<MPEIV>>50490000
      << VDSLEN IS ALREADY ROUNDED SO NO SWEAT THERE >>        <<MPEIV>>50492000
      LDEV := GETLDEV(VOLUME);                                 <<MPEIV>>50494000
      TYPE := LDT(LDEV*LDTSIZE+LDT2).TYP;                      <<MPEIV>>50496000
      STYPE := LPDT(LDEV*LPDTSIZE+LPDT1).SUBTYPE;              <<MPEIV>>50498000
      IF TYPE = MHDISCTYPE THEN                                <<MPEIV>>50500000
        TRACKLEN := MHINFO(STYPE*MHINFOSIZE+MHSECTRK)          <<MPEIV>>50502000
      ELSE                                                     <<MPEIV>>50504000
        TRACKLEN := 32;  << TRACK LENGTH >>                    <<MPEIV>>50506000
                                                               <<MPEIV>>50508000
    << SET UP VOLUME BITMAP >>                                 <<MPEIV>>50510000
      BMLENGTH := L'(VDSLEN'PAGES/16D);  <<DIV BY # BITS/WORD>><<MPEIV>>50514000
      BMLENGTH := BMLENGTH+1;  << NUM BITMAP WORDS >>          <<MPEIV>>50518000
      << EXTRA WORD IS FOR LAST PARTIAL WORD IF NEEDED >>      <<MPEIV>>50520000
      I := L'(VDSLEN'PAGES MODD 16);  << # BITS IN LAST WORD >><<MPEIV>>50522000
      ENTRYSIZE := ROUND(BMLENGTH+L'(VDSMTAB(OFFSETTOBMWORD)));<<MPEIV>>50526000
      TOS := INITTABLE(ENTRYSIZE, 1, FALSE);                   <<MPEIV>>50528000
      ABSOLUTE(SYSVDSENTRY) := S0-SYSBASE;                     <<MPEIV>>50530000
      ABSOLUTE(SYSVDSMAP) := S0+BMOFFSET-SYSBASE;              <<MPEIV>>50532000
      DEL;  <<SPL CAN'T DEAL WITH USING TOS IN LAST STATEMENT>><<MPEIV>>50534000
      IF LDEV = SYSDISC THEN                                   <<MPEIV>>50536000
        BEGIN  << SAVE SYSTEM DISC POINTERS >>                 <<MPEIV>>50538000
        SYSENTRY := ABSOLUTE(SYSVDSENTRY);                     <<MPEIV>>50540000
        SYSMAP := ABSOLUTE(SYSVDSMAP);                         <<MPEIV>>50542000
        END;                                                   <<MPEIV>>50544000
      X := -1;                                                 <<MPEIV>>50546000
      WHILE LOGICAL(X:=X+1) < BMLENGTH-1  DO VDSMAP(X):= -1;   <<MPEIV>>50548000
      << SET BITS REPRESENTING AVAILABLE PAGES TO 1 >>         <<MPEIV>>50550000
      VDSMAP(BMLENGTH-1) := (-1)&LSL(16-I);<<LAST WORD OF MAP>><<01742>>50552000
                                                               <<MPEIV>>50554000
      VDSMTAB(VMSVOLUMECNTWORD) := VDSMTAB(VMSVOLUMECNTWORD)+1;<<MPEIV>>50556000
    << SET UP VOLUME ENTRY HEADER AREA >>                      <<MPEIV>>50558000
      VDSENTRY(NEXTINLISTWORD) := MEMLOC -                     <<MPEIV>>50560000
        (ABSOLUTE(SYSVDSMTAB)+SYSBASE);                        <<MPEIV>>50562000
      VDSENTRY(LDEVWORD) := LDEV;                              <<MPEIV>>50564000
      VDSENTRY(HOSTARTSECTORWORD) := VDSTART1;  << HODA >>     <<MPEIV>>50566000
      VDSENTRY(LOSTARTSECTORWORD) := VDSTART2;  << LODA >>     <<MPEIV>>50568000
      VDSENTRY(HOSECTORCONTWORD) := VDSLEN1;                   <<01569>>50570000
      VDSENTRY(LOSECTORCOUNTWORD) := VDSLEN2;                  <<MPEIV>>50572000
      VDSENTRY(TOTALPAGESWORD) := L'(VDSLEN'PAGES);            <<MPEIV>>50574000
      VDSENTRY(AVAILPAGESWORD) := L'(VDSLEN'PAGES);            <<MPEIV>>50576000
      VDSMTAB(TOTALVMPAGESWORD):=VDSMTAB(TOTALVMPAGESWORD)+    <<01639>>50578000
           L'(VDSLEN'PAGES);                                   <<01556>>50580000
      VDSENTRY(WORDSINBITMAPWORD) := BMLENGTH;                 <<MPEIV>>50582000
      VDSENTRY(SMALLESTMISSWORD) := L'(VDSLEN'PAGES);          <<MPEIV>>50584000
       VDSENTRY(DEVLEASTAVAILPAGESWORD):=L'(VDSLEN'PAGES);     <<01556>>50586000
                                                               <<MPEIV>>50588000
      IF TYPE=DISC0 OR TYPE=DISC1 THEN                         <<03549>>50590000
      BEGIN                                                    <<03549>>50592000
    << CHECK FOR DELETED TRACKS IN VM >>                       <<MPEIV>>50594000
      DISC(READ, LDEV, 1D, DTT, 128); <<READ DEF TRACKS TABLE>><<MPEIV>>50596000
      I := 0;                                                  <<MPEIV>>50598000
      WHILE (I:=I+1) <= DTT DO                                 <<MPEIV>>50600000
      IF DTT(I).(14:2) = 2 THEN                                <<MPEIV>>50602000
        BEGIN  << DELETED TRACK >>                             <<MPEIV>>50604000
        FSECT := D'( DTT(I)&LSR(2) ) * D'(TRACKLEN);           <<MPEIV>>50606000
        LSECT := FSECT + D'(TRACKLEN) - 1D;                    <<MPEIV>>50608000
                                                               <<MPEIV>>50610000
      << CONVERT FSECT AND LSECT TO THAT PORTION OF THE BAD  >><<MPEIV>>50612000
      << TRACK THAT LIES WITHIN VIRTUAL MEMORY.              >><<MPEIV>>50614000
        IF FSECT <= VDSTOP AND LSECT >= VDSTART THEN           <<MPEIV>>50616000
          BEGIN  << AT LEAST PARTIALLY IN VIRTUAL MEMORY >>    <<MPEIV>>50618000
          IF FSECT < VDSTART THEN                              <<MPEIV>>50620000
            << BAD TRACK OVERLAPS END OF V.M. >>               <<MPEIV>>50622000
            FSECT := VDSTART;                                  <<MPEIV>>50624000
          IF LSECT > VDSTOP THEN                               <<MPEIV>>50626000
            << BAD TRACK OVERLAPS END OF V.M. >>               <<MPEIV>>50628000
            LSECT := VDSTOP;                                   <<MPEIV>>50630000
                                                               <<MPEIV>>50632000
        << REMOVE BAD TRACK FROM BITMAP >>                     <<MPEIV>>50634000
          << WHEN COMPUTING THE FIRST AND LAST PAGES TO    >>  <<MPEIV>>50636000
          << REMOVE, BOTH WILL BE ROUNDED DOWN.            >>  <<MPEIV>>50638000
          FPAGE := L'( (FSECT-VDSTART)/D'(NSECTPAGE) );        <<MPEIV>>50640000
          LPAGE := L'( (LSECT-VDSTART)/D'(NSECTPAGE) );        <<MPEIV>>50642000
          PAGE := FPAGE;                                       <<MPEIV>>50644000
          DO                                                   <<MPEIV>>50646000
            BEGIN  << REMOVE SPACE FROM BITMAP >>              <<MPEIV>>50648000
            TOS := VDSMAP(PAGE.(0:12));                        <<MPEIV>>50650000
            X := PAGE.(12:4);  << BIT NUMBER >>                <<MPEIV>>50652000
            ASSEMBLE(TRBC 0,X);  << MARK UNAVAILABLE >>        <<MPEIV>>50654000
            IF = THEN ERRMESSAGE(M325,14);  << SPACE ERR >>    <<03632>>50656000
            VDSMAP(PAGE.(0:12)) := TOS;                        <<MPEIV>>50658000
            END                                                <<MPEIV>>50660000
          UNTIL (PAGE := PAGE+1) > LPAGE;                      <<MPEIV>>50662000
                                                               <<MPEIV>>50664000
          IF LDEV = SYSDISC AND NOT(INITLOGONDST) THEN         <<MPEIV>>50666000
            BEGIN  << SEE IF ON DELETED TRACK >>               <<MPEIV>>50668000
            IF INFOD(LOGONLOC1) <= LSECT AND                   <<MPEIV>>50670000
              INFOD(LOGONLOC1)+D'(WELMESPAGES-1)>=FSECT THEN   <<MPEIV>>50672000
              LOGON1'BAD := TRUE;                              <<MPEIV>>50674000
            IF INFOD(LOGONLOC2) <= LSECT AND                   <<MPEIV>>50676000
              INFOD(LOGONLOC2)+D'(WELMESPAGES-1)>=FSECT THEN   <<MPEIV>>50678000
              LOGON2'BAD := TRUE;                              <<MPEIV>>50680000
            END;                                               <<MPEIV>>50682000
          END;  << AT LEAST PARTIALLY ON DELETED TRACK >>      <<MPEIV>>50684000
        END;  << DELETED TRACK >>                              <<MPEIV>>50686000
      END;                                                     <<03549>>50688000
                                                               <<MPEIV>>50690000
        IF LDEV = SYSDISC THEN                                 <<MPEIV>>50692000
          BEGIN                                                <<MPEIV>>50694000
          IF WARMSTART THEN                                    <<MPEIV>>50696000
            BEGIN  << SAVE ODD, IDD, JMAT >>                   <<MPEIV>>50698000
            TOS := INFOD(ODDLOC);  << DISC ADDR OF ODD >>      <<MPEIV>>50700000
            TOS := INFOD(IDDLOC);  << DISC ADDR OF IDD >>      <<MPEIV>>50702000
            TOS := INFOD(JMATLOC);  << DISC ADDR OF JMAT >>    <<MPEIV>>50704000
            I := -1;                                           <<MPEIV>>50706000
            WHILE(I:=I+1) < 3 DO                               <<MPEIV>>50708000
              BEGIN                                            <<MPEIV>>50710000
              TOS := TOS - VDSTART;                            <<MPEIV>>50712000
              DELB;                                            <<MPEIV>>50714000
              FPAGE := TOS / NSECTPAGE;                        <<MPEIV>>50716000
              LPAGE := FPAGE + L'(PAGES(I)) - 1;               <<MPEIV>>50718000
              PAGE := FPAGE;                                   <<MPEIV>>50720000
              DO                                               <<MPEIV>>50722000
                BEGIN                                          <<MPEIV>>50724000
                TOS := VDSMAP(PAGE.(0:12));                    <<MPEIV>>50726000
                X := PAGE.(12:4);                              <<MPEIV>>50728000
                ASSEMBLE(TRBC 0,X);                            <<MPEIV>>50730000
                IF = THEN ERRMESSAGE(M231); <<BIT ALREADY 0>>  <<MPEIV>>50732000
                VDSMAP(PAGE.(0:12)) := TOS;                    <<MPEIV>>50734000
                END                                            <<MPEIV>>50736000
              UNTIL (PAGE := PAGE+1) > LPAGE;                  <<MPEIV>>50738000
              END;                                             <<MPEIV>>50740000
            END;  << WARMSTART >>                              <<MPEIV>>50742000
                                                               <<MPEIV>>50744000
          IF NOT LOGON1'BAD THEN                               <<MPEIV>>50746000
            BEGIN                                              <<MPEIV>>50748000
            DISC(READ, SYSDISC, INFOD(LOGONLOC1), LBUF, 1);    <<MPEIV>>50750000
            IF LBUF < 0 THEN LOGONLOC := LOGONLOC1;            <<MPEIV>>50752000
            END;                                               <<MPEIV>>50754000
          IF LOGONLOC = 0 AND NOT LOGON2'BAD THEN              <<MPEIV>>50756000
            BEGIN                                              <<MPEIV>>50758000
            DISC(READ,SYSDISC,INFOD(LOGONLOC2),LBUF,1);        <<MPEIV>>50760000
            IF LBUF < 0 THEN LOGONLOC := LOGONLOC2;            <<MPEIV>>50762000
            END;                                               <<MPEIV>>50764000
                                                               <<MPEIV>>50766000
          IF LOGONLOC = 0 AND (LOGON1'BAD OR LOGON2'BAD)       <<MPEIV>>50768000
            THEN MESSAGE(M2244);                               <<MPEIV>>50770000
                                                               <<MPEIV>>50772000
          IF LOGONLOC <> 0 THEN                                <<MPEIV>>50774000
            BEGIN  << SAVE LOGONDST VIRTUAL MEM. SPACE >>      <<MPEIV>>50776000
            FPAGE:=L'((INFOD(LOGONLOC)-VDSTART)/D'(NSECTPAGE));<<MPEIV>>50778000
            LPAGE := FPAGE + WELMESPAGES - 1;                  <<MPEIV>>50780000
            PAGE := FPAGE;                                     <<MPEIV>>50782000
            DO                                                 <<MPEIV>>50784000
              BEGIN                                            <<MPEIV>>50786000
              TOS := VDSMAP(PAGE.(0:12));                      <<MPEIV>>50788000
              X := PAGE.(12:4);                                <<MPEIV>>50790000
              ASSEMBLE(TRBC 0, X);                             <<MPEIV>>50792000
              IF = THEN ERRMESSAGE(M325,15);                   <<03632>>50794000
                << BIT ALREADY SET >>                          <<MPEIV>>50796000
              VDSMAP(PAGE.(0:12)) := TOS;                      <<MPEIV>>50798000
              END                                              <<MPEIV>>50800000
            UNTIL (PAGE := PAGE+1) > LPAGE;                    <<MPEIV>>50802000
            END;  << LOGONLOC <> 0 - SAVE IT >>                <<MPEIV>>50804000
          END;  << VOL = SYSTEM DISC >>                        <<MPEIV>>50806000
      END;  << WHILE VOL <= HVOL >>                            <<MPEIV>>50808000
                                                               <<MPEIV>>50810000
  VDSMTAB(TABLELENGTHWORD) := MEMLOC -                         <<MPEIV>>50812000
    (ABSOLUTE(SYSVDSMTAB)+SYSBASE);                            <<MPEIV>>50814000
  VDSMTAB(GLOBLEASTAVAILPAGE):=VDSMTAB(TOTALPAGESWORD);        <<01569>>50816000
  DST(VDSMDSTN*4) := VDSMTAB(TABLELENGTHWORD)&LSR(2);          <<MPEIV>>50818000
    << CORRECT DST LENGTH WORD >>                              <<MPEIV>>50820000
                                                               <<MPEIV>>50822000
  << RESET POINTERS TO SYSTEM DISC >>                          <<MPEIV>>50824000
  VDSENTRY(NEXTINLISTWORD) := BMOFFSET; <<PNT BACK TO 1ST ENT>><<MPEIV>>50826000
  ABSOLUTE(SYSVDSENTRY) := SYSENTRY;                           <<MPEIV>>50828000
  ABSOLUTE(SYSVDSMAP) := SYSMAP;                               <<MPEIV>>50830000
END;  << BUILD'VDSMTAB >>                                      <<MPEIV>>50832000
                                                                        50834000
          <<---------------------------------                           50836000
            RETURN SPACE FOR DELETED TRACKS                             50838000
          --------------------------------->>                           50840000
  PROCEDURE RETURNDELETES( LDEV);                              <<03549>>50842000
    VALUE LDEV;                                                <<03549>>50844000
    LOGICAL                                                    <<03549>>50846000
       LDEV;    << LOGICAL DEVICE NO. >>                       <<03549>>50848000
                                                               <<03549>>50850000
  COMMENT                                                      <<03549>>50852000
  RETURN DISC SPACE FOR DELETED TRACKS ON THE GIVEN LDEV.      <<03549>>50854000
  ;                                                            <<03549>>50856000
      BEGIN                                                    <<03549>>50860000
       DOUBLE  FSECT,   << FIRST SECTOR OF TRACK >>            <<03549>>50862000
               LSECT;   << LAST SECTOR OF TRACK >>             <<03549>>50864000
       INTEGER LEN,     << LENGTH OF TRACK >>                  <<03549>>50866000
               I := 0;  << INDEX >>                            <<03549>>50868000
       LOGICAL TYPE,    << DEVICE TYPE >>                      <<03549>>50870000
               STYPE;   << DEVICE SUBTYPE >>                   <<03549>>50872000
                                                               <<MPEIV>>50874000
       TYPE := LDT(LDEV*LDTSIZE+LDT2).TYP;                     <<03549>>50876000
       STYPE := LPDT(LDEV*LPDTSIZE+LPDT1).SUBTYPE;             <<03549>>50878000
       IF TYPE=DISC0 OR TYPE=DISC1 THEN                        <<03549>>50880000
          BEGIN                                                <<03549>>50882000
          DISC(READ,LDEV,1D,DTT,128);<<DEFECTIVE TRACKS TABLE>><<MPEIV>>50884000
          LEN := IF TYPE=MHDISCTYPE THEN MHINFO(STYPE          <<MPEIV>>50886000
            *MHINFOSIZE+MHSECTRK) ELSE 32;                              50888000
          WHILE (I:=I+1) <= DTT DO                                      50892000
          IF DTT(I).(14:2)=2 THEN                                       50894000
            BEGIN  <<DELETED TRACK>>                                    50896000
              TOS := LOGICAL(DTT(I)&LSR(2))**LOGICAL(LEN);              50898000
              FSECT := TOS;                                             50900000
              RETDISCSPACE(LDEV,D'L(LEN)),FSECT);              <<MPEIV>>50904000
            END;                                                        50908000
          END;                                                 <<03549>>50910000
      END <<RETURNDELETES>> ;                                           50912000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>50916000
        <<---------------------------------------------->>     <<03549>>50918000
        << RETURN OR REMOVE SPACE FOR REASSIGNED TRACKS >>     <<03549>>50920000
        <<---------------------------------------------->>     <<03549>>50922000
PROCEDURE REM'RET'REASS(RETRN,LDEV,DTT);                       <<03549>>50924000
VALUE RETRN,LDEV;                                              <<03549>>50926000
LOGICAL                                                        <<03549>>50928000
   RETRN;    << IF TRUE RETURN SPACE, IF FALSE REMOVE IT >>    <<03549>>50930000
INTEGER                                                        <<03549>>50932000
   LDEV;     << LOGICAL DEVICE # >>                            <<03549>>50934000
INTEGER ARRAY                                                  <<03549>>50936000
   DTT;      << DEFECTIVE TRACKS TABLE (TYPE 0 OR TYPE 1) >>   <<03549>>50938000
                                                               <<03549>>50940000
COMMENT                                                        <<03549>>50942000
RETURNS OR REMOVES DISC SPACE FROM THE DFSM FOR REASSIGNED     <<03549>>50944000
TRACKS ON A PARTICULAR LDEV.                                   <<03549>>50946000
;                                                              <<03549>>50948000
BEGIN                                                          <<03549>>50950000
DOUBLE                                                         <<03549>>50952000
   DADDR;   << STARTING DISC ADDRESS OF REASSIGNED AREA >>     <<03549>>50954000
LOGICAL                                                        <<03549>>50956000
   TYPE,       << DEVICE TYPE >>                               <<03549>>50958000
   STYPE,      << DEVICE SUBTYPE >>                            <<03549>>50960000
   TRACKLEN;   << LENGTH OF A TRACK >>                         <<03549>>50962000
INTEGER                                                        <<03549>>50964000
   I;                                                          <<03549>>50966000
                                                               <<03549>>50968000
TYPE := LDT(LDEV*LDTSIZE+LDT2).TYP;                            <<03549>>50970000
STYPE := LPDT(LDEV*LPDTSIZE+LPDT1).SUBTYPE;                    <<03549>>50972000
                                                               <<03549>>50974000
IF TYPE=DISC0 OR TYPE=DISC1 THEN                               <<03549>>50976000
   BEGIN                                                       <<03549>>50978000
                                                               <<03549>>50980000
 << GET LENGTH OF REASSIGNED AREA--IN THIS CASE, >>            <<03549>>50982000
 << THE LENGTH OF ONE TRACK                      >>            <<03549>>50984000
                                                               <<03549>>50986000
   IF TYPE=DISC0 THEN                                          <<03549>>50988000
      TRACKLEN := MHINFOL(STYPE*MHINFOSIZE+MHSECTRK)           <<03549>>50990000
   ELSE                                                        <<03549>>50992000
      TRACKLEN := 32;                                          <<03549>>50994000
   I := 0;                                                     <<03549>>50996000
   WHILE (I := I+1) <= DTT(0) DO                               <<03549>>50998000
      IF DTT(I).(14:2) = 3 THEN    << REASSIGNED TRACK >>      <<03549>>51000000
         BEGIN                                                 <<03549>>51002000
         DADDR := D'(DTT(I)&LSR(2)) * D'(TRACKLEN);            <<03549>>51004000
         IF RETRN THEN      << RETURN DISC SPACE >>            <<03549>>51006000
            RETDISCSPACE(LDEV,D'(TRACKLEN),DADDR)              <<03549>>51008000
         ELSE               << REMOVE DISC SPACE >>            <<03549>>51010000
            REMDISCSPACE(LDEV,D'(TRACKLEN),DADDR);             <<03549>>51012000
         END;                                                  <<03549>>51014000
   END                                                         <<03549>>51016000
                                                               <<03549>>51018000
ELSE IF TYPE=DISC3 THEN                                        <<03549>>51020000
   BEGIN   << DO NOTHING FOR NOW >>                            <<03549>>51022000
   END;                                                        <<03549>>51024000
END;   << REM'RET'REASS >>                                     <<03549>>51026000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>51028000
         <<-------------------------------------->>            <<03549>>51030000
         <<  GET THE END OF THE RESERVED AREA    >>            <<03549>>51032000
         <<-------------------------------------->>            <<03549>>51034000
DOUBLE PROCEDURE END'RESERVED( LDEV);                          <<03549>>51036000
VALUE LDEV;                                                    <<03549>>51038000
INTEGER                                                        <<03549>>51040000
   LDEV;    << LOGICAL DEVICE NO. >>                           <<03549>>51042000
                                                               <<03549>>51044000
COMMENT                                                        <<03549>>51046000
RETURNS THE ADDRESS OF THE LAST SECTOR OF THE RESERVED AREA    <<03549>>51048000
ON THE GIVEN LDEV.  THE RESERVED AREA IS THE AREA OF THE DISC  <<03549>>51050000
RESERVED FOR INITIAL'S BOOTSTRAP AND FOR INITIAL'S USE         <<03549>>51052000
DURING A BOOT.                                                 <<03549>>51054000
;                                                              <<03549>>51056000
BEGIN                                                          <<03549>>51058000
LOGICAL                                                        <<03549>>51060000
   TEMP;                                                       <<03549>>51062000
                                                               <<03549>>51064000
IF LDEV=SYSDISC THEN                                           <<03549>>51066000
   TEMP := LDEV'1'RESERVED'AREA'SIZE - 1                       <<03549>>51068000
ELSE                                                           <<03549>>51070000
   TEMP := OTHER'DISC'RESERVED'AREA'SIZE - 1;                  <<03549>>51072000
END'RESERVED := DOUBLE(TEMP);                                  <<03549>>51074000
END;   << END'RESERVED >>                                      <<03549>>51076000
          <<----------------------------------                          51078000
            CHECK IF TRACK IS IN SYSTEM AREA                            51080000
          ---------------------------------->>                          51082000
  PROCEDURE CHECKSYS(FSECT,LSECT);                                      51084000
    VALUE FSECT,LSECT;                                                  51086000
    DOUBLE FSECT,LSECT;                                                 51088000
    COMMENT                                                             51090000
      CHECKS IF THE TRACK BOUNDED BY FSECT AND LSECT IS IN ONE OF THE   51092000
    SYSTEM TABLES, INITIAL'S CSTS OR THE MESSAGE CATALOG ON DISC. IF IT 51094000
    IS, RETURNS CCL, OTHERWISE CCE;                                     51096000
      BEGIN                                                             51098000
        INTEGER I:=0;                                                   51100000
        SUBROUTINE COMPARE(LEN,DADDR);                                  51102000
        VALUE LEN, DADDR;                                               51104000
        INTEGER LEN;                                                    51106000
        DOUBLE DADDR;                                                   51108000
        BEGIN                                                           51110000
          IF LSECT>=DADDR AND FSECT<DADDR+D'L(LEN)) THEN                51112000
            BEGIN  <<TRACK IS IN SYSTEM AREA>>                          51114000
              CC := CCL;                                                51116000
              ASSEMBLE(EXIT 4); <<EXIT FROM PROCEDURE>>                 51118000
            END;                                                        51120000
        END <<COMPARE>> ;                                               51122000
          COMPARE(LPDTSECT,TABLEINFO(LPDTINFOX+1)); <<LPDT>>            51124000
          COMPARE(LDTSECT,TABLEINFO(LDTINFOX+1));  <<LDT>>              51126000
          COMPARE(DVCLSECT,TABLEINFO(DVCLINFOX+1)); <<DEV CLASS TABLE>> 51128000
          COMPARE(LDTXSECT,TABLEINFO(LDTXINFOX+1)); << LDTX >> <<03549>>51130000
          COMPARE(VTABSECT,TABLEINFO(VTABINFOX+1)); <<VOLUME TABLE>>    51132000
          TOS := TABLEINFO(STACKINFOX);                                 51134000
          DEL;                                                          51136000
          TOS := (TOS+127)&LSR(7);  <<SECTOR COUNT>>                    51138000
          COMPARE(*,TABLEINFO(X:=X+1)); <<INITIAL'S STACK>>             51140000
          DO                                                            51142000
            BEGIN  <<CHECK INITIAL'S CSTS>>                             51144000
              TOS := TCSTINFO(I&LSL(1));                                51146000
              DEL;                                                      51148000
              TOS := (TOS+127)&LSR(7);                                  51150000
              COMPARE(*,TCSTINFO(X:=X+1)); <<CST>>                      51152000
            END                                                         51154000
          UNTIL (I:=I+1)=INFO(NUTCST');                                 51156000
          CC := CCE;  <<EVERYTHING OK>>                                 51158000
      END <<CHECKSYS>> ;                                                51160000
          <<-------------------------------------------->>     <<03612>>51162000
          <<CHECK IF DEFECTIVE TRACK IS IN THE DIRECTORY>>     <<03612>>51164000
          <<-------------------------------------------->>     <<03612>>51166000
LOGICAL PROCEDURE CHECK'DIRECTORY (FSECT,LSECT);               <<03612>>51168000
  VALUE FSECT,LSECT;                                           <<03612>>51170000
  DOUBLE FSECT,LSECT;                                          <<03612>>51172000
                                                               <<03612>>51174000
  COMMENT                                                      <<03612>>51176000
    CHECKS IF THE DEFECTIVE TRACK BOUNDED BY FSECT AND LSECT   <<03612>>51178000
  IS IN THE DIRECTORY.  IF IT IS, RETURN TRUE.  THIS PROC      <<03612>>51180000
  IS CALLED FROM MAINSEG1;                                     <<03612>>51182000
                                                               <<03612>>51184000
    BEGIN                                                      <<03612>>51186000
      CHECK'DIRECTORY := FALSE;                                <<03612>>51188000
      IF FSECT < INFOD(DIRADR) + D'L(INFO(DIRSECT))) AND       <<03612>>51190000
         LSECT >= INFOD(DIRADR)                                <<03612>>51192000
         THEN                                                  <<03612>>51194000
           CHECK'DIRECTORY := TRUE;                            <<03612>>51196000
    END;                                                       <<03612>>51198000
   <<-------------------------------------------------------->><<03612>>51200000
   <<CHECK IF DEFECTIVE TRACK IN A SYSTEM DISC RESIDENT TABLE>><<03612>>51202000
   <<-------------------------------------------------------->><<03612>>51204000
LOGICAL PROCEDURE CHECK'RESIDENT (FSECT,LSECT);                <<03612>>51206000
  VALUE FSECT,LSECT;                                           <<03612>>51208000
  DOUBLE FSECT,LSECT;                                          <<03612>>51210000
                                                               <<03612>>51212000
  COMMENT                                                      <<03612>>51214000
    CHECKS IF THE TRACK BOUNDED BY FSECT AND LSECT IS IN THE   <<03612>>51216000
  RIN TABLE, LOG ID, OR LOG TAB AREAS ON DISC.  IF IT IS THEN  <<03612>>51218000
  RETURN TRUE.  THIS PROC IS CALLED BY MAINSEG1;               <<03612>>51220000
                                                               <<03612>>51222000
    BEGIN                                                      <<03612>>51224000
      LOGICAL SUBROUTINE BOUNDS (LEN,ADDR);                    <<03612>>51226000
        VALUE LEN,ADDR;                                        <<03612>>51228000
        INTEGER LEN,ADDR;                                      <<03612>>51230000
        BEGIN                                                  <<03612>>51232000
          BOUNDS := FALSE;                                     <<03612>>51234000
          IF FSECT < INFOD(ADDR) + D'L(INFO(LEN))) AND         <<03612>>51236000
             LSECT >= INFOD(ADDR)                              <<03612>>51238000
             THEN                                              <<03612>>51240000
               BOUNDS := TRUE;                                 <<03612>>51242000
        END; <<BOUNDS>>                                        <<03612>>51244000
      CHECK'RESIDENT := FALSE;                                 <<03612>>51246000
      IF BOUNDS(RINSECT,RINADR) OR                             <<03612>>51248000
         BOUNDS(LOGIDSECT,LOGIDADDR) OR                        <<03612>>51250000
         BOUNDS(LOGTABSECT,LOGTABADDR)                         <<03612>>51252000
         THEN                                                  <<03612>>51254000
           CHECK'RESIDENT := TRUE;                             <<03612>>51256000
    END; <<CHECK'RESIDENT>>                                    <<03612>>51258000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03714>>51260000
    <<----------------------------------------------------->>  <<03714>>51262000
    <<  CHECK IF DEFECTIVE DISC AREA IS IN VIRTUAL MEMORY  >>  <<03714>>51264000
    <<----------------------------------------------------->>  <<03714>>51266000
LOGICAL PROCEDURE CHECK'VM(LDEV, FSECT, LSECT);                <<03714>>51268000
VALUE LDEV, FSECT, LSECT;                                      <<03714>>51270000
INTEGER                                                        <<03714>>51272000
   LDEV;         << LOGICAL DEVICE NO. >>                      <<03714>>51274000
DOUBLE                                                         <<03714>>51276000
   FSECT,        << ADDRESS OF FIRST SECTOR OF AREA >>         <<03714>>51278000
   LSECT;        << ADDRESS OF LAST SECTOR OF AREA  >>         <<03714>>51280000
COMMENT                                                        <<03714>>51282000
CHECKS TO SEE IF THE DISC AREA ON THE GIVEN LDEV BOUNDED BY    <<03714>>51284000
FSECT (STARTING ADDRESS) AND LSECT (ENDING ADDRESS) OVERLAPS   <<03714>>51286000
ANY PART OF VIRTUAL MEMORY.  IF SO, THE PROCEDURE RETURNS      <<03714>>51288000
TRUE, FALSE OTHERWISE.                                         <<03714>>51290000
;                                                              <<03714>>51292000
BEGIN                                                          <<03714>>51294000
DOUBLE                                                         <<03714>>51296000
   VDSTART,           << STARTING DISC ADDRESS OF VM >>        <<03714>>51298000
   VDSLEN;            << LENGTH OF VM IN SECTORS >>            <<03714>>51300000
INTEGER                                                        <<03714>>51302000
   VOLUME,                 << VOLUME NO. OF DISC >>            <<03714>>51304000
   VDSTART1 = VDSTART,     << HIGH ORDER WORD OF VDSTART >>    <<03714>>51306000
   VDSTART2 = VDSTART+1,   << LOW ORDER WORD OF VDSTART >>     <<03714>>51308000
   VDSLEN1  = VDSLEN,      << HIGH ORDER WORD OF VDSLEN >>     <<03714>>51310000
   VDSLEN2  = VDSLEN+1;    << LOW ORDER WORD OF VDSLEN >>      <<03714>>51312000
                                                               <<03714>>51314000
CHECK'VM := FALSE;    << INITIALIZE RETURN >>                  <<03714>>51316000
VOLUME := GETVOL(LDEV);                                        <<03714>>51318000
IF VTAB(VOLUME*VTABSIZE+VTAB12).VMS = 1 THEN                   <<03714>>51320000
   BEGIN                             << DISC HAS VM >>         <<03714>>51322000
                                                               <<03714>>51324000
   VDSTART1 := VTAB(VOLUME*VTABSIZE+VTAB8);                    <<03714>>51326000
   VDSTART2 := VTAB(VOLUME*VTABSIZE+VTAB9);                    <<03714>>51328000
   VDSLEN1  := VTAB(VOLUME*VTABSIZE+VTAB10);                   <<03714>>51330000
   VDSLEN2  := VTAB(VOLUME*VTABSIZE+VTAB11);                   <<03714>>51332000
                                                               <<03714>>51334000
   IF FSECT < (VDSTART + VDSLEN) AND                           <<03714>>51336000
      LSECT >= VDSTART THEN                                    <<03714>>51338000
                                                               <<03714>>51340000
      CHECK'VM := TRUE;       << IT'S IN VIRTUAL MEMORY >>     <<03714>>51342000
   END;                                                        <<03714>>51344000
END;   << CHECK'VM >>                                          <<03714>>51346000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03714>>51348000
    <<------------------------------------------------->>      <<03714>>51350000
    <<  CHECK IF RECOVER LOST DISC SPACE IS NECESSARY  >>      <<03714>>51352000
    <<------------------------------------------------->>      <<03714>>51354000
LOGICAL PROCEDURE RECOVERY'NEEDED(LDEV, FSECT, LSECT);         <<03714>>51356000
VALUE LDEV,FSECT,LSECT;                                        <<03714>>51358000
INTEGER                                                        <<03714>>51360000
   LDEV;           << LOGICAL DEVICE NO. >>                    <<03714>>51362000
DOUBLE                                                         <<03714>>51364000
   FSECT,          << ADDRESS OF FIRST SECTOR OF AREA >>       <<03714>>51366000
   LSECT;          << ADDRESS OF LAST SECTOR OF AREA  >>       <<03714>>51368000
COMMENT                                                        <<03714>>51370000
CHECKS TO SEE IF THE DISC AREA ON THE GIVEN LDEV AND           <<03714>>51372000
BOUNDED BY FSECT AND LSECT, IN WHICH DATA WAS LOST, IS         <<03714>>51374000
SITUATED SUCH THAT RECOVER LOST DISC SPACE WILL BE             <<03714>>51376000
REQUIRED.  RECOVER LOST DISC SPACE IS REQUIRED IF THERE IS     <<03714>>51378000
ANY CHANCE THAT A FILE LOST DATA OR THE DISC FREE SPACE MAP    <<03714>>51380000
LOST DATA.  IF RECOVERY IS REQUIRED, IT RETURNS TRUE.          <<03714>>51382000
;                                                              <<03714>>51384000
BEGIN                                                          <<03714>>51386000
DOUBLE                                                         <<03714>>51388000
   VDSTART,   << STARTING ADDRESS OF VM >>                     <<03714>>51390000
   VDSLEN;    << LENGTH OF VM IN SECTORS >>                    <<03714>>51392000
INTEGER                                                        <<03714>>51394000
   VOLUME,                 << VOLUME NO. OF DISC >>            <<03714>>51396000
   VDSTART1 = VDSTART,     << HIGH ORDER WORD OF VDSTART >>    <<03714>>51398000
   VDSTART2 = VDSTART+1,   << LOW ORDER WORD OF VDSTART >>     <<03714>>51400000
   VDSLEN1  = VDSLEN,      << HIGH ORDER WORD OF VDSLEN >>     <<03714>>51402000
   VDSLEN2  = VDSLEN+1;    << LOW ORDER WORD OF VDSLEN >>      <<03714>>51404000
                                                               <<03714>>51406000
RECOVERY'NEEDED := FALSE;    << INITIALIZE RETURN >>           <<03714>>51408000
                                                               <<03714>>51410000
IF NOT RELOAD THEN           << NEVER DO RECOVERY ON RELOAD >> <<03714>>51412000
   BEGIN                                                       <<03714>>51414000
                                                               <<03714>>51416000
   << IF THE ENTIRE AREA IS WITHIN THE RESERVED AREA, IT >>    <<03714>>51418000
   << DOES NOT REQUIRE A RECOVER LOST DISC SPACE         >>    <<03714>>51420000
                                                               <<03714>>51422000
   IF LSECT <= END'RESERVED(LDEV) THEN                         <<03714>>51424000
      RETURN;                    << NO RECOVERY REQUIRED >>    <<03714>>51426000
                                                               <<03714>>51428000
   VOLUME := GETVOL(LDEV);                                     <<03714>>51430000
   IF VTAB(VOLUME*VTABSIZE+VTAB12).VMS=1 THEN                  <<03714>>51432000
      BEGIN                            << DISC HAS VM >>       <<03714>>51434000
                                                               <<03714>>51436000
      << IF THE AREA WHICH LOST DATA IS TOTALLY WITHIN  >>     <<03714>>51438000
      << VIRTUAL MEMORY THERE IS NO NEED TO RECOVER     >>     <<03714>>51440000
      << LOST DISC SPACE.                               >>     <<03714>>51442000
                                                               <<03714>>51444000
      VDSTART1 := VTAB(VOLUME*VTABSIZE+VTAB8);                 <<03714>>51446000
      VDSTART2 := VTAB(VOLUME*VTABSIZE+VTAB9);                 <<03714>>51448000
      VDSLEN1  := VTAB(VOLUME*VTABSIZE+VTAB10);                <<03714>>51450000
      VDSLEN2  := VTAB(VOLUME*VTABSIZE+VTAB11);                <<03714>>51452000
                                                               <<03714>>51454000
      IF FSECT >= VDSTART AND                                  <<03714>>51456000
         LSECT < (VDSTART + VDSLEN) THEN                       <<03714>>51458000
         << RECOVER LOST DISC SPACE NOT NEEDED >>              <<03714>>51460000
      ELSE                                                     <<03714>>51462000
         RECOVERY'NEEDED := TRUE;                              <<03714>>51464000
                                                               <<03714>>51466000
      END                                                      <<03714>>51468000
                                                               <<03714>>51470000
   ELSE                                                        <<03714>>51472000
      RECOVERY'NEEDED := TRUE;    << NO VM ON THE DISC, >>     <<03714>>51474000
                                  <<   MUST DO RECOVERY >>     <<03714>>51476000
                                                               <<03714>>51478000
   END;                                                        <<03714>>51480000
END;   << RECOVERY'NEEDED >>                                   <<03714>>51482000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03714>>51484000
    <<------------------------------------------------------>> <<03714>>51486000
    <<  ISSUE WARNINGS FOR DATA LOST IN SPECIAL DISC AREAS  >> <<03714>>51488000
    <<------------------------------------------------------>> <<03714>>51490000
PROCEDURE WARN'DISC'ZAPPED(LDEV, FSECT, LSECT);                <<03714>>51492000
VALUE LDEV,FSECT,LSECT;                                        <<03714>>51494000
INTEGER                                                        <<03714>>51496000
   LDEV;     << LOGICAL DEVICE OF DISC >>                      <<03714>>51498000
DOUBLE                                                         <<03714>>51500000
   FSECT,    << ADDRESS OF FIRST SECTOR OF AREA >>             <<03714>>51502000
   LSECT;    << ADDRESS OF LAST SECTOR OF AREA  >>             <<03714>>51504000
COMMENT                                                        <<03714>>51506000
ISSUES WARNINGS FOR DATA LOST IN THE FOLLOWING SPECIAL         <<03714>>51508000
AREAS OF THE DISC:  THE RESERVED AREA, THE SYSTEM AREA,        <<03714>>51510000
THE DIRECTORY, THE DISC FREE SPACE MAP, ANY OTHER DISC         <<03714>>51512000
RESIDENT TABLE, AND VIRTUAL MEMORY.  MORE THAN ONE WARNING     <<03714>>51514000
MAY APPEAR FOR A GIVEN DISC AREA.  THIS PROCEDURE IS USED      <<03714>>51516000
DURING SPARING.                                                <<03714>>51518000
;                                                              <<03714>>51520000
BEGIN                                                          <<03714>>51522000
                                                               <<03714>>51524000
IF FSECT <= END'RESERVED(LDEV) THEN    << WARNING: IN       >> <<03714>>51526000
   MESSAGE(M2240);                     <<    RESERVED AREA  >> <<03714>>51528000
                                                               <<03714>>51530000
IF LDEV = SYSDISC THEN                                         <<03714>>51532000
   BEGIN                                                       <<03714>>51534000
                                                               <<03714>>51536000
   IF NOT LOADFROMTAPE THEN                                    <<03714>>51538000
      BEGIN                                                    <<03714>>51540000
                                                               <<03714>>51542000
      CHECKSYS(FSECT, LSECT);                                  <<03714>>51544000
      IF <> THEN                     << WARNING: IN SYSTEM >>  <<03714>>51546000
         MESSAGE(M2246);             <<    AREA            >>  <<03714>>51548000
                                                               <<03714>>51550000
      END;                                                     <<03714>>51552000
                                                               <<03714>>51554000
   IF NOT RELOAD THEN                                          <<03714>>51556000
      BEGIN                                                    <<03714>>51558000
                                                               <<03714>>51560000
      IF CHECK'DIRECTORY(FSECT, LSECT) THEN    << WARNING:  >> <<03714>>51562000
         MESSAGE(M2241);                    << IN DIRECTORY >> <<03714>>51564000
                                                               <<03714>>51566000
      IF CHECK'RESIDENT(FSECT, LSECT) THEN    << WARNING:   >> <<03714>>51568000
         MESSAGE(M2250);         << IN DISC RESIDENT TABLE  >> <<03714>>51570000
                                                               <<03714>>51572000
      END;                                                     <<03714>>51574000
   END;                                                        <<03714>>51576000
                                                               <<03714>>51578000
IF NOT RELOAD THEN                                             <<03714>>51580000
   IF CHECK'IF'OVERLAPS'DFS'DATA'STRUCTURES(                   <<03714>>51582000
                          LDEV, FSECT, LSECT) THEN             <<03714>>51584000
      MESSAGE(M2248);    << WARNING: IN FREE SPACE MAP >>      <<03714>>51586000
                                                               <<03714>>51588000
IF NOT RELOAD OR RESTORE THEN                                  <<03714>>51590000
   IF CHECK'VM(LDEV, FSECT, LSECT) THEN     << WARNING: IN  >> <<03714>>51592000
      MESSAGE(M2242);                   <<  VIRTUAL MEMORY  >> <<03714>>51594000
                                                               <<03714>>51596000
END;   << WARN'DISC'ZAPPED >>                                  <<03714>>51598000
$CONTROL SEGMENT=SETUP                                         <<03549>>51602000
          <<---------------------------------->>               <<03549>>51604000
          <<     TEST A BIT IN A BIT MAP      >>               <<03549>>51606000
          <<---------------------------------->>               <<03549>>51608000
LOGICAL PROCEDURE TESTBIT(BIT'MAP,BIT'NUM);                    <<03549>>51610000
VALUE BIT'NUM;                                                 <<03549>>51612000
INTEGER ARRAY                                                  <<03549>>51614000
   BIT'MAP;    << BIT MAP >>                                   <<03549>>51616000
INTEGER                                                        <<03549>>51618000
   BIT'NUM;    << BIT NUMBER >>                                <<03549>>51620000
                                                               <<03549>>51622000
COMMENT                                                        <<03549>>51624000
RETURN TRUE IF THE GIVEN BIT'NUM IN BITMAP IS SET (=1).        <<03549>>51626000
OTHERWISE, RETURN FALSE.                                       <<03549>>51628000
;                                                              <<03549>>51630000
BEGIN                                                          <<03549>>51632000
INTEGER                                                        <<03549>>51634000
   TEMP;                                                       <<03549>>51636000
                                                               <<03549>>51638000
TEMP := BIT'MAP(BIT'NUM.(0:12));   << GET APPROPRIATE WORD >>  <<03549>>51640000
                                   <<     FROM BIT'MAP     >>  <<03549>>51642000
IF TEMP&LSL(BIT'NUM.(12:4)) < 0 THEN     << IF BIT IS SET, >>  <<03549>>51644000
   TESTBIT := TRUE                       <<    RETURN TRUE >>  <<03549>>51646000
ELSE                                     << OTHERWISE,     >>  <<03549>>51648000
   TESTBIT := FALSE;                     <<   RETURN FALSE >>  <<03549>>51650000
END;   << TESTBIT >>                                           <<03549>>51652000
$CONTROL SEGMENT=SETUP                                         <<03549>>51654000
           <<-------------------------------->>                <<03549>>51656000
           <<     SET A BIT IN A BIT MAP     >>                <<03549>>51658000
           <<-------------------------------->>                <<03549>>51660000
PROCEDURE SETBIT(BIT'MAP,BIT'NUM);                             <<03549>>51662000
VALUE BIT'NUM;                                                 <<03549>>51664000
INTEGER ARRAY                                                  <<03549>>51666000
   BIT'MAP;   << BIT MAP >>                                    <<03549>>51668000
INTEGER                                                        <<03549>>51670000
   BIT'NUM;   << BIT NUMBER >>                                 <<03549>>51672000
                                                               <<03549>>51674000
COMMENT                                                        <<03549>>51676000
SET THE THE GIVEN BIT'NUM IN BIT'MAP                           <<03549>>51678000
;                                                              <<03549>>51680000
BEGIN                                                          <<03549>>51682000
LOGICAL                                                        <<03549>>51684000
   TEMP,I;                                                     <<03549>>51686000
                                                               <<03549>>51688000
TEMP := BIT'MAP(BIT'NUM.(0:12));   << GET APPROPRIATE WORD >>  <<03549>>51690000
                                   <<    FROM THE BIT MAP  >>  <<03549>>51692000
I := %100000&LSR(BIT'NUM.(12:4));         << SET THE       >>  <<03549>>51694000
BIT'MAP(BIT'NUM.(0:12)) := TEMP LOR I;    <<   DESIRED BIT >>  <<03549>>51696000
END;   << SETBIT >>                                            <<03549>>51698000
$CONTROL SEGMENT=SETUP                                         <<03549>>51700000
          <<------------------------------>>                   <<03549>>51702000
          <<  CLEAR A BIT IN A BIT MAP    >>                   <<03549>>51704000
          <<------------------------------>>                   <<03549>>51706000
PROCEDURE CLEARBIT( BIT'MAP, BIT'NUM);                         <<03549>>51708000
VALUE BIT'NUM;                                                 <<03549>>51710000
INTEGER ARRAY                                                  <<03549>>51712000
   BIT'MAP;    << BIT MAP >>                                   <<03549>>51714000
INTEGER                                                        <<03549>>51716000
   BIT'NUM;    << BIT NUMBER TO CLEAR >>                       <<03549>>51718000
                                                               <<03549>>51720000
COMMENT                                                        <<03549>>51722000
CLEARS (ZEROES) THE GIVEN BIT'NUM IN BIT'MAP                   <<03549>>51724000
;                                                              <<03549>>51726000
BEGIN                                                          <<03549>>51728000
LOGICAL                                                        <<03549>>51730000
   TEMP,I;                                                     <<03549>>51732000
                                                               <<03549>>51734000
TEMP := BIT'MAP(BIT'NUM.(0:12));     << GET THE APPROPRIATE >> <<03549>>51736000
                                     <<   WORD FROM BIT'MAP >> <<03549>>51738000
I := %077777 & CSR(BIT'NUM.(4:12));      << CLEAR THE       >> <<03549>>51740000
BIT'MAP(BIT'NUM.(0:12)) := TEMP LAND I;  <<   DESIRED BIT   >> <<03549>>51742000
END;   << CLEARBIT >>                                          <<03549>>51744000
$CONTROL SEGMENT=SETUP                                         <<03549>>51746000
           <<---------------------------------->>              <<03549>>51748000
           <<  GET SPACE IN THE RESERVED AREA  >>              <<03549>>51750000
           <<---------------------------------->>              <<03549>>51752000
LOGICAL PROCEDURE GET'RESERVED( DADDR, SIZE);                  <<03549>>51754000
VALUE SIZE;                                                    <<03549>>51756000
DOUBLE                                                         <<03549>>51758000
   DADDR;   << RETURN DOUBLE WORD DISC ADDRESS >>              <<03549>>51760000
INTEGER                                                        <<03549>>51762000
   SIZE;    << NUMBER OF SECTORS REQUESTED  >>                 <<03549>>51764000
                                                               <<03549>>51766000
COMMENT                                                        <<03549>>51768000
GET 'SIZE' NUMBER OF CONTIGUOUS SECTORS IN THE RESERVED AREA   <<03549>>51770000
OF THE DISC.  IF A CONTIGUOUS AREA OF THAT SIZE IS NOT         <<03549>>51772000
AVAILABLE, GET'RESERVED RETURNS FALSE.  OTHERWISE, IT          <<03549>>51774000
RETURNS TRUE WITH THE STARTING DISC ADDRESS IN DADDR.          <<03549>>51776000
NOTE:  ALTHOUGH THIS PROCEDURE RETURNS A DOUBLE DISC ADDRESS,  <<03549>>51778000
THE ADDRESS IS ALWAYS <= 32767 (DECIMAL).                      <<03549>>51780000
;                                                              <<03549>>51782000
BEGIN                                                          <<03549>>51784000
INTEGER                                                        <<03549>>51786000
   CUR'SECTOR,      << CURRENT SECTOR >>                       <<03549>>51788000
   LAST'RESERVED,   << LAST SECTOR IN RESERVED AREA >>         <<03549>>51790000
   START'SECTOR;    << CURRENT STARTING SECTOR >>              <<03549>>51792000
LOGICAL                                                        <<03549>>51794000
   FOUND;           << TRUE IF SPACE IS FOUND >>               <<03549>>51796000
                                                               <<03549>>51798000
FOUND := FALSE;                                                <<03549>>51800000
CUR'SECTOR := -1;                                              <<03549>>51802000
LAST'RESERVED := LDEV'1'RESERVED'AREA'SIZE - 1;                <<03549>>51804000
                                                               <<03549>>51806000
WHILE NOT FOUND AND CUR'SECTOR < LAST'RESERVED DO              <<03549>>51808000
   BEGIN                                                       <<03549>>51810000
   FOUND := TRUE;    << HAVEN'T FOUND IT YET, BUT WE'LL TRY >> <<03549>>51812000
   START'SECTOR := CUR'SECTOR + 1;                             <<03549>>51814000
                                                               <<03549>>51816000
 << BEGINNING AT START'SECTOR, CHECK 'SIZE' CONSECUTIVE   >>   <<03549>>51818000
 << SECTORS TO SEE IF THEY ARE ALL FREE                   >>   <<03549>>51820000
                                                               <<03549>>51822000
   WHILE FOUND AND (CUR'SECTOR := CUR'SECTOR + 1)              <<03549>>51824000
                  <= (START'SECTOR + SIZE - 1) DO              <<03549>>51826000
      IF CUR'SECTOR <= LAST'RESERVED THEN                      <<03549>>51828000
         IF NOT TESTBIT(BOOTSPACEMAP, CUR'SECTOR) THEN         <<03549>>51830000
            FOUND := FALSE   << SECTOR ALREADY IN USE >>       <<03549>>51832000
         ELSE                << CONTINUE >>                    <<03549>>51834000
                                                               <<03549>>51836000
      ELSE                                                     <<03549>>51838000
         FOUND := FALSE;     << PAST END OF RESERVED AREA >>   <<03549>>51840000
                                                               <<03549>>51842000
   END;   << WHILE NOT FOUND AND CUR'SECTOR < LAST'RESERVED >> <<03549>>51844000
                                                               <<03549>>51846000
IF FOUND THEN                                                  <<03549>>51848000
   BEGIN             << WE GOT THE SPACE >>                    <<03549>>51850000
   CUR'SECTOR := START'SECTOR - 1;                             <<03549>>51852000
   WHILE (CUR'SECTOR := CUR'SECTOR + 1)      << RESERVE THE >> <<03549>>51854000
                <= (START'SECTOR + SIZE - 1) DO   << SPACE  >> <<03549>>51856000
      CLEARBIT(BOOTSPACEMAP, CUR'SECTOR);                      <<03549>>51858000
   DADDR := DOUBLE(START'SECTOR);                              <<03549>>51860000
   GET'RESERVED := TRUE;                                       <<03549>>51862000
   END                                                         <<03549>>51864000
                                                               <<03549>>51866000
ELSE                                                           <<03549>>51868000
   GET'RESERVED := FALSE;     << COULDN'T GET IT, SO SORRY >>  <<03549>>51870000
                                                               <<03549>>51872000
END;   << GET'RESERVED >>                                      <<03549>>51874000
$CONTROL SEGMENT=SETUP                                         <<03549>>51876000
         <<-------------------------------------->>            <<03549>>51878000
         <<  RELEASE SPACE IN THE RESERVED AREA  >>            <<03549>>51880000
         <<-------------------------------------->>            <<03549>>51882000
PROCEDURE RELEASE'RESERVED( DADDR, SIZE);                      <<03549>>51884000
VALUE DADDR,SIZE;                                              <<03549>>51886000
DOUBLE                                                         <<03549>>51888000
   DADDR;    << STARTING DISC ADDRESS OF RELEASE AREA >>       <<03549>>51890000
INTEGER                                                        <<03549>>51892000
   SIZE;     << LENGTH IN SECTORS OF RELEASE AREA >>           <<03549>>51894000
                                                               <<03549>>51896000
COMMENT                                                        <<03549>>51898000
RELEASES SPACE IN THE RESERVED AREA, PREVIOUSLY RESERVED BY    <<03549>>51900000
GET'RESERVED.  THIS AREA IS AVAILABLE TO INITIAL ONLY FOR      <<03549>>51902000
ITS BOOTSTRAP AND WORKING SPACE.  NOTE:  ALTHOUGH DADDR IS     <<03549>>51904000
A DOUBLE, IT IS ASSUMED THAT IT CONTAINS A VALUE <= 32767.     <<03549>>51906000
ALSO, IF AN ATTEMPT IS MADE TO RETURN SPACE NOT IN THE         <<03549>>51908000
RESERVED AREA OR SPACE ALREADY FREE, INITIAL ABORTS.           <<03549>>51910000
;                                                              <<03549>>51912000
BEGIN                                                          <<03549>>51914000
INTEGER                                                        <<03549>>51916000
   I,                  << CURRENT SECTOR >>                    <<03549>>51918000
   LAST'RESERVED,      << LAST SECTOR IN RESERVED AREA >>      <<03549>>51920000
   START'SECTOR = DADDR+1;   << LOW ORDER WORD OF DADDR >>     <<03549>>51922000
                                                               <<03549>>51924000
I := -1;                                                       <<03549>>51926000
LAST'RESERVED := LDEV'1'RESERVED'AREA'SIZE - 1;                <<03549>>51928000
                                                               <<03549>>51930000
WHILE (I := I + 1) < SIZE DO     << TRY TO FREE SPACE >>       <<03549>>51932000
   BEGIN                                                       <<03549>>51934000
   IF (START'SECTOR + I) > LAST'RESERVED THEN                  <<03549>>51936000
      ERRMESSAGE(M334);      << SPACE NOT IN RESERVED AREA >>  <<03549>>51938000
                                                               <<03549>>51940000
   IF TESTBIT(BOOTSPACEMAP, START'SECTOR + I) THEN             <<03549>>51942000
      ERRMESSAGE(M335);      << SPACE ALREADY FREE >>          <<03549>>51944000
                                                               <<03549>>51946000
 << FREE ONE SECTOR >>                                         <<03549>>51948000
                                                               <<03549>>51950000
   SETBIT(BOOTSPACEMAP, START'SECTOR + I);                     <<03549>>51952000
   END;                                                        <<03549>>51954000
END;   << RELEASE'RESERVED >>                                  <<03549>>51956000
$CONTROL SEGMENT=SETUP                                         <<03549>>51958000
            <<--------------------------------->>              <<03549>>51960000
            <<   GET BOOTSTRAP DISC SPACE      >>              <<03549>>51962000
            <<--------------------------------->>              <<03549>>51964000
INTEGER PROCEDURE BOOTDISCSPACE( SIZE);                        <<03549>>51966000
VALUE SIZE;                                                    <<03549>>51968000
LOGICAL                                                        <<03549>>51970000
   SIZE;    << NO. OF WORDS NEEDED >>                          <<03549>>51972000
COMMENT                                                        <<03549>>51974000
GETS SPACE OF WORD LENGTH SIZE (IN SECTOR MULTIPLES) FROM      <<03549>>51976000
THE BOOTSTRAP AREA OF THE SYSTEM DISC.  RETURNS THE            <<03549>>51978000
SINGLE-WORD DISC ADDRESS IN BOOTDISCSPACE.                     <<03549>>51980000
;                                                              <<03549>>51982000
BEGIN                                                          <<03549>>51984000
DOUBLE                                                         <<03549>>51986000
   DADDR;                << DOUBLE WORD DISC ADDRESS >>        <<03549>>51988000
INTEGER                                                        <<03549>>51990000
   DADDR2 = DADDR + 1;   << LOW ORDER WORD OF DADDR >>         <<03549>>51992000
                                                               <<03549>>51994000
SIZE := (SIZE + 127)/128;   << COMPUTE NO. OF SECTORS >>       <<03549>>51996000
                            <<    (ROUNDED UP)        >>       <<03549>>51998000
                                                               <<03549>>52000000
IF NOT GET'RESERVED(DADDR,SIZE) THEN                           <<03549>>52002000
   ERRMESSAGE( M327);   << OUT OF BOOTSTRAP DISC SPACE >>      <<03549>>52004000
                                                               <<03549>>52006000
BOOTDISCSPACE := DADDR2;   << RETURN DISC SPACE >>             <<03549>>52008000
END;   << BOOTDISCSPACE >>                                     <<03549>>52010000
$CONTROL SEGMENT=SETUP                                         <<03549>>52012000
        <<-------------------------------------->>             <<03549>>52014000
        <<   FIND THE NEXT AREA IN A BIT MAP    >>             <<03549>>52016000
        <<-------------------------------------->>             <<03549>>52018000
LOGICAL PROCEDURE FIND'NEXT'BIT'AREA(BIT'MAP,BIT'MAP'SIZE,     <<03549>>52020000
                          BIT'INDEX,SIZE,NEXT'INDEX,ON'OFF);   <<03549>>52022000
VALUE BIT'MAP'SIZE,ON'OFF;                                     <<03549>>52024000
INTEGER ARRAY                                                  <<03549>>52026000
   BIT'MAP;        << BIT MAP >>                               <<03549>>52028000
INTEGER                                                        <<03549>>52030000
   BIT'MAP'SIZE,   << SIZE OF BIT MAP (IN BITS) >>             <<03549>>52032000
   BIT'INDEX,      << RETURN STARTING LOCATION OF AREA    >>   <<03672>>52034000
   SIZE,           << RETURN SIZE OF AREA >>                   <<03549>>52038000
   NEXT'INDEX;     << RETURN VALUE USED IN A SEQUENCE OF   >>  <<03672>>52040000
                   << CALLS, INITIALLY SET BY USER TO THE  >>  <<03672>>52042000
                   << START OF SEARCH AREA                 >>  <<03672>>52044000
LOGICAL                                                        <<03549>>52046000
   ON'OFF;         << IF TRUE, SEARCH FOR AREAS OF 1.      >>  <<03549>>52048000
                   <<    ELSE SEARCH FOR AREAS OF 0.       >>  <<03549>>52050000
                                                               <<03549>>52052000
COMMENT                                                        <<03549>>52054000
GETS THE NEXT CONTIGUOUS AREA FROM A BITMAP (INDEXED STARTING  <<03672>>52056000
FROM 0) STARTING FROM NEXT'INDEX.  THE AREA CAN EITHER BE      <<03672>>52058000
CONSECUTIVE 1'S (ON'OFF = TRUE) OR 0'S (ON'OFF = FALSE).  IF   <<03672>>52060000
THE NEXT'INDEX PASSED BY THE USER CURRENTLY POINTS AT A BIT    <<03672>>52062000
WHICH IS THE OPPOSITE OF THE VALUE OF ON'OFF, IT SCANS FORWARD <<03672>>52064000
TO FIND THE FIRST AREA.  IF FIND'NEXT'BIT'AREA IS SUCCESSFUL,  <<03672>>52066000
IT RETURNS TRUE AND RETURNS THE STARTING BIT OF THE AREA IN    <<03672>>52068000
BIT'INDEX, THE LENGTH OF THE AREA IN 'SIZE', AND NEXT'INDEX    <<03672>>52070000
 = (BIT'INDEX + SIZE).  NEXT'INDEX CAN THEN BE USED IN THE     <<03672>>52072000
NEXT CALL, TO FIND THE NEXT AREA.  IF NO                       <<03672>>52074000
AREA IS FOUND, FIND'NEXT'BIT'AREA RETURNS FALSE.  NOTE:        <<03672>>52076000
THIS PROCEDURE DOES NOT ALTER THE BIT MAP.                     <<03549>>52078000
;                                                              <<03549>>52080000
BEGIN                                                          <<03549>>52082000
                                                               <<03549>>52084000
FIND'NEXT'BIT'AREA := FALSE;     << INITIALIZE RETURN >>       <<03549>>52086000
BIT'INDEX := NEXT'INDEX;     << STARTING POINT FOR SEARCH >>   <<03672>>52088000
                                                               <<03549>>52090000
IF 0 <= BIT'INDEX <= (BIT'MAP'SIZE - 1) THEN                   <<03549>>52092000
   BEGIN                                                       <<03549>>52094000
                                                               <<03549>>52096000
 << SEARCH FOR THE FIRST BIT WHICH IS THE SAME AS ON'OFF >>    <<03549>>52098000
                                                               <<03549>>52100000
   WHILE BIT'INDEX <= (BIT'MAP'SIZE - 1) AND                   <<03549>>52102000
         TESTBIT( BIT'MAP,BIT'INDEX) <> ON'OFF DO              <<03549>>52104000
      BIT'INDEX := BIT'INDEX + 1;                              <<03549>>52106000
                                                               <<03549>>52108000
   NEXT'INDEX := BIT'INDEX + 1;                                <<03549>>52110000
                                                               <<03549>>52112000
 << IF NO AREA IS FOUND, RETURN FALSE >>                       <<03549>>52114000
                                                               <<03549>>52116000
   IF BIT'INDEX > (BIT'MAP'SIZE - 1) THEN RETURN;              <<03549>>52118000
                                                               <<03549>>52120000
 << WE HAVE FOUND AN AREA, NOW SEARCH FOR THE END OF IT >>     <<03549>>52122000
                                                               <<03549>>52124000
   WHILE NEXT'INDEX <= (BIT'MAP'SIZE - 1) AND                  <<03549>>52126000
         TESTBIT( BIT'MAP,NEXT'INDEX) = ON'OFF DO              <<03549>>52128000
      NEXT'INDEX := NEXT'INDEX + 1;                            <<03549>>52130000
                                                               <<03549>>52132000
   SIZE := NEXT'INDEX - BIT'INDEX;                             <<03549>>52134000
   FIND'NEXT'BIT'AREA := TRUE;                                 <<03549>>52136000
                                                               <<03549>>52138000
   END;                                                        <<03549>>52140000
END;   << FIND'NEXT'BIT'AREA >>                                <<03549>>52142000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>52144000
        <<---------------------------------------->>           <<03549>>52146000
        <<  SPARE SUSPECT SECTOR ON A CS'80 DISC  >>           <<03549>>52148000
        <<---------------------------------------->>           <<03549>>52150000
PROCEDURE CS80'SPARE(LDEV,DISC'ADDRESS,AFFECT'AREA,            <<03549>>52152000
                      AFFECT'AREA'LEN,DATA'LOST'MAP);          <<03549>>52154000
VALUE LDEV,DISC'ADDRESS;                                       <<03549>>52156000
INTEGER                                                        <<03549>>52158000
   LDEV,             << LOGICAL DEVICE NO. >>                  <<03549>>52160000
   AFFECT'AREA'LEN;  << RETURN LENGTH OF THE AFFECTED AREA >>  <<03549>>52162000
                     <<    IN SECTORS                      >>  <<03549>>52164000
DOUBLE                                                         <<03549>>52166000
   DISC'ADDRESS,     << DISC ADDRESS OF SUSPECT SECTOR >>      <<03549>>52168000
   AFFECT'AREA;      << RETURN DISC ADDRESS OF AREA >>         <<03549>>52170000
                     <<    AFFECTED BY THE SPARE    >>         <<03549>>52172000
INTEGER ARRAY                                                  <<03549>>52174000
   DATA'LOST'MAP;    << BIT MAP REPRESENTING THE AFFECTED >>   <<03549>>52176000
                     << AREA-- 1 MEANS DATA WAS LOST, 0   >>   <<03549>>52178000
                     << MEANS DATA WAS RECOVERED--FILLED  >>   <<03549>>52180000
                     << IN BY THIS PROCEDURE              >>   <<03549>>52182000
                                                               <<03549>>52184000
COMMENT                                                        <<03549>>52186000
THIS PROCEDURE SPARES A SUSPECT SECTOR ON A CS'80 DISC.  IT    <<03549>>52188000
FIRST TRIES SPARE RETAINING DATA.  IF THAT FAILS, WE MUST      <<03549>>52190000
DO SPARE NOT RETAINING DATA.  BEFORE THE SPARE NOT RETAINING   <<03549>>52192000
DATA, HOWEVER, WE MUST SAVE THE AREA THE DISC TELLS US TO      <<03549>>52194000
SAVE (A TRACK) INTO THE RESERVED AREA ON LDEV 1.  WE           <<03549>>52196000
REMEMBER WHICH DATA COULD NOT BE READ BY SETTING A BIT IN      <<03549>>52198000
THE DATA'LOST'MAP BIT MAP.  WE THEN PERFORM SPARE NOT          <<03549>>52200000
RETAINING DATA UNTIL THE SPARED AREA IS GOOD.  THE SAVED       <<03549>>52202000
DATA IS THEN COPIED BACK TO ITS ORIGINAL ADDRESS.              <<03549>>52204000
;                                                              <<03549>>52206000
BEGIN                                                          <<03549>>52208000
EQUATE                                                         <<03549>>52210000
   SPARE'RETAIN     = 15,   << SPARE RETAINING DATA >>         <<03549>>52212000
   SPARE'NO'RETAIN  = 16,   << SPARE NOT RETAINING DATA >>     <<03549>>52214000
   RECOV'READ       = 14,   << RECOVERY READ--NOT FATAL IF >>  <<03549>>52216000
                            <<     IT GETS UNRECOVERABLE   >>  <<03549>>52218000
                            <<     DATA ERRORS.            >>  <<03549>>52220000
   RW'ERT           = 18,   << READ/WRITE ERROR RATE TEST  >>  <<03549>>52222000
   RO'ERT           = 23;   << READ-ONLY ERROR RATE TEST   >>  <<03549>>52224000
DOUBLE                                                         <<03549>>52226000
   TEMP,                                                       <<03549>>52228000
   RESERVED;         << DISC ADDRESS IN THE RESERVED AREA >>   <<03549>>52230000
INTEGER                                                        <<03549>>52232000
   TEMP1 = TEMP,     << HIGH ORDER WORD OF TEMP >>             <<03549>>52234000
   TEMP2 = TEMP+1,   << LOW ORDER WORD OF TEMP  >>             <<03549>>52236000
   I;                << INDEX >>                               <<03549>>52238000
INTEGER ARRAY                                                  <<03549>>52240000
   AFFECTS(0:4),     << ARRAY TO HOLD STATUS RETURN FROM   >>  <<03549>>52242000
                     <<    SPARE COMMAND--CONTAINS 6-BYTE  >>  <<03549>>52244000
                     <<    ADDRESS OF AFFECTED AREA        >>  <<03549>>52246000
                     <<    FOLLOWED BY 4-BYTE LENGTH OF    >>  <<03549>>52248000
                     <<    AREA IN BYTES                   >>  <<03549>>52250000
   BUFF(0:127),      << READ/WRITE BUFFER >>                   <<03549>>52252000
   DUMMY(0:0);       << DUMMY ARRAY >>                         <<03549>>52254000
LOGICAL                                                        <<03549>>52256000
   SUCCESS,                                                    <<03549>>52258000
   ANY'SAVED;     << TRUE IF SOME DATA IN SPARED AREA >>       <<03549>>52260000
                  <<    WAS SAVED                     >>       <<03549>>52262000
                                                               <<03549>>52264000
<< FIRST TRY SPARE RETAINING DATA >>                           <<03549>>52266000
                                                               <<03549>>52268000
DISC(SPARE'RETAIN,LDEV,DISC'ADDRESS,AFFECTS,5);                <<03549>>52270000
                                                               <<03549>>52272000
IF = THEN                                                      <<03549>>52274000
   SUCCESS := TRUE       << SPARE RETAINING DATA WORKED >>     <<03549>>52276000
ELSE                                                           <<03549>>52278000
   SUCCESS := FALSE;     << SPARE RETAINING DATA FAILED >>     <<03549>>52280000
                                                               <<03549>>52282000
TEMP1 := AFFECTS(1);     << GET AREA AFFECTED BY >>            <<03549>>52284000
TEMP2 := AFFECTS(2);     <<    THE SPARE         >>            <<03549>>52286000
AFFECT'AREA := TEMP;                                           <<03549>>52288000
TEMP1 := AFFECTS(3);                                           <<03549>>52290000
TEMP2 := AFFECTS(4);                                           <<03549>>52292000
AFFECT'AREA'LEN := INTEGER(((TEMP+255D)/256D));                <<03549>>52294000
                                                               <<03549>>52296000
IF SUCCESS THEN          << SPARE RETAINING DATA WORKED >>     <<03549>>52298000
   BEGIN                                                       <<03549>>52300000
                                                               <<03549>>52302000
   << TRY READ-ONLY ERT ON THE AFFECTED AREA >>                <<03549>>52304000
                                                               <<03549>>52306000
   DISC(RO'ERT,LDEV,AFFECT'AREA,DUMMY,AFFECT'AREA'LEN);        <<03549>>52308000
                                                               <<03549>>52310000
   IF = THEN           << READ-ONLY ERT WORKED, WE'RE DONE >>  <<03549>>52312000
      BEGIN                                                    <<03549>>52314000
      AFFECT'AREA := DISC'ADDRESS;                             <<03549>>52316000
      AFFECT'AREA'LEN := 1;                                    <<03549>>52318000
      RETURN;                                                  <<03549>>52320000
      END;                                                     <<03549>>52322000
   END;                                                        <<03549>>52324000
                                                               <<03549>>52326000
<< TRY TO GET SOME RESERVED AREA ON THE DISC TO SAVE >>        <<03549>>52328000
<< DATA IN THE AFFECTED AREA, BEFORE WE DO A SPARE   >>        <<03549>>52330000
<< NOT RETAINING DATA                                >>        <<03549>>52332000
                                                               <<03549>>52334000
IF GET'RESERVED( RESERVED, AFFECT'AREA'LEN) THEN               <<03549>>52336000
   BEGIN                                                       <<03549>>52338000
                                                               <<03549>>52340000
   << WE GOT SPACE IN THE RESERVED AREA, NOW COPY ALL >>       <<03549>>52342000
   << SECTORS IN THE AFFECTED AREA INTO THE RESERVED  >>       <<03549>>52344000
   << AREA                                            >>       <<03549>>52346000
                                                               <<03549>>52348000
   ANY'SAVED := TRUE;     << SAVED SOME DATA >>                <<03549>>52350000
   I := -1;                                                    <<03549>>52352000
   WHILE (I:=I+1) < AFFECT'AREA'LEN DO                         <<03549>>52354000
      BEGIN                                                    <<03549>>52356000
      DISC(RECOV'READ,LDEV,AFFECT'AREA+DOUBLE(I),BUFF,128);    <<03549>>52358000
                                                               <<03549>>52360000
      << REMEMBER WHICH DATA WAS LOST >>                       <<03549>>52362000
                                                               <<03549>>52364000
      IF <> THEN                                               <<03549>>52366000
         SETBIT(DATA'LOST'MAP,I)   << SHUCKS, WE LOST IT >>    <<03549>>52368000
                                                               <<03549>>52370000
      ELSE                                                     <<03549>>52372000
         CLEARBIT(DATA'LOST'MAP,I);    << STILL HAVE IT >>     <<03549>>52374000
                                                               <<03549>>52376000
      << WRITE THE DATA INTO THE RESERVED AREA >>              <<03549>>52378000
                                                               <<03549>>52380000
      DISC(WRITE,LDEV,RESERVED+DOUBLE(I),BUFF,128);            <<03549>>52382000
      END;                                                     <<03549>>52384000
   END                                                         <<03549>>52386000
                                                               <<03549>>52388000
ELSE             << COULDN'T GET ANY RESERVED AREA, SO >>      <<03549>>52390000
   BEGIN         << MARK DATA AS LOST                  >>      <<03549>>52392000
   I := -1;                                                    <<03549>>52394000
   WHILE (I:=I+1) < AFFECT'AREA'LEN DO                         <<03549>>52396000
      SETBIT(DATA'LOST'MAP,I);                                 <<03549>>52398000
   ANY'SAVED := FALSE;    << NO DATA WAS SAVED >>              <<03549>>52400000
   END;                                                        <<03549>>52402000
                                                               <<03549>>52404000
<< NOW SPARE NOT RETAINING DATA >>                             <<03549>>52406000
                                                               <<03549>>52408000
DISC(SPARE'NO'RETAIN,LDEV,AFFECT'AREA,AFFECTS,5);              <<03549>>52410000
                                                               <<03549>>52412000
<< SEE IF THE SPARED AREA IS GOOD BY DOING A       >>          <<03549>>52414000
<< READ/WRITE ERROR RATE TEST ON THE AFFECTED AREA.>>          <<03549>>52416000
<< IF TEST FAILS, DO SPARE NOT RETAINING DATA      >>          <<03549>>52418000
<< UNTIL WE PASS THE TEST                          >>          <<03549>>52420000
                                                               <<03549>>52422000
SUCCESS := FALSE;                                              <<03549>>52424000
WHILE NOT SUCCESS DO                                           <<03549>>52426000
   BEGIN                                                       <<03549>>52428000
                                                               <<03549>>52430000
   << DO READ/WRITE ERROR RATE TEST >>                         <<03549>>52432000
                                                               <<03549>>52434000
   DISC(RW'ERT,LDEV,AFFECT'AREA,DUMMY,AFFECT'AREA'LEN);        <<03549>>52436000
                                                               <<03549>>52438000
   IF <> THEN      << SPARE NOT RETAINING DATA AGAIN >>        <<03549>>52440000
      DISC(SPARE'NO'RETAIN,LDEV,AFFECT'AREA,AFFECTS,5)         <<03549>>52442000
                                                               <<03549>>52444000
   ELSE                                                        <<03549>>52446000
      SUCCESS := TRUE;     << FOUND A GOOD TRACK >>            <<03549>>52448000
                                                               <<03549>>52450000
   END;                                                        <<03549>>52452000
                                                               <<03549>>52454000
<< NOW COPY THE SAVED DATA BACK TO ITS ORIGINAL LOCATION >>    <<03549>>52456000
                                                               <<03549>>52458000
IF ANY'SAVED THEN    << IF ANY DATA WAS SAVED >>               <<03549>>52460000
   BEGIN                                                       <<03549>>52462000
   I := -1;                                                    <<03549>>52464000
   WHILE (I:=I+1) < AFFECT'AREA'LEN DO                         <<03549>>52466000
      BEGIN                                                    <<03549>>52468000
                                                               <<03549>>52470000
      << ATTEMPT TO READ THE DATA BACK FROM THE RESERVED >>    <<03549>>52472000
      << AREA.  IF WE CAN'T GET IT BACK, THEN MARK THE   >>    <<03549>>52474000
      << DATA AS LOST.                                   >>    <<03549>>52476000
                                                               <<03549>>52478000
      DISC(RECOV'READ,LDEV,RESERVED+DOUBLE(I),BUFF,128);       <<03549>>52480000
      IF <> THEN                                               <<03549>>52482000
         SETBIT(DATA'LOST'MAP,I);   << WE LOST IT >>           <<03549>>52484000
                                                               <<03549>>52486000
      DISC(WRITE,LDEV,AFFECT'AREA+DOUBLE(I),BUFF,128);         <<03549>>52488000
      END;                                                     <<03549>>52490000
   << RELEASE SPACE IN THE RESERVED AREA >>                    <<03549>>52492000
                                                               <<03549>>52494000
   RELEASE'RESERVED(RESERVED,AFFECT'AREA'LEN);                 <<03549>>52496000
   END;                                                        <<03549>>52498000
END;   << CS80'SPARE >>                                        <<03549>>52500000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>52502000
        <<----------------------------------------->>          <<03549>>52504000
        << PROCESS SUSPECT SECTORS ON A CS'80 DISC >>          <<03549>>52506000
        <<----------------------------------------->>          <<03549>>52508000
PROCEDURE CS80'DEFECTS( LDEV,DSCT);                            <<03549>>52510000
VALUE LDEV;                                                    <<03549>>52512000
INTEGER                                                        <<03549>>52514000
   LDEV;      << LOGICAL DEVICE NO. >>                         <<03549>>52516000
INTEGER ARRAY                                                  <<03549>>52518000
   DSCT;      << DEFECTIVE SECTOR TABLE >>                     <<03549>>52520000
                                                               <<03549>>52522000
COMMENT                                                        <<03549>>52524000
CS80'DEFECTS PROCESSES ALL DEFECTIVE SECTOR ENTRIES CURRENTLY  <<03549>>52526000
IN THE DSCT ON A GIVEN LDEV.  IT FIRST PERFORMS A DIAGNOSTIC   <<03549>>52528000
ON THE DISC TO SEE IF THE HARDWARE IS OK. THEN IT ATTEMPTS TO  <<03549>>52530000
RECOVER THE DATA ON THE SECTOR.  IT THEN PERFORMS A READ/WRITE <<03549>>52532000
ERROR RATE TEST ON THE SECTOR.  IF ANY PROBLEMS SHOW UP, IT    <<03549>>52534000
CALLS CS80'SPARE TO SPARE THE SECTOR.  THEN THE SAVED DATA IS  <<03549>>52536000
WRITTEN BACK TO THE SECTOR, AND THE DSCT ENTRY REMOVED.  THIS  <<03549>>52538000
PROCEDURE ALSO PRINTS MESSAGES TELLING WHERE DATA WAS LOST     <<03549>>52540000
AND WARNS THE USER IF THE DATA WAS ON ANY SPECIAL AREA OF THE  <<03549>>52542000
DISC--THE DIRECTORY, VIRTUAL MEMORY, THE RESERVED AREA, THE    <<03549>>52544000
SYSTEM AREA.  IF DATA MAY HAVE BEEN LOST IN A FILE, A          <<03549>>52546000
RECOVER LOST DISC SPACE MUST BE PERFORMED.                     <<03549>>52548000
;                                                              <<03549>>52550000
BEGIN                                                          <<03549>>52552000
EQUATE                                                         <<03549>>52554000
   DIAGNOSTIC   = 22,   << RUN INTERNAL DIAGNOSTIC >>          <<03549>>52556000
   RECOV'READ   = 14,   << READ TO RECOVER DATA >>             <<03549>>52558000
   RW'ERT       = 18;   << READ/WRITE ERROR RATE TEST >>       <<03549>>52560000
DOUBLE                                                         <<03549>>52562000
   DISC'ADDRESS,   << DISC ADDRESS--CURRENT DSCT ENTRY >>      <<03549>>52564000
   DUMMY,                                                      <<03549>>52566000
   AFFECT'AREA,         << STARTING DISC ADDRESS OF AREA >>    <<03714>>52568000
                        <<    AFFECTED BY SPARE          >>    <<03714>>52570000
   FSECT,               <<STARTING SECTOR OF LOST DATA AREA>>  <<03714>>52572000
   LSECT;               <<ENDING SECTOR OF LOST DATA AREA>>    <<03714>>52574000
INTEGER                                                        <<03549>>52576000
   AFFECT'AREA'LEN,     << LENGTH OF THE SPARE AREA >>         <<03549>>52578000
                        <<    IN SECTORS            >>         <<03549>>52580000
   OLD'NREASS,          << STARTING NO. OF BAD DISC AREAS >>   <<03714>>52582000
   CUR'BIT,             << CURRENT BIT IN BIT MAP >>           <<03549>>52584000
   SIZE,                << CURRENT SIZE OF AREA IN BIT MAP >>  <<03549>>52586000
   NEXT'BIT;            << TEMP >>                             <<03549>>52588000
LOGICAL                                                        <<03549>>52590000
   SECTORLOST;          << IF TRUE, THE SECTOR'S DATA WAS  >>  <<03549>>52592000
                        <<    LOST                         >>  <<03714>>52594000
BYTE ARRAY                                                     <<03714>>52596000
   STRINGA(0:13),       << FOR ASCII DISC ADDRESS >>           <<03714>>52598000
   STRINGB(0:13);       << FOR ASCII DISC ADDRESS >>           <<03714>>52600000
INTEGER ARRAY                                                  <<03549>>52602000
   DATA'LOST'MAP(0:19), << BIT MAP FOR DISC SECTORS WHICH  >>  <<03549>>52604000
                        << LOST DATA                       >>  <<03549>>52606000
   BUFF(0:127);         << BUFFER TO SAVE SECTOR'S DATA >>     <<03549>>52608000
                                                               <<03549>>52610000
IF GET'DSCT'ENTRY(DSCT,DISC'ADDRESS) THEN                      <<03549>>52612000
   BEGIN            << THERE ARE ENTRIES IN THE DSCT >>        <<03549>>52614000
   BLANKLINE;                                                  <<03549>>52616000
   MESSAGE(M2500,LDEV);                                        <<03549>>52618000
                                                               <<03549>>52620000
   << RUN DIAGNOSTIC ON DISC BEFORE DOING ANY SPARES.  IF  >>  <<03549>>52622000
   << THE DIAGNOSTIC FAILS, WE NEVER RETURN (INITIAL DIES) >>  <<03549>>52624000
                                                               <<03549>>52626000
   DISC(DIAGNOSTIC,LDEV,0D,DUMMY,1);                           <<03549>>52628000
                                                               <<03549>>52630000
   << PROCESS ALL DEFECTIVE SECTOR ENTRIES.  IF THERE IS NO >> <<03549>>52632000
   << MORE ROOM IN LIST OF AREAS WHICH LOST DATA, DON'T     >> <<03549>>52634000
   << CONTINUE PROCESSING DEFECTIVE SECTORS.                >> <<03549>>52636000
                                                               <<03549>>52638000
   WHILE GET'DSCT'ENTRY(DSCT,DISC'ADDRESS) AND                 <<03549>>52640000
         NREASS < MAX'REASS DO                                 <<03549>>52642000
                                                               <<03549>>52644000
      BEGIN                                                    <<03549>>52646000
      OLD'NREASS := NREASS;   << SAVE CURRENT NREASS >>        <<03714>>52648000
                                                               <<03714>>52650000
      SECTORLOST := FALSE;                                     <<03549>>52652000
      AFFECT'AREA := DISC'ADDRESS;   << INIT. AFFECTED AREA >> <<03549>>52654000
      AFFECT'AREA'LEN := 1;          << TO JUST ONE SECTOR  >> <<03549>>52656000
                                                               <<03549>>52658000
      << TRY TO RECOVER THE SECTOR AT DISC'ADDRESS >>          <<03549>>52660000
                                                               <<03549>>52662000
      DISC(RECOV'READ,LDEV,DISC'ADDRESS,BUFF,128);             <<03549>>52664000
                                                               <<03549>>52666000
      IF <> THEN                                               <<03549>>52668000
         SECTORLOST := TRUE;     << LOST THE SECTOR >>         <<03549>>52670000
                                                               <<03549>>52672000
      << RUN READ/WRITE ERROR RATE TEST ON SECTOR TO >>        <<03549>>52674000
      << SEE IF IT'S REALLY BAD                      >>        <<03549>>52676000
                                                               <<03549>>52678000
      DISC(RW'ERT,LDEV,DISC'ADDRESS,DUMMY,1);                  <<03549>>52680000
      IF <> THEN                                               <<03549>>52682000
                                                               <<03549>>52684000
         << ERT FAILED, CALL CS80'SPARE TO DO SPARING >>       <<03549>>52686000
                                                               <<03549>>52688000
         CS80'SPARE(LDEV,DISC'ADDRESS,AFFECT'AREA,             <<03549>>52690000
                    AFFECT'AREA'LEN,DATA'LOST'MAP);            <<03549>>52692000
                                                               <<03549>>52694000
      << WRITE BACK WHATEVER DATA WAS SAVED >>                 <<03549>>52696000
                                                               <<03549>>52698000
      DISC(WRITE,LDEV,DISC'ADDRESS,BUFF,128);                  <<03549>>52700000
                                                               <<03549>>52702000
      REMOVE'DSCT'ENTRY(DSCT);    << REMOVE THE DSCT ENTRY >>  <<03549>>52704000
                                                               <<03549>>52706000
      << POST THE DSCT TO DISC AFTER EACH SUSPECT SECTOR >>    <<03549>>52708000
      << IS PROCESSED AND REMOVED.                       >>    <<03549>>52710000
                                                               <<03549>>52712000
      DISC(WRITE,LDEV,1D,DSCT,128);                            <<03549>>52714000
                                                               <<03549>>52716000
      CUR'BIT := INTEGER(DISC'ADDRESS-AFFECT'AREA);            <<03549>>52718000
                                                               <<03549>>52720000
      IF SECTORLOST THEN      << SET BIT IN MAP IF DATA >>     <<03549>>52722000
         SETBIT(DATA'LOST'MAP,CUR'BIT)     << WAS LOST  >>     <<03549>>52724000
                                                               <<03549>>52726000
      ELSE                           << OTHERWISE, CLEAR >>    <<03549>>52728000
         CLEARBIT(DATA'LOST'MAP,CUR'BIT);     << THE BIT >>    <<03549>>52730000
                                                               <<03549>>52732000
      << NOW PRINT OUT ALL AREAS OF DISC WHICH LOST DATA >>    <<03549>>52734000
                                                               <<03549>>52736000
      NEXT'BIT := 0;                                           <<03672>>52738000
      WHILE FIND'NEXT'BIT'AREA(DATA'LOST'MAP,AFFECT'AREA'LEN,  <<03549>>52740000
                   CUR'BIT,SIZE,NEXT'BIT,TRUE) DO              <<03549>>52742000
         BEGIN                                                 <<03549>>52744000
                                                               <<03714>>52746000
         IF NOT RELOAD THEN                                    <<03714>>52748000
            BEGIN                                              <<03714>>52750000
                                                               <<03714>>52752000
            << TRY TO ADD THIS AREA TO THE LIST OF DISC >>     <<03714>>52754000
            << AREAS WHICH LOST DATA.                   >>     <<03714>>52756000
                                                               <<03714>>52758000
            NREASS := NREASS + 1;                              <<03714>>52760000
            IF NOT ADD'AREA(REASSIGNED,NREASS,MAX'REASS+1,     <<03714>>52762000
                            LDEV,AFFECT'AREA+DOUBLE(CUR'BIT),  <<03714>>52764000
                            DOUBLE(SIZE)) THEN                 <<03714>>52766000
                                                               <<03714>>52768000
               BEGIN                                           <<03714>>52770000
                                                               <<03714>>52772000
               << NO MORE ROOM IN LIST--BACK UP TO THE FIRST >><<03714>>52774000
               << ENTRY IN THIS SERIES AND WRITE AN ENTRY    >><<03714>>52776000
               << FOR THE ENTIRE AFFECTED AREA.  REMOVE ALL  >><<03714>>52778000
               << OTHER ENTRIES WRITTEN FOR THIS AREA.       >><<03714>>52780000
                                                               <<03714>>52782000
               NREASS := OLD'NREASS + 1;                       <<03714>>52784000
               ADD'AREA(DATA'LOST'MAP,NREASS,MAX'REASS+1,      <<03714>>52786000
                        LDEV,AFFECT'AREA,                      <<03714>>52788000
                        DOUBLE(AFFECT'AREA'LEN));              <<03714>>52790000
                                                               <<03714>>52792000
               CUR'BIT := 0;                                   <<03714>>52794000
               SIZE := AFFECT'AREA'LEN;                        <<03714>>52796000
               NEXT'BIT := AFFECT'AREA'LEN;   << GET OUT OF >> <<03714>>52798000
                                              <<  THE LOOP  >> <<03714>>52800000
               END;                                            <<03714>>52802000
            END;   << IF NOT RELOAD >>                         <<03714>>52804000
                                                               <<03714>>52806000
         << PRINT MESSAGE:  DATA LOST DURING SPARE    >>       <<03714>>52808000
         << (INCLUDES LDEV, SECTOR RANGE)             >>       <<03714>>52810000
                                                               <<03714>>52812000
         FSECT := AFFECT'AREA + DOUBLE(CUR'BIT);               <<03714>>52814000
         LSECT := AFFECT'AREA + DOUBLE(CUR'BIT) +              <<03714>>52816000
                  DOUBLE(SIZE) - 1D;                           <<03714>>52818000
         STRINGA(1) := "%";                                    <<03714>>52820000
         STRINGB(1) := "%";                                    <<03714>>52822000
         STRINGA(0) := LDNTOA(FSECT, 8, STRINGA(2)) + 1;       <<03714>>52824000
         STRINGB(0) := LDNTOA(LSECT, 8, STRINGB(2)) + 1;       <<03714>>52826000
         MESSAGE(M501, LDEV,,,, STRINGA, STRINGB);             <<03714>>52828000
                                                               <<03714>>52830000
         << PRINT WARNING MESSAGES IF THE LOST DATA WAS >>     <<03714>>52832000
         << ON ANY SPECIAL AREAS OF THE DISC            >>     <<03714>>52834000
                                                               <<03714>>52836000
         WARN'DISC'ZAPPED(LDEV, FSECT, LSECT);                 <<03714>>52838000
         BLANKLINE;                                            <<03714>>52840000
                                                               <<03714>>52842000
         << CHECK TO SEE IF THE DATA WAS LOST IN AN AREA >>    <<03714>>52844000
         << OF THE DISC WHICH WILL REQUIRE RECOVER LOST  >>    <<03714>>52846000
         << DISC SPACE                                   >>    <<03714>>52848000
                                                               <<03714>>52850000
         IF RECOVERY'NEEDED(LDEV, FSECT, LSECT) THEN           <<03714>>52852000
            RECOVERY := TRUE;     << SET RECOVERY FLAG >>      <<03714>>52854000
                                                               <<03714>>52856000
         END;                                                  <<03714>>52878000
      END;   << WHILE MORE DEFECTIVE SECTORS >>                <<03714>>52880000
                                                               <<03549>>52882000
   << IF OVERFLOWED LIST OF AREAS WHICH LOST DATA, >>          <<03714>>52884000
   << PRINT MESSAGE "NO MORE SPARING ALLOWED THIS  >>          <<03714>>52886000
   << BOOT"                                        >>          <<03714>>52888000
                                                               <<03714>>52890000
   IF NREASS >= MAX'REASS THEN                                 <<03714>>52892000
      MESSAGE(M500);                                           <<03714>>52894000
                                                               <<03549>>52898000
   MESSAGE(M2501,LDEV);     << SPARING COMPLETED ON >>         <<03549>>52900000
                            <<    THIS LDEV         >>         <<03549>>52902000
   END;  << IF ANY DEFECTIVE SECTORS >>                        <<03549>>52904000
END;   << CS80'DEFECTS >>                                      <<03549>>52906000
                                                                        52908000
$CONTROL SEGMENT=SETUP                                         <<03549>>52910000
          <<-----------------------------------                         52912000
            WRITE CONFIGURATION TABLE TO DISC                           52914000
          ----------------------------------->>                         52916000
  PROCEDURE WRITECONFTABLE(TABSIZE,RECNUM,LOC,INDEX);                   52918000
    VALUE TABSIZE,RECNUM,INDEX;                                         52920000
    INTEGER TABSIZE,          <<TABLE SIZE>>                            52922000
            INDEX;            <<INDEX IN INFO TABLE>>                   52924000
    DOUBLE RECNUM;            <<RECORD # IN CONFIGURATION FILE>>        52926000
    ARRAY LOC;                <<DATA BUFFER>>                           52928000
    COMMENT                                                             52930000
      WRITES THE SPECIFIED CONFIGURATION TABLE TO THE CONFDATA FILE     52932000
   AND UPDATES THE DISC ADDRESS IN THE INFO TABLE;             <<01683>>52934000
      BEGIN                                                             52936000
          FWRITE(CTABFNUM,RECNUM,LOC,TABSIZE); <<WRITE TO FILE>>        52938000
          TABLEINFO(INDEX+1) := DTEMP+RECNUM; <<DISC ADDRESS>> <<01683>>52940000
      END <<WRITECONFTABLE>> ;                                          52942000
                                                                        52944000
          <<----------------------------                                52946000
            WRITE DEVICE TABLE TO DISC                                  52948000
          ---------------------------->>                                52950000
  PROCEDURE WRITEDEVTABLE(MAXSIZE,LOC,INDEX,TABSIZE);                   52952000
    VALUE MAXSIZE,INDEX,TABSIZE;                                        52954000
    INTEGER MAXSIZE,INDEX,TABSIZE;                                      52956000
    ARRAY LOC;                <<DATA BUFFER>>                           52958000
    COMMENT                                                             52960000
      WRITES THE SPECIFIED DEVICE TABLE TO DISC. IF THIS IS A TAPE COLD 52962000
    LOAD, ENOUGH DISC SPACE FOR THE MAXIMUM SIZE OF THE TABLE IS FIRST  52964000
    OBTAINED;                                                           52966000
      BEGIN                                                             52968000
        DOUBLE DSIZE;                                                   52970000
          IF LOADFROMTAPE THEN                                          52972000
            BEGIN  <<GET DISC SPACE FOR TABLE>>                         52974000
              DSIZE := D'L((MAXSIZE+127)&LSR(7)));                      52976000
              SUPERDISCSPACE(-SYSDISC,1,0,DSIZE,TABLEINFO(INDEX+1));    52978000
              IF <> THEN ERRMESSAGE(M326, SYSDISC);<<OUT DISC>><<MPEIV>>52980000
              TOS := TABLEINFO(INDEX+1);                                52982000
              BS1 := 0;      <<ZERO VOLUME INDEX>>             <<03603>>52984000
              TABLEINFO(X) := TOS;                                      52986000
            END;                                                        52988000
          DISC(WRITE,SYSDISC,TABLEINFO(INDEX+1),LOC,TABSIZE);           52990000
      END <<WRITEDEVTABLE>> ;                                           52992000
PROCEDURE SAVE'TABLE'ADDR(TABSIZE, LOC, INDEX);                <<01683>>52994000
  VALUE   TABSIZE, INDEX;                                      <<01683>>52996000
  ARRAY   LOC;         << CONTAINS THE TABLE >>                <<01683>>52998000
  INTEGER TABSIZE,     << SIZE OF THE TABLE IN WORDS >>        <<01683>>53000000
          INDEX;       << INDEX INTO DOUBLE(INFO TABLE) >>     <<01683>>53002000
                                                               <<01683>>53004000
  BEGIN                                                        <<01683>>53006000
  COMMENT:  THIS PROCEDURE RECORDS THE SIZE AND LOCATION OF    <<01683>>53008000
  TABLES INTO THE COLD LOAD INFORMATION TABLE.                 <<01683>>53010000
  ;                                                            <<01683>>53012000
  TOS := TABSIZE;                                              <<01683>>53014000
  PUSH(DB);                                                    <<01683>>53016000
  DELB;  << DELETE BANK >>                                     <<01683>>53018000
  TOS := TOS + @LOC;  << ABSOLUTE ADDRESS OF THE TABLE >>      <<01683>>53020000
  TABLEINFO(INDEX) := TOS;                                     <<01683>>53022000
  END;  << SAVE'TABLE'ADDR >>                                  <<01683>>53024000
                                                                        53026000
          <<-------------------                                         53028000
            READ DEVICE TABLE                                           53030000
          ------------------->>                                         53032000
  PROCEDURE READTABLE(RECORD,BUF,WORDS);                                53034000
    VALUE RECORD,WORDS;                                                 53036000
    DOUBLE RECORD;                                                      53038000
    ARRAY BUF;                                                          53040000
    INTEGER WORDS;                                                      53042000
      BEGIN                                                             53044000
          TOS := 0;  <<LOGICAL DEVICE # UNKNOWN>>                       53046000
          TOS := 0; <<PUSH A WORD,THEN LOAD DRT INTO IT>>      <<03002>>53048000
          TOS.DRTFIELD := SYSDISCDRT;                          <<03002>>53050000
          TOS := SYSDISCSUBTYPE;                                        53052000
          TOS := READ;                                                  53054000
          TOS := RECORD;                                                53056000
          PUSH(DB);                                                     53058000
          TOS := TOS+@BUF;                                              53060000
          TOS := WORDS;                                                 53062000
          IF SYSDISCTYPE=FHDISCTYPE THEN TOS := @FHDISC                 53064000
          ELSE IF SYSDISCTYPE=MHDISCTYPE THEN                           53066000
          IF SYSDISCSUBTYPE<4 THEN TOS := @MHDISC                       53068000
          ELSE IF SYSDISCSUBTYPE<NMHSUBTYPES THEN TOS:=@MH7905 <<25.00>>53070000
          ELSE ERRMESSAGE(M126,0)                              <<01103>>53072000
          ELSE IF SYSDISCTYPE=DISC3 THEN TOS := @CS80'DRIVER   <<03550>>53074000
          ELSE ERRMESSAGE( M126);                              <<03550>>53076000
          ASSEMBLE(PCAL 0);                                             53078000
      END <<READTABLE>> ;                                               53080000
           <<---------------------->>                          <<03550>>53084000
           <<   ZERO A BUFFER      >>                          <<03550>>53086000
           <<---------------------->>                          <<03550>>53088000
PROCEDURE ZEROBUF( BUF, LEN);                                  <<03550>>53090000
VALUE LEN;                                                     <<03550>>53092000
ARRAY BUF;     << BUFFER TO BE ZEROED >>                       <<03550>>53094000
INTEGER LEN;   << LENGTH TO ZERO      >>                       <<03550>>53096000
COMMENT                                                        <<03550>>53098000
ZEROES A LOGICAL ARRAY FOR THE SPECIFIED LENGTH                <<03550>>53100000
(IN WORDS).                                                    <<03550>>53102000
;                                                              <<03550>>53104000
BEGIN                                                          <<03550>>53106000
IF LEN > 0 THEN         << IF LENGTH <= 0 DON'T   >>           <<03550>>53108000
   BEGIN                <<     DO ANYTHING        >>           <<03550>>53110000
   BUF := 0;            << OTHERWISE, ZERO IT OUT >>           <<03550>>53112000
   MOVE BUF(1) := BUF,(LEN-1);                                 <<03550>>53114000
   END;                                                        <<03550>>53116000
END;     << ZEROBUF >>                                         <<03550>>53118000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>53120000
          <<-----------------------------                               53122000
            MAKE SIO PROGRAM READ ENTRY                                 53124000
          ----------------------------->>                               53126000
PROCEDURE SIOREADENT( DISCADR, COREADR, SIZE);                 <<02510>>53130000
   VALUE DISCADR, COREADR, SIZE;                               <<02510>>53132000
   DOUBLE DISCADR, COREADR;                                    <<02510>>53134000
   INTEGER SIZE;                                               <<02510>>53136000
BEGIN                                                          <<02510>>53138000
   ENTRY SIOREADENT'; << THIS ENTRY POINT IS USED FOR THE >>   <<02510>>53140000
                      << MICROCODE COLD LOAD READ BECAUSE >>   <<02510>>53142000
                      << ONLY SIX WORDS HAVE BEEN         >>   <<02510>>53144000
                      << ALLOCATED IN THE DISC LABEL      >>   <<02510>>53146000
   EQUATE ARCPTRK = 32;  << ARCS PER TRACK >>                  <<02510>>53148000
   INTEGER ARRAY SCTPERHEAD(0:NMHSUBTYPES-1) = PB :=           <<02510>>53150000
      24,24,24,23,48,48,48,48,64,48,48,48;                     <<02510>>53152000
   INTEGER ARRAY HDBASE(0:NMHSUBTYPES-1) = PB :=               <<02510>>53154000
      0,2,0,0,0,2,0,0,0,0,0,2,0;                               <<02510>>53156000
   INTEGER ARRAY SECPERCYL(4:NMHSUBTYPES-1) = PB :=            <<02510>>53158000
      96,48,144,240,576,96,96,192,64;                          <<02510>>53160000
   INTEGER ARRAY FILEMASK(4:NMHSUBTYPES-1)=PB :=               <<02510>>53162000
      %7406,%7405,%7407,%7407,%7407,%7407,%7406,%7406,         <<02510>>53164000
      %7407,%7400;                                             <<02510>>53166000
   INTEGER ARRAY DISCIOPROG(0:15) = PB :=                      <<02510>>53168000
       %40000,  %1200,                                         <<02510>>53170000
       %14000,      0,                                         <<02510>>53172000
       %67776,      0,                                         <<02510>>53174000
       %40000,      0,                                         <<02510>>53176000
       %40000,  %6000,                                         <<02510>>53178000
       %67776,      0,                                         <<02510>>53180000
       %40000,  %2400;                                         <<03716>>53182000
   INTEGER                                                     <<02510>>53186000
      MAXREAD, << END-OF-CYL CHECK, BECAUSE OF SPLIT DISCS >>  <<02510>>53188000
      NRSECTS,                                                 <<02510>>53190000
      REM,                                                     <<02510>>53192000
      LEN,                                                     <<02510>>53194000
      BANK    = COREADR,                                       <<02510>>53196000
      ADDRESS = COREADR+1;                                     <<02510>>53198000
   LOGICAL                                                     <<02510>>53200000
      FLAG := TRUE; << ENTRY POINT FLAG >>                     <<02510>>53202000
                                                               <<02510>>53204000
   SUBROUTINE READ( WORDS);                                    <<02510>>53206000
      VALUE WORDS;                                             <<02510>>53208000
      INTEGER WORDS;                                           <<02510>>53210000
   BEGIN                                                       <<02510>>53212000
      IF NOT FLAG THEN                                         <<03716>>53214000
         BEGIN                                                 <<03716>>53216000
         SIOPNTR := %14000; << SET BANK INSTRUCTION >>         <<03716>>53218000
         SIOPNTR(1) := BANK;                                   <<03716>>53220000
         @SIOPNTR := @SIOPNTR+2;                               <<03716>>53222000
         END;                                                  <<03716>>53224000
      WHILE WORDS > 0 DO                                       <<02510>>53226000
         BEGIN                                                 <<02510>>53228000
         LEN := IF WORDS > 4096 THEN 4096 ELSE WORDS;          <<02510>>53230000
         SIOPNTR := -LEN;                                      <<02510>>53232000
         SIOPNTR(1) := ADDRESS;                                <<02510>>53234000
         @SIOPNTR := @SIOPNTR+2;                               <<02510>>53236000
         ADDRESS := ADDRESS+LEN;                               <<02510>>53238000
         WORDS := WORDS-LEN;                                   <<02510>>53240000
         END;                                                  <<02510>>53242000
      SIOPNTR(-2).(0:1) := 0; << STOP CHAIN >>                 <<02510>>53244000
   END;                                                        <<02510>>53246000
   FLAG := FALSE;                                              <<02510>>53248000
SIOREADENT':                                                   <<02510>>53250000
   IF SYSDISCTYPE = FHDISCTYPE THEN                            <<02510>>53252000
      BEGIN   << FIXED HEAD DISC >>                            <<02510>>53254000
      TOS := DISCADR;                                          <<02510>>53256000
      TOS := ARCPTRK;                                          <<02510>>53258000
      ASSEMBLE( LDIV );                                        <<02510>>53260000
      SIOPNTR := SIOCNTRL LOR TOS; << ARC # >>                 <<02510>>53262000
      SIOPNTR(1) := TOS;    << TRACK >>                        <<02510>>53264000
      @SIOPNTR := @SIOPNTR+2;                                  <<02510>>53266000
      READ( SIZE);                                             <<02510>>53268000
      END                                                      <<02510>>53270000
   ELSE                                                        <<02510>>53272000
      BEGIN   << MOVING HEAD DISC >>                           <<02510>>53274000
      IF SYSDISCSUBTYPE <= 3 OR FLAG THEN                      <<02510>>53276000
         BEGIN                                                 <<02510>>53278000
         TOS := DISCADR;                                       <<02510>>53280000
         TOS := SCTPERHEAD(SYSDISCSUBTYPE);                    <<02510>>53282000
         ASSEMBLE( LDIV, XCH );                                <<02510>>53284000
         TOS := (TOS+HDBASE(X))&LSL(6); << HEAD NR. >>         <<02510>>53286000
         ASSEMBLE( OR );                                       <<02510>>53288000
         SIOPNTR := SIOCNTRL;                                  <<02510>>53290000
         SIOPNTR(1) := TOS; << HEAD AND SECTOR >>              <<02510>>53292000
         @SIOPNTR := @SIOPNTR+2;                               <<02510>>53294000
         READ( SIZE);                                          <<02510>>53296000
         END                                                   <<02510>>53298000
      ELSE                                                     <<02510>>53300000
         BEGIN  << 7905/7906/7920/7925 >>                      <<02510>>53302000
         WHILE SIZE > 0 DO                                     <<02510>>53304000
            BEGIN                                              <<02510>>53306000
            NRSECTS := (SIZE+127)/128;                         <<02510>>53308000
            TOS := DISCADR;                                    <<02510>>53310000
            TOS := SECPERCYL( SYSDISCSUBTYPE);                 <<02510>>53312000
            ASSEMBLE( LDIV, DELB );                            <<02510>>53314000
            REM := TOS;                                        <<02510>>53316000
            MAXREAD:=IF NRSECTS > SECPERCYL(SYSDISCSUBTYPE)-REM<<02510>>53318000
            THEN (SECPERCYL(SYSDISCSUBTYPE)-REM)*128 ELSE SIZE;<<02510>>53320000
            MOVE SIOPNTR := DISCIOPROG,(14),2;                 <<03716>>53322000
            SIOPNTR(5) := SIOPNTR(11) := SIOCOREADR+ADRBASE;   <<02510>>53324000
            SIOPNTR(7) := FILEMASK( SYSDISCSUBTYPE);           <<02510>>53326000
            @SIOPNTR := TOS;  << CAME FROM MOVE! >>            <<02510>>53330000
            READ( MAXREAD);                                    <<02510>>53332000
            TOS := L'PADR( SYSDISC, DISCADR);                  <<02510>>53334000
            BUF( ADRBASE+1) := TOS;                            <<02510>>53336000
            BUF( ADRBASE) := TOS;                              <<02510>>53338000
            ADRBASE := ADRBASE+2;                              <<02510>>53340000
            DISCADR := DISCADR+DOUBLE((MAXREAD+127)/128);      <<02510>>53342000
            SIZE := SIZE-MAXREAD;                              <<02510>>53344000
            END;                                               <<02510>>53346000
         END;                                                  <<02510>>53348000
      END;                                                     <<02510>>53350000
END;                                                           <<02510>>53352000
$IF   << ****** RETURNING TO COMMON CODE ******** >>           <<02510>>53354000
     << ------------------------------- >>                     <<02510>>53356000
     << MAKE CHANNEL PROGRAM READ ENTRY >>                     <<02510>>53358000
     << ------------------------------- >>                     <<02510>>53360000
PROCEDURE AMIGOREADENT( DISCADR, COREADR, SIZE);               <<02510>>53362000
   VALUE DISCADR, COREADR, SIZE;                               <<02510>>53364000
   DOUBLE DISCADR, COREADR;                                    <<02510>>53366000
   INTEGER SIZE;                                               <<02510>>53368000
BEGIN                                                          <<02510>>53370000
   INTEGER                                                     <<02510>>53372000
      MAXREAD,  << END-OF-CYL CHECK, BECAUSE OF SPLIT DISCS >> <<02510>>53374000
      NRSECTS,                                                 <<02510>>53376000
      REM;                                                     <<02510>>53378000
   INTEGER ARRAY SECPERCYL(4:NMHSUBTYPES-1) = PB :=            <<02510>>53380000
       96,48,144,144,240,576,96,96,192,64;                     <<02510>>53382000
   INTEGER ARRAY CHANIOPROG(0:27) = PB :=                      <<02510>>53384000
      <<  0 >>    %1000,0,                                     <<02510>>53386000
      <<  2 >>    %2010,6,0,0,0,                               <<02510>>53388000
      <<  7 >>    %1000,0,                                     <<02510>>53390000
      <<  9 >>    %2010,2,0,0,0,                               <<02510>>53392000
      << 14 >>    %1000,0,                                     <<02510>>53394000
      << 16 >>    %2010,2,0,0,0,                               <<02510>>53396000
      << 21 >>        0,0,                                     <<02510>>53398000
      << 23 >>    %1400,0,0,0,0;                               <<02510>>53400000
                                                               <<02510>>53402000
   WHILE SIZE > 0 DO                                           <<02510>>53404000
      BEGIN                                                    <<02510>>53406000
      NRSECTS := (SIZE+127)/128;                               <<02510>>53408000
      TOS := DISCADR;                                          <<02510>>53410000
      TOS := SECPERCYL(SYSDISCSUBTYPE);                        <<02510>>53412000
      ASSEMBLE( LDIV, DELB );                                  <<02510>>53414000
      REM := TOS;                                              <<02510>>53416000
      MAXREAD :=IF NRSECTS > SECPERCYL(SYSDISCSUBTYPE)-REM THEN<<02510>>53418000
         (SECPERCYL(SYSDISCSUBTYPE)-REM)*128 ELSE SIZE;        <<02510>>53420000
      MOVE SIOPNTR := CHANIOPROG,(28),2;                       <<02510>>53422000
      SIOPNTR(6) := %7100+ADRBASE;                             <<02510>>53424000
      IF SYSDISCSUBTYPE=S7910 THEN                             <<02510>>53426000
         BEGIN  << JUMP AROUND FILEMASK >>                     <<02510>>53428000
         SIOPNTR(7) := 0;                                      <<02510>>53430000
         SIOPNTR(8) := 7;                                      <<02510>>53432000
         END                                                   <<02510>>53434000
      ELSE                                                     <<02510>>53436000
         SIOPNTR(13) := %7276;                                 <<02510>>53438000
      SIOPNTR(20) := %7277;                                    <<02510>>53440000
      SIOPNTR(24) := MAXREAD&LSL(1);                           <<02510>>53442000
      TOS := COREADR;                                          <<02510>>53444000
      SIOPNTR(27) := TOS;                                      <<02510>>53446000
      SIOPNTR(26) := TOS;   << BANK >>                         <<02510>>53448000
      @SIOPNTR := TOS;   << CAME FROM MOVE! >>                 <<02510>>53450000
      BUF(ADRBASE) := %1000;                                   <<02510>>53452000
      TOS := L'PADR( SYSDISC, DISCADR);                        <<02510>>53454000
      BUF(ADRBASE+2) := TOS;                                   <<02510>>53456000
      BUF(X:=X-1) := TOS;                                      <<02510>>53458000
      ADRBASE := ADRBASE-3;                                    <<02510>>53460000
      DISCADR := DISCADR+D'L((MAXREAD+127)/128));              <<02510>>53462000
      COREADR := COREADR+D'L(MAXREAD));                        <<02510>>53464000
      SIZE := SIZE-MAXREAD;                                    <<02510>>53466000
      END;                                                     <<02510>>53468000
END;                                                           <<02510>>53470000
$IF    << ***** RETURNING TO COMMON CODE ******* >>            <<02510>>53472000
INTEGER PROCEDURE CALCULATECHECKSUM(TARGET,TARGETLEN,OLDCHECKSUM);      53474000
VALUE TARGET,TARGETLEN,OLDCHECKSUM;                            <<00888>>53476000
POINTER TARGET;                                                <<00888>>53478000
INTEGER TARGETLEN;                                             <<00888>>53480000
LOGICAL OLDCHECKSUM;                                           <<00888>>53482000
BEGIN                                                          <<00888>>53484000
<<USING THE VALUE OF OLDCHECKSUM AS A BASE, CALCULATE>>        <<00888>>53486000
<<THE CHECKSUM OF THE TARGET ARRAY AND RETURN IT IN>>          <<00888>>53488000
<<THE PROCEDURE RETURN VALUE.>>                                <<00888>>53490000
FOR XREG:=0 UNTIL TARGETLEN-1 DO                               <<00888>>53492000
   OLDCHECKSUM:=OLDCHECKSUM+TARGET(XREG);                      <<00888>>53494000
CALCULATECHECKSUM:=OLDCHECKSUM;                                <<00888>>53496000
END;  <<CALCULATECHECKSUM>>                                    <<00888>>53498000
         <<---------------------------------->>                <<03550>>53500000
         << BUILD CS'80 BOOT CHANNEL PROGRAM >>                <<03550>>53502000
         <<---------------------------------->>                <<03550>>53504000
PROCEDURE BUILD'CS80'BOOT( BOOT'FMT'TAB, CNT);                 <<03550>>53506000
VALUE BOOT'FMT'TAB, CNT;                                       <<03550>>53508000
INTEGER POINTER BOOT'FMT'TAB;  << POINTER TO TABLE OF >>       <<03550>>53510000
                               << DISC BOOT ADDRESSES >>       <<03550>>53512000
INTEGER CNT;   << NO. OF ENTRIES IN BOOT'FMT'TAB >>            <<03550>>53514000
BEGIN                                                          <<03550>>53516000
EQUATE                                                         <<03550>>53518000
   BASE1         =  %7100,                                     <<03550>>53520000
   BASE2         =  %2000;                                     <<03550>>53522000
EQUATE                                                         <<03550>>53524000
   ENTRY'SIZE    =  5,                                         <<03550>>53526000
   SEED          =  %123456;                                   <<03550>>53528000
DEFINE                                                         <<03550>>53530000
   DISCADR1      =  PNTR#,      << BOOT'FMT'TAB DEFINITION: >> <<03550>>53532000
   DISCADR2      =  PNTR(1)#,   << 5-WORD ENTRIES CONTAIN   >> <<03550>>53534000
   COREADR1      =  PNTR(2)#,   << DOUBLE-WORD DISC ADDRESS,>> <<03550>>53536000
   COREADR2      =  PNTR(3)#,   << DOUBLE-WORD CORE ADDRESS,>> <<03550>>53538000
   LENGTH        =  PNTR(4)#;   << LENGTH OF TABLE (WORDS)  >> <<03550>>53540000
INTEGER                                                        <<03550>>53542000
   CPSIZE,                                                     <<03550>>53544000
   BASE,                                                       <<03550>>53546000
   SIZE,                                                       <<03550>>53548000
   MSGLEN;                                                     <<03550>>53550000
DOUBLE ARRAY DISCADDRESS(0:0)=Q;                               <<03550>>53552000
DOUBLE CPDISCADR;                                              <<03550>>53554000
INTEGER POINTER                                                <<03550>>53556000
   PNTR,                                                       <<03550>>53558000
   CPPNTR;                                                     <<03550>>53560000
BYTE POINTER                                                   <<03550>>53562000
   ADRPNTR,                                                    <<03550>>53564000
   APNTR;                                                      <<03550>>53566000
DEFINE                                                         <<03550>>53568000
   MEMX                   = (8:8)#;                            <<03550>>53570000
EQUATE                                                         <<03550>>53572000
   CDB'READ               =   0,                               <<03550>>53574000
   CDB'REQ'STATUS         = %15,                               <<03550>>53576000
   CDB'SET'SNGL'VEC       = %20,                               <<03550>>53578000
   CDB'SET'LENGTH         = %30,                               <<03550>>53580000
   CDB'SET'UNIT           = %40,                               <<03550>>53582000
   CDB'NO'OP              = %64,                               <<03550>>53584000
   CDB'SET'VOL            =%100,                               <<03550>>53586000
   MAXMSG                 = 200;                               <<03550>>53588000
EQUATE                                                         <<03550>>53590000
   CPBASE'LEN             = %41,                               <<03550>>53592000
   CPBASE'JMP'X           =   2,                               <<03550>>53594000
   CPBASE'STATCMD'X       =   3,                               <<03550>>53596000
   CPBASE'STATBUF         =   4,                               <<03550>>53598000
   CPSTAT'ENTRY           = %16,                               <<03550>>53600000
   CPSTAT'CMD'X           = %22,                               <<03550>>53602000
   CPSTAT'ADR'X           = %31,                               <<03550>>53604000
   CPRD'LEN               = %23,                               <<03550>>53606000
   CPRD'MSGLEN'X          =   1,                               <<03550>>53608000
   CPRD'MSGADR'X          =   4,                               <<03550>>53610000
   CPRD'CNT'X             = %10,                               <<03550>>53612000
   CPRD'BANK'X            = %12,                               <<03550>>53614000
   CPRD'ADR'X             = %13,                               <<03550>>53616000
   CPRD'DSJ'ERR1'X        = %21,                               <<03550>>53618000
   CPRD'DSJ'ERR2'X        = %22,                               <<03550>>53620000
   CPRD'DSJ'NEXT          = %23,                               <<03550>>53622000
   CPEND'LEN              =   3;                               <<03550>>53624000
<<     NOTE:   A "*" BESIDES A NUMBER INDICATES     >>         <<03550>>53626000
<<     A LOCATION WITHIN THE CHANNEL PROGRAM        >>         <<03550>>53628000
<<     THAT NEEDS TO BE UPDATED.                    >>         <<03550>>53630000
ARRAY CHAN'PGM'BASE(*) = PB :=                                 <<03550>>53632000
  <<  0*>>         0, << CHECKSUM                         >>   <<03550>>53634000
                                                               <<03550>>53636000
  <<  1 >>         0, << JUMP COMMAND                     >>   <<03550>>53638000
  <<  2*>>       %36, << JUMP TARGET                      >>   <<03550>>53640000
                                                               <<03550>>53642000
  <<  3 >>       %15, << STATUS REQUEST COMMAND           >>   <<03550>>53644000
                                                               <<03550>>53646000
  <<  4 >> 0,0,0,0,0, << STATUS BUFFER - ERROR STATUS     >>   <<03550>>53648000
  << 11 >> 0,0,0,0,0, << WILL BE RETURNED HERE!           >>   <<03550>>53650000
                                                               <<03550>>53652000
  << 16 >>     %2005, << SEND READ STATUS COMMAND         >>   <<03550>>53654000
  << 17 >>         1,                                          <<03550>>53656000
  << 20 >>         0,                                          <<03550>>53658000
  << 21 >>    %42000,                                          <<03550>>53660000
  << 22*>>         0,                                          <<03550>>53662000
                                                               <<03550>>53664000
  << 23 >>     %1000, << WAIT                             >>   <<03550>>53666000
  << 24 >>         0,                                          <<03550>>53668000
                                                               <<03550>>53670000
  << 25 >>     %1416, << EXECUTION MSG SECONDARY          >>   <<03550>>53672000
  << 26 >>        20, << #STATUS BYTES TO READ            >>   <<03550>>53674000
  << 27 >>         0, << BURST                            >>   <<03550>>53676000
  << 30 >>     %2000, << DATA BANK                        >>   <<03550>>53678000
  << 31*>>         0, << DATA BUFFER ABSOLUTE ADDRESS     >>   <<03550>>53680000
                                                               <<03550>>53682000
  << 32 >>     %1000, << WAIT                             >>   <<03550>>53684000
  << 33 >>         0,                                          <<03550>>53686000
                                                               <<03550>>53688000
  << 34 >>     %2400, << REPORTING MSG SECONDARY          >>   <<03550>>53690000
  << 35 >>         0,                                          <<03550>>53692000
  << 36 >>         0,                                          <<03550>>53694000
                                                               <<03550>>53696000
  << 37 >>      %600, << INT/HALT - BAD NEWS HALT         >>   <<03550>>53698000
  << 40 >>         1; << ERROR - CAUSE SYSTEM HALT!       >>   <<03550>>53700000
ARRAY CHAN'PGM'READ(*) = PB :=                                 <<03550>>53702000
  <<  0 >>     %2005, << COMMAND MSG SECONDARY            >>   <<03550>>53704000
  <<  1*>>         0, << COMMAND MSG BUFFER LENGTH        >>   <<03550>>53706000
  <<  2 >>         0, << BURST                            >>   <<03550>>53708000
  <<  3 >>     %2000, << COMMAND BUFFER BANK              >>   <<03550>>53710000
  <<  4*>>         0, << COMMAND BUFFER ABSOLUTE ADDRESS  >>   <<03550>>53712000
                                                               <<03550>>53714000
  <<  5 >>     %1000, << WAIT                             >>   <<03550>>53716000
  <<  6 >>         0,                                          <<03550>>53718000
                                                               <<03550>>53720000
  <<  7 >>     %1416, << EXECUTION MSG SECONDARY          >>   <<03550>>53722000
  << 10*>>         0, << NUMBER OF DATA BYTES TO READ     >>   <<03550>>53724000
  << 11 >>         0, << BURST                            >>   <<03550>>53726000
  << 12*>>         0, << DATA BANK                        >>   <<03550>>53728000
  << 13*>>         0, << DATA BUFFER ABSOLUTE ADDRESS     >>   <<03550>>53730000
                                                               <<03550>>53732000
  << 14 >>     %1000, << WAIT                             >>   <<03550>>53734000
  << 15 >>         0,                                          <<03550>>53736000
                                                               <<03550>>53738000
  << 16 >>     %2402, << DSJ - REPORTING PHASE            >>   <<03550>>53740000
  << 17 >>         0,                                          <<03550>>53742000
  << 20 >>         0, << A-OK JUMP                        >>   <<03550>>53744000
  << 21*>>         0, << HARD ERROR JUMP                  >>   <<03550>>53746000
  << 22*>>         0; << POWER ON JUMP                    >>   <<03550>>53748000
ARRAY CHAN'PGM'END(*) = PB :=                                  <<03550>>53750000
  <<  0 >>      %600, << INT/HALT                         >>   <<03550>>53752000
  <<  1 >>         0, << GOOD NEWS HALT!                  >>   <<03550>>53754000
                                                               <<03550>>53756000
  <<  2 >>        -1; << TERMINATOR                       >>   <<03550>>53758000
                                                               <<03550>>53760000
SUBROUTINE READ( BANK, ADDRESS, DISCADR, SIZE);                <<03550>>53762000
VALUE BANK, ADDRESS, DISCADR, SIZE;                            <<03550>>53764000
INTEGER BANK, ADDRESS, SIZE;                                   <<03550>>53766000
DOUBLE DISCADR;                                                <<03550>>53768000
                                                               <<03550>>53770000
COMMENT                                                        <<03550>>53772000
BUILDS A CHANNEL PROGRAM TO DO ONE READ.                       <<03550>>53774000
;                                                              <<03550>>53776000
                                                               <<03550>>53778000
BEGIN                                                          <<03550>>53780000
SIZE := SIZE&LSL(1);                                           <<03550>>53782000
@APNTR := @ADRPNTR; << SAVE START OF CMD BUFFER >>             <<03550>>53784000
                                                               <<03550>>53786000
<< BUILD CMD BUFFER >>                                         <<03550>>53788000
                                                               <<03550>>53790000
ADRPNTR := CDB'SET'SNGL'VEC;                                   <<03550>>53792000
ADRPNTR(1) := 0;                                               <<03550>>53794000
ADRPNTR(2) := 0;                                               <<03550>>53796000
TOS := @DISCADR&LSL(1);                                        <<03550>>53798000
MOVE ADRPNTR(3) := *,(4);                                      <<03550>>53800000
ADRPNTR(7) := CDB'SET'LENGTH;                                  <<03550>>53802000
ADRPNTR(8) := 0;                                               <<03550>>53804000
ADRPNTR(9) := 0;                                               <<03550>>53806000
TOS := @SIZE&LSL(1);                                           <<03550>>53808000
MOVE ADRPNTR(10) := *,(2);                                     <<03550>>53810000
ADRPNTR(12) := CDB'READ;                                       <<03550>>53812000
MSGLEN := 13;                                                  <<03550>>53814000
@ADRPNTR := @ADRPNTR(14);                                      <<03550>>53816000
                                                               <<03550>>53818000
<< BUILD CHANNEL PROGRAM >>                                    <<03550>>53820000
                                                               <<03550>>53822000
MOVE CPPNTR := CHAN'PGM'READ,(CPRD'LEN);                       <<03550>>53824000
CPPNTR(CPRD'MSGLEN'X) := MSGLEN;                               <<03550>>53826000
CPPNTR(CPRD'MSGADR'X) := BASE+WORDADDRESS(APNTR)-@BUF;         <<04306>>53828000
CPPNTR(CPRD'CNT'X) := SIZE;                                    <<03550>>53830000
CPPNTR(CPRD'BANK'X).MEMX := BANK;                              <<03550>>53832000
CPPNTR(CPRD'ADR'X) := ADDRESS;                                 <<03550>>53834000
CPPNTR(CPRD'DSJ'ERR1'X) := CPPNTR(CPRD'DSJ'ERR2'X) :=          <<03550>>53836000
   @BUF(CPSTAT'ENTRY) - @CPPNTR(CPRD'DSJ'NEXT);                <<03550>>53838000
@CPPNTR := @CPPNTR+CPRD'LEN;                                   <<03550>>53840000
END;                                                           <<03550>>53842000
                                                               <<03550>>53844000
<< BUILD LARGE CHANNEL PROGRAM WITH MANY READS TO GO >>        <<03550>>53846000
<< AT ADDRESS %2000.                                 >>        <<03550>>53848000
                                                               <<03550>>53850000
BASE := BASE2;                                                 <<03550>>53852000
MOVE BUF := CHAN'PGM'BASE,(CPBASE'LEN),2;                      <<03550>>53854000
@ADRPNTR := TOS&LSL(1); << MAKE BYTE ADDRESS >>                <<03550>>53856000
@CPPNTR := @BUF(MAXMSG);                                       <<03550>>53858000
BUF(CPSTAT'CMD'X) := BASE+CPBASE'STATCMD'X;                    <<03550>>53860000
BUF(CPSTAT'ADR'X) := BASE+CPBASE'STATBUF;                      <<03550>>53862000
                                                               <<03550>>53864000
<< BUILD ONE READ CHANNEL PROGRAM FOR EVERY ENTRY IN >>        <<03550>>53866000
<< BOOT'FMT'TAB.                                     >>        <<03550>>53868000
                                                               <<03550>>53870000
@PNTR := @BOOT'FMT'TAB;  << SET POINTER TO START OF MAP >>     <<03550>>53872000
WHILE CNT > 0 DO    << BUILD READ COMMANDS FOR ALL >>          <<03550>>53874000
   BEGIN            << ENTRIES IN TABLE            >>          <<03550>>53876000
   MOVE DISCADDRESS := DISCADR1,(2);                           <<03550>>53878000
   READ(COREADR1,COREADR2,DISCADDRESS,LENGTH);                 <<03550>>53880000
   @PNTR := @PNTR(ENTRY'SIZE);                                 <<03550>>53882000
   CNT := CNT - 1;                                             <<03550>>53884000
   END;                                                        <<03550>>53886000
MOVE CPPNTR := CHAN'PGM'END,(CPEND'LEN),2;                     <<03550>>53888000
@CPPNTR := TOS;                                                <<03550>>53890000
@PNTR := WORDADDRESS(ADRPNTR);   << CHANGE TO WORD PNTR >>     <<04306>>53892000
CPSIZE := @CPPNTR-@BUF;                                        <<03550>>53894000
<< COMPUTE JUMP TARGET >>                                      <<03550>>53896000
BUF(CPBASE'JMP'X) := @BUF(MAXMSG)-@BUF(CPBASE'JMP'X+1);        <<03550>>53898000
CPDISCADR := D'L( BOOTDISCSPACE( CPSIZE)));                    <<03550>>53900000
DISC( WRITE,SYSDISC,          << WRITE CHANNEL PROGRAM OUT >>  <<03550>>53902000
      CPDISCADR,BUF,CPSIZE);  <<    TO THE RESERVED AREA   >>  <<03550>>53904000
                                                               <<03550>>53906000
<< NOW BUILD THE SMALL CHANNEL PROGRAM, WHICH READS IN >>      <<03550>>53908000
<< THE LARGER ONE, TO RUN AT %7100.                    >>      <<03550>>53910000
                                                               <<03550>>53912000
BASE := BASE1;                                                 <<03550>>53914000
ZEROBUF(BUF,128);                                              <<03550>>53916000
MOVE BUF := CHAN'PGM'BASE,(CPBASE'LEN),2;                      <<03550>>53918000
@ADRPNTR := S0&LSL(1); << MAKE BYTE ADDRESS >>                 <<03550>>53920000
@CPPNTR := TOS+27; << ROOM FOR THREE MSG READS >>              <<03550>>53922000
BUF(CPBASE'JMP'X) := @CPPNTR-@BUF(CPBASE'JMP'X+1);             <<03550>>53924000
BUF(CPSTAT'CMD'X) := BASE+CPBASE'STATCMD'X;                    <<03550>>53926000
BUF(CPSTAT'ADR'X) := BASE+CPBASE'STATBUF;                      <<03550>>53928000
READ(0,BASE2,CPDISCADR,CPSIZE);                                <<03550>>53930000
<< COMPUTE ABSOLUTE JUMP TARGET >>                             <<03550>>53932000
CPPNTR := 0;  << JUMP >>                                       <<03550>>53934000
CPPNTR(1) := BASE2+1-(@CPPNTR(2)-@BUF+BASE);                   <<03550>>53936000
BUF := CALCULATECHECKSUM(BUF,128,SEED);                        <<03550>>53938000
                                                               <<03550>>53940000
<< WRITE THIS CHANNEL PROGRAM OUT TO SECTOR 2 >>               <<03550>>53942000
                                                               <<03550>>53944000
DISC( WRITE,SYSDISC,2D,BUF,128);  << PUT IT AT SECTOR 2 >>     <<03550>>53946000
END;   << BUILD'CS80'BOOT >>                                   <<03550>>53948000
$IF X1=OFF  << ******* SERIES II/III UNIQUE ******** >>        <<02510>>53950000
PROCEDURE BUILD'SIO'BOOT( PNTR, CNT);                          <<02510>>53952000
   VALUE PNTR, CNT;                                            <<02510>>53954000
   INTEGER POINTER PNTR;                                       <<02510>>53956000
   INTEGER CNT;                                                <<02510>>53958000
BEGIN                                                          <<02510>>53960000
   DOUBLE POINTER                                              <<02510>>53962000
      DPNTR = PNTR;                                            <<02510>>53964000
   DOUBLE                                                      <<02510>>53966000
      SIODISCADR;                                              <<02510>>53968000
   INTEGER                                                     <<02510>>53970000
      SIOPGMSIZE;                                              <<02510>>53972000
   INTEGER POINTER                                             <<02510>>53974000
      PS0 = S-0;                                               <<02510>>53976000
                                                               <<02510>>53978000
   ZEROBUF( BUF, 256);                                         <<03550>>53980000
   ADRBASE := 0;                                               <<02510>>53982000
   @SIOPNTR := @BUF(128);                                      <<02510>>53984000
   TOS := CNT;                                                 <<02510>>53986000
   WHILE <> DO                                                 <<02510>>53988000
      BEGIN                                                    <<02510>>53990000
      SIOREADENT(DPNTR,DPNTR(1),PNTR(4));                      <<02510>>53992000
      @PNTR := @PNTR(5);                                       <<02510>>53994000
      TOS := TOS-1;                                            <<02510>>53996000
      END;                                                     <<02510>>53998000
   SIOPNTR := %34000;  << SIO END,I >>                         <<02510>>54000000
   SIOPGMSIZE := @SIOPNTR-@BUF(126);                           <<02510>>54002000
   MOVE BUF( ADRBASE) := BUF(128),(SIOPGMSIZE);                <<02510>>54004000
   SIOPGMSIZE := SIOPGMSIZE+ADRBASE;                           <<02510>>54006000
   SIODISCADR := D'L(BOOTDISCSPACE(SIOPGMSIZE)));              <<02510>>54008000
   DISC(WRITE,SYSDISC,SIODISCADR,BUF,SIOPGMSIZE);              <<02510>>54010000
                                                               <<02510>>54012000
   @SIOPNTR := @BUF;                                           <<02510>>54014000
   SIOREADENT'(SIODISCADR,D'L(SIOCOREADR)),SIOPGMSIZE);        <<02510>>54016000
   DISC(READ,SYSDISC,0D,LBUF,128);  << DISC LABEL >>           <<02510>>54018000
   MOVE LBUF := BUF,(4),2;                                     <<02510>>54020000
   PS0 := 0;  << SIO JUMP >>                                   <<02510>>54022000
   TOS := TOS+1;                                               <<02510>>54024000
   PS0 := SIOCOREADR+ADRBASE;  << JUMP TARGET >>               <<02510>>54026000
   DISC(WRITE,SYSDISC,0D,LBUF,128);                            <<02510>>54028000
END;                                                           <<02510>>54030000
$IF   << ********* RETURNING TO COMMON CODE ********** >>      <<02510>>54032000
PROCEDURE BUILD'AMIGO'BOOT( PNTR, CNT);                        <<02510>>54034000
   VALUE PNTR, CNT;                                            <<02510>>54036000
   INTEGER POINTER PNTR;                                       <<02510>>54038000
   INTEGER CNT;                                                <<02510>>54040000
BEGIN                                                          <<02510>>54042000
   DOUBLE POINTER                                              <<02510>>54044000
      DPNTR = PNTR;                                            <<02510>>54046000
   DOUBLE                                                      <<02510>>54048000
      SIODISCADR;                                              <<02510>>54050000
   INTEGER                                                     <<02510>>54052000
      SIOPGMSIZE;                                              <<02510>>54054000
   EQUATE                                                      <<02510>>54056000
      SEED = %123456;                                          <<02510>>54058000
   INTEGER ARRAY END'W'INT(0:4)=PB :=                          <<02510>>54060000
      %1000,0,  %600,0,  %177777;                              <<02510>>54062000
   INTEGER ARRAY FILEMASK(4:NMHSUBTYPES-1)=PB :=               <<02510>>54064000
      %7406,%7405,%7407,%7407,%7407,%7407,%7406,%7406,         <<02510>>54066000
      %7407,%7400;                                             <<02510>>54068000
                                                               <<02510>>54070000
   ZEROBUF( BUF, 256);                                         <<03550>>54072000
   @SIOPNTR := @BUF(128);                                      <<02510>>54074000
   BUF(127) := %2400;    << READ CHANNEL COMMAND >>            <<02510>>54076000
   BUF(126) := FILEMASK(SYSDISCSUBTYPE);                       <<02510>>54078000
   ADRBASE := 123;                                             <<02510>>54080000
                                                               <<02510>>54082000
   TOS := CNT;                                                 <<02510>>54084000
   WHILE <> DO                                                 <<02510>>54086000
      BEGIN                                                    <<02510>>54088000
      AMIGOREADENT(DPNTR,DPNTR(1),PNTR(4));                    <<02510>>54090000
      @PNTR := @PNTR(5);                                       <<02510>>54092000
      TOS := TOS-1;                                            <<02510>>54094000
      END;                                                     <<02510>>54096000
   MOVE SIOPNTR := END'W'INT,(5),2;                            <<02510>>54098000
   @SIOPNTR := TOS;                                            <<02510>>54100000
   SIOPGMSIZE := @SIOPNTR-@BUF(128);                           <<02510>>54102000
   SIODISCADR := D'L(BOOTDISCSPACE(SIOPGMSIZE)));              <<02510>>54104000
   DISC(WRITE,SYSDISC,SIODISCADR,BUF(128),SIOPGMSIZE);         <<02510>>54106000
                                                               <<02510>>54108000
   @SIOPNTR := @BUF(1);                                        <<02510>>54110000
   AMIGOREADENT(SIODISCADR,D'L(SIOCOREADR)),SIOPGMSIZE);       <<02510>>54112000
   SIOPNTR := 0;  << CHANNEL JUMP >>                           <<02510>>54114000
   << COMPUTE JUMP TARGET >>                                   <<02510>>54116000
   SIOPNTR(1) := SIOCOREADR-(%7100+@SIOPNTR(2)-@BUF);          <<02510>>54118000
   BUF := CALCULATECHECKSUM(BUF,128,SEED);                     <<02510>>54120000
   DISC(WRITE,SYSDISC,2D,BUF,128); << COLD LOAD SECTOR >>      <<02510>>54122000
END;                                                           <<02510>>54124000
$CONTROL SEGMENT=RESIDENT                                      <<03603>>54128000
PROCEDURE DISPATCHER;                                          <<03603>>54130000
   OPTION INTERRUPT;                                           <<03603>>54132000
BEGIN                                                          <<03603>>54134000
END;                                                           <<03603>>54136000
PROCEDURE MOVE'INITIAL( USEDCORE);                             <<03603>>54138000
   VALUE USEDCORE;                                             <<03603>>54140000
   DOUBLE USEDCORE;                                            <<03603>>54142000
BEGIN                                                          <<03603>>54144000
   DOUBLE                                                      <<03603>>54146000
      STACK'ADR,                                               <<03603>>54148000
      SWAP'AREA,                                               <<03603>>54150000
      DADR,                                                    <<03603>>54152000
      DTEMP;                                                   <<03603>>54154000
   INTEGER                                                     <<03603>>54156000
      BANK     = DADR,                                         <<03603>>54158000
      ADR      = DADR+1,                                       <<03603>>54160000
      DTEMP1   = DTEMP,                                        <<03603>>54162000
      DTEMP2   = DTEMP+1,                                      <<03603>>54164000
      LAST'BANK,                                               <<03603>>54166000
      STACK'SIZE,                                              <<03603>>54168000
      STACK'DLZ,                                               <<03603>>54170000
      NEWDBBANK,                                               <<03603>>54172000
      NEWDB,                                                   <<03603>>54174000
      I,                                                       <<03603>>54176000
      J;                                                       <<03603>>54178000
   DEFINE                                                      <<03603>>54180000
      DISP'BK  = ICS(1)#,                                      <<03603>>54182000
      DISP'DB  = ICS(2)#,                                      <<03603>>54184000
      QIDB     = ICS(-4)#,                                     <<03603>>54186000
      QISBK    = ICS(-5)#,                                     <<03603>>54188000
      QIS      = ICS(-6)#,                                     <<03603>>54190000
      QIDL     = ICS(-7)#,                                     <<03603>>54192000
      QIZ      = ICS(-8)#;                                     <<03603>>54194000
                                                               <<03603>>54196000
   DOUBLE ARRAY                                                <<03603>>54198000
      COREADR(*)   = BUF,                                      <<03603>>54200000
      DLBUF(*)     = LBUF;                                     <<03603>>54202000
SUBROUTINE LAUNCH;                                             <<03603>>54204000
BEGIN                                                          <<03603>>54206000
   ABS(DB) := NEWDB;                                           <<03603>>54208000
   ABS(DBBANK) := NEWDBBANK;                                   <<03603>>54210000
   QIDB := NEWDB;                                              <<03603>>54212000
   QISBK := NEWDBBANK;                                         <<03603>>54214000
   DISP'BK := NEWDBBANK;                                       <<03603>>54216000
   DISP'DB := NEWDB;                                           <<03603>>54218000
   PUSH( S, Q, Z, DL );                                        <<03603>>54220000
   TOS := NEWDBBANK;                                           <<03603>>54222000
   TOS := NEWDB;                                               <<03603>>54224000
   TOS := NEWDBBANK; << SBANK >>                               <<03603>>54226000
   SET( S, Q, Z, DL, DB, SBANK );                              <<03603>>54228000
   ASSEMBLE( EXIT 2 ); << LAUNCH >>                            <<03603>>54230000
END;                                                           <<03603>>54232000
                                                               <<03603>>54234000
LOGICAL SUBROUTINE SEGSIZE( CSTNR);                            <<03603>>54236000
   VALUE CSTNR;                                                <<03603>>54238000
   INTEGER CSTNR;                                              <<03603>>54240000
SEGSIZE := TCST( CSTNR*4).(4:12)*4;                            <<03603>>54242000
                                                               <<03603>>54244000
DOUBLE SUBROUTINE GETSPACE( SIZE);                             <<03603>>54246000
   VALUE SIZE;                                                 <<03603>>54248000
   LOGICAL SIZE;                                               <<03603>>54250000
BEGIN                                                          <<03603>>54252000
   J := LAST'BANK;                                             <<03603>>54254000
   WHILE J >= NR'MPE'BANKS DO                                  <<03603>>54256000
      BEGIN                                                    <<03603>>54258000
      DTEMP := DLBUF(J) - DOUBLE(SIZE);                        <<03603>>54260000
      IF J = DTEMP1 THEN << CROSS OVER A BANK BOUNDARY? >>     <<03603>>54262000
         BEGIN  << IT FITS! >>                                 <<03603>>54264000
         DLBUF(J) := DTEMP;                                    <<03603>>54266000
         GETSPACE := DTEMP; << RETURN ADR OF SPACE >>          <<03603>>54268000
         J := 0; << TERMINATE LOOP >>                          <<03603>>54270000
         END                                                   <<03603>>54272000
      ELSE                                                     <<03603>>54274000
         J := J-1; << TRY NEXT BANK >>                         <<03603>>54276000
      END;                                                     <<03603>>54278000
END;                                                           <<03603>>54280000
SUBROUTINE MABS'( DEST, SBANK, SADDRESS, COUNT);               <<03603>>54282000
   VALUE DEST, SBANK, SADDRESS, COUNT;                         <<03603>>54284000
   DOUBLE DEST;                                                <<03603>>54286000
   INTEGER SBANK, SADDRESS, COUNT;                             <<03603>>54288000
BEGIN                                                          <<03603>>54290000
   X := TOS;   << SAVE RETURN ADDRESS >>                       <<03603>>54292000
   ASSEMBLE( MABS 0 );                                         <<03603>>54294000
   TOS := X;   << REPLACE RETURN ADDRESS >>                    <<03603>>54296000
END;                                                           <<03603>>54298000
SUBROUTINE MOVESEG( SEG, COREADR);                             <<03603>>54300000
   VALUE SEG, COREADR;                                         <<03603>>54302000
   INTEGER SEG;                                                <<03603>>54304000
   DOUBLE COREADR;                                             <<03603>>54306000
BEGIN                                                          <<03603>>54308000
   IF LOGICAL( TCST(SEG*4).(0:1)) THEN                         <<03603>>54310000
      BEGIN << ABSENT - READ FROM DISC >>                      <<03603>>54312000
      DISC'(READ,SYSDISC,TCSTDISC(SEG),COREADR,SEGSIZE(SEG));  <<03603>>54314000
      END                                                      <<03603>>54316000
   ELSE                                                        <<03603>>54318000
      BEGIN << PRESENT - MOVE TO NEW LOCATION >>               <<03603>>54320000
      MABS'(COREADR,TCST(SEG*4+2),TCST(X:=X+1),SEGSIZE(SEG));  <<03603>>54322000
      END;                                                     <<03603>>54324000
   TCST(SEG*4).(0:1) := 0; << MARK PRESENT >>                  <<03603>>54326000
   TCST(X:=X+2) := S2;     << BANK >>                          <<03603>>54328000
   TCST(X:=X+1) := S1;     << ADDRESS >>                       <<03603>>54330000
END;                                                           <<03603>>54332000
SUBROUTINE SETUP'SWAP'TAB;                                     <<03603>>54334000
BEGIN                                                          <<03603>>54336000
   I := NSWAPSEG-1;                                            <<03603>>54338000
   DO BEGIN                                                    <<03603>>54340000
      DADR := DADR-D'L(CTAB0(MAXINITSEG')));                   <<03603>>54342000
      SWAPD(I*SWAPDSIZE) := 0; <<CST #>>                       <<03603>>54344000
      SWAPD(X:=X+1) := BANK;                                   <<03603>>54346000
      SWAPD(X:=X+1) := ADR;                                    <<03603>>54348000
         << NEXT MOST LIKELY TO SWAP >>                        <<03603>>54350000
      SWAPD(X:=X+1) := IF I=0 THEN 0 ELSE (I-1)*SWAPDSIZE+3;   <<03603>>54352000
         << NEXT LEAST LIKELY TO SWAP >>                       <<03603>>54354000
      SWAPD(X:=X+1) := IF I=NSWAPSEG-1 THEN 0                  <<03603>>54356000
         ELSE (I+1)*SWAPDSIZE+4;                               <<03603>>54358000
      END UNTIL (I:=I-1) < 0;                                  <<03603>>54360000
   LLSWAP := 4;  << LEAST LIKELY TO SWAP >>                    <<03603>>54362000
   MLSWAP := (NSWAPSEG-1)*SWAPDSIZE+3; << MOST LIKELY >>       <<03603>>54364000
END;                                                           <<03603>>54366000
                                                               <<03603>>54368000
                                                               <<03603>>54370000
   DADR := USEDCORE-%11D;                                      <<03603>>54372000
   LAST'BANK := BANK;                                          <<03603>>54374000
                                                               <<03603>>54376000
   I := LAST'BANK;                                             <<03603>>54378000
   WHILE I >= NR'MPE'BANKS DO                                  <<03603>>54380000
      BEGIN                                                    <<03603>>54382000
      DLBUF(I) := DADR;                                        <<03603>>54384000
      ADR := %177770;                                          <<03603>>54386000
      BANK := BANK-1;                                          <<03603>>54388000
      I := I-1;                                                <<03603>>54390000
      END;                                                     <<03603>>54392000
                                                               <<03603>>54394000
   STACK'DLZ := QIZ-QIDL;                                      <<03603>>54396000
   STACK'SIZE := STACK'DLZ+INITSTACKEXTRA;                     <<03603>>54398000
   MAXSTACKSIZE:= STACK'SIZE;                                  <<04266>>54400000
                                                               <<03603>>54402000
   I := NUTCST;                                                <<03603>>54404000
   WHILE > DO                                                  <<03603>>54406000
      BEGIN                                                    <<03603>>54408000
      COREADR(I) := GETSPACE(SEGSIZE(I));                      <<03603>>54410000
      IF COREADR(I) = 0D THEN GO SWAP; << DOESN'T FIT >>       <<03603>>54412000
      I := I-1;                                                <<03603>>54414000
      END;                                                     <<03603>>54416000
                                                               <<03603>>54418000
   STACK'ADR := GETSPACE(STACK'SIZE);                          <<03603>>54420000
   IF STACK'ADR = 0D THEN GO SWAP; << DOESN'T FIT >>           <<03603>>54422000
                                                               <<03603>>54424000
   <<  EVERYTHING FITS -- BRING IT IN  >>                      <<03603>>54426000
                                                               <<03603>>54428000
   I := NUTCST;                                                <<03603>>54430000
   WHILE > DO                                                  <<03603>>54432000
      BEGIN                                                    <<03603>>54434000
      MOVESEG( I, COREADR(I));                                 <<03603>>54436000
      I := I-1;                                                <<03603>>54438000
      END;                                                     <<03603>>54440000
                                                               <<03603>>54442000
   DADR := STACK'ADR + D'L(INITSTACKEXTRA));                   <<03603>>54444000
   NEWDBBANK := BANK;                                          <<03603>>54446000
   NEWDB := ADR-QIDL;                                          <<03603>>54448000
   MABS(BANK,ADR,ABS(DBBANK),ABS(DB)+QIDL,STACK'DLZ);          <<03603>>54450000
   LAUNCH; << BLUE SKY  OR  CRASH AND BURN >>                  <<03603>>54452000
                                                               <<03603>>54454000
SWAP:  <<  IF WE GET HERE, THEIR WASN'T ENOUGH MEMORY  >>      <<03603>>54456000
       <<  TO HOLD INITIAL WITHOUT SWAPPING.           >>      <<03603>>54458000
                                                               <<03603>>54460000
   IF MEMORYSIZE = 128 THEN                                    <<03603>>54462000
      BEGIN << SEGMENTS IN CORRECT PLACE ALREADY >>            <<03603>>54464000
      TOS := TCST(NCORRESSEG*4+2);                             <<03603>>54466000
      TOS := TCST(X:=X+1);                                     <<03603>>54468000
      DADR := TOS;                                             <<03603>>54470000
      END                                                      <<03603>>54472000
   ELSE                                                        <<03603>>54474000
      BEGIN                                                    <<03603>>54476000
      DADR := USEDCORE-%11D;                                   <<03603>>54478000
                                                               <<03603>>54480000
      <<  READ IN CORE RESIDENT SEGMENTS  >>                   <<03603>>54482000
                                                               <<03603>>54484000
      I := NCORRESSEG;                                         <<03603>>54486000
      WHILE > DO                                               <<03603>>54488000
         BEGIN                                                 <<03603>>54490000
         DADR := DADR - D'L(SEGSIZE(I)));                      <<03603>>54492000
         MOVESEG( I, DADR);                                    <<03603>>54494000
         I := I-1;                                             <<03603>>54496000
         END;                                                  <<03603>>54498000
      END;                                                     <<03603>>54500000
                                                               <<03603>>54502000
   <<  FORCE REGISTER SWITCH TO NEW CODE SEGMENT LOCATION  >>  <<03603>>54504000
   <<  BY CALLING A PROCEDURE EXTERNAL TO THIS SEGMENT     >>  <<03603>>54506000
   THISCPU; << THERE GO THE REGISTERS! >>                      <<03603>>54508000
                                                               <<03603>>54510000
   <<  FLAG ALL NON-CORE RESIDENT SEGMENTS ABSENT  >>          <<03603>>54512000
   I := NCORRESSEG+1;                                          <<03603>>54514000
   WHILE I <= NUTCST DO                                        <<03603>>54516000
      BEGIN                                                    <<03603>>54518000
      TCST(I*4).(0:1) := 1; << MARK ABSENT >>                  <<03603>>54520000
      I := I+1;                                                <<03603>>54522000
      END;                                                     <<03603>>54524000
                                                               <<03603>>54526000
   SWAP'AREA := IF MEMORYSIZE=160 OR MEMORYSIZE=224 THEN       <<03603>>54528000
      D'L(ADR))                                                <<03603>>54530000
   ELSE                                                        <<03603>>54532000
      D'L(ADR-STACK'SIZE));                                    <<03603>>54534000
   IF MEMORYSIZE = 128 THEN                                    <<03603>>54536000
      IF ABS(DRTBANK) = 1 AND ABS(DRTADDR) = 0 THEN            <<03603>>54538000
         SWAP'AREA := SWAP'AREA-2048D; << DON'T OVERLAY DRT >> <<03603>>54540000
   NSWAPSEG := SWAP'AREA // LOGICAL(CTAB0(MAXINITSEG'));       <<03603>>54542000
                                                               <<04777>>54544000
   <<  For minimum memory (1/4 megabyte) system, minimize  >>  <<04777>>54546000
   <<  Initial's swapping area to allow larger I/O         >>  <<04777>>54548000
   <<  configuration.  This will slow down Initial.        >>  <<04777>>54550000
                                                               <<04777>>54552000
   IF MEMORYSIZE=128 AND NSWAPSEG > 2 THEN                     <<04777>>54554000
      BEGIN                                                    <<04777>>54556000
      NSWAPSEG:= 2;                                            <<04777>>54558000
      ADDRESS(NUM'BANKS):= HEADERLENGTH;                       <<04777>>54560000
      END;                                                     <<04777>>54562000
                                                               <<04777>>54564000
   IF NSWAPSEG > MAXSWAPSEG THEN                               <<03603>>54566000
      NSWAPSEG := MAXSWAPSEG;                                  <<03603>>54568000
   SETUP'SWAP'TAB;                                             <<03603>>54570000
                                                               <<03603>>54572000
   <<  CALULATE INITIAL'S NEW STACK POSITION  >>               <<03603>>54574000
                                                               <<03603>>54576000
   IF MEMORYSIZE = 160 OR MEMORYSIZE = 224 THEN                <<03603>>54578000
      BEGIN   << HALF BANK SYSTEM >>                           <<03603>>54580000
      BANK := BANK-1; << PUT STACK IN ANOTHER BANK >>          <<03603>>54582000
      ADR := %177770-STACK'DLZ;                                <<03603>>54584000
      END                                                      <<03603>>54586000
   ELSE                                                        <<03603>>54588000
      DADR := DADR-D'L(STACK'DLZ));                            <<03603>>54590000
                                                               <<03603>>54592000
   <<  MOVE STACK TO IT'S NEW LOCATION  >>                     <<03603>>54594000
                                                               <<03603>>54596000
   MABS'(DADR,QISBK,QIDB+QIDL,STACK'DLZ);                      <<03603>>54598000
   NEWDB := ADR-QIDL;                                          <<03603>>54600000
   NEWDBBANK := BANK;                                          <<03603>>54602000
   LAUNCH; <<  BLUE SKY  OR  CRASH AND BURN  >>                <<03603>>54604000
END; << MOVE'INITIAL >>                                        <<03603>>54606000
$CONTROL SEGMENT=BOOTSTRAP                                     <<02510>>54608000
PROCEDURE CKFORSTARFISH;                                       <<02510>>54610000
BEGIN                                                          <<02510>>54612000
   INTEGER TEMP1, TEMP2;                                       <<02510>>54614000
                                                               <<02510>>54616000
   STARFISH := FALSE;                                          <<02510>>54618000
   IF SERIESII'III THEN                                        <<02510>>54620000
      BEGIN                                                    <<02510>>54622000
      TEMP1 := ABSOLUTE(-1); << SAVE LAST LOCATION >>          <<02510>>54624000
      ABSOLUTE(-1) := %30000;<< REPLACE WITH SIO END INSTRUCTON<<02510>>54626000
      TEMP2 := ABSOLUTE(0);  << SAVE CST POINTER >>            <<02510>>54628000
      MB0 := 4;      << ENABLE/DISABLE >>                      <<02510>>54630000
      MB1 := 1;      << ENABLE         >>                      <<02510>>54632000
      MB4 := 0;      << I/0 STATUS     >>                      <<02510>>54634000
      TOS := ADAPTERDRT;                                       <<02510>>54636000
      TOS := -1;     << SIO PGM PNTR   >>                      <<02510>>54638000
      ASSEMBLE( SIO 1 );                                       <<02510>>54640000
      IF = THEN                                                <<02510>>54642000
         BEGIN                                                 <<02510>>54644000
         I := 100;                                             <<02510>>54646000
         WHILE <> AND NOT STARFISH DO                          <<02510>>54648000
            BEGIN                                              <<02510>>54650000
            IF MB4 < 0 THEN STARFISH := TRUE;                  <<02510>>54652000
            I := I-1;                                          <<02510>>54654000
            END;                                               <<02510>>54656000
         IF GETDRT(ADAPTERDRT,0) = -1 THEN STARFISH:=TRUE;     <<03002>>54658000
         << SIO PGM PNTR WOULD HAVE BEEN 1 FOR A SIO DEVICE >> <<02510>>54660000
         << A DEVICE ON THE MUX CHANNEL WILL HAVE WRAPPED   >> <<02510>>54662000
         << CORE AND DESTROYED THE CST POINTER              >> <<02510>>54664000
         << A DEVICE ON THE SELECTOR CHANNEL WILL HAVE      >> <<02510>>54666000
         << WRAPPED CORE BUT NOT DESTROYED THE CST POINTER  >> <<02510>>54668000
         ABSOLUTE(0) := TEMP2;                                 <<02510>>54670000
         END;                                                  <<02510>>54672000
      ABSOLUTE(-1) := TEMP1; << REPLACE LAST LOCATION >>       <<02510>>54674000
      END;                                                     <<02510>>54676000
END;                                                           <<02510>>54678000
$PAGE "DISC COLD LOAD BOOTSTRAP"                                        54680000
$CONTROL SEGMENT=BOOTSTRAP                                              54682000
  PROCEDURE BOOTSTRAP;                                                  54684000
    COMMENT                                                             54686000
      READS TABLES AND INITIAL'S CSTS FROM SYSTEM DISC. THEN PUTS       54688000
    MARKER ON INITIAL'S STACK SO THAT IXIT WILL GO THERE;               54690000
      BEGIN                                                             54692000
        INTEGER POINTER INFO;     <<INFORMATION TABLE>>                 54694000
        DOUBLE POINTER TABLEINFO; <<TABLE INFORMATION>>                 54696000
        INTEGER I,N,C,SBANK;                                   <<03603>>54698000
        DOUBLE ADR;                                            <<03603>>54700000
                                                               <<03603>>54702000
          SBANK := ABSOLUTE(ABSOLUTE(QI)-5);                   <<03603>>54704000
          TOS := ABS(ABS(QI)-13); << INFO BANK >>              <<03603>>54706000
          TOS := ABS(X:=X+1); << INFO ADDR >>                  <<03603>>54708000
          SET(DB);  <<SET DB TO POINT AT INFO TABLE>>                   54710000
          @INFO := 0;                                                   54712000
          << FIRMWARE AREA USED FOR INITIAL'S FLAGS >>         <<02510>>54714000
          ZEROABS( %1400, 32);                                 <<02510>>54716000
          PUSH( DB ); DELB;                                    <<03603>>54718000
          ABSOLUTE( CHANPROG) := S0+INFOSIZE;                  <<03603>>54720000
          DEL;                                                 <<03603>>54722000
          CS80'LOCK := FALSE;   << PARAM. FOR CS80'DRIVER-- >> <<03672>>54724000
                                << SHOULD BE SET BEFORE THE >> <<03672>>54726000
                                << FIRST CALL TO THIS DRIVER>> <<03672>>54728000
          IF NOT ICF55  <<CAN NOT USE DRTBANK,DRTADDR>>        <<03002>>54730000
          THEN BEGIN    <<SO ZERO TO EFFECTIVELY PUT>>         <<03002>>54732000
            ABSOLUTE(DRTBANK):=0;  <<DRT TAB IN BANK 0 >>      <<03002>>54734000
            ABSOLUTE(DRTADDR):=0;                              <<03002>>54736000
          END;                                                 <<03002>>54738000
          CKFORSTARFISH;                                       <<02510>>54742000
          INITDRT( INFO(SYSDISCDRT'));                         <<02510>>54744000
          << CLEAR TEMP'CPVA AREA >>                           <<02510>>54746000
          ZEROABS( TEMP'CPVA, 8);                              <<02510>>54748000
          @TABLEINFO := INFO(TABPTR);  <<PTR TO TABLE INFORMATION>>     54750000
          N := INFO(NREAD);  <<# OF ENTRIES TO READ IN>>                54752000
          C := (INFO(TCSTPTR)-INFO(TABPTR))/4;                 <<03603>>54754000
          I := 0;                                                       54756000
          DO                                                            54758000
            BEGIN                                                       54760000
              TOS := 0;       <<LDEV>>                                  54762000
              TOS := 0;  <<PUSH A WORD THEN LOAD DRT>>         <<03002>>54764000
              TOS.DRTFIELD := INFO(SYSDISCDRT');               <<03002>>54766000
              TOS := INFO(DISCTST).INFODSUBTYPE;                        54768000
              TOS := READ;                                              54770000
              TOS := TABLEINFO(I&LSL(1)+1);  <<DISC ADDRESS>>           54772000
              TOS := IF I >= C THEN 1 ELSE SBANK;              <<03603>>54774000
              TOS := TABLEINFO(I&LSL(1));                      <<03603>>54776000
              ASSEMBLE(XCH);   <<CORE ADDRESS AND WORD COUNT>>          54778000
              TOS := INFO(DISCTST).INFODTYPE;                           54780000
              IF S0=FHDISCTYPE THEN TOS := @FHDISC                      54782000
              ELSE IF S0=MHDISCTYPE THEN                                54784000
              IF S7<4 THEN TOS := @MHDISC                               54786000
              ELSE IF S7<NMHSUBTYPES THEN TOS := @MH7905       <<25.00>>54788000
              ELSE ASSEMBLE(HALT 9)                            <<2B.00>>54790000
              ELSE IF S0=DISC3 THEN TOS := @CS80'DRIVER        <<03550>>54792000
              ELSE ASSEMBLE( HALT 10);                         <<03550>>54794000
              ASSEMBLE(DELB; PCAL 0);  <<CALL DISC DRIVER>>             54796000
            END                                                         54798000
          UNTIL (I:=I+1)=N;                                             54800000
          ABSOLUTE(ABSOLUTE(QI)-6) := ABSOLUTE(ABSOLUTE(QI)-10); <<S>>  54802000
          TOS := SBANK;                     << DB BANK >>      <<03603>>54806000
          TOS := INFO(INITS)+INFO(INITDB)+1;                   <<03603>>54808000
          ADR := TOS;                                          <<03603>>54810000
          SSEA( ADR, INFO(LOADMODE));       << X >>            <<03603>>54812000
          SSEA( ADR+1D, INFO(DISCENTRY));   << DELTA P >>      <<03603>>54814000
          SSEA( ADR+2D, LOGICAL(@BOOTSTRAPHELP) LAND %100377); <<03603>>54816000
          SSEA( ADR+3D, 4);                 << DELTA Q >>      <<03603>>54818000
          SSEA( ADR+4D, SBANK);             << DB BANK >>      <<03603>>54820000
          SSEA( ADR+5D, INFO(INITDB));      << DB >>           <<03603>>54822000
      END <<BOOTSTRAP>> ;                                               54824000
$PAGE "CODE SEGMENT ABSENCE"                                            54826000
$CONTROL SEGMENT=RESIDENT                                               54828000
COMMENT                                                                 54830000
  THESE PROCEDURES ARE USED WHEN ONE OF INITIAL'S CODE SEGMENTS WHICH   54832000
IS ABSENT IS THE TARGET OF EITHER A PCAL OR AN EXIT INSTRUCTION. THEY   54834000
REFERENCE A TABLE IN INITIAL'S DL AREA (SWAPD) WHICH CONTAINS A 5-WORD  54836000
DESCRIPTOR FOR EACH AVAILABLE SWAPPING AREA (THE SWAPPING AREAS ARE OF  54838000
THE SAME LENGTH, EQUAL TO THE SIZE OF THE LARGEST SEGMENT WHICH IS      54840000
SWAPPED). THE DESCRIPTOR IS FORMATTED AS FOLLOWS:                       54842000
                                                                        54844000
      WORD            CONTENTS                                          54846000
      ----            --------                                          54848000
       0       CST NUMBER                                               54850000
       1       HIGH ORDER CORE ADDRESS                                  54852000
       2       LOW ORDER CORE ADDRESS                                   54854000
       3       LINK TO NEXT MOST LIKELY SEGMENT                         54856000
       4       LINK TO NEXT LEAST LIKELY SEGMENT                        54858000
                                                                        54860000
THE DESCRIPTORS ARE LINKED THROUGH THE 4TH AND 5TH WORDS, WHICH ARE     54862000
POINTERS TO THE NEXT MOST LIKELY ENTRY TO SWAP AND NEXT LEAST LIKELY    54864000
ENTRY TO SWAP, RESPECTIVELY. A ZERO IS THE TERMINATOR FOR THESE LISTS.  54866000
TWO WORDS IN PRIMARY DB, MLSWAP AND LLSWAP, ARE USED AS THE HEADS OF    54868000
THESE LISTS;                                                            54870000
                                                                        54872000
          <<---------------------------------------------------         54874000
            REMOVE ENTRY FROM SWAPPING DESCRIPTOR LINKED LIST           54876000
          --------------------------------------------------->>         54878000
  PROCEDURE REMOVENTRY(INDEX);                                          54880000
    VALUE INDEX;                                                        54882000
    INTEGER INDEX;                                                      54884000
    COMMENT                                                             54886000
      REMOVE THE ENTRY NUMBER INDEX FROM THE SWAPPING DESCRIPTOR LINKED 54888000
    LISTS;                                                              54890000
      BEGIN                                                             54892000
          TOS := SWAPD(INDEX*SWAPDSIZE+3); <<NEXT MOST LIKELY PTR>>     54894000
          TOS := SWAPD(X:=X+1);  <<NEXT LEAST LIKELY PTR>>              54896000
          IF = THEN                                                     54898000
            BEGIN   <<THIS GUY WAS MOST LIKELY>>                        54900000
              DEL;                                                      54902000
              MLSWAP := TOS;   <<NEW MOST LIKELY>>                      54904000
              IF MLSWAP=0 THEN MLSWAP := 3;  <<ONLY ONE SEGMENT>>       54906000
            END                                                         54908000
          ELSE                                                          54910000
            BEGIN                                                       54912000
              ASSEMBLE(DECA,STAX);                                      54914000
              SWAPD(X) := TOS;  <<RELINK NEXT MOST LIKELY PTR>>         54916000
            END;                                                        54918000
          TOS := SWAPD(INDEX*SWAPDSIZE+4);                              54920000
          TOS := SWAPD(X:=X-1);   <<NEXT MOST LIKELY PTR>>              54922000
          IF = THEN                                                     54924000
            BEGIN   <<THIS GUY WAS LEAST LIKELY>>                       54926000
              DEL;                                                      54928000
              LLSWAP := TOS;   <<NEW LEAST LIKELY>>                     54930000
            END                                                         54932000
          ELSE                                                          54934000
            BEGIN                                                       54936000
              ASSEMBLE(INCA,STAX);                                      54938000
              SWAPD(X) := TOS;  <<RELINK NEXT LEAST LIKELY PTR>>        54940000
            END;                                                        54942000
      END <<REMOVENTRY>> ;                                              54944000
                                                                        54946000
          <<--------------------------------------                      54948000
            INSERT ENTRY AS LEAST LIKELY TO SWAP                        54950000
          -------------------------------------->>                      54952000
  PROCEDURE INSERTLLSWAP(INDEX);                                        54954000
    VALUE INDEX;                                                        54956000
    INTEGER INDEX;                                                      54958000
    COMMENT                                                             54960000
      INSERT ENTRY NUMBER INDEX AT THE HEAD OF THE LEAST LIKELY LIST    54962000
    AND THE TAIL OF THE MOST LIKELY LIST;                               54964000
      BEGIN                                                             54966000
          SWAPD(INDEX*SWAPDSIZE+4) := LLSWAP; <<PTR TO OLD LLSWAP>>     54968000
          SWAPD(X:=X-1) := 0;    <<END OF MLSWAP LIST>>                 54970000
          ASSEMBLE(LDXA,DUP);                                           54972000
          IF LLSWAP=0 THEN DEL  <<ONLY ONE SEGMENT>>                    54974000
          ELSE SWAPD(LLSWAP-1) := TOS;  <<NEXT MOST LIKELY PTS HERE>>   54976000
          LLSWAP := TOS+1;  <<NEW LEAST LIKELY PTR>>                    54978000
      END <<INSERTLLSWAP>> ;                                            54980000
                                                                        54982000
          <<----------------------------------                          54984000
            MAKE ABSENT CODE SEGMENT PRESENT                            54986000
          ---------------------------------->>                          54988000
  PROCEDURE MAKEPRESENT;                                                54990000
    COMMENT                                                             54992000
      CALLED FROM THE ENTRY POINT IN SEGMENT ONE FOR CODE SEGMENT       54994000
    ABSENCE. THE PARAMETER STACKED BY THE HARDWARE IS THEREFORE         54996000
    AT Q-4 BECAUSE OF THE EXTRA PCAL. THE ABSENT SEGMENT IS BROUGHT     54998000
    INTO CORE AND IS INSERTED IN THE SWAPPING DESCRIPTOR LINKED LIST    55000000
    AS THE LEAST LIKELY SEGMENT TO SWAP. FOR PCAL'S, THE CALLING        55002000
    SEGMENT IS MADE TO BE THE SECOND LEAST LIKELY SEGMENT TO SWAP.      55004000
    FOR PCAL'S, A NORMAL EXIT IS MADE AFTER SETTING THE CORRECT         55006000
    PB-RELATIVE ADDRESS IN THE PREVIOUS MARKER, WHILE FOR EXITS THE     55008000
    PREVIOUS MARKER IS SKIPPED OVER BY RESETTING Q AND THE EXIT IS MADE 55010000
    DIRECTLY TO THE FORMERLY ABSENT SEGMENT;                            55012000
      BEGIN                                                             55014000
        INTEGER PARM=Q-4,      <<PARAMETER PASSED BY HARDWARE>>         55016000
                STATUS=Q-6,    <<MARKER STATUS>>                        55018000
                PREL=Q-7,      <<MARKER RELATIVE P>>                    55020000
                OLDSTAT=Q-10,  <<STATUS IN PREVIOUS MARKER>>            55022000
                I,             <<INDEX>>                                55024000
                ABSCST,        <<CST # OF ABSENT SEGMENT>>              55026000
                LEN;           <<LENGTH OF SEGMENT>>                    55028000
        DOUBLE  OLDDB,         <<ORIGINAL DB VALUE>>                    55030000
                COREADR;       <<ABSOLUTE ADDRESS OF CODE SEGMENT>>     55032000
          TOS := ABSOLUTE(DBBANK);                                      55034000
          TOS := ABSOLUTE(DB);                                          55036000
          ASSEMBLE(XCHD);   <<SET DB TO STACK>>                         55038000
          OLDDB := TOS;  <<SAVE ORIGINAL DB VALUE>>                     55040000
          TOS := IF PARM<0 THEN  PARM ELSE STATUS;                      55042000
          ABSCST := TOS.(8:8);  <<CST # OF ABSENT SEGMENT>>             55044000
          IF PARM<0 THEN                                                55046000
            BEGIN  <<PCAL - MAKE CALLING SEGMENT LEAST LIKELY>>         55048000
              I := 0;                                                   55050000
              DO IF SWAPD(I*SWAPDSIZE)=OLDSTAT.(8:8) THEN               55052000
              IF SWAPD(X:=X+3)=0 THEN GOTO GETML  <<ALREADY LEAST>>     55054000
              ELSE                                                      55056000
                BEGIN  <<MAKE LEAST LIKELY>>                            55058000
                  REMOVENTRY(I);                                        55060000
                  INSERTLLSWAP(I);                                      55062000
                  GOTO GETML;                                           55064000
                END                                                     55066000
              UNTIL (I:=I+1)=NSWAPSEG;                                  55068000
            END;                                                        55070000
  GETML:  TOS := MLSWAP-3;  <<INDEX OF MOST LIKELY TO SWAP ENTRY>>      55072000
          ASSEMBLE(DUP,STAX);                                           55074000
          TOS := SWAPD(X); <<CST #>>                                    55076000
          IF <> THEN                                                    55078000
            BEGIN  <<SET OLD SEGMENT ABSENT>>                           55080000
              X := TOS&LSL(2)+ABSOLUTE(CSTP);                           55082000
              ABSOLUTE(X).(0:1) := 1;  <<ABSENCE BIT>>                  55084000
            END                                                         55086000
          ELSE DEL;                                                     55088000
          ASSEMBLE(DUP,STAX);                                           55090000
          SWAPD(X) := ABSCST;  <<SET NEW CST # IN DESCRIPTOR>>          55092000
          TOS := SWAPD(X:=X+1);                                         55094000
          TOS := SWAPD(X:=X+1);                                         55096000
          COREADR := TOS;  <<ABSOLUTE CORE ADDRESS>>                    55098000
          TOS := ABSOLUTE(ABSOLUTE(CSTP)+ABSCST&LSL(2));                55100000
          LEN := S0.(4:12)&LSL(2);  <<LENGTH OF CODE SEGMENT>>          55102000
          ASSEMBLE(TRBC 0);  <<PRESENT NOW>>                            55104000
          ABSOLUTE(X) := TOS;                                           55106000
          TOS := COREADR;                                               55108000
          ABSOLUTE(X:=X+3) := TOS;                                      55110000
          ABSOLUTE(X:=X-1) := TOS;  <<PUT CORE ADDRESS IN CST ENTRY>>   55112000
          TOS := TOS/SWAPDSIZE;  <<ENTRY INDEX>>                        55114000
          REMOVENTRY(S0);                                               55116000
          INSERTLLSWAP(*);  <<MAKE ENTRY LEAST LIKELY TO SWAP>>         55118000
          DISC'(READ,SYSDISC,TCSTDISC(ABSCST),COREADR,LEN);             55120000
          TOS := OLDDB;                                                 55122000
          SET(DB);  <<RESET DB WHERE IT WAS>>                           55124000
          TOS := 1;         <<CODE TO MAKE -PRESENT>>          <<03603>>55126000
          TOS := ABSCST;   <<PUSH SEG # FOR HELP>>             <<03603>>55128000
          HELP'MAKE'PRESENT;  <<FIX UP BRKPTS>>                <<03603>>55130000
          DDEL;           <<DELETE CODE,SEG # >>               <<03603>>55132000
                                                               <<03603>>55134000
          IF PARM>=0 THEN                                               55136000
            BEGIN  <<EXIT>>                                             55138000
              TOS := PARM;  <<PARAMETER FOR EXIT>>                      55140000
              PUSH(Q);                                                  55142000
              TOS := TOS-5;                                             55144000
              SET(Q);  <<SKIP OVER MARKER STACKED FOR SEG 1>>           55146000
              TOS := %31400;  <<EXIT INSTRUCTION>>                      55148000
              ASSEMBLE(OR; XEQ 0);  <<EXIT>>                            55150000
            END;                                                        55152000
          TOS := COREADR; <<ABS ADDRESS OF BASE OF SEGMENT>>            55154000
          TOS := TOS+LEN-PARM.(1:7)-1; <<POINT INTO STT>>               55156000
          ASSEMBLE(LSEA);  <<GET LOCAL LABEL FROM STT>>                 55158000
          PREL := TOS.(2:14);  << PUT RELATIVE P IN MARKER >>  <<01683>>55160000
      END <<MAKEPRESENT>> ;                                             55162000
$PAGE "NON-RESPONDING-MODULE-INTERRUPT HANDLER"                <<00888>>55164000
$CONTROL SEGMENT=MAINSEG1                                      <<03002>>55168000
   LOGICAL PROCEDURE VERIFY'PHYS'MEMORY (KWORDS);              <<03002>>55170000
   <<===========================================>>             <<03002>>55172000
       VALUE KWORDS;  INTEGER KWORDS;                          <<03002>>55174000
                                                               <<03002>>55176000
    BEGIN                                                      <<03002>>55178000
                                                               <<03002>>55180000
    <<======================================================>> <<03002>>55182000
    << THIS PROCEDURE TESTS CONFIGURED MEMORY SIZE:         >> <<03002>>55184000
    <<   INSURES THAT "KWORDS" IS A VALID SIZE              >> <<03002>>55186000
    <<   DETERMINES ACTUAL PHYSICAL MEMORY AVAILABLE        >> <<03002>>55188000
    <<   INSURES THAT "KWORDS" <= ACTUAL PHYSICAL MEMORY    >> <<03002>>55190000
    <<   UPDATES GLOBAL "COREX" INDEX                       >> <<03002>>55192000
    <<   UPDATES CTAB0 VALUES, AND CONFDATA POINTERS        >> <<03002>>55194000
    <<======================================================>> <<03002>>55196000
                                                               <<03002>>55198000
            << GENERAL MEMORY INFORMATION >>                   <<03002>>55200000
            <<============================>>                   <<03002>>55202000
                                                               <<03002>>55204000
    <<  BYTES    WORDS    BANKS   BANK-BITS   MAX-CONFIG    >> <<03002>>55206000
    <<  -----    -----    -----   ---------   ----------    >> <<03002>>55208000
    <<  128K     64K        1                 SERIES-I      >> <<03002>>55210000
    <<  256K     128K       2         1                     >> <<03002>>55212000
    <<  512K     256K       4         2       SERIES-II     >> <<03002>>55214000
    <<  1M       512K       8         3                     >> <<03002>>55216000
    <<  2M       1M         16        4       SER-III ICF-33>> <<03002>>55218000
    <<  4M       2M         32        5                     >> <<03002>>55220000
    <<  8M       4M         64        6                     >> <<03002>>55222000
    <<  16M      8M         128       7                     >> <<03002>>55224000
    <<  32M      16M        256       8       ICF-44        >> <<03002>>55226000
    <<  64M      32M        512       9                     >> <<03002>>55228000
    <<  128M     64M        1024      10                    >> <<03002>>55230000
    <<  256M     128M       2048      11                    >> <<03002>>55232000
    <<  512M     256M       4096      12                    >> <<03002>>55234000
    <<  1G       512M       8192      13                    >> <<03002>>55236000
    <<  2G       1G         16384     14                    >> <<03002>>55238000
    <<  4G       2G         32768     15                    >> <<03002>>55240000
    <<  8G       4G         65536     16      ICF-55        >> <<03002>>55242000
    <<===================================================== >> <<03002>>55244000
                                                               <<03002>>55246000
                                                               <<03002>>55248000
        <<AN ARRAY OF VALID CORESIZES,INDEXED BY "COREX">>     <<03002>>55250000
                                                               <<03002>>55252000
        INTEGER ARRAY CORESIZES(0:NCORESIZES-1) = PB :=        <<03002>>55254000
        64, 80, 96, 128, 160, 192, 224, 256, 384, 512, 768,    <<03002>>55256000
        1024, 1152, 1280, 1408, 1536, 1664, 1792, 1920, 2048,  <<03002>>55258000
        2176, 2304, 2432, 2560, 2688, 2816, 2944, 3072,        <<03002>>55260000
        3200, 3328, 3456, 3584, 3712, 3840, 3968, 4096;        <<03002>>55262000
                                                               <<03002>>55264000
        <<AN ARRAY INDEXED BY "THISCPU" TYPE >>                <<03002>>55266000
        <<WHICH CONTAINS THE APPROPRIATE INDEX INTO>>          <<03002>>55268000
        <<CORESIZES FOR THE "MAX" SUPPORTED BY THE CPU. >>     <<03002>>55270000
        <<NOTE: AS IMPLEMENTED HERE, ICF/44,55 ARE >>          <<03002>>55272000
        <<RESTRICTED TO 64 BANKS CAPABILITY>>                  <<03002>>55274000
                                                               <<03002>>55276000
        INTEGER ARRAY MAXCPU'COREX (0:5) = PB :=               <<03002>>55278000
           0,   <<CPU-0   SERIES-I   64K>>                     <<03002>>55280000
           7,   <<CPU-1   SERIES-II  256K    4 BANKS (2)  >>   <<03002>>55282000
          11,   <<CPU-2   SERIES-33  1M     16 BANKS (4)  >>   <<03002>>55284000
          11,   <<CPU-3   SERIES-III 1M     16 BANKS (4)  >>   <<03002>>55286000
          35,   <<CPU-4   ICF-44     4M     64 BANKS (6)  >>   <<03002>>55288000
          35;   <<CPU-5   ICF-55     4M     64 BANKS (6)  >>   <<03002>>55290000
                                                               <<03002>>55292000
        DEFINE MCMD = ASSEMBLE( CON %20104; << ICF'55 MCMD >>  <<03746>>55294000
                                CON      4 )#;                 <<03746>>55296000
        DOUBLE STATUS; << RETURNED BY MCMD >>                  <<03746>>55298000
        LOGICAL MSTATUS = STATUS,                              <<03746>>55300000
                LSTATUS = STATUS+1;                            <<03746>>55302000
        INTEGER NR'BANKS;                                      <<03746>>55304000
        INTEGER MAXCOREX,          <<INDEX CPU SUPPORTS>>      <<03002>>55306000
                INDEX,             <<USED FOR TESTING>>        <<03002>>55308000
                PHYS'SIZE;         <<ACTUAL PHYS CORESIZE>>    <<03002>>55310000
                                                               <<03002>>55312000
        LOGICAL VALIDSIZE,         <<SPECIFIED SIZE VALID>>    <<03002>>55314000
                FOUND'PHYS'SIZE;   <<TRUE WHEN WE HAVE >>      <<03002>>55316000
                                   <<ESTABLISHED ACTUAL >>     <<03002>>55318000
                                   <<PHYSICAL CORESIZE>>       <<03002>>55320000
                                                               <<03002>>55322000
                                                               <<03002>>55324000
       <<------------------------------------------------>>    <<03002>>55326000
                                                               <<03002>>55328000
     VALIDSIZE := FALSE;      <<ASSUME FAILURE>>               <<03002>>55330000
     COREX := 0;              <<START AT LOWEST SIZE>>         <<03002>>55332000
                                                               <<03002>>55334000
            <<CONFIRM THAT "KWORDS" IS A VALID MEMORY SIZE>>   <<03002>>55336000
            <<EVEN IF IT EXCEEDS AVAILABLE PHYSICAL MEMORY>>   <<03002>>55338000
                                                               <<03002>>55340000
     DO IF CORESIZES (COREX) = KWORDS                          <<03002>>55342000
        THEN VALIDSIZE := TRUE                                 <<03002>>55344000
     UNTIL VALIDSIZE OR (COREX:=COREX+1) = NCORESIZES;         <<03002>>55346000
                                                               <<03002>>55348000
     IF NOT VALIDSIZE                                          <<03002>>55350000
     THEN MESSAGE (M2453)   <<INVALID CORESIZE>>               <<03002>>55352000
     ELSE BEGIN    <<VALID CORESIZE>>                          <<03002>>55354000
                                                               <<03002>>55356000
         INDEX := 3;          <<START AT 128K>>                <<03002>>55358000
                                                               <<03002>>55360000
             <<LOOK UP INDEX OF MAX CONFIG FOR THIS CPU>>      <<03002>>55362000
                                                               <<03002>>55364000
         MAXCOREX := MAXCPU'COREX( THISCPU);                   <<03002>>55366000
                                                               <<03002>>55368000
         FOUND'PHYS'SIZE := FALSE;                             <<03002>>55370000
                                                               <<03002>>55372000
            <<DETERMINE HOW MUCH PHYSICAL MEMORY IS >>         <<03746>>55376000
            <<ACTUALLY AVAILABLE BY WRITING A PATTERN>>        <<03746>>55378000
            <<AND THEN READING IT BACK. >>                     <<03746>>55380000
                                                               <<03746>>55382000
         IF ICF55 THEN                                         <<03746>>55384000
            BEGIN                                              <<03746>>55386000
            << Read status message to memory >>                <<03746>>55388000
            TOS := [7/0,1/1,24/0]D;                            <<03746>>55390000
            TOS := [6/0,4/%12,<<CSB bus op; Send word>>        <<03746>>55392000
                    3/7,      <<CSB address of memory module>> <<03746>>55394000
                    3/3];     <<Go busy, Reply expected>>      <<03746>>55396000
            MCMD;                                              <<03746>>55398000
            STATUS := TOS; <<See memory ERS of Status>>        <<03746>>55400000
            MSTATUS := MSTATUS LAND %777;<<Isolate mem size &>><<03746>>55402000
            LSTATUS := LSTATUS LAND %177400;<<NR. array bits>> <<03746>>55404000
            ASSEMBLE(                                          <<03746>>55406000
               LDD STATUS;                                     <<03746>>55408000
               DCSR 11;                                        <<03746>>55410000
               LSL 1;                                          <<03746>>55412000
               STOR NR'BANKS; << NR. OF BANKS >>               <<03746>>55414000
               DEL  );                                         <<03746>>55416000
            PHYS'SIZE := NR'BANKS*64;                          <<03746>>55418000
            END                                                <<03746>>55420000
         ELSE                                                  <<03746>>55422000
            DO BEGIN                                           <<03746>>55424000
             PHYS'SIZE := CORESIZES(INDEX);                    <<03002>>55426000
                                                               <<03002>>55428000
             COMMENT:                                          <<03002>>55430000
             ************************************************* <<03002>>55432000
             BE CAREFUL OF THIS SECTION OF CODE--IT WILL BITE. <<03002>>55434000
             1-INSTRUCTION FOLLOWING SSEA MUST BE LSEA.        <<03002>>55436000
             2-LSEA ISN'T GUARANTEED TO PUSH A VALUE, SO DON'T <<03002>>55438000
               JUST BLINDLY DELETE TOS.                        <<03002>>55440000
             3-THIS CODE IS TIED TO MODERR, SO CHANGE BOTH IF  <<03002>>55442000
               YOU CHANGE EITHER.                              <<03002>>55444000
             ************************************************* <<03002>>55446000
             END OF COMMENT;                                   <<03002>>55448000
                                                               <<03002>>55450000
             TOS := DOUBLE(PHYS'SIZE)*1024D-1D;                <<03002>>55452000
             ASSEMBLE(DDUP);                                   <<03002>>55454000
             TOS := %12345;           <<ARBITRARY PATTERN>>    <<03002>>55456000
             ASSEMBLE( SSEA; LSEA);   <<WRITE THEN READ BACK>> <<03002>>55458000
             IF S0 <> %12345                                   <<03002>>55460000
             THEN BEGIN               <<MEMORY MISSING>>       <<03002>>55462000
                 FOUND'PHYS'SIZE := TRUE;                      <<03002>>55464000
                 PHYS'SIZE := CORESIZES( INDEX-1);             <<03002>>55466000
                 <<THIS WRITE-READ FAILED SO >>                <<03002>>55468000
                 <<LAST INDEX WAS ACTUAL SIZE>>                <<03002>>55470000
                  END                                          <<03002>>55472000
             ELSE BEGIN                                        <<03002>>55474000
                 INDEX := INDEX + 1; <<TRY NEXT SIZE>>         <<03002>>55476000
                 DDEL;DDEL;DEL;      <<REMOVE ADDRS,VAL>>      <<03002>>55478000
              END;                                             <<03002>>55480000
$PAGE "MAINSEG1  --  INITIALIZATION"                                    55482000
         END UNTIL FOUND'PHYS'SIZE OR INDEX>COREX OR           <<03002>>55484000
                   INDEX > MAXCOREX;                           <<03002>>55486000
                                                               <<03002>>55488000
                                                               <<03002>>55490000
         IF KWORDS > PHYS'SIZE                                 <<03002>>55492000
         THEN BEGIN                                            <<03002>>55494000
             MESSAGE(M124);                                    <<03002>>55496000
             <<CONFIGURED MEMORY EXCEEDS PHYSICAL>>            <<03002>>55498000
             MESSAGE(M2412,PHYS'SIZE);                         <<03002>>55500000
             <<PHYSICAL MEMORY AVAILABLE IS XXX>>              <<03002>>55502000
             END                                               <<03002>>55504000
                                                               <<03002>>55506000
         ELSE BEGIN    <<SUFFICIENT PHYS MEM>>                 <<03002>>55508000
             VERIFY'PHYS'MEMORY := TRUE;  <<SUCCESS>>          <<03002>>55510000
                                                               <<03002>>55512000
             IF COREX > CORE256X                               <<03002>>55514000
             THEN CTAB0(COREX') := CORE256X                    <<03002>>55516000
             ELSE CTAB0(COREX') := COREX;                      <<03002>>55518000
             @CTABNC := CTAB0(COREX')&LSL(7) + @CTAB;          <<03002>>55520000
                <<PTR TO NEW CORE SIZE SIZE INFO>>             <<03002>>55522000
             CTAB0(CORESIZE) := KWORDS;                        <<03002>>55524000
             MOVE CTABNC := CTABCC,(CTABSIZE);                 <<03002>>55526000
             @CTABCC := @CTABNC;                               <<03002>>55528000
                <<UPDATE CURRENT CORESIZE CTAB PTR>>           <<03002>>55530000
           END;    <<SUFFICIENT PHYS MEM>>                     <<03002>>55532000
     END;  <<VALID CORESIZE>>                                  <<03002>>55534000
    END;  <<PROCEDURE VERIFY'PHYS'MEMORY>>                     <<03002>>55536000
$CONTROL SEGMENT=MAINSEG1                                               55538000
  PROCEDURE MAINSEG1;                                                   55540000
      BEGIN                                                             55542000
      COMMENT                                                           55544000
        THE TAPE SIO PROGRAM OR DISC COLD LOAD BOOTSTRAP HAS READ THE   55546000
      CONFIGURATION TABLES INTO INITIAL'S DL AREA. AT THIS POINT THE    55548000
      POINTERS TO THE TABLES ARE INITIALIZED. THE AREA IS SET UP        55550000
      AS FOLLOWS (THE UNCHANGED COPY OF THE VOLUME TABLE (OLDVTAB) AND  55552000
      OLD DISC COLD LOAD INFORMATION TABLE (OLDINFO) ARE PRESENT ONLY   55554000
      IF THIS IS A COLD LOAD FROM A TAPE ON WHICH USER FILES WERE       55556000
      DUMPED):                                                          55558000
              CSTAB  => --------------------                            55560000
                        -        CS        -                            55562000
                        -      TABLE       -                            55564000
              DVRTAB => --------------------                            55566000
                        -      DRIVER      -                            55568000
                        -       TABLE      -                            55570000
                LPDT => --------------------                            55572000
                        - LOGICAL-PHYSICAL -                            55574000
                        -  DEVICE TABLE    -                            55576000
                 LDT => --------------------                            55578000
                        -    LOGICAL       -                            55580000
                        -  DEVICE TABLE    -                            55582000
             DVCLTAB => --------------------                            55584000
            (BYTE PTR)  -  DEVICE CLASS    -                            55586000
                        -      TABLE       -                            55588000
                VTAB => --------------------                            55590000
                        -    VOLUME        -                            55592000
                        -     TABLE        -                            55594000
             OLDVTAB => --------------------                            55596000
                        -    UNCHANGED     -                            55598000
                        -   VOLUME TABLE   -                            55600000
             OLDINFO => --------------------                            55602000
                        -  OLD DISC COLD   -                            55604000
                        - LOAD INFO TABLE  -                            55606000
                CTAB => --------------------                            55608000
                        - CURRENT CORESIZE -                            55610000
                        -  CONFIGURATION   -                            55612000
                        -    INFORMATION   -                            55614000
               CTAB0 => --------------------                            55616000
                        -   NON-CORESIZE   -                            55618000
                        -     RELATED      -                            55620000
                        -  CONFIGURATION   -                            55622000
                        -    INFORMATION   -                            55624000
                  DB => -------------------- ;                 <<03603>>55626000
                                                                        55630000
        BYTE ARRAY OPTS(0:8)=PB:="COL","UPD","REL";                     55632000
       INTEGER  TYPE;     << DEVICE TYPE >>                    <<03603>>55636000
        INTEGER SUBTYP;     << DEVICE SUBTYPE >>               <<03550>>55638000
        INTEGER SIZE;       << TEMP >>                         <<03552>>55640000
                                                               <<03557>>55642000
        EQUATE SDISC=31,FDISC=7;                               <<MPEIV>>55644000
        BYTE ARRAY RELOPTS(0:14)=PB:="SPR","COM","RES","ACC","NUL";     55646000
          LOGICAL DSDEVICE;                                             55648000
        INTEGER ARRAY CORESIZES(0:NCORESIZES-1) = PB :=        <<01756>>55650000
        64, 80, 96, 128, 160, 192, 224, 256, 384, 512, 768,    <<01756>>55652000
        1024, 1152, 1280, 1408, 1536, 1664, 1792, 1920, 2048,  <<01756>>55654000
        2176, 2304, 2432, 2560, 2688, 2816, 2944, 3072,        <<01756>>55656000
        3200, 3328, 3456, 3584, 3712, 3840, 3968, 4096;        <<01756>>55658000
                                                               <<01756>>55660000
        DOUBLE ARRAY USEDCORE(0:NCORESIZES-1)=PB:=             <<01384>>55662000
        << LAST ADDRESS+1 FOR GIVEN MEMORY SIZE >>             <<01384>>55664000
        <<64K>>%200000D,   <<80K>>%240000D,                    <<01384>>55666000
        <<96K>>%300000D,   <<128K>>%400000D,                   <<01384>>55668000
        <<160K>>%500000D,  <<192K>>%600000D,                   <<01384>>55670000
        <<224K>>%700000D,  <<256K>>%1000000D,                  <<01384>>55672000
        <<384K>>%1400000D, <<512K>>%2000000D,                  <<01384>>55674000
        <<768K>>%3000000D, <<1024K>>%4000000D,                 <<01756>>55676000
        <<1152>>%4400000D, <<1280K>>%5000000D,                 <<01756>>55678000
        <<1408>>%5400000D, <<1536K>>%6000000D,                 <<01756>>55680000
        <<1664>>%6400000D, <<1792K>>%7000000D,                 <<01756>>55682000
        <<1920>>%7400000D, <<2048K>>%10000000D,                <<01756>>55684000
        <<2176>>%10400000D,<<2304K>>%11000000D,                <<01756>>55686000
        <<2432>>%11400000D,<<2560K>>%12000000D,                <<01756>>55688000
        <<2688>>%12400000D,<<2816K>>%13000000D,                <<01756>>55690000
        <<2944>>%13400000D,<<3072K>>%14000000D,                <<01756>>55692000
        <<3200>>%14400000D,<<3328K>>%15000000D,                <<01756>>55694000
        <<3456>>%15400000D,<<3584K>>%16000000D,                <<01756>>55696000
        <<3712>>%16400000D,<<3840K>>%17000000D,                <<01756>>55698000
        <<3968>>%17400000D,<<4096K>>%20000000D;                <<01756>>55700000
                                                               <<01756>>55702000
                                                               <<03557>>55706000
        INTEGER TEMP;                                          <<00890>>55708000
        LOGICAL IOCHANGES;                                     <<00678>>55710000
                                                               <<03635>>55712000
        INTEGER Q;                                             <<02510>>55722000
        POINTER DVCL;   << WORD POINTER TO CLASS TABLE >>      <<04306>>55724000
        INTEGER ARRAY CLBUF(0:34); << COLD LOAD READ INFO >>   <<02510>>55726000
        INTEGER POINTER CLPNTR;                                <<02510>>55728000
        DOUBLE POINTER CLDPNTR = CLPNTR;                       <<02510>>55730000
        LOGICAL CLSTARFISH;                                    <<02510>>55732000
        LOGICAL ARRAY INITAREA(0:NCORESIZES-1) = PB :=         <<01756>>55734000
          NCORESIZES(0);                                       <<01756>>55736000
        ARRAY SYSDISC'DRT(0:5)=PB :=  <<DEFAULT SYSDISC DRTS>> <<02835>>55738000
          5,4,49,4,89,25;         <<FOR SERIES I,II,33,III, >> <<02835>>55740000
                                  << 44,55                  >> <<02835>>55742000
        DOUBLE ABSLBUF,     << TEMP FOR ABS ADDR OF LBUF >>    <<03557>>55744000
               FSECT,       << START ADDR OF DEFECTIVE AREA >> <<03557>>55746000
               LSECT;       << END ADDR OF DEFECTIVE AREA >>   <<03635>>55748000
                                                               <<03557>>55752000
      LOGICAL VTABCHANGES, DTTCHANGES;                         <<01123>>55754000
                                                               <<03557>>55756000
                                                               <<03557>>55762000
                                                               <<03557>>55764000
      DEFINE  CS80'TYPE = << TRUE IF DEVICE IS A CS80 DISC >>  <<03550>>55766000
              (%(16)200 <= IDENTIFY(SYSDISCDRT) <= %(16)23F)#; <<03550>>55768000
                                                               <<03635>>55788000
      DOUBLE DCOREADDR; <<DOUBLE WORD CORE ADDRESS>>           <<03603>>55790000
      LOGICAL BANK     = DCOREADDR,                            <<03603>>55792000
              COREADDR = DCOREADDR+1;                          <<03603>>55794000
                                                               <<03635>>55796000
      INTEGER POINTER DIRSP';                                  <<03603>>55798000
                                                               <<03635>>55800000
                                                               <<03635>>55802000
                                                               <<MPEIV>>55804000
                                                               <<03001>>55806000
<<=====================================================>>      <<03001>>55808000
                                                               <<03001>>55810000
          <<SET BANK MASK FOR 8 BITS IF ICF 34>>               <<01771>>55812000
                                                               <<01771>>55814000
          ASSEMBLE(CON %020362);                               <<01771>>55816000
          IF TOS=3 THEN                                        <<01771>>55818000
             BEGIN <<ICF34>>                                   <<01771>>55820000
             TOS:=%377; <<BANK MASK>>                          <<01771>>55822000
             ASSEMBLE(CON %20104; CON %4);  << SBM >>          <<01771>>55824000
             END;                                              <<01771>>55826000
                                                               <<01771>>55828000
          IF LOADFROMTAPE THEN                                 <<02510>>55830000
             BEGIN                                             <<02510>>55832000
             << FIRMWARE AREA USED FOR INITIAL'S FLAGS >>      <<02510>>55834000
             ZEROABS( %1400, 32);                              <<02510>>55836000
             CKFORSTARFISH;                                    <<02510>>55838000
             ABSOLUTE(ABSFLAGS).(14:1) := 1; << 7976 NEW REQ >><<02517>>55840000
             END;                                              <<02510>>55842000
          ABS(SYSBASE) := ABS(CSTP)-SYSBASE;                   <<03603>>55844000
          ABS(SYSICS) := ABS(QI)-SYSBASE;                      <<03603>>55846000
                                                               <<03672>>55848000
          CS80'LOCK := FALSE;   << PARAM. FOR CS80'DRIVER-- >> <<03672>>55850000
                                << SHOULD BE SET BEFORE THE >> <<03672>>55852000
                                << FIRST CALL TO THIS DRIVER>> <<03672>>55854000
                                                               <<03672>>55856000
          IF NOT ICF55  <<CAN NOT USE DRTBANK,DRTADDR>>        <<03002>>55860000
          THEN BEGIN    <<SO ZERO TO EFFECTIVELY PUT>>         <<03002>>55862000
            ABSOLUTE(DRTBANK):=0;  <<DRT TAB IN BANK 0 >>      <<03002>>55864000
            ABSOLUTE(DRTADDR):=0;                              <<03002>>55866000
            MAXDRT := 127; <<MAX FOR 7-BIT DRT>>               <<03002>>55868000
            END                                                <<03002>>55870000
          ELSE MAXDRT:= 511;  <<MAXDRT FOR 9-BIT DRT>>         <<03002>>55872000
                                                                        55874000
          TOS := ABS(0)-SIOBUFSIZE;                            <<03603>>55878000
          HCLIMIT := S0;                                       <<03603>>55880000
          ABS(SIOPROG) := S0;                                  <<03603>>55882000
          ABS(CHANPROG) := S0;                                 <<03603>>55884000
          ABS(TAPECHANPROG) := LS0+DISCSIOBUFSIZE;             <<03603>>55886000
          ABS(TERMCHANPROG) := LS0+DISCSIOBUFSIZE+             <<03603>>55888000
             TAPESIOBUFSIZE;                                   <<03603>>55890000
          DEL;                                                 <<03603>>55892000
          PUSH( DB );                                          <<03603>>55894000
          ABSOLUTE(DB) := TOS;                                          55896000
          ABSOLUTE(DBBANK) := TOS;                                      55898000
          <<INITIALIZE BRKPT-TABLE FOR HELP>>                  <<03001>>55900000
          <<------------------------------->>                  <<03001>>55902000
          HELP'INIT'BPTAB;   <<SPECIAL ENTRY-PT INTO HELP>>    <<03603>>55904000
                                                               <<03001>>55906000
          ASSEMBLE( RSW );                                     <<02510>>55910000
          CLRSW := S0.(8:8);                                   <<02510>>55912000
          I := TOS;                                            <<02510>>55914000
          CLSTARFISH := FALSE;                                 <<02510>>55916000
          SYSTAPEDRTUNIT :=                                    <<03002>>55918000
              IF SERIESII'III                                  <<03002>>55920000
              THEN I.RBITE&LSL(7)                              <<03002>>55922000
              ELSE I&LSL(7);                                   <<03002>>55924000
          IF STARFISH AND I.RBITE = ADAPTERDRT THEN            <<02510>>55926000
             BEGIN                                             <<02510>>55928000
             CLSTARFISH := TRUE;                               <<02510>>55930000
             SYSTAPEDRT := I.LBITE;                            <<02510>>55932000
             END;                                              <<02510>>55934000
          TOS := 0; << DL STARTING ADDRESS >>                  <<03603>>55936000
          TOS := TOS-CSDEFSIZE;                                         55938000
          @CSDEF := S0;  <<DEFAULT LINE DESCRIPTORS>>                   55940000
          TOS := TOS-CSDVRTSIZE;                                        55942000
          @CSDVR := S0;  <<EXTRA CS DRIVERS>>                           55944000
          TOS := TOS-CTAB0SIZE;                                         55946000
          @CTAB0  := S0; <<PTR TO CONFIGURATION INFO>>                  55948000
          TOS := TOS-CTABTSIZE;                                         55950000
          @CTAB := S0; <<PTR TO CORESIZE-RELATED INFO TABLE>>           55952000
          TOS := TOS-CTAB0(OLDINFOSIZE);                                55954000
          @OLDINFO := S0;<<PTR TO OLD DISC COLD LOAD INFO>>             55956000
          TOS := TOS-CTAB0(OLDVTABSIZE);                                55958000
          @OLDVTAB := S0; <<PTR TO UNCHANGED VOLUME TABLE>>             55960000
          SETPOINTERS(*); <<SET POINTERS TO REMAINDER OF TABLES>>       55962000
          MEMLOC := SYSBASE;                                   <<03603>>55964000
          ZEROABS( TEMP'CPVA, 8); << INIT CPVA AREA >>         <<02510>>55968000
          <<LENGTH MUST BE ZERO TO APPEASE CHANNEL CODE>>      <<00888>>55970000
          <<WHEN TALKING TO UNIT ZERO>>                        <<00888>>55972000
$IF X1=ON << ******* SERIES 33 UNIQUE ********* >>             <<02510>>55976000
          INITDRT( CONSOLEDRT); << SET UP CONSOLE DRT >>       <<02510>>55978000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>55980000
          BAUDRATE := 0;                                       <<00888>>55982000
          SPEEDSENSE; <<SET UP CONSOLE FOR I/0>>               <<00888>>55984000
          SERIALDISCLOAD := FALSE;  << INITIALIZE >>           <<01119>>55986000
          IF NOT LOADFROMTAPE THEN                             <<00888>>55988000
             BEGIN                                             <<00888>>55990000
             IF LOGICAL(LASTLOADMODE.RLMODE) THEN              <<00888>>55992000
                ERRMESSAGE(M100); << PREVIOUS RELOAD ABORTED >><<01103>>55994000
             IF LOGICAL(LASTLOADMODE.TLMODE) THEN              <<00888>>55996000
                ERRMESSAGE(M101);<<PREVIOUS COLD LOAD ABORTED>><<01103>>55998000
             END                                               <<00888>>56000000
          ELSE                                                 <<00888>>56002000
             BEGIN                                             <<02510>>56004000
             IF CTAB0(SERIALDISCLOAD').LOADTYPE=1 THEN         <<00888>>56006000
                BEGIN << READ FROM SERIAL DISC >>              <<00888>>56008000
                SERIALDISCLOAD:=TRUE;   <<True>>               <<03598>>56010000
                IF CTAB0(SERIALDISCLOAD').LOADDATE=1           <<00888>>56012000
                   THEN FUTURE'DATE:=TRUE;   <<True>>          <<03598>>56014000
                CTAB0(SERIALDISCLOAD'):=0; <<RESET>>           <<00888>>56016000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>56018000
                IF TESTIO(SYSTAPEDRTUNIT.DRTFIELD,             <<03002>>56020000
                          %17400) <> 0 THEN                    <<03002>>56022000
                   ERRMESSAGE(M10);<<COLD LOAD TAPE READ ERROR <<01103>>56024000
                END                                            <<00888>>56026000
             ELSE                                              <<00888>>56028000
                IF NOT CLSTARFISH AND                          <<02510>>56030000
                   TESTIO(SYSTAPEDRT,%16) <> %16 THEN          <<02510>>56032000
                   ERRMESSAGE(M10);<<COLD LOAD TAPE READ ERROR <<01103>>56034000
             IF CLSTARFISH AND                                 <<02510>>56036000
                ABSOLUTE(GETDRT(SYSTAPEDRT,0)-2) <> %600       <<03002>>56038000
                THEN ERRMESSAGE(M10); <<COLD LOAD READ ERROR>> <<02510>>56040000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>56042000
                END;                                           <<00888>>56044000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>56046000
             END;                                              <<02510>>56048000
          IF LOADFROMTAPE THEN                                 <<03603>>56050000
             IF SERIALDISCLOAD THEN                            <<03603>>56052000
                BEGIN                                          <<03603>>56054000
                @TAPEBUF := @LBUF;                             <<03603>>56056000
                END                                            <<03603>>56058000
             ELSE                                              <<03603>>56060000
                BEGIN                                          <<03603>>56062000
                @TAPEBUF := @RECBUF;                           <<03603>>56064000
                END;                                           <<03603>>56066000
          TAPERECSIZE := CTAB0(TAPERECSIZE');                  <<03603>>56068000
          INBUF := %6412;                                               56070000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>56072000
          MOVE BINBUF(2):="HP32002",2;                                  56074000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>56076000
          MOVE BINBUF(2):="HP32033",2;                         <<00888>>56078000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>56080000
          BPS0 := BYTE(CTAB0(VERSION'));                                56082000
          TOS := TOS+1;                                                 56084000
          BPS0 := ".";                                                  56086000
          TOS := TOS+1;                                                 56088000
          TOS := @CTAB0(UPDATEL')&LSL(1);                      <<04306>>56090000
          MOVE *:=*,(2),2;                                              56092000
          BPS0 := ".";                                                  56094000
          DEL;                                                          56096000
          INBUF(7) := CTAB0(FIXLEVEL');                                 56098000
          PRINT(INBUF,8,0);                                             56100000
        <<INITIALIZE DB VARIABLES CHANGED ON PREVIOUS COLD LOAD>>       56102000
                                                               <<03551>>56104000
          ldev'index'to'ldev (0) := -1;                        <<03551>>56106000
          MOVE ldev'index'to'ldev (1) :=                       <<03551>>56108000
               ldev'index'to'ldev (0), (max'disc'drives-1);    <<03551>>56110000
          ldev'of'dt'page'in'buffer := -1;                     <<03551>>56112000
          ldev'of'map'in'buffer := -1;                         <<03551>>56114000
                                                               <<03714>>56116000
          IF LOADFROMTAPE THEN                                 <<03714>>56118000
             BEGIN                                             <<03714>>56120000
                                                               <<03714>>56122000
           << INITIALIZE THE RESERVED AREA BIT MAP.  A '1' >>  <<03714>>56124000
           << MEANS THE SPACE IF FREE.  WE REMOVE SPACE    >>  <<03714>>56126000
           << NOW FOR SECTORS 0-3 (SERIES 33) OR 0-2       >>  <<03714>>56128000
           << (SERIES II/III).  THESE ARE FOR THE DISC     >>  <<03714>>56130000
           << LABEL, THE DTT OR DSCT, AND THE BOOTSTRAP    >>  <<03714>>56132000
           << CHANNEL PROGRAMS.  WE ALSO REMOVE SPACE FOR  >>  <<03714>>56134000
           << THE COLD LOAD INFORMATION TABLE (SECTORS     >>  <<03714>>56136000
           << 28-29), AND THE RESERVED AREA BIT MAP ITSELF >>  <<03714>>56138000
           << (SECTOR 4).                                  >>  <<03714>>56140000
                                                               <<03714>>56142000
             TEMP := -1;                                       <<03714>>56144000
             WHILE (TEMP:=TEMP+1) <                            <<03714>>56146000
                   LDEV'1'RESERVED'AREA'SIZE DO                <<03714>>56148000
                SETBIT(BOOTSPACEMAP,TEMP);                     <<03714>>56150000
                                                               <<03714>>56152000
             CLEARBIT(BOOTSPACEMAP,0);   << RESERVE SECTORS >> <<03714>>56154000
             CLEARBIT(BOOTSPACEMAP,1);   <<     0-2         >> <<03714>>56156000
             CLEARBIT(BOOTSPACEMAP,2);                         <<03714>>56158000
$IF X1=ON  << ********** SERIES 33,44,55 UNIQUE ********** >>  <<03714>>56160000
             CLEARBIT(BOOTSPACEMAP,3);   <<RESERVE SECTOR 3>>  <<03714>>56162000
$IF        << ********* RETURNING TO COMMON CODE ********* >>  <<03714>>56164000
                                                               <<03714>>56166000
           << NOW RESERVE COLD LOAD INFORMATION TABLE >>       <<03714>>56168000
                                                               <<03714>>56170000
             CLEARBIT(BOOTSPACEMAP,INFOSECTOR);                <<03714>>56172000
             CLEARBIT(BOOTSPACEMAP,INFOSECTOR+1);              <<03714>>56174000
                                                               <<03714>>56176000
           <<  RESERVE SPACE FOR THE BOOTSPACEMAP    >>        <<03714>>56178000
           <<     BITMAP                             >>        <<03714>>56180000
                                                               <<03714>>56182000
             CLEARBIT(BOOTSPACEMAP,BOOTSPACE'SECTOR);          <<03714>>56184000
                                                               <<03714>>56186000
             END     << IF LOADFROMTAPE >>                     <<03714>>56188000
                                                               <<03714>>56190000
          ELSE      << BOOTING FROM DISC >>                    <<03714>>56192000
                    << READ IN BOOTSPACEMAP >>                 <<03714>>56194000
                                                               <<03714>>56196000
             DISC(READ,SYSDISC,DOUBLE(BOOTSPACE'SECTOR),       <<03714>>56198000
                  BOOTSPACEMAP,                                <<03714>>56200000
                  (LDEV'1'RESERVED'AREA'SIZE+15)/16);          <<03714>>56202000
                                                               <<03714>>56204000
          RECOVERY := FALSE;                                            56206000
          INITLOGONDST := FALSE;                                        56208000
          ZEROBUF( REASSIGNED, (MAX'REASS+1)*5);               <<03714>>56212000
          NREASS := 0;                                         <<03714>>56214000
          RELOAD := FALSE;                                              56216000
          ACCTSONLY := FALSE;                                           56218000
          LOADMAP := FALSE;                                             56220000
          CHANGES := FALSE;                                             56222000
          SECONDPASS := FALSE;                                          56224000
          IF LOADFROMTAPE THEN                                          56226000
            BEGIN  <<COLD LOAD WAS FROM MAG TAPE>>                      56228000
  REQOPT:     MESSAGE(-M2001);<<WHICH OPTION<COLDSRT/RELOAD/UPD<<01103>>56230000
              READINPUT;                                                56232000
              GETSTR(BBUF,@REQOPT,1,9);  <<GET ANSWER>>                 56234000
              OPT := 0;                                                 56236000
              DO IF BBUF=OPTS(3*OPT),(3) THEN GO OPTOK                  56238000
              UNTIL (OPT:=OPT+1)=NOPT;                                  56240000
            <<ILLEGAL OPTION SPECIFIED>>                                56242000
              MESSAGE(M2453);                                  <<01103>>56244000
              GO REQOPT;                                                56246000
  OPTOK:      OPT := OPT+COLD; <<FIRST OF THE TAPELOAD OPTIONS>>        56248000
              IF OPT=REL THEN   <<RELOAD>>                              56250000
              IF CTAB0(FILESDUMPED)=0 THEN                              56252000
                BEGIN <<NO USER FILES ON TAPE>>                         56254000
                  GETYESNO(@REQOPT,M2275); <<NO USER FILES ON TAPE;     56256000
                                             DO YOU WANT TO RELOAD?>>   56258000
                  GO SPR; <<RELOAD WITH NO FILES DEFAULTS TO SPREAD>>   56260000
                END                                                     56262000
              ELSE                                                      56264000
                BEGIN  <<FILES ON TAPE>>                                56266000
  REQRELOPT:      MESSAGE(-M2002);<<WHICH OPTION <SPREAD/COMPACT/       56268000
                                   RESTORE/ACCOUNTS/NULL>?>>            56270000
                  READINPUT;                                            56272000
                  SCAN BINBUF WHILE BLANK;                              56274000
                  IF CARRY THEN GOTO SPR;  <<DEFAULT IS SPREAD>>        56276000
                  GETSTR(BBUF,@REQRELOPT,1,8); <<GET ANSWER>>           56278000
                  I := 0;                                               56280000
                  DO IF BBUF=RELOPTS(3*I),(3) THEN GO RELOPTOK          56282000
                  UNTIL (I:=I+1)=NRELOPTS;                              56284000
                <<ILLEGAL OPTION INPUT>>                                56286000
                  MESSAGE(M2453);                              <<01103>>56288000
                  GO REQRELOPT;                                         56290000
  RELOPTOK:       IF I-NRELOPTS+2=0 THEN ACCTSONLY:=TRUE  <<ACCOUNTS>>  56292000
                  ELSE IF > THEN CTAB0(FILESDUMPED):=0 <<NULL>>         56294000
                  ELSE OPT := OPT+I;  <<SPREAD,COMPACT OR RESTORE>>     56296000
  SPR:            RELOAD := TRUE;                                       56298000
                END;                                                    56300000
              IF UPDATE THEN                                            56302000
                BEGIN  <<READ TABLES FROM SYSTEM DISC>>                 56304000
                  <<GET DEFAULT SYSTEM DISC DRT ON THIS CPU>>  <<02835>>56308000
                  SYSDISCDRT := SYSDISC'DRT( THISCPU);         <<02835>>56310000
  REQSYSDISC:     GETNEWVAL(M2003,SYSDISCDRT,LOWESTDRT,MAXDRT);<<03002>>56312000
                  <<SYSTEM DISC DRT#?>>                        <<00071>>56314000
                  IF SYSDISCDRT=SYSTAPEDRT THEN                <<SD.00>>56316000
                     BEGIN <<CONFLICT--2 UNITS AS UNIT ZERO>>  <<SD.00>>56318000
                     MESSAGE(M2401); <<WARNING--SYSTEM DISC AND<<01103>>56320000
                     <<COLDLOAD UNIT ARE ON SAME DRT. SYSTEM>> <<SD.00>>56322000
                     <<DISC MUST BE ONLY UNIT ZERO ON THIS>>   <<SD.00>>56324000
                     <<DRT.>>                                  <<SD.00>>56326000
                     MESSAGE(M2329);<<MAKE UNIT # CHANGES NOW>><<01103>>56328000
                     DO UNTIL LGETYESNO(M2332); <<READY?>>     <<01103>>56330000
                     SYSTAPEUNIT:=GETVAL(M2328,0,7,1);<<COLD>> <<03603>>56332000
                     <<LOAD UNIT NUMBER>>                      <<SD.00>>56334000
                     END;  <<CONFLICT--2 UNITS AS UNIT ZERO>>  <<SD.00>>56336000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>56338000
         TOS := SYSDISCDRT;                                    <<02510>>56342000
         ASSEMBLE( TIO 0 );                                    <<02510>>56344000
         IF <> THEN                                            <<02510>>56346000
            IF STARFISH THEN GO HPIB'DISC                      <<02510>>56348000
         ELSE                                                  <<02510>>56350000
            GO BADSDISC;                                       <<02510>>56352000
         IF TOS > 0 THEN GO BADSDISC;                          <<02510>>56354000
         BUF := %14000;    << SET BANK >>                      <<03603>>56356000
         BUF(1) := ABS(DBBANK);                                <<03603>>56358000
         BUF(2) := SIOCNTRL;                                   <<03603>>56360000
         BUF(3) := 0;      << COLD LOAD READ OPCODE >>         <<03603>>56362000
READSECT0:                                                     <<02510>>56364000
         BUF(4) := (-128) LAND %77777;                         <<03603>>56366000
         BUF(5) := ABS(DB)+@LBUF;                              <<03603>>56368000
         BUF(6) := SIOEND;                                     <<03603>>56370000
         BUF(7) := 0;                                          <<03603>>56372000
         MABS( 0,ABS(SIOPROG),ABS(DBBANK),ABS(DB)+@BUF,8);     <<03603>>56374000
         EXECUTESIO(SYSDISCDRT,ABS(SIOPROG));                  <<03603>>56376000
         SYSDISCTYPE := LBUF(LAB6).LABDTYPE;                   <<02510>>56380000
         SYSDISCSUBTYPE := LBUF(LAB6).LABDSUBTYPE;             <<02510>>56382000
         IF LBUF = 0 OR BLBUF(LABSYSID) <> "3000" THEN         <<03603>>56384000
            IF SYSDISCTYPE=MHDISCTYPE AND (SYSDISCSUBTYPE      <<02510>>56386000
               =UH7900 OR SYSDISCSUBTYPE=UH7905) THEN          <<02510>>56388000
               BEGIN                                           <<02510>>56390000
               BUF(1) := %200; <<READ FROM HEAD 2>>            <<02510>>56392000
               GO READSECT0;                                   <<02510>>56394000
               END                                             <<02510>>56396000
            ELSE                                               <<02510>>56398000
               GO BADSDISC;                                    <<02510>>56400000
         GO FOUND'SDISC;                                       <<02510>>56402000
$IF  << ************* RETURNING TO COMMON CODE *********** >>  <<02510>>56404000
HPIB'DISC:                                                     <<02510>>56406000
       INITDRT( SYSDISCDRT);                                   <<03550>>56408000
       IF CS80'TYPE THEN    << DEVICE ON SYSDISCDRT IS >>      <<03550>>56410000
         BEGIN              << A CS'80 DISC            >>      <<03550>>56412000
         PUSH(DB);             << GET ABSOLUTE ADDRESS >>      <<03550>>56414000
         TOS := TOS + @LBUF;   << OF THE READ BUFFER   >>      <<03550>>56416000
         ABSLBUF := TOS;                                       <<03550>>56418000
                                                               <<03672>>56420000
         CS80'DRIVER( 0,SYSDISCDRT&LSL(7),2,     << INIT.   >> <<03672>>56422000
                       INIT'DEV,0D,ABSLBUF,2);   <<  DEVICE >> <<03715>>56424000
         CS80'DRIVER( 0,SYSDISCDRT&LSL(7),2,   << READ DISC >> <<03672>>56426000
                    NON'FATAL'READ,0D,ABSLBUF,128); <<LABEL >> <<03550>>56428000
         IF < THEN GO BADSDISC;  << UNABLE TO READ LABEL    >> <<03550>>56430000
                                 << MUST NOT BE SYSTEM DISC >> <<03550>>56432000
         END                                                   <<03550>>56434000
                                                               <<03550>>56436000
       ELSE              << MUST BE A TYPE 0 DISC >>           <<03550>>56438000
         BEGIN           << TRY TO READ THE DISC LABEL >>      <<03550>>56440000
         BUF(34):=0; <<HEAD ZERO/SECTOR ZERO>>                 <<02510>>56442000
RETRY:                                                         <<02510>>56444000
                                                               <<02510>>56446000
         MOVE BUF := (                                         <<03603>>56450000
     << 0>>  %4400,0,            << CLEAR         >>           <<03603>>56452000
     << 2>>  %2010,6,0,0,0,      << SEEK          >>           <<03603>>56454000
     << 7>>  %1000,0,            << WAIT          >>           <<03603>>56456000
     << 9>>  %2010,2,0,0,0,      << SET FILE MASK >>           <<03603>>56458000
     <<14>>  %1000,0,            << WAIT          >>           <<03603>>56460000
     <<16>>  %2010,2,0,0,0,      << READ COMMAND  >>           <<03603>>56462000
     <<21>>  %1400,256,0,0,0,    << READ DATA     >>           <<03603>>56464000
     <<26>>  %1000,0,            << WAIT          >>           <<03603>>56466000
     <<28>>  %600,0,             << END,INT       >>           <<03603>>56468000
     <<30>>  %2400,              << READ COMMAND  >>           <<03603>>56470000
     <<31>>  %7407,              << FILE MASK     >>           <<03603>>56472000
     <<32>>  %1000,              << SEEK COMMAND  >>           <<03603>>56474000
     <<33>>      0);             << CYLINDER ZERO >>           <<03603>>56476000
         BUF(6) := ABS(CHANPROG)+32;                           <<03603>>56478000
         BUF(13) := ABS(CHANPROG)+31;                          <<03603>>56480000
         BUF(20) := ABS(CHANPROG)+30;                          <<03603>>56482000
         BUF(24) := ABS(DBBANK);                               <<03603>>56484000
         BUF(25) := ABS(DB)+@LBUF;                             <<03603>>56486000
         MABS( 0,ABS(CHANPROG),ABS(DBBANK),ABS(DB)+@BUF,35);   <<03603>>56488000
         EXECUTESIOP(SYSDISCDRT,ABS(CHANPROG));                <<03603>>56490000
         END;                                                  <<03550>>56492000
                                                               <<03550>>56494000
         SYSDISCTYPE := LBUF(LAB6).LABDTYPE;                   <<02510>>56498000
         SYSDISCSUBTYPE := LBUF(LAB6).LABDSUBTYPE;             <<02510>>56500000
         IF (STARFISH LAND LBUF=0) LOR                         <<02510>>56502000
            (NOT STARFISH LAND BLBUF <> "SYSTEM DISC") LOR     <<03603>>56504000
            (BLBUF(LABSYSID) <> "3000") THEN                   <<03603>>56506000
            IF BUF(34) = %1000 OR CS80'TYPE THEN               <<03550>>56508000
               BEGIN     << THIS IS NOT THE SYSTEM DISC >>     <<03550>>56510000
BADSDISC:      MESSAGE(M106);   << PRINT ERROR MESSAGE  >>     <<03550>>56512000
               GO REQSYSDISC;   << AND RE-REQUEST THE   >>     <<03550>>56514000
               END              << THE SYSTEM DISC DRT  >>     <<03550>>56516000
            ELSE                                               <<02510>>56518000
               BEGIN <<COULD BE LOWER HALF OF 7906>>           <<02510>>56520000
               BUF(34) := %1000; <<HEAD TWO/SECTOR ZERO>>      <<02510>>56522000
               GO RETRY;                                       <<02510>>56524000
               END;                                            <<02510>>56526000
FOUND'SDISC:                                                   <<02510>>56528000
                  READTABLE(D'L(INFOSECTOR)),INFO,INFOSIZE);   <<00.DL>>56530000
                  @TABLEINFO := @INFO+INFO(TABPTR);                     56532000
IF INFO(TABPTR) = 40 THEN CONVERTOLOG:=TRUE ELSE                        56534000
CONVERTOLOG:=FALSE;                                                     56536000
                  TOS := CTAB0(OLDINFOSIZE); <<SIZE OF TABLE IN CORE>>  56538000
                  TOS := CTAB0(OLDVTABSIZE);                            56540000
                  TOS := CTAB0(FIXLEVEL');                              56542000
              TOS := CTAB0(UPDATEL');                                   56544000
              TOS := CTAB0(VERSION');                                   56546000
                  TOS := CTAB0(MAXINITSEG');                            56548000
                  TOS := CTAB0(DISCENTRY');                             56550000
                  TOS := CTAB0(MITVERSION);                    <<00931>>56552000
                  TOS := CTAB0(MITUPDATE);                     <<00931>>56554000
                  TOS := CTAB0(MITFIX);                        <<00931>>56556000
                  READTABLE(TABLEINFO(CTAB0INFOX+1),CTAB0,CTAB0SIZE);   56558000
                  CTAB0(MITFIX) := TOS;                        <<00931>>56560000
                  CTAB0(MITUPDATE) := TOS;                     <<00931>>56562000
                  CTAB0(MITVERSION) := TOS;                    <<00931>>56564000
                  CTAB0(DISCENTRY') := TOS;                             56566000
                  CTAB0(MAXINITSEG') := TOS;                            56568000
              CTAB0(VERSION') := TOS;                                   56570000
              CTAB0(UPDATEL') := TOS;                                   56572000
                  CTAB0(FIXLEVEL') := TOS;                              56574000
                  CTAB0(OLDVTABSIZE) := TOS;                            56576000
                  CTAB0(OLDINFOSIZE) := TOS;                            56578000
                  READTABLE(TABLEINFO(CTABINFOX+1),CTAB,CTABTSIZE);     56580000
                  SETPOINTERS(@OLDVTAB);<<ADJUST DL PTRS FOR NEW SIZES>>56582000
          READTABLE(TABLEINFO(CSDEFINFOX+1),CSDEF,CSDEFSIZE);           56584000
          READTABLE(TABLEINFO(CSDVRINFOX+1),CSDVR,CSDVRTSIZE);          56586000
          READTABLE(TABLEINFO(CSTABINFOX+1),CSTAB,CTAB0(CSTABSIZE));    56588000
                  READTABLE(TABLEINFO(LDTXINFOX+1),LDTX,(HLDEV+1)       56590000
                            *LDTXSIZE);<<LDT EXTENSION>>       <<00071>>56592000
                  @DVCL := WORDADDRESS(DVCLTAB);               <<04306>>56594000
                  READTABLE(TABLEINFO(DVCLINFOX+1),DVCL,       <<04306>>56596000
                            DVCLSIZE&LSR(1));                  <<00.02>>56598000
                  READTABLE(TABLEINFO(LDTINFOX+1),LDT,(HLDEV+1)         56600000
                            *LDTSIZE); <<LOGICAL DEVICE TABLE>>         56602000
                  READTABLE(TABLEINFO(LPDTINFOX+1),LPDT,(HLDEV+1)       56604000
                            *LPDTSIZE); <<LOGICAL-PHYSICAL DEV TABLE>>  56606000
                  READTABLE(TABLEINFO(DVRINFOX+1),DVRTAB,(HLDEV+1)      56608000
                            *DVRSIZE); <<DRIVER TABLE>>                 56610000
                  IF CTAB0(ID0).DRTCNVRT = 0                   <<03002>>56612000
                                                               <<03002>>56614000
                     << IF THE CONVERSION BIT IN CTAB0      >> <<03002>>56616000
                     << IS SET, THEN IT IS ALREADY IN 9-BIT >> <<03002>>56618000
                     << DRT FORMAT, OTHERWISE IT IS 7-BIT   >> <<03002>>56620000
                     << DRT AND THE DRIVER TABLE MUST BE    >> <<03002>>56622000
                     << REFORMATTED TO 9-BIT DRT FORMAT     >> <<03002>>56624000
                  THEN BEGIN  <<DS BIT,DRT,UNIT CHANGE>>       <<03002>>56626000
                      LDEV:= 1;   <<CHECK EACH LDEV>>          <<03002>>56628000
                      @DVRENT:=@DVRTAB(LDEV*DVRSIZE);          <<03002>>56630000
                      DO BEGIN   <<LOOP THRU DVRTAB>>          <<03002>>56632000
                         IF DVRENT < 0  <<OLD DS-DEVICE>>      <<03002>>56634000
                         THEN DVRENT(DVR1).DSBIT:=1            <<03002>>56636000
                              <<SET NEW DS-BIT IN NEXT WORD>>  <<03002>>56638000
                         ELSE BEGIN                            <<03002>>56640000
                             DVRENT(DVR1).DSBIT:=0;            <<03002>>56642000
                              <<CLEAR NEW DS-BIT>>             <<03002>>56644000
                             DVRENT.DRTFIELD := DVRENT.(1:7);  <<03002>>56646000
                              <<LOAD NEW 9-BIT DRT WITH>>      <<03002>>56648000
                              <<OLD 7-BIT VALUE. THIS ALSO>>   <<03002>>56650000
                              <<REDUCES UNIT TO PROPER 7-BIT>> <<03002>>56652000
                          END;                                 <<03002>>56654000
                         @DVRENT:=@DVRENT+DVRSIZE;             <<03002>>56656000
                         LDEV:=LDEV+1;  <<ADVANCE TO NEXT>>    <<03002>>56658000
                      END UNTIL LDEV > HLDEV;                  <<03002>>56660000
                     CTAB0(ID0).DRTCNVRT := 1;                 <<03002>>56662000
                  END; <<IF OLD'DVRTAB'FORMAT>>                <<03002>>56664000
                                                               <<03004>>56666000
                  IF CTAB0(ID0).LYNXCNVRT = 0 THEN             <<03004>>56668000
                     << IF LYNX CONVERSION BIT IN CTAB0 IS >>  <<03004>>56670000
                     << NOT SET, THEN CONVERT THE NO. OF   >>  <<03004>>56672000
                     << TERMINAL BUFFERS ( CTAB(TBUFNUM) ) >>  <<03004>>56674000
                     << TO THE NO. OF TERMINAL BUFFERS PER >>  <<03004>>56676000
                     << PORT.  TERMCOUNT RETURNS THE NO. OF>>  <<03004>>56678000
                     << TERMINALS CONFIGURED IN THE SYSTEM >>  <<03004>>56680000
                     BEGIN                                     <<03004>>56682000
                     << SET POINTER TO CURRENT CTAB RECORD >>  <<03004>>56684000
                     COREX := CTAB0(COREX');                   <<03004>>56686000
                     @CTABCC := @CTAB( ( IF COREX<CORE256X     <<03004>>56688000
                       THEN COREX ELSE CORE256X)&LSL(7));      <<03004>>56690000
                     << DIVIDE NO. OF TBUFS BY NO. OF    >>    <<03004>>56692000
                     << TERMINALS TO GET TBUFS/PORT      >>    <<03004>>56694000
                     I := TERMCOUNT( FALSE);                   <<03004>>56696000
                     IF I <= 0 THEN I := 1;                    <<03004>>56698000
                     CTABCC(TBUFNUM) :=                        <<03004>>56700000
                       ( CTABCC(TBUFNUM) +I-1)/I;              <<03004>>56702000
                     IF CTABCC(TBUFNUM) > PERPORTMAX THEN      <<03004>>56704000
                        CTABCC(TBUFNUM) := PERPORTMAX;         <<03004>>56706000
                     CTAB0(ID0).LYNXCNVRT := 1;                <<03004>>56708000
                     END;                                      <<03004>>56710000
                                                               <<03004>>56712000
                END;  <<UPDATE>>                               <<SD.00>>56714000
            END  <<COLDLOAD WAS FROM MAGTAPE>>                 <<SD.00>>56716000
          ELSE                                                          56718000
   REQCOOL:BEGIN                                                        56720000
           MESSAGE(-M2000);<<WHICH OPTION WARMSTART/COOLSTART>><<01103>>56722000
           WRITECHAR(17);         <<DC1>>                      <<01423>>56724000
           READINPUT;                                                   56726000
           GETSTR(BBUF,@REQCOOL,1,9);                                   56728000
           IF BBUF="WAR" THEN OPT:=WARM                                 56730000
             ELSE IF BBUF="COO" THEN OPT:=COOL                          56732000
                  ELSE BEGIN                                            56734000
                       MESSAGE(M2453);                         <<01103>>56736000
                       GO REQCOOL;                                      56738000
                       END;                                             56740000
            END;                                                        56742000
          PUSH( DL );                                          <<03675>>56746000
          @DIRSP := S0;                                        <<03675>>56748000
          @DIR := S0;                                          <<03675>>56750000
          @SEGT := TOS;                                        <<03675>>56752000
          COREX := CTAB0(COREX'); <<CORESIZE INDEX>>                    56754000
          @CTABCC := @CTAB( (IF COREX<CORE256X THEN COREX ELSE <<01384>>56756000
            CORE256X)&LSL(7));  << PTR TO CURRENT CTAB TABLE >><<01384>>56758000
          LOGGING := CTAB0(LOGBITS).(15:1);  <<TRUE IF LOGGING IS ON>>  56760000
          IF OPT=REL OR OPT=COLD THEN INITLOGONDST:=TRUE;               56762000
                                                               <<03002>>56766000
          IF WARMSTART     <<NORMALLY, NO CHANGES ALLOWED>>    <<03002>>56768000
                           <<BUT WE MUST CONFIRM PHYSICAL>>    <<03002>>56770000
                           <<MEMORY IS SUFFICIENT>>            <<03002>>56772000
          THEN GOTO TEST'PHYS'MEM;                             <<03002>>56774000
                                                               <<03002>>56776000
          IF LGETYESNO (M2005)     <<ANY CHANGES? >>           <<03002>>56778000
          THEN CHANGES := TRUE                                 <<03002>>56780000
          ELSE BEGIN       <<NO CHANGES REQUESTED, BUT >>      <<03002>>56782000
                           <<WE MUST CONFIRM PHYSICAL >>       <<03002>>56784000
                           <<MEMORY IS SUFFICIENT>>            <<03002>>56786000
                                                               <<03002>>56788000
TEST'PHYS'MEM:                                                 <<03002>>56790000
              TEMP := CTAB0( CORESIZE);                        <<03002>>56792000
                                                               <<03002>>56794000
              IF NOT VERIFY'PHYS'MEM (TEMP)                    <<03002>>56796000
              THEN DO BEGIN                                    <<03002>>56798000
                   TEMP := CTAB0(CORESIZE);                    <<03002>>56800000
                   GETNEWVAL(M2007,TEMP,128,4096);             <<03002>>56802000
                     <<MEMORY SIZE = XXX?>>                    <<03002>>56804000
                   END UNTIL VERIFY'PHYS'MEM(TEMP);            <<03002>>56806000
                                                               <<03002>>56808000
                           <<NOW, SINCE THIS IS A >>           <<03002>>56810000
                           <<WARMSTART OR NO CHANGES>>         <<03002>>56812000
                           <<WE JUMP TO IOCHECK>>              <<03002>>56814000
              GOTO IOCHECK;  <<SKIP CHANGES>>                  <<03002>>56816000
          END;  <<NO CHANGES DESIRED>>                         <<03002>>56818000
                                                               <<03002>>56820000
                           <<HERE WE BEGIN NORMAL>>            <<03002>>56822000
                           << "CHANGES" SEQUENCE>>             <<03002>>56824000
                                                               <<03002>>56826000
          IF LGETYESNO( M2006)   <<LOAD MAP?>>                 <<03002>>56828000
          THEN LOADMAP := TRUE;                                <<03002>>56830000
                                                               <<03002>>56832000
          DO BEGIN                                             <<03002>>56834000
          TEMP := CTAB0(CORESIZE);                             <<03002>>56836000
          GETNEWVAL(M2007,TEMP,128,4096);                      <<03002>>56838000
            <<MEMORY SIZE = XXX?>>                             <<03002>>56840000
          END UNTIL VERIFY'PHYS'MEM(TEMP);                     <<03002>>56842000
                                                               <<MPEIV>>56848000
  REQIOC: IOCHANGES:=FALSE;                                    <<00678>>56850000
REQOLIO:WHILE LGETYESNO(M2008) DO IOCHANGE;                    <<MPEIV>>56852000
        << I/O CONFIGURATION CHANGES? >>                       <<MPEIV>>56854000
IOCHECK:CHECKDEV(@REQOLIO);                                    <<MPEIV>>56856000
$PAGE "MAINSEG1 -- SET UP DISC COLD LOAD INFORMATION TABLE"             56858000
          SYSDISCTYPE := LDT(LDTSIZE+LDT2).TYP;                         56860000
          SYSDISCSUBTYPE := LPDT(LPDTSIZE+LPDT1).SUBTYPE;               56862000
          SYSDISCDRT := DVRTAB(DVRSIZE).DRTFIELD;              <<03002>>56864000
<< BEGIN CSLDTX EXPANSION FOR SHOWCOMINFO AREA>>               <<01165>>56866000
         @CSLDTX:=@CSTAB + CSXSTART;                           <<01165>>56868000
         FOR J:=1 UNTIL CSTAB(CSLDTXENTNUM) DO                 <<01165>>56870000
            BEGIN                                              <<01165>>56872000
            IF NOT(LOGICAL(CSLDTXEXP)) THEN                    <<01165>>56874000
               BEGIN                                           <<01165>>56876000
               CSTABINCR:=CSSHOWCOMLEN;                        <<01165>>56878000
               MOVEDLTABLES;                                   <<01165>>56880000
               @CSLDTX:=@CSLDTX-CSSHOWCOMLEN;                  <<01165>>56882000
               FOR I:=CSTAB(COMSYSLEN)-(@CSLDTX(CSSHOWCOMINFO)-<<01165>>56884000
                      @CSTAB-1) STEP -1 UNTIL 0 DO             <<01165>>56886000
                  CSLDTX(I+CSSHOWCOMINFO+CSSHOWCOMLEN):=       <<01165>>56888000
                     CSLDTX(I+CSSHOWCOMINFO);                  <<01165>>56890000
               FOR I:=0 UNTIL CSSHOWCOMLEN-1 DO                <<01165>>56892000
                  CSLDTX(CSSHOWCOMINFO+I):=0;                  <<01165>>56894000
               IF CSLDTXCONTPTR <> 0 THEN                      <<01165>>56896000
                  CSLDTXCONTPTR:=CSLDTXCONTPTR+CSSHOWCOMLEN;   <<01165>>56898000
               IF CSLDTXPHLISTPTR <> 0 THEN                    <<01165>>56900000
                 CSLDTXPHLISTPTR:=CSLDTXPHLISTPTR+CSSHOWCOMLEN;<<01165>>56902000
               IF CSLDTXIDLISTPTR <> 0 THEN                    <<01165>>56904000
                 CSLDTXIDLISTPTR:=CSLDTXIDLISTPTR+CSSHOWCOMLEN;<<01165>>56906000
               CSLDTXEXP:=1;  <<SET EXPANDED FLAG>>            <<01165>>56908000
               CSTAB(COMSYSLEN):=CSTAB(COMSYSLEN)+CSSHOWCOMLEN;<<01165>>56910000
               CSLDTXENTRYSIZE:=CSLDTXENTRYSIZE+CSSHOWCOMLEN;  <<01165>>56912000
               END;                                            <<01165>>56914000
            CSLDTX'DEV'OPENED := 0;                            <<01165>>56916000
            IF LDT(CSLDTXLDEV*LDTSIZE+LDT2).TYP=CSDEV17 THEN   <<01165>>56918000
               CSLDTX'DEV'DUMPED:=0;                           <<01165>>56920000
            @CSLDTX:=@CSLDTX + CSLDTXENTRYSIZE;                <<01165>>56922000
            END;                                               <<01165>>56924000
<<END CSLDTX EXPANSION FOR SHOWCOMINFO AREA>>                  <<01165>>56926000
IF LOADFROMTAPE THEN                                           <<SD.00>>56928000
  IF SERIALDISCLOAD THEN                                       <<03598>>56930000
    BEGIN <<TAPELOAD FROM SERIAL DISC>>                        <<SD.00>>56932000
    IF SYSTAPEDRT=DVRTAB(DVRSIZE).DRTFIELD AND                 <<DL002>>56934000
    SYSTAPEUNIT=0 THEN                                         <<00071>>56936000
       BEGIN <<ON SAME DRT COULD BE TROUBLE>>                  <<00071>>56938000
       IF LPDT(LPDTSIZE+LPDT1).SUBTYPE=LH7906 THEN             <<00071>>56940000
          BEGIN <<USING SPLIT 7906 --THIS IS TROUBLE>>         <<00071>>56942000
          GETYESNO(@GETUNIT,M2004);<<LOAD FROM TOP OF 06>>     <<01103>>56944000
          GOTO SETLDEV; <<YES-THEREFORE UNIT# IS ZERO>>        <<00071>>56946000
          <<AND USER SHOULDN'T HAVE BEEN CHANGING THE>>        <<00071>>56948000
          <<UNIT #'S ON THE DRIVES>>                           <<00071>>56950000
          END   <<USING SPLIT 7906>>                           <<00071>>56952000
       ELSE                                                    <<00071>>56954000
          BEGIN <<USING THE ENTIRE DRIVE AS SYSDISC>>          <<00071>>56956000
GETUNIT:  MESSAGE(M2401); <<WARNING-ON SAME DRT & UNIT>>       <<01103>>56958000
          MESSAGE(M2329); <<MAKE CHANGES NOW>>                 <<01103>>56960000
          DO UNTIL LGETYESNO(M2332);  <<READY?>>               <<01103>>56962000
          SYSTAPEUNIT:=GETVAL(M2328,1,7,1); <<NEW UNIT#>>      <<01103>>56964000
          END;  <<USING THE ENTIRE DRIVE>>                     <<00071>>56966000
       END;  <<ON SAME DRT>>                                   <<00071>>56968000
    END;                                                       <<01119>>56970000
    << GET LOAD DEVICE LDEV, TYPE & SUBTYPE >>                 <<01119>>56972000
SETLDEV: SYSTAPELDEV:=0;                                       <<00071>>56974000
  IF LOADFROMTAPE THEN                                         <<01119>>56976000
    << IF SYSTAPELDEV POINTS TO A DISC THEN THAT DISC CANNOT >><<01119>>56978000
    << BE ADDED TO THE SYSTEM DOMAIN UNLESS IT HAS ALREADY   >><<01119>>56980000
    << BEEN INITIALIZED.  THEREFORE, INITIALIZE THESE SILLY  >><<01119>>56982000
    << VARIABLES UNLESS WARM/COOL START WHEN NO ONE CARES!!  >><<01119>>56984000
    DO                                                         <<SD.00>>56986000
      BEGIN <<FIND VALID SYSTAPELDEV>>                         <<SD.00>>56988000
      I:=0;                                                    <<SD.00>>56990000
      WHILE (I:=I+1)<=HLDEV DO                                 <<SD.00>>56992000
        IF DVRTAB(I*DVRSIZE)=SYSTAPEDRTUNIT THEN               <<SD.00>>56994000
          SYSTAPELDEV:=I;                                      <<SD.00>>56996000
      IF SYSTAPELDEV=0 THEN                                    <<SD.00>>56998000
        MESSAGE(M2400); <<WARNING-NOT IN I/O CONFIGURATION>>   <<01103>>57000000
      IF SYSTAPELDEV=1 THEN                                    <<SD.00>>57002000
        MESSAGE(M2401); <<WARNING-ON SAME DRT & UNIT>>         <<01103>>57004000
      IF SYSTAPELDEV < 2 AND SERIALDISCLOAD THEN               <<01119>>57006000
         BEGIN <<INVALID LDEV>>                                <<SD.00>>57008000
         MESSAGE(M2329); <<MAKE CHANGES NOW>>                  <<01103>>57010000
         DO UNTIL LGETYESNO(M2332); <<READY?>>                 <<01103>>57012000
         SYSTAPEUNIT:=GETVAL(M2328,0,7,1); <<NEW UNIT #>>      <<01103>>57014000
         END;  <<INVALID LDEV>>                                <<SD.00>>57016000
      END   <<FIND VALID SYSTAPELDEV>>                         <<SD.00>>57018000
    UNTIL NOT SERIALDISCLOAD OR SYSTAPELDEV >= 2;              <<01119>>57020000
    SYSTAPESTYPE:=LPDT(SYSTAPELDEV*LPDTSIZE+LPDT1).SUBTYPE;    <<SD.00>>57022000
    SYSTAPETYPE:=LDT(SYSTAPELDEV*LDTSIZE+LDT2).TYP;            <<00071>>57024000
            <<SET UP DRTS FOR DISCS AND COLDLOAD DEV>>         <<00888>>57048000
            I:=1;                                              <<00888>>57050000
            DO                                                 <<00888>>57052000
               BEGIN <<DRT FOR EACH DISC>>                     <<00888>>57054000
               @LDTENT:=@LDT(I*LDTSIZE);                       <<00888>>57056000
               IF NON'DS'LDEV(I) AND                           <<03550>>57058000
                 LDTENT(LDT2).RANGE = DIRACCESS THEN           <<04262>>57060000
                  BEGIN                                        <<03550>>57064000
                  INITDRT( DVRTAB(I*DVRSIZE).DRTFIELD);        <<02510>>57068000
                                                               <<03550>>57070000
                  END;                                         <<03550>>57086000
               END                                             <<00888>>57088000
            UNTIL (I:=I+1)>HLDEV;                              <<00888>>57090000
                                                               <<03672>>57092000
            << MAKE SYSTEM DISC READY TO TALK TO >>            <<03672>>57094000
            DISC(INIT'DEV,SYSDISC,0D,DTEMP,2);                 <<03672>>57096000
                                                               <<03672>>57098000
          IF LOADFROMTAPE THEN                                 <<04580>>57100000
            INITDRT( SYSTAPEDRT); << COLDLOAD DEV >>           <<02510>>57104000
          IF NOT SECONDPASS THEN                                        57106000
            BEGIN  <<SET UP COLD LOAD INFORMATION TABLE>>               57108000
              IF RELOAD THEN                                            57110000
                BEGIN  <<INITIALIZE TABLE>>                             57112000
                  ZEROBUF(INFO,INFOSIZE);                      <<03549>>57122000
                  INFO(COLD'LOAD'ID') := CTAB0(COLDLOADID');            57124000
                  INFO(LOG'FILE'NUM') := CTAB0(LOGFILENUM');            57126000
                  INFO(LOADMODE).RLMODE := 1; <<RELOAD IN PROGRESS>>    57128000
                  INFO(DIRSECT) := CTABCC(DIRSECT');                    57130000
                  INFO(VIRMEMSECT) := CTABCC(VIRMEMSECT');              57132000
                  INFO(RINS) := CTABCC(RINS');                          57134000
                  INFO(GRINS) := CTABCC(GRINS');                        57136000
                  INFO(NLOGPROCS):=CTABCC(NLOGPROCS');         <<00506>>57138000
                  INFO(LOGIDS):=CTABCC(LOGIDS');               <<00506>>57140000
                END                                                     57142000
              ELSE                                                      57144000
                BEGIN  <<USE COPY OF TABLE ON DISC>>                    57146000
$IF X1=ON  << ******** SERIES 33 UNIQUE ************ >>        <<02510>>57152000
                  DISC(READ,SYSDISC,0D,LBUF,128);              <<00888>>57154000
                  IF BLBUF<>"SYSTEM DISC " OR                  <<00888>>57156000
                  BLBUF(LABSYSID)<>"3000" OR LBUF(LAB6)        <<00888>>57158000
                    .LABDTYPE<>SYSDISCTYPE OR LBUF(LAB6).LABDSUBTYPE    57160000
                    <>SYSDISCSUBTYPE THEN                      <<00888>>57162000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>57164000
                  DISC(READ,SYSDISC,0D,LBUF,128);                       57166000
                  IF LBUF=0 OR BLBUF(LABSYSID)<>"3000" OR LBUF(LAB6)    57168000
                    .LABDTYPE<>SYSDISCTYPE OR LBUF(LAB6).LABDSUBTYPE    57170000
                    <>SYSDISCSUBTYPE THEN                               57172000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>57174000
                    BEGIN  <<SYSTEM DISC RECONFIGURED>>                 57176000
                      MESSAGE(M104);                           <<01103>>57178000
                      GO REQIOC;                                        57180000
                    END;                                                57182000
                  DISC(READ,SYSDISC,D'L(INFOSECTOR)),INFO,INFOSIZE);    57184000
                  IF LOADFROMTAPE THEN                                  57186000
                    BEGIN  <<ADJUST TABLE FOR INCREASES IN SIZES>>      57188000
                      TOS := @INFO(INFO(TCSTPTR))                       57190000
                             +(I:=INFO(NUTCST')&LSL(2));<<SIZE OF CST>> 57192000
                      ASSEMBLE(DECA,DUP); <<SOURCE PTR FOR MOVE>>       57194000
                      TOS := (J:=LOWINFOWORDS-INFO(TABPTR))<<LOW INFO>> 57196000
                             +NTABLES&LSL(2)-(K:=INFO(TCSTPTR)-         57198000
                             INFO(TABPTR));<<TABLE AREA CHANGE>>        57200000
                      ASSEMBLE(ADD,XCH);  <<DESTINATION PTR>>           57202000
                      TOS := -J;                                        57204000
                      ASSEMBLE(MOVE 3);  <<MOVE CST PORTION OF TABLE>>  57206000
                      TOS := @INFO(INFO(TCSTPTR));                      57208000
                      ASSEMBLE(DECA,DUP);  <<SOURCE PTR FOR MOVE>>      57210000
                      TOS := TOS+J;  <<ADJUSTMENT FOR LOW INFO>>        57212000
                      ASSEMBLE(XCH);  <<DESTINATION PTR>>               57214000
                      TOS := -K;                                        57216000
                      ASSEMBLE(MOVE 3);  <<MOVE TABLE AREA>>            57218000
                    END;                                                57220000
                    IF UPDATE AND CONVERTOLOG THEN             <<00518>>57222000
                       BEGIN                                   <<00506>>57224000
                       INFO(NLOGPROCS):=CTABCC(NLOGPROCS'):=20;<<00506>>57226000
                       INFO(LOGIDS):=CTABCC(LOGIDS'):=20;      <<00506>>57228000
                       END;                                    <<00506>>57230000
                END;                                                    57232000
              INFO(TABPTR) := LOWINFOWORDS; <<PTR TO TABLE AREA>>       57236000
              INFO(TCSTPTR) := LOWINFOWORDS+NTABLES&LSL(2);<<TCST PTR>> 57238000
              INFO(NREAD) := NTABLES+NSTARTSEG;<<# OF BOOTSTRAP READS>> 57240000
              INFO(RINSECT) := (INFO(RINS)&LSL(1)+             <<00717>>57242000
                                INFO(GRINS)*12+137)&LSR(7);    <<00717>>57244000
              INFO(LOGIDSECT):=(INFO(NLOGPROCS)*33+33)/128 + 2;<<00506>>57246000
              INFO(LOGTABSECT):=(INFO(NLOGPROCS)*38+38)/128 + 2;        57248000
              @TABLEINFO := @INFO+INFO(TABPTR);                         57250000
              @TCSTINFO := @INFO+INFO(TCSTPTR);                         57252000
              COLDLOADID := INFO(COLD'LOAD'ID');                        57254000
              IF RESTORING THEN                                         57256000
                BEGIN <<COPY INFO FROM OLDINFO FOR USE WHEN GETTING BACK57258000
                        THE SAME DISC SPACE AND DETERMINING WHERE       57260000
                        DEFECTIVE TRACKS ARE LOCATED>>                  57262000
                <<COPY DISC ADDRESSES FOR TABLES>>                      57264000
                  @OLDTABLEINFO := @OLDINFO(OLDINFO(TABPTR));           57266000
                  J := (OLDINFO(TCSTPTR)-OLDINFO(TABPTR))&LSR(1);       57268000
          X := CSTABINFOX+1; <<INDEX FOR CSTAB DISC ADR>>               57270000
                  DO TABLEINFO(X) := OLDTABLEINFO(X) UNTIL (X:=X+2)>J;  57272000
                <<COPY DISC ADDRESSES FOR INITIAL'S CST'S>>             57274000
                  @OLDTCSTINFO := @OLDINFO(OLDINFO(TCSTPTR));           57276000
                  I := 0;                                               57278000
                  DO TCSTINFO(X) := OLDTCSTINFO(I&LSL(1)+1)             57280000
                  UNTIL (I:=I+1)=OLDINFO(NUTCST');                      57282000
                <<COPY DISC ADDRESSES FOR SYSTEM DISC AREAS>>           57284000
                  INFOD(X) := OLDINFOD(DIRADR);  <<DIRECTORY>>          57286000
                  INFOD(X) := OLDINFOD(VIRMEMADR); <<VIRTUAL MEMORY>>   57288000
                  INFOD(X) := OLDINFOD(RINADR);  <<RIN TABLE>>          57290000
                  INFOD(LOGIDADDR):=OLDINFOD(LOGIDADDR);       <<00506>>57292000
                  INFOD(LOGTABADDR):=OLDINFOD(LOGTABADDR);     <<00506>>57294000
                END;                                                    57296000
              IF NOT RELOAD THEN                                        57298000
                BEGIN  <<READ VOLUME TABLE FROM DISC>>                  57300000
                  I := IF INFO(H'VOL').(0:8) <> 0 THEN         <<RH.PV>>57302000
                       INFO(H'VOL').(0:8) ELSE                 <<RH.PV>>57304000
                       INFO(H'VOL').(8:8);                     <<RH.PV>>57306000
                  VTABINCR := (I-MVOL)*VTABSIZE;               <<RH.PV>>57308000
                  IF <> THEN MOVEDLTABLES; <<MAY BE DIFF. ON COLDSTART>>57310000
                  NVOL := INFO(H'VOL'); << MVOL/HVOL >>        <<RH.PV>>57312000
                  IF MVOL = 0 THEN MVOL := HVOL ELSE           <<RH.PV>>57314000
                  IF HVOL > MVOL THEN HVOL := MVOL;            <<RH.PV>>57316000
                  READTABLE(TABLEINFO(VTABINFOX+1),VTAB,       <<RH.PV>>57318000
                            (MVOL+1)*VTABSIZE); <<READ VTAB>>  <<RH.PV>>57320000
                  IF VTAB(1)<>COLDLOADID THEN ERRMESSAGE(M201);<<01103>>57322000
                     <<VOLUME TABLE DESTROYED; MUST RELOAD>>            57324000
             IF LOGICAL(INFO(LOADMODE).RLMODE) THEN ERRMESSAGE(M100);   57326000
                     <<PREVIOUS RELOAD ABORTED; MUST RELOAD>>           57328000
                  IF LOGICAL(INFO(LOADMODE).RYMODE) THEN RECOVERY:=TRUE;57330000
                END;                                                    57332000
              IF LOADFROMTAPE THEN                                      57334000
                BEGIN<<WRITE OUT INFO TABLE SO LOAD FLAGS CORRECT>>     57336000
                  INFO(LOADMODE).TLMODE := 1; <<COLD LOAD FROM TAPE>>   57338000
                  DISC(WRITE,SYSDISC,D'L(INFOSECTOR)),INFO,INFOSIZE);   57340000
                END;                                                    57342000
$PAGE "MAINSEG1  --  SET UP DISC VOLUMES"                               57344000
          <<------------------------------------                        57346000
            FIND OUT WHICH VOLUMES ARE MOUNTED                          57348000
          ------------------------------------>>                        57350000
              I := 0;                                                   57352000
              WHILE (I:=I+1) <= HVOL DO                                 57354000
                VTAB(I*VTABSIZE+VTAB12).VTABLDEV := 0;<<ZERO LDN'S>>    57356000
              VTABINCR := (HVOL-MVOL) * VTABSIZE;              <<01035>>57358000
              IF <> THEN MOVEDLTABLES;  << DELETE PV AREA >>   <<01035>>57360000
              MVOL := 0;                                       <<01035>>57362000
              << INITIAL COMPUTES A NEW VALUE FOR MVOL IN   >> <<01035>>57364000
              << PRIVATE VOLUME SECTION.  FROM THIS POINT   >> <<01035>>57366000
              << ON, MVOL CONTAINS UNRELIABLE INFORMATION   >> <<01035>>57368000
              << AND SHOULD NOT BE USED UNTIL RECOMPUTED.   >> <<01035>>57370000
              LDEV := 0;                                                57372000
              WHILE (LDEV:=LDEV+1) <= HLDEV DO                          57374000
                BEGIN                                          <<03550>>57378000
                TYPE := LDT(LDEV*LDTSIZE+LDT2).TYP;            <<03550>>57380000
                SUBTYP := LPDT(LDEV*LPDTSIZE+LPDT1).SUBTYPE;   <<03550>>57382000
                                                               <<03550>>57384000
                IF NON'DS'LDEV(LDEV) AND  << SYSTEM-DOMAIN >>  <<03550>>57386000
                  SYSDISC'TYPE(TYPE,SUBTYP)    << DISC     >>  <<03550>>57388000
                  THEN                                         <<03550>>57390000
                  BEGIN                                        <<03550>>57392000
                                                               <<03550>>57394000
                << IF THE DISC HAS NOT BEEN INITIALIZED >>     <<03715>>57396000
                << YET, DO IT NOW                       >>     <<03715>>57398000
                                                               <<03715>>57400000
                  IF LDEV <> SYSDISC THEN                      <<03715>>57402000
                     DISC(INIT'DEV,LDEV,0D,DTEMP,2);           <<03715>>57404000
                                                               <<03715>>57406000
                  DISC(RSTAT,LDEV,0D,DTEMP,2);  << MAKE SURE >><<03550>>57408000
                  IF DTEMP2.NREADYF=1 THEN      <<   DISC IS >><<03550>>57410000
                    GO TRYANOTHER;              <<   ON-LINE >><<03550>>57412000
                                                               <<03550>>57414000
                << READ THE DISC LABEL AND THE DTT OR  >>      <<03715>>57416000
                << DSCT.                               >>      <<03715>>57418000
                                                               <<03672>>57422000
                  DISC(READ,LDEV,0D,LBUF,256);                 <<03550>>57428000
                                                               <<03550>>57430000
                << CHECK FOR A VALID LABEL AND DTT OR DSCT >>  <<03550>>57432000
                                                               <<03550>>57434000
                  IF VALID'SYSDISC( TYPE, SUBTYP,              <<03550>>57436000
                                        LBUF, DTT) = 0 THEN    <<03550>>57438000
                    BEGIN                                      <<03550>>57440000
                                                               <<03550>>57442000
                  << IF VOLUME WAS PRESENT LAST LOAD OR  >>    <<03550>>57444000
                  << WE'RE DOING A RELOAD, MARK VOLUME   >>    <<03550>>57446000
                  << AS PRESENT IN VTAB                  >>    <<03550>>57448000
                                                               <<03550>>57450000
                    IF LBUF(LABCOLDLOADID) = COLDLOADID OR     <<03550>>57452000
                       RELOAD THEN                             <<03550>>57454000
                       BEGIN                                   <<03550>>57456000
                       INDEX := FINDVOL(BLBUF(LABVOLB));       <<03550>>57458000
                       IF = THEN                               <<03550>>57460000
                            VTAB(INDEX+VTAB12).VTABLDEV        <<03550>>57462000
                                               := LDEV;        <<03550>>57464000
                       END;                                    <<03550>>57466000
                                                               <<03550>>57468000
                    IF TYPE=DISC0 OR TYPE=DISC1 THEN           <<03550>>57470000
                       BEGIN                                   <<03550>>57472000
                       SORTDTT(DTT);    << SORT DTT >>         <<03550>>57474000
                       DISC(WRITE,LDEV,1D,DTT,128);            <<03550>>57476000
                       END;                                    <<03550>>57478000
                    END;                                       <<03550>>57480000
                  END;                                         <<03550>>57482000
TRYANOTHER:     END;                                           <<03550>>57484000
                                                                        57486000
          <<------------------------------------------------------      57488000
            MAKE SURE ALL PREVIOUSLY MOUNTED VOLUMES ARE PRESENT        57490000
          ------------------------------------------------------>>      57492000
             IF NOT(RELOAD) THEN                                        57494000
                BEGIN                                                   57496000
                  I := 0;                                               57498000
                  WHILE (I:=I+1) <= HVOL DO                             57500000
                  IF VTAB(I*VTABSIZE)<>0 AND VTAB(X:=X+VTAB12)          57502000
                    .VTABLDEV=0 THEN                                    57504000
                    BEGIN  <<AT LEAST ONE NOT MOUNTED>>                 57506000
                      MESSAGE(M2210);  <<FOLLOWING VOLUMES NOT <<01103>>57508000
                      I := I-1;                                         57510000
                      WHILE (I:=I+1) <= HVOL DO                         57512000
                      IF VTAB(I*VTABSIZE)<>0 AND VTAB(X:=X+VTAB12)      57514000
                        .VTABLDEV=0 THEN PRINT(VTAB(I*VTABSIZE),4,0);   57516000
                      GETYESNO(@MUSTMOUNT,M2201);<<LIST VOLUME <<01103>>57518000
                      LISTVOL;                                          57520000
MUSTMOUNT: ERRMESSAGE(M202);<<MOUNT CORRECT VOL OR REL>>       <<01103>>57522000
                    END;                                                57524000
                END;                                                    57526000
            END;                                                        57528000
                                                                        57530000
          <<------------------------------                              57532000
            DISC VOLUME CHANGES DIALOGUE                                57534000
          ------------------------------>>                              57536000
          VTABCHANGES := FALSE;                                <<01123>>57538000
          DTTCHANGES := FALSE;                                 <<01123>>57540000
          IF CHANGES AND LGETYESNO(M2200) THEN                 <<01123>>57542000
            BEGIN  << DISC VOLUME CHANGES? >>                  <<01123>>57544000
              VTABCHANGES := TRUE;                             <<01123>>57546000
              IF LGETYESNO(M2201) THEN LISTVOL;                <<01123>>57548000
              << LIST VOLUME TABLE? >>                         <<01123>>57550000
  REQDVOL:    IF RELOAD THEN                                            57552000
                BEGIN   <<VOLUMES MAY BE DELETED>>                      57554000
                  GETYESNO(@REQAVOL,M2202);    <<DELETE VOLUME?<<01103>>57556000
  REQVNAME1:      GETVNAME(@REQAVOL);  <<GET VOLUME NAME>>              57558000
                  INDEX := FINDVOL(VNAME);                              57560000
                  IF <> THEN                                            57562000
                    BEGIN <<NOT FOUND>>                                 57564000
                      MESSAGE(M2205);  <<NO SUCH VOLUME>>      <<01103>>57566000
                      GO REQVNAME1;                                     57568000
                    END;                                                57570000
                  IF INDEX/VTABSIZE = HVOL THEN                <<01035>>57572000
                    BEGIN  <<MUST COMPACT TABLE>>                       57574000
              DO                                               <<RH.PV>>57576000
                 BEGIN                                         <<RH.PV>>57578000
                 HVOL := HVOL - 1;                             <<01035>>57580000
                 I := HVOL;                                    <<01035>>57582000
                 IF VTAB(I*VTABSIZE) <> 0 THEN                 <<RH.PV>>57584000
                    GOTO SQUISHVTAB;                           <<RH.PV>>57586000
                 END                                           <<RH.PV>>57588000
              UNTIL <>;  <<WILL ALWAYS BE =>>                  <<RH.PV>>57590000
SQUISHVTAB:                                                    <<01035>>57592000
                      VTABINCR := X-INDEX;                     <<RH.PV>>57594000
                      MOVEDLTABLES;  <<COMPACT TABLE>>                  57596000
                    END                                                 57598000
                  ELSE                                                  57600000
                    BEGIN  <<ZERO ENTRY>>                               57602000
                      VTAB(INDEX) := 0;                                 57604000
                      MOVE VTAB(X:=X+1) := VTAB(X:=X-1),(VTABSIZE-1);   57606000
                    END;                                                57608000
                  GO REQVNAME1;                                         57610000
                END;                                                    57612000
  REQAVOL:    GETYESNO(@REQNVL,M2203);  <<ADD VOLUME?>>        <<01103>>57614000
  REQVNAME2:  GETVNAME(@REQNVL);                                        57616000
              FINDVOL(VNAME);                                           57618000
              IF = THEN                                                 57620000
                BEGIN  <<DUPLICATE>>                                    57622000
                  MESSAGE(M2206);  <<VOLUME ALREADY DEFINED>>  <<01103>>57624000
                  GO REQVNAME2;                                         57626000
                END;                                                    57628000
              ADDVOL(VNAME);                                            57630000
              IF <> THEN GO REQDVOL;  <<NO ROOM IN VTAB>>               57632000
              GO REQVNAME2;                                             57634000
REQNVL:       IF LGETYESNO(M2201) THEN LISTVOL;                <<01123>>57636000
              << LIST VOLUME TABLE? >>                         <<01123>>57638000
            END;                                                        57640000
                                                                        57642000
          <<------------------------------                              57644000
            CHECK DISCS FOR VALID LABELS                                57646000
          ------------------------------>>                              57648000
RECHECKLAB:                                                    <<00458>>57650000
          I := 0;                                                       57652000
          WHILE (I:=I+1)<=HVOL DO VTAB(I*VTABSIZE+VTAB12).VTABLDEV:=0;  57654000
          LDEV := 0;                                                    57656000
          WHILE (LDEV:=LDEV+1) <= HLDEV DO                              57658000
            IF NON'DS'LDEV(LDEV) AND                           <<03550>>57662000
               LDT(LDEV*LDTSIZE+LDT2).RANGE=DIRACCESS THEN     <<03550>>57664000
              BEGIN         << IT'S A DISC >>                  <<03550>>57666000
                                                               <<03550>>57668000
              TYPE := LDT(LDEV*LDTSIZE+LDT2).TYP;              <<03550>>57670000
              SUBTYP := LPDT(LDEV*LPDTSIZE+LPDT1).SUBTYPE;     <<03550>>57672000
                                                               <<03550>>57674000
            << IF NOT A SYSTEM-DOMAIN TYPE DISC, DON'T     >>  <<03550>>57676000
            << ALLOW IT TO BE ADDED TO THE SYSTEM VOLUMES  >>  <<03550>>57678000
                                                               <<03550>>57680000
              IF NOT SYSDISC'TYPE(TYPE,SUBTYP) THEN            <<03550>>57682000
                GO SETNSDFLAG                                  <<03648>>57684000
              ELSE LPDT(LDEV*LPDTSIZE+LPDT1).NSDV := 0;        <<03648>>57686000
                                                               <<03550>>57688000
            << IF THERE IS THE POSSIBILITY THE DISC HAS   >>   <<03715>>57690000
            << NOT BEEN INITIALIZED YET, DO IT NOW.       >>   <<03715>>57692000
                                                               <<03715>>57694000
              IF SECONDPASS AND (LDEV <> SYSDISC) THEN         <<03715>>57696000
                 DISC(INIT'DEV,LDEV,0D,DTEMP,2);               <<03715>>57698000
                                                               <<03715>>57700000
              IF SDISC'TYPE(TYPE,SUBTYP) THEN                  <<03550>>57702000
                BEGIN                                          <<03550>>57704000
                DISC(RSTAT,LDEV,0D,DTEMP,2);                   <<03550>>57706000
                IF DTEMP2.NREADYF=1 THEN                       <<03550>>57708000
                            << DISC IS OFF-LINE--SET PV BIT >> <<03550>>57710000
                   GOTO SETNSDFLAG;                            <<03550>>57712000
                END;                                           <<03550>>57714000
                                                               <<03550>>57716000
            << READ LABEL AND DTT OR DSCT AND CHECK TO >>      <<03550>>57730000
            << SEE IF THEY ARE VALID                   >>      <<03550>>57732000
                                                               <<03550>>57734000
              DISC(READ,LDEV,0D,LBUF,256);                     <<03550>>57736000
              IF VALID'SYSDISC(TYPE,SUBTYP,LBUF,DTT) = 0 THEN  <<03550>>57738000
                BEGIN   <<VALID LABEL>>                                 57740000
                  VALID := TRUE;  <<VALID LABEL>>                       57742000
                  MOVE VNAMEI := LBUF(LABVOL),(4);                      57744000
                  INDEX := FINDVOL(VNAME);                              57746000
                  IF <> THEN                                            57748000
                    BEGIN   <<NOT FOUND IN TABLE>>                      57750000
                      BINBUF := MOVEAN(BINBUF(1),VNAME,8);     <<01103>>57752000
                      << DEVICE n VOLUME xxxx NOT DEFINED IN TA<<01103>>57754000
                      MESSAGE(M204,LDEV,,,,BINBUF);            <<01103>>57756000
                      GETYESNO(@SETNSDFLAG,M2211);             <<01103>>57758000
                      GETVNAME(@ADDTOTAB);  <<GET VOLUME NAME>>         57760000
                      GO FINDIT;                                        57762000
  V4ERR:              MESSAGE(M2453);  <<ILLEGAL INPUT>>       <<01103>>57764000
                      GO REQVNAME4;                                     57766000
                    END                                                 57768000
                  ELSE IF VTAB(INDEX+VTAB12).VTABLDEV<>0 THEN           57770000
                    BEGIN   <<DUPLICATE VOLUME NAME>>                   57772000
                      BINBUF := MOVEAN(BINBUF(1),VNAME,8);     <<01103>>57774000
                      << VOLUME NAME xxxx ON DEVICE n ALREADY I<<01103>>57776000
                      MESSAGE(M205,LDEV,,,,BINBUF);            <<01103>>57778000
                      GOTO REQVNAME4;                                   57780000
                    END;                                                57782000
                END                                                     57784000
              ELSE                                                      57786000
                BEGIN  <<INVALID LABEL>>                                57788000
                  IF SDISC'TYPE(TYPE,SUBTYP) THEN              <<03550>>57790000
                    BEGIN              << MIGHT BE A PV >>     <<03550>>57792000
                    IF RELOAD AND LDEV<>SYSTAPELDEV OR         <<00458>>57794000
                    SECONDPASS AND LDEV<>SYSTAPELDEV THEN      <<00458>>57796000
                      IF CHANGES OR SECONDPASS OR              <<00458>>57798000
                                                               <<03549>>57800000
                    << CHECK FOR A SCRATCH VOLUME >>           <<03549>>57802000
                                                               <<03549>>57804000
                      LBUF(6).LABDSUBTYPE<>SUBTYP OR           <<PV.PV>>57806000
                      LBUF(6).LABDTYPE<>TYPE OR                <<PV.PV>>57808000
                      LBUF(7)<>0 OR                            <<PV.PV>>57810000
                      LBUF(8)<>0 OR                            <<PV.PV>>57812000
                      LBUF(9)<>0 THEN                          <<PV.PV>>57814000
                      <<MAY BE ADDED TO SYSTEM SET>>           <<PV.PV>>57816000
                      BEGIN                                    <<RH.PV>>57818000
                        MOVE BINBUF := "NON-SYSTEM VOLUME ",2; <<RH.PV>>57820000
                        MOVE * :="ON LDEV ";                   <<00071>>57822000
                        J := ASCII(LDEV,BINBUF(26));           <<00071>>57824000
                        PRINT(INBUF,-J-26,0);                  <<00071>>57826000
                        GETYESNO(@SETNSDFLAG,M2211);           <<01103>>57828000
                        VALID := FALSE;                        <<RH.PV>>57830000
                        ZEROBUF(LBUF,256);                     <<03549>>57832000
                        GOTO REQVNAME4;                        <<RH.PV>>57834000
                      END;                                     <<RH.PV>>57836000
  SETNSDFLAG:       LPDT(LDEV*LPDTSIZE+LPDT1).NSDV := 1;       <<RH.PV>>57838000
                    GO TO NEXTVOL;                             <<RH.PV>>57840000
                  END;                                         <<RH.PV>>57842000
                                                               <<03549>>57844000
                  ZEROBUF(LBUF,256);   << ZERO LABEL AND DTT>> <<03549>>57846000
                                       << OR DSCT BUFFER    >> <<03549>>57848000
                  VALID := FALSE;                                       57850000
                  MOVE BINBUF := "INVALID LABEL FOR DEVICE ";           57852000
                  J := ASCII(LDEV,BINBUF(25));                          57854000
                  PRINT(INBUF,-25-J,0);                                 57856000
  REQVNAME4:      GETVNAME(@V4ERR);                                     57858000
                  MOVE BLBUF(LABSYSID) := "3000"; <<LABEL VERIFIER>>    57860000
  FINDIT:         MOVE LBUF(LABVOL) := VNAMEI,(4);                      57862000
                  INDEX := FINDVOL(VNAME);                              57864000
                  IF <> THEN                                            57866000
                    BEGIN  <<NOT IN VOLUME TABLE>>                      57868000
  ADDTOTAB:           INDEX := ADDVOL(VNAME);                           57870000
                      IF <> THEN GOTO NEXTVOL; <<NO ROOM IN TABLE>>     57872000
                    END                                                 57874000
                  ELSE IF VTAB(INDEX+VTAB12).VTABLDEV<>0 THEN           57876000
                    BEGIN                                               57878000
                      MESSAGE(M2207); <<ALREADY IN USE>>       <<01103>>57880000
                      GOTO REQVNAME4;                                   57882000
                    END;                                                57884000
                  LPDT(LDEV*LPDTSIZE+LPDT1).NSDV:=0;           <<00458>>57886000
                END;                                                    57888000
              IF NOT VALID THEN                                         57890000
                BEGIN  <<INITIALIZE DTT>>                               57892000
                  IF TYPE=MHDISCTYPE THEN                               57896000
                    BEGIN  <<MOVING HEAD>>                              57898000
                      L := SUBTYP*MHINFOSIZE;                  <<03549>>57900000
                      N := MHINFO(L+MHDEFLPS); <<DEFAULT PACK SIZE>>    57902000
                      GETNEWVAL(M2234,N,3*N/4,MHINFO(L+MHMAXLPS));      57904000
                      DTT(DTTLPS) := N;                                 57906000
                      DTT(DTTALT) := SIZE := N*MHINFO(L+MHTRKCYL);      57908000
                      J := MHINFO(L+MHTRKCYL)*MHINFO(L+MHMAXLPS);       57910000
                      K := 0;                                           57912000
                      DO                                                57914000
                        BEGIN  <<CHECK EACH TRACK FOR DEFECTIVE>>       57916000
                                                               <<03549>>57920000
                        DISC(2,LDEV,LOGICAL(K)**               <<03549>>57922000
                             MHINFOL(L+MHSECTRK),BUF,128);     <<03549>>57924000
                                                               <<03549>>57926000
                        IF <> THEN      << FOUND SUSPECT >>    <<03549>>57928000
                           ADDDTTENTRY(K&LSL(2));              <<03549>>57930000
                        END                                             57932000
                      UNTIL (K:=K+1)=J;                                 57934000
                    END                                                 57938000
                  ELSE IF TYPE=DISC1 THEN                      <<03549>>57940000
                       DTT(DTTLPS) := FHINFO(SUBTYP)           <<03549>>57942000
                  ELSE IF TYPE=DISC3 THEN  << CS'80 DISC >>    <<03549>>57944000
                       INIT'DSCT(DSCT);                        <<03549>>57946000
                END;                                                    57950000
                                                                        57952000
          <<----------------------------------------------              57954000
            PROMPT OPERATOR FOR ACTION ON SUSPECT TRACKS                57956000
          ---------------------------------------------->>              57958000
            IF TYPE=DISC0 OR TYPE=DISC1 THEN                   <<03549>>57960000
              BEGIN                                            <<03549>>57962000
              L := SUBTYP * MHINFOSIZE;                        <<03549>>57964000
              J := 0;                                                   57966000
              WHILE (J:=J+1) <= DTT DO                                  57968000
                BEGIN  <<SCAN DTT FOR SUSPECTS>>                        57970000
                  K := DTT(J).(14:2);  <<TYPE>>                         57972000
                  IF K>1 THEN GOTO NEXTDTTENT; <<NOT INTERESTED>>       57974000
                  N := DTT(J)&LSR(2);  <<TRACK #>>                      57976000
                  IF K=0 AND J<>DTT AND DTT(J+1)&LSR(2)=N THEN K:=2;    57978000
                              <<UNREADABLE ALTERNATE>>                  57980000
                  TOS := @INBUF;  <<FOR PRINT>>                         57982000
                  TOS := @BINBUF;  <<FOR COMPUTING LINE COUNT>>         57984000
                  DUPLICATE;                                            57986000
                  IF K<2 THEN MOVE * := "SUSPECT",2                     57988000
                  ELSE MOVE * := "UNREADABLE",2;                        57990000
                  IF K>0 THEN MOVE * := " ALT",2;                       57992000
                  MOVE * := " TRK  LDEV #",2;                           57994000
                  DUPLICATE;  <<BUFFER PTR>>                            57996000
                  TOS := 0;                                             57998000
                  TOS := LDEV;                                          58000000
                  ASSEMBLE(CAB);                                        58002000
                  TOS := ASCII(*,*);                                    58004000
                  ASSEMBLE(ADD);  <<NEW BUFFER PTR>>                    58006000
                  IF TYPE=MHDISCTYPE THEN                               58008000
                    BEGIN                                               58010000
                      MOVE * := " CYL=",2;                              58012000
                      TOS := CYLINDERHEAD(N,SUBTYP);                    58014000
                      ASSEMBLE(ZERO,XCH);                               58016000
                      TOS := S3;  <<BUFFER PTR>>                        58018000
                      TOS := ASCII(*,*);                                58020000
                      ASSEMBLE(CAB,ADD);                                58022000
                      MOVE * := " HEAD=",2;                             58024000
                      ASSEMBLE(DUP,ZERO; DXCH);                         58026000
                      TOS := ASCII(*,*);                                58028000
                    END                                                 58030000
                  ELSE                                                  58032000
                    BEGIN  <<FIXED HEAD DISC>>                          58034000
                      MOVE * := " TRACK=",2;                            58036000
                      TOS := 0;                                         58038000
                      TOS := N;                                         58040000
                      TOS := S2;                                        58042000
                      TOS := ASCII(*,*);                                58044000
                    END;                                                58046000
                  ASSEMBLE(ADD); <<UPDATE BUFFER PTR>>                  58048000
                  MOVE * := " (SECTORS %",2;                            58050000
                  IF TYPE=MHDISCTYPE THEN TOS := LOGICAL(N)**MHINFOL    58052000
                    (L+MHSECTRK)                                        58054000
                  ELSE                                                  58056000
                    BEGIN  <<FIXED HEAD>>                               58058000
                      TOS := 0;                                         58060000
                      TOS := N&LSL(5);                                  58062000
                    END;                                                58064000
                  ASSEMBLE(CAB,ZERO);                                   58066000
                  TOS := DS3;  <<FIRST SECTOR>>                         58068000
                  ASSEMBLE(DDUP);                                       58070000
                  FSECT := TOS;                                         58072000
                  TOS := 8;  <<BASE 8>>                        <<00935>>58074000
                  TOS := S4;                                   <<00935>>58076000
                  TOS := LDNTOA(*,*,*);                        <<00935>>58078000
                  ASSEMBLE(ADD);  <<UPDATE BUFFER PTR>>                 58080000
                  MOVE * := "-%",2;                                     58082000
                  ASSEMBLE(ZERO,DXCH);                                  58084000
                  IF TYPE=MHDISCTYPE THEN TOS := TOS+DOUBLE(LOGICAL(    58086000
                    MHINFO(L+MHSECTRK)))-1D                             58088000
                  ELSE TOS := TOS+31D;                                  58090000
                  ASSEMBLE(DDUP);                                       58092000
                  LSECT := TOS;  <<LAST SECTOR>>                        58094000
                  TOS := 8;  <<BASE 8>>                        <<00935>>58096000
                  TOS := S4;                                   <<00935>>58098000
                  TOS := LDNTOA(*,*,*);                        <<00935>>58100000
                  ASSEMBLE(ADD,SUB; DUP,DECB; NEG,STAX);                58102000
                  BINBUF(X) := ")";                                     58104000
                  PRINT(*,*,0);                                         58106000
                <<ASK OPERATOR WHAT TO DO>>                             58108000
REQDISP:                                                       <<03550>>58112000
                << GET THE END OF THE RESERVED AREA >>         <<03550>>58114000
                  DTEMP := END'RESERVED(LDEV);                 <<03550>>58116000
                                                               <<03550>>58118000
                  FLAGGED := FALSE;                                     58120000
                  IF TYPE=MHDISCTYPE AND NOT VALID THEN                 58122000
                    BEGIN  <<CHECK FOR FLAGGED DEFECTIVE>>              58124000
                                                               <<03549>>58128000
                      DISC(2,LDEV,FSECT,BUF,128);              <<03549>>58130000
                                                               <<03549>>58132000
                      IF < THEN FLAGGED := TRUE;  <<TRACK IS FLAGGED>>  58134000
                      TOS := MHINFOL(L+MHSECTRK)**LOGICAL(SIZE);        58136000
                             <<FIRST SECTOR OF ALTERNATE AREA>>         58138000
                      IF TOS <= LSECT THEN                              58140000
                        BEGIN                                           58142000
                          MESSAGE(M2243);<<WARNING-IN ALTERNATE<<01103>>58144000
                          IF FLAGGED THEN                               58146000
                            BEGIN  <<MAY ONLY BE DELETED>>              58148000
  REQDELYN:                   GETYESNO(@DELERR,M2230);<<DELETE <<01103>>58150000
                              TOS := 2;  <<DELETE>>                     58152000
                              GO SETDISP;                               58154000
                            END;                                        58156000
                           GO REQDRI; <<DELETE, RECOVER OR IGNORE>>     58158000
  DELERR:                 MESSAGE(M2453);  <<ILLEGAL INPUT>>   <<01103>>58160000
                          GO REQDELYN;                                  58162000
                        END;                                            58164000
                    END;                                                58166000
                  IF FSECT<=DTEMP THEN  <<IN RESERVED AREA>>            58168000
IF FLAGGED THEN ERRMESSAGE(M232) <<FLAGGED TRACK IN>>          <<01103>>58170000
<<RESERVED AREA -- MUST REINITIALIZE PACK>>                    <<2B.00>>58172000
                  ELSE                                                  58174000
                    BEGIN                                               58176000
                      MESSAGE(M2240);<<WARNING - IN RESERVED AR<<01103>>58178000
  REQRECOVER:         GETYESNO(@IGNORE,M2229);  <<RECOVER?>>   <<01103>>58180000
                      TOS := 1;  <<RECOVER>>                            58182000
                      GOTO SETDISP;                                     58184000
  IGNORE:             TOS := 0;  <<IGNORE>>                             58186000
                      GOTO SETDISP;                                     58188000
                    END;                                                58190000
                  IF LDEV= SYSDISC THEN                                 58192000
                    BEGIN  <<CHECK FOR SPECIAL AREAS ON SYSTEM DISC>>   58194000
                      IF NOT LOADFROMTAPE THEN                          58196000
                        BEGIN  <<CHECK FOR TRACK IN SYSTEM AREA>>       58198000
                          CHECKSYS(FSECT,LSECT);                        58200000
                          IF <> THEN                                    58202000
                            BEGIN  <<IN SYSTEM AREA>>                   58204000
                             MESSAGE(M2246);<<WARNING-IN SYSTEM<<01103>>58206000
                              GO REQRECOVER;                            58208000
                            END;                                        58210000
                        END;                                            58212000
                      IF NOT (RELOAD)                          <<03612>>58216000
                        THEN                                   <<03612>>58218000
                          BEGIN  << CHK FOR DEFECTIVE TRACK  >><<03612>>58220000
                                 << IN THE DIRECTORY OR IN A >><<03612>>58222000
                                 << SYS DISC RESIDENT TABLE. >><<03612>>58224000
                            IF CHECK'DIRECTORY(FSECT,LSECT)    <<03612>>58226000
                              THEN                             <<03612>>58228000
                                BEGIN                          <<03612>>58230000
                                  MESSAGE(M2241);              <<03612>>58232000
                                  GO REQRECOVER;               <<03612>>58234000
                                END;                           <<03612>>58236000
                            IF CHECK'RESIDENT(FSECT,LSECT)     <<03612>>58238000
                              THEN                             <<03612>>58240000
                                BEGIN                          <<03612>>58242000
                                  MESSAGE(M2250);              <<03612>>58244000
                                  GO REQRECOVER;               <<03612>>58246000
                                END;                           <<03612>>58248000
                           END;                                <<03612>>58250000
                    END;                                                58252000
                                                               <<03613>>58254000
                  << Check to make sure it does not overlap >> <<03613>>58256000
                  << the disc free space data structures.   >> <<03613>>58258000
                                                               <<03613>>58260000
                  IF NOT reload THEN                           <<03613>>58262000
                  IF Check'If'Overlaps'Dfs'Data'Structures (   <<03613>>58264000
                        ldev, fsect, lsect) THEN               <<03613>>58266000
                     BEGIN  << Overlap >>                      <<03613>>58268000
                                                               <<03613>>58270000
                        Message (m2248);                       <<03613>>58272000
                        GOTO Req'rec'rea'ign;                  <<03613>>58274000
                                                               <<03613>>58276000
                     END;   << Overlap >>                      <<03613>>58278000
                                                               <<03613>>58280000
                  IF NOT RELOAD OR RESTORE THEN                <<03714>>58284000
                     BEGIN                                     <<03714>>58286000
                                                               <<03714>>58288000
                     IF CHECK'VM(LDEV,FSECT,LSECT) THEN        <<03714>>58290000
                        BEGIN                                  <<03714>>58292000
                        MESSAGE(M2242);   << WARNING: IN VM >> <<03714>>58294000
                        IF RESTORE THEN                        <<03714>>58296000
                           GOTO REQALL                         <<03714>>58298000
                        ELSE                                   <<03714>>58300000
                           GOTO REQDRI;                        <<03714>>58302000
                        END;                                   <<03714>>58304000
                     END;                                      <<03714>>58306000
                                                               <<03714>>58308000
  REQALL:         IF TYPE=MHDISCTYPE THEN                               58310000
                  IF FLAGGED THEN TOS := GETDISP(%14)<<DELETE,REASSIGN>>58312000
                  ELSE TOS := GETDISP(%17)  <<DELETE,REA,RECOVER,IGN>>  58314000
                  ELSE                                                  58316000
  REQDRI:         TOS := GETDISP(7);  <<DELETE,RECOVER,IGNORE>>         58318000
                                                               <<03613>>58320000
                  GOTO Setdisp;                                <<03613>>58322000
                                                               <<03613>>58324000
   Req'rec'rea'ign: IF type = mhdisctype THEN                  <<03613>>58326000
                       TOS := Getdisp (%13)                    <<03613>>58328000
                    ELSE                                       <<03613>>58330000
                       TOS := Getdisp (%3);                    <<03613>>58332000
                                                               <<03613>>58334000
  SETDISP:        M := TOS;                                             58336000
                  IF M=0 THEN GOTO NEXTDTTENT;  <<IGNORE>>              58338000
                  IF M=1 THEN                                           58340000
                    BEGIN  <<RECOVER>>                                  58342000
                      TOS := DELDTTENTRY(DTT(J));                       58344000
                      J := TOS+J;<<UPDATE COUNT BY # OF WORDS DELETED>> 58346000
                      GOTO NEXTDTTENT;                                  58348000
                    END;                                                58350000
                  IF M=3 THEN                                           58352000
                    BEGIN  <<REASSIGN>>                                 58354000
  CHECKALT:           IF DTT(DTTALT) >= MHINFO(L+MHMAXLPS)     <<03549>>58356000
                        *MHINFO(L+MHTRKCYL) THEN                        58358000
                        BEGIN  <<NO ALTERNATES AVAILABLE>>              58360000
                          MESSAGE(M226); <<NO ALTERNATES AVAILA<<01103>>58362000
                          GO REQDISP;                                   58364000
                        END;                                            58366000
                    <<DETERMINE IF FIRST ALT IS DELETED OR SUSPECT>>    58368000
                      Q := 0;                                           58370000
                      WHILE (Q:=Q+1) <= DTT DO                          58372000
                      IF DTT(Q)&LSR(2)=DTT(DTTALT) THEN                 58374000
                        BEGIN  <<AVAILABLE ALTERNATE IS BAD>>           58376000
                          DTT(X) := DTT(DTTALT)+1;                      58378000
                          GOTO CHECKALT;                                58380000
                        END;                                            58382000
                      ALT := DTT(DTTALT);                               58384000
                      DTT(DTTALT) := DTT(DTTALT) + 1;          <<03549>>58388000
                      IF NOT RELOAD THEN                       <<03549>>58390000
                        BEGIN                                  <<03549>>58392000
                                                               <<03549>>58394000
                      << TRY TO ADD AN ENTRY TO THE LIST OF >> <<03549>>58396000
                      << REASSIGNED AREAS.  ADD'AREA        >> <<03549>>58398000
                      << RETURNS FALSE IF THERE'S NO ROOM   >> <<03549>>58400000
                                                               <<03549>>58402000
                        NREASS := NREASS + 1;                  <<03714>>58404000
                        IF NOT ADD'AREA(REASSIGNED,NREASS,     <<03549>>58406000
                                MAX'REASS+1,LDEV,FSECT,        <<03714>>58408000
                                LSECT-FSECT+1D) THEN           <<03549>>58410000
                          BEGIN                                <<03549>>58412000
                                                               <<03549>>58414000
                        << FREE ALT. TRACK AND PRINT MESS. >>  <<03549>>58416000
                                                               <<03549>>58418000
                          NREASS := NREASS - 1;                <<03714>>58420000
                          DTT(DTTALT) := DTT(DTTALT) - 1;      <<03549>>58422000
                          MESSAGE(M233);                       <<03549>>58424000
                          GOTO REQDISP;                        <<03549>>58426000
                          END;                                 <<03714>>58428000
                                                               <<03549>>58430000
                        END;                                   <<03549>>58436000
                    END                                                 58438000
                  ELSE ALT := 0;  <<DELETING>>                          58440000
                                                               <<03714>>58444000
                  << CHECK TO SEE IF THIS TRACK IS SITUATED >> <<03714>>58446000
                  << SUCH THAT A RECOVER LOST DISC SPACE    >> <<03714>>58448000
                  << WILL BE NECESSARY AFTER IT IS          >> <<03714>>58450000
                  << REASSIGNED OR DELETED.                 >> <<03714>>58452000
                                                               <<03714>>58454000
                  IF RECOVERY'NEEDED(LDEV,FSECT,LSECT) THEN    <<03714>>58456000
                     RECOVERY := TRUE;   << SET FLAG >>        <<03714>>58458000
                                                               <<03714>>58460000
                  TOS := DELDTTENTRIES(N);  <<REMOVE ALL ENTRIES FROM   58462000
                             TABLE FOR THIS TRACK>>                     58464000
                  TOS := ADDDTTENTRY(N&LSL(2)+M);                       58466000
                  TOS := J;                                             58468000
                  ASSEMBLE(ADD,ADD);  <<DTT INDEX OFFSET>>              58470000
                  J := TOS;  <<UPDATE DTT INDEX>>                       58472000
                  IF TYPE=MHDISCTYPE THEN FLAGTRACK(LDEV,N,ALT);        58474000
  NEXTDTTENT:   END;                                                    58476000
              END   << PROCESSING SUSPECT TRACKS IN DTT >>     <<03549>>58478000
                                                                        58480000
            ELSE IF TYPE=DISC3 THEN   << PROCESS SUSPECT    >> <<03549>>58482000
              CS80'DEFECTS(LDEV,DSCT);  << SECTORS IN DSCT  >> <<03549>>58484000
                                                               <<03549>>58486000
          <<---------------------                                       58488000
            UPDATE VOLUME LABEL                                         58490000
          --------------------->>                                       58492000
              VTAB(INDEX+VTAB12).VTABLDEV := LDEV;                      58494000
              LDT(LDEV*LDTSIZE+LDT1).VOL := INDEX/VTABSIZE;             58496000
              N := LBUF(LABCOLDLOADID);                                 58498000
              LBUF(LAB6).LABDTYPE := TYPE;                              58500000
              LBUF(LAB6).LABDSUBTYPE := SUBTYP;                         58502000
              DISC(WRITE,LDEV,0D,LBUF,256);                             58504000
              IF NOT(RELOAD) AND (NOT VALID OR                 <<01483>>58506000
              N <> COLDLOADID) THEN                            <<03551>>58508000
                   Init'Disc'Free'Space'Map (ldev);            <<03551>>58510000
       <<NEW VOL ADDED THIS TIME;INIT DISC FREE SPACE MAP>>    <<01483>>58512000
  NEXTVOL:                                                              58514000
            END;                                                        58516000
                                                                        58518000
          <<----------------------------------                          58520000
            MAKE SURE ALL VOLUMES ARE MOUNTED                           58522000
          ----------------------------------->>                         58524000
          I := 0;                                                       58526000
          WHILE (I:=I+1)<=HVOL DO                                       58528000
          IF VTAB(I*VTABSIZE)<>0 AND VTAB(X+VTAB12).VTABLDEV=0 THEN     58530000
            BEGIN   <<AT LEAST ONE VOLUME NOT MOUNTED>>                 58532000
              IF NOT SECONDPASS THEN                           <<00458>>58534000
                 BEGIN                                         <<00458>>58536000
                 << IT IS POSSIBLE THAT THE SYSTEM VOLUME   >> <<00458>>58538000
                 << SET WAS NOT SATISFIED ON THE FIRST      >> <<00458>>58540000
                 << PASS BECAUSE THE OPERATOR WASN'T GIVEN  >> <<00458>>58542000
                 << THE OPPORTUNITY TO MOVE THE SPINDLES    >> <<00458>>58544000
                 << FROM THE PRIVATE DOMAIN. HE WILL BE     >> <<00458>>58546000
                 << GIVEN THIS CHANCE ON PASS 2.            >> <<00458>>58548000
                 SECONDPASS:=TRUE;                             <<00458>>58550000
                 GOTO RECHECKLAB;                              <<00458>>58552000
                 END                                           <<00458>>58554000
              ELSE                                             <<00458>>58556000
                 MESSAGE(M203); << ALL VOLS MUST BE MOUNTED >> <<01103>>58558000
              GETYESNO(@REQIOC,M2201);  <<LIST VOLUME TABLE?>> <<01103>>58560000
              LISTVOL;                                                  58562000
              GO REQIOC;                                                58564000
            END;                                                        58566000
                                                               <<RH.PV>>58568000
                                                               <<01123>>58570000
                                                               <<01123>>58572000
      <<- - - - - - - - - - - - - - - - - - - - - - - - - - ->><<01123>>58574000
      <<              DEFECTIVE TRACKS DIALOG                >><<01123>>58576000
      << - - - - - - - - - - - - - - - - - - - - - - - - - - >><<01123>>58578000
                                                               <<01123>>58580000
                                                               <<01123>>58582000
          IF CHANGES AND VTABCHANGES THEN                      <<01123>>58584000
            BEGIN                                              <<01123>>58586000
              LIST'DEFECTS;    << LIST DEFECTIVE INFO. >>      <<03549>>58588000
              GETYESNO(@ENDDTT, M2227);  << DELETE TRACK? >>   <<01123>>58590000
              DTTCHANGES := TRUE;                              <<01123>>58592000
  REQLCH:     MESSAGE(-M2228);  << ENTER LDEV, CYL. AND HEAD >><<01123>>58594000
              READINPUT;                                       <<01123>>58596000
              LDEV := INVAL(@DELTERR);                         <<01123>>58598000
              IF = THEN GO ENDDTT;  << CR INPUT >>             <<01123>>58600000
              IF > OR NOT (1 <= LDEV <= 255) THEN              <<01123>>58602000
                BEGIN  << ILLEGAL INPUT >>                     <<01123>>58604000
  DELTERR:        MESSAGE(M2453);                              <<01123>>58606000
                  GO REQLCH;                                   <<01123>>58608000
                END;                                           <<01123>>58610000
                                                               <<03549>>58612000
            << INSURE VALID DISC AND DTT >>                    <<03549>>58614000
              IF VALID'DISC(LDEV) <> 0 THEN GOTO REQLCH;       <<03549>>58616000
                                                               <<03549>>58618000
              TYPE := LDT(LDEV*LDTSIZE+LDT2).TYP;              <<01123>>58620000
              SUBTYP := LPDT(LDEV*LPDTSIZE+LPDT1).SUBTYPE;     <<01123>>58622000
                                                               <<03549>>58624000
              IF TYPE <> DISC0 AND TYPE <> DISC1 THEN          <<03549>>58626000
                 BEGIN       << CAN'T DELETE TRACKS >>         <<03549>>58628000
                 MESSAGE(2502);    << ON THIS DISC  >>         <<03549>>58630000
                 GOTO REQLCH;                                  <<03549>>58632000
                 END;                                          <<03549>>58634000
                                                               <<03549>>58636000
              N := INVAL(@DELTERR);  << GET SECOND PARM >>     <<01123>>58638000
              IF = THEN GOTO DELTERR;  << CR INPUT >>          <<01123>>58640000
              IF > THEN                                        <<01123>>58642000
                IF TYPE = MHDISCTYPE THEN GOTO DELTERR         <<01123>>58644000
                ELSE                                           <<01123>>58646000
                  BEGIN  << FIXED HEAD DISC >>                 <<01123>>58648000
                    IF NOT (0<=N<=FHINFO(SUBTYP)-1) THEN       <<01123>>58650000
                      BEGIN  << INVALID TRACK # >>             <<01123>>58652000
                        MESSAGE(M2237);                        <<01123>>58654000
                        GO REQLCH;                             <<01123>>58656000
                      END;                                     <<01123>>58658000
                    TOS := 0;                                  <<01123>>58660000
                    TOS := N&LSL(5);                           <<01123>>58662000
                    ASSEMBLE(DDUP);                            <<01123>>58664000
                    FSECT := TOS;                              <<01123>>58666000
                    TOS := TOS + 31;                           <<01123>>58668000
                    LSECT := TOS;                              <<01123>>58670000
                    GOTO CHECKDEL;                             <<01123>>58672000
                  END;                                         <<01123>>58674000
              << FOLLOWED BY COMMA >>                          <<01123>>58676000
              IF TYPE=FHDISCTYPE THEN GO DELTERR;              <<01123>>58678000
              IF NOT (0<=N<=MHINFO((INDEX:=SUBTYP*MHINFOSIZE)+ <<01123>>58680000
                MHMAXLPS)-1) THEN                              <<01123>>58682000
                BEGIN  << INVALID CYLINDER NUMBER >>           <<01123>>58684000
                  MESSAGE(M2238);                              <<01123>>58686000
                  GO REQLCH;                                   <<01123>>58688000
                END;                                           <<01123>>58690000
              M := INVAL(@DELTERR);  << GET HEAD # >>          <<01123>>58692000
              IF <= THEN GO DELTERR;                           <<01123>>58694000
              IF NOT (MHINFO(INDEX+MHSTHEAD) <= M <=           <<01123>>58696000
                MHINFO(INDEX+MHTRKMULT)*MHINFO(INDEX+MHTRKCYL) <<01123>>58698000
                +MHINFO(INDEX+MHSTHEAD)-1) THEN                <<01123>>58700000
                BEGIN  << INVALID HEAD # >>                    <<01123>>58702000
                  MESSAGE(M2239);                              <<01123>>58704000
                  GO REQLCH;                                   <<01123>>58706000
                END;                                           <<01123>>58708000
              N := N*MHINFO(INDEX+MHTRKCYL)+(M-MHINFO(INDEX+   <<01123>>58710000
                MHSTHEAD))/MHINFO(INDEX+MHTRKMULT); <<TRACK #>><<01123>>58712000
              TOS := LOGICAL(N)**MHINFOL(INDEX+MHSECTRK);      <<01123>>58714000
              ASSEMBLE(DDUP);                                  <<01123>>58716000
              FSECT := TOS;                                    <<01123>>58718000
              LSECT := TOS+DOUBLE(MHINFOL(X))-1D;              <<01123>>58720000
                                                               <<01123>>58722000
       <<---------------------------------------------------->><<01123>>58724000
       <<CHECK THAT TRACK TO BE DELETED IS NOT IN A BAD PLACE>><<01123>>58726000
       <<---------------------------------------------------->><<01123>>58728000
CHECKDEL:                                                      <<03550>>58732000
              IF FSECT <= END'RESERVED(LDEV) THEN              <<03550>>58734000
                BEGIN  << IN RESERVED AREA >>                  <<01123>>58736000
                  MESSAGE(M227);                               <<01123>>58738000
                  GO REQLCH;                                   <<01123>>58740000
                END;                                           <<01123>>58742000
              IF TYPE=MHDISCTYPE THEN                          <<01123>>58744000
                BEGIN  <<CHECK FOR TRACK USED AS ALTERNATE>>   <<01123>>58746000
                  DISC(READ,LDEV,1D,DTT,128);                  <<01123>>58748000
                  IF DTT(DTTLPS)*MHINFO(INDEX+MHTRKCYL) <=N<=  <<01123>>58750000
                    DTT(DTTALT)-1 THEN                         <<01123>>58752000
                    BEGIN  <<IN ALTERNATE AREA>>               <<01123>>58754000
                      I := 0;                                  <<01123>>58756000
                      WHILE (I:=I+1)<=DTT DO                   <<01123>>58758000
                      IF DTT(I).(14:2)=3 THEN<<REASSGND TRACK>><<01123>>58760000
                      IF ALTTRACK(LDEV,DTT(I)&LSR(2))=N THEN   <<01123>>58762000
                        BEGIN       << SPECIFIED TRACK IS AN >><<01123>>58764000
                          MESSAGE(M229);<<ALT. - CAN'T DELETE>><<01123>>58766000
                          GO REQLCH;                           <<01123>>58768000
                        END;                                   <<01123>>58770000
                    END;                                       <<01123>>58772000
                END;                                           <<01123>>58774000
              IF LDEV=SYSDISC THEN                             <<01123>>58776000
                BEGIN  <<CHECK FOR SPECIAL AREAS ON SYS DISC>> <<01123>>58778000
                  IF NOT (RELOAD)                              <<03612>>58782000
                    THEN                                       <<03612>>58784000
                      BEGIN                                    <<03612>>58786000
                        IF CHECK'RESIDENT(FSECT,LSECT)         <<03612>>58788000
                          THEN                                 <<03612>>58790000
                            BEGIN                              <<03612>>58792000
                              MESSAGE(M236);<<IN SYS RESIDENT>><<03612>>58794000
                                            <<TAB - CAN'T DEL>><<03612>>58796000
                              GO REQLCH;                       <<03612>>58798000
                            END;                               <<03612>>58800000
                        IF CHECK'DIRECTORY(FSECT,LSECT)        <<03612>>58802000
                          THEN                                 <<03612>>58804000
                            BEGIN                              <<03612>>58806000
                              MESSAGE(M228); <<IN DIRECTORY>>  <<03612>>58808000
                                             <<CAN'T DELETE>>  <<03612>>58810000
                              GO REQLCH;                       <<03612>>58812000
                            END;                               <<03612>>58814000
                      END;                                     <<03612>>58816000
                    IF NOT LOADFROMTAPE THEN                   <<MPEIV>>58818000
                      BEGIN  <<CHECK FOR TRACK IN SYSTEM AREA>><<01123>>58820000
                        CHECKSYS(FSECT, LSECT);                <<01123>>58822000
                        IF <> THEN                             <<01123>>58824000
                          BEGIN  <<IN SYSTEM AREA>>            <<01123>>58826000
                            MESSAGE(M230);                     <<01123>>58828000
                            GO REQLCH;                         <<01123>>58830000
                          END;                                 <<01123>>58832000
                      END;                                     <<01123>>58834000
                END;                                           <<01123>>58836000
                                                               <<03613>>58838000
                  << Check to make sure it does not overlap >> <<03613>>58840000
                  << the disc free space data structures.   >> <<03613>>58842000
                                                               <<03613>>58844000
                  IF NOT reload THEN                           <<03613>>58846000
                  IF Check'If'Overlaps'Dfs'Data'Structures (   <<03613>>58848000
                        ldev, fsect, lsect) THEN               <<03613>>58850000
                     BEGIN  << Overlap >>                      <<03613>>58852000
                                                               <<03613>>58854000
                        Message (m237);                        <<03613>>58856000
                        GOTO Reqlch;                           <<03613>>58858000
                                                               <<03613>>58860000
                     END;   << Overlap >>                      <<03613>>58862000
                                                               <<03613>>58864000
              IF NOT RELOAD OR RESTORE THEN                    <<03714>>58868000
                 BEGIN                                         <<03714>>58870000
                                                               <<03714>>58872000
                 IF CHECK'VM(LDEV,FSECT,LSECT) THEN            <<03714>>58874000
                    BEGIN                                      <<03714>>58876000
                    MESSAGE(M2242);   << WARNING: IN VM >>     <<03714>>58878000
                                                               <<03714>>58880000
                    GETYESNO(@REQLCH, M2230);   << DELETE? >>  <<03714>>58882000
                    END;                                       <<03714>>58884000
                 END;                                          <<03714>>58886000
                                                               <<03714>>58888000
              DELDTTENTRIES(N);                                <<BB.02>>58890000
              << REMOVE ALL ENTRIES FOR THIS TRACK >>          <<BB.02>>58892000
              TOS := ADDDTTENTRY(N&LSL(2)+2);                  <<BB.02>>58894000
              << ADD DELETED ENTRY >>                          <<BB.02>>58896000
              IF TOS=0 THEN MESSAGE(M225)  <<TABLE FULL>>      <<BB.02>>58898000
              ELSE                                             <<BB.02>>58900000
                BEGIN         << FLAG DELETED TRACK >>         <<03714>>58904000
                                                               <<03714>>58906000
                  << FIRST CHECK TO SEE IF THIS TRACK IS    >> <<03714>>58908000
                  << SITUATED SUCH THAT A RECOVER LOST DISC >> <<03714>>58910000
                  << SPACE WILL BE NECESSARY AFTER IT IS    >> <<03714>>58912000
                  << DELETED.                               >> <<03714>>58914000
                                                               <<03714>>58916000
                  IF RECOVERY'NEEDED(LDEV,FSECT,LSECT) THEN    <<03714>>58918000
                     RECOVERY := TRUE;    << SET FLAG >>       <<03714>>58920000
                                                               <<03714>>58922000
                  IF TYPE = MHDISCTYPE THEN                    <<03714>>58924000
                     FLAGTRACK(LDEV,N,0);   << DELETE TRACK >> <<03714>>58926000
                                                               <<03714>>58928000
                END;                                           <<03714>>58930000
                                                               <<03714>>58932000
              DISC(WRITE,LDEV,1D,DTT,128); <<UPDATE TABLE>>    <<01123>>58934000
              GO REQLCH;                                       <<01123>>58936000
ENDDTT:     END;  << END OF DEFECTIVE TRACKS DIALOG >>         <<01123>>58938000
                                                               <<01123>>58940000
          IF DTTCHANGES THEN   << LIST DEFECTIVE TRACK/ >>     <<03549>>58942000
             LIST'DEFECTS;     << SECTOR INFORMATION?   >>     <<03549>>58944000
          <<------------------------------------------------->><<RH.PV>>58946000
          <<UPDATE VOLUME TABLE FOR MOUNTED PRIVATE VOLUMES  >><<RH.PV>>58948000
          <<------------------------------------------------->><<RH.PV>>58950000
          LDEV := 0;                                           <<RH.PV>>58952000
          MVOL := HVOL;  << FILL PV AREA OF VTAB >>            <<01035>>58954000
          WHILE (LDEV:=LDEV+1) <= HLDEV DO                     <<RH.PV>>58956000
          IF NON'DS'LDEV(LDEV) AND                             <<03549>>58958000
            LDT(LDEV*LDTSIZE+LDT2).RANGE=DIRACCESS THEN        <<03550>>58960000
          IF LPDT(LDEV*LPDTSIZE+LPDT1).NSDV = 1 THEN           <<RH.PV>>58962000
            BEGIN   <<ITS A NON-SYSTEM DOMAIN (PV) DISC>>      <<RH.PV>>58964000
                INDEX := ADDVOL(,TRUE);                        <<RH.PV>>58966000
                IF <> THEN LDEV:= HLDEV;                       <<04264>>58968000
            END;                                               <<RH.PV>>58972000
          SYSVOL := LDT(LDTSIZE+LDT1).VOL;                              58974000
          IF VTABCHANGES AND LGETYESNO(M2201) THEN LISTVOL;    <<MPEIV>>58976000
END;  <<  MAINSEG1  >>                                         <<03603>>58978000
$PAGE "MAINSEG1A"                                              <<03603>>58980000
$CONTROL SEGMENT=MAINSEG1A                                     <<03603>>58982000
PROCEDURE MAINSEG1A;                                           <<03603>>58984000
BEGIN                                                          <<03603>>58986000
   DEFINE D'NSECTPAGE = DOUBLE(NSECTPAGE)#;                    <<03603>>58988000
   EQUATE  IOPNTR = 4;       << DIRBASE'+4 >>                  <<SY>>   58990000
   DOUBLE                                                      <<03603>>58992000
      SECTORS,                                                 <<03603>>58994000
      NRSECT,                                                  <<03603>>58996000
      VDSLEN,                                                  <<03603>>58998000
      VDSTART,                                                 <<03603>>59000000
      START,                                                   <<03603>>59002000
      DISCADR;                                                 <<03603>>59004000
   LOGICAL                                                     <<03603>>59006000
      VOLUME,                                                  <<03603>>59008000
      VDSTART1   = VDSTART,                                    <<03603>>59010000
      VDSTART2   = VDSTART+1,                                  <<03603>>59012000
      VDSLEN1    = VDSLEN,                                     <<03603>>59014000
      VDSLEN2    = VDSLEN+1;                                   <<03603>>59016000
   BYTE ARRAY NAME(0:79);                                      <<03603>>59018000
   DOUBLE DCOREADDR;  << DOUBLE WORD CORE ADDRESS >>           <<03603>>59020000
   LOGICAL BANK      = DCOREADDR,                              <<03603>>59022000
           COREADDR  = DCOREADDR+1;                            <<03603>>59024000
   INTEGER                                                     <<03603>>59026000
                                                               <<03635>>59028000
      LEN,                                                     <<03603>>59030000
      SIZE,                                                    <<03603>>59032000
      ILOC,                                                    <<03603>>59034000
      I,                                                       <<03603>>59036000
      TEMP;                                                    <<03603>>59038000
                                                               <<03635>>59040000
   POINTER DVCL;   << WORD POINTER TO CLASS TABLE >>           <<04306>>59042000
   INTEGER HI'STARFISH'DRT; << HIGHEST DRT ON STARTFISH >>     <<03603>>59044000
   INTEGER                                                     <<03675>>59046000
      STKNRSECT;  << INITIAL'S STACK SIZE IN SECTORS >>        <<03675>>59048000
   INTEGER                                                     <<03603>>59050000
      LCDISCADR,        <<DISC ADDRESS OF LOW CORE>>           <<03603>>59052000
      TCSTDISCADR,      <<DISC ADDRESS OF TCST>>               <<03603>>59054000
      ININDISCADR,      <<DISC ADDRESS ON INTERNAL INTS>>      <<03603>>59056000
      STACKDISCADR;     <<DISC ADDRESS OF BOOT STACK>>         <<03603>>59058000
   DOUBLE                                                      <<03603>>59060000
      STACK'DISC'ADR;   <<DISC ADDRESS OF INITIAL'S STK>>      <<03603>>59062000
   INTEGER ARRAY CLBUF(0:34); <<COLD LOAD READ INFO>>          <<03603>>59064000
   INTEGER POINTER CLPNTR;                                     <<03603>>59066000
   DOUBLE POINTER CLDPNTR = CLPNTR;                            <<03603>>59068000
        INTEGER ARRAY CORESIZES(0:NCORESIZES-1) = PB :=        <<03603>>59070000
        64, 80, 96, 128, 160, 192, 224, 256, 384, 512, 768,    <<03603>>59072000
        1024, 1152, 1280, 1408, 1536, 1664, 1792, 1920, 2048,  <<03603>>59074000
        2176, 2304, 2432, 2560, 2688, 2816, 2944, 3072,        <<03603>>59076000
        3200, 3328, 3456, 3584, 3712, 3840, 3968, 4096;        <<03603>>59078000
                                                               <<03603>>59080000
        DOUBLE ARRAY USEDCORE(0:NCORESIZES-1)=PB:=             <<03603>>59082000
        << LAST ADDRESS+1 FOR GIVEN MEMORY SIZE >>             <<03603>>59084000
        <<64K>>%200000D,   <<80K>>%240000D,                    <<03603>>59086000
        <<96K>>%300000D,   <<128K>>%400000D,                   <<03603>>59088000
        <<160K>>%500000D,  <<192K>>%600000D,                   <<03603>>59090000
        <<224K>>%700000D,  <<256K>>%1000000D,                  <<03603>>59092000
        <<384K>>%1400000D, <<512K>>%2000000D,                  <<03603>>59094000
        <<768K>>%3000000D, <<1024K>>%4000000D,                 <<03603>>59096000
        <<1152>>%4400000D, <<1280K>>%5000000D,                 <<03603>>59098000
        <<1408>>%5400000D, <<1536K>>%6000000D,                 <<03603>>59100000
        <<1664>>%6400000D, <<1792K>>%7000000D,                 <<03603>>59102000
        <<1920>>%7400000D, <<2048K>>%10000000D,                <<03603>>59104000
        <<2176>>%10400000D,<<2304K>>%11000000D,                <<03603>>59106000
        <<2432>>%11400000D,<<2560K>>%12000000D,                <<03603>>59108000
        <<2688>>%12400000D,<<2816K>>%13000000D,                <<03603>>59110000
        <<2944>>%13400000D,<<3072K>>%14000000D,                <<03603>>59112000
        <<3200>>%14400000D,<<3328K>>%15000000D,                <<03603>>59114000
        <<3456>>%15400000D,<<3584K>>%16000000D,                <<03603>>59116000
        <<3712>>%16400000D,<<3840K>>%17000000D,                <<03603>>59118000
        <<3968>>%17400000D,<<4096K>>%20000000D;                <<03603>>59120000
        <<-------------------------->>                         <<MPEIV>>59122000
        <<  VIRTUAL MEMORY CHANGES  >>                         <<MPEIV>>59124000
        <<-------------------------->>                         <<MPEIV>>59126000
                                                               <<MPEIV>>59128000
VERIFYVM;  << VERIFY VALIDITY OF VM VALUES >>                  <<MPEIV>>59130000
                                                               <<MPEIV>>59132000
WHILE VTAB(SYSVOL*VTABSIZE+VTAB12).VMS <> 1 OR                 <<01682>>59134000
  CHANGES AND LGETYESNO(M2215) DO                              <<01682>>59136000
  << VIRTUAL MEMORY CHANGES - FORCE ENTRY INTO DIALOG IF    >> <<01682>>59138000
  << THERE IS NO VIRTUAL MEMORY ON THE SYSTEM DISC.         >> <<01682>>59140000
  BEGIN  << VIRTUAL MEMORY CHANGES? >>                         <<MPEIV>>59142000
  IF LGETYESNO(M2216) THEN LISTVM;                             <<MPEIV>>59144000
  << LIST VIRTUAL MEMORY ALLOCATION? >>                        <<MPEIV>>59146000
REDO:                                                          <<MPEIV>>59148000
  MESSAGE(-M2217);  << ENTER VOLUME, SIZE IN KILO SECTORS >>   <<MPEIV>>59150000
  READINPUT;                                                   <<MPEIV>>59152000
  SCAN BINBUF WHILE BLANK, 1;                                  <<MPEIV>>59154000
  IF NOCARRY THEN  << NOT CARRAGE RETURN INPUT >>              <<MPEIV>>59156000
    BEGIN                                                      <<MPEIV>>59158000
    @BPINBUF := TOS;                                           <<MPEIV>>59160000
    << IF 1ST BYTE = ALPHA NAME WAS INPUT ELSE LDEV WAS INPUT>><<MPEIV>>59162000
    IF BPINBUF = ALPHA THEN                                    <<MPEIV>>59164000
      BEGIN  << GET VOLUME # FROM NAME >>                      <<MPEIV>>59166000
      MOVE NAME := "        ";  << 8 BLANKS >>                 <<MPEIV>>59168000
      MOVE NAME := BPINBUF WHILE ANS, 0;                       <<MPEIV>>59170000
      DELB;  << SAVE SOURCE, DELETE DESTINATION >>             <<MPEIV>>59172000
      IF BPS0 <> "," THEN                                      <<MPEIV>>59174000
        BEGIN                                                  <<MPEIV>>59176000
WRONG:  MESSAGE(M2453);  << ILLEGAL INPUT >>                   <<MPEIV>>59178000
        GOTO REDO;                                             <<MPEIV>>59180000
        END;                                                   <<MPEIV>>59182000
      @BPINBUF := TOS+1;  << SKIP COMMA >>                     <<MPEIV>>59184000
      VOLUME := FINDVOL(NAME);                                 <<MPEIV>>59186000
      IF <> THEN                                               <<MPEIV>>59188000
        BEGIN                                                  <<MPEIV>>59190000
        MESSAGE(M2205);  << NO SUCH VOLUME >>                  <<MPEIV>>59192000
        GOTO REDO;                                             <<MPEIV>>59194000
        END;                                                   <<MPEIV>>59196000
      VOLUME := VOLUME / VTABSIZE;                             <<MPEIV>>59198000
      END                                                      <<MPEIV>>59200000
    ELSE                                                       <<MPEIV>>59202000
      BEGIN  << GET VOLUME # FROM LDEV >>                      <<MPEIV>>59204000
      LDEV := INVAL(@WRONG);                                   <<MPEIV>>59206000
      IF >= THEN GOTO WRONG;                                   <<MPEIV>>59208000
      << BPINBUF NOW POINTING JUST PAST COMMA >>               <<MPEIV>>59210000
      VOLUME := GETVOL(LDEV);                                  <<MPEIV>>59212000
      IF <> THEN                                               <<MPEIV>>59214000
        BEGIN                                                  <<MPEIV>>59216000
        MESSAGE(M2205);  << NO SUCH VOLUME >>                  <<MPEIV>>59218000
        GOTO REDO;                                             <<MPEIV>>59220000
        END;                                                   <<MPEIV>>59222000
      END;                                                     <<MPEIV>>59224000
                                                               <<MPEIV>>59226000
  << GOT VOLUME NOW GET SIZE >>                                <<MPEIV>>59228000
    SECTORS := DINVAL(@WRONG);  << REQUESTED VALUE IN SECTORS>>         59230000
    IF <= THEN GOTO WRONG;                                     <<!>>    59232000
    SECTORS := SECTORS * 1024D;  << CONVERT TO KILO SECTORS >>          59234000
                                                               <<MPEIV>>59236000
    LDEV := GETLDEV(VOLUME);                                   <<MPEIV>>59238000
                                                               <<MPEIV>>59240000
    IF LDEV = SYSDISC AND NOT RELOAD THEN                      <<MPEIV>>59242000
      BEGIN                                                    <<MPEIV>>59244000
      MESSAGE(M2402);  << SYSDISC VM SIZE ONLY CHANGED ON REL>><<MPEIV>>59246000
      GOTO REDO;                                               <<MPEIV>>59248000
      END;                                                     <<MPEIV>>59250000
                                                               <<MPEIV>>59252000
    IF VTAB(VOLUME*VTABSIZE+VTAB12).VMS = 1 THEN               <<MPEIV>>59254000
      BEGIN                                                    <<MPEIV>>59256000
      VDSTART1 := VTAB(VOLUME*VTABSIZE+VTAB8);                 <<MPEIV>>59258000
      VDSTART2 := VTAB(X:=X+1);                                <<MPEIV>>59260000
      VDSLEN1  := VTAB(X:=X+1);                                <<MPEIV>>59262000
      VDSLEN2  := VTAB(X:=X+1);                                <<MPEIV>>59264000
      END                                                      <<MPEIV>>59266000
    ELSE                                                       <<MPEIV>>59268000
      BEGIN                                                    <<MPEIV>>59270000
      VDSTART := 0D;                                           <<MPEIV>>59272000
      VDSLEN := 0D;                                            <<MPEIV>>59274000
      END;                                                     <<MPEIV>>59276000
                                                               <<MPEIV>>59278000
  << VIRTUAL MEMORY SIZE HAS CHANGED >>                        <<MPEIV>>59280000
    IF NOT RELOAD AND VDSLEN <> 0D THEN                        <<MPEIV>>59282000
      BEGIN  << RELEASE OLD VIRTUAL MEMORY SPACE >>            <<MPEIV>>59284000
      RELEASEVM(LDEV, VDSLEN, VDSTART);                        <<MPEIV>>59286000
      END;                                                     <<MPEIV>>59288000
                                                               <<MPEIV>>59290000
    IF SECTORS = 0D THEN                                       <<MPEIV>>59292000
      BEGIN  << DELETE VIRTUAL MEMORY, ZERO OLD VALUES >>      <<MPEIV>>59294000
      VDSTART := 0D;                                           <<MPEIV>>59296000
      VDSLEN := 0D;                                            <<MPEIV>>59298000
      END                                                      <<MPEIV>>59300000
    ELSE                                                       <<MPEIV>>59302000
      BEGIN  << TRY TO GET NEW SPACE FOR VIRTUAL MEMORY >>     <<MPEIV>>59304000
      IF RELOAD THEN                                           <<MPEIV>>59306000
        BEGIN                                                  <<MPEIV>>59308000
        << ALLOCATE SPACE AFTER DFS TABLES ARE REINITIALIZED >><<MPEIV>>59310000
        << FOR NOW JUST CHANGE VTAB >>                         <<MPEIV>>59312000
        VDSTART := 0D;                                         <<MPEIV>>59314000
        VDSLEN := SECTORS;                                     <<MPEIV>>59316000
        END  << RELOAD >>                                      <<MPEIV>>59318000
      ELSE                                                     <<MPEIV>>59320000
        BEGIN  << NOT RELOAD - GET SPACE FROM DFS >>           <<MPEIV>>59322000
        GETVM(LDEV, SECTORS, START);  << GET ANY SPACE >>      <<MPEIV>>59324000
        IF <> THEN                                             <<MPEIV>>59326000
          BEGIN  << COULDN'T GET SPACE REQUESTED >>            <<MPEIV>>59328000
          MESSAGE(M2218);  << INSUFFICIENT DISC SPACE >>       <<MPEIV>>59330000
          IF VDSLEN <> 0D THEN                                 <<MPEIV>>59332000
            BEGIN  << GET OLD SPACE BACK >>                    <<MPEIV>>59334000
            GETVM(LDEV, VDSLEN, VDSTART, TRUE);                <<MPEIV>>59336000
            IF <> THEN                                         <<MPEIV>>59338000
              BEGIN                                            <<MPEIV>>59340000
              MESSAGE(M329);  << DISC SPACE ERROR >>           <<MPEIV>>59342000
              VDSTART := 0D;                                   <<MPEIV>>59344000
              VDSLEN := 0D;                                    <<MPEIV>>59346000
              END;                                             <<MPEIV>>59348000
            END;                                               <<MPEIV>>59350000
          END                                                  <<MPEIV>>59352000
        ELSE                                                   <<MPEIV>>59354000
          BEGIN  << GOT SPACE REQUESTED >>                     <<MPEIV>>59356000
          VDSTART := START;                                    <<MPEIV>>59358000
          VDSLEN := SECTORS;                                   <<MPEIV>>59360000
          END;                                                 <<MPEIV>>59362000
        END;  << NOT RELOAD >>                                 <<MPEIV>>59364000
      END;  << SECTORS <> 0 >>                                 <<MPEIV>>59366000
                                                               <<MPEIV>>59368000
    VTAB(VOLUME*VTABSIZE+VTAB8) := VDSTART1;                   <<MPEIV>>59370000
    VTAB(X:=X+1) := VDSTART2;                                  <<MPEIV>>59372000
    VTAB(X:=X+1) := VDSLEN1;                                   <<MPEIV>>59374000
    VTAB(X:=X+1) := VDSLEN2;                                   <<MPEIV>>59376000
    IF VDSLEN = 0D THEN VTAB(X:=X+1).VMS := 0                  <<MPEIV>>59378000
    ELSE VTAB(X:=X+1).VMS := 1;                                <<MPEIV>>59380000
                                                               <<MPEIV>>59382000
    GOTO REDO;                                                 <<MPEIV>>59384000
    END;  << NOT A CARRAGE RETURN INPUT >>                     <<MPEIV>>59386000
  IF VTAB(SYSVOL*VTABSIZE+VTAB12).VMS <> 1 THEN                <<01682>>59388000
    MESSAGE(M2220);  << NO V.M. ALLOCATION ON SYSTEM DISC >>   <<01682>>59390000
  END;  << VIRTUAL MEMORY CHANGES >>                           <<MPEIV>>59392000
                                                               <<00458>>59394000
          <<--------------------------------------->>          <<00458>>59396000
          <<UPDATE COLDLOADID IN SYSTEM DISC LABELS>>          <<00458>>59398000
          <<--------------------------------------->>          <<00458>>59400000
CONFDONE:                                                      <<00683>>59402000
          I:=0;                                                <<00458>>59404000
          WHILE (I:=I+1)<=HVOL DO                              <<00458>>59406000
          IF VTAB(I*VTABSIZE)<>0 THEN                          <<00458>>59408000
             BEGIN <<MOUNTED SYSTEM VOLUME>>                   <<00458>>59410000
             LDEV:=VTAB(I*VTABSIZE+VTAB12).VTABLDEV;           <<00458>>59412000
             IF LPDT(LDEV*LPDTSIZE+LPDT1).NSDV=0 THEN          <<00458>>59414000
                BEGIN                                          <<00458>>59416000
                                                               <<03672>>59418000
                << LOCK IN CS'80 DISC DRIVES HERE.  WE DO >>   <<03672>>59420000
                << IT HERE DELIBERATELY BECAUSE THIS IS   >>   <<03672>>59422000
                << THE POINT OF NO RETURN IN INITIAL--WE  >>   <<03672>>59424000
                << ARE UPDATING THE COLDLOADID'S.  SET    >>   <<03672>>59426000
                << CS80'LOCK FOR CS80'DRIVER SO THAT IN   >>   <<03672>>59428000
                << CASE AN UNDELIBERATE DEVICE CLEAR IS   >>   <<03672>>59430000
                << DONE, IT WILL RE-LOCK THE CS'80 DEVICE >>   <<03672>>59432000
                                                               <<03672>>59434000
                CS80'LOCK := TRUE;   << SET FLAG FOR DRIVER >> <<03672>>59436000
                IF LDT(LDEV*LDTSIZE+LDT2).TYP = DISC3 THEN     <<03672>>59438000
                   DISC(LOCK'DEV,LDEV,0D,DTEMP,2);             <<03672>>59440000
                                                               <<03672>>59442000
                DISC(READ,LDEV,0D,LBUF,128);                   <<00458>>59444000
                LBUF(LABCOLDLOADID):=COLDLOADID+1;             <<00458>>59446000
                DISC(WRITE,LDEV,0D,LBUF,128);                  <<00458>>59448000
                END;                                           <<00458>>59450000
             END;                                              <<00458>>59452000
                                                               <<00458>>59454000
                                                               <<01123>>59456000
              IF CHANGES THEN                                  <<01123>>59458000
                BEGIN  <<ASK QUESTIONS>>                       <<01123>>59460000
                  IF LOGGING THEN                              <<01123>>59462000
                    << DISABLE LOGGING? >>                     <<01123>>59464000
                    LOGGING := NOT(LGETYESNO(M2450));          <<01123>>59466000
REQMKILS:         I := LDNTOA(DCTAB0(KILOSECTS),10,BINBUF(1)); <<01123>>59468000
                  MESSAGE(-M2353);<<MAX# SPOOLFILE KILOSECT'S>><<01123>>59470000
                  BINBUF := "=";                               <<01123>>59472000
                  BINBUF(I+1):="?";                            <<01123>>59474000
                  PRINT(INBUF,-I-2,%320);                      <<01123>>59476000
                  READINPUT;                                   <<01123>>59478000
                  TOS := DINVAL(@REQMKILS);                    <<01123>>59480000
                  IF = THEN                                    <<01123>>59482000
                    BEGIN                                      <<01123>>59484000
                      DEL;                                     <<01123>>59486000
                      GO REQEXTS;                              <<01123>>59488000
                    END;                                       <<01123>>59490000
                  IF > THEN                                    <<01123>>59492000
                    DCTAB0(KILOSECTS) := TOS;                  <<01123>>59494000
REQEXTS:          ILOC:= CTAB0(EXTSSECT');                     <<02834>>59496000
REQEXTSR:         GETNEWVAL(M2354,CTAB0(EXTSSECT'),128,32767); <<02834>>59498000
                  IF CTAB0(EXTSSECT').(14:2)<>0 THEN           <<02834>>59500000
                    BEGIN                                      <<02834>>59502000
                    MESSAGE(M2357);        <<NOT MOD 4>>       <<02834>>59504000
                    CTAB0(EXTSSECT'):= ILOC; <<RESTORE VALUE>> <<02834>>59506000
                    GO TO REQEXTSR;                            <<02834>>59508000
                    END;                                       <<02834>>59510000
                  IF NOT RELOAD AND NOT RECOVERY THEN          <<01123>>59512000
                    BEGIN  << RECOVER LOST DISC SPACE >>       <<01123>>59514000
                        GETYESNO(@CONSOL,M2451);               <<01123>>59516000
                      RECOVERY := TRUE;                        <<01123>>59518000
                    END;                                       <<01123>>59520000
                END;                                           <<01123>>59522000
          IF CTAB0(EXTSSECT')=0 THEN CTAB0(EXTSSECT'):=128;    <<01123>>59524000
CONSOL:                                                        <<01123>>59526000
                                                               <<01123>>59528000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<01123>>59530000
<<-------------------------------------------->>               <<00888>>59532000
<<RECONFIGURE CONSOLE TO REFLECT SPEED SENSING>>               <<00888>>59534000
<<-------------------------------------------->>               <<00888>>59536000
LDTX(CONSOLELDEV*LDTXSIZE) := BAUDRATE;                        <<03003>>59538000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>59540000
$PAGE "MAINSEG1  --  GET DISC SPACE FOR SYSTEM"                         59542000
          <<---------------------------------                           59544000
            INITIALIZE DISC FREE SPACE MAPS                             59546000
          --------------------------------->>                           59548000
          LDT := HLDEV&LSL(8)+LDTSIZE;  <<FIRST WORD OF LDT>>  <<03603>>59552000
          TOS := DVCLSIZE&LSR(1);  <<SIZE IN WORDS>>           <<03603>>59554000
          LDT(DCSIZE) := S0;                                   <<03603>>59556000
          CTAB0(DVCLSIZE') := TOS;                             <<03603>>59558000
          CTAB0(HLDEV') := HLDEV;                              <<03603>>59560000
          CTAB0(HVOL') := NVOL;                                <<03603>>59562000
          INFO(H'VOL') := NVOL;                                <<03603>>59564000
          VTAB(VTABSYSVOLNUM) := HVOL;                         <<03603>>59566000
          LDT(DCFIRST) := (HLDEV+1)*LDTSIZE; <<PTR TO DVCLTAB>><<03603>>59568000
          LPDT := HLDEV&LSL(8)+LPDTSIZE;                       <<03603>>59570000
          VTAB := MVOL&LSL(8)+VTABSIZE;                        <<03603>>59572000
          VTAB(VMINTEGRITY) := COLDLOADID+1;                   <<03603>>59574000
          IF NOT RELOAD THEN                                   <<03603>>59576000
            BEGIN<<FORCE AGREEMENT ON NEXT COLD LOAD IF ABORTED<<03603>>59578000
              VTAB(VTABCOLDLOADID) := COLDLOADID+1;            <<03603>>59580000
              INFO(COLD'LOAD'ID') := COLDLOADID+1;             <<03603>>59582000
              DISC(WRITE,SYSDISC,D'L(INFOSECTOR)),INFO,        <<03603>>59584000
                 INFOSIZE);                                    <<03603>>59586000
              DISC(WRITE,SYSDISC,TABLEINFO(VTABINFOX+1),VTAB,  <<03603>>59588000
                (MVOL+1)*VTABSIZE);                            <<03603>>59590000
            END                                                <<03603>>59592000
          ELSE                                                 <<03603>>59594000
            BEGIN  <<INITIALIZE SPACE MAPS>>                   <<03603>>59596000
              I := 0;                                          <<03603>>59598000
              WHILE (I:=I+1) <= HVOL DO                        <<03603>>59600000
                 IF VTAB(I*VTABSIZE) <> 0 THEN                 <<03603>>59602000
                    Init'Disc'Free'Space'Map(GETLDEV(I));      <<03615>>59604000
            END;                                               <<03603>>59606000
                                                               <<03603>>59608000
                                                               <<03603>>59610000
          <<------------------------------------>>             <<03603>>59612000
          <<  WRITE INITIAL'S SEGMENTS TO DISC  >>             <<03603>>59614000
          <<------------------------------------>>             <<03603>>59616000
                                                               <<03603>>59618000
          NUTCST := NTCST;                                     <<03603>>59620000
          DO NUTCST:=NUTCST-1 UNTIL TCST(NUTCST*4) <> 0;       <<03603>>59622000
                                                               <<03603>>59624000
          @TCSTDISC := @SEGDISCADR;<<DISCADR PTR>>             <<03603>>59626000
          IF NOT LOADFROMTAPE THEN                             <<03603>>59628000
            BEGIN  << MOVE DISC ADDRS FROM INFO TO TCSTDISC >> <<03603>>59630000
            I := 0;                                            <<03603>>59632000
            DO TCSTDISC(I+1) := TCSTINFO(I&LSL(1)+1)           <<03603>>59634000
               UNTIL (I:=I+1)=NUTCST;                          <<03603>>59636000
            END                                                <<03603>>59638000
          ELSE                                                 <<03603>>59640000
            BEGIN  <<WRITE SEGMENTS TO DISC>>                  <<03603>>59642000
                                                               <<03603>>59644000
            IF SERIALDISCLOAD THEN                             <<03603>>59646000
              BEGIN  <<Setup to Read Serial Disc>>             <<03603>>59648000
              SDISCREEL:=0;                                    <<03603>>59652000
              COLD'LOAD'MEDIA(REWIND);<<This Forces TZT'INIT >><<03603>>59654000
              END;   <<Setup to Read Serial Disc>>             <<03603>>59656000
                                                               <<03603>>59658000
            <<  MODIFY ININ  -  CHANGE COLD LOAD TRAP LABEL >> <<03603>>59660000
            <<  FOR DISC BOOT.  STT 44 := STT 45            >> <<03603>>59662000
            TOS := TCST(6);  << ININ BANK >>                   <<03603>>59664000
            TOS := TCST(7)+TCST(4).(4:12)*4-%46;               <<03603>>59666000
            ASSEMBLE( LSEA; INCB; SSEA; DDEL );                <<03603>>59668000
                                                               <<03603>>59670000
            <<  RELEASE DISC SPACE FOR THE OLD VERSION  >>     <<03603>>59672000
            <<  OF INITIAL.                             >>     <<03603>>59674000
            IF NOT RELOAD THEN                                 <<03603>>59676000
               BEGIN                                           <<03603>>59678000
               I := 0;                                         <<03603>>59680000
               DO BEGIN                                        <<03603>>59682000
                  IF TCSTINFO(I&LSL(1)+1) >                    <<03603>>59684000
                     END'RESERVED(SYSDISC) THEN                <<03603>>59686000
                     BEGIN                                     <<03603>>59688000
                     TOS := TCSTINFO(I&LSL(1))&DLSR(16);       <<03603>>59690000
                     TOS := (TOS+127)&LSR(7);                  <<03603>>59692000
                     NRSECT := TOS;                            <<03603>>59694000
                     RETDISCSPACE(SYSDISC, NRSECT,             <<03603>>59696000
                        TCSTINFO(I&LSL(1)+1));                 <<03603>>59698000
                     END;                                      <<03603>>59700000
                  END UNTIL (I:=I+1) = INFO(NUTCST');          <<03603>>59702000
               END;                                            <<03603>>59704000
                                                               <<03603>>59706000
           INFO(NUTCST') := NUTCST;<<NR CST'S FOR NEW INITIAL>><<03603>>59708000
                                                               <<03603>>59710000
           I := 1; << FIRST CST >>                             <<03603>>59712000
           DO                                                  <<03603>>59714000
              BEGIN                                            <<03603>>59716000
              SIZE := TCST(I&LSL(2)).(4:12)&LSL(2);            <<03603>>59718000
                                                               <<03603>>59720000
              IF 1 <= I <= 2 THEN                              <<03603>>59722000
                BEGIN  << ININ OR BOOTSTRAP SEGMENT >>         <<03603>>59724000
                TOS := 0;                                      <<03603>>59726000
                TOS := BOOTDISCSPACE(SIZE);  <<GET BOOT SPACE>><<03603>>59728000
                TCSTDISC(I) := TOS;                            <<03603>>59730000
                END                                            <<03603>>59732000
              ELSE                                             <<03603>>59734000
                BEGIN                                          <<03603>>59736000
                DTEMP := D'L((SIZE+127)&LSR(7)));              <<03603>>59738000
                SUPERDISCSPACE(-SYSDISC,1,0,DTEMP,TCSTDISC(I));<<03603>>59740000
                IF <> THEN ERRMESSAGE(M326, SYSDISC);          <<03603>>59742000
                TOS := TCSTDISC(I);                            <<03603>>59744000
                BS1 := 0;      <<ZERO VOLUME INDEX>>           <<03603>>59746000
                TCSTDISC(X) := TOS;                            <<03603>>59748000
                END;                                           <<03603>>59750000
                                                               <<03603>>59752000
              TOS := TCSTDISC(I);                              <<03603>>59754000
              TOS := SIZE;                                     <<03603>>59756000
              TOS := TCST(I&LSL(2)+2); << BANK OF SEGMENT >>   <<03603>>59758000
              TOS := TCST(X:=X+1); << ADDRESS OF SEGMENT >>    <<03603>>59760000
              DCOREADDR := DS1;                                <<03603>>59762000
              DELB;  << DELETE THE BANK >>                     <<03603>>59764000
              TCSTINFO((I-1)&LSL(1)) := TOS;                   <<03603>>59766000
              TCSTINFO(X:=X+1) := TOS;  <<DISC ADDRESS ALSO>>  <<03603>>59768000
                                                               <<03603>>59770000
              IF DCOREADDR <> 0D THEN                          <<03603>>59772000
                 BEGIN                                         <<03603>>59774000
                 TOS:=0; TOS:=I; HELP'MAKE'ABSENT; DDEL;       <<03603>>59776000
                 DISC'(WRITE,SYSDISC,TCSTDISC(I),DCOREADDR,    <<03603>>59778000
                       SIZE);  << WRITE SEGMENT TO DISC >>     <<03603>>59780000
                 TOS:=1; TOS:=I; HELP'MAKE'PRESENT; DDEL;      <<03603>>59782000
                 END                                           <<03603>>59784000
              ELSE                                             <<03603>>59786000
                BEGIN   <<MUST READ FROM TAPE>>                <<03603>>59788000
                DISCADR := TCSTDISC(I);                        <<03603>>59790000
                TEMP := SIZE;                                  <<03603>>59792000
                WHILE TEMP <> 0 DO                             <<03603>>59794000
                   BEGIN                                       <<03603>>59796000
                   LEN := IF TEMP > TAPERECSIZE THEN           <<03603>>59798000
                      TAPERECSIZE ELSE TEMP;                   <<03603>>59800000
                   COLD'LOAD'MEDIA( READ,TAPEBUF,LEN);         <<03603>>59802000
                   WHILE END'OF'TAPE DO                        <<03603>>59804000
                      BEGIN                                    <<03603>>59806000
                      NEXTREEL( TAPEBUF);                      <<03603>>59808000
                      COLD'LOAD'MEDIA( READ,TAPEBUF,LEN);      <<03603>>59810000
                      END;                                     <<03603>>59812000
                   DISC( WRITE,SYSDISC,DISCADR,TAPEBUF,LEN);   <<03603>>59814000
                   DISCADR := DISCADR+DOUBLE((LEN+127)/128);   <<03603>>59816000
                   TEMP := TEMP-LEN;                           <<03603>>59818000
                   END;                                        <<03603>>59820000
                END;                                           <<03603>>59822000
                                                               <<03603>>59824000
              END                                              <<03603>>59826000
            UNTIL (I:=I+1) > NUTCST;                           <<03603>>59828000
            END;                                               <<03603>>59830000
          SAVE'TABLE'ADDR(CSDVRTSIZE, CSDVR, CSDVRINFOX);      <<03603>>59832000
          SAVE'TABLE'ADDR(CSDEFSIZE, CSDEF, CSDEFINFOX);       <<03603>>59834000
          SAVE'TABLE'ADDR((HLDEV+1)*DVRSIZE, DVRTAB, DVRINFOX);<<03603>>59836000
          SAVE'TABLE'ADDR(CTAB0SIZE, CTAB0, CTAB0INFOX);       <<03603>>59838000
          SAVE'TABLE'ADDR(CTABTSIZE, CTAB, CTABINFOX);         <<03603>>59840000
          SAVE'TABLE'ADDR((HLDEV+1)*LPDTSIZE, LPDT, LPDTINFOX);<<03603>>59842000
          SAVE'TABLE'ADDR((HLDEV+1)*LDTSIZE, LDT, LDTINFOX);   <<03603>>59844000
          @DVCL := WORDADDRESS(DVCLTAB);                       <<04306>>59846000
          SAVE'TABLE'ADDR(DVCLSIZE&LSR(1), DVCL, DVCLINFOX);   <<04306>>59848000
          SAVE'TABLE'ADDR((HLDEV+1)*LDTXSIZE, LDTX, LDTXINFOX);<<03603>>59850000
          SAVE'TABLE'ADDR((MVOL+1)*VTABSIZE, VTAB, VTABINFOX); <<03603>>59852000
          SAVE'TABLE'ADDR(CSTAB, CSTAB, CSTABINFOX);           <<03603>>59854000
            STKNRSECT := LOGICAL((TABLEINFO(STACKINFOX)        <<03675>>59856000
               &DLSR(16)+127D)&DLSR(7));                       <<03675>>59858000
          IF LOADFROMTAPE THEN                                 <<03603>>59860000
                                                               <<03603>>59862000
            BEGIN                                              <<03603>>59864000
            INFO(DISCENTRY) := CTAB0(DISCENTRY');              <<03603>>59866000
            INFO(DISCTST).INFODTYPE := SYSDISCTYPE;            <<03603>>59868000
            INFO(DISCTST).INFODSUBTYPE := SYSDISCSUBTYPE;      <<03603>>59870000
            INFO(SYSDISCDRT') := DVRTAB(DVRSIZE).DRTFIELD;     <<03603>>59872000
            INFO(INITDB) := DBVALUE;                           <<03603>>59874000
            INFO(INITZ) := ZVALUE;                             <<03603>>59876000
            INFO(INITQ) := QVALUE;                             <<03603>>59878000
            INFO(INITS) := SVALUE;                             <<03603>>59880000
            SAVE'TABLE'ADDR(ZVALUE, 0, STACKINFOX);            <<03603>>59882000
                                                               <<03603>>59884000
          <<------------------------------------>>             <<03603>>59886000
          <<  BUILD DISC COLD LOAD SIO PROGRAM  >>             <<03603>>59888000
          <<------------------------------------>>             <<03603>>59890000
      @CLPNTR := @CLBUF;                                       <<03603>>59892000
                                                               <<03603>>59894000
         << GET SPACE FOR LOW CORE >>                          <<03603>>59896000
                                                               <<03603>>59898000
      LCDISCADR := BOOTDISCSPACE(LCSIZE);                      <<03603>>59900000
      CLDPNTR := D'L(LCDISCADR));                              <<03603>>59902000
      CLDPNTR(1) := 0D; << MEMORY ADDRESS >>                   <<03603>>59904000
      CLPNTR(4) := LCSIZE;                                     <<03603>>59906000
      @CLPNTR := @CLPNTR+5;                                    <<03603>>59908000
                                                               <<03603>>59910000
         << GET SPACE FOR TCST >>                              <<03603>>59912000
                                                               <<03603>>59914000
      TCSTDISCADR := BOOTDISCSPACE(TCSTSIZE);                  <<03603>>59916000
      CLDPNTR := D'L(TCSTDISCADR));                            <<03603>>59918000
      CLDPNTR(1) := D'L(ABSOLUTE(CSTP)));                      <<03603>>59920000
      CLPNTR(4) := TCSTSIZE;                                   <<03603>>59922000
      @CLPNTR := @CLPNTR+5;                                    <<03603>>59924000
                                                               <<03603>>59926000
         << GET SPACE FOR INTERNAL INTERRUPTS >>               <<03603>>59928000
                                                               <<03603>>59930000
      CLDPNTR := TCSTDISC(1);<< DISC ADR OF ININ SEG >>        <<03603>>59932000
      CLPNTR(2) := TCST(6);  << ININ BANK >>                   <<03603>>59934000
      CLPNTR(3) := TCST(7);  << ININ ADDRESS >>                <<03603>>59936000
      CLPNTR(4) := TCST(4).(4:12)&LSL(2);                      <<03603>>59938000
      @CLPNTR := @CLPNTR+5;                                    <<03603>>59940000
                                                               <<03603>>59942000
         << BOOTSTRAP SEGMENT >>                               <<03603>>59944000
                                                               <<03603>>59946000
      CLDPNTR := TCSTDISC(2);<< DISC ADR OF BOOTSTRAP SEG      <<03603>>59948000
      CLPNTR(2) := TCST(10); << BOOTSTRAP BANK >>              <<03603>>59950000
      CLPNTR(3) := TCST(11); << BOOTSTRAP ADDRESS >>           <<03603>>59952000
      CLPNTR(4) := TCST(8).(4:12)&LSL(2);                      <<03603>>59954000
      @CLPNTR := @CLPNTR+5;                                    <<03603>>59956000
                                                               <<03603>>59958000
         << COLD LOAD INFORMATION TABLE >>                     <<03603>>59960000
                                                               <<03603>>59962000
      CLDPNTR := D'L(INFOSECTOR));                             <<03603>>59964000
      CLDPNTR(1) := D'L(INFOCOREADR));                         <<03603>>59966000
      CLPNTR(4) := INFOSIZE;                                   <<03603>>59968000
      @CLPNTR := @CLPNTR+5;                                    <<03603>>59970000
                                                               <<03603>>59972000
         << GET SPACE FOR BOOTSTRAP STACK >>                   <<03603>>59974000
                                                               <<03603>>59976000
      STACKDISCADR := BOOTDISCSPACE(BOOTSTACKSIZE);            <<03603>>59978000
      CLDPNTR := D'L(STACKDISCADR));                           <<03603>>59980000
      CLDPNTR(1) := D'L(ABSOLUTE(QI)-BOOTQI));                 <<03603>>59982000
      CLPNTR(4) := BOOTSTACKSIZE;                              <<03603>>59984000
      @CLPNTR := @CLPNTR+5;                                    <<03603>>59986000
                                                               <<03603>>59988000
         << RESIDENT SEGMENT >>                                <<03603>>59990000
                                                               <<03603>>59992000
      IF SYSDISCTYPE = 0 AND SYSDISCSUBTYPE <= 3 THEN ELSE     <<03603>>59994000
         BEGIN                                                 <<03603>>59996000
         CLDPNTR := TCSTDISC(3);<<DISC ADR OF RESIDENT SE      <<03603>>59998000
         CLPNTR(2) := TCST(14); << RESIDENT BANK >>            <<03603>>60000000
         CLPNTR(3) := TCST(15); << RESIDENT ADDRESS >>         <<03603>>60002000
         CLPNTR(4) := TCST(12).(4:12)&LSL(2);                  <<03603>>60004000
         @CLPNTR := @CLPNTR+5;                                 <<03603>>60006000
         END;                                                  <<03603>>60008000
                                                               <<03603>>60010000
      I := (@CLPNTR-@CLBUF)/5; << NR. ENTRIES >>               <<03603>>60012000
$IF X1=OFF  <<  ******  SERIES II/III UNIQUE  ********* >>     <<03603>>60014000
      BUILD'SIO'BOOT( CLBUF, I);                               <<03603>>60016000
$IF         <<  RETURN TO COMMON CODE  >>                      <<03603>>60018000
      IF SYSDISCTYPE = DISC3 THEN    << BUILD THE APPRO- >>    <<03614>>60020000
         BUILD'CS80'BOOT( CLBUF, I)  << PRIATE BOOT      >>    <<03614>>60022000
      ELSE                           << CHANNEL PROGRAM  >>    <<03614>>60024000
         BUILD'AMIGO'BOOT( CLBUF, I);<< ON THE DISC      >>    <<03614>>60026000
                                                               <<03603>>60028000
                                                               <<03603>>60030000
          <<--------------------------->>                      <<03603>>60032000
          <<  WRITE BOOTSTRAP TO DISC  >>                      <<03603>>60034000
          <<--------------------------->>                      <<03603>>60036000
           DISC'(WRITE,SYSDISC,D'L(TCSTDISCADR)),D'L(ABS(0))), <<03603>>60038000
                TCSTSIZE);                                     <<03603>>60040000
                                                               <<03603>>60042000
                                                               <<03603>>60044000
            << BUILD LOW CORE >>                               <<03603>>60046000
            ZEROBUF(BUF,LCSIZE);                               <<03603>>60048000
            BUF := ABSOLUTE(CSTP);  << CST PNTR >>             <<03603>>60050000
            BUF(QI) := ABSOLUTE(QI);                           <<03603>>60052000
            BUF(ZI) := ABSOLUTE(ZI);                           <<03603>>60054000
            BUF(DRTBANK) := 1;                                 <<03603>>60056000
            BUF(DRTADDR) := 0;                                 <<03603>>60058000
            BUF(DB) := ABSOLUTE(DB);                           <<03603>>60060000
            BUF(DBBANK) := ABSOLUTE(DBBANK);                   <<03603>>60062000
            BUF(SDTYPE) := LDT(LDTSIZE+LDT2).TYP;              <<03603>>60064000
            DISC(WRITE,SYSDISC,D'L(LCDISCADR)),BUF,LCSIZE);    <<03603>>60066000
                                                               <<03603>>60068000
            << BUILD ICS >>                                    <<03603>>60070000
            ZEROBUF(BUF,BOOTSTACKSIZE);                        <<03603>>60072000
            BUF(BOOTQI+2) := ABSOLUTE(DB);<<DISPATCHER DB>>    <<03603>>60074000
            BUF(BOOTQI+1) := ABSOLUTE(DBBANK);<<DISP BANK>>    <<03603>>60076000
            BUF(BOOTQI-4) := ABSOLUTE(DB);                     <<03603>>60078000
            BUF(BOOTQI-5) := ABSOLUTE(DBBANK);                 <<03603>>60080000
            BUF(BOOTQI-7) := DLVALUE;                          <<03603>>60082000
            BUF(BOOTQI-8) := ZVALUE;                           <<03603>>60084000
            BUF(BOOTQI-10) := SVALUE+6; <<SAVE S IN QI-10>>    <<03603>>60086000
            BUF(BOOTQI-12) := INFOCOREADR;<<DB FOR BOOTSTRAP>> <<03603>>60088000
            BUF(BOOTQI-13) := 0; << BANK OF INFO TABLE >>      <<03603>>60090000
            BUF(BOOTQI-18) := 1; <<P DISABLED>>                <<03603>>60092000
            DISC(WRITE,SYSDISC,D'L(STACKDISCADR)),BUF,         <<03603>>60094000
                 BOOTSTACKSIZE);                               <<03603>>60096000
                                                               <<03714>>60098000
            <<-------------------------------------->>         <<03714>>60100000
            <<  WRITE RESERVED AREA BITMAP TO DISC  >>         <<03714>>60102000
            <<-------------------------------------->>         <<03714>>60104000
                                                               <<03714>>60106000
            << WRITE RESERVED AREA BITMAP TO DISC.  THE >>     <<03714>>60108000
            << BITMAP MUST AT THIS POINT ACCURATELY     >>     <<03714>>60110000
            << REFLECT WHAT IS IN THE RESERVED AREA     >>     <<03714>>60112000
            << FOR THE NEXT DISC BOOT.                  >>     <<03714>>60114000
                                                               <<03714>>60116000
            DISC(WRITE,SYSDISC,DOUBLE(BOOTSPACE'SECTOR),       <<03714>>60118000
                 BOOTSPACEMAP,                                 <<03714>>60120000
                 (LDEV'1'RESERVED'AREA'SIZE+15)/16);           <<03714>>60122000
                                                               <<03714>>60124000
            END;  << LOADFROMTAPE - BUILD COLD LOAD SIO PROG >><<03603>>60126000
                                                               <<03603>>60128000
            <<  PARPARE TO RELOCATE INITIAL TO HIGH CORE.  >>  <<03603>>60130000
                                                               <<03603>>60132000
            << UPDATE ICS VALUES >>                            <<03603>>60134000
            PUSH( Z, DL);                                      <<03603>>60136000
            ICS(-7) := TOS; << DL >>                           <<03603>>60138000
            ICS(-8) := TOS; << Z  >>                           <<03603>>60140000
            << IF NO CHANGES THEN COREX MAY NOT >>             <<03603>>60142000
            << REFLECT CORESIZE                 >>             <<03603>>60144000
            COREX := 0;                                        <<03603>>60146000
            DO COREX := COREX+1 UNTIL                          <<03603>>60148000
               CORESIZES(COREX) = CTAB0(CORESIZE);             <<03603>>60150000
                                                               <<03603>>60152000
            << BUILD DISPATCHER'S MARKER >>                    <<03603>>60154000
            I := @DISPATCHER;                                  <<03603>>60156000
            J := I.(1:7);      << STT >>                       <<03603>>60158000
            I := I.(8:8);      << SEG >>                       <<03603>>60160000
            TOS := TCST(I*4+2);    << BANK >>                  <<03603>>60162000
            TOS := TCST(X:=X+1)+TCST(X:=X-3).(4:12)*4-1-J;     <<03603>>60164000
            ASSEMBLE( LSEA ); << LOAD DELTA P >>               <<03603>>60166000
            ICS(-2) := TOS; << DELTA P >>                      <<03603>>60168000
            ICS(-1) := LOGICAL(I) LOR %100000;<<STATUS>>       <<03603>>60170000
                                                               <<03603>>60172000
            <<  MOVE INITIAL TO THE LAST BANK  >>              <<03603>>60174000
                                                               <<03603>>60176000
            MOVE'INITIAL( USEDCORE(COREX) );                   <<03603>>60178000
                                                               <<03603>>60180000
            << RECALCUATE ABSOLUTE BUFFERS >>                  <<03603>>60182000
            PUSH( DB );                                        <<03603>>60184000
            TOS := TOS+@DIR;                                   <<03603>>60186000
            DCOREADDR := TOS;                                  <<03603>>60188000
            DST(DIRDSTN*4+2) := BANK;                          <<03603>>60190000
            DST(X:=X+1) := COREADDR;                           <<03603>>60192000
            PUSH( DB );                                        <<03603>>60194000
            TOS := TOS+@DIRSP;                                 <<03603>>60196000
            DCOREADDR := TOS;                                  <<03603>>60198000
            DST(DIRSPDSTN*4+2) := BANK;                        <<03603>>60200000
            DST(X:=X+1) := COREADDR;                           <<03603>>60202000
                                                               <<03603>>60204000
  IF NOT RELOAD AND RECOVERY THEN                              <<03603>>60206000
     BEGIN<< RETURN ALL DISC SPACE BACK TO SYSTEM>>            <<03603>>60208000
     MESSAGE(M2289);   <<RECOVER LOST DISC SPACE IN PROGRESS>> <<03672>>60210000
     IF RECOVERY THEN INFO(LOADMODE).RYMODE := 1;              <<03603>>60212000
     DISC(WRITE,SYSDISC,D'L(INFOSECTOR)),INFO,INFOSIZE);       <<03603>>60214000
     I := 0;                                                   <<03603>>60216000
     WHILE (I:=I+1) <= HVOL DO                                 <<03603>>60218000
        IF VTAB(I*VTABSIZE) <> 0 THEN                          <<03603>>60220000
           Init'Disc'Free'Space'Map(GETLDEV(I),TRUE);          <<03615>>60222000
     END;                                                      <<03603>>60224000
                                                                        60226000
          <<--------------------------------------------                60228000
            GET SPACE FOR DIRECTORY AND VIRTUAL MEMORY                  60230000
          -------------------------------------------->>                60232000
          IF NOT RELOAD THEN                                            60234000
            BEGIN                                                       60236000
              IF LOADFROMTAPE AND NOT RECOVERY OR NOT LOADFROMTAPE      60238000
                AND RECOVERY THEN                                       60240000
                BEGIN  <<REMOVE OR RETURN DISC SPACE FOR MESSAGE CATALOG60242000
                        AND INITIAL'S TABLES AND CODE SEGMENTS>>        60244000
                  REMRETDSPACE(LPDTSECT,TABLEINFO(LPDTINFOX+1));        60246000
                  REMRETDSPACE(LDTSECT,TABLEINFO(LDTINFOX+1));          60248000
                  REMRETDSPACE(DVCLSECT,TABLEINFO(DVCLINFOX+1));        60250000
                  REMRETDSPACE(LDTXSECT,TABLEINFO(LDTXINFOX+1));        60252000
                  REMRETDSPACE(VTABSECT,TABLEINFO(VTABINFOX+1));        60254000
                  REMRETDSPACE(CSTABSECT,TABLEINFO(CSTABINFOX+1));      60256000
                  << TAKE CARE OF INITIAL'S STACK >>           <<03675>>60260000
                  REMRETDSPACE(STKNRSECT,                      <<03675>>60262000
                     TABLEINFO(STACKINFOX+1));                 <<03675>>60264000
                END;                                           <<03603>>60266000
                                                               <<03603>>60268000
              I := 0;                                          <<03603>>60270000
              IF RECOVERY THEN                                 <<03603>>60272000
                  DO                                                    60274000
                    BEGIN <<TAKE CARE OF INITIAL'S SEGMENTS>>           60276000
                      NRSECT := (TCSTINFO(I&LSL(1))&DLSR(16)   <<03603>>60278000
                          +127D)&DLSR(7); << NR. OF SECTORS >> <<03603>>60280000
                      DISCADR := TCSTINFO(X:=X+1);             <<03603>>60282000
                      IF DISCADR > END'RESERVED(SYSDISC) THEN  <<03603>>60284000
                         REMDISCSPACE(SYSDISC,NRSECT,DISCADR); <<03603>>60286000
                    END                                                 60290000
                  UNTIL (I:=I+1)=INFO(NUTCST');                         60292000
                                                               <<MPEIV>>60296000
            << CHECK FOR TABLE SIZE CHANGES >>                 <<MPEIV>>60298000
              TOS := INFO(DIRSECT);                                     60300000
              IF S0<>CTABCC(DIRSECT') THEN MESSAGE(M2403);     <<01103>>60302000
                <<WARNING DIRECTORY SIZE ONLY CHANGED ON RELOAD>>       60304000
              CTABCC(X) := TOS;                                         60306000
              IF INFO(RINS)<>CTABCC(RINS') OR INFO(GRINS)<>             60308000
                CTABCC(GRINS') THEN MESSAGE(M2404);            <<01103>>60310000
                  <<WARNING RIN TABLE SIZE ONLY CHANGED ON RELOAD>>     60312000
              CTABCC(RINS') := INFO(RINS);                              60314000
              CTABCC(GRINS') := INFO(GRINS);                            60316000
              INFO(LOGIDS) := CTABCC(LOGIDS');                 <<MPEIV>>60318000
              IF INFO(NLOGPROCS) <> CTABCC(NLOGPROCS') THEN    <<MPEIV>>60320000
                  MESSAGE(M2405);<<LOGID CHANGE ON RELOAD>>    <<01103>>60322000
              CTABCC(NLOGPROCS') := INFO(NLOGPROCS);           <<MPEIV>>60324000
                                                               <<MPEIV>>60326000
              IF UPDATE AND CONVERTOLOG THEN                   <<00518>>60328000
                 BEGIN                                         <<00506>>60330000
                 TOS:=GETDISCSPACE(SYSDISC,D'L(INFO(LOGIDSECT))));      60332000
                 IF <> THEN ERRMESSAGE(M326, SYSDISC);         <<MPEIV>>60334000
                 INFOD(LOGIDADDR):=TOS;                        <<00506>>60336000
                 TOS:=GETDISCSPACE(SYSDISC,D'L(INFO(LOGTABSECT))));     60338000
                 IF <> THEN ERRMESSAGE(M326, SYSDISC);         <<MPEIV>>60340000
                 INFOD(LOGTABADDR):=TOS;                       <<00506>>60342000
                 END;                                          <<00506>>60344000
                                                               <<MPEIV>>60346000
              IF RECOVERY THEN                                          60348000
                BEGIN  <<REMOVE SPACE FOR DIRECTORY AND VIRTUAL MEM>>   60350000
                  REMDISCSPACE(SYSDISC,D'L(INFO(DIRSECT))),             60352000
                    INFOD(DIRADR));                                     60354000
                  IF <> THEN ERRMESSAGE(M329);                 <<01442>>60356000
                  << GETTING FREE SPACE ERROR >>               <<01442>>60358000
                  REMDISCSPACE(SYSDISC,D'L(INFO(RINSECT))),             60360000
                    INFOD(RINADR));                                     60362000
                  IF <> THEN ERRMESSAGE(M329);                 <<MPEIV>>60364000
                  REMDISCSPACE(SYSDISC,D'L(INFO(LOGIDSECT))),  <<MPEIV>>60366000
                    INFOD(LOGIDADDR));                         <<MPEIV>>60368000
                  IF <> THEN ERRMESSAGE(M329);                 <<MPEIV>>60370000
                  REMDISCSPACE(SYSDISC,D'L(INFO(LOGTABSECT))), <<MPEIV>>60372000
                    INFOD(LOGTABADDR));                        <<MPEIV>>60374000
                  IF <> THEN ERRMESSAGE(M329);                 <<MPEIV>>60376000
                END;  << RECLAIM DISC SPACE >>                 <<MPEIV>>60378000
            END  << NOT RELOAD >>                              <<MPEIV>>60380000
          ELSE                                                          60382000
            BEGIN  <<RELOAD>>                                           60384000
              DISC(READ,SYSDISC,1D,DTT,128);                            60386000
                                                               <<03549>>60390000
            << REMOVE REASSIGNED TRACKS FROM DFSM SO THERE >>  <<03549>>60392000
            << WON'T BE ANY IN THE DIRECTORY, ETC.         >>  <<03549>>60394000
                                                               <<03549>>60396000
              REM'RET'REASS(FALSE,SYSDISC,DTT);                <<03549>>60398000
              IF RESTORE THEN     << RESTORE OPTION ONLY >>    <<03714>>60400000
                BEGIN  <<TRY TO GET OLD SPACE BACK>>                    60402000
                  REMDISCSPACE(SYSDISC,D'L(INFO(DIRSECT))),             60404000
                    INFOD(DIRADR));                                     60406000
                  IF <> THEN                                            60408000
                    BEGIN  <<CAN'T GET IT; GET NEW SPACE>>              60410000
                      TOS := GETDISCSPACE(SYSDISC,D'L(INFO(DIRSECT)))); 60412000
                      IF <> THEN ERRMESSAGE(M326, SYSDISC);    <<MPEIV>>60414000
                      INFOD(DIRADR) := TOS;                             60416000
                    END;                                                60418000
                  REMDISCSPACE(SYSDISC,D'L(INFO(RINSECT))),             60420000
                    INFOD(RINADR));                                     60422000
                  IF <> THEN                                            60424000
                    BEGIN  <<GET ANY SPACE>>                            60426000
                      TOS := GETDISCSPACE(SYSDISC,D'L(INFO(RINSECT)))); 60428000
                      IF <> THEN ERRMESSAGE(M326, SYSDISC);    <<MPEIV>>60430000
                      INFOD(RINADR) := TOS;                             60432000
                    END;                                                60434000
                  REMDISCSPACE(SYSDISC,D'L(INFO(LOGIDSECT))),  <<MPEIV>>60436000
                    INFOD(LOGIDADDR));                         <<MPEIV>>60438000
                  IF <> THEN                                   <<MPEIV>>60440000
                     BEGIN                                     <<MPEIV>>60442000
                     TOS := GETDISCSPACE(SYSDISC,              <<MPEIV>>60444000
                       D'L(INFO(LOGIDSECT))));                 <<MPEIV>>60446000
                     IF <> THEN ERRMESSAGE(M326, SYSDISC);     <<MPEIV>>60448000
                     INFOD(LOGIDADDR) := TOS;                  <<MPEIV>>60450000
                     END;                                      <<MPEIV>>60452000
                  REMDISCSPACE(SYSDISC,D'L(INFO(LOGTABSECT))), <<MPEIV>>60454000
                    INFOD(LOGTABADDR));                        <<MPEIV>>60456000
                  IF <> THEN                                   <<MPEIV>>60458000
                     BEGIN                                     <<MPEIV>>60460000
                     TOS := GETDISCSPACE(SYSDISC,              <<MPEIV>>60462000
                       D'L(INFO(LOGTABSECT))));                <<MPEIV>>60464000
                     IF <> THEN ERRMESSAGE(M326, SYSDISC);     <<MPEIV>>60466000
                     INFOD(LOGTABADDR) := TOS;                 <<MPEIV>>60468000
                     END;                                      <<MPEIV>>60470000
                END                                                     60472000
              ELSE                                                      60474000
                BEGIN   << NOT RESTORE, GET SPACE ANYWHERE >>  <<03714>>60476000
                        <<   ON THE DISC                   >>  <<03714>>60478000
                  TOS := GETDISCSPACE(SYSDISC,D'L(INFO(DIRSECT))));     60480000
                  IF <> THEN ERRMESSAGE(M326, SYSDISC);        <<MPEIV>>60482000
                  INFOD(DIRADR) := TOS;                                 60484000
                  TOS := GETDISCSPACE(SYSDISC,D'L(INFO(RINSECT))));     60486000
                  IF <> THEN ERRMESSAGE(M326, SYSDISC);        <<MPEIV>>60488000
                  INFOD(RINADR) := TOS;                                 60490000
                  TOS := GETDISCSPACE(SYSDISC,                 <<MPEIV>>60492000
                    D'L(INFO(LOGIDSECT))));                    <<MPEIV>>60494000
                  IF <> THEN ERRMESSAGE(M326, SYSDISC);        <<MPEIV>>60496000
                  INFOD(LOGIDADDR) := TOS;                     <<MPEIV>>60498000
                  TOS := GETDISCSPACE(SYSDISC,                 <<MPEIV>>60500000
                    D'L(INFO(LOGTABSECT))));                   <<MPEIV>>60502000
                  IF <> THEN ERRMESSAGE(M326, SYSDISC);        <<MPEIV>>60504000
                  INFOD(LOGTABADDR) := TOS;                    <<MPEIV>>60506000
                END;                                                    60508000
                                                               <<03549>>60510000
            << RETURN SPACE FOR REASSIGNED TRACKS >>           <<03549>>60512000
              DISC(READ,SYSDISC,1D,DTT,128);                   <<03668>>60514000
              REM'RET'REASS(TRUE,SYSDISC,DTT);                 <<03549>>60516000
                                                               <<03549>>60518000
            END;  << RELOAD >>                                 <<MPEIV>>60520000
                                                               <<MPEIV>>60522000
                                                               <<MPEIV>>60524000
        << GET SPACE FOR VIRTUAL MEMORY >>                     <<MPEIV>>60526000
                                                               <<MPEIV>>60528000
        VOLUME := 0;                                           <<MPEIV>>60530000
        WHILE (VOLUME:= VOLUME+1) <= L'(HVOL) DO               <<MPEIV>>60532000
          IF VTAB(VOLUME*VTABSIZE+VTAB12).VMS = 1 THEN         <<MPEIV>>60534000
            BEGIN  << INSURE SPACE ALLOCATED FOR V.M. >>       <<MPEIV>>60536000
            VDSTART1 := VTAB(VOLUME*VTABSIZE+VTAB8);           <<MPEIV>>60538000
            VDSTART2 := VTAB(X:=X+1);                          <<MPEIV>>60540000
            VDSLEN1 := VTAB(X:=X+1);                           <<MPEIV>>60542000
            VDSLEN2 := VTAB(X:=X+1);                           <<MPEIV>>60544000
            LDEV := GETLDEV(VOLUME);                           <<MPEIV>>60546000
                                                               <<MPEIV>>60548000
            IF RECOVERY AND NOT RELOAD THEN                    <<01819>>60550000
              BEGIN  << RECOVER EXACTLY SAME SPACE AS BEFORE >><<MPEIV>>60552000
              GETVM(LDEV, VDSLEN, VDSTART, TRUE);              <<MPEIV>>60554000
              IF <> THEN ERRMESSAGE(M329);  <<SPACE NOT THERE>><<MPEIV>>60556000
              END                                              <<MPEIV>>60558000
            ELSE                                               <<MPEIV>>60560000
              IF RELOAD THEN                                   <<MPEIV>>60562000
                BEGIN                                          <<MPEIV>>60564000
                IF RESTORE THEN                                <<03714>>60566000
                  BEGIN  << TRY TO GET SAME SPACE AS BEFORE >> <<MPEIV>>60568000
                  GETVM(LDEV, VDSLEN, VDSTART, TRUE);          <<MPEIV>>60570000
                  IF <> THEN                                   <<MPEIV>>60572000
                    BEGIN  << SETTLE FOR ANY SPACE >>          <<MPEIV>>60574000
                    GETVM(LDEV, VDSLEN, VDSTART);              <<MPEIV>>60576000
                    IF <> THEN ERRMESSAGE(M326, LDEV);         <<MPEIV>>60578000
                    END;                                       <<MPEIV>>60580000
                  END   << RELOAD AND RESTORE >>               <<03714>>60582000
                ELSE                                           <<MPEIV>>60584000
                  BEGIN   << RELOAD AND NOT RESTORE >>         <<03714>>60586000
                          <<  GET SPACE ANYWHERE    >>         <<03714>>60588000
                  GETVM(LDEV, VDSLEN, VDSTART);                <<MPEIV>>60590000
                  IF <> THEN ERRMESSAGE(M326, LDEV);           <<MPEIV>>60592000
                  END;                                         <<MPEIV>>60594000
                VTAB(VOLUME*VTABSIZE+VTAB8) := VDSTART1;       <<MPEIV>>60596000
                VTAB(X := X+1) := VDSTART2;                    <<MPEIV>>60598000
                IF LDEV = SYSDISC THEN                         <<MPEIV>>60600000
                  BEGIN  << SAVE SIZE FOR NEXT DEFAULT VALUE >><<MPEIV>>60602000
                  INFO(VIRMEMSECT) := INTEGER(VDSLEN);         <<MPEIV>>60604000
                  INFOD(VIRMEMADR) := VDSTART;                 <<MPEIV>>60606000
                  END;                                         <<MPEIV>>60608000
                END;  << RELOAD >>                             <<MPEIV>>60610000
            END;  << VOLUME WITH VMS ATTRIBUTE >>              <<MPEIV>>60612000
$PAGE "MOVE INITIAL TO HIGH CORE - SETUP FOR SWAPPING"         <<01683>>60614000
          <<--------------------------                                  60622000
            SYSTEM GLOBAL AREA (SYS)                                    60624000
          -------------------------->>                                  60626000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>60628000
          LCMEMLOC := 12;  <<START OF LOW CORE AREA>>                   60630000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>60632000
          LCMEMLOC := %40;  <<START OF LOW CORE /33,/44,/55>>  <<02510>>60634000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>60636000
          MEMLOC := SYSBASE;   <<START OF SYSTEM GLOBAL AREA>>          60638000
          INITTABLE(SYSSIZE,1,0); << SYSTEM GLOBAL AREA >>     <<02510>>60640000
          MEMLOC := MEMLOC+FIRMWARESIZE;                       <<02510>>60642000
          INITTABLE(SYSEXTSIZE,1,0); << SYSGLOB EXT AREA >>    <<02510>>60644000
          <<INITIALIZE SYSGLOB,FIRMWARE AREA,SYSGLOB EXT>>     <<00101>>60646000
          ABSOLUTE(SYSEXTPTR):=SYSSIZE+FIRMWARESIZE;           <<00101>>60648000
          <<PTR TO SYS GLOBAL EXTENSION AREA>>                 <<00101>>60650000
          << INITIALIZE INITIAL'S TEMP CST POINTER >>          <<03603>>60652000
          ABS(SYSBASE) := ABS(CSTP)-SYSBASE;                   <<03603>>60654000
          ABS(SYSICS) := ABS(QI)-SYSBASE;                      <<03603>>60656000
          N := MEMSEG;                                                  60658000
                                                                        60660000
          <<------------------------------                              60662000
            DEVICE REFERENCE TABLE (DRT)                                60664000
          ------------------------------>>                              60666000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>60668000
                                                               <<02707>>60670000
          << FIRST, IF THERE IS A STARFISH ON THE SYSTEM,   >> <<02707>>60672000
          << FIND OUT THE HIGHEST DRT THAT EXISTS ON THE    >> <<02707>>60674000
          << STARFISH.  WE NEED TO MAKE SURE WE ALLOCATE    >> <<02707>>60676000
          << ENOUGH DRTS TO INCLUDE THIS BECAUSE            >> <<02707>>60678000
          << RESETSTARFISH ZERO'S THE LAST WORD OF EACH     >> <<02707>>60680000
          << DRT ON STARFISH.                               >> <<02707>>60682000
                                                               <<02707>>60684000
          IF STARFISH THEN                                     <<02707>>60686000
             BEGIN                                             <<02707>>60688000
             TEMP := RIOC( 0, ROLLCALL); << DO A ROLL CALL >>  <<02707>>60690000
             IF <> THEN ERRMESSAGE(M29);   << RIOC FAILED >>   <<02707>>60692000
             I := 0;                                           <<02707>>60694000
             WHILE I < 16 AND                                  <<02707>>60696000
                NOT LOGICAL(TEMP&LSR(I)) DO I := I + 1;        <<02707>>60698000
             HI'STARFISH'DRT :=                                <<02707>>60700000
                IF I < 16 THEN (15-I)&LSL(3) + DEVPERCHAN-1    <<02707>>60702000
                          ELSE 0;                              <<02707>>60704000
             HIDRT := MAX( HI'STARFISH'DRT, CTAB0(DRTNUM));    <<02707>>60706000
                                                               <<02707>>60708000
             << PREVENT THE OVERLAYING OF THE STARFISH      >> <<02707>>60710000
             << MAILBOX (DRTS 125-127).  NO DEVICES CAN BE  >> <<02707>>60712000
             << BE CONFIGURED ON THESE DRTS IF THERE IS A   >> <<02707>>60714000
             << STARFISH.  THEN COMPUTE THE NO. OF DRT      >> <<02707>>60716000
             << ENTRIES TO ALLOCATE.  WE SUBTRACT 2 BECAUSE >> <<02707>>60718000
             << DRTS ON SERIES II,III START AT 3.           >> <<02707>>60720000
                                                               <<02707>>60722000
             IF HIDRT >= ADAPTERDRT THEN                       <<02707>>60724000
                HIDRT := ADAPTERDRT - 1;                       <<02707>>60726000
             I := HIDRT - 2;                                   <<02707>>60728000
             END                                               <<02707>>60730000
                                                               <<02707>>60732000
          ELSE            << NO STARFISH >>                    <<02707>>60734000
             BEGIN                                             <<02707>>60736000
             HIDRT := CTAB0(DRTNUM);                           <<02707>>60738000
             I := HIDRT - 2;                                   <<02707>>60740000
             END;                                              <<02707>>60742000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>60744000
          HIDRT := CTAB0(DRTNUM) + (DEVPERCHAN -               <<02707>>60746000
                   CTAB0(DRTNUM) MOD DEVPERCHAN) - 1;          <<02707>>60748000
          I := HIDRT - LOWESTDRT + 1;                          <<02707>>60750000
$IF << ******** RETURN TO COMMON CODE ******* >>               <<02510>>60752000
                                                               <<03744>>60756000
          <<************************************************>> <<03744>>60758000
          << *** WARNING! *** ANY I/O OPERATIONS TRIED      >> <<03744>>60760000
          << BETWEEN THE TIME THE DRT TABLE IS ZEROED AND   >> <<03744>>60762000
          << THE DRTS ARE RE-INITIALIZED WILL KILL INITIAL. >> <<03744>>60764000
          << THIS INCLUDES ANY SWAPS CAUSED BY PCALS.       >> <<03744>>60766000
          <<************************************************>> <<03744>>60768000
                                                               <<03744>>60770000
          IF HIDRT<= 127                                       <<03022>>60772000
          THEN BEGIN    <<DRT TABLE WILL REMAIN BK-0>>         <<03002>>60774000
             INITTABLE(I,DRTSIZE,1);                           <<03002>>60776000
             ABSOLUTE(DRTBANK) := 0;                           <<03002>>60778000
             ABSOLUTE(DRTADDR) := 0;                           <<03002>>60780000
             END                                               <<03002>>60782000
          ELSE BEGIN                                           <<03002>>60784000
              <<ZERO OUT THE DRT-TABLE IN BANK 1>>             <<03002>>60786000
              BANK := 1; COREADDR :=0;                         <<03002>>60788000
              SSEA( DCOREADDR,0);  <<ZERO 1ST WORD>>           <<03002>>60790000
              MABS( BANK,COREADDR+1,  <<DEST>>                 <<03002>>60792000
                    BANK,COREADDR,    <<SOURCE>>               <<03002>>60794000
                    HIDRT*4+3); <<LENGTH>>                     <<03022>>60796000
               <<ZERO THE REST OF THE DRT TABLE>>              <<03002>>60798000
            END;                                               <<03002>>60800000
                                                               <<03002>>60802000
         COMMENT ****************************                  <<03002>>60804000
                                                               <<03002>>60806000
                                                               <<00888>>60808000
                                                               <<00888>>60810000
            WHERE    CTAB0(DRTNUM) IS HIGHEST CONFIGURED DRT NUMBER     60812000
                     LOWESTDRT     IS LOWEST ALLOWED DRT NUMBER         60814000
                     DEVPERCHAN    IS NUMBER OF DEVICES PER CHANNEL     60816000
                                                                        60818000
                                                                        60820000
            THIS IS NECESSARY BECAUSE DRT'S ZERO (0) THRU LOWESDRT      60822000
            ARE NOT ALLOWED AND WHEN AN INIT(I/O INITIALIZE CHANNEL)    60824000
            IS EXECUTED FOR THE HIGHEST CONFIGURED CHANNEL IT           60826000
            SETS THE LAST WORD OF EACH(ALL) DRT ON THAT CHANNEL TO ZERO.60828000
            THEREFORE THE HIGHEST DRT # RESERVED IN LOW MEMORY MUST     60830000
            BE A MULTIPLE OF THE NUMBER OF DEVICES PER CHANNEL.         60832000
                                                                        60834000
                                                                        60836000
            *************************************************; <<00888>>60838000
          <<RESET DRTS FOR ALL DISCS AND COLDLOAD DEV>>        <<00888>>60840000
          I:=1;                                                <<00888>>60842000
          DO                                                   <<00888>>60844000
             BEGIN                                             <<00888>>60846000
             @LDTENT:=@LDT(I*LDTSIZE);                         <<00888>>60848000
             IF LDTENT(LDT2).RANGE=DIRACCESS AND               <<00888>>60850000
             DVRTAB(I*DVRSIZE) <>0 AND                         <<03002>>60852000
             DVRTAB(I*DVRSIZE+1).DSBIT=0 <<NOT DS DEV>> THEN   <<03002>>60854000
                INITDRT( DVRTAB(I*DVRSIZE).DRTFIELD);          <<02510>>60856000
             END                                               <<00888>>60860000
          UNTIL (I:=I+1) > HLDEV;                              <<00888>>60862000
      IF LOADFROMTAPE THEN                                     <<04580>>60864000
          INITDRT( SYSTAPEDRT);                                <<02510>>60866000
          INITDRT( CONSOLEDRT);                                <<02510>>60868000
                                                                        60872000
          <<--------------------                                        60874000
            DST, CST, AND CSTX                                          60876000
            ------------------>>                                        60878000
          TOS := INITTABLE(CTABCC(CSTNUM)+CTABCC(DSTNUM)+CTABCC(CSTXNUM)60880000
            ,CSTSIZE,1);                                                60882000
          ASSEMBLE(DUP,DDUP);  <<STARTING ADDRESS>>                     60884000
          ABSOLUTE(DSTP) := TOS;                                        60886000
          TOS := TOS-SYSBASE;  <<SYSDB RELATIVE PTR>>                   60888000
          ABSOLUTE(SYSDST) := TOS;                                      60890000
          INITFREELIST(*,CTABCC(DSTNUM),CSTSIZE,FREEDSTN);              60892000
          TOS := CTABCC(DSTNUM)*CSTSIZE;                                60894000
          DUPLICATE;   <<SIZE OF DST>>                                  60896000
          ABSOLUTE(DFC) := TOS;  <<DISPLACEMENT FROM DST TO CST>>       60898000
          ASSEMBLE(ADD,DUP; DUP);                                       60900000
          TOS := TOS-SYSBASE;                                           60902000
          ABSOLUTE(SYSCST) := TOS;                                      60904000
          INITFREELIST(*,CTABCC(CSTNUM),CSTSIZE,FREECSTN);              60906000
          TOS := CTABCC(CSTNUM)*CSTSIZE;                                60908000
          TOS := S0+ABSOLUTE(DFC); <<OFFSET TO CSTX>>                   60910000
          ABSOLUTE(DFS) := TOS;                                         60912000
          ASSEMBLE(ADD,DUP); <<ABS ADDRESS OF CST EXTENSION>>           60914000
          INITFREELIST(*,CTABCC(CSTXNUM),CSTSIZE,FREECSTXN);            60916000
          X := TOS;                                                     60918000
          ABSOLUTE(X) := 0;  <<ZERO FIRST 2 WORDS PLACED BY INITFREE>>  60920000
          ABSOLUTE(X:=X+1) := 0;                                        60922000
          INSERTDST(SYSBASE,SYSDSTN,N,0);                               60924000
          INSERTDST(ABSOLUTE(DSTP)+ABSOLUTE(DFC),CSTDSTN,CTABCC(CSTNUM) 60926000
            *CSTSIZE,0);                                                60928000
          INSERTDST(ABSOLUTE(DSTP),DSTDSTN,CTABCC(DSTNUM)*CSTSIZE,0);   60930000
          INSERTDST(ABSOLUTE(DSTP)+ABSOLUTE(DFS),CSTXDSTN,CTABCC        60932000
            (CSTXNUM)*CSTSIZE,0);                                       60934000
                                                                        60936000
          <<------------------------                                    60938000
            DIRECTORY DATA SEGMENT                                      60940000
          ------------------------>>                                    60942000
          DIRSPINCR := DIRSPSIZE';                             <<03675>>60944000
          DIRINCR := DIRLEN;                                   <<03675>>60946000
          MOVEDLTABLES;                                        <<03675>>60948000
          PUSH(DB);                                            <<01683>>60950000
          TOS := TOS + @DIR;                                   <<01683>>60952000
          DCOREADDR := TOS;                                    <<01683>>60954000
          INSERTDST(COREADDR, DIRDSTN, DIRLEN, 0, BANK);       <<01683>>60956000
          DIR := 0;                                                     60958000
          MOVE DIR(1) := DIR,(DIRLEN-1);   <<ZERO TABLE>>               60960000
          DIR (L:=DIRZ+IOPNTR) := TEMP := DIRZ+(2*DIRX)+DIRY;  <<RV.PV>>60962000
          DIR(L+DIRX) := TEMP+128*DMAXBZ+DIRMAXENTZ;                    60964000
          TOS := INFOD(DIRADR);                                         60966000
          ASSEMBLE(DDUP,DDUP);                                          60968000
          ABSOLUTE(DIRDISCADR2) := TOS;                                 60970000
          ABSOLUTE(X:=X-1) := TOS;                                      60972000
          DIRDISCADR := TOS;                                            60974000
          DIR (TEMP-DIRY) := CTABCC(DIRSECT');                 <<DE>>   60976000
          DIR (X:=X+2) := TOS;                                 <<RV.PV>>60978000
          DIR(X:=X-1) := TOS;                                           60980000
          TOS := .85;  << DISTRIBUTION FACTOR >>               <<DE>>   60984000
          DIR(X:=X+15) := TOS;                                 <<DE>>   60986000
          DIR(X:=X-1) := TOS;                                           60988000
          TOS := 0;  << Calculate number of bitmap words >>    <<DE>>   60990000
          TOS := DIR(TEMP-DIRY) & DCSR(4); << # words >>       <<DE>>   60992000
          DIR(TEMP-DIRY)  := TOS;                              <<DE>>   60994000
          IF TOS<>0 THEN DIR(TEMP-DIRY):=DIR(TEMP-DIRY)+1;     <<DE>>   60996000
          DIR(TEMP-DIRY) := DIR(TEMP-DIRY) + 3;                <<DE>>   60998000
          TOS := 0;  << Calculate number of bitmap sectors >>  <<DE>>   61000000
          TOS := DIR(TEMP-DIRY) & DCSR(7);                     <<DE>>   61002000
          DIR(TEMP-DIRY) := TOS;                               <<DE>>   61004000
          IF TOS<>0 THEN DIR(TEMP-DIRY):=DIR(TEMP-DIRY)+1;     <<DE>>   61006000
          IF DIR(TEMP-DIRY) < 3 THEN DIR(TEMP-DIRY):=3;        <<DE>>   61008000
          DIR(TEMP-DIRY+3) := DIR(TEMP-DIRY);                  <<DE>>   61010000
          DIR(TEMP-DIRY+4) := SYSDISC;                         <<DE>>   61012000
                                                               <<DE>>   61014000
          <<--------------------->>                            <<DE>>   61016000
          <<DIRECTORY SPACE TABLE>>                            <<DE>>   61018000
          <<--------------------->>                            <<DE>>   61020000
          PUSH(DB);                                            <<01683>>61022000
          TOS := TOS + @DIRSP;                                 <<01683>>61024000
          DCOREADDR := TOS;                                    <<01683>>61026000
          INSERTDST(COREADDR, DIRSPDSTN, DIRSPSIZE', 0, BANK); <<01683>>61028000
          IF NOT RELOAD THEN DISC(READ,SYSDISC,DIRDISCADR,              61030000
            DIRSP (DIRSPHDR), DIRSPSIZE );                     <<DE>>   61032000
          TOS := DIRDISCADR;                                            61034000
          DIRSP (1) := TOS;        <<LOW ORDER DISC ADR>>      <<RV.PV>>61036000
          TOS.(0:8) := SYSDISC;                                <<RV.PV>>61038000
          DIRSP (X:=X-1) := TOS;   <<HIGH ORDER DISC ADR>>     <<RV.PV>>61040000
       << Initialize DSDS 10 word header >>                    <<DE>>   61042000
          IF DIRSP(DIRSPHDR)>0 AND DIRSP(DIRSPHDR)<=%607       <<DE>>   61044000
             THEN DIRSP(2) := %012000                          <<DE>>   61046000
             ELSE DIRSP(2) := %002000;                         <<DE>>   61048000
          DIRSP(3) := 0; << UNUSED >>                          <<DE>>   61050000
          TOS := DIRDISCADR + 1D;                              <<DE>>   61052000
          DIRSP(5) := TOS;                                     <<DE>>   61054000
          DIRSP(4) := TOS;                                     <<DE>>   61056000
          DIRSP(6) := 256;                                     <<DE>>   61058000
          DIRSP(7) := 1;                                       <<DE>>   61060000
          TOS := COLDLOADID;                                            61062000
          ASSEMBLE(INCA,DUP; DDUP);                                     61064000
          ABSOLUTE(COLD'LOAD'ID) := TOS;                                61066000
          INFO(COLD'LOAD'ID') := TOS;                                   61068000
          VTAB(VTABCOLDLOADID) := TOS;                                  61070000
          COLDLOADID := TOS;                                            61072000
          TOS := INFO(LOG'FILE'NUM');   <<LOG FILE NUMBER>>             61074000
              ASSEMBLE(INCA,DUP);                                       61078000
              IF TOS=10000 THEN ASSEMBLE(DEL,ZERO);                     61080000
          INFO(X) := S0;                                                61084000
          ABSOLUTE(LOGFILENUM) := TOS;                                  61086000
                                                                        61088000
          <<--------------------                                        61090000
            CLEAN UP DIRECTORY                                          61092000
          -------------------->>                                        61094000
          HEADING'PRINTED := FALSE;                            <<01442>>61096000
          ZEROBUF( LDMAPBUF,       << ZERO BUFFER USED FOR >>  <<03668>>61098000
                   LDMAP'SIZE);    << SAVING NAMES OF      >>  <<03668>>61100000
                                   << FILES WHICH LOST DATA>>  <<03668>>61102000
          IF NOT RELOAD THEN                                            61104000
            BEGIN  <<CLEAN UP ACCOUNTS, GROUPS AND FILES>>              61106000
              TOS := 0D;                                                61108000
              IF RECOVERY THEN                                          61110000
                BEGIN                                          <<03668>>61112000
                                                               <<03668>>61114000
                                                               <<03668>>61120000
                  TOS := %120;  <<ALL FILES>>                  <<RV.PV>>61122000
                END                                                     61124000
              ELSE TOS := %320;  <<ALL GROUPS>>                <<RV.PV>>61126000
              BUF := OPT;  <<WHICH OPTION>>                             61128000
              BUF(1) := 0;  <<# OF FILES PURGED>>                       61130000
              BUF(14) := RECOVERY;                                      61132000
              TOS := DIRECSCAN(*,0,NULLNAME,NULLNAME,NULLNAME,          61134000
                DIRECTORYCLEAN,BUF);                                    61136000
              IF <> THEN DIRERROR(*,BBUF);                              61138000
              DDEL;                                                     61140000
              IF RECOVERY THEN                                 <<03668>>61142000
                 BEGIN                                         <<03668>>61144000
                 MESSAGE(M2290);   << RECOVER LOST DISC  >>    <<03668>>61146000
                                   <<    SPACE COMPLETE  >>    <<03668>>61148000
                                                               <<03668>>61150000
                 << ALLOW USER TO PURGE/SAVE FILES WHICH >>    <<03668>>61152000
                 <<    LOST DATA                         >>    <<03668>>61154000
                                                               <<03668>>61156000
                 FILE'DAMAGE;                                  <<03668>>61158000
                 END;                                          <<03668>>61160000
            END;                                                        61162000
                                                               <<03668>>61164000
                                                                        61166000
END;  << MAINSEG1 >>                                           <<03603>>61168000
$PAGE "MAINSEG1B"                                              <<03603>>61170000
$CONTROL SEGMENT=MAINSEG1B                                     <<03603>>61172000
PROCEDURE MAINSEG1B;                                           <<03603>>61174000
BEGIN                                                          <<03603>>61176000
    INTEGER INX;                                               <<03603>>61178000
    INTEGER POINTER DIRSP', DIRSP2';                           <<DE>>   61180000
    POINTER DVCL;   << WORD POINTER TO CLASS TABLE >>          <<04306>>61182000
    LOGICAL LDIRC, LNUM;                                       <<DE>>   61184000
                                                               <<03603>>61186000
    ASSEMBLE( RSW );                                           <<03603>>61188000
    IF TOS.(8:8) <> CLRSW THEN HELP;                           <<03603>>61190000
                                                               <<03603>>61192000
$IF X1=ON    << ****** SERIES 33 UNIQUE ********* >>           <<03603>>61194000
          <<--------------------------->>                      <<03603>>61196000
          <<  MAKE SYSTEM DISC UNIQUE  >>                      <<03603>>61198000
          <<--------------------------->>                      <<03603>>61200000
            DISC(READ,SYSDISC,0D,LBUF,128);                    <<03603>>61202000
            MOVE BLBUF:="SYSTEM DISC ";                        <<03603>>61204000
            DISC(WRITE,SYSDISC,0D,LBUF,128);                   <<03603>>61206000
                                                               <<03603>>61208000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<03603>>61210000
          <<----------------------                                      61212000
            INITIALIZE RIN TABLE                                        61214000
          ---------------------->>                                      61216000
          M := INFO(GRINS);                                             61218000
          N := INFO(RINS);                                              61220000
          TOS := ((M*12+N&LSL(1)+9)&LSR(2))&LSL(2);                     61222000
          ASSEMBLE(DUP,NEG);                                            61224000
          PUSH(DL);                                                     61226000
          DLSAVE := S0;                                                 61228000
          ASSEMBLE(ADD,DUP);                                            61230000
        DST(RINTDSTN&LSL(2)+1).DISCCOPYVALIDFLAG:=1;           <<MPEIV>>61232000
          @RIN := TOS;  <<PTR TO RIN TABLE>>                            61234000
          SET(DL);                                                      61236000
          CHECKMEM;                                                     61238000
          K := TOS;  <<RIN TABLE LENGTH>>                               61240000
          IF RELOAD THEN                                                61242000
          IF CTAB0(FILESDUMPED)=0 THEN                                  61244000
            BEGIN  <<INITIALIZE TO NULL TABLE>>                         61246000
              RIN := 0;                                                 61248000
              MOVE RIN(1) := RIN,(K-1);                                 61250000
              X := -2;                                                  61252000
              I := 0;                                                   61254000
              WHILE (I:=I+1) <= N DO RIN(X:=X+2) := I*2;                61256000
              RIN(1) := J := 2*I;  <<PTR TO GLOBAL RIN AREA>>           61258000
              IF M<>0 THEN                                              61260000
                BEGIN  <<INITIALIZE GLOBAL AREA>>                       61262000
                  TOS := J+4;                                           61264000
                  RIN(J) := S0;                                         61266000
                  TOS := M;                                             61268000
                  RIN(X:=X+1) := S0;                                    61270000
                  RIN(X:=X+1) := TOS;  <<# OF FREE ENTRIES>>            61272000
                  X := X+2;                                             61274000
                  I := 1;                                               61276000
                  WHILE (I:=I+1)<=M DO                                  61278000
                    BEGIN  <<INITIALIZE GLOBAL FREE LIST>>              61280000
                      TOS := TOS+12;                                    61282000
                      RIN(X) := S0;                                     61284000
                      X:=X+12;                                          61286000
                    END;                                                61288000
                END;                                                    61290000
            END                                                         61292000
          ELSE                                                          61294000
            BEGIN  <<READ IT OFF THE TAPE>>                    <<03603>>61296000
            INX := 0;                                          <<03603>>61300000
            WHILE INX <> K DO                                  <<03603>>61302000
               BEGIN                                           <<03603>>61304000
               LEN := IF K-INX > TAPERECSIZE THEN              <<03603>>61306000
                  TAPERECSIZE ELSE K-INX;                      <<03603>>61308000
               COLD'LOAD'MEDIA( READ,RIN(INX),LEN);            <<03603>>61310000
               WHILE END'OF'TAPE DO                            <<03603>>61312000
                  BEGIN                                        <<03603>>61314000
                  NEXTREEL(TAPEBUF);                           <<03603>>61316000
                  COLD'LOAD'MEDIA( READ,RIN(INX),LEN);         <<03603>>61318000
                  END;                                         <<03603>>61320000
               INX := INX+LEN;                                 <<03603>>61322000
               END;                                            <<03603>>61324000
            GO CLEANRIN;                                       <<03603>>61326000
            END                                                         61328000
          ELSE                                                          61330000
            BEGIN  <<USE COPY ON DISC>>                                 61332000
              DISC(READ,SYSDISC,INFOD(RINADR),RIN,K);                   61334000
  CLEANRIN:   M := 0;  <<LAST FREE RIN>>                                61336000
              J := 0;                                                   61338000
              RIN := 0;                                                 61340000
              WHILE (J:=J+2) <= N&LSL(1) DO                             61342000
                BEGIN  <<INITIALIZE RIN FREE LIST>>                     61344000
                  IF RIN(J).(0:2)<>2 THEN                               61346000
                    BEGIN  <<NOT A GLOBAL RIN>>                         61348000
                      RIN(J) := 0;                                      61350000
                      RIN(M) := J;                                      61352000
                      M := J;                                           61354000
                    END;                                                61356000
                  RIN(J+1) := 0;                                        61358000
                END;                                                    61360000
            END;                                                        61362000
          DISC(WRITE,SYSDISC,INFOD(RINADR),RIN,K);                      61364000
          TOS := K&LSR(2)+1;                                            61366000
          TOS.(0:1) := 1;                                               61368000
          DST(RINTDSTN&LSL(2)) := TOS;                                  61370000
          TOS := INFOD(RINADR);                                         61372000
          DST(RINTDSTN&LSL(2)+3) := TOS;                                61374000
          TOS.(0:8) := SYSDISC;                                         61376000
          DST(X:=X-1) := TOS;                                           61378000
          TOS := DLSAVE;                                                61380000
          SET(DL);                                                      61382000
         N:=INFO(NLOGPROCS);                                   <<00506>>61384000
         TOS:=N*33+33;                                         <<00506>>61386000
         ASSEMBLE(DUP,NEG);                                    <<00506>>61388000
         PUSH(DL);                                             <<00506>>61390000
         DLSAVE:=S0;                                           <<00506>>61392000
         ASSEMBLE(ADD,DUP);                                    <<00506>>61394000
         @LIDTAB:=TOS;                                         <<00506>>61396000
         SET(DL);                                              <<00506>>61398000
         CHECKMEM;                                             <<00506>>61400000
         K:=TOS;   <<LENGTH OF LOGGIND ID TABLE>>              <<00506>>61402000
         IF RELOAD  THEN                                       <<00506>>61404000
         IF CTAB0(FILESDUMPED)=0 THEN                          <<00506>>61406000
            BEGIN  <<INIT TO NULL>>                            <<00506>>61408000
            MOVE LIDTAB:="  ";                                 <<00506>>61410000
            MOVE LIDTAB(1):=LIDTAB,(N*33);                     <<00506>>61412000
            LIDTAB(0):=0;                                      <<00506>>61414000
            LIDTAB(1):=N;                                      <<00506>>61416000
            LIDTAB(3):=0;                                      <<00506>>61418000
            LIDTAB(4):=33;                                     <<00506>>61420000
            DO                                                 <<00506>>61422000
               BEGIN                                           <<00506>>61424000
               LIDTAB(LIDTAB(4)*(LIDTAB(3):=LIDTAB(3)+1)+32):=-1;       61426000
               END UNTIL LIDTAB(3)=LIDTAB(1);                  <<00506>>61428000
            END                                                <<00506>>61430000
         ELSE                                                  <<00506>>61432000
            BEGIN                                              <<00506>>61434000
            INX := 0;                                          <<03603>>61438000
            WHILE INX <> K DO                                  <<03603>>61440000
               BEGIN                                           <<03603>>61442000
               LEN := IF K-INX > TAPERECSIZE THEN              <<03603>>61444000
                  TAPERECSIZE ELSE K-INX;                      <<03603>>61446000
               COLD'LOAD'MEDIA( READ,LIDTAB(INX),LEN);         <<03603>>61448000
               WHILE END'OF'TAPE DO                            <<03603>>61450000
                  BEGIN                                        <<03603>>61452000
                  NEXTREEL( TAPEBUF);                          <<03603>>61454000
                  COLD'LOAD'MEDIA( READ,LIDTAB(INX),LEN);      <<03603>>61456000
                  END;                                         <<03603>>61458000
               INX := INX+LEN;                                 <<03603>>61460000
               END;                                            <<03603>>61462000
            END                                                <<00506>>61464000
         ELSE                                                  <<00506>>61466000
            BEGIN                                              <<00506>>61468000
      IF UPDATE AND CONVERTOLOG THEN                           <<00518>>61470000
         BEGIN                                                 <<00506>>61472000
         MOVE LIDTAB:="  ";  MOVE LIDTAB(1):=LIDTAB,(N*33);    <<00506>>61474000
         LIDTAB(0):=0;   LIDTAB(1):=N;  LIDTAB(3):=0; LIDTAB(4):=33;    61476000
         DO BEGIN                                              <<00506>>61478000
            LIDTAB(LIDTAB(4)*(LIDTAB(3):=LIDTAB(3)+1)+32):=-1; <<00506>>61480000
         END UNTIL LIDTAB(3)=LIDTAB(1);                        <<00506>>61482000
         END                                                   <<00506>>61484000
      ELSE                                                     <<00506>>61486000
            DISC(READ,SYSDISC,INFOD(LOGIDADDR),LIDTAB,K);      <<00506>>61488000
            END;                                               <<00506>>61490000
         DISC(WRITE,SYSDISC,INFOD(LOGIDADDR),LIDTAB,K);        <<00506>>61492000
         TOS:=K&LSR(2)+2;                                      <<00506>>61494000
         TOS.(0:1):=1;                                         <<00506>>61496000
         DST(LIDDST&LSL(2)):=TOS;                              <<00506>>61498000
         TOS:=INFOD(LOGIDADDR);                                <<00506>>61500000
         DST(LIDDST&LSL(2)+3):=TOS;                            <<00506>>61502000
         TOS.(0:8):=SYSDISC;                                   <<00506>>61504000
         DST(X:=X-1):=TOS;                                     <<00506>>61506000
        DST(X:=X-1).DISCCOPYVALIDFLAG:=1;                      <<MPEIV>>61508000
        DST(X).SYSTEMFLAG:=1;                                  <<MPEIV>>61510000
         TOS:=DLSAVE;                                          <<00506>>61512000
         SET(DL);                                              <<00506>>61514000
         N:=INFO(NLOGPROCS);                                   <<00506>>61516000
         TOS:=N*38+38;                                         <<00506>>61518000
         ASSEMBLE(DUP,NEG);                                    <<00506>>61520000
         PUSH(DL);                                             <<00506>>61522000
         DLSAVE:=S0;                                           <<00506>>61524000
         ASSEMBLE(ADD,DUP);                                    <<00506>>61526000
         @LOGTAB:=TOS;                                         <<00506>>61528000
         SET(DL);                                              <<00506>>61530000
         CHECKMEM;                                             <<00506>>61532000
         M:=TOS;                                               <<00506>>61534000
      IF WARMSTART THEN                                        <<00506>>61536000
         BEGIN   <<WARMSTART, SAVE LIDTAB>>                    <<00506>>61538000
         DISC(READ,SYSDISC,INFOD(LOGTABADDR),LOGTAB,M);        <<00506>>61540000
         <<CHECK AND CLEAN UP TABLE HERE>>                     <<00506>>61542000
         END                                                   <<00506>>61544000
      ELSE                                                     <<00506>>61546000
         BEGIN  <<COOL, COLD, RELOAD.  INIT>>                  <<00506>>61548000
         MOVE LOGTAB:="  ";                                    <<00506>>61550000
         MOVE LOGTAB(1):=LOGTAB,(INFO(NLOGPROCS)*38);          <<00506>>61552000
         LOGTAB(0):=INFO(NLOGPROCS);                           <<00506>>61554000
         LOGTAB(1):=38;                                        <<00506>>61556000
         LOGTAB(2):=-1;                                        <<00506>>61558000
         LOGTAB(3):=38;                                        <<00506>>61560000
         LOGTAB(4):=0;                                         <<00506>>61562000
         LOGTAB(5):=-1;                                        <<00506>>61564000
         LOGTAB(6):=38;                                        <<00506>>61566000
         LOGTAB(7):=38;                                        <<00506>>61568000
         DO                                                    <<00506>>61570000
            BEGIN                                              <<00506>>61572000
            LOGTAB(6):=LOGTAB(3)*LOGTAB(4)+LOGTAB(7);          <<00506>>61574000
            LOGTAB(LOGTAB(6)+37):=LOGTAB(5);                   <<00506>>61576000
            LOGTAB(LOGTAB(6)+36):=LOGTAB(6)+LOGTAB(7);         <<00506>>61578000
            LOGTAB(5):=LOGTAB(6);                              <<00506>>61580000
            END UNTIL (LOGTAB(4):=LOGTAB(4)+1) = LOGTAB(0);    <<00506>>61582000
          LOGTAB(LOGTAB(6)+36):=-1;                            <<00506>>61584000
          LOGTAB(3):=0;                                        <<00506>>61586000
         LOGTAB(0):=0;                                         <<00506>>61588000
         LOGTAB(4):=INFO(NLOGPROCS);                           <<00506>>61590000
         LOGTAB(5):=INFO(LOGIDS);                              <<00506>>61592000
         END;                                                  <<00506>>61594000
         DISC(WRITE,SYSDISC,INFOD(LOGTABADDR),LOGTAB,M);       <<00506>>61596000
         TOS:=M&LSR(2)+2;                                      <<00506>>61598000
         TOS.(0:1):=1;                                         <<00506>>61600000
         DST(LOGDST&LSL(2)):=TOS;                              <<00506>>61602000
         TOS:=INFOD(LOGTABADDR);                               <<00506>>61604000
         DST(LOGDST&LSL(2)+3):=TOS;                            <<00506>>61606000
         TOS.(0:8):=SYSDISC;                                   <<00506>>61608000
         DST(X:=X-1):=TOS;                                     <<00506>>61610000
        DST(X:=X-1).DISCCOPYVALIDFLAG:=1;                      <<MPEIV>>61612000
        DST(X).SYSTEMFLAG:=1;                                  <<MPEIV>>61614000
         TOS:=DLSAVE;                                          <<00506>>61616000
         SET(DL);                                              <<00506>>61618000
         DIRSP(8) := DIRSP(10) + DIRSPHDR - 2; <<1st 2 wds>>   <<DE>>   61620000
         IF DIRSP(8) > %607 << LAST BUFFER WORD >>             <<DE>>   61622000
            THEN DIRSP(8) := %607;                             <<DE>>   61624000
         DIRSP(9) := DIRSP(11) + DIRSPHDR - 2;                 <<DE>>   61626000
         IF DIRSP(9) > %607 << LAST BUFFER WORD >>             <<DE>>   61628000
            THEN DIRSP(9) := DIRSPHDR + 2;                     <<DE>>   61630000
                                                                        61632000
          <<----------------------                                      61634000
            INITIALIZE DIRECTORY                                        61636000
          ---------------------->>                                      61638000
          IF RELOAD THEN                                                61640000
          IF CTAB0(FILESDUMPED) = 0 THEN                                61642000
            BEGIN  <<CREATE NULL DIRECTORY WITH SYS, PUB, MANAGER>>     61644000
              TOS := DIRECNULL(CTABCC(DIRSECT'));                       61646000
              IF <> THEN DIRERROR(*,BBUF);                              61648000
              DDEL;                                                     61650000
              TOS := DIRECINSERT(ACCTYPE,0,SYSACCT,NULLNAME,NULLNAME,   61652000
                      SYSINFO);                                         61654000
              IF <> THEN DIRERROR(*,BBUF);                              61656000
              DDEL;                                                     61658000
              TOS := DIRECINSERT(GRPTYPE,0,SYSACCT,PUBGRP,NULLNAME,     61660000
                      PUBINFO);                                         61662000
              IF <> THEN DIRERROR(*,BBUF);                              61664000
              DDEL;                                                     61666000
              TOS := DIRECINSERT(USERTYPE,0,SYSACCT,MANUSER,NULLNAME,   61668000
                      MANAGERINFO);                                     61670000
              IF <> THEN DIRERROR(*,BBUF);                              61672000
              DDEL;                                                     61674000
              NUSERFILES := 0;                                          61676000
            END                                                         61678000
          ELSE                                                          61680000
            BEGIN  <<DIRECTORY ON TAPE>>                                61682000
              COLD'LOAD'MEDIA(READ,TAPEBUF,20);                <<03603>>61684000
              WHILE END'OF'TAPE DO                             <<03603>>61688000
                 BEGIN                                         <<03603>>61690000
                 NEXTREEL( TAPEBUF);                           <<03603>>61692000
                 COLD'LOAD'MEDIA(READ,TAPEBUF,20);             <<03603>>61694000
                 END;                                          <<03603>>61696000
              LNUM := WRITEDISC ( INFOD(DIRADR) );             <<DE>>   61698000
              @DIRSP' := @DIRSP (DIRSPHDR); << Beg. Bitmap >>  <<DE>>   61700000
              @DIRSP2' := @DIRSP (128); << 2nd part buffer >>  <<DE>>   61702000
              DISC(READ,SYSDISC,INFOD(DIRADR),DIRSP',384);     <<14.PV>>61704000
              TOS := 0;                                                 61706000
              TOS := CTABCC(DIRSECT');  <<DIRECTORY SIZE>>              61708000
              LDIRC := S0 + 32;  << AVAILABLE SECTORS >>       <<DE>>   61710000
              TOS := TOS&DCSR(4);                                       61712000
              ASSEMBLE(XCH);                                            61714000
              IF TOS<>0 THEN TOS := TOS+1;  <<LAST USED WORD>>          61716000
              DIRSP' := S0+1; <<PTR TO END OF TABLE>>          <<14.PV>>61718000
              DIRSP' (1) := 2;  <<FIRST WORD TO SCAN>>         <<14.PV>>61720000
              X := TOS+2;                                               61722000
              IF X<=384 THEN DIRSP' (X) := 0;  <<terminator>>  <<DE>>   61724000
              DIRSP(8) := DIRSP' + DIRSPHDR - 2; <<1st 2 wds>> <<DE>>   61726000
              DIRSP(9) := DIRSP'(1) + DIRSPHDR - 2;            <<DE>>   61728000
              IF DIRSP(8) > %607 << LAST BUFFER WORD >>        <<DE>>   61730000
                 THEN DIRSP(8) := %607;                        <<DE>>   61732000
              I := INTEGER(LNUM) + 31; << Skip first 2 words >><<DE>>   61734000
              DIRSP (2) := %2000;  << first page in buffer >>  <<DE>>   61736000
              IF LDIRC >= 6176 THEN GOTO INIT'DIRC;            <<DE>>   61738000
              DIRSP (2) := %12000; << all bitmap in buffer >>  <<DE>>   61740000
              WHILE LOGICAL(I:=I+1) < LDIRC DO                 <<DE>>   61742000
                BEGIN  <<TURN BIT ON FOR EACH AVAILABLE SECTOR>>        61744000
                  TOS := DIRSP' (I.(0:12));                    <<14.PV>>61746000
                  X := I.(12:4);                                        61748000
                  ASSEMBLE(TSBC 0,X);                                   61750000
                  DIRSP' (I.(0:12)) := TOS;                    <<14.PV>>61752000
                END;                                                    61754000
              TOS := I;                                                 61756000
              TOS := 16;                                                61758000
              ASSEMBLE(DIV,XCH; DUP,STAX);                              61760000
              I := TOS;                                                 61762000
              TOS := DIRSP' (X);                               <<14.PV>>61764000
              ASSEMBLE(STBX,DELB);                                      61766000
              WHILE X<16 DO                                             61768000
                BEGIN  <<RESET UNUSED BITS IN LAST WORD>>               61770000
                  ASSEMBLE(TRBC 0,X);                                   61772000
                  X := X+1;                                             61774000
                END;                                                    61776000
              DIRSP' (I) := TOS;                               <<14.PV>>61778000
            <<ZERO UNUSED PORTION OF DIRECTORY>>                        61780000
         INIT'DIRC:                                            <<DE>>   61782000
              LBUF := 0;                                                61784000
              MOVE LBUF(1) := LBUF,(1023);                              61786000
              TOS := 0;                                                 61788000
              TOS := (LDIRC - LNUM - 32) & DCSR(3);<<#WRITES>> <<DE>>   61790000
              L := TOS;                                                 61792000
              M := TOS&LSR(6);  <<# OF EXTRA WORDS>>                    61794000
              DTEMP := INFOD (DIRADR) + DOUBLE(LNUM);          <<DE>>   61796000
              I := -1;                                                  61798000
              WHILE (I:=I+1) < L DO                                     61800000
                BEGIN  <<INITIALIZE DIRECTORY TO ZEROES>>               61802000
                  DISC(WRITE,SYSDISC,DTEMP,LBUF,1024);                  61804000
                  DTEMP := DTEMP+8D;                                    61806000
                END;                                                    61808000
              IF M <> 0 THEN DISC(WRITE,SYSDISC,DTEMP,LBUF,M);          61810000
              BUF := OPT;                                               61812000
              BUF(1) := 0;                                              61814000
              BUF(15) := ACCTSONLY;                                     61816000
              TOS := DIRECSCAN (%120,0,NULLNAME,NULLNAME,      <<RV.PV>>61818000
                NULLNAME,DIRECTORYCLEAN,BUF);                  <<RV.PV>>61820000
              IF <> THEN DIRERROR(*,BBUF);                              61822000
              DDEL;                                                     61824000
              NUSERFILES := BUF(1);                                     61826000
            END;                                                        61828000
                                                                        61830000
                                                                        61832000
          <<-----------------------------                               61834000
            READ SYSTEM FILES FROM TAPE                                 61836000
          ----------------------------->>                               61838000
          IF LOADFROMTAPE THEN                                          61840000
            BEGIN  <<READ FILES FROM TAPE>>                             61842000
REDOFSF:      COLD'LOAD'MEDIA(FWDSPFILE);                      <<00678>>61844000
              IF END'OF'TAPE THEN                              <<00678>>61846000
                 BEGIN                                         <<00678>>61848000
                 NEXTREEL(TAPEBUF);                            <<03603>>61850000
                 GOTO REDOFSF;                                 <<00678>>61852000
                 END;                                          <<00678>>61854000
READNEXT:     COLD'LOAD'MEDIA(READ,TAPEBUF,TAPERECSIZE);       <<03603>>61856000
              IF > THEN                                        <<00678>>61858000
                   GOTO REWINDTAPE;                            <<00678>>61860000
                 IF END'OF'TAPE THEN                           <<00678>>61862000
                   BEGIN                                       <<00678>>61864000
                   NEXTREEL(TAPEBUF);                          <<03603>>61866000
                   GOTO READNEXT;                              <<00678>>61868000
                   END;                                        <<00678>>61870000
              FREPLACE;                                        <<00678>>61872000
              GOTO READNEXT;                                   <<00678>>61874000
REWINDTAPE:                                                    <<00678>>61876000
IF NOT RELOAD OR NUSERFILES=0 THEN COLD'LOAD'MEDIA(REWUNLOAD); <<00678>>61878000
            END;                                               <<00678>>61880000
$PAGE "MAINSEG1  --  SET UP FOR DISC COLD LOAD"                         61882000
          <<----------------------                                      61884000
            WRITE TABLES TO DISC                                        61886000
          ---------------------->>                                      61888000
          TOS := DIRECSCAN (%720,0,NULLNAME,NULLNAME,NULLNAME, <<RV.PV>>61890000
                            USERCLEAN,BUF);                    <<RV.PV>>61892000
          IF <> THEN DIRERROR(*,BBUF);                                  61894000
          DDEL;                                                         61896000
          TOS := DIRECSCAN(%30, 0, SYSACCT, MANUSER, NULLNAME, <<01090>>61898000
            SET'1'MGR, BUF);                                   <<01090>>61900000
          IF <> THEN DIRERROR(*,BBUF);                         <<01090>>61902000
          DDEL;                                                <<01090>>61904000
          TOS := DIRECSCAN (%1120,0,NULLNAME,NULLNAME,NULLNAME,<<RV.PV>>61906000
                            VSDCLEAN,BUF);                     <<RV.PV>>61908000
          IF <> THEN DIRERROR (*,BBUF);                        <<RV.PV>>61910000
          DDEL;                                                <<RV.PV>>61912000
          FCBHD := 0;                                                   61914000
          I := 0;                                                       61916000
          DO FCB(I*FCBSIZE) := (I+1)*FCBSIZE UNTIL (I:=I+1)=3;          61918000
          CTABFNUM := FOPEN(CTABFILE);                                  61920000
          TOS := FCBDBL+D'L(FCB(FCBSECTOFF)));                 <<03603>>61922000
          BS1 := 0; << ZERO LDEV >>                            <<03603>>61924000
          DTEMP := TOS;  <<DISC ADDRESS OF CONFDATA FILE>>     <<03603>>61926000
                                                               <<01732>>61928000
        << USE DEFAULTS FOR CONVERTING FROM MPE3 TO MPE4 >>    <<01732>>61930000
          IF CTABCC(SWAPTABLE) = 0 THEN                        <<01732>>61932000
            CTABCC(SWAPTABLE) := CTABCC(PCBNUM)*LOCALITYCOUNT; <<01732>>61934000
          IF CTABCC(SPECIALREQTABLE) = 0 THEN                  <<01732>>61936000
            CTABCC(SPECIALREQTABLE) := 20;                     <<01732>>61938000
          IF CTABCC(PRIMARYMSGTABLE) = 0 THEN                  <<01732>>61940000
            CTABCC(PRIMARYMSGTABLE) := 25;                     <<01732>>61942000
          IF CTABCC(SECNDRYMSGTABLE) = 0 THEN                  <<03707>>61944000
            CTABCC(SECNDRYMSGTABLE) := 25;                     <<03707>>61946000
          IF CTABCC(DISCREQTABLE) = 0 THEN                     <<01732>>61948000
            CTABCC(DISCREQTABLE) := 100;                       <<01732>>61950000
                                                               <<01732>>61952000
          WRITECONFTABLE(CSDVRTSIZE,CSDVRRECNUM,CSDVR,CSDVRINFOX);      61954000
          WRITECONFTABLE(CSDEFSIZE,CSDEFRECNUM,CSDEF,CSDEFINFOX);       61956000
          WRITECONFTABLE((HLDEV+1)*DVRSIZE,DVRRECNUM,DVRTAB,DVRINFOX);  61958000
          CTAB0(CSTABSIZE) := CSTAB;                                    61960000
          WRITECONFTABLE(CTAB0SIZE,CTAB0RECNUM,CTAB0,CTAB0INFOX);       61962000
          WRITECONFTABLE(CTABTSIZE,CTABRECNUM,CTAB,CTABINFOX);          61964000
          FCLOSE(CTABFNUM);                                             61966000
          WRITEDEVTABLE(LPDTTSIZE,LPDT,LPDTINFOX,(HLDEV+1)*LPDTSIZE);   61968000
          WRITEDEVTABLE(LDTTSIZE,LDT,LDTINFOX,(HLDEV+1)*LDTSIZE);       61970000
          @DVCL := WORDADDRESS(DVCLTAB);                       <<04306>>61972000
          WRITEDEVTABLE(DVCLTSIZE,DVCL,DVCLINFOX,              <<04306>>61974000
                                       DVCLSIZE&LSR(1));       <<04306>>61976000
          WRITEDEVTABLE(LDTXTSIZE,LDTX,LDTXINFOX,(HLDEV+1)*LDTXSIZE);   61978000
          WRITEDEVTABLE(VTABTSIZE,VTAB,VTABINFOX,              <<RH.PV>>61980000
                        (MVOL+1)*VTABSIZE);                    <<RH.PV>>61982000
          WRITEDEVTABLE(CSTABTSIZE,CSTAB,CSTABINFOX,CSTAB);             61984000
          TOS := @CSTAB;                                                61986000
          DLVALUE := S0;                                                61988000
          INFO(INITDL) := TOS;                                          61990000
          IF LOADFROMTAPE THEN                                          61992000
            BEGIN                                                       61994000
              WRITEDEVTABLE(INFO(INITZ), 0, STACKINFOX,        <<01683>>61996000
                INFO(INITZ));  << DB TO Z AREA >>              <<01683>>61998000
            END;                                                        62000000
$PAGE "MAINSEG1  --  SET UP FOR FULL CORE SIZE"                         62002000
          <<-----------------                                           62004000
            COMPRESS TABLES                                             62006000
          ----------------->>                                           62008000
          IF RELOAD AND NUSERFILES<>0 OR                                62010000
          WARMSTART AND RECOVERY THEN                                   62012000
          ELSE INFO(LOADMODE) := 0;                                     62014000
          DISC(WRITE,SYSDISC,D'L(INFOSECTOR)),INFO,INFOSIZE);           62016000
          I := 0;                                                       62018000
          LDEV := 0;                                                    62020000
          TOS := 0;   <<CHANGE IN HLDEV>>                               62022000
  INITREST:                                                             62024000
          WHILE (LDEV:=LDEV+1)<=HLDEV DO                                62026000
          IF DVRTAB(LDEV*DVRSIZE) = 0 AND                      <<03002>>62028000
              DVRTAB(LDEV*DVRSIZE+1).DSBIT = 0 THEN            <<03002>>62030000
              BEGIN                                                     62032000
              IF(I:=I+1)>CTAB0(MAXSPOOLF) THEN GO SETHLDEV;             62034000
              LPDT(LDEV*LPDTSIZE) := %100000;                           62036000
              LPDT(X:=X+1) := 0;                                        62038000
              END;                                                      62040000
          TOS := CTAB0(MAXSPOOLF)-I;   <<# OF EXTRA LDN'S NEEDED>>      62042000
          IF = THEN GOTO SETHLDEV;                                      62044000
          ASSEMBLE(DUP,DUP;DUP);                                        62046000
          DVRTABINCR := TOS*DVRSIZE;                                    62048000
          LPDTINCR := TOS*LPDTSIZE;                                     62050000
          LDTINCR := TOS*LDTSIZE;                                       62052000
          MOVEDLTABLES;                                                 62054000
          HLDEV := S0+HLDEV;                                            62056000
          LDEV := LDEV-1;                                               62058000
          ASSEMBLE(NEG,ADD);                                            62060000
          GOTO INITREST;                                                62062000
  SETHLDEV:                                                             62064000
          LPDT := HLDEV&LSL(8)+LPDTSIZE;                                62066000
          LDT := HLDEV&LSL(8)+LDTSIZE;                                  62068000
          LDTX := HLDEV&LSL(8)+LDTXSIZE;                       <<00.06>>62070000
          LDT(DCFIRST) := (HLDEV+1)*LDTSIZE;                            62072000
          HLDEV := TOS+HLDEV;                                           62074000
          MOVE CTAB := CTABCC,(CTABSIZE); <<ONLY ONE WE NEED NOW>>      62076000
          CTABINCR := CTABSIZE-CTABTSIZE;                               62078000
          OLDINFOINCR := -CTAB0(OLDINFOSIZE); <<DON'T NEED IT ANY MORE>>62080000
          MOVEDLTABLES;  <<SHRINK TABLES>>                              62082000
          @DISCLASS := @DVCLTAB+@DISCLASS;                              62084000
                                                               <<01683>>62088000
          SEGTINCR := SEGT'SIZE;                               <<03675>>62090000
          MOVEDLTABLES;                                        <<03675>>62092000
        << DIRECTORY DST'S IN DL SO MAY HAVE MOVED >>          <<01683>>62094000
          PUSH(DB);                                                     62096000
          TOS := TOS+@DIR;                                              62098000
          DST(DIRDSTN&LSL(2)+3) := TOS;                                 62100000
          X := X-1;                                                     62102000
          DST(X).(8:8) := TOS;  << HIGH ORDER ADDR >>          <<01756>>62104000
          PUSH(DB);                                                     62106000
          TOS := TOS+@DIRSP;                                            62108000
          DST(DIRSPDSTN&LSL(2)+3) := TOS;                               62110000
          X := X-1;                                                     62112000
          DST(X).(8:8) := TOS;  << HIGH ORDER ADDR >>          <<01756>>62114000
      END <<MAINSEG1B>> ;                                      <<01683>>62116000
$PAGE "MAINSEG2  --  RELOAD USER FILES"                                 62118000
$CONTROL SEGMENT=MAINSEG2                                      <<MPEIV>>62120000
  PROCEDURE MAINSEG2;                                                   62122000
      BEGIN                                                             62124000
   DEFINE TAPEBLOCKSIZE=LBUF(27)#;                             <<KS.88>>62126000
    INTEGER POINTER DRIVERENT;                                          62128000
    LOGICAL  DRIVERSECT,                                                62130000
             POINTERSECT,                                               62132000
             ADCCRESERVED := FALSE,                            <<03004>>62134000
             SEEKMASK,                                         <<01853>>62136000
             SECONDPASS;                                                62138000
    EQUATE  GLINKAGE   = 24, << LOCATION IN GROUP ENTRY >>     <<SY>>   62140000
            GROUPLEVEL = 1,                                    <<SY>>   62142000
            PV = 1;                                            <<SY>>   62144000
    DEFINE  PVF = 0:1 #;                                       <<SY>>   62146000
                                                               <<SY>>   62148000
    BYTE POINTER LCNPTR;                                                62150000
    INTEGER DRTUNIT;  <<BUILD DRT/UNIT COMBINATION>>           <<03002>>62152000
    INTEGER LCN,                                                        62154000
            LDEV,                                              <<03603>>62156000
            DITSIZE,       << SIZE OF DIT >>                   <<03552>>62158000
            SIOSIZE,       << SIZE OF SIO PROGRAM >>           <<03552>>62160000
            STATSIZE,      << SIZE OF STATUS RETURN AREA >>    <<03552>>62162000
            CHANNEL,       << SOFTWARE CHANNEL NUMBER >>       <<03552>>62164000
            UNIT,          << UNIT NUMBER >>                   <<03552>>62166000
            ILTSTART,      << BASE ADDRESS OF ILT >>           <<03557>>62168000
            DITLOC,        << BASE OF DITS >>                  <<03557>>62170000
            MOVE'LEN,                                          <<03557>>62172000
            LDTXINDEX,                                                  62174000
            TYPE,           << DEVICE TYPE >>                  <<03549>>62176000
            SUBTYP,         << DEVICE SUBTYP >>                <<03549>>62178000
            DVRINDEX,                                                   62180000
            LCMEDPDMAX,                                                 62182000
            DEFDVRINDEX,                                                62184000
            CONTSECTSIZE;                                               62186000
    DOUBLE NAM1, NAM2, FILEADR;                                <<03000>>62188000
    LOGICAL FILEADR1=FILEADR,                                  <<04545>>62190000
            FILEADR2=FILEADR+1;                                <<04545>>62192000
    INTEGER ARRAY FILENTRY(*) = NAM1;                          <<03000>>62194000
    BYTE VOLUME = FILEADR;                                     <<03603>>62196000
    DOUBLE WCSADR;                                             <<03000>>62198000
    INTEGER ARRAY                <<STT #'S OF INITIALIZATION>> <<03557>>62200000
       INIT'LIZAT'NSTT(0:31);    << ROUTINES OF ADDITIONAL  >> <<03557>>62202000
                                 << CS DRIVERS              >> <<03557>>62204000
      INTEGER ARRAY CHNUMB(0:63)=Q;   <<RESOURCE QUEUE  #>>             62206000
                                                               <<03557>>62208000
                                                               <<03557>>62210000
                                                               <<03557>>62212000
          ASSEMBLE( RSW );                                     <<01091>>62214000
          IF TOS.(8:8) <> CLRSW THEN HELP;                     <<02510>>62216000
          CSDRTN := 0;   <<INITIALIZE CSDRTN ARRAY TO ZEROS>>  <<03002>>62218000
          MOVE CSDRTN(1) := CSDRTN,(31);                       <<03002>>62220000
          CHECKMEM;                                                     62222000
          HEADING'PRINTED := FALSE;                            <<01442>>62224000
          IF NOT LOADFROMTAPE THEN                                      62226000
            BEGIN <<UPDATE COLDLOADID IN SYSTEM PROGRAM FILES>>         62228000
            I := 0;                                                     62230000
            DO                                                          62232000
              BEGIN                                                     62234000
              J := FOPEN(PROTECTED(I*8));                               62236000
              TOS := FLAB(FLMISCX);                                     62238000
              TOS.(0:3) := 0;                                           62240000
              TOS.(14:2) := 1; <<OPEN FOR READ>>                        62242000
              FLAB(X) := TOS;                                           62244000
              FLFCBVECT := 0;                                           62246000
              FLCLID := COLDLOADID;                                     62248000
              CHECKSUM;                                                 62250000
              FLCHECKSUM := TOS;                                        62252000
              FILEADR := FLEXT0;                               <<03603>>62256000
              LDEV := GETLDEV( VOLUME);                        <<03603>>62258000
              IF <> THEN ERRMESSAGE( M452); << DEF FILE LBL >> <<03603>>62260000
              VOLUME := 0;                                     <<03603>>62262000
              DISC( WRITE,LDEV,FILEADR,FLAB,128);              <<03603>>62264000
              FCLOSE(J);                                                62266000
              END                                                       62268000
            UNTIL(I:=I+1) = NPROTECTED;                                 62270000
            END;                                               <<00.EB>>62272000
              MOVE FLAB := ("LOADMAP ","PUB     ","SYS     ",           62274000
                            "MANAGER ","        ");                     62276000
              FLFOPTIONS := 5;                                          62278000
              FLRECSIZE := -128;                               <<00.DL>>62280000
              FLBLKSIZE := 128;                                         62282000
              FLSECTOFF := 1;                                           62284000
              FLNUMEXTS := 0;                                           62286000
              FLFILECODE:=0;                                            62288000
              FLFLIM := 178D;                                  <<00.DL>>62290000
              FLEXTSIZE  := FLLASTEXTSIZE := 30; <<30 SECTORS>><<01734>>62292000
              FLEOF := 54D;                                    <<00.DL>>62294000
              FLAB(46) := 0;                                            62296000
              MOVE FLAB(47) := FLAB(46),(61);                           62298000
              FLEXT0 := -1D; << MAKE NON ZERO FOR FREPLACE>>            62300000
              CHECKSUM;                                        <<03603>>62302000
              FLCHECKSUM := TOS;                               <<03603>>62304000
              MOVE TAPEBUF := FLAB,(128);                      <<03603>>62306000
              FREPLACE(TRUE);                                           62308000
              TOS := FLEXT0;                                            62310000
              S1.(0:8) := 0;                                            62312000
              LOADMAPADR := TOS;                                        62314000
          I := 0;                                              <<03000>>62316000
          DISC(READ,SYSDISC,0D,LBUF,128);                      <<03000>>62318000
          TOS := NR'WCS'FILES;                                 <<03000>>62320000
          WHILE <> DO                                          <<03000>>62322000
             BEGIN                                             <<03000>>62324000
             WCSADR := 0D;                                     <<03000>>62326000
             DIRECFIND(FILETYPE,0,SYSACCT,PUBGRP,WCSNAMES(I),  <<03000>>62328000
                       FILENTRY);                              <<03000>>62330000
             IF = AND FILEADR1.(8:1)  = 0                      <<04545>>62332000
                  AND GETLDEV(VOLUME) = SYSDISC THEN           <<04545>>62334000
                BEGIN                                          <<03000>>62336000
                << READ FILE LABEL >>                          <<03000>>62338000
                DISC(READ,SYSDISC,FILEADR,FLAB,128);           <<03000>>62340000
                IF FLEOF <> 0D THEN                            <<03000>>62342000
                   WCSADR := L'PADR(SYSDISC,                   <<03000>>62344000
                      FLEXT0+DOUBLE(FLSECTOFF));               <<03000>>62346000
                IF WCSNAMES(I+4)&CSR(THISCPU) THEN             <<03000>>62348000
                   BEGIN  << PROTECT FILE FROM BEING PURGED >> <<03000>>62350000
                   TOS := FLAB(FLMISCX);                       <<03000>>62352000
                   TOS.(0:3) := 0;                             <<03000>>62354000
                   TOS.(14:2) := 1; << OPEN FOR READ >>        <<03000>>62356000
                   FLAB(X) := TOS;                             <<03000>>62358000
                   END;                                        <<03000>>62360000
                FLFCBVECT := 0;                                <<03000>>62362000
                FLCLID := COLDLOADID;                          <<03000>>62364000
                CHECKSUM;                                      <<03000>>62366000
                FLCHECKSUM := TOS;                             <<03000>>62368000
                DISC(WRITE,SYSDISC,FLEXT0,FLAB,128);           <<03000>>62370000
                END;                                           <<03000>>62372000
             DISCWCSTAB(WCSNAMES(I+5)) := WCSADR;              <<03000>>62374000
             I := I+6; << NEXT ENTRY >>                        <<03000>>62376000
             TOS := TOS-1;   << COUNTER >>                     <<03000>>62378000
             END;                                              <<03000>>62380000
          DISC(WRITE,SYSDISC,0D,LBUF,128);                     <<03000>>62382000
          IF RELOAD AND NUSERFILES<>0 THEN                              62384000
            BEGIN  <<RELOAD FILES>>                                     62386000
              IF SERIALDISCLOAD AND                            <<03598>>62388000
              SYSTAPETYPE=DISC2 THEN                           <<00071>>62390000
                BEGIN                                          <<00071>>62392000
                IF NOT FUTURE'DATE THEN                        <<03598>>62394000
                BEGIN                                          <<00678>>62396000
                NEXTREEL(LBUF);                                <<00678>>62398000
                COLD'LOAD'MEDIA(FWDSPFILE,,,TRUE);             <<01092>>62400000
                IF < THEN GO TO ABORT;                         <<01092>>62402000
                COLD'LOAD'MEDIA(FWDSPFILE,,,TRUE);             <<01092>>62404000
                IF < THEN GO TO ABORT;                         <<01092>>62406000
                END;                                           <<00678>>62408000
                END;                                           <<00678>>62410000
              NNODISC:=-1;<<# OF FILES WITHOUT DISC SPACE>>    <<00.06>>62412000
              LEN:=COLD'LOAD'MEDIA(READ,LBUF,1024,TRUE); <<READ THE>>   62414000
              <<HEADER RECORD WITH PARITY CHECKING ON>>        <<00.06>>62416000
              IF < THEN                                        <<00.06>>62418000
                BEGIN <<PARITY ERROR>>                         <<00.06>>62420000
                IF LEN = 1 THEN GO TO ABORT;                   <<01092>>62422000
                HEDLABP:=TRUE;<<SIGNAL PARITY ERROR IN>>       <<00.06>>62424000
                <<HEADER LABEL--THIS IMPLIES THAT IT WILL>>    <<00.06>>62426000
                <<NOT BE POSSIBLE TO RECOVER FROM A>>          <<00.06>>62428000
                <<PARITY ERROR IN ANY OF THE TRAILER>>         <<00.06>>62430000
                <<LABELS OF THIS TAPE SET>>                    <<00.06>>62432000
                COLD'LOAD'MEDIA(FWDSPFILE,,,TRUE);             <<01092>>62434000
                <<SKIP EOF AFTER HEADER LABEL>>                <<01092>>62436000
                IF < THEN GO TO ABORT;                         <<01092>>62438000
                GOTO SKIPTONEXT;                               <<00.06>>62440000
                END;                                           <<00.06>>62442000
              IF > THEN                                        <<00.06>>62444000
                BEGIN <<FOUND EOF--NOT HEADER LABEL>>          <<00.06>>62446000
                HEDLABP:=TRUE;<<NOT ABLE TO GET REEL#>>        <<00.06>>62448000
                <<FROM HEADER LABEL, SO TREAT AS A>>           <<00.06>>62450000
                <<PARITY ERROR>>                               <<00.06>>62452000
                GOTO SKIPTONEXT;                               <<00.06>>62454000
                END;                                           <<00.06>>62456000
              IF LEN <> 40 THEN                                <<00.06>>62458000
                BEGIN <<NOT A HEADER LABEL>>                   <<00.06>>62460000
                HEDLABP:=TRUE;                                 <<00.06>>62462000
                COLD'LOAD'MEDIA(FWDSPFILE,,,TRUE);             <<01092>>62464000
                IF < THEN GO TO ABORT;                         <<01092>>62466000
                GOTO SKIPTONEXT;                               <<00.06>>62468000
                END;                                           <<00.06>>62470000
              <<READ A GOOD HEADER LABEL>>                     <<00.06>>62472000
              HEDLABP:=FALSE;<<SIGNAL NO PARITY ERROR>>        <<00.06>>62474000
              <<DURING READING OF THIS HEADER LABEL>>          <<00.06>>62476000
              REEL:=REELNUM;<<INITIALIZE REEL COUNTER>>        <<00.06>>62478000
              MOVE ITMP:=CHDATE,(3);<<INITIALIZE>>             <<00.06>>62480000
      IF TAPEBLOCKSIZE=0 THEN TAPEBLOCKSIZE:=1024;             <<KS.88>>62482000
      RECSIZE:=TAPEBLOCKSIZE; <<SIZE STORE BLOCK SIZE>>        <<KS.88>>62484000
                                                               <<KS.88>>62486000
<< NOW ALLOCATE TEMPORARY BUFFER FOR RESTORE BLOCKS>>          <<KS.88>>62488000
                                                               <<KS.88>>62490000
      PUSH(DL);                                                <<KS.88>>62492000
      TOS:=TOS-RECSIZE;                                        <<KS.88>>62494000
      ASSEMBLE(DUP);                                           <<KS.88>>62496000
      SET(DL);                                                 <<KS.88>>62498000
      @RESTOREBUF:=TOS;                                        <<KS.88>>62500000
      @BRESTOREBUF:=@RESTOREBUF&LSL(1);                        <<KS.88>>62502000
                                                               <<KS.88>>62504000
              <<CREATION DATE>>                                <<00.06>>62506000
              COLD'LOAD'MEDIA(FWDSPFILE,,,TRUE);               <<01092>>62508000
              IF < THEN GO TO ABORT;                           <<01092>>62510000
  SKIPTONEXT:                                                           62512000
              IF NUSERFILES=0 THEN                                      62514000
                BEGIN                                                   62516000
                  COLD'LOAD'MEDIA(REWUNLOAD,,,TRUE);           <<01092>>62518000
                  IF < THEN GO TO ABORT;                       <<01092>>62520000
                  GOTO FINISHEDRELOAD;                                  62522000
                END;                                                    62524000
              READTAPE'(0); <<FORWARD SPACE FILE>>             <<01092>>62526000
              <<FIRST TIME, THIS SKIPS THE (NON-EXISTENT)>>    <<00.06>>62528000
              <<DIRECTORY>>                                    <<00.06>>62530000
              IF < THEN                                        <<00.06>>62532000
                BEGIN <<PARITY ERROR ON LABEL OF NEXT FILE>>   <<00.06>>62534000
                IF LEN = 1 THEN GO TO ABORT;                   <<01092>>62536000
                I:=2; <<PARAMETERS FOR TAPERROR>>              <<00.06>>62538000
         MOVE BLBUF:="NAME    IS      UNKNOWN ";               <<KS.88>>62540000
                                                               <<KS.88>>62542000
                                                               <<KS.88>>62544000
                GOTO TAPERROR;                                 <<00.06>>62546000
                END;                                           <<00.06>>62548000
              IF > THEN GOTO FPURGE;  <<NO MORE TAPE SETS>>    <<00.06>>62550000
      READTAPE'(RECSIZE); <<NO NEED TO TEST PARITY AS>>        <<KS.88>>62552000
              <<THIS IS A LOGICAL READ ONLY.  THE PHYSICAL>>   <<00.06>>62554000
              <<READ TOOK PLACE IN READTAPE'(0) ABOVE.>>       <<00.06>>62556000
      TOS:=DIRECFIND(GROUPLEVEL&LSL(3),0,RESTOREBUF(8),        <<KS.88>>62558000
             RESTOREBUF(4),RESTOREBUF,BUF);                    <<KS.88>>62560000
                IF < THEN DIRERROR(*,BRESTOREBUF);             <<KS.88>>62562000
              IF > THEN                                        <<RV.PV>>62564000
      IF S0<>2 THEN DIRERROR(*,BRESTOREBUF)                    <<KS.88>>62566000
              ELSE                                             <<RV.PV>>62568000
                 BEGIN <<NOT FOUND>>                           <<RV.PV>>62570000
                 DDEL;                                         <<RV.PV>>62572000
                 GOTO SKIPTONEXT;                              <<RV.PV>>62574000
                 END;  <<NOT FOUND>>                           <<RV.PV>>62576000
              DDEL;                                            <<RV.PV>>62578000
              IF BUF(GLINKAGE).(PVF)=PV THEN                   <<RV.PV>>62580000
                 BEGIN <<GROUP ASSIGNED TO A PV>>              <<RV.PV>>62582000
                 GOTO SKIPTONEXT;                              <<RV.PV>>62584000
                 END;                                          <<RV.PV>>62586000
              <<ONLY FILES FROM GROUPS ASSIGNED TO THE>>       <<RV.PV>>62588000
              <<SYSTEM DOMAIN WILL PASS THIS POINT AND>>       <<RV.PV>>62590000
              <<BE RESTORED>>                                  <<RV.PV>>62592000
      TOS:=DIRECFIND(FILETYPE,0,RESTOREBUF(8),RESTOREBUF(4),   <<KS.88>>62594000
             RESTOREBUF,BUF);                                  <<KS.88>>62596000
      IF < THEN DIRERROR(*,BRESTOREBUF);                       <<KS.88>>62598000
      IF > THEN IF S0<>2 THEN DIRERROR(*,BRESTOREBUF)          <<KS.88>>62600000
              ELSE                                                      62602000
                BEGIN                                                   62604000
                  DDEL;                                                 62606000
                  GO SKIPTONEXT;                                        62608000
                END;                                                    62610000
              DDEL;                                                     62612000
              IF BUF(4).(8:1)<>1 THEN GOTO SKIPTONEXT; <<ALREADY FOUND>>62614000
              NUSERFILES := NUSERFILES-1;                               62616000
      TOS:=DIRECPURGE(FILETYPE,0,RESTOREBUF(8),RESTOREBUF(4),  <<KS.88>>62618000
             RESTOREBUF);                                      <<KS.88>>62620000
      IF <> THEN DIRERROR(*,BRESTOREBUF);                      <<KS.88>>62622000
              DDEL;                                                     62624000
      MOVE FLAB:=RESTOREBUF,(128);  <<COPY FILE LABEL>>        <<KS.88>>62626000
              SECTORS := 0D;                                            62628000
              I := 0;                                                   62630000
              DO                                                        62632000
                BEGIN  <<TOTAL UP SPACE USED>>                          62634000
                  TOS := 0;                                             62636000
                  IF FLABDBL(EXT0+I)=0D THEN TOS := 0                   62638000
                  ELSE TOS := GETEXTLEN(I);  <<EXTENT SIZE>>            62640000
                  ASSEMBLE(DDUP);                                       62642000
                  SECTORS := TOS+SECTORS;                               62644000
                  EXTSIZES(I) := TOS;                                   62646000
                END                                                     62648000
              UNTIL (I:=I+1) > FLNUMEXTS;                               62650000
              FLLASTEXTSIZE:=INTEGER(EXTSIZES(I-1));           <<03597>>62652000
              TOS := 0;  <<FOR SUPERDISCSPACE>>                         62654000
              IF RESTORING THEN                                         62656000
                BEGIN   <<GET LDN OF OLD VOLUME>>                       62658000
                  TOS := @VNAME;                                        62660000
                  TOS := @OLDVTAB(VTABSIZE*BUF(4).(0:8))       <<04306>>62662000
                                                     &LSL(1);  <<04306>>62664000
                  MOVE * := *,(8);                                      62666000
                  I := 0;                                               62668000
                  WHILE (I:=I+1) <= HVOL DO                    <<03550>>62670000
                    BEGIN                                               62672000
                      TOS := @VTAB(I*VTABSIZE)&LSL(1);         <<04306>>62674000
                      IF * = VNAME,(8) THEN                             62676000
                        BEGIN  <<FOUND IT>>                             62678000
                          TOS := VTAB(I*VTABSIZE+VTAB12).VTABLDEV;      62680000
                          GOTO GETSPACE;                                62682000
                        END;                                            62684000
                    END;                                                62686000
                END;                                                    62688000
              TOS := 0;  <<ANY DEVICE OK>>                              62690000
  GETSPACE:                                                             62692000
              LDEV := SUPERDISCSPACE(*,FLNUMEXTS+1,FLAB(28),EXTSIZES,   62694000
                FLABDBL(EXT0));                                         62696000
              IF <> THEN                                                62698000
                BEGIN  <<COULDN'T FIND THE SPACE>>                      62700000
              I := 1; <<INSUFFICIENT DISC SPACE>>                       62702000
  TAPERROR:        <<TAPE PARITY ERROR>>                                62704000
                  NNODISC := NNODISC+1;                                 62706000
              IF = THEN                                                 62708000
               BEGIN                                                    62710000
               << XXX FILES PURGED BECAUSE OF ERRORS - LIST >> <<01103>>62712000
               LISTPURGE := LGETYESNO(M2281);                  <<01103>>62714000
               IF NOT LISTPURGE THEN GO SKIPTONEXT;            <<01103>>62716000
               END;                                                     62718000
         IF LISTPURGE THEN PRINTFNR(BRESTOREBUF,I);            <<KS.88>>62720000
                GOTO SKIPTONEXT;                                        62722000
                END;                                                    62724000
              TOS := LDT(LDEV*LDTSIZE+LDT2).TYP&LSL(2);                 62726000
              TOS.(4:4) := LPDT(LDEV*LPDTSIZE+LPDT1).SUBTYPE;           62728000
              FLAB(28) := TOS;                                          62730000
              FLFCBVECT := 0;                                           62732000
              FLCLID := COLDLOADID;                                     62734000
     FLAB(108):=FLAB(109):=FLAB(110):=0; <<CLEAR RESTORE DATE>><<00601>>62736000
          CHECKSUM;           <<NEW CHECKSUM>>                          62738000
          FLCHECKSUM := TOS;  <<UPDATE FLAB>>                           62740000
      MOVE RESTOREBUF:=FLAB,(128);                             <<KS.88>>62742000
              TOS := FLEXT0;                                            62744000
              ASSEMBLE(XCH);                                            62746000
              TOS.(0:8) := LDT(LDEV*LDTSIZE+LDT1).VOL;                  62748000
              ASSEMBLE(XCH);                                            62750000
              DTEMP := TOS;                                             62752000
              TOS := DIRECINSERTFILE(SECTORS,FLAB(8),FLAB(4),FLAB,      62754000
                DTEMP);                                                 62756000
              IF <> THEN DIRERROR(*,BFLAB);                             62758000
              DDEL;                                                     62760000
              IF FLFOPTIONS.(8:2)<>1 THEN                               62762000
                BEGIN  <<FIXED OR UNDEFINED RECORDS>>                   62764000
                  TOS := FLEOF;                                         62766000
                  TOS := FLBLKSIZE;                                     62768000
                  TOS := FLRECSIZE;                                     62770000
                  IF = THEN TOS := TOS+128                              62772000
                  ELSE IF < THEN TOS := (-TOS+1)&LSR(1);                62774000
                  ASSEMBLE(DIV,DEL);                                    62776000
                  X := TOS;                                             62778000
                  ASSEMBLE(ZERO,CAB; LDXA,LDIV; CAB,LDXA; LDIV);        62780000
                  IF TOS<>0 THEN TOS := TOS+1D;                         62782000
                  X := (FLBLKSIZE+127)&LSR(7);                          62784000
                  ASSEMBLE(LDXA,LMPY; CAB,LDXA; MPY,ZERO; DADD,ZERO);   62786000
                  TOS := FLSECTOFF;                                     62788000
                  ASSEMBLE(DADD);                                       62790000
                  SECTORS := TOS;                                       62792000
                END;                                                    62794000
              NBLKS := LEN&LSR(7);                                      62796000
              BLOCKSWRITTEN := 0;                                       62798000
              I := 0;                                                   62800000
              DO                                                        62802000
                BEGIN  <<COPY FILE PER EXTENT>>                         62804000
                  @ENTRE := @FLEXTMAP+I&LSL(1);                         62806000
                  TOS := ENTRE0.(0:8);                                  62808000
                  X := TOS*VTABSIZE+VTAB12;                             62810000
                  LDEV := VTAB(X).VTABLDEV;                             62812000
                  TOS := SECTORS;                                       62814000
                  TOS := 0;                                             62816000
                  TOS := FLEXTSIZE;                                     62818000
                  ASSEMBLE(DSUB);                                       62820000
                  IF < THEN                                             62822000
                    BEGIN  <<LAST EXTENT>>                              62824000
                      CNT := INTEGER(SECTORS);                          62826000
                      DDEL;                                             62828000
                      SECTORS := 0D;                                    62830000
                    END                                                 62832000
                  ELSE                                                  62834000
                    BEGIN                                               62836000
                      CNT := FLEXTSIZE;                                 62838000
                      SECTORS := TOS;                                   62840000
                    END;                                                62842000
                  IF ENTRE=0D THEN GO NULLEXT;                          62844000
                  NN := 0;                                              62846000
                  WHILE NN<CNT DO                                       62848000
                    BEGIN                                               62850000
                      IF BLOCKSWRITTEN=NBLKS THEN                       62852000
                        BEGIN  <<READ NEXT RECORD>>                     62854000
                          READTAPE'(RECSIZE);                  <<01092>>62856000
                          IF < THEN GO TO REMOVE'FILE;         <<01092>>62858000
                          IF (LEN MOD 128)<>0 THEN             <<01092>>62860000
                            GO TO REMOVE'FILE;                 <<01092>>62862000
                          NBLKS := LEN&LSR(7);                          62864000
                          BLOCKSWRITTEN := 0;                           62866000
                        END;                                            62868000
                      SECTORSLEFT := CNT-NN;                            62870000
                      MM := NBLKS-BLOCKSWRITTEN;                        62872000
                      IF SECTORSLEFT < MM THEN MM:=SECTORSLEFT;         62874000
                      TOS := 0;                                         62876000
                      TOS := NN;                                        62878000
                      TOS := TOS + ENTRE;                               62880000
                      S1.(0:8) := 0;                                    62882000
                      DTEMP := TOS;                                     62884000
            DISC(WRITE,LDEV,DTEMP,                             <<KS.88>>62886000
                 RESTOREBUF(BLOCKSWRITTEN&LSL(7)),             <<KS.88>>62888000
                        MM&LSL(7));                                     62890000
                      BLOCKSWRITTEN := BLOCKSWRITTEN+INTEGER(MM);       62892000
                      NN := NN+MM;                                      62894000
                    END;                                                62896000
  NULLEXT:        I := I+1;                                             62898000
                END                                                     62900000
              UNTIL SECTORS=0D OR I > FLNUMEXTS;                        62902000
              IF SECTORS<>0D THEN GO TO REMOVE'FILE;           <<01092>>62904000
              GOTO SKIPTONEXT;                                          62906000
                                                               <<01092>>62908000
REMOVE'FILE:                                                   <<01092>>62910000
    SECTORS := DOUBLE(I:=0);                                   <<01092>>62912000
    DO                                                         <<01092>>62914000
      BEGIN  << RETURN ALLOCATED SPACE >>                      <<01092>>62916000
        IF EXTSIZES (I) <> 0D THEN                             <<01092>>62918000
           Return'Disc'Space (ldev, flabdbl(ext0+i),           <<03551>>62920000
                              extsizes(i));                    <<03551>>62922000
        SECTORS := SECTORS + EXTSIZES(I)                       <<01092>>62926000
      END                                                      <<01092>>62928000
    UNTIL (I:=I+1) > FLNUMEXTS;                                <<01092>>62930000
    MOVE RESTOREBUF: = FLAB, (12);  << F.G.A >>                <<01092>>62932000
    TOS := 0D;     <<RETURN VALUE>>                            <<01092>>62934000
    TOS := SECTORS;  << DIR ACCOUNTING >>                      <<01092>>62936000
    TOS := DIRECPURGEFILE(*, *, FLAB(8), FLAB(4), FLAB);       <<01092>>62938000
    IF <> THEN DIRERROR(*, BRESTOREBUF);                       <<01092>>62940000
    DDEL;                                                      <<01092>>62942000
    IF LEN = 1 OR (LEN MOD 128) <> 0 THEN                      <<01122>>62944000
      BEGIN                                                    <<01122>>62946000
        MESSAGE(M375);                                         <<01122>>62948000
        GO TO ABORT;                                           <<01122>>62950000
      END;                                                     <<01122>>62952000
    I := 2;  << TAPE PARITY ERROR >>                           <<01092>>62954000
    GO TO TAPERROR;  << REPORT & SKIP FILE >>                  <<01092>>62956000
                                                               <<01092>>62958000
ABORT:                                                         <<01092>>62960000
          COLD'LOAD'MEDIA(REWUNLOAD,,,TRUE);                   <<01122>>62962000
          MESSAGE(M2283); << RELOAD OF USER FILES ABORTED >>   <<01103>>62964000
  FPURGE: LISTPURGE := FALSE;                                           62966000
           GETYESNO(@NOLIST,M2278,NUSERFILES);<<FILES NOT FOUND<<01103>>62968000
          LISTPURGE := TRUE;                                            62970000
          MESSAGE(M2277);<<FOLLOWING FILES PURGE - NOT FOUND>> <<01103>>62972000
  NOLIST: BUF := NUSERFILES;                                            62974000
              TOS := DIRECSCAN (%120,0,NULLNAME,NULLNAME,      <<RV.PV>>62976000
                                NULLNAME,FILEPURGE,BUF);       <<RV.PV>>62978000
              IF <> THEN DIRERROR(*,BBUF);                              62980000
              DDEL;                                                     62982000
  FINISHEDRELOAD:                                                       62984000
              INFO(LOADMODE) := 0;                                      62986000
              DISC(WRITE,SYSDISC,D'L(INFOSECTOR)),INFO,INFOSIZE);       62988000
                END;                                                    62990000
                                                               <<KS.88>>62992000
<< DELETE RESTORE TAPE BUFFERS >>                              <<KS.88>>62994000
                                                               <<KS.88>>62996000
   IF @RESTOREBUF<>0 THEN                                      <<KS.88>>62998000
   BEGIN                                                       <<KS.88>>63000000
      PUSH(DL);                                                <<KS.88>>63002000
      TOS:=TOS+RECSIZE; <<DEALLOCATE DL-DB BUFFER>>            <<KS.88>>63004000
      SET(DL);                                                 <<KS.88>>63006000
   END;                                                        <<KS.88>>63008000
          <<-------------------------->>                       <<SD.00>>63010000
          <<DELETE SERIAL DISC BUFFERS>>                       <<SD.00>>63012000
          <<-------------------------->>                       <<SD.00>>63014000
          <<SHIFT ALL OF STACK BELOW SDISC BUFFERS>>           <<SD.00>>63016000
          <<UPWARDS, OVERLAYING THEM>>                         <<SD.00>>63018000
          TOS:=@RECBUF(RECBUFLEN+TZTBUFLEN+1);<<Dest for Move>><<03598>>63020000
          TOS:=@RECBUF(-1); <<SOURCE FOR MOVE>>                <<03598>>63022000
          ASSEMBLE(DUP); <<THIS MINUS DL IS LENGTH FOR MOVE>>  <<SD.00>>63024000
          PUSH(DL);                                            <<SD.00>>63026000
          ASSEMBLE(SUB,INCA;NEG;MOVE 3);                       <<SD.00>>63028000
          PUSH(DL,DB);                                         <<SD.00>>63030000
          TOS:=0;                                              <<SD.00>>63032000
          TOS:=RECBUFLEN+TZTBUFLEN+2;                          <<03598>>63034000
          ASSEMBLE(DUP,NEG);                                   <<SD.00>>63036000
          @INIT'LIZAT'NSTT:=TOS+@INIT'LIZAT'NSTT;              <<SD.00>>63038000
          ASSEMBLE(DADD);                                      <<SD.00>>63040000
          ASSEMBLE(DDUP);                                      <<03603>>63042000
          SET (DB);                                            <<SD.00>>63044000
          ASSEMBLE(DDUP,DDUP);                                          63048000
          TOS:=TOS+@DIR;                                                63050000
          DST(DIRDSTN&LSL(2)+3):=TOS;                                   63052000
          X:=X-1;                                                       63054000
          DST(X).(8:8) := TOS;  << HIGH ORDER ADDR >>          <<01756>>63056000
          TOS:=TOS+@DIRSP;                                              63058000
          DST(DIRSPDSTN&LSL(2)+3):=TOS;                                 63060000
          X:=X-1;                                                       63062000
          DST(X).(8:8) := TOS;  << HIGH ORDER ADDR >>          <<01756>>63064000
          ABSOLUTE(DB):=TOS;                                   <<SD.00>>63066000
          ABSOLUTE(DBBANK):=TOS;                               <<SD.00>>63068000
          SET (DL); <<RESET DL REG TO REFLECT MOVE>>           <<SD.00>>63070000
$PAGE "MAINSEG2  --  CORE RESIDENT TABLE SETUP"                         63072000
          <<------------------------------------------------>> <<01681>>63074000
          << **** TEMPORARY(?!?!?!?!?) GRIZZLEY KLUDGE **** >> <<01681>>63076000
          <<------------------------------------------------>> <<01681>>63078000
                                                               <<01681>>63080000
          << THIS TEMPORARY(?!) FIX IS GOING TO MOVE THE    >> <<01681>>63082000
          << DST, CST AND CSTX TABLES TO THE UPPER END OF   >> <<01681>>63084000
          << BANK 0 UNTIL SPACE HAS BEEN RESERVED FOR       >> <<01681>>63086000
          << THE DITS.  THIS FIX WILL NOT WORK ON A 96K     >> <<01681>>63088000
          << MEMORY SIZE.                                   >> <<01681>>63090000
                                                               <<01681>>63092000
          TOS := 0;  << DESTINATION BANK >>                    <<01681>>63094000
          TOS := HCLIMIT-1;  << DEST. ADDRESS >>               <<03603>>63096000
          TOS := 0;  << SOURCE BANK >>                         <<01681>>63098000
          TOS := MEMLOC - 1;  << SOURCE ADDRESS >>             <<01681>>63100000
          TOS := -MEMSEG;  << LEFT TO RIGHT MOVE LENGTH >>     <<01681>>63102000
          ASSEMBLE (MABS 3);  << LEAVE DESTINATION ADDRESS >>  <<01681>>63104000
          DELB;  << DELETE BANK >>                             <<01681>>63106000
          MOVE'LEN := MEMSEG;  << SAVE FOR RETURN MOVE >>      <<01681>>63108000
          << MEMSEG & MEMLOC SET BY LAST CALL TO INITTABLE >>  <<01681>>63110000
          MEMLOC := MEMLOC - MOVE'LEN;  << RELEASE SPACE >>    <<01681>>63112000
                                                               <<01681>>63114000
          TOS := TOS + 1;                                      <<01681>>63116000
        << RESET POINTERS >>                                   <<01681>>63118000
          ABSOLUTE(DSTP) := S0;  << LOW CORE DST POINTER >>    <<01681>>63120000
          ABSOLUTE(SYSDST) := S0 - SYSBASE;  << SYSGLOB PTR >> <<01681>>63122000
          TOS := CTAB(DSTNUM) * CSTSIZE;  << LEN OF DST TAB>>  <<01681>>63124000
          ABSOLUTE(DFC) := S0; <<DISPLACEMENT FROM DST TO CST>><<01681>>63126000
          ASSEMBLE (ADD);  << @DST + SIZE = @CST >>            <<01681>>63128000
          ABSOLUTE(SYSCST) := S0 - SYSBASE;  << SYSGLOB PTR >> <<01681>>63130000
          DEL;  << COMPILER CAN'T HANDLE TOS IN LAST LINE >>   <<01681>>63132000
          ABSOLUTE(DFS) := ABSOLUTE(DFC) +                     <<01681>>63134000
            (CTAB(CSTNUM) * CSTSIZE);  << OFFSET TO CSTX >>    <<01681>>63136000
          DST(DSTDSTN&LSL(2)+3) := ABSOLUTE(DSTP);             <<01681>>63138000
          DST(CSTDSTN&LSL(2)+3) := ABSOLUTE(DSTP) +            <<01681>>63140000
            ABSOLUTE(DFC);                                     <<01681>>63142000
          DST(CSTXDSTN&LSL(2)+3) := ABSOLUTE(DSTP) +           <<01681>>63144000
            ABSOLUTE(DFS);                                     <<01681>>63146000
                                                               <<01681>>63148000
          <<------------------------->>                        <<01681>>63150000
          <<  BUILD CS DRIVER TABLE  >>                        <<01681>>63152000
          <<------------------------->>                        <<01681>>63154000
          CSDVRAREASIZE := 0;                                  <<01681>>63156000
          PUSH(DL);                                            <<01681>>63158000
          DLSAVE := S0;                                        <<01681>>63160000
          @CSDVRAREA := TOS;  <<PTR TO DRIVER TABLE WORK AREA>><<01681>>63162000
          CSTAB(DRIVERENTNUM) := 0;                            <<01681>>63164000
          IF CSPRESENT THEN FORMATCSDVRENTRY(CSDUMMY);         <<01681>>63166000
          DRTN := LOWESTDRT;                                   <<01681>>63168000
          DO                                                   <<01681>>63170000
            BEGIN  <<ADD DVR FOR EACH CONFIG'D LINE TO TABLE>> <<01681>>63172000
              LDEV := 2;                                       <<01681>>63174000
              DO IF DVRTAB(LDEV*DVRSIZE).DRTFIELD=DRTN AND     <<03002>>63176000
                CSDEV17<=LDT(LDEV*LDTSIZE+LDT2).TYP<=CSDEV19   <<01681>>63178000
                THEN BEGIN  << CS DEVICE >>                    <<01681>>63180000
                @DVRNAME :=(@DVRTAB(DVRSIZE*LDEV)+DVR2)&LSL(1);<<04306>>63182000
                  TOS := CSDRTN(DRTN.(0:12));                  <<01681>>63184000
                  X := DRTN.(12:4);                            <<01681>>63186000
                  ASSEMBLE(TSBC 0,X);     <<SET CS BIT>>       <<01681>>63188000
                  CSDRTN(DRTN.(0:12)) := TOS;                  <<01681>>63190000
                  I := 0;                                      <<01681>>63192000
                  @DRIVERENTRY := @CSDVRAREA;                  <<01681>>63194000
                  WHILE (I:=I+1)<=CSTAB(DRIVERENTNUM) DO       <<01681>>63196000
                    BEGIN  <<CHECK FOR ALREADY IN TABLE>>      <<01681>>63198000
                      TOS := @DRNAME&LSL(1);                   <<04306>>63200000
                      TOS := @DVRNAME;                         <<01681>>63202000
                      IF *=*,(8) THEN GOTO NEXTCSDRT';         <<01681>>63204000
                      @DRIVERENTRY := @DRIVERENTRY+DRIVERENTRY;<<01681>>63206000
                    END;                                       <<01681>>63208000
                  FORMATCSDVRENTRY(DVRNAME);                   <<01681>>63210000
                END                                            <<01681>>63212000
              UNTIL (LDEV:=LDEV+1)>HLDEV;                      <<01681>>63214000
  NEXTCSDRT':END                                               <<01681>>63216000
          UNTIL (DRTN := DRTN+1) > HIDRT;                      <<02707>>63218000
          INIT'LIZAT'NSTT := 0;                                <<01681>>63220000
          MOVE INIT'LIZAT'NSTT(1) := INIT'LIZAT'NSTT,(31);     <<01681>>63222000
          I := -1;                                             <<01681>>63224000
          WHILE(I:=I+1) < CTAB0(NUMADVRS) DO                   <<01681>>63226000
            BEGIN <<ADD ADDITIONAL CS DRIVERS TO TABLE>>       <<01681>>63228000
            TOS := 0;  <<FOR PROCEDURE RETURN>>                <<01681>>63230000
            TOS := @CSDVR(I*CSDVRSIZE)&LSL(1);                 <<04306>>63232000
            INIT'LIZAT'NSTT(I) := FORMATCSDVRENTRY(*);         <<01681>>63234000
            END;                                               <<01681>>63236000
                                                               <<01681>>63238000
          <<----------------------------->>                    <<03004>>63240000
          <<  ALLOCATE TERMINAL BUFFERS  >>                    <<03004>>63242000
          <<----------------------------->>                    <<03004>>63244000
          << FOR ADCC- OR ATC-CONNECTED TERMINALS, ALLOCATE>>  <<03004>>63246000
          << TBUF'S IN BANK 0.  LYNX SOFTWARE ALLOCATES ITS>>  <<03004>>63248000
          << OWN TBUF'S.  NO. OF TBUF'S = TBUF'S/PORT *    >>  <<03004>>63250000
          << NO. OF TERMINALS, NOT GREATER THAN LIMIT      >>  <<03004>>63252000
          I := CTAB( TBUFNUM) * TERMCOUNT( TRUE);              <<03004>>63254000
          IF I > TBUFLIMIT THEN I := TBUFLIMIT;                <<03004>>63256000
          IF I < 10 THEN I := 10;  << CHANGEME >>              <<03004>>63258000
          INITIOTABLE( I, SECTBUF, TBUFSIZE,                   <<03004>>63260000
            TBUFDSTN, SYSTBUF);                                <<01681>>63262000
                                                               <<01681>>63264000
          <<------------------------------->>                  <<01681>>63266000
          <<  INITIALIZE TEMPROARY TABLES  >>                  <<01681>>63268000
          <<------------------------------->>                  <<01681>>63270000
          NPROCQ := 0;  <<# OF TYPE 2 PROCESSES>>              <<01681>>63272000
          NCNTRLQ := 0;  <<# OF MULTI-UNIT CONTROLLERS>>       <<01681>>63274000
          NIOPROC := 0;  <<# OF I/O PROCESSES>>                <<01681>>63276000
          NDLT := 0;  <<# OF ENTRIES IN DLT>>                  <<01681>>63278000
          NCHANQ := 0;  <<# OF MULTI-CONTROLLER CHANNELS>>     <<01681>>63280000
          PUSH(DL);                                            <<01681>>63282000
          TOS := TOS-HLDEV*IOPROCSIZE;                         <<01681>>63284000
          @IOPROC := S0;   <<PTR TO I/O PROCESS TABLE>>        <<01681>>63286000
          TOS := TOS-HLDEV*INTRSIZE;                           <<01681>>63288000
          @INTR := S0&LSL(1);                                  <<04306>>63290000
          TOS := TOS-(HLDEV+CTAB0(NUMADVRS))*DLTSIZE;          <<01681>>63292000
          ASSEMBLE(DUP,DUP);                                   <<01681>>63294000
          ASSEMBLE(DUP,ZERO;XCH);                              <<01681>>63296000
          PUSH (DB);                                           <<01681>>63298000
          ASSEMBLE(ZROB,DADD;DEL);                             <<01681>>63300000
          IF TOS<>1 THEN ERRMESSAGE(M352); <<BANK WRAPAROUND>> <<01681>>63302000
          <<BANK WRAP-AROUND IS DETECTED BY A     >>           <<01681>>63304000
          <<CHANGE IN SIGN OF A 17-BIT INTEGER    >>           <<01681>>63306000
          SET(DL);                                             <<01681>>63308000
          @DLT' := TOS;   <<PTR TO TEMP DRIVER LINKAGE TABLE>> <<01681>>63310000
          PS0 := 0;                                            <<01681>>63312000
          ASSEMBLE(DUP,INCB);                                  <<01681>>63314000
          TOS := -S0-1+@CSDVRAREA;                             <<01681>>63316000
          ASSEMBLE(MOVE);   <<ZERO TABLES>>                    <<01681>>63318000
                                                               <<01681>>63320000
          <<----------------------------->>                    <<01681>>63322000
          <<  BUILD TABLES IN DRT ORDER  >>                    <<01681>>63324000
          <<----------------------------->>                    <<01681>>63326000
          DITLOC := MEMLOC;                                    <<01681>>63328000
          DRTN := LOWESTDRT;                                   <<01681>>63330000
          DO                                                   <<01681>>63332000
            BEGIN                                              <<01681>>63334000
              FIRST := TRUE;  <<FIRST LDEV FOR THIS DRT>>      <<01681>>63336000
              SECONDPASS := FALSE;                             <<01681>>63338000
  STARTPASS':  LDEV := 1;                                      <<01681>>63340000
              DO IF DVRTAB(LDEV*DVRSIZE+1).DSBIT=1  <<DS DEV>> <<03002>>63342000
                    AND SECONDPASS OR                          <<03002>>63344000
                    DVRTAB(LDEV*DVRSIZE).DRTFIELD=DRTN AND     <<03002>>63346000
                    NOT(SECONDPASS) THEN                       <<03002>>63348000
                BEGIN<<MAY BE DEVICE ON THIS CONTROLLER>>      <<01681>>63350000
                @DVRENT := @DVRTAB(LDEV*DVRSIZE);              <<03002>>63352000
                IF SECONDPASS THEN                             <<01681>>63354000
                  BEGIN                                        <<01681>>63356000
                  TOS := DVRENT(DVR1).DSDRTN*DVRSIZE;          <<01681>>63358000
                  DRTN := DVRTAB(TOS).DRTFIELD;                <<03002>>63360000
                  END;                                         <<01681>>63362000
                  UNIT := DVRENT.UNITFIELD; <<UNIT #>>         <<03002>>63364000
                  @DVRNAME := @DVRENT(DVR2)&LSL(1);            <<04306>>63366000
                  TYPE := LDT(LDEV*LDTSIZE+LDT2).TYP;          <<01681>>63368000
                  DVRFNUM := FOPEN(DVRNAME);  <<OPEN DRIVER>>  <<01681>>63370000
                  FREAD(DVRFNUM,0D,REC0,128);  <<RECORD ZERO>> <<01681>>63372000
                  FREAD(DVRFNUM,D'L(REC0(3))),DBINFO,384);     <<01681>>63374000
                  RESIDENT := LOGICAL(DBINFO.CORERES) LOR      <<01681>>63376000
                    LOGICAL(DVRENT(DVR1).CRBIT);               <<01681>>63378000
                  DITSIZE := DBINFO.(0:8); <<SIZE OF DIT AREA>><<01681>>63380000
                  STATSIZE := DBINFO(DVRDB3).STRETSIZE;        <<01681>>63384000
                    <<SIZE OF STATUS RETURN AREA>>             <<01681>>63386000
                  TOS := DVRFNUM;                              <<01681>>63390000
                  TOS := 0;                                    <<01681>>63392000
                  TOS := REC0(10);  <<ENTRY POINT>>            <<01681>>63394000
                  TOS := 128;                                  <<01681>>63396000
                  ASSEMBLE(DIV);                               <<01681>>63398000
                  INDEX := TOS;   <<POSITION IN BUFFER>>       <<01681>>63400000
                  TOS := TOS+REC0(4);  <<CODE SEG RECORD #>>   <<01681>>63402000
                  FREAD(*,*,OBINFO,256);  <<OUTER BLOCK CODE>> <<01681>>63404000
                                                               <<01681>>63406000
          <<------------->>                                    <<01681>>63408000
          <<  BUILD ILT  >>                                    <<01681>>63410000
          <<------------->>                                    <<01681>>63412000
                  IF NOT SECONDPASS THEN                       <<01681>>63414000
                  IF FIRST THEN                                <<01681>>63416000
                    BEGIN  <<CREATE ILT>>                      <<01681>>63418000
                    END                                        <<01681>>63420000
                  ELSE                                         <<01681>>63422000
                    BEGIN                                      <<01681>>63424000
                      I := 0;                                  <<01681>>63426000
                      WHILE (I:=I+1) < LDEV DO                 <<01681>>63428000
                      BEGIN                                    <<03002>>63430000
                      DRTUNIT.DRTFIELD := DRTN;                <<03002>>63432000
                      DRTUNIT.UNITFIELD:= UNIT;                <<03002>>63434000
                      IF DVRTAB(I*DVRSIZE)=DRTUNIT             <<03002>>63436000
                        THEN BEGIN   <<SAME DRT AND UNIT>>     <<01681>>63438000
                        IF CSDEV OR TYPE&LSR(3)=DIRACCESS THEN <<03004>>63440000
                             GOTO NEXTLDEV'                    <<03004>>63442000
                        ELSE GOTO CONSOLCHECK';                <<03004>>63444000
                        END;                                   <<01681>>63446000
                      END;                                     <<03002>>63448000
                    END;                                       <<01681>>63450000
                                                               <<01681>>63452000
  CONSOLCHECK':                                                <<03004>>63454000
          <<------------->>                                    <<01681>>63456000
          <<  BUILD DIT  >>                                    <<01681>>63458000
          <<------------->>                                    <<01681>>63460000
                  IF NOT(CSDEV) THEN                           <<01681>>63462000
                    BEGIN <<MOVE IN INITIALIZED DIT>>          <<01681>>63464000
                    MEMLOC := MEMLOC + DITSIZE;                <<01681>>63466000
                    IF L'(MEMLOC) > %100000 THEN               <<01681>>63468000
                      ERRMESSAGE(M350);                        <<01681>>63470000
                    END                                        <<01681>>63472000
                  ELSE                                         <<01681>>63474000
                    BEGIN   <<CS DEVICE>>                      <<01681>>63476000
                    END;                                       <<01681>>63478000
                  IF SECONDPASS THEN                           <<01681>>63480000
                    BEGIN <<NO  ILT POINTER>>                  <<01681>>63482000
                    GO BUILDDLT';                              <<01681>>63484000
                    END;                                       <<01681>>63486000
              IF NOT(CSDEV17<=LDT(LDEV*LDTSIZE+LDT2).TYP<=     <<01681>>63488000
                CSDEV19) THEN GO BUILDDLT';                    <<01681>>63490000
          <<---------------->>                                 <<01681>>63492000
          <<  BUILT CS DIT  >>                                 <<01681>>63494000
          <<---------------->>                                 <<01681>>63496000
                                                               <<01681>>63498000
              IF LPDT(LDEV*LPDTSIZE+LPDT1).SUBTYPE = 7 THEN    <<01681>>63500000
                LCN := 7                                       <<01681>>63502000
              ELSE                                             <<01681>>63504000
                 BEGIN                                         <<01681>>63506000
                 TOS := LPDT(LDEV*LPDTSIZE+LPDT1).SUBTYPE;     <<01681>>63508000
                 TOS := 3;                                     <<01681>>63510000
                 ASSEMBLE(DIV,ADD);                            <<01681>>63512000
              LCN:=IF LDT(LDEV*LDTSIZE+LDT2).TYP = CSDEV19     <<01681>>63514000
                     THEN TOS+4  <<LINE CONNECTION>>           <<01681>>63516000
                     ELSE TOS+1; <<NETWORK        >>           <<01681>>63518000
                 END;                                          <<01681>>63520000
              LDTXINDEX :=CSDEF(LDEV);<<LINE DESCRIPTOR INDEX>><<01681>>63522000
              @CSLDTX := @CSTAB(7);                            <<01681>>63524000
              I := -1;                                         <<01681>>63526000
              WHILE (I:=I+1) < LDTXINDEX DO                    <<01681>>63528000
                @CSLDTX := @CSLDTX+CSLDTX;                     <<01681>>63530000
              DEFDVRINDEX := 0;                                <<01681>>63532000
              LCMEDPDMAX := 0;                                 <<01681>>63534000
              @DRIVERENTRY := @CSDVRAREA;<<PT TO DUMMY DRIVER>><<01681>>63536000
              I := -1;                                         <<01681>>63538000
              WHILE (I:=I+1)<CSTAB(DRIVERENTNUM) DO            <<01681>>63540000
                BEGIN  <<COMPUTE MAX DIT FOR COMPATIBLE DVRS>> <<01681>>63542000
                  @LCNPTR := @DRLCN&LSL(1);                    <<04306>>63544000
                  J := 0;                                      <<01681>>63546000
                  DO IF INTEGER(LCNPTR(J))=LCN OR I=0 THEN     <<01681>>63548000
                    BEGIN <<COMPATIBLE DRIVER>>                <<01681>>63550000
                      TOS := @DRNAME&LSL(1);                   <<04306>>63552000
                      TOS := @DVRNAME;                         <<01681>>63554000
                      IF *=*,(8) THEN                          <<01681>>63556000
                        BEGIN                                  <<01681>>63558000
                          DEFDVRINDEX := I;                    <<01681>>63560000
                          GO SUMLENS';                         <<01681>>63562000
                        END;                                   <<01681>>63564000
                      IF LOGICAL(CSLDTXDRCHANGEABLE) OR I=0    <<01681>>63566000
                        THEN BEGIN                             <<01681>>63568000
  SUMLENS':                TOS := @DRCAPSECTSIZE;              <<01681>>63570000
                          TOS := PS0;                          <<01681>>63572000
                          ASSEMBLE(ADD,INCA);<<PTR TO LCM LEN>><<01681>>63574000
                          N := 0;                              <<01681>>63576000
                          K := 0;                              <<01681>>63578000
                          DO                                   <<01681>>63580000
                            BEGIN  <<SUM LENGTHS>>             <<01681>>63582000
                              TOS := PS0;                      <<01681>>63584000
                              N := S0+N;                       <<01681>>63586000
                              ASSEMBLE(ADD,INCA);  <<NEW PTR>> <<01681>>63588000
                            END                                <<01681>>63590000
                          UNTIL (K:=K+1)=4;                    <<01681>>63592000
                          IF N>LCMEDPDMAX THEN LCMEDPDMAX := N;<<01681>>63594000
                          DEL;                                 <<01681>>63596000
                        END;                                   <<01681>>63598000
                    END                                        <<01681>>63600000
                  UNTIL (J:=J+1)=3;                            <<01681>>63602000
                  @DRIVERENTRY := @DRIVERENTRY+DRIVERENTRY;    <<01681>>63604000
                END;                                           <<01681>>63606000
              CONTSECTSIZE := 0;<<NO CONTROL SECTION IN DIT>>  <<01681>>63608000
              DITSIZE := MPESTDSIZE+CSSTDSIZE+CONTSECTSIZE+    <<01681>>63610000
                LCMEDPDMAX;                                    <<01681>>63612000
              MEMLOC := MEMLOC+DITSIZE;                        <<01681>>63614000
              IF L'(MEMLOC) > %100000 THEN ERRMESSAGE(M350);   <<01681>>63616000
          <<------------------->>                              <<01681>>63618000
          <<  BUILD DLT ENTRY  >>                              <<01681>>63620000
          <<------------------->>                              <<01681>>63622000
  BUILDDLT':                                                   <<01681>>63624000
                  FIRST := FALSE;                              <<01681>>63626000
  NEXTLDEV':       FCLOSE(DVRFNUM);                            <<01681>>63628000
                END                                            <<01681>>63630000
              UNTIL (LDEV:=LDEV+1) > HLDEV;                    <<01681>>63632000
              IF SECONDPASS THEN GO MOVEDLT';                  <<01681>>63634000
            END                                                <<01681>>63636000
          UNTIL (DRTN := DRTN+1) > HIDRT;                      <<02707>>63638000
                                                               <<01681>>63640000
          IF NOT(SECONDPASS) THEN                              <<01681>>63642000
            BEGIN                                              <<01681>>63644000
            FIRST := FALSE;                                    <<01681>>63646000
            SECONDPASS := TRUE;                                <<01681>>63648000
            GO STARTPASS';                                     <<01681>>63650000
            END;                                               <<01681>>63652000
          <<------------------------>>                         <<01681>>63654000
          <<  MOVE DLT TO LOW CORE  >>                         <<01681>>63656000
          <<------------------------>>                         <<01681>>63658000
  MOVEDLT':                                                    <<01681>>63660000
            TOS := DLSAVE;                                     <<01681>>63662000
            SET(DL);                                           <<01681>>63664000
            MEMLOC := ROUND(MEMLOC);                           <<01681>>63666000
                                                               <<01681>>63668000
        << ZERO THE AREA RESERVED FOR THE DITS >>              <<01681>>63670000
          TOS := 0;  << BANK 0 >>                              <<01681>>63672000
          TOS := DITLOC;  << FIRST WORD OF DIT AREA >>         <<01681>>63674000
          TOS := 0;  << VALUE TO STORE >>                      <<01681>>63676000
          ASSEMBLE (SSEA; INCA,DDUP; DECA);                    <<01681>>63678000
          TOS := MEMLOC - DITLOC - 1;  << LENGTH OF DIT AREA >><<01681>>63680000
          ASSEMBLE (MABS 5);                                   <<01681>>63682000
                                                               <<01681>>63684000
        << SPACE FOR DITS IS NOW SAFE.  LET'S MOVE THE    >>   <<01681>>63686000
        << DST, CST & CSTX BACK TO LOW END OF MEMORY.     >>   <<01681>>63688000
          TOS := 0;  << DESTINATION BANK >>                    <<01681>>63690000
          TOS := MEMLOC;  << DESTINATION ADDRESS >>            <<01681>>63692000
          TOS := 0;  << SOURCE ADDRESS >>                      <<01681>>63694000
          TOS := ABSOLUTE(DSTP);  << SOURCE ADDRESS >>         <<01681>>63696000
          TOS := MOVE'LEN;  << MOVE RIGHT TO LEFT THIS TIME >> <<01681>>63698000
          ASSEMBLE (MABS 3);  << LEAVE ADRESS >>               <<01681>>63700000
          DELB;  << DELETE BANK >>                             <<01681>>63702000
          MEMLOC := S0;  << POINT TO NEXT AVAILABLE WORD >>    <<01681>>63704000
                                                               <<01681>>63706000
        << RESET POINTERS >>                                   <<01681>>63708000
          TOS := TOS - MOVE'LEN;  << POINT TO START OF TABS >> <<01681>>63710000
          ABSOLUTE(DSTP) := S0;  << LOW CORE DST POINTER >>    <<01681>>63712000
          ABSOLUTE(SYSDST) := S0 - SYSBASE;  << SYSGLOB PTR >> <<01681>>63714000
          TOS := CTAB(DSTNUM) * CSTSIZE;  << LEN OF DST TAB>>  <<01681>>63716000
          ABSOLUTE(DFC) := S0;                                 <<01681>>63718000
          ASSEMBLE(ADD);  << @DST + SIZE = @CST >>             <<01681>>63720000
          ABSOLUTE(SYSCST) := S0 - SYSBASE;  << SYSGLOB PTR >> <<01681>>63722000
          DEL;  << COMPILER CAN'T HANDLE TOS IN LAST LINE >>   <<01681>>63724000
          ABSOLUTE(DFS) := ABSOLUTE(DFC) +                     <<01681>>63726000
            (CTAB(CSTNUM) * CSTSIZE);  << OFFSET TO CSTX >>    <<01681>>63728000
          DST(DSTDSTN&LSL(2)+3) := ABSOLUTE(DSTP);             <<01681>>63730000
          DST(CSTDSTN&LSL(2)+3) := ABSOLUTE(DSTP) +            <<01681>>63732000
            ABSOLUTE(DFC);                                     <<01681>>63734000
          DST(CSTXDSTN&LSL(2)+3) := ABSOLUTE(DSTP) +           <<01681>>63736000
            ABSOLUTE(DFS);                                     <<01681>>63738000
                                                               <<01681>>63740000
          <<-----------------------------------                         63742000
            PROCESS CONTROL BLOCK TABLE (PCB)                           63744000
          ----------------------------------->>                         63746000
          TOS := INITTABLE(CTAB(PCBNUM),PCBSIZE,1);                     63748000
          ASSEMBLE(DUP,DDUP);                                           63750000
          ABSOLUTE(PCBP) := TOS;  <<STARTING ADDRESS OF TABLE>>         63752000
          TOS := TOS-SYSBASE;                                           63754000
          ABSOLUTE(SYSPCB) := TOS;                                      63756000
          INITFREELIST(*,CTAB(PCBNUM),PCBSIZE,FREEPCBN);                63758000
          INSERTDST(*,PCBDSTN,MEMSEG,0);                                63760000
             <<mark unassigned pcb entries for check alive>>   <<01684>>63762000
             I:=FREEPCBN;                                      <<01684>>63764000
             WHILE I < CTAB(PCBNUM) DO                         <<01684>>63766000
                BEGIN                                          <<01684>>63768000
                PCB(I*PCBSIZE+PQPTRWORDNUM):=-1;               <<01684>>63770000
                I:=I+1;                                        <<01684>>63772000
                END;                                           <<01684>>63774000
          TOS:=0;                                              <<MPEIV>>63776000
          TOS:=SYSBASE;                                        <<MPEIV>>63778000
          ASSEMBLE(XCHD); <<DB TO SYSDB>>                      <<MPEIV>>63780000
                                                               <<MPEIV>>63782000
          <<PLACE PROGENITOR'S PCB ENTRY AT HEAD OF DISPQ>>    <<MPEIV>>63784000
          X:=ABSOLUTE(SYSPCB)+PROGPCBN*PCBSIZE;                <<MPEIV>>63786000
          DISPQHEAD:=X;                                        <<MPEIV>>63788000
          DISPQTAIL:=X;                                        <<MPEIV>>63790000
          <<FIX PROGENITOR'S QUEUE FIELDS>>                    <<MPEIV>>63792000
          WAKEMASK.MEMWAITFLAG:=1;                             <<MPEIV>>63794000
          QUEUEINGINFO.DISPQFLAG:=1;                           <<MPEIV>>63796000
          ASSEMBLE(XCHD);                                      <<MPEIV>>63798000
          ASSEMBLE(DDEL);                                      <<MPEIV>>63800000
                                                                        63802000
          <<-------------------------------                             63804000
            INTERRUPT CONTROL STACK (ICS)                               63806000
          ------------------------------->>                             63808000
          TOS := INITTABLE(ICSQMINUS+CTAB(ICSSIZE),1,1);                63810000
          ASSEMBLE(DUP,DUP);                                            63812000
          ABSOLUTE(QI) := TOS+ICSQMINUS;                                63814000
          ABSOLUTE(ZI) := TOS+MEMSEG-2;                                 63816000
        ABSOLUTE(SYSICS):=ABSOLUTE(QI)-SYSBASE;                <<MPEIV>>63818000
          INSERTDST(*,ICSDSTN,MEMSEG,0);                                63820000
                                                                        63822000
          <<-----------                                                 63824000
            CORE SIZE                                                   63826000
          ----------->>                                                 63828000
          INSERTDST(0,COREDSTN,CTAB0(CORESIZE)&LSL(2),0);               63830000
                                                                        63832000
          <<----------------------                                      63834000
            BUILD CS DRIVER TABLE                                       63836000
          ----------------------->>                                     63838000
          CSDVRAREASIZE := 0;                                           63840000
          PUSH(DL);                                                     63842000
          @CSDVRAREA := TOS;  <<PTR TO DRIVER TABLE WORK AREA>>         63844000
          CSTAB(DRIVERENTNUM) := 0;                                     63846000
          IF CSPRESENT THEN FORMATCSDVRENTRY(CSDUMMY); <<FOR CSDUMMY>>  63848000
          DRTN := LOWESTDRT;                                   <<00888>>63850000
          DO                                                            63852000
            BEGIN  <<ADD DRIVER FOR EACH CONFIGURED LINE TO TABLE>>     63854000
              LDEV := 2;                                                63856000
              DO IF DVRTAB(LDEV*DVRSIZE).DRTFIELD=DRTN         <<03002>>63858000
                 AND CSDEV17 <=                                <<03002>>63860000
                LDT(LDEV*LDTSIZE+LDT2).TYP<=CSDEV19 THEN       <<00888>>63862000
                BEGIN  << CS DEVICE >>                                  63864000
                @DVRNAME := (@DVRTAB(DVRSIZE*LDEV)+DVR2)       <<04306>>63866000
                                                      &LSL(1); <<04306>>63868000
                  TOS := CSDRTN(DRTN.(0:12));                           63870000
                  X := DRTN.(12:4);                                     63872000
                  ASSEMBLE(TSBC 0,X);     <<SET CS BIT>>                63874000
                  CSDRTN(DRTN.(0:12)) := TOS;                           63876000
                  I := 0;                                               63878000
                  @DRIVERENTRY := @CSDVRAREA;                           63880000
                  WHILE (I:=I+1)<=CSTAB(DRIVERENTNUM) DO                63882000
                    BEGIN  <<CHECK FOR ALREADY IN TABLE>>               63884000
                      TOS := @DRNAME&LSL(1);                   <<04306>>63886000
                      TOS := @DVRNAME;                                  63888000
                      IF *=*,(8) THEN GOTO NEXTCSDRT;                   63890000
                      @DRIVERENTRY := @DRIVERENTRY+DRIVERENTRY;         63892000
                    END;                                                63894000
                  FORMATCSDVRENTRY(DVRNAME);                            63896000
                END                                                     63898000
              UNTIL (LDEV:=LDEV+1)>HLDEV;                               63900000
  NEXTCSDRT:END                                                         63902000
          UNTIL (DRTN := DRTN+1) > HIDRT;                      <<02707>>63904000
          INIT'LIZAT'NSTT := 0;                                <<00.06>>63906000
          MOVE INIT'LIZAT'NSTT(1) := INIT'LIZAT'NSTT,(31);     <<00.06>>63908000
          I := -1;                                             <<00.06>>63910000
          WHILE(I:=I+1) < CTAB0(NUMADVRS) DO                   <<00.06>>63912000
            BEGIN <<ADD ADDITIONAL CS DRIVERS TO TABLE>>       <<00.06>>63914000
            TOS := 0;  <<FOR PROCEDURE RETURN>>                <<00.06>>63916000
            TOS := @CSDVR(I*CSDVRSIZE)&LSL(1);                 <<04306>>63918000
            INIT'LIZAT'NSTT(I) := FORMATCSDVRENTRY(*);         <<00.06>>63920000
            END;                                               <<00.06>>63922000
$PAGE "MAINSEG2  --  SET UP I/O SYSTEM TABLES"                          63924000
          <<-----------                                                 63926000
            I/O QUEUE                                                   63928000
          ----------->>                                                 63930000
          INITIOTABLE(CTAB(IOQNUM),SECIOQ,IOQSIZE,IOQDSTN,SYSIOQ);      63932000
          <<>>                                                 <<MPEIV>>63934000
          <<DISC I/O REQUEST TABLE>>                           <<MPEIV>>63936000
          <<>>                                                 <<MPEIV>>63938000
          INITIOTABLE(CTAB(DISCREQTABLE),SECDISC,              <<01639>>63940000
           DISCREQSIZE,DISCREQTABDSTN,SYSDISCREQTAB);          <<01639>>63942000
                                                                        63944000
          <<-----------------------------                               63946000
            INITIALIZE TEMPROARY TABLES                                 63948000
          ----------------------------->>                               63950000
          NPROCQ := 0;  <<# OF TYPE 2 PROCESSES>>                       63952000
          NCNTRLQ := 0;  <<# OF MULTI-UNIT CONTROLLERS>>                63954000
          NIOPROC := 0;  <<# OF I/O PROCESSES>>                         63956000
          NDLT := 0;  <<# OF ENTRIES IN DLT>>                           63958000
          NCHANQ := 0;  <<# OF MULTI-CONTROLLER CHANNELS>>              63960000
          PUSH(DL);                                                     63962000
          TOS := TOS-HLDEV*IOPROCSIZE;                                  63964000
          @IOPROC := S0;   <<PTR TO I/O PROCESS TABLE>>                 63966000
          TOS := TOS-HLDEV*INTRSIZE;                                    63968000
          @INTR := S0&LSL(1);                                  <<04306>>63970000
          TOS := TOS-(HLDEV+CTAB0(NUMADVRS))*DLTSIZE;          <<00.06>>63972000
          ASSEMBLE(DUP,DUP);                                            63974000
          ASSEMBLE(DUP,ZERO;XCH);                                       63976000
          PUSH (DB);                                                    63978000
          ASSEMBLE(ZROB,DADD;DEL);                                      63980000
          IF TOS<>1 THEN ERRMESSAGE(M352); <<BANK WRAPAROUND>> <<01103>>63982000
          <<BANK WRAP-AROUND IS DETECTED BY A     >>                    63984000
          <<CHANGE IN SIGN OF A 17-BIT INTEGER    >>                    63986000
          SET(DL);                                                      63988000
          @DLT' := TOS;   <<PTR TO TEMPORARY DRIVER LINKAGE TABLE>>     63990000
          PS0 := 0;                                                     63992000
          ASSEMBLE(DUP,INCB);                                           63994000
          TOS := -S0-1+@CSDVRAREA;                                      63996000
          ASSEMBLE(MOVE);   <<ZERO TABLES>>                             63998000
                                                                        64000000
          <<--------------------------                                  64002000
            BUILD TABLES IN DRT ORDER                                   64004000
          -------------------------->>                                  64006000
          ILTSTART := MEMLOC;                                           64008000
          DRTN := LOWESTDRT;                                   <<00888>>64010000
          DO                                                            64012000
            BEGIN                                                       64014000
              FIRST := TRUE;  <<FIRST LDEV FOR THIS DRT>>               64016000
              SECONDPASS := FALSE;                                      64018000
  STARTPASS:  LDEV := 1;                                                64020000
              DO IF DVRTAB(LDEV*DVRSIZE+1).DSBIT=1 <<DS DEV>>  <<03002>>64022000
                 AND SECONDPASS OR                             <<03002>>64024000
                 DVRTAB(LDEV*DVRSIZE).DRTFIELD=DRTN            <<03002>>64026000
                 AND NOT(SECONDPASS) THEN                      <<03002>>64028000
                BEGIN<<MAY BE DEVICE ON THIS CONTROLLER>>               64030000
                @DVRENT := @DVRTAB(LDEV*DVRSIZE);              <<03002>>64032000
                IF SECONDPASS THEN                                      64034000
                  BEGIN                                                 64036000
                  TOS := DVRENT(DVR1).DSDRTN*DVRSIZE;                   64038000
                  DRTN := DVRTAB(TOS).DRTFIELD;                <<03002>>64040000
                  END;                                                  64042000
                  UNIT := DVRENT.UNITFIELD;  <<UNIT #>>        <<03002>>64044000
                  @DVRNAME := @DVRENT(DVR2)&LSL(1);            <<04306>>64046000
                  TYPE := LDT(LDEV*LDTSIZE+LDT2).TYP;                   64048000
                  SUBTYP := LPDT(LDEV*LPDTSIZE+LPDT1).SUBTYPE; <<03004>>64050000
                  DVRFNUM := FOPEN(DVRNAME);  <<OPEN DRIVER FILE>>      64052000
                  FREAD(DVRFNUM,0D,REC0,128);  <<RECORD ZERO>>          64054000
                  FREAD(DVRFNUM,D'L(REC0(3))),DBINFO,384);  <<DB AREA>> 64056000
                  RESIDENT := LOGICAL(DBINFO.CORERES) LOR LOGICAL(      64058000
                    DVRENT(DVR1).CRBIT);                                64060000
                  DITSIZE := DBINFO.(0:8);  <<SIZE OF DIT AREA>>        64062000
                  STATSIZE := DBINFO(DVRDB3).STRETSIZE;        <<00888>>64066000
                    <<SIZE OF STATUS RETURN AREA>>             <<00888>>64068000
                  TOS := DVRFNUM;                                       64072000
                  TOS := 0;                                             64074000
                  TOS := REC0(10);  <<ENTRY POINT>>                     64076000
                  TOS := 128;                                           64078000
                  ASSEMBLE(DIV);                                        64080000
                  INDEX := TOS;   <<POSITION IN BUFFER>>                64082000
                  TOS := TOS+REC0(4);  <<CODE SEG RECORD #>>            64084000
                  FREAD(*,*,OBINFO,256);  <<OUTER BLOCK CODE>>          64086000
                                                                        64088000
          <<-----------                                                 64090000
            BUILD ILT                                                   64092000
          ----------->>                                                 64094000
                  IF NOT SECONDPASS THEN                                64096000
                  IF FIRST THEN                                         64098000
                    BEGIN  <<CREATE ILT>>                               64100000
                      SEEKMASK := 0;                           <<01853>>64102000
                      TOS := 0;  <<BANK ADDRESS>>                       64106000
                      TOS := MEMLOC;                                    64108000
                      ASSEMBLE(DUP);                           <<03002>>64110000
                      PUTDRT(DRTN,DBI,MEMLOC);<<ADDR OF ILT>>  <<03002>>64112000
                      TOS :=TOS-SYSBASE;                                64114000
                      ABSOLUTE(ILTPTR) := TOS;                          64116000
                      TOS := 0;                                         64118000
                      ASSEMBLE(SSEA; INCA,DDUP; DECA);                  64120000
                      TOS := 255;                                       64122000
                      ASSEMBLE(MABS);  <<ZERO AREA FOR ILT>>            64124000
                      ILT(ICNTRL).DRTN' := DRTN;               <<00888>>64128000
                      IF NOT(CSDEV) THEN                       <<00888>>64134000
                        BEGIN <<NOT CS DEVICE>>                         64136000
                      ILT(IUNIT):=DBINFO(DVRDB2); <<UNIT EXTRACT INFO>> 64140000
                      ILT(IFLAG).RUNWAIT := DBINFO.RUNWAIT';   <<00888>>64142000
                      TOS := DBINFO(DVRDB3).SIOPSIZE; <<SIO PROG SIZE>> 64144000
                      SIOSIZE := S0&LSL(1);                    <<00888>>64146000
                      ILT(IQUEUE).SIOPSIZE := TOS;             <<00888>>64148000
                      CHANNEL:=DVRENT(DVR1).DVRCHAN; <<CHANNEL #>>      64152000
                      I := 1;                                           64154000
                      N := UNIT;  <<WILL HOLD HIGHEST UNIT #>>          64156000
                      K := 0;  <<# OF DEVICES ON CONTROLLER>>           64158000
                     DO IF DVRTAB(I*DVRSIZE).DRTFIELD=DRTN THEN<<03002>>64160000
                        BEGIN  <<DEVICE ON THIS CONTROLLER>>            64162000
                          TOS := DVRTAB(X).UNITFIELD;          <<03002>>64164000
                          IF LDTX(I*LDTXSIZE).LDTX'SA = 1 THEN <<01853>>64166000
                            BEGIN                              <<01853>>64168000
                            X := S0;                           <<01853>>64170000
                            TOS := SEEKMASK;                   <<01853>>64172000
                            ASSEMBLE(TSBC 0, X);               <<01853>>64174000
                            SEEKMASK := TOS;                   <<01853>>64176000
                            END;                               <<01853>>64178000
                          J := 0;                                       64180000
                          WHILE (J:=J+1)<I DO                           64182000
                          IF DVRTAB(J*DVRSIZE).DRTFIELD=DRTN   <<03002>>64184000
                             AND DVRTAB(X).UNITFIELD=S0        <<03002>>64186000
                          THEN GOTO SAMEDU;                    <<03002>>64188000
                          K := K+1;                                     64190000
  SAMEDU:                 IF S0>N THEN N := TOS ELSE DEL;               64192000
                        END                                             64194000
                      ELSE IF CHANNEL<>0 AND DVRTAB(X:=X+DVR1).DVRCHAN  64196000
                        =CHANNEL THEN                                   64198000
                          BEGIN <<MULTI-CONTROLLER CHANNEL>>            64200000
                          ILT(ICNTRL).MCHAN := 1;              <<00888>>64204000
                          X := 0;                                       64208000
                          WHILE (X:=X+1)<=NCHANQ DO                     64210000
                            IF CHNUMB(X)=CHANNEL THEN                   64212000
                             BEGIN<<QUEUE ALREADY RESERVED FOR CHANNEL>>64214000
                             TOS := X;                                  64216000
                             GO SETCHANQUE;                             64218000
                             END;                                       64220000
                          TOS := NCHANQ+1;                              64222000
                          NCHANQ := S0;                                 64224000
                          X := S0;                                      64226000
                          CHNUMB(X) := CHANNEL;                         64228000
  SETCHANQUE:             ILT(ICNTRL).CHANQUE := TOS;          <<00888>>64232000
                          END                                           64236000
                      UNTIL (I:=I+1)>HLDEV;                             64238000
                      IF K<>1 AND DBINFO(ILTSIZE).TERM'=0 THEN          64240000
                        BEGIN  <<MULTI-UNIT, NON-TERMINAL CONTROLLER>>  64242000
                          TOS := NCNTRLQ+1; <<# OF MULTI-UNIT CNTRLS>>  64244000
                          NCNTRLQ := S0;                                64246000
                          ILT(IQUEUE).CNTRLRQ := TOS; <<REL Q #>>       64248000
                        END;                                            64250000
                      ILT(IFLAG).HCUNIT:=N; <<SET>>            <<00888>>64254000
                      <<HIGHEST CONFIGURED UNIT #>>            <<00888>>64256000
                      INTHS'UNITS(DRTN) := N+1; <<MAX UNITS>>  <<00888>>64258000
                      TOS := 0;                                <<00888>>64260000
                      TOS := MEMLOC+ILTSIZE+N+1;               <<00888>>64262000
                      ILT(ISTAP) := IF STATSIZE=0 THEN 0       <<00888>>64264000
                        ELSE S0-SYSBASE;                       <<00888>>64266000
                      TOS := TOS+STATSIZE;                     <<00888>>64268000
                      IF TYPE = DISC0 OR TYPE = DISC1 THEN     <<01853>>64270000
                        TOS := TOS + DVR'GLOBAL'VARS;          <<01962>>64272000
                      ILT(ISIOP) := S0-SYSBASE;                <<00888>>64274000
                      IF TYPE = DISC0 OR TYPE = DISC1 THEN     <<01853>>64276000
                      ABSOLUTE(ILT(ISIOP)-1+SYSBASE):=SEEKMASK;<<01853>>64278000
                      PUSH(DB);                                <<00888>>64280000
                      TOS := TOS+@DBINFO(DITSIZE+DVRDB4);      <<00888>>64282000
                      TOS := SIOSIZE;                          <<00888>>64284000
                      ASSEMBLE(MABS 3);  <<MOVE SIO AREA TO ILT>>       64286000
                      MEMLOC := TOS;  <<UPDATE MEMORY PTR>>             64290000
                      DEL;                                              64292000
                      CHECKMEM;                                         64294000
                        END                                             64296000
                      ELSE                                              64298000
                        BEGIN <<CS DEVICE>>                             64300000
                        RESIDENT := 0;                                  64302000
                        MEMLOC := MEMLOC+ILTSIZE+1;            <<00888>>64306000
                        INTHS'UNITS(DRTN) := 1;                <<00888>>64308000
                        END;                                            64312000
                    END                                                 64314000
                  ELSE                                                  64316000
                    BEGIN                                               64318000
                      I := 0;                                           64320000
                      WHILE (I:=I+1) < LDEV DO                          64322000
                      BEGIN                                    <<03002>>64324000
                      DRTUNIT.DRTFIELD := DRTN;                <<03002>>64326000
                      DRTUNIT.UNITFIELD := UNIT;               <<03002>>64328000
                      IF DVRTAB(I*DVRSIZE)=DRTUNIT THEN        <<03002>>64330000
                        BEGIN   <<SAME DRT AND UNIT>>                   64332000
                          LPDT(LDEV*LPDTSIZE) := LPDT(I*LPDTSIZE);      64334000
                          IF CSDEV THEN                        <<03004>>64336000
                            BEGIN    << UPDATE CSTAB >>        <<03004>>64338000
                            LDTXINDEX := CSDEF(I);             <<01.01>>64340000
                            @CSLDTX := @CSTAB(7);              <<01.01>>64342000
                            J := -1;                           <<01.01>>64344000
                            WHILE(J:=J+1)<LDTXINDEX DO         <<01.01>>64346000
                              @CSLDTX := @CSLDTX+CSLDTX;       <<01.01>>64348000
                            TOS := CSLDTXDRINDEX;              <<01.01>>64350000
                            LDTXINDEX := CSDEF(LDEV);          <<01.01>>64352000
                            J := -1;                           <<01.01>>64354000
                            @CSLDTX := @CSTAB(7);              <<01.01>>64356000
                            WHILE(J:=J+1)<LDTXINDEX DO         <<01.01>>64358000
                              @CSLDTX := @CSLDTX+CSLDTX;       <<01.01>>64360000
                            CSLDTXLDEV := LDEV;                <<01.01>>64362000
                            CSLDTXDRINDEX:= TOS;               <<04389>>64364000
                            GOTO NEXTLDEV;                     <<03004>>64366000
                            END                                <<03004>>64368000
                          ELSE                                 <<03004>>64370000
                          << DON'T BUILD NEW DIT FOR DISCS >>  <<03004>>64372000
                            IF TYPE&LSR(3) = DIRACCESS THEN    <<03004>>64374000
                               GOTO NEXTLDEV                   <<03004>>64376000
                          ELSE GOTO CONSOLCHECK;               <<03004>>64378000
                        END;                                            64380000
                      END;                                     <<03002>>64382000
                    END;                                                64384000
                                                                        64386000
  CONSOLCHECK:                                                 <<03004>>64388000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>64390000
      <<------------------------------------->>                <<00888>>64392000
      <<BUILD TERMINAL INITIALIZATION PROGRAM>>                <<00888>>64394000
      <<------------------------------------->>                <<00888>>64396000
               IF NOT ADCCRESERVED THEN  << NOT DONE YET >>    <<03004>>64398000
                 IF DVRTAB(LDEV*DVRSIZE+DVR1).DSBIT=0 THEN     <<03004>>64400000
                   IF (TYPE=TERMDEVTYPE LOR TYPE=32 LAND       <<03004>>64402000
                       (SUBTYP=14 LOR SUBTYP=15))              <<03004>>64404000
                      AND LDTX(LDEV*LDTXSIZE+LDTX2).TERMBOARD  <<03004>>64406000
                      = ADCC'TERM THEN  <<HAVE AN ADCC TERM>>  <<03004>>64408000
                     BEGIN                                     <<00888>>64410000
                     <<IF THERE IS AT LEAST ONE ADCC-       >> <<03004>>64412000
                     <<CONNECTED PORT CONFIGURED, SAVE ROOM >> <<03004>>64414000
                     <<FOR CHANNEL PROGRAMS OF PRINTCHAR AND>> <<03004>>64416000
                     <<READCHAR OF HARDRES.  ALSO SAVE SPACE>> <<03004>>64418000
                     <<FOR ADCC TERMINAL INIT. CHANNEL PROG,>> <<03004>>64420000
                     <<WHICH EXISTS IN ONLY ONE PLACE       >> <<03004>>64422000
                     MEMLOC := MEMLOC + HARDRES'SIOAREA;       <<01384>>64424000
                                                               <<01384>>64426000
                     IF INITTCP'>384<<SIZE OF DBINFO ARRAY>>   <<00888>>64428000
                     THEN ERRMESSAGE(M251);                    <<01103>>64430000
                     <<TERMINAL SIOPROG IS TOO LARGE!>>        <<00888>>64432000
                     <<CAN'T EVEN GET TO INITPROG SIZEWORD>>   <<00888>>64434000
                     ABSOLUTE(INITTCP):=MEMLOC-SYSBASE;        <<00888>>64436000
                     TOS:=0;                                   <<00888>>64438000
                     TOS:=MEMLOC;                              <<00888>>64440000
                     PUSH(DB);                                 <<00888>>64442000
                     TOS:=TOS+@DBINFO(INITTCP');               <<00888>>64444000
                     J:=DBINFO(X:=X-1);                        <<00888>>64446000
                     TOS:=384-(INITTCP');                      <<00888>>64448000
                     <<AMOUNT OF INITPROG IN DBREC0-2>>        <<00888>>64450000
                     J:=J-S0; <<AMOUNT LEFT>>                  <<00888>>64452000
                     IF J>384 THEN ERRMESSAGE(M250);           <<01103>>64454000
                     <<INITPROG CAN'T EXTEND INTO DBREC6>>     <<00888>>64456000
                     ASSEMBLE(MABS 3);                         <<00888>>64458000
                     IF J>0 THEN                               <<00888>>64460000
                       BEGIN <<GET REST FROM DBREC3-5>>        <<00888>>64462000
                       FREAD(DVRFNUM,D'L(REC0(3)+3)),          <<00888>>64464000
                       DBINFO,384);                            <<00888>>64466000
                       PUSH(DB);                               <<00888>>64468000
                       TOS:=TOS+@DBINFO;                       <<00888>>64470000
                       TOS:=J; <<COUNT>>                       <<00888>>64472000
                       ASSEMBLE(MABS 3);                       <<00888>>64474000
                       FREAD(DVRFNUM,D'L(REC0(3))),            <<00888>>64476000
                       DBINFO,384);                            <<00888>>64478000
                       END                                     <<00888>>64480000
                     ELSE                                      <<00888>>64482000
                       TOS:=TOS+J;                             <<00888>>64484000
                     MEMLOC:=TOS;                              <<00888>>64486000
                     DEL;                                      <<00888>>64488000
                     CHECKMEM;                                 <<00888>>64490000
                     ADCCRESERVED := TRUE; <<DON'T DO AGAIN>>  <<03004>>64492000
                     END;                                      <<00888>>64494000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>64496000
          <<-----------                                                 64498000
            BUILD DIT                                                   64500000
          ----------->>                                                 64502000
                  TOS := 0;                                             64504000
                  TOS := DITLOC;                               <<01681>>64506000
                  TOS := S0-SYSBASE;                                    64508000
                  ASSEMBLE(DUP,DUP);                                    64510000
                  LPDT(LDEV*LPDTSIZE) := TOS;  <<PTR TO DIT>>           64512000
                  IF SECONDPASS THEN DEL                                64514000
                  ELSE ILT(IDITP+UNIT) := TOS;                          64516000
                  ABSOLUTE(DITPTR) := TOS;                              64518000
                  IF NOT(CSDEV) THEN                           <<00888>>64520000
                    BEGIN <<MOVE IN INITIALIZED DIT>>                   64522000
                    PUSH(DB);                                           64524000
                    TOS := TOS+@DBINFO(DVRDB4);                <<00888>>64528000
                    TOS := DITSIZE;                                     64532000
                    ASSEMBLE( MABS 3);                         <<03004>>64536000
                                                               <<03004>>64538000
                    << FILL IN DIT ENTRIES FOR ADCC    >>      <<03004>>64540000
                    << TERMINALS, NOT FOR LYNX         >>      <<03004>>64542000
                    IF (TYPE=TERMDEVTYPE LOR TYPE=32 LAND      <<03004>>64544000
                       (SUBTYP=14 LOR SUBTYP=15))              <<03004>>64546000
$IF X1=ON   << *********** SERIES 33,44,55 UNIQUE ********* >> <<03004>>64548000
                      AND LDTX( LDEV*LDTXSIZE+LDTX2).TERMBOARD <<03004>>64550000
                      = ADCC'TERM                              <<03004>>64552000
$IF         << ********* RETURNING TO COMMON CODE ********* >> <<03004>>64554000
                      << MULTIPOINT TOO! >>                    <<03004>>64556000
                      OR TYPE=TERMDEVTYPE AND                  <<03004>>64558000
                      (LDT(LDEV*LDTSIZE+LDT4).TERMTYP=14 LOR   <<03004>>64560000
                       LDT(LDEV*LDTSIZE+LDT4).TERMTYP=17)      <<03004>>64562000
                      THEN                                     <<03004>>64564000
                      BEGIN                                    <<00.06>>64566000
                      IF DITSIZE >= 24 THEN                    <<01900>>64568000
                        BEGIN  << NOT PSEUDO TERMINAL >>       <<01803>>64570000
                        DIT(23).TERMTYP :=                     <<01803>>64572000
                          LDT(LDEV*LDTSIZE+LDT4).TERMTYP;      <<01803>>64574000
                        DIT(23).TERMSPEED :=                   <<01803>>64576000
                          LDTX(LDEV*LDTXSIZE).TERMSPEED;       <<01803>>64578000
                        END;                                   <<01803>>64580000
                      END;                                     <<00.06>>64582000
                    DITLOC := TOS;                             <<01681>>64584000
                    DEL;                                                64586000
                    END                                                 64588000
                  ELSE                                                  64590000
                    BEGIN   <<CS DEVICE>>                               64592000
                    ABSOLUTE(DITLOC) := 0;                     <<01681>>64594000
                    ASSEMBLE(INCA,DDUP;DECA);                           64596000
                    TOS := MPESTDSIZE;                                  64598000
                    ASSEMBLE(MABS 5);                                   64600000
                    END;                                                64602000
            DIT(DLDEV) := (UNIT+DIT(DLDEV)&LSR(8))&LSL(8)+LDEV;<<01300>>64604000
                  IF SECONDPASS THEN                                    64606000
                    BEGIN <<NO  ILT POINTER>>                           64608000
                    DIT(DILTP) := DVRENT(DVR1).DSDRTN;                  64610000
                    GO BUILDDLT;                                        64612000
                    END;                                                64614000
                  DIT(DILTP) := ABSOLUTE(ILTPTR);  <<PTR TO ILT>>       64616000
                  IF ILT(IQUEUE).CNTRLRQ<>0 THEN DIT(DFLAG).MUNIT:=1;   64618000
                                  <<MULTI-UNIT CONTROLLER>>             64620000
              IF NOT(CSDEV17<=LDT(LDEV*LDTSIZE+LDT2).TYP<=CSDEV19) THEN 64622000
                GO BUILDDLT;                                            64624000
          <<--------------                                              64626000
            BUILT CS DIT                                                64628000
          -------------->>                                              64630000
                                                                        64632000
              IF LPDT(LDEV*LPDTSIZE+LPDT1).SUBTYPE = 7 THEN LCN := 7    64634000
              ELSE                                                      64636000
                 BEGIN                                                  64638000
                 TOS := LPDT(LDEV*LPDTSIZE+LPDT1).SUBTYPE;              64640000
                 TOS := 3;                                              64642000
                 ASSEMBLE(DIV,ADD);                                     64644000
              LCN:=IF LDT(LDEV*LDTSIZE+LDT2).TYP = CSDEV19     <<01165>>64646000
                     THEN TOS+4  <<LINE CONNECTION>>           <<01165>>64648000
                     ELSE TOS+1; <<NETWORK        >>           <<01165>>64650000
                 END;                                                   64652000
              LDTXINDEX := CSDEF(LDEV);  <<LINE DESCRIPTOR INDEX>>      64654000
              @CSLDTX := @CSTAB(7);                                     64656000
              I := -1;                                                  64658000
              WHILE (I:=I+1) < LDTXINDEX DO @CSLDTX:=@CSLDTX+CSLDTX;    64660000
              DEFDVRINDEX := 0;                                         64662000
              LCMEDPDMAX := 0;                                          64664000
              @DRIVERENTRY := @CSDVRAREA; <<PT TO DUMMY DRIVER>>        64666000
              I := -1;                                                  64668000
              WHILE (I:=I+1)<CSTAB(DRIVERENTNUM) DO                     64670000
                BEGIN  <<COMPUTE MAX DIT FOR COMPATIBLE DRIVERS>>       64672000
                  @LCNPTR := @DRLCN&LSL(1);                    <<04306>>64674000
                  J := 0;                                               64676000
                  DO IF INTEGER(LCNPTR(J))=LCN OR I=0 THEN              64678000
                    BEGIN <<COMPATIBLE DRIVER>>                         64680000
                      TOS := @DRNAME&LSL(1);                   <<04306>>64682000
                      TOS := @DVRNAME;                                  64684000
                      IF *=*,(8) THEN                                   64686000
                        BEGIN                                           64688000
                          DEFDVRINDEX := I;                             64690000
                          GO SUMLENS;                                   64692000
                        END;                                            64694000
                      IF LOGICAL(CSLDTXDRCHANGEABLE) OR I=0 THEN        64696000
                        BEGIN <<SUM SIZES OF LCM, EDT, PDT SECTIONS>>   64698000
  SUMLENS:                TOS := @DRCAPSECTSIZE;                        64700000
                          TOS := PS0;                                   64702000
                          ASSEMBLE(ADD,INCA);  <<PTR TO LCM LENGTH>>    64704000
                          N := 0;                                       64706000
                          K := 0;                                       64708000
                          DO                                            64710000
                            BEGIN  <<SUM LENGTHS>>                      64712000
                              TOS := PS0;                               64714000
                              N := S0+N;                                64716000
                              ASSEMBLE(ADD,INCA);  <<NEW PTR>>          64718000
                            END                                         64720000
                          UNTIL (K:=K+1)=4;                             64722000
                          IF N>LCMEDPDMAX THEN LCMEDPDMAX := N;         64724000
                          DEL;                                          64726000
                        END;                                            64728000
                    END                                                 64730000
                  UNTIL (J:=J+1)=3;                                     64732000
                  @DRIVERENTRY := @DRIVERENTRY+DRIVERENTRY;             64734000
                END;                                                    64736000
              CONTSECTSIZE := 0;<<NO CONTROL SECTION IN DIT>>  <<00.06>>64738000
              DITSIZE := MPESTDSIZE+CSSTDSIZE+CONTSECTSIZE+             64740000
                LCMEDPDMAX;                                             64742000
              @DRIVERENTRY := @CSDVRAREA;                               64744000
              ABSOLUTE(STDPTR) := ABSOLUTE(DITPTR)+MPESTDSIZE;          64746000
              ABSOLUTE(CONTPTR) := ABSOLUTE(STDPTR)+CSSTDSIZE;          64748000
              CONTROLP := 0;                                   <<01.01>>64750000
              @DRIVERENT := @CSDVRAREA+DRINFOSIZE+DRCAPSECTSIZE;        64752000
              DRIVERSECT := ABSOLUTE(CONTPTR)+SYSBASE+CONTSECTSIZE;     64754000
              POINTERSECT := ABSOLUTE(DITPTR)+SYSBASE+LCMP;             64756000
              K := 0;                                                   64758000
              DVRINDEX := 0;                                            64760000
              DO                                                        64762000
                BEGIN  <<MOVE IN LCM,EDT,PHYS DRIVER FOR DUMMY>>        64764000
                TOS := 0;                                               64766000
                TOS := DRIVERSECT+LOGICAL(DVRINDEX);                    64768000
                PUSH(DB);                                               64770000
                TOS := TOS+@DRIVERENT(DVRINDEX+K+1);                    64772000
                TOS := DRIVERENT(DVRINDEX+K);                           64774000
                ASSEMBLE(MABS 5);                                       64776000
                ABSOLUTE(POINTERSECT+LOGICAL(K)):=DRIVERSECT            64778000
                         +LOGICAL(DVRINDEX)-SYSBASE;                    64780000
                DVRINDEX := DVRINDEX+DRIVERENT(DVRINDEX+K);             64782000
                END                                                     64784000
              UNTIL (K:=K+1)=3;                                         64786000
              TOS := 0;                                                 64788000
              TOS := DRIVERSECT+LOGICAL(DVRINDEX);                      64790000
              PUSH(DB);                                                 64792000
              TOS := TOS+@DRIVERENT(DVRINDEX+4);                        64794000
              TOS := DRIVERENT(DVRINDEX+3);                             64796000
              ASSEMBLE(MABS 5);                                         64798000
              ILT(ISIOP) := DRIVERSECT+LOGICAL(DVRINDEX)-SYSBASE;       64800000
              ILT(IQUEUE).SIOPSIZE := DRIVERENT(DVRINDEX+3);            64802000
              CSSUBTYPE := LPDT(LDEV&LSL(1)+LPDT1).SUBTYPE;             64804000
              CSDEVTYPE := LDT(LDEV*LDTSIZE+LDT2).TYP;                  64806000
              CSLCN := LCN;                                             64808000
              CSLDTXDRINDEX := DEFDVRINDEX;                    <<00.06>>64810000
              CSLDTXLDEV := LDEV;                              <<00.06>>64812000
              CSMODE := CSLDTXMODE;                                     64814000
              CSCODE := CSLDTXCODE;                                     64816000
              CSPROTOCOL := CSLDTXPROTOCOL;                             64818000
              CSDOPTIONS := CSLDTXDOPTIONS;                             64820000
              CSHSI'CHAN := CSLDTXHSI'CHAN;        <<UNIT NUMBER>>      64822000
              CSDUAL'SPEED := CSLDTXDUAL'SPEED;                         64824000
              CSHALF'SPEED := CSLDTXHALF'SPEED;                         64826000
              CSXMSN'MODE := CSLDTXXMSN'MODE;                           64828000
              CSSPEED'CHNGBLE := CSLDTXSPEEDCHNGBLE;                    64830000
              CSANSWER := CSLDTXANSWER;                                 64832000
              CSDIAL := CSLDTXDIAL;                                     64834000
              CSRECV'TIMEOUT := CSLDTXRECV'TIMEOUT;                     64836000
              CSLOCAL'TIMEOUT := CSLDTXLOCAL'TIMEOUT;                   64838000
              CSCONCT'TIMEOUT := CSLDTXCONCT'TIMEOUT;                   64840000
              TOS := CSLDTXINSPEED;                                     64842000
              ASSEMBLE(XCH);                                            64844000
              CSINSPEED := TOS;                                         64846000
              STANDARD(X:=X+1) := TOS;                                  64848000
              TOS := CSLDTXOUTSPEED;                                    64850000
              ASSEMBLE(XCH);                                            64852000
              CSOUTSPEED := TOS;                                        64854000
              STANDARD(X:=X+1) := TOS;                                  64856000
              CSMAXRETRIES := DRRETRIES;                                64858000
              DITLOC := DITLOC+DITSIZE;                        <<01681>>64860000
          <<-----------------                                           64862000
            BUILD DLT ENTRY                                             64864000
          ----------------->>                                           64866000
  BUILDDLT:       I := 0;                                               64868000
                  WHILE (I:=I+1)<HLDEV DO                               64870000
                    BEGIN   <<SEARCH FOR DEVICE WITH SAME DRIVER>>      64872000
                      TOS := @DVRTAB(I*DVRSIZE+DVR2)&LSL(1);   <<04306>>64874000
                      IF *=DVRNAME,(8) THEN                             64876000
                      IF SECONDPASS THEN                                64878000
                      IF I<LDEV THEN GO USEOLD                          64880000
                      ELSE GO BUILDNEW                                  64882000
                      ELSE     <<NON DS DEVICE>>                        64884000
                      IF DVRTAB(X:=X-2).DRTFIELD=DRTN          <<03002>>64886000
                        AND I < LDEV OR                        <<03002>>64888000
                        DVRTAB(X).DRTFIELD<DRTN THEN           <<03002>>64890000
  USEOLD:               BEGIN  <<DRIVER ALREADY IN DLT>>                64892000
                          NEWDLT := FALSE;  <<NO NEW ENTRY>>            64894000
                          TOS := LPDT(I*LPDTSIZE);  <<DIT PTR>>         64896000
                          TOS := ABSOLUTE(TOS+SYSBASE+DDLTP);           64898000
                          ASSEMBLE(DUP,DUP;STAX);  <<DLT INDEX>>        64900000
                          DVRTYPE := DLT'(X).DRVRTYPE;                  64902000
                          DLTINDEX := TOS;                              64904000
                          DIT(DDLTP) := TOS;  <<SAVE IN DIT>>           64906000
                          TOS := DLT'(DLTINDEX).CORERES;                64908000
                          TOS := TOS LOR LOGICAL(RESIDENT);             64910000
                          RESIDENT := TOS;                              64912000
                          GOTO SETRES;                                  64914000
                        END;                                            64916000
                    END;                                                64918000
                <<MAKE NEW DLT ENTRY>>                                  64920000
  BUILDNEW:       NEWDLT := TRUE;                                       64922000
                  TOS := NDLT;  <<# OF ENTRIES IN DLT TABLE>>           64924000
                  NDLT := S0+1;                                         64926000
                  DLTINDEX := S0*DLTSIZE;  <<INDEX TO THIS ENTRY>>      64928000
                  INTRINDEX := (TOS*INTRSIZE)&LSL(1); <<INT TAB INDEX>> 64930000
                  TOS := (IF CSDEV17<=TYPE<=CSDEV19 THEN 1     <<01165>>64932000
                            ELSE DBINFO.DRVRTYPE); <<DRIVER TYPE>>      64934000
                  DVRTYPE := S0;                                        64936000
                  DLT'(DLTINDEX).DRVRTYPE := TOS;                       64938000
                  DLT'(DLTINDEX+DMNTR) := OBINFO(INDEX).(8:8);          64940000
                            <<MONITOR STT #>>                           64942000
                  DLT'(DLTINDEX+DINIT) := OBINFO(INDEX+1).(8:8);        64944000
                            <<INITIATOR STT #>>                         64946000
                  DLT'(DLTINDEX+DCOMP) := OBINFO(INDEX+2).(8:8);        64948000
                            <<COMPLETOR STT #>>                         64950000
                  TOS := OBINFO(INDEX+5);<<# OF INTERRUPT ROUTINES>>    64952000
                  M := S0;                                              64954000
                  INTR(INTRINDEX) := TOS;                               64956000
                  J := -1;                                              64958000
                  WHILE (J:=J+1)<M DO <<PUT INTERUPT STT'S IN INTR>>    64960000
                    INTR(INTRINDEX+J+1) := OBINFO(INDEX+J+6).(8:8);     64962000
                  DLT'(DLTINDEX+DTYPE).DEVTYPE := LDT(LDEV*LDTSIZE+LDT2)64964000
                    .TYP;                                               64966000
                  DLT'(X).DITSIZE' := DITSIZE;                          64968000
                  IF CSDEV THEN                                <<00888>>64970000
                    DLT'(DLTINDEX+DEDITOR):=OBINFO(INDEX+3).(8:8);      64972000
                  DIT(DDLTP) := DLTINDEX;                               64974000
                  DLT'(DLTINDEX+DINTPL):=OBINFO(INDEX+4).(8:8);<<0+.04>>64976000
                                    <<INITIALIZATION STT>>     <<0+.04>>64978000
                                                                        64980000
          <<--------------------------------                            64982000
            SET UP I/O PROCESS TABLE ENTRY                              64984000
          -------------------------------->>                            64986000
                  IF DVRTYPE=2 THEN                                     64988000
                    BEGIN  <<SET UP I/O PROCESS>>                       64990000
                      GETIOPROCNAME;   <<GET PROCESS NAME>>             64992000
                      J := -1;                                          64994000
                      WHILE (J:=J+1) < NIOPROC DO                       64996000
                        BEGIN   <<SEARCH FOR NAME ALREADY IN TABLE>>    64998000
                          TOS := @IOPROC(J*IOPROCSIZE)&LSL(1); <<04306>>65000000
                          IF *=IOPROCNAME,(16) AND IOPROC(X:=X+8)       65002000
                            .DRVRTYPE=2 THEN                            65004000
                            BEGIN  <<MATCHES OTHER TYPE 2 PROCESS>>     65006000
                              IF RESIDENT THEN IOPROC(X).CORERES:= 1;   65008000
                              DLT'(DLTINDEX).QNUMB := J;                65010000
                              GOTO SETRES;                              65012000
                            END;                                        65014000
                        END;                                            65016000
                    <<ADD PROCESS TO TABLE>>                            65018000
                      ADDIOPROC;                                        65020000
                    END;                                                65022000
  SETRES:         DLT'(DLTINDEX).CORERES := RESIDENT;                   65024000
                  IF DVRTYPE=3 THEN                                     65026000
                    BEGIN  <<SET UP PROCESS FOR TYPE 3 DRIVER>>         65028000
                      GETIOPROCNAME;                                    65030000
                      IF DBINFO.(13:1)=1 AND FIRST OR DBINFO.(13:1)=0   65032000
                        THEN BEGIN  <<ADD ENTRY TO TABLE>>              65034000
                          IF NEWDLT THEN ADDIOPROC <<ADD FROM OBINFO>>  65036000
                          ELSE                                          65038000
                            BEGIN  <<COPY FROM SIMILAR ENTRY>>          65040000
                              DIT(DPCBN) := NIOPROC;                    65042000
                              MOVE IOPROC(NIOPROC*IOPROCSIZE) := IOPROC 65044000
                                (DLT(DLTINDEX).QNUMB*IOPROCSIZE),       65046000
                                (IOPROCSIZE);                           65048000
                              IOPROC(NIOPROC*IOPROCSIZE+8).CORERES :=   65050000
                                RESIDENT;                               65052000
                              NIOPROC := NIOPROC+1;                     65054000
                            END;                                        65056000
                        END                                             65058000
                      ELSE                                              65060000
                        BEGIN  <<ENSURE  OTHER UNITS USE SAME PROCESS>> 65062000
                          I := 0;                                       65064000
  NEXTDIT:                IF ILT(ILTSIZE+I)<>0 AND I<>UNIT THEN         65066000
                            BEGIN  <<ANOTHER UNIT ON THIS CONTROLLER>>  65068000
                              X := ABSOLUTE(ILT(X)+SYSBASE+DDLTP);      65070000
                              TOS := DLT'(X).QNUMB; <<IOPROC INDEX>>    65072000
                              X := S0*IOPROCSIZE;                       65074000
                              K := TOS;                                 65076000
                              TOS := @IOPROC(X)&LSL(1);        <<04306>>65078000
                              IF *<>IOPROCNAME,(16) THEN                65080000
                                ERRMESSAGE(M252,DRTN)          <<01103>>65082000
                              ELSE                                      65084000
                                BEGIN                                   65086000
                                  IF RESIDENT THEN IOPROC(X:=X+8)       65088000
                                    .CORERES := 1;                      65090000
                                  DIT(DPCBN) := K;  <<PROCESS INDEX>>   65092000
                                END;                                    65094000
                            END                                         65096000
                          ELSE                                          65098000
                            BEGIN  <<LOOK AT NEXT UNIT>>                65100000
                              I := I+1;                                 65102000
                              GOTO NEXTDIT;                             65104000
                            END;                                        65106000
                        END;                                            65108000
                    END;                                                65110000
                  FIRST := FALSE;                                       65112000
  NEXTLDEV:       FCLOSE(DVRFNUM);                                      65114000
                END                                                     65116000
              UNTIL (LDEV:=LDEV+1) > HLDEV;                             65118000
              IF SECONDPASS THEN GO MOVEDLT;                            65120000
            END                                                         65122000
          UNTIL (DRTN := DRTN+1) > HIDRT;                      <<02707>>65124000
                                                                        65126000
;                                                              <<01681>>65128000
          <<-----------------------                                     65130000
            BUILD DLT FOR CSDUMMY                                       65132000
          ----------------------->>                                     65134000
          IF CSPRESENT THEN                                             65136000
            BEGIN <<RESERVE DLT ENTRIES FOR CSDUMMY >>         <<00.06>>65138000
                  << AND ADDITIONAL CS DRIVERS      >>         <<00.06>>65140000
            TOS := NDLT;                                                65142000
            CSDUMMYINDEX := S0*DLTSIZE;                        <<00.06>>65144000
            NDLT := TOS+CTAB0(NUMADVRS)+1;                     <<00.06>>65146000
            I := -1;                                           <<00.06>>65148000
            WHILE(I:=I+1) < CTAB0(NUMADVRS) DO                 <<00.06>>65150000
              <<PUT INITIALIZATION STT IN DLT ENTRIES>>        <<00.06>>65152000
              DLT'(CSDUMMYINDEX+(I+1)*DLTSIZE+DINTPL) :=       <<00.06>>65154000
                INIT'LIZAT'NSTT(I);                            <<00.06>>65156000
            END;                                               <<00.06>>65158000
          IF NOT(SECONDPASS) THEN                                       65160000
            BEGIN                                                       65162000
            FIRST := FALSE;                                             65164000
            SECONDPASS := TRUE;                                         65166000
            GO STARTPASS;                                               65168000
            END;                                                        65170000
          <<----------------------                                      65172000
            MOVE DLT TO LOW CORE                                        65174000
          ---------------------->>                                      65176000
  MOVEDLT:TOS := ILTSTART;                                              65178000
          TOS := S0;  <<START OF ILT-DIT AREA>>                         65180000
          TOS := ((MEMLOC+3)&LSR(2))&LSL(2);                            65182000
          MEMLOC := S0;                                                 65184000
          ASSEMBLE(SUB,NEG);  <<SIZE OF AREA>>                          65186000
          TOS := ILTDITDSTN;                                            65188000
          ASSEMBLE(XCH);                                                65190000
          INSERTDST(*,*,*,0);                                           65192000
          TOS := 0;                                                     65194000
          TOS := INITTABLE(NDLT,DLTSIZE,1);                             65196000
          ASSEMBLE(DUP,DUP);                                            65198000
          INSERTDST(*,DLTDSTN,MEMSEG,0);                                65200000
          TOS := TOS-SYSBASE;                                           65202000
          DLTPTR' := S0;                                                65204000
          ABSOLUTE(DLTPTR) := TOS;                                      65206000
          PUSH(DB);                                                     65208000
          TOS := TOS+@DLT';                                             65210000
          TOS := NDLT*DLTSIZE;                                          65212000
          ASSEMBLE(MABS);   <<MOVE DLT>>                                65214000
                                                                        65216000
          <<-----------------------------                               65218000
            CRUNCH TEMPORARY I/O TABLES                                 65220000
          ----------------------------->>                               65222000
          MOVE IOPROC(HLDEV*IOPROCSIZE-1) := IOPROC(NIOPROC*            65224000
            IOPROCSIZE-1),(-X-1),2;                                     65226000
          @IOPROC := S0+1;                                              65228000
          TOS := INTRSIZE*NDLT;                                         65230000
          TOS := S0-1;                                                  65232000
          TOS := WORDADDRESS(INTR);    << GET WORD POINTER >>  <<04306>>65234000
          ASSEMBLE(ADD,XCH; NEG; MOVE 2);                               65236000
          ASSEMBLE(INCA,DUP);                                           65238000
          @INTR := TOS&LSL(1);                                 <<04306>>65240000
          SET(DL);                                                      65242000
                                                                        65244000
                                                               <<00588>>65246000
          <<-----------------------                                     65248000
            BUILD RESOURCE TABLES                                       65250000
          ----------------------->>                                     65252000
          NRESQ := NCNTRLQ+NCHANQ+NPROCQ+2;                             65254000
          TOS := INITTABLE(NRESQ,3,1);                                  65256000
          DUPLICATE;                                                    65258000
          INSERTDST(*,RESQDSTN,MEMSEG,0);                               65260000
          TOS := TOS-SYSBASE;                                           65262000
          ABSOLUTE(SYSBUSY) := S0;   <<BUSY TABLE PTR>>                 65264000
          TOS := TOS+NRESQ;                                             65266000
          ABSOLUTE(SYSHEAD) := S0;  <<HEAD TABLE PTR>>                  65268000
          TOS := TOS+NRESQ;                                             65270000
          ABSOLUTE(SYSTAIL) := TOS;  <<TAIL TABLE PTR>>                 65272000
          I := 0;                                                       65274000
          DO HEAD(I) := -1 UNTIL (I:=I+1)=NRESQ;                        65276000
          I := 0;                                                       65278000
          DO TAIL(I) := ABSOLUTE(SYSHEAD)+I-1 UNTIL (I:=I+1)=NRESQ;     65280000
                                                                        65282000
          <<------------------------------------------                  65284000
            UPDATE DLT AND MULTI-UNIT QUEUE POINTERS                    65286000
          ------------------------------------------>>                  65288000
          DRTN := LOWESTDRT;                                   <<00888>>65290000
          DO IF GETDRT(DRTN,DBI) <>0 THEN                      <<03002>>65292000
            BEGIN  <<DRT IS USED>>                                      65294000
              TOS:=GETDRT(DRTN,DBI)-SYSBASE;                   <<03002>>65296000
              N := INTHS'UNITS(DRTN);  <<# OF UNITS ON CONTROLLER>>     65300000
              ABSOLUTE(ILTPTR) := TOS;                                  65304000
              TOS := ILT(IQUEUE).CNTRLRQ;                               65306000
              IF <> THEN                                                65308000
                BEGIN  <<UPDATE CONTROLLER QUEUE NUMBER>>               65310000
                  TOS := TOS+NPROCQ+1;                                  65312000
                  ILT(X).CNTRLRQ := TOS;                                65314000
                END                                                     65316000
              ELSE DEL;                                                 65318000
              TOS := ILT(ICNTRL).CHANQUE;                      <<00888>>65322000
              IF <> THEN                                                65326000
                BEGIN <<UPDATE CHANNEL QUEUE NUMBER>>                   65328000
                TOS := TOS+NCNTRLQ+NPROCQ+1;                            65330000
                ILT(X).CHANQUE := TOS;                                  65332000
                END                                                     65334000
              ELSE DEL;                                                 65336000
              I := 0;                                                   65338000
              DO IF ILT(IDITP+I)<>0 THEN                                65340000
                BEGIN  <<UPDATE DLT PTR IN DIT>>                        65342000
                  TOS := ILT(X);                                        65344000
                  ABSOLUTE(DITPTR) := TOS;                              65346000
                  DIT(X) := DIT(DDLTP)+DLTPTR';                         65348000
                END                                                     65350000
              UNTIL (I:=I+1)=N;                                         65352000
            END                                                         65354000
          UNTIL (DRTN := DRTN+1) > HIDRT;                      <<02707>>65356000
                                                                        65358000
          <<-----------------------------------------                   65360000
            ASSIGN ABSOLUTE PRIORITIES TO PROCESSES                     65362000
          ----------------------------------------->>                   65364000
          RELPRI := 0;                                                  65366000
          ABSPRI := IOPRI;                                              65368000
          DO                                                            65370000
            BEGIN  <<ASSIGN PRIORITIES>>                                65372000
              I := 0;                                                   65374000
              DO IF IOPROC(I*IOPROCSIZE+9).(8:8)=RELPRI THEN            65376000
                BEGIN                                                   65378000
                  IOPROC(X).(0:8) := ABSPRI;                            65380000
                  ABSPRI := ABSPRI+1;                                   65382000
                END                                                     65384000
             UNTIL (I:=I+1)=NIOPROC;                                    65386000
            END                                                         65388000
          UNTIL (RELPRI := RELPRI+1) > 255;                             65390000
                                                                        65392000
          <<----------------                                            65394000
            SYSTEM BUFFERS                                              65396000
          ---------------->>                                            65398000
          INITIOTABLE(CTAB(SBUFNUM),SECSBUF,SBUFSIZE,SBUFDSTN,SYSSBUF); 65400000
                                                               <<MPEIV>>65402000
<<>>                                                           <<MPEIV>>65404000
<<MEMORY MANAGEMENT INFO>>                                     <<MPEIV>>65406000
<<>>                                                           <<MPEIV>>65408000
TOS:=(CTAB0(CORESIZE)+63)&LSR(6);                              <<MPEIV>>65410000
TOS:=TOS-1;                                                    <<MPEIV>>65412000
ABSOLUTE(NBANKS):=TOS;                                         <<MPEIV>>65414000
TOS:=CTAB0(CORESIZE);                                          <<MPEIV>>65416000
TOS:=S0.(10:6); <<KWORDS IN LAST PARTIAL BANK>>                <<MPEIV>>65418000
IF = THEN                                                      <<MPEIV>>65420000
   BEGIN <<LAST BANK IS COMPLETE>>                             <<MPEIV>>65422000
   ASSEMBLE(DEL);                                              <<MPEIV>>65424000
   ABSOLUTE(SYSLASTBASE):=%177777;                             <<MPEIV>>65426000
   TOS:=TOS.(0:10); <<NUMBER OF COMPLETE BANKS>>               <<MPEIV>>65428000
   TOS:=TOS-1; <<BANK NUMBER OF LAST BANK>>                    <<MPEIV>>65430000
   ABSOLUTE(SYSLASTBANK):=TOS;                                 <<MPEIV>>65432000
   END                                                         <<MPEIV>>65434000
ELSE                                                           <<MPEIV>>65436000
   BEGIN <<LAST BANK IS PARTIAL>>                              <<MPEIV>>65438000
   TOS:=TOS&LSL(10)-1;                                         <<MPEIV>>65440000
   ABSOLUTE(SYSLASTBASE):=TOS;                                 <<MPEIV>>65442000
   TOS:=TOS.(0:10);                                            <<MPEIV>>65444000
   ABSOLUTE(SYSLASTBANK):=TOS;                                 <<MPEIV>>65446000
   END;                                                        <<MPEIV>>65448000
$PAGE "MAINSEG2  --  SET UP MEMORY MANAGEMENT TABLES"                   65450000
<< ----------------------->>                                   <<MPEIV>>65452000
<< SWAPTABLE >>                                                <<MPEIV>>65454000
<<------------------------>>                                   <<MPEIV>>65456000
                                                               <<MPEIV>>65458000
TOS:=INITTABLE(CTAB(SWAPTABLE),SWAPTABSIZE,1);                 <<01639>>65460000
ASSEMBLE(DUP,DUP);                                             <<MPEIV>>65462000
INSERTDST(*,SWAPTABDSTN,MEMSEG,0);                             <<MPEIV>>65464000
TOS:=TOS-SYSBASE;                                              <<MPEIV>>65466000
ABSOLUTE(SYSSWAPTAB):=TOS;                                     <<MPEIV>>65468000
INITFREELIST(*,CTAB(SWAPTABLE),SWAPTABSIZE,1);                 <<01639>>65470000
          <<-----------------                                           65472000
            CST BLOCK TABLE                                             65474000
          ----------------->>                                           65476000
TOS:=INITTABLE(CTAB(CONPROGNUM)+9+(CTAB(CONPROGNUM)-1)&LSR(4)+2<<MPEIV>>65478000
   ,1,1);                                                      <<MPEIV>>65480000
          DUPLICATE;                                                    65482000
          INSERTDST(*,CSTBLKDSTN,MEMSEG,0);                             65484000
          TOS := TOS-SYSBASE;                                           65486000
          ABSOLUTE(SYSCSTBLK) := TOS;                                   65488000
        CSTBLK(0):=CTAB(CONPROGNUM)+8;<<USER AND SYS>>         <<00652>>65490000
          I := 0;                                                       65492000
        WHILE (I:=I+1) <= CSTBLK(0) DO CSTBLK(I):=-1;          <<00652>>65494000
                                                                        65496000
<<---------->>                                                 <<MPEIV>>65498000
<<SPECIAL REQUEST TABLE>>                                      <<MPEIV>>65500000
<<--------->>                                                  <<MPEIV>>65502000
                                                               <<MPEIV>>65504000
TOS:=INITTABLE(CTAB(SPECIALREQTABLE),SRTSIZE,0);               <<01639>>65506000
ASSEMBLE(DUP,DUP);                                             <<MPEIV>>65508000
INSERTDST(*,SPECREQTABDSTN,MEMSEG,0);                          <<MPEIV>>65510000
TOS:=TOS-SYSBASE;                                              <<MPEIV>>65512000
ABSOLUTE(SYSSPECREQTAB):=TOS;                                  <<MPEIV>>65514000
INITFREELIST(*,CTAB(SPECIALREQTABLE),SRTSIZE,1);               <<01639>>65516000
                                                               <<MPEIV>>65518000
<<------------->>                                              <<MPEIV>>65520000
<<MEMORY RESIDENT MESSAGE SYSTEM STRUCTURES>>                  <<MPEIV>>65522000
<<------------->>                                              <<MPEIV>>65524000
TOS:=INITTABLE(CTAB(PCBNUM),MSGHARBORLENGTH,0);                <<02807>>65526000
INSERTDST(*,MSGHARBORTABDSTN,MEMSEG,0); <<NEEDN'T BE IN BK 0>> <<MPEIV>>65528000
TOS:=INITTABLE(CTAB(PRIMARYMSGTABLE),MSGTABSIZE,0);            <<01639>>65530000
ASSEMBLE(DUP);                                                 <<MPEIV>>65532000
INSERTDST(*,PRIMMSGTABDSTN,MEMSEG,0); <<NEEDN'T BE IN BK 0>>   <<MPEIV>>65534000
INITFREELIST(*,CTAB(PRIMARYMSGTABLE),MSGTABSIZE,1);            <<01639>>65536000
<<ALLOCATE SECONDARY MESSAGE TABLE>>                           <<02807>>65538000
TOS:=INITTABLE(CTAB(SECNDRYMSGTABLE),MSGTABSIZE,0);            <<03707>>65540000
ASSEMBLE(DUP);                                                 <<02807>>65542000
INSERTDST(*,SECMSGTABDSTN,MEMSEG,0);                           <<02807>>65544000
INITFREELIST(*,CTAB(SECNDRYMSGTABLE),MSGTABSIZE,1);            <<03707>>65546000
TOS:=DST(X:=(SECMSGTABDSTN*4+2));  <<CLEAR IMPEDED PCB FIELD>> <<02807>>65548000
TOS:=DST(X+1)+4;                   <<(WORD(4) OF TABLE HEAD>>  <<02807>>65550000
TOS:=0; ASMB(SSEA;DDEL);                                       <<02807>>65552000
<<>>                                                           <<MPEIV>>65554000
<<INITIALIZE MEASINFOTAB>>                                     <<MPEIV>>65556000
<<>>                                                           <<MPEIV>>65558000
TOS:=INITTABLE(1,MEASINFOTABSIZE,1);                           <<MPEIV>>65560000
ASSEMBLE(DUP);                                                 <<MPEIV>>65562000
INSERTDST(*,MEASINFOTABDSTN,MEMSEG,0);                         <<MPEIV>>65564000
TOS:=TOS-SYSBASE;                                              <<MPEIV>>65566000
ABSOLUTE(SYSMEASINFOTAB):=TOS;                                 <<MPEIV>>65568000
                                                                        65570000
          <<--------------------------------------->>          <<MPEIV>>65572000
          <<  VIRTUAL DISC SPACE MANAGEMENT TABLE  >>          <<MPEIV>>65574000
          <<--------------------------------------->>          <<MPEIV>>65576000
                                                               <<MPEIV>>65578000
          BUILD'VDSMTAB;                                       <<MPEIV>>65580000
                                                                        65582000
<<---------->>                                                 <<MPEIV>>65584000
<<ARSBMTABLE>>                                                 <<MPEIV>>65586000
<<--------->>                                                  <<MPEIV>>65588000
TOS:=INITTABLE(ARSBMLENGTH,1,1);                               <<MPEIV>>65590000
ASSEMBLE(DUP);                                                 <<MPEIV>>65592000
INSERTDST(*,ARSBMTABDSTN,MEMSEG,0);                            <<MPEIV>>65594000
TOS:=TOS-SYSBASE;                                              <<MPEIV>>65596000
ABSOLUTE(SYSARSBM):=TOS;                                       <<MPEIV>>65598000
<<---------->>                                                 <<MPEIV>>65600000
<<ARLDTABLE>>                                                  <<MPEIV>>65602000
<<--------->>                                                  <<MPEIV>>65604000
TOS:=INITTABLE(ARLDLENGTH,1,1);                                <<MPEIV>>65606000
ASSEMBLE(DUP);                                                 <<MPEIV>>65608000
INSERTDST(*,ARLDTABDSTN,MEMSEG,0);                             <<MPEIV>>65610000
TOS:=TOS-SYSBASE;                                              <<MPEIV>>65612000
ABSOLUTE(SYSARLD):=TOS;                                        <<MPEIV>>65614000
          <<-------------------------------                             65616000
            LOGICAL-PHYSICAL DEVICE TABLE                               65618000
          ------------------------------->>                             65620000
          TOS := 0;                                                     65622000
          TOS := INITTABLE(HLDEV+1,LPDTSIZE,0);                         65624000
          ASSEMBLE(DUP,DUP);                                            65626000
          INSERTDST(*,LPDTDSTN,MEMSEG,0);                               65628000
          LPDTBASE := TOS-SYSBASE;  <<SAVE FOR LATER USE>>              65630000
          PUSH(DB);                                                     65632000
          TOS := TOS+@LPDT;                                             65634000
          TOS := (HLDEV+1)*LPDTSIZE;                                    65636000
          ASSEMBLE(MABS);  <<MOVE LPDT TO LOW CORE>>                    65638000
                                                                        65640000
          <<---------------------                                       65642000
            TIMER REQUEST QUEUE                                         65644000
          --------------------->>                                       65646000
          TOS := INITTABLE((N:=CTAB(TRLNUM))+1,TRLSIZE,1);              65648000
          ASSEMBLE(DUP,DUP);                                            65650000
          INSERTDST(*,TRLDSTN,MEMSEG,0);                                65652000
          TOS := TOS-SYSBASE;                                           65654000
          ABSOLUTE(SYSTRL) := TOS;                                      65656000
          TRL(0) := 3*TRLSIZE;  <<FREE LIST HEAD>>                      65658000
          TRL(1) := CTAB(TRLNUM)&LSL(8)+TRLSIZE;                        65660000
          I := 3;                                                       65662000
          X := TRL(0);                                                  65664000
          DO                                                            65666000
            BEGIN  <<INITIALIZE FREE LIST>>                             65668000
              TOS := X+TRLSIZE;                                         65670000
              TRL(X) := S0;                                             65672000
              X := TOS;                                                 65674000
            END                                                         65676000
          UNTIL (I:=I+1)=N;                                             65678000
                                                                        65680000
          <<-------------------------                                   65682000
            JOB PROCESS COUNT TABLE                                     65684000
          ------------------------->>                                   65686000
          TEMP := CTAB(MAXRJOB)+CTAB(MAXRSES);                          65688000
          TOS := INITTABLE((TEMP+4)&LSR(1)+(TEMP+16)&LSR(4),1,1);       65690000
          TOS := S0-SYSBASE;                                            65692000
          ABSOLUTE(SYSJPCNT) := TOS;                                    65694000
          INSERTDST(*,JPCTDSTN,MEMSEG,0);                               65696000
          M := (N:=TEMP&LSR(1))&LSL(1)+1;                               65698000
          JPCNT(0) := M&LSL(8)+M;                                       65700000
          X := 1;                                                       65702000
          DO JPCNT(X) := 254&LSL(8)+254 UNTIL (X:=X+1)>N;               65704000
          JPCNT(X) := 254&LSL(8)+255;  <<STOPPER>>                      65706000
                                                                        65708000
          <<----------------                                            65710000
            JOB CUTOFF TABLE                                            65712000
          ------------------>>                                          65714000
          TOS := INITTABLE(M+1,JCUTSIZE,1);                             65716000
          TOS := S0-SYSBASE;                                            65718000
          ABSOLUTE(SYSJCUT) := TOS;                                     65720000
          INSERTDST(*,JCUTDSTN,MEMSEG,0);                               65722000
          JCUT(1) := M&LSL(8)+JCUTSIZE;                                 65724000
          I := 0;                                                       65726000
          X := 0;                                                       65728000
          DO                                                            65730000
            BEGIN  <<INITIALIZE FREE LIST>>                             65732000
              TOS := X+JCUTSIZE;                                        65734000
              JCUT(X) := S0;                                            65736000
              X := TOS;                                                 65738000
            END                                                         65740000
          UNTIL (I:=I+1)=M;                                             65742000
          JCUT(2) := X;  <<PTR TO LAST ENTRY>>                          65744000
          ABSOLUTE(DEFAULTQUEUE) := DEFAULTJOBPRI;             <<00.EB>>65746000
          ABSOLUTE(MAXQUEUE) := DEFAULTJOBPRI;                 <<00.EB>>65748000
                                                                        65750000
          <<-----------                                                 65752000
            SIR TABLE                                                   65754000
          ----------->>                                                 65756000
          TOS := INITTABLE(NSIR+M,SIRSIZE,0);                           65758000
          SIRBASE := S0-SYSBASE;                                        65760000
          INSERTDST(*,SIRDSTN,MEMSEG,0);                                65762000
                                                                        65764000
          <<-------------------------------------                       65766000
            MEMORY MANAGEMENT MONITORING BUFFER                         65768000
          ------------------------------------->>                       65770000
          TOS := INITTABLE(MONBUFSIZE+1,1,1);                           65772000
          MONBUFBASE := S0-SYSBASE+1;                                   65774000
          ABSOLUTE(TOS) := MONBUFSIZE;                                  65776000
            << NO LONGER DEPENDENT ON BANK 0 SPACE >>          <<MPEIV>>65778000
              STARTMAM;                                        <<MPEIV>>65780000
      END <<MAINSEG2>> ;                                                65782000
$PAGE "MAINSEG3  --  ALLOCATE SYSTEM LIBRARY"                           65784000
$CONTROL SEGMENT=MAINSEG3                                               65786000
  PROCEDURE MAINSEG3;                                                   65788000
      BEGIN                                                             65790000
      LOGICAL FIRSTDRT;                                        <<00.04>>65792000
      INTEGER TEMP;                                            <<03002>>65794000
      BYTE POINTER DNAME;   << TEMP FOR DRIVER NAME     >>     <<03004>>65796000
      INTEGER NSEG,  << TEMP FOR NO. OF CST'S ALLOCATED >>     <<03004>>65798000
              FIRSTCST;   << 1ST PHYSICAL CST FOR DRIVER >>    <<03004>>65800000
      INTEGER ADDDVRNUM;<<CS ADDITIONAL DRIVER BEING PROCESSD>><<00.06>>65802000
      INTEGER CSTBLKINDEX;    <<PGM CSTBLK INDEX>>             <<00652>>65804000
      INTEGER UNIT;            << UNIT NUMBER >>               <<03552>>65806000
                                                               <<03635>>65808000
      DOUBLE  DISCADR;                                         <<03603>>65810000
      BYTE VOLUME = DISCADR;                                   <<03603>>65812000
      BYTE LDEV = DISCADR;                                     <<03603>>65814000
      DOUBLE  SAVDRT;     << TEMP. FOR NEW DRT LOCATION >>     <<03744>>65816000
      LOGICAL SAVDRTBANK = SAVDRT,                             <<03744>>65818000
              SAVDRTADDR = SAVDRT+1;                           <<03744>>65820000
      LOGICAL BANK,       << TEMP. FOR BANK # >>               <<03744>>65822000
              OFFSET;     << TEMP. FOR BANK OFFSET >>          <<03744>>65824000
                                                                        65826000
                                                                        65830000
          ASSEMBLE( RSW );                                     <<01091>>65832000
          IF TOS.(8:8) <> CLRSW THEN HELP;                     <<02510>>65834000
          ABSOLUTE(MAXCODESEG) := CTAB(MCSS);                           65836000
          ABSOLUTE(MAXSEGPROC) := CTAB(MCSP);                           65838000
          ABSOLUTE(MAXDATA) := CTAB(MSTACK);                            65840000
          ABSOLUTE(MAXXTRADSEG) := CTAB(MXDSS);                         65842000
          ABSOLUTE(MAXDSEGPROC) := CTAB(MXDSP);                         65844000
          ABSOLUTE(STDSTACK) := CTAB0(SSS);                             65846000
          ABSOLUTE(LOGONLIM) := CTAB0(LOGON);                           65848000
          ABSOLUTE(CPUTIME)  := CTAB0(CPULIM);                          65850000
          ABSOLUTE(HSYSDRT) := CTAB0(DRTNUM);                           65852000
                                                                        65854000
          <<---------------------------------->>               <<03002>>65856000
          << ALLOCATE DRT TABLE FROM MAM      >>               <<03002>>65858000
          <<    (IF MAXDRT > 127)             >>               <<03002>>65860000
          <<---------------------------------->>               <<03002>>65862000
          IF HIDRT > 127                                       <<03022>>65864000
          THEN BEGIN                                           <<03002>>65866000
            I:=4* (HIDRT + ( DEVPERCHAN -                      <<03022>>65868000
               HIDRT MOD DEVPERCHAN) );                        <<03022>>65870000
                                                               <<03002>>65872000
            << WE MUST SAVE DRT TABLE ELSEWHERE BECAUSE WE >>  <<03744>>65876000
            << MAY MOVE IT ON TOP OF ITS OLD LOCATION      >>  <<03744>>65878000
                                                               <<03744>>65880000
            PUSH(DB);                     << GET ABS. ADDR. >> <<03744>>65882000
            OFFSET := TOS + @LDMAPBUF;    << OF LDMAPBUF    >> <<03744>>65884000
            BANK := TOS;                                       <<03744>>65886000
                                                               <<03744>>65888000
            MABS(BANK,OFFSET,            << COPY DRT TABLE  >> <<03744>>65890000
                 ABSOLUTE(DRTBANK),      <<    TEMPORARILY  >> <<03744>>65892000
                 ABSOLUTE(DRTADDR),I);                         <<03744>>65894000
                                                               <<03744>>65896000
            << NOW POINT THE DRT POINTERS AT THE TEMPORARY  >> <<03744>>65898000
            << COPY ONLY FOR THE CALL TO MAM.  WE ONLY DO   >> <<03744>>65900000
            << THIS BECAUSE WE CANNOT DO ANY I/O WHILE MAM  >> <<03744>>65902000
            << IS ZEROING THE NEW DRT TABLE, AND MAM MAY    >> <<03744>>65904000
            << CAUSE SOME SWAPS.                            >> <<03744>>65906000
                                                               <<03744>>65908000
            ABSOLUTE( DRTBANK) := BANK;                        <<03744>>65910000
            ABSOLUTE( DRTADDR) := OFFSET;                      <<03744>>65912000
                                                               <<03744>>65914000
            SAVDRT := MAM(I, FALSE);   <<GET MEMORY FOR AND >> <<03744>>65916000
                                       << ZERO OUT DRT TABLE>> <<03744>>65918000
                                                               <<03744>>65920000
            MABS(SAVDRTBANK,SAVDRTADDR,     <<COPY DRT TABLE>> <<03744>>65922000
                          BANK,OFFSET,I);   << TO NEW SPOT  >> <<03744>>65924000
                                                               <<03744>>65926000
            ABSOLUTE( DRTBANK):= SAVDRTBANK;                   <<03002>>65928000
            ABSOLUTE( DRTADDR):= SAVDRTADDR;                   <<03002>>65930000
          END;                                                 <<03002>>65932000
                                                               <<03002>>65934000
          <<-----------------------------                               65936000
            BUILD INITIAL SEGMENT TABLE                                 65938000
          ----------------------------->>                               65940000
          SEGTLEN := SEGTPDB+SEGDIRLEN+(HCST:=CTAB(CSTNUM))*3;          65942000
          SEGT(1) := SEGDIRLEN;                                         65946000
          TOS := SEGTPDB;                                               65948000
          ASSEMBLE(DUP,DUP);                                            65950000
          SEGT(3) := TOS;   <<REFERENCE TABLE POINTER>>                 65952000
          @SEGREF := TOS+@SEGT;                                         65954000
          X := 0;                                                       65956000
          DO SEGREF(X) := -1 UNTIL (X:=X+1)=HCST;                       65958000
          TOS := TOS+HCST;                                              65960000
          ASSEMBLE(DUP,DUP);                                            65962000
          SEGT(4) := TOS;     <<XFORM TABLE POINTER>>                   65964000
          @SEGXFORM := TOS+@SEGT;                                       65966000
          X := 0;                                                       65968000
          DO SEGXFORM(X) := %177400 UNTIL (X:=X+1)=HCST;                65970000
          TOS := TOS+HCST;                                              65972000
          ASSEMBLE(DUP,DUP);                                            65974000
          SEGT(5) := TOS;   <<ENTRY TABLE POINTER>>                     65976000
          @SEGENTTAB := TOS+@SEGT;                                      65978000
          TOS := TOS+HCST;                                              65980000
          SEGT(6) := 0;                                                 65982000
          SAGL := 0;  <<STARTING ADDRESS OF GARBAGE LIST>>              65984000
          X := 8;                                                       65986000
          DO                                                            65988000
            BEGIN                                                       65990000
              SEGT(X:=X+1) := S0;                                       65992000
              TOS := TOS+128;                                           65994000
            END                                                         65996000
          UNTIL X=13;                                                   65998000
          ASSEMBLE(DUP,DUP);                                            66000000
          SEGT(2) := TOS;   <<DIR POINTER>>                             66002000
          @SEGDIR := TOS+@SEGT-640;                                     66004000
          SEGDIR := 0;                                                  66006000
          SEGDIR(1) := SEGDIRLEN;   <<TOTAL GARBAGE ENTRY>>             66008000
          SEGT(19) := 0;  <<ACCESS COUNT>>                              66010000
                                                                        66012000
          <<------------------------------                              66014000
            LOAD SYSTEM LIBRARY SEGMENTS                                66016000
          ------------------------------>>                              66018000
            MOVE INBUF := "LOADMAP ";                                   66020000
            LDMAPFNUM := FOPEN(BINBUF);                                 66022000
            LDMAPBUF := "  ";                                           66024000
            MOVE LDMAPBUF(1) := LDMAPBUF,(LDMAP'SIZE-1);       <<03668>>66026000
            FWRITE(LDMAPFNUM,0D,LDMAPBUF,128);                 <<00.DL>>66028000
            FWRITE(LDMAPFNUM,1D,LDMAPBUF,128);                 <<00.DL>>66030000
            MOVE LDMAPBUF:="MPE IV  U.FF.VV ";                 <<01734>>66032000
            LDMAPBUF(4).LBITE:=CTAB0(VERSION').RBITE;          <<13.KM>>66034000
            LDMAPBUF(5):=CTAB0(UPDATEL');                      <<13.KM>>66036000
            LDMAPBUF(6).RBITE:=CTAB0(FIXLEVEL').LBITE;         <<13.KM>>66038000
            LDMAPBUF(7).LBITE:=CTAB0(FIXLEVEL').RBITE;         <<13.KM>>66040000
            MOVE LDMAPBUF(64) := "  1 ININ";                   <<01103>>66042000
            IF LOADMAP THEN PRINT(LDMAPBUF(64),-8,0);          <<01103>>66044000
          SLFNUM := FOPEN(SLFILE);                                      66046000
          FREAD(SLFNUM,0D,SLREC0,256);  <<RECORDS 0 AND 1>>             66048000
          RTNUM := SLREC0(9)-1;  <<# OF REFERENCE TABLE ENTRIES -1>>    66050000
          I := -1;                                                      66052000
          DO ALLOCATEALL(I:=I+1,0) UNTIL I=RTNUM;                       66054000
          I := FREECSTN-1;                                              66056000
          DO                                                            66058000
            BEGIN                                                       66060000
              FIXSTT(I:=I+1);                                           66062000
              IF CST(I&LSL(2))>0 THEN                                   66064000
                  READCODE(I, CORERES');                       <<01384>>66066000
            END                                                         66068000
          UNTIL I=CSTN;                                                 66070000
          TOS := FLAB(28);                                              66072000
          TOS.(14:2) := 0;  <<RESET READ BIT >>                         66074000
          TOS.(0:4) := 2;   <<RESET LOAD BIT,CLEAR S,R,X BITS>>         66076000
          FLAB(X) := TOS;                                               66078000
          FLCLID := ABSOLUTE(COLD'LOAD'ID);                             66080000
          FLFCBVECT := 0;                                               66082000
          CHECKSUM;          <<NEW CHECKSUM>>                           66084000
          FLCHECKSUM := TOS; <<UPDATE LABEL>>                           66086000
          DISCADR := FCBDBL(SLFNUM*FCBDSIZE); << ADR FST EXT >><<03603>>66090000
          TOS := DISCADR;                                      <<03603>>66092000
          ABSOLUTE(SLDISCADR2) := TOS;                         <<03603>>66094000
          ABSOLUTE(X:=X-1) := TOS;                             <<03603>>66096000
          SEGDIRENT(DISCADR,SLTYP,FREECSTN,CSTN);              <<03603>>66098000
          DISC(WRITE,LDEV,DISCADR,FLAB,128);                   <<03603>>66100000
          ABSOLUTE(TERMINTLAB) := INTLABEL(ABSOLUTE(TERMEXTLAB) :=      66102000
            PLABEL(TERMNAME));                                          66104000
          ABSOLUTE(CIINTLAB) := INTLABEL(ABSOLUTE(CIEXTLAB) :=          66106000
            PLABEL(CINAME));                                            66108000
          ABSOLUTE(TRACEINTLAB) := INTLABEL(ABSOLUTE(TRACEEXTLAB) :=    66110000
            PLABEL(TRACENAME));                                         66112000
          ABSOLUTE(FIXL) := CTAB0(FIXLEVEL');                           66114000
          ABSOLUTE(UPDATEL) := CTAB0(UPDATEL');                         66116000
          ABSOLUTE(VERSION) := CTAB0(VERSION');                         66118000
          SYSGLOBEXT(GLOBMITVERSION) := CTAB0(MITVERSION);     <<00931>>66120000
          SYSGLOBEXT(GLOBMITUPDATE) := CTAB0(MITUPDATE);       <<00931>>66122000
          SYSGLOBEXT(GLOBMITFIX) := CTAB0(MITFIX);             <<00931>>66124000
$PAGE "MAINSEG3  --  LOAD DISC FILES"                                   66126000
          <<---------------------                                       66128000
            INTERNAL INTERRUPTS                                         66130000
          --------------------->>                                       66132000
          LOAD(ININFILE,CSTINDEX,DSTINDEX,0,GLOB,PROCSTART     <<00652>>66134000
                 ,0,FALSE,CSTBLKINDEX,FIRSTCST,NSEG);          <<03004>>66136000
                                                                        66138000
<<>>                                                           <<MPEIV>>66140000
<<FIX UP ICS GLOBAL CELLS FOR DISPATCHER AND PSEUDO-INTS>>     <<MPEIV>>66142000
<<>>                                                           <<MPEIV>>66144000
                                                               <<MPEIV>>66146000
          <<>>                                                 <<MPEIV>>66148000
          <<FIX UP ICS GLOBAL CELLS>>                          <<MPEIV>>66150000
          <<>>                                                 <<MPEIV>>66152000
                                                               <<MPEIV>>66154000
          ABSOLUTE(TABLEPTR) := ABSOLUTE(QI)-SYSBASE;  <<PTR TO ICS>>   66156000
          ICS(2):=SYSBASE; <<DISPATCHER DB>>                   <<MPEIV>>66158000
          TOS:=0; <<DAMN COMPILER>>                            <<MPEIV>>66160000
          TOS:=PLABEL(DISPATCHNAME);                           <<MPEIV>>66162000
          ICS(-1):=LOGICAL(S0) LAND %100377;  <<DISP STATUS>>  <<MPEIV>>66164000
          ICS(-2):=INTLABEL(*);<<DISPATCHER DELTA P>>          <<MPEIV>>66166000
          ICS(-JCUT') := ABSOLUTE(SYSJCUT)+SYSBASE;                     66168000
          TOS := 0;                                                     66170000
          TOS := PLABEL(PSINTNAME);  <<PSEUDO INTERRUPT PLABEL>>        66172000
          ICS(-PSTA) := LOGICAL(S0) LAND %100377;                       66174000
          ICS(-PADDR) := INTLABEL(*);                                   66176000
$PAGE "MAINSEG3  --  SET UP I/O PROCESSES AND DRIVERS"                  66178000
          <<------------------                                          66180000
            CREATE PROCESSES                                            66182000
          ------------------>>                                          66184000
          @DRIVERENTRY := @CSDVRAREA;                                   66186000
          DLSIZE(NDLT);  << MAKE ROOM FOR TEMPORARY TABLES >>  <<01384>>66188000
          PUSH(DL);                                                     66190000
          @DLT' := TOS;                                        <<01384>>66192000
          DLT' := 0;                                                    66194000
          MOVE DLT'(1) := DLT',(NDLT-1);                                66196000
          LINKED := 0;  <<DO CORE RESIDENT ONES FIRST>>                 66198000
  NONCORE:I := 0;   <<PROCESS INDEX>>                                   66200000
          DO IF IOPROC(I*IOPROCSIZE+8).CORERES<>INTEGER(LINKED) THEN    66202000
            BEGIN  <<CREATE PROCESS>>                                   66204000
              TOS := 0;                                                 66206000
              TOS := @IOPROC(INDEX:=I*IOPROCSIZE)&LSL(1);      <<04306>>66208000
              DUPLICATE;                                                66210000
              IF IOPROC(INDEX:=INDEX+8).DRVRTYPE=2 THEN        <<01.EB>>66212000
              IF *=SYSIOPROC,(16) THEN TOS := SIOPROC                   66214000
              ELSE TOS := -1 <<DOESN'T GO IN LOGICAL PROC TABLE>>       66216000
              ELSE BEGIN DEL;TOS := -1; END;                            66218000
              TOS:=PROCREATE(*,*,IOPROC(INDEX:=INDEX+1).(0:8), <<01.EB>>66220000
                IF LINKED THEN LKIOSTACK ELSE CRIOSTACK,JUNKWAIT,4,1,1, 66222000
                LINKED*2,IOPROC(INDEX:=INDEX-1).QNUMB);        <<01.EB>>66224000
              IF IOPROC(INDEX).DRVRTYPE=2 THEN                 <<01.EB>>66226000
                BEGIN  <<TYPE 2 - PUT PIN IN BUSY TABLE>>               66228000
                  TOS := TOS*PCBSIZE;                                   66230000
                  BUSY(IOPROC(INDEX).QNUMB) := TOS;            <<01.EB>>66232000
                END                                                     66234000
              ELSE IOPROC(INDEX:=INDEX+1).(0:8):=TOS;<<PIN>>   <<01.EB>>66236000
            END                                                         66238000
          UNTIL (I:=I+1)=NIOPROC;                                       66240000
                                                                        66242000
          <<--------------                                              66244000
            LOAD DRIVERS                                                66246000
          -------------->>                                              66248000
          DRTN := LOWESTDRT;                                   <<00888>>66250000
          DO                                                            66252000
            BEGIN  <<LOAD IN DRT ORDER>>                                66254000
              IF (UNIT:=INTHS'UNITS(DRTN).NUNIT)=0 THEN        <<00888>>66258000
                BEGIN  <<NOT USED>>                                     66262000
                  DRTN := DRTN+1;                                       66264000
                  GOTO NEXTDRT;                                         66266000
                END;                                                    66268000
              ABSOLUTE(ILTPTR) := GETDRT(DRTN,DBI)-SYSBASE;    <<03002>>66272000
              TOS := CSDRTN(DRTN.(0:12));                               66276000
              X := DRTN.(12:4);                                         66278000
              ASSEMBLE(TBC 0,X);                                        66280000
              IF <> THEN                                                66282000
                BEGIN <<CS DEVICE>>                                     66284000
                DEL;                                                    66286000
                DRTN := DRTN+1;                                         66288000
                GOTO NEXTDRT;                                           66290000
                END                                                     66292000
              ELSE DEL;                                                 66294000
              I := 0;  <<UNIT COUNTER>>                                 66296000
              N := 0;   <<MAX # OF INTERRUPT HANDLERS>>                 66298000
              DO                                                        66300000
                BEGIN  <<CHECK EACH DIT>>                               66302000
                  IF ILT(IDITP+I)=0 THEN GOTO NEXTDIT;                  66304000
                  ABSOLUTE(DITPTR) := ILT(X);                           66306000
                  TOS := DIT(DDLTP);  <<DLT PTR>>                       66308000
                  ABSOLUTE(DLTPTR) := S0;                               66310000
                  IF DLT(DPROC).CORERES=INTEGER(LINKED) THEN GO NEXTDIT;66312000
                  DVRTYPE := DLT(DPROC).DRVRTYPE;                       66314000
                  DLTINDEX := ( TOS+SYSBASE - DST(DLTDSTN&     <<03004>>66316000
                               LSL(2)+3)) /DLTSIZE;            <<03004>>66318000
                  INTRINDEX := INTRSIZE*DLTINDEX&LSL(1);       <<03004>>66322000
                  @DNAME := @DVRTAB( DIT(DLDEV).(8:8)          <<03004>>66324000
                               *DVRSIZE+DVR2)&LSL(1);          <<04306>>66326000
                  IF DLT'(DLTINDEX)<>0 THEN                    <<03004>>66328000
                    BEGIN <<ALREADY LOADED>>                            66330000
                    CSTINDEX := DLT'(DLTINDEX);                <<03004>>66332000
                    UPDATESTT( CSTINDEX, DNAME); << GET STT >> <<03004>>66334000
                    GOTO SETPIN;                               <<0+.04>>66336000
                    END;                                                66338000
                <<LOAD IT>>                                             66340000
                  LOAD( DNAME, CSTINDEX, DSTINDEX, 0, GLOB,    <<03004>>66344000
                     PROCSTART, LINKED&ASL(1), FALSE,          <<03004>>66346000
                     CSTBLKINDEX, FIRSTCST, NSEG);             <<03004>>66348000
                  UPDATESTT( CSTINDEX); << MAKE SURE STT OF >> <<03004>>66350000
                                << O.B. SEGMENT IS IN 'STT' >> <<03004>>66352000
                  DLT'(DLTINDEX) := CSTINDEX;                           66354000
                  J := 0;                                               66356000
                  DO                                                    66358000
                    BEGIN  <<FIX UP PLABELS FOR MONITOR, INIT, COMP>>   66360000
                      TOS := 0;                                         66362000
                      TOS := DLT(J+DMNTR);                              66364000
                      IF = THEN DDEL                                    66366000
                      ELSE DLT(X) := STTLABEL(*);                       66368000
                    END                                                 66370000
                  UNTIL (J := J+1)=3;                                   66372000
                  IF DLT(DPROC).CORERES=1 THEN                          66374000
                    BEGIN  <<MAKE SURE INIT AND COMP ARE CORE RESIDENT>>66376000
                      J := 0;                                           66378000
                      DO IF DLT(DINIT+J)<>0 AND CST(DLT(X).(8:8)&LSL(2))66380000
                        <0 THEN                                         66382000
                        BEGIN  <<NOT RESIDENT>>                         66384000
                        ERRMESSAGE(M253,DIT(DLDEV).(8:8));     <<01103>>66386000
                        END                                             66388000
                      UNTIL (J:=J+1)=2;                                 66390000
                    END;                                                66392000
                  IF DVRTYPE=2 THEN DLT(DPROC).QNUMB := IOPROC(DLT(     66394000
                    DPROC).QNUMB*IOPROCSIZE+8).QNUMB; <<RESOURCE Q #>>  66396000
                <<FIX UP INITIALIZATION PLABEL>>                        66398000
                  TOS := 0;                                    <<0+.04>>66400000
                  TOS := DLT(DINTPL);<<INITIALIZATION STT>>    <<0+.04>>66402000
                  IF = THEN DDEL                                        66404000
                  ELSE DLT(X) := STTLABEL(*);                  <<0+.04>>66406000
                                                               <<03004>>66408000
                << IF THE DRIVER HAS NO INTERNAL DRIVER    >>  <<03004>>66410000
                << ENTRY POINTS, IT IS A DUMMY DRIVER, AND >>  <<03004>>66412000
                << ITS CST ENTRIES MAY BE REMOVED          >>  <<03004>>66414000
                  IF DUMMYDRIVER( INTRINDEX, FIRSTCST,         <<03004>>66416000
                            FIRSTCST+NSEG-1, FALSE) THEN       <<03004>>66418000
                                                               <<03004>>66420000
                    << RETURN ALL CST ENTRIES ALLOCATED FOR>>  <<03004>>66422000
                    << THE DUMMY DRIVER.  RETURN THEM IN   >>  <<03004>>66424000
                    << REVERSE ORDER SO THEY WILL BE       >>  <<03004>>66426000
                    << RE-ALLOCATED IN INCREASING ORDER    >>  <<03004>>66428000
                    BEGIN                                      <<03004>>66430000
                    J := FIRSTCST+NSEG-1;                      <<03004>>66432000
                    DO                                         <<03004>>66434000
                       DELETECST( J)                           <<03004>>66436000
                    UNTIL (J:=J-1) < FIRSTCST;                 <<03004>>66438000
                    << MARK AS DUMMY DRIVER, WITH           >> <<03004>>66440000
                    << -( LOGICAL O.B. SEGMENT #) - 1       >> <<03004>>66442000
                    DLT'(DLTINDEX) := -(CSTINDEX-FIRSTCST)-1;  <<03004>>66444000
                    END                                        <<03004>>66446000
                  ELSE        << NOT A DUMMY DRIVER, SO    >>  <<03004>>66448000
                              << PRINT ALL CST ENTRIES     >>  <<03004>>66450000
                    LDMAP( FIRSTCST, NSEG, DNAME);             <<03004>>66452000
                                                               <<03004>>66454000
  SETPIN:         IF DVRTYPE=3 THEN DIT(DPCBN):=IOPROC(DLT(DPROC).      66456000
                    QNUMB*IOPROCSIZE+9).(0:8);  <<PIN NUMBER>>          66458000
                <<FIX UP INTERRUPT PLABELS>>                            66460000
                  K := INTR(INTRINDEX);                        <<03004>>66462000
                  IF K>N THEN N := K;  <<# OF INTERRUPT ROUTINES>>      66464000
                  IF DIT(DFLAG).SPECIH=1 THEN DLT(DINTP) := STTLABEL(   66466000
                    INTEGER(INTR(INTRINDEX+1)))   <<PLABEL>>            66468000
                  ELSE                                                  66470000
                    BEGIN  <<PRIMARY INTERRUPT HANDLER>>                66472000
                      J := 0;                                           66474000
                      DO                                                66476000
                        BEGIN  <<UPDATE DRT>>                           66478000
                          IF DRTN+J > HIDRT OR                 <<02707>>66482000
                            INTHS'UNITS(DRTN+J) <> 0 AND       <<02707>>66484000
                            J <> 0 THEN                        <<02707>>66486000
                            GOTO DONEINT;  <<FINISHED UPDATE>> <<02707>>66488000
                          TOS := STTLABEL(INTEGER(INTR(INTRINDEX+J+1)));66492000
                          TOS := GETDRT(DRTN+J,PI);            <<03002>>66494000
                          IF = THEN                                     66496000
                            BEGIN  <<NO PREVIOUS HANDLER SPECIFIED>>    66498000
                              DEL;                                      66500000
                              TEMP := TOS;                     <<03002>>66502000
                              PUTDRT(DRTN+J,PI,TEMP);          <<03002>>66504000
                            END                                         66506000
                          ELSE                                          66508000
                            BEGIN  <<MAKE SURE THIS ONE IS THE SAME AS  66510000
                                     THE ONE PREVIOUSLY SPECIFIED>>     66512000
                              ASSEMBLE(CMP);                            66514000
                              IF <> THEN                                66516000
  IHERROR:                      BEGIN  <<DIFFERENT>>                    66518000
                                ERRMESSAGE(M254,DRTN+J);       <<01103>>66520000
                                END;                                    66522000
                            END;                                        66524000
                        END                                             66526000
                      UNTIL (J:=J+1)=K;                                 66528000
  DONEINT:          END;                                                66530000
  NEXTDIT:      END                                                     66532000
              UNTIL (I:=I+1) = UNIT;                                    66534000
              IF N>INTHS'UNITS(DRTN).NINTH THEN INTHS'UNITS(X) <<01283>>66538000
                .NINTH := N;  <<# OF INTERRUPT HANDLERS>>      <<00888>>66540000
              DRTN := DRTN+1;                                           66544000
  NEXTDRT:  END                                                         66546000
          UNTIL DRTN > HIDRT;                                  <<02707>>66548000
      IF CSPRESENT THEN                                        <<WH.24>>66550000
        BEGIN                                                  <<WH.24>>66552000
          K := 1;                                                       66554000
          ADDDVRNUM := 1;                                      <<00.06>>66556000
          M := IF CSTAB(DRIVERENTNUM)=0 THEN 0 ELSE 2;                  66558000
          WHILE K<CSTAB(DRIVERENTNUM) AND LINKED OR K<M AND NOT         66560000
            LINKED DO                                                   66562000
            BEGIN  <<LOAD CS DRIVER>>                                   66564000
              @DNAME := @DRNAME&LSL(1);                        <<04306>>66566000
              LOAD( DNAME, CSTINDEX, DSTINDEX, 0, GLOB,        <<03004>>66568000
                 PROCSTART, LINKED&LSL(1), FALSE,              <<03004>>66570000
                 CSTBLKINDEX, FIRSTCST, NSEG);                 <<03004>>66572000
              UPDATESTT( CSTINDEX);  << MAKE SURE STT OF OB >> <<03004>>66574000
                                     << SEGMENT IS IN 'STT' >> <<03004>>66576000
              J := 0;                                                   66578000
              I := 1;                                                   66580000
              FIRSTDRT := TRUE;                                <<00.04>>66582000
              IF NOT LINKED THEN <<CSDUMMY>>                            66584000
                ABSOLUTE(DLTPTR) := DST(DLTDSTN&LSL(2)+3)-SYSBASE       66586000
                +(DLTINDEX:=CSDUMMYINDEX)                      <<00.06>>66588000
              ELSE                                             <<00.06>>66590000
              BEGIN  <<CONFIGURED OR ADDITIONAL DRIVER>>       <<00.06>>66592000
              DO                                                        66594000
                BEGIN <<FIND CS DRT'S FOR THIS DRIVER>>                 66596000
                IF NOT(CSDEV17<=LDT(I*LDTSIZE+LDT2).TYP<=CSDEV19) THEN  66598000
                GO LOOKFORCSDRT;                                        66600000
                TOS := @DRNAME&LSL(1);                         <<04306>>66602000
                TOS := @DVRTAB(I*DVRSIZE+2)&LSL(1);            <<04306>>66604000
                IF *<>*,(8) THEN GO LOOKFORCSDRT;                       66606000
                DRTN := DVRTAB(I*DVRSIZE).DRTFIELD;            <<03002>>66608000
                ABSOLUTE(ILTPTR) := GETDRT(DRTN,DBI) -SYSBASE; <<03002>>66610000
                ABSOLUTE(DITPTR) := ILT(IDITP);                         66612000
                TOS := DIT(DDLTP);                                      66614000
                ABSOLUTE(DLTPTR) := S0;                                 66616000
                TOS := TOS+SYSBASE-DST(DLTDSTN&LSL(2)+3);               66618000
                INTRINDEX:=(DLTINDEX:=TOS)/DLTSIZE*INTRSIZE+1;          66620000
                INTHS'UNITS(DRTN).NUNIT := 1;                  <<00888>>66624000
                IF FIRSTDRT THEN                               <<00.04>>66628000
                 BEGIN <<DO ONLY ONCE PER DRIVER>>             <<00.04>>66630000
                 TOS := 0;                                     <<00.04>>66632000
                 TOS := DLT(DINTPL); <<INITIALIZATION STT>>    <<0+.04>>66634000
                 IF = THEN DDEL                                <<00.04>>66636000
                 ELSE DLT(X) := STTLABEL(*);                   <<0+.04>>66638000
                 FIRSTDRT := FALSE;                            <<00.04>>66640000
                 END;                                          <<00.04>>66642000
                TOS := STTLABEL(INTEGER(INTR(INTRINDEX)));              66644000
                TOS := GETDRT(DRTN,PI);                        <<03002>>66646000
                IF = THEN                                               66648000
                  BEGIN                                                 66650000
                  DEL;                                                  66652000
                  TEMP := TOS;                                 <<03002>>66654000
                  PUTDRT(DRTN,PI,TEMP);                        <<03002>>66656000
                  END                                                   66658000
                ELSE                                                    66660000
                  BEGIN                                                 66662000
                  ASSEMBLE(CMP);                                        66664000
                  IF <> THEN GOTO IHERROR;                              66666000
                  END;                                                  66668000
  LOOKFORCSDRT: END                                                     66670000
              UNTIL(I:=I+1)>HLDEV;                                      66672000
              IF FIRSTDRT THEN                                 <<00.06>>66674000
                BEGIN <<MUST BE ADDITIONAL DRIVER>>            <<00.06>>66676000
                DLTINDEX := CSDUMMYINDEX+ADDDVRNUM*DLTSIZE;    <<00.06>>66678000
                ABSOLUTE(DLTPTR) := DST(DLTDSTN&LSL(2)+3)      <<00.06>>66680000
                  +DLTINDEX-SYSBASE;                           <<00.06>>66682000
                TOS := 0;                                      <<00.06>>66684000
                TOS := DLT(DINTPL);                            <<00.06>>66686000
                IF = THEN DDEL                                 <<00.06>>66688000
                ELSE DLT(X) := STTLABEL(*);                    <<00.06>>66690000
                DLT(0).DRVRTYPE := 1;                          <<00.06>>66692000
                ADDDVRNUM := ADDDVRNUM+1;                      <<00.06>>66694000
                END;                                           <<00.06>>66696000
              END;  <<CONFIGURED OR ADDITIONAL DRIVER>>        <<00.06>>66698000
              TOS := @DRLCMPLABEL;                                      66700000
              I := 0;                                                   66702000
              DO                                                        66704000
               BEGIN  <<PUT LABELS IN DLT>>                             66706000
                  TOS := PS0;   <<GET STT #>>                           66708000
                  IF <> THEN                                            66710000
                    BEGIN   <<PROCEDURE SPECIFIED>>                     66712000
                      X := -S0+STTINDEX;                                66714000
                      TOS := STT(X);                                    66716000
                      IF < THEN DELB  <<EXTERNAL LABEL>>                66718000
                      ELSE                                              66720000
                        BEGIN  <<INTERNAL LABEL>>                       66722000
                          DEL;                                          66724000
                          TOS := TOS&LSL(8)+CSTINDEX;                   66726000
                          TOS.(0:1) := 1;                               66728000
                        END;                                            66730000
                    END;                                                66732000
                  ASSEMBLE(XCH);                                        66734000
                  TOS := TOS+1;  <<POINT TO NEXT LABEL>>                66736000
                END                                                     66738000
              UNTIL (I:=I+1)=5;                                         66740000
              DEL;                                                      66742000
              CSIH'PLABEL := TOS;                                       66744000
              EDITOR'PLABEL := TOS;                                     66746000
              PHYS'DVR'PLABEL := TOS;                                   66748000
              CSSLC'PLABEL := TOS;                                      66750000
              LCM'PLABEL := TOS;                                        66752000
                                                               <<03004>>66754000
              << IF THE DRIVER HAS NO INTERNAL ENTRY       >>  <<03004>>66756000
              << POINTS, IT IS A DUMMY DRIVER, AND ITS     >>  <<03004>>66758000
              << CST ENTRIES MAY BE RELEASED.              >>  <<03004>>66760000
              IF DUMMYDRIVER( INTRINDEX-1, FIRSTCST,           <<03004>>66762000
                       FIRSTCST+NSEG-1, TRUE) THEN             <<03004>>66764000
                                                               <<03004>>66766000
                 << RETURN ALL CST'S ALLOCATED TO DRIVER IN>>  <<03004>>66768000
                 << REVERSE ORDER SO THEY MAY BE RE-       >>  <<03004>>66770000
                 << ALLOCATED IN INCREASING ORDER          >>  <<03004>>66772000
                 BEGIN                                         <<03004>>66774000
                 J := FIRSTCST+NSEG-1;                         <<03004>>66776000
                 DO                                            <<03004>>66778000
                    DELETECST( J)                              <<03004>>66780000
                 UNTIL (J:=J-1) < FIRSTCST;                    <<03004>>66782000
                 END                                           <<03004>>66784000
              ELSE          << NOT A DUMMY DRIVER, SO      >>  <<03004>>66786000
                            << PRINT ALL CST'S ALLOCATED   >>  <<03004>>66788000
                 LDMAP( FIRSTCST, NSEG, DNAME);                <<03004>>66790000
                                                               <<03004>>66792000
              DRDLTP := DLTINDEX;                                       66794000
              @DRIVERENTRY := @DRIVERENTRY+DRIVERENTRY;                 66796000
              K := K+1;                                                 66798000
            END;                                                        66800000
          I := 1;                                                       66802000
          TEMP := DST(DLTDSTN&LSL(2)+3)-SYSBASE;                        66804000
          WHILE(I:=I+1)<=HLDEV DO                                       66806000
            IF DVRTAB(I*DVRSIZE+1).DSBIT=1 <<DS DEV>> THEN     <<03002>>66808000
              BEGIN <<LOAD DS DRIVER & UPDATE DLT POIINTER>>            66810000
              ABSOLUTE(DITPTR) := LPDT(I&LSL(1));                       66812000
              IF DIT(DPROC).CORERES=INTEGER(LINKED) THEN GOTO NEXTDSDEV;66814000
              TOS := DIT(DDLTP);                                        66816000
              TOS := S0+TEMP;  <<SYDB REL POINTER TO DLT>>              66818000
              DIT(X) := S0;                                             66820000
              ABSOLUTE(DLTPTR) := TOS;                                  66822000
              DLTINDEX := TOS/DLTSIZE;                         <<03004>>66824000
              INTRINDEX := INTRSIZE*DLTINDEX&LSL(1);           <<03004>>66828000
              @DNAME := @DVRTAB( I*DVRSIZE+DVR2)&LSL(1);       <<04306>>66830000
              IF DLT'(DLTINDEX)<>0 THEN                        <<03004>>66832000
                BEGIN <<ALREADY LOADED>>                                66834000
                CSTINDEX := DLT'(DLTINDEX);                    <<03004>>66836000
                UPDATESTT( CSTINDEX,DNAME);  << GET STT >>     <<03004>>66838000
                GOTO NEXTDSDEV;                                <<0+.04>>66840000
                END;                                                    66842000
              LOAD( DNAME, CSTINDEX, DSTINDEX, 0, GLOB,        <<03004>>66846000
                 PROCSTART, LINKED&ASL(1), FALSE,              <<03004>>66848000
                 CSTBLKINDEX, FIRSTCST, NSEG);                 <<03004>>66850000
              UPDATESTT( CSTINDEX);  << MAKE SURE STT OF OB >> <<03004>>66852000
                                     << SEGMENT IS IN 'STT' >> <<03004>>66854000
              DLT'(DLTINDEX) := CSTINDEX;                               66856000
              J := 0;                                                   66858000
              DO                                                        66860000
                BEGIN <<FIX UP PLABELS FOR MONITOR,INIT,COMP>>          66862000
                TOS := 0;                                               66864000
                TOS := DLT(J+DMNTR);                                    66866000
                IF = THEN DDEL                                          66868000
                ELSE DLT(X) := STTLABEL(*);                             66870000
                END                                                     66872000
              UNTIL (J:=J+1) =3;                                        66874000
              IF DLT(DPROC).DRVRTYPE=2 THEN DLT(DPROC).QNUMB :=         66876000
                IOPROC(DLT(DPROC).QNUMB*IOPROCSIZE+8).QNUMB;            66878000
                << RESOURCE Q NUMBER>>                                  66880000
              TOS := 0;                                        <<0+.04>>66882000
              TOS := DLT(DINTPL);  <<INITIALIZATION STT>>      <<0+.04>>66884000
              IF = THEN DDEL                                            66886000
              ELSE DLT(X) := STTLABEL(*);                      <<0+.04>>66888000
                                                               <<03004>>66890000
              << IF THE DRIVER HAS NO INTERNAL ENTRY       >>  <<03004>>66892000
              << POINTS, IT IS A DUMMY DRIVER, AND ITS     >>  <<03004>>66894000
              << CST ENTRIES MAY BE RELEASED.              >>  <<03004>>66896000
              IF DUMMYDRIVER( INTRINDEX, FIRSTCST,             <<03004>>66898000
                    FIRSTCST+NSEG-1, FALSE) THEN               <<03004>>66900000
                                                               <<03004>>66902000
                 << RETURN ALL CST'S ALLOCATED TO THE      >>  <<03004>>66904000
                 << DRIVER IN REVERSE ORDER, SO THAT THEY  >>  <<03004>>66906000
                 << WILL BE RE-ALLOCATED IN INCREASING     >>  <<03004>>66908000
                 << ORDER.                                 >>  <<03004>>66910000
                 BEGIN                                         <<03004>>66912000
                 J := FIRSTCST+NSEG-1;                         <<03004>>66914000
                 DO                                            <<03004>>66916000
                    DELETECST( J)                              <<03004>>66918000
                 UNTIL (J:=J-1) < FIRSTCST;                    <<03004>>66920000
                 << MARK AS DUMMY DRIVER, WITH       >>        <<03004>>66922000
                 << -(LOGICAL OB SEGMENT #) - 1      >>        <<03004>>66924000
                 DLT'(DLTINDEX) := -(CSTINDEX-FIRSTCST)-1;     <<03004>>66926000
                 END                                           <<03004>>66928000
              ELSE           << NOT A DUMMY DRIVER, SO     >>  <<03004>>66930000
                             << PRINT ALL CST'S ALLOCATED  >>  <<03004>>66932000
                 LDMAP( FIRSTCST, NSEG, DNAME);                <<03004>>66934000
                                                               <<03004>>66936000
  NEXTDSDEV:  END;                                                      66938000
        END;                                                   <<WH.24>>66940000
          IF NOT LINKED THEN                                            66942000
             BEGIN << MAKE REST ABSENT >>                      <<01384>>66944000
              LINKED := 1;                                              66946000
              GOTO NONCORE;  <<DO SECOND PASS>>                         66948000
            END;                                                        66950000
                                                                        66952000
          <<-------------------                                         66954000
            DELETE TEMPORARY TABLES                                     66956000
          ------------------->>                                         66958000
          ABSOLUTE(CCLOSELAB) := PLABEL(CCLOSENAME);                    66960000
          ABSOLUTE(CSIOWLAB) := PLABEL(CSIOWAITNAME);                   66962000
          MOVE BINBUF := "7DSCHECK";                                    66964000
          ABSOLUTE(DSCHECKLAB) := PLABEL(BINBUF);                       66966000
          MOVE BINBUF := "6DSOPEN";                                     66968000
          ABSOLUTE(DSOPENLAB) := PLABEL(BINBUF);                        66970000
          MOVE BINBUF := "7DSCLOSE";                                    66972000
          ABSOLUTE(DSCLOSELAB) := PLABEL(BINBUF);                       66974000
          MOVE BINBUF := "?MANAGEWRITECONV";                            66976000
          ABSOLUTE(MWRITECONVLAB) := PLABEL(BINBUF);                    66978000
          MOVE BINBUF := ";CONSDSLINE'";                                66980000
          ABSOLUTE(CONSDSLINE'LAB) := PLABEL(BINBUF);                   66982000
          MOVE BINBUF := ";CONSMPLINE'";                       <<MP.00>>66984000
          ABSOLUTE(CONSMPLINE'LAB) := PLABEL(BINBUF);          <<MP.00>>66986000
          MOVE BINBUF := "9CONSMRJE'";                        <<MRJE>>  66988000
          ABSOLUTE(CONSMRJE'LAB) := PLABEL(BINBUF);           <<MRJE>>  66990000
          MOVE BINBUF := ";PLABEL3270'";                       <<00181>>66992000
          SYSGLOBEXT(CONS3270'LAB) := PLABEL(BINBUF);          <<01165>>66994000
          MOVE BINBUF := "8CSHOWCOM";                          <<01165>>66996000
          ABSOLUTE(CONSHOWCOM'LAB) := PLABEL(BINBUF);          <<01165>>66998000
          MOVE BINBUF := "8CXREMOTE";                                   67000000
          ABSOLUTE(CXREMOTELAB) := PLABEL(BINBUF);                      67002000
          MOVE BINBUF := "8CXDSLINE";                                   67004000
          ABSOLUTE(CXDSLINELAB) := PLABEL(BINBUF);                      67006000
          MOVE BINBUF := "5CXRFA";                                      67008000
          ABSOLUTE(CXRFALAB) := PLABEL(BINBUF);                         67010000
          MOVE BINBUF := "7DSIMAGE";                                    67012000
          ABSOLUTE(DSIMAGELAB) := PLABEL(BINBUF);                       67014000
          MOVE BINBUF := "7DSBREAK";                                    67016000
          ABSOLUTE(DSBREAKLAB) := PLABEL(BINBUF);                       67018000
          MOVE BINBUF := "7SDSLDEV";                           <<00.06>>67020000
          ABSOLUTE(SDSLDEVLAB) := PLABEL(BINBUF);              <<00.06>>67022000
          PUSH(DL);                                            <<01384>>67024000
          TOS := TOS-@CSDVRAREA;                               <<01384>>67026000
          DLSIZE(*);  << REMOVE TEMPORARY I/O TABLE AREA >>    <<01384>>67028000
          ABSOLUTE(SYSDIT8) := LPDT(LPDTSIZE)+SYSBASE+8;                67030000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>67032000
          ABSOLUTE(12+PI) := PLABEL(CLOCKNAME); <<CLOCK INT HANDLER>>   67034000
          ABSOLUTE(12+DBI) := ABSOLUTE(SYSTRL)+SYSBASE; <<CLOCK DB>>    67036000
          ABSOLUTE(CONSLDEV) := CONSPEED&LSL(8)+CONSOLELDEV;            67038000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>67040000
          ABSOLUTE(CONSLDEV) := CONSOLELDEV;                   <<03004>>67042000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>67044000
                                                                        67046000
          <<----------------------------                                67048000
            CREATE I/O MESSAGE PROCESS                                  67050000
          --------------------------->>                                 67052000
          ABSOLUTE(IOMESSSTOP) := PROCREATE(IOMESSNAME,IOMESSPROC,      67054000
            IOMESSPRI,IOMESSSTACK,9<<MSG wait>>,4,0,1,2,0)     <<02807>>67056000
            & lsl(8) + IOMESSSBIT;                             <<02807>>67058000
          ABSOLUTE(X:=X+1) := %20;                                      67060000
           ABSOLUTE(NPROCSTOP):=5;                                      67062000
      END <<MAINSEG3>> ;                                                67064000
$PAGE "MAINSEG3  --  TABLE SETUP"                                       67066000
$PAGE "MAINSEG4  --  TABLE SETUP"                              <<03580>>67068000
$CONTROL SEGMENT=MAINSEG4                                      <<03580>>67070000
                                                               <<03580>>67072000
  <<------------------------>>                                 <<03580>>67074000
  << Build Tape Label Table >>                                 <<03580>>67076000
  <<------------------------>>                                 <<03580>>67078000
                                                               <<03580>>67080000
   PROCEDURE BUILD'TAPE'LABEL'TABLE;                           <<03580>>67082000
                                                               <<03580>>67084000
COMMENT                                                        <<03580>>67086000
                                                               <<03580>>67088000
   Allocates space for tape label table and fills it with      <<03580>>67090000
   LDEV #'s for tape devices and for non-system-domain discs.  <<04263>>67092000
   The resulting table is an interim table from which LABSEG   <<04263>>67094000
   builds the completed Tape Label Table for use by the system.<<04263>>67096000
   The interim table consists of one word entries, the left    <<04263>>67098000
   byte of each containing the qualifying LDEV#, and the right <<04263>>67100000
   byte containing a "1" if the LDEV# specifies an actual tape <<04263>>67102000
   type device (i.e. if Device Type = %30).                    <<04263>>67104000
   ;                                                           <<03580>>67106000
                                                               <<03580>>67108000
BEGIN                                                          <<03580>>67110000
DEFINE CLASS'ACC'TYP = (10:6)#;                                <<03580>>67112000
EQUATE SDISC = 31; <<CLASS ACCESS TYPE FOR SERIAL DISC>>       <<03580>>67114000
DOUBLE DCOREADDR;                                              <<03580>>67116000
INTEGER ARRAY TLT'LDEVS(0:256);                                <<03580>>67118000
INTEGER TLT'LDEVS'INDX:= 2,                                    <<03580>>67120000
        INDEX,                                                 <<03580>>67122000
        LDEV,                                                  <<03580>>67124000
        TLTMAX,                                                <<03580>>67126000
        J,                                                     <<03580>>67128000
        I;                                                     <<03580>>67130000
LOGICAL BANK=DCOREADDR,                                        <<03580>>67132000
        COREADDR=DCOREADDR+1;                                  <<03580>>67134000
                                                               <<03580>>67136000
                                                               <<03580>>67140000
  I := 1;                                                      <<03580>>67142000
  WHILE (I:=I+1)<=HLDEV DO                                     <<04263>>67144000
    IF LDEV'EXISTS(I) THEN                                     <<04263>>67146000
                                                               <<04263>>67148000
      <<check if tape unit or non-system domain disc>>         <<04263>>67150000
      IF  LDT((I*LDTSIZE)+LDT2).TYP=TAPETYPE OR                <<04263>>67152000
          (LPDT((I*LPDTSIZE)+LPDT1).NSDV=1 LAND                <<04263>>67154000
           0<=LDT((I*LDTSIZE)+LDT2).TYP<=9) THEN               <<04263>>67156000
                                                               <<04263>>67158000
        BEGIN <<Include in Tape Label Table>>                  <<04263>>67160000
        TLT'LDEVS(TLT'LDEVS'INDX):= I&LSL(8);                  <<04263>>67162000
                                                               <<04263>>67164000
        <<indicate tape units with "1" in right byte>>         <<04263>>67166000
        IF LDT((I*LDTSIZE)+LDT2).TYP=TAPETYPE THEN             <<04263>>67168000
          TLT'LDEVS(TLT'LDEVS'INDX).(8:8):= 1;                 <<04263>>67170000
                                                               <<04263>>67172000
        TLT'LDEVS'INDX:= TLT'LDEVS'INDX+1;                     <<04263>>67174000
        END;                                                   <<04263>>67176000
                                                               <<03580>>67180000
<<ALLOCATE SPACE>>                                             <<03580>>67182000
TLTMAX:= (TLT'LDEVS'INDX-1)*65;                                <<03580>>67184000
TLT'LDEVS(0):= TLTMAX;                                         <<03580>>67186000
TLT'LDEVS(1):= TLT'LDEVS'INDX-2;                               <<03580>>67188000
BANK:= ABSOLUTE(DBBANK);                                       <<03580>>67190000
COREADDR:= ABSOLUTE(DB)+@TLT'LDEVS;                            <<03580>>67192000
INSERTDST(COREADDR,TLTDSTN,ROUND(TLT'LDEVS'INDX),0,BANK);      <<03580>>67194000
ABSOLUTE(AVR):=1; <<TURN ON AVR>>                              <<03580>>67196000
ABSENT(TLTDSTN,TLTMAX);                                        <<03580>>67198000
DST(TLTDSTN&LSL(2)).(3:13):= (ROUND(TLTMAX)&LSR(2)).(3:13);    <<03580>>67200000
END; <<BUILD'TAPE'LABEL'TABLE>>                                <<03580>>67202000
$CONTROL SEGMENT=MAINSEG4                                               67204000
  PROCEDURE MAINSEG4;                                                   67206000
      BEGIN                                                             67208000
        INTEGER POINTER TABLE;                                 <<MPEIV>>67210000
        DEFINE  STOP'ENT0'X = TABLE(0) #,                      <<MPEIV>>67212000
                STOP'ENT1'X = (STOP'ENT0'X+MINSTOPSIZE) #;     <<MPEIV>>67214000
        LOGICAL DONE;                                          <<01384>>67216000
        INTEGER IDDSEGSIZE,  << SIZE OF IDD TABLE >>           <<02614>>67218000
                ODDSEGSIZE,  << SIZE OF ODD TABLE >>           <<02614>>67220000
                JMATSEGSIZE,                                   <<01384>>67222000
                MAXNIDDENT, <<MAX # OF IDD SUBENTRIES>>                 67224000
                NIDDENT,    <<# OF IDD SUBENTRIES>>                     67226000
                INDEX',                                        <<SD.00>>67228000
                STOP'DSTSIZE,                                  <<MPEIV>>67230000
                STOP'PCB'EXTSIZE,                              <<MPEIV>>67232000
                STOP'TABSIZE,                                  <<MPEIV>>67234000
                JOBNUMB,    <<CURRENT JOB NUMBER>>             <<TL.02>>67236000
                FPOINT;   <<FREE POINTER>>                     <<TL.02>>67240000
        DOUBLE LENGTH;       << LENGTH OF EXTENT IN SECTORS >> <<02614>>67242000
        DOUBLE LSECT;                                          <<03557>>67244000
        DOUBLE NLINES,EOF,EXTADR;                              <<00.+4>>67246000
        INTEGER LDEV';                                         <<00.+4>>67248000
        INTEGER POINTER PCBENT=TABIX; <<PTR TO PCB>>           <<00652>>67250000
        BYTE ARRAY DESTROYED'BEFORE(*)=PB :=                   <<01103>>67252000
           28,"- DESTROYED BEFORE WARMSTART";                  <<01103>>67254000
        BYTE ARRAY DESTROYED'DURING(*)=PB :=                   <<01103>>67256000
           27,"- DESTROYED DURING RECOVERY";                   <<01103>>67258000
        DOUBLE  DCOREADDR;                                     <<01384>>67260000
        LOGICAL BANK     = DCOREADDR,                          <<01384>>67262000
                COREADDR = DCOREADDR+1;                        <<01384>>67264000
        INTEGER CLABEL;                                        <<01384>>67266000
        DOUBLE  VDSTART;  << VM STARTING SECTOR >>             <<MPEIV>>67268000
        LOGICAL VDSTART1 = VDSTART,                            <<MPEIV>>67270000
                VDSTART2 = VDSTART+1;                          <<MPEIV>>67272000
                                                               <<MPEIV>>67274000
       INTEGER NRIMB,I;                                        <<03002>>67276000
       ARRAY IMB (0:3);                                        <<03002>>67278000
                                                                        67280000
          ASSEMBLE( RSW );                                     <<01091>>67282000
          IF TOS.(8:8) <> CLRSW THEN HELP;                     <<02510>>67284000
          VDSTART1 := VDSENTRY(HOSTARTSECTORWORD);                      67286000
          VDSTART2 := VDSENTRY(LOSTARTSECTORWORD);                      67288000
          <<-----------------                                           67290000
            CS DATA SEGMENT                                             67292000
          ----------------->>                                           67294000
          TOS := CSTAB;  <<SIZE OF LDTX AREA>>                          67296000
          CSTAB(GROUPENTPTR) := S0;                                     67298000
          CSTAB(DRIVERENTPTR) := TOS;                                   67300000
          MEMSEG := ROUND(CSTAB+CSDVRAREASIZE);                <<01384>>67302000
          DCOREADDR := MAM(MEMSEG);                            <<01384>>67304000
          INSERTDST(COREADDR,CSDSTN,MEMSEG,0,BANK);            <<01440>>67306000
          TOS := DCOREADDR;                                    <<01384>>67308000
          PUSH(DB);                                                     67310000
          TOS := TOS+@CSTAB;                                            67312000
          TOS := CSTAB;                                                 67314000
          ASSEMBLE(MABS 3);                                             67316000
          PUSH(DB);                                                     67318000
          TOS := TOS+@CSDVRAREA;                                        67320000
          TOS := CSDVRAREASIZE;                                         67322000
          ASSEMBLE(MABS 5);                                             67324000
          SSEA(DCOREADDR, MEMSEG);                             <<01384>>67326000
          ABSENT(CSDSTN,-1);                                            67328000
          ABSOLUTE(STDPTR) := 0;                                        67330000
          ABSOLUTE(CONTPTR) := 0;                                       67332000
                                                                        67336000
          <<-------------------------                                   67338000
            REPLY INFORMATION TABLE                                     67340000
          ------------------------->>                                   67342000
          DCOREADDR := MAM(2048);                              <<04778>>67344000
          SSEA(DCOREADDR+1D,39);                               <<04778>>67346000
          SSEA(DCOREADDR+2D,4);                                <<04778>>67348000
          SSEA(DCOREADDR+3D,0);                                <<04778>>67350000
          INSERTDST(COREADDR,RITDSTN,2048,0,BANK);             <<04778>>67352000
          ABSENT(RITDSTN,-1);                                           67354000
                                                                        67356000
          <<---------------------------                                 67358000
            UCOP REQUEST QUEUE (UCRQ)                                   67360000
          --------------------------->>                                 67362000
          MEMSEG := ROUND((CTAB(UCRQNUM)+2)*UCRQSIZE);         <<01384>>67364000
          DCOREADDR := MAM(MEMSEG);                            <<01384>>67366000
          INSERTDST(COREADDR,UCRQDSTN,MEMSEG,0,BANK);          <<01384>>67368000
          SSEA(DCOREADDR+0D, CTAB(UCRQNUM));                   <<01384>>67370000
          ABSENT(UCRQDSTN,-1);                                          67372000
                                                                        67374000
          <<------------------------------                              67376000
            INIT P-P COMMUNICATION TABLE                                67378000
          ------------------------------>>                              67380000
          MEMSEG := ROUND(CTAB(PCBNUM)*PPCTSIZE);              <<01384>>67382000
          DCOREADDR := MAM(MEMSEG);                            <<01384>>67384000
          INSERTDST(COREADDR,PPCTDSTN,MEMSEG,0,BANK);          <<01384>>67386000
          ABSENT(PPCTDSTN,-1);                                          67388000
                                                                        67390000
          <<-----------------------------                               67392000
            JOB-PROCESS CROSS REF TABLE                                 67394000
          ----------------------------->>                               67396000
          MEMSEG := ROUND(CTAB(PCBNUM));                       <<01384>>67398000
          DCOREADDR := MAM(MEMSEG);                            <<01384>>67400000
          INSERTDST(COREADDR,JPXREFDSTN,MEMSEG,0,BANK);        <<01384>>67402000
          SSEA(DCOREADDR+0D, CTAB(PCBNUM));                    <<01384>>67404000
          SSEA(DCOREADDR+1D, 1);                               <<01384>>67406000
          ABSENT(JPXREFDSTN,-1);                                        67408000
                                                                        67410000
          <<------------                                                67412000
            SYSTEM JIT                                                  67414000
          ------------>>                                                67416000
          DCOREADDR := MAM(64);                                <<01384>>67418000
          INSERTDST(COREADDR,SJITDSTN,64,0,BANK);              <<01384>>67420000
          SSEA(DCOREADDR+1D, 6&LSL(10)+SJITDSTN);              <<01384>>67422000
          SSEA(DCOREADDR+2D, 8);                               <<01384>>67424000
          SSEA(DCOREADDR+3D, 48);  << PTR TO ACCOUNTING INFO >><<01384>>67426000
          SSEA(DCOREADDR+4D, 59);  << PTR TO RESERVED AREA >>  <<01384>>67428000
          SSEA(DCOREADDR+8D, 7);                               <<01384>>67430000
          SSEA(DCOREADDR+10D, PROGPCBN);                       <<01384>>67432000
          TOS := DIRECFIND(%20,0,SYSACCT,NULLNAME,NULLNAME,             67434000
            INFO);                                                      67436000
          IF <> THEN DIRERROR(*,BBUF);                                  67438000
          DDEL;                                                         67440000
          SSEA(DCOREADDR+13D, INFO(26));  <<ACCOUNT SECURITY>> <<01384>>67442000
          SSEA(DCOREADDR+32D,53); <<PTR TO ACCT-GRP INDEX PTR>><<01384>>67444000
          SSEA(DCOREADDR+54D, INFO(4));                        <<01384>>67446000
          TOS := DIRECFIND(%10,0,SYSACCT,PUBGRP,NULLNAME,               67448000
            INFO);                                                      67450000
          IF <> THEN DIRERROR(*,BBUF);                                  67452000
          DDEL;                                                         67454000
          SSEA(DCOREADDR+14D, INFO(21));  << GROUP SECURITY >> <<01384>>67456000
          SSEA(DCOREADDR+15D, INFO(22));                       <<01384>>67458000
          SSEA(DCOREADDR+33D, 55);  <<PTR TO GROUP FILE INDEX>><<01384>>67460000
          SSEA(DCOREADDR+56D, INFO(4));                        <<01384>>67462000
          TOS := DIRECFIND(%30,0,SYSACCT,MANUSER,NULLNAME,              67464000
            INFO);                                                      67466000
          IF <> THEN DIRERROR(*,BBUF);                                  67468000
          DDEL;                                                         67470000
          SSEA(DCOREADDR+38D, INFO(4));  << USER CAPABILITY >> <<01384>>67472000
          SSEA(DCOREADDR+39D, INFO(5));  << USER CAPABILITY >> <<01384>>67474000
          SSEA(DCOREADDR+16D, "SY");                           <<01384>>67476000
          SSEA(DCOREADDR+17D, "S ");                           <<01384>>67478000
          SSEA(DCOREADDR+18D, "  ");                           <<01384>>67480000
          SSEA(DCOREADDR+19D, "  ");                           <<01384>>67482000
          SSEA(DCOREADDR+20D, "PU");                           <<01384>>67484000
          SSEA(DCOREADDR+21D, "B ");                           <<01384>>67486000
          SSEA(DCOREADDR+22D, "  ");                           <<01384>>67488000
          SSEA(DCOREADDR+23D, "  ");                           <<01384>>67490000
          SSEA(DCOREADDR+24D, "PU");                           <<01384>>67492000
          SSEA(DCOREADDR+25D, "B ");                           <<01384>>67494000
          SSEA(DCOREADDR+26D, "  ");                           <<01384>>67496000
          SSEA(DCOREADDR+27D, "  ");                           <<01384>>67498000
          SSEA(DCOREADDR+28D, "MA");                           <<01384>>67500000
          SSEA(DCOREADDR+29D, "NA");                           <<01384>>67502000
          SSEA(DCOREADDR+30D, "GE");                           <<01384>>67504000
          SSEA(DCOREADDR+31D, "R ");                           <<01384>>67506000
        <<SSEA(DCOREADDR+40D, 0);>>  <<INITIAL MSECCOUNT>>     <<01384>>67508000
        <<SSEA(DCOREADDR+41D, 0);>>  <<INITIAL MSECCOUNT>>     <<01384>>67510000
          ABSENT(SJITDSTN,-1);                                          67512000
                                                                        67514000
          DISC(READ,SYSDISC,D'L(INFOSECTOR)),INFO,INFOSIZE);            67516000
          <<------------                                                67518000
            SYSTEM JDT                                                  67520000
          ------------>>                                                67522000
          MEMSEG := ROUND(SJDTSIZE);                           <<01384>>67524000
          DCOREADDR := MAM(MEMSEG);                            <<01384>>67526000
          INSERTDST(COREADDR,SJDTDSTN,MEMSEG,0,BANK);          <<01384>>67528000
          SSEA(DCOREADDR+0D, MAXSJDTSIZE);                     <<01384>>67530000
          SSEA(DCOREADDR+1D, %30);                             <<01384>>67532000
          SSEA(DCOREADDR+2D, %30);                             <<01384>>67534000
          SSEA(DCOREADDR+3D, %30);                             <<01384>>67536000
          SSEA(DCOREADDR+4D, %30);                             <<01384>>67538000
          SSEA(DCOREADDR+5D, %30);                             <<01384>>67540000
          SSEA(DCOREADDR+6D, %30);                             <<01384>>67542000
          SSEA(DCOREADDR+%27D, 3);                             <<01384>>67544000
          ABSENT(SJDTDSTN,MAXSJDTSIZE);                                 67546000
                                                                        67548000
          <<-----------                                                 67550000
            WARMSTART                                                   67552000
          ----------->>                                                 67554000
                                                                        67556000
          IF WARMSTART THEN                                             67558000
            BEGIN                                                       67560000
                                                                        67562000
          <<-------------                                               67564000
            RECOVER IDD                                                 67566000
          ------------->>                                               67568000
            DISC(READ,SYSDISC,INFOD(IDDLOC),INBUF,4);          <<01384>>67570000
            IDDSEGSIZE := INBUF.(8:8)&LSL(7);                  <<01384>>67572000
            MAXNIDDENT :=                                      <<01384>>67574000
              (IDDSEGSIZE-INBUF(SUBAREAP))/XDDSUBSIZE;         <<01384>>67576000
            DISC(READ,SYSDISC,INFOD(JMATLOC),INBUF,2);         <<01384>>67578000
            JMATSEGSIZE := INBUF.(8:8)&LSL(7);                 <<01384>>67580000
            IF IDDSEGSIZE > JMATSEGSIZE THEN                   <<01384>>67582000
              MEMSEG := IDDSEGSIZE                             <<01384>>67584000
            ELSE                                               <<01384>>67586000
              MEMSEG := JMATSEGSIZE;                           <<01384>>67588000
            DLSIZE(MEMSEG+MAXNIDDENT);                         <<01384>>67590000
            PUSH(DL);                                          <<01384>>67592000
            @XDD := S0 + MAXNIDDENT;                           <<01384>>67594000
            @JMAT := TOS + MAXNIDDENT;                         <<01384>>67596000
            PUSH(DB);                                          <<01384>>67598000
            TOS := @XDD;                                       <<01384>>67600000
            ASSEMBLE(ADD);  << ABSOLUTE XDD/JMAT ADDRESS >>    <<01384>>67602000
            DCOREADDR := TOS;                                  <<01384>>67604000
                                                               <<01384>>67606000
            INSERTDST(COREADDR,IDDDSTN,IDDSEGSIZE,0,BANK);     <<01384>>67608000
            DISC(READ,SYSDISC,INFOD(IDDLOC),XDD,IDDSEGSIZE);   <<01384>>67610000
            NIDDENT := 0;                                      <<01384>>67614000
            INDEX := XDD(SUBAREAP);                                     67616000
            LSECT := 0D;                                                67618000
            WHILE INDEX < IDDSEGSIZE DO  << CHECK ALL IDD  >>  <<02614>>67620000
              BEGIN                      << SUBENTRIES     >>  <<02614>>67622000
              IF XDD(INDEX)<>0 THEN                                     67624000
                BEGIN                                                   67626000
                IF(XDD(INDEX).XDDSTATE=OPENED) AND                      67628000
                  (XDD(X+IDDREST)=0) OR                                 67630000
                  (XDD(INDEX).XDDSTATE=ACTIV) OR                        67632000
                  (XDD(X+20)=0) THEN                                    67634000
                  BEGIN                                                 67636000
                  XDD(INDEX) := 0;                                      67638000
                  DELETEVDEV(INDEX);                                    67640000
                  END                                                   67642000
                ELSE                                                    67644000
                  BEGIN                                                 67646000
                  IF RECOVERY THEN                                      67648000
                    IF NOT(VDEVREPLACED(INDEX)) THEN                    67650000
                      BEGIN                                             67652000
                      BINBUF(1) := "I";                        <<01103>>67654000
                      I := ASCII(XDD(INDEX+JOBID),BINBUF(2));  <<01103>>67656000
                      BINBUF := I+1;                           <<01103>>67658000
                      MESSAGE(M125,,,,,BINBUF);                <<01103>>67660000
                      REMOVEXDDSUBENTRY(INDEX);                         67662000
                      XDD(INDEX) := 0;                                  67664000
                      GO AROUND;                                        67666000
                      END;                                              67668000
                  XDD(INDEX).XDDSTATE := READY;                         67670000
                  XDD(X+VDVFLD) := 0;                                   67672000
                  XDD(NIDDENT-MAXNIDDENT) := XDD(INDEX+JOBNUM);         67674000
                  NIDDENT := NIDDENT+1;                                 67676000
                  LSECT := LSECT+DOUBLE((XDD(INDEX+NUMEXT).(0:8)-1)*    67678000
                          CTAB0(EXTSSECT'))+DOUBLE(XDD(INDEX+LASTEXT)); 67680000
  AROUND:         END;                                                  67682000
                END;                                           <<02614>>67684000
              INDEX := INDEX+XDDSUBSIZE;                       <<02614>>67686000
              END;                                             <<02614>>67688000
             J := 2;                                                    67690000
             N := XDD(SUBAREAP)/XDDHEADSIZE;                            67692000
             WHILE(J:=J+1)<N DO                                         67694000
               BEGIN                                                    67696000
               X := XDD(J*XDDHEADSIZE)*LDTSIZE+LDT4;                    67698000
               LDT(X).(8:8) := J;                                       67700000
               END;                                                     67702000
             TOS := INFOD(IDDLOC)-VDSTART;                              67704000
             DELB;                                                      67706000
             TOS := TOS/NSECTPAGE;                                      67708000
             L := S0;                                                   67710000
             M := TOS+PAGES(1);                                         67712000
             DO                                                         67714000
               BEGIN                                                    67716000
               TOS := VDSMAP(L.(0:12));                                 67718000
               X := L.(12:4);                                           67720000
               ASSEMBLE(TSBC 0,X);                                      67722000
               VDSMAP(L.(0:12)) := TOS;                                 67724000
               END                                                      67726000
             UNTIL (L:=L+1)>=M;                                         67728000
             ABSENT(IDDDSTN,MAXIDDTSIZE);                               67730000
                                                                        67732000
          <<--------------                                              67734000
            RECOVER JMAT                                                67736000
          -------------->>                                              67738000
            INSERTDST(COREADDR,JMATDSTN,JMATSEGSIZE,0,BANK);   <<01384>>67740000
            DISC(READ,SYSDISC,INFOD(JMATLOC),JMAT,JMATSEGSIZE);<<01384>>67742000
            IF JMAT(1).(8:8) <> JMATSIZE THEN                  <<01103>>67744000
               BEGIN                                           <<01103>>67746000
               MOVE BINBUF := DESTROYED'BEFORE,(29);           <<01103>>67748000
               ERRMESSAGE(M305,,,,,BINBUF);                    <<01103>>67750000
               END;                                            <<01103>>67752000
<<INVALID JMAT ON DISC CAN'T WARMSTART>>                                67754000
            ABSOLUTE(VMOUNTINFO).(8:8) := JMAT(1).(0:8);       <<01262>>67756000
            << PERMIT RECOVERY OF USER LOGGING FROM PV'S >>    <<01262>>67758000
            TEMP := JMATSEGSIZE-JMATSUBSIZE;                   <<01384>>67760000
            INDEX := 0;                                                 67762000
            WHILE(INDEX:=INDEX+JMATSUBSIZE)<=TEMP DO                    67764000
              BEGIN                                                     67766000
              IF JMAT(INDEX)<>0 AND                                     67768000
                 JMAT(INDEX).STATEFLD<>ERRORSTATE THEN                  67770000
                IF LOGICAL(JMAT(INDEX+SPSTATE)) THEN                    67772000
                  IF JMAT(INDEX).STATEFLD=WAITING                       67774000
                     OR LOGICAL(JMAT(INDEX+RESTART))                    67776000
                     AND (JMAT(INDEX).STATEFLD=INITIALIZING             67778000
                          OR JMAT(INDEX).STATEFLD=EXECUTING    <<01.00>>67780000
                          OR JMAT(INDEX).STATEFLD=SUSPENDED)   <<01.00>>67782000
                          THEN                                 <<01.00>>67784000
                    BEGIN <<SAVE ENTRY>>                                67786000
                    JOBNUMB := JMAT(INDEX+JOBNUM);                      67788000
                    I := -1;                                            67790000
                    WHILE (I := I+1) < NIDDENT DO              <<02614>>67792000
                      <<CHECK IF CORRESPONDING IDD ENTRY>>              67794000
                      IF JOBNUMB=JMAT(I-MAXNIDDENT) THEN GO SETWAITING; 67796000
                    GO DELETEJOB;<<NO CORRESPONDING IDD ENTRY>>         67798000
  SETWAITING:       IF JMAT(INDEX).STATEFLD<>WAITING THEN               67800000
                      BEGIN <<SET TO WAITING>>                          67802000
                      JMAT(INDEX).STATEFLD := WAITING;                  67804000
                      JMAT(X).GAU := 0;                                 67806000
                      JMAT(X+MAINPIN) := 0;                             67808000
                      JMAT(INDEX+18) := JMAT(INDEX+25);                 67810000
                      END;                                              67812000
                    END                                                 67814000
                  ELSE JMAT(INDEX) := 0    <<DELETE>>                   67816000
                ELSE                                                    67818000
  DELETEJOB:      JMAT(INDEX) := 0; <<NOT SPOOLED,DELETE>>              67820000
              END;                                                      67822000
            SCHEDULEJMATENTRIES;                                        67824000
            JMAT(7).(12:4) := 14;                                       67826000
            JMAT(7).(0:1) := 0;  << RESET LOGOFF BIT >>        <<01102>>67828000
            JMAT(9) := 0;                                               67830000
            JMAT(11) := 0;                                              67832000
            TOS := INFOD(JMATLOC)-VDSTART;                              67834000
            DELB;                                                       67836000
            TOS := TOS/NSECTPAGE;                                       67838000
            L := S0;                                                    67840000
            M := TOS+PAGES;                                             67842000
            DO                                                          67844000
              BEGIN                                                     67846000
              TOS := VDSMAP(L.(0:12));                                  67848000
              X := L.(12:4);                                            67850000
              ASSEMBLE(TSBC 0,X);                                       67852000
              VDSMAP(L.(0:12)) := TOS;                                  67854000
              END                                                       67856000
            UNTIL (L:=L+1)>=M;                                          67858000
            IF JMAT(1).(8:8) <> JMATSIZE THEN                  <<01103>>67860000
               BEGIN                                           <<01103>>67862000
               MOVE BINBUF := DESTROYED'DURING,(28);           <<01103>>67864000
               ERRMESSAGE(M305,,,,,BINBUF);                    <<01103>>67866000
               END;                                            <<01103>>67868000
<<INITIAL MESSED UP THE JMAT CAN'T WARMSTART>>                          67870000
            ABSENT(JMATDSTN,MAXJMSIZE);                                 67872000
            DLSIZE( -(MEMSEG+MAXNIDDENT) );                    <<01384>>67874000
                                                                        67876000
           <<-------------                                              67878000
             RECOVER ODD                                                67880000
           ------------->>                                              67882000
            DISC(READ,SYSDISC,INFOD(ODDLOC),INBUF,2);                   67884000
            ODDSEGSIZE := INBUF.(8:8)&LSL(7);                  <<02614>>67886000
            MEMSEG := ODDSEGSIZE;                              <<02614>>67888000
            DLSIZE(MEMSEG);                                    <<01384>>67890000
            PUSH(DL);                                          <<01384>>67892000
            @XDD := TOS;                                       <<01384>>67894000
            PUSH(DB);                                          <<01384>>67896000
            TOS := @XDD;                                       <<01384>>67898000
            ASSEMBLE(ADD);  << ABSOLUTE XDD ADDRESS >>         <<01384>>67900000
            DCOREADDR := TOS;                                  <<01384>>67902000
            INSERTDST(COREADDR,ODDDSTN,MEMSEG,0,BANK);         <<01384>>67904000
            DISC(READ,SYSDISC,INFOD(ODDLOC),XDD,ODDSEGSIZE);   <<02614>>67906000
            INDEX := XDD(SUBAREAP);                                     67910000
            XDD(OUTFENCE) := 14;                                        67912000
            WHILE INDEX < ODDSEGSIZE DO  << CHECK ALL ODD  >>  <<02614>>67914000
              BEGIN                      << SUBENTRIES     >>  <<02614>>67916000
              IF XDD(INDEX)<>0 THEN                                     67918000
                IF XDD(X+20)<>0 THEN                                    67920000
                  BEGIN <<SPOOLED>>                                     67922000
                  IF RECOVERY THEN                                      67924000
                    BEGIN                                               67926000
                    IF NOT(VDEVREPLACED(INDEX)) THEN                    67928000
                      BEGIN  <<DISC ERROR>>                             67930000
                      BINBUF(1) := "O";                        <<01103>>67932000
                      I := ASCII(XDD(INDEX+JOBID),BINBUF(2));  <<01103>>67934000
                      BINBUF := I+1;                           <<01103>>67936000
                      MESSAGE(M125,,,,,BINBUF);                <<01103>>67938000
                      GO REMOVEODEV;                                    67940000
                      END;                                              67942000
                    END;                                                67944000
                  TOS := XDD(INDEX+FLABADR1);                           67946000
                  LDEV := S0.(0:8);                                     67948000
                  TOS := TOS.(8:8);                                     67950000
                  TOS := XDD(X:=X+1);                                   67952000
                  DTEMP := TOS;  <<FILE LABEL ADRESS>>                  67954000
                  TOS := 0;                                             67956000
                  TOS := (IF XDD(INDEX+NUMEXT).(0:8)=1 THEN             67958000
                           XDD(INDEX+LASTEXT) ELSE CTAB0(EXTSSECT'));   67960000
                  IF = THEN                                             67962000
                    BEGIN <<LAST EXTENT WORD WAS ZERO>>                 67964000
                    DEL;                                                67966000
                    TOS := CTAB0(EXTSSECT');                            67968000
                    END;                                                67970000
                  LENGTH := TOS;                                        67972000
                  TOS := Get'Specific'Disc'Space (ldev, dtemp, <<03551>>67974000
                                                  length);     <<03551>>67976000
                  IF TOS = 0 THEN                              <<03551>>67978000
                    BEGIN <<SPACE WAS FREE,SHOULDN'T HAVE BEEN>>        67980000
                    <<THIS TEST WAS PUT IN TO TRY AND PREVENT>>         67982000
                    <<SOME SUDDEN DEATHS 422. THE S.D.'S WERE>>         67984000
                    <<CAUSED BECAUSE THE ODD SOMETIMES WAS NOT>>        67986000
                    <<UPDATED ON THE DISC FAST ENOUGH BEFORE A>>        67988000
                    <<CRASH...................................>>        67990000
                    Return'Disc'Space (ldev, dtemp, length);   <<03551>>67992000
                    GO REMOVEODEV;                                      67994000
                    END;                                                67996000
                  DISC(READ,LDEV,DTEMP,FLAB,128);              <<00.+4>>67998000
                  IF XDD(INDEX).XDDSTATE=OPENED THEN                    68000000
                    BEGIN <<UPDATE EOF POINTERS>>                       68002000
                    TOS := XDD(INDEX+NUMEXT).(0:8);                     68004000
                    IF S0=0 THEN                                        68006000
                      BEGIN <<DELETE ENTRY>>                            68008000
                      DEL;                                              68010000
                      RETDISCSPACE(LDEV,D'L(CTAB0(EXTSSECT'))),DTEMP);  68012000
                      GO REMOVEODEV;                                    68014000
                      END;                                              68016000
                    I:=TOS-1;FLNUMEXTS := I;<<HAVE TO FOR COMPILER>>    68018000
                    TOS := XDD(INDEX+XDDEOF);                           68020000
                    TOS := XDD(X:=X+1);                                 68022000
                    IF DS0 = 0D THEN                                    68024000
                      BEGIN                                             68026000
                      DDEL;                                             68028000
                      TOS := DEFAULTEOF;                                68030000
                      ASSEMBLE(DDUP);                                   68032000
                      XDD(X) := TOS;                                    68034000
                      XDD(X:=X-1) := TOS;                               68036000
                      END;                                              68038000
                    FLEOF := TOS;                                       68040000
                    CHECKSUM;  <<GENERATE NEW CHECKSUM>>                68042000
                    FLCHECKSUM := TOS;                                  68044000
                    DISC(WRITE,LDEV,DTEMP,FLAB,128);                    68046000
                    END;                                                68048000
                  IF LOGICAL(XDD(INDEX+SQUEEZE)) THEN          <<00.+4>>68050000
                    BEGIN <<SQUEEZE BIT IS SET>>               <<00.+4>>68052000
                    I := J := 0;                               <<00.06>>68054000
                    WHILE(I:=I+1)<=FLNUMEXTS DO                <<00.06>>68056000
                      IF FLABDBL(EXT0+I)=0D THEN J:=J+1;       <<00.06>>68058000
                    M:=FLNUMEXTS-J+1;<<# OF NON ZERO ENTRIES>> <<00.06>>68060000
                    N := XDD(INDEX+NUMEXT).(0:8);              <<00.+4>>68062000
                    EOF := FLEOF;                              <<00.+4>>68064000
                    TOS := XDD(INDEX+XDDEOF);                  <<00.+4>>68066000
                    TOS := XDD(X:=X+1);                        <<00.+4>>68068000
                    NLINES := DS1;                             <<00.+4>>68070000
                    IF N=M THEN FLEOF:=TOS <<UPDATE LABEL EOF>><<00.+4>>68072000
                    ELSE IF N<M THEN                           <<00.+4>>68074000
                           BEGIN <<UPDATE LABEL >>             <<00.+4>>68076000
                           FLEOF := TOS;                       <<00.+4>>68078000
                           I := 1;                             <<00.+4>>68080000
                           WHILE FLABDBL(EXT0+I)=0D AND        <<00.+4>>68082000
                                 I<=FLNUMEXTS DO I:=I+1;       <<00.+4>>68084000
                           IF I<FLNUMEXTS THEN                 <<00.+4>>68086000
                             BEGIN <<RETURN SPACE FOR EXTENT>> <<00.+4>>68088000
                             TOS := FLABDBL(EXT0+I);           <<00.+4>>68090000
                             LDEV':=VTAB(S1.(0:8)*VTABSIZE +   <<00.+4>>68092000
                                         VTAB12).VTABLDEV;     <<00.+4>>68094000
                             S1.(0:8) := 0;                    <<00.+4>>68096000
                             EXTADR := TOS;                    <<00.+4>>68098000
                             Return'Disc'Space (ldev',         <<03551>>68100000
                                 DOUBLE(flextsize),  extadr);  <<03551>>68102000
                             FLABDBL(EXT0+I) := 0D;            <<00.+4>>68104000
                             END                               <<00.+4>>68106000
                           ELSE             <<LAST EXTENT>>    <<00.+4>>68108000
                             BEGIN <<DELETE ENTRY>>            <<00.+4>>68110000
                             << Delete first extent >>         <<03551>>68112000
                             Return'Disc'Space (ldev,          <<03551>>68114000
                                d'l(ctab0(extssect'))), dtemp);<<03551>>68116000
                             GO REMOVEODEV;                    <<00.+4>>68118000
                             END;                              <<00.+4>>68120000
                           END                                 <<00.+4>>68122000
                         ELSE  << N < M >>                     <<00.+4>>68124000
                           BEGIN <<UPDATE XDD >>               <<00.+4>>68126000
                           DDEL;                               <<00.+4>>68128000
                           XDD(INDEX+NUMEXT).(0:8):=M;         <<00.+4>>68130000
                           TOS := FLEOF;                       <<00.+4>>68132000
                           XDD(INDEX+XDDEOF+1) := TOS;         <<00.+4>>68134000
                           XDD(X:=X+1) := TOS;                 <<00.+4>>68136000
                           END;                                <<00.+4>>68138000
                    CHECKSUM;                                  <<00.+4>>68140000
                    FLCHECKSUM := TOS;                         <<00.+4>>68142000
                    DISC(WRITE,LDEV,DTEMP,FLAB,128);           <<00.+4>>68144000
                    END;                                       <<00.+4>>68146000
                  XDD(INDEX).XDDSTATE := READY;                         68148000
                  LSECT := LSECT+DOUBLE((XDD(INDEX+NUMEXT).(0:8)-1)*    68150000
                          CTAB0(EXTSSECT'))+DOUBLE(XDD(INDEX+LASTEXT)); 68152000
                  END                                                   68154000
                ELSE                                                    68156000
                  BEGIN                                                 68158000
  REMOVEODEV:     REMOVEXDDSUBENTRY(INDEX);                             68160000
                  XDD(INDEX) := 0;                                      68162000
                  END;                                         <<02614>>68164000
              INDEX := INDEX+XDDSUBSIZE;                       <<02614>>68166000
              END;                                             <<02614>>68168000
            J := 2;                                                     68170000
            N := XDD(SUBAREAP)/XDDHEADSIZE;                             68172000
            WHILE (J:=J+1)<N DO                                         68174000
              BEGIN                                                     68176000
              X := XDD(J*XDDHEADSIZE).(8:8) * LDTSIZE + LDT4;  <<01743>>68178000
              LDT(X).(8:8) := J;                                        68180000
              END;                                                      68182000
            TOS := INFOD(ODDLOC)-VDSTART;                               68184000
            DELB;                                                       68186000
            TOS := TOS/NSECTPAGE;                                       68188000
            L := S0;                                                    68190000
            M := TOS+PAGES(2);                                          68192000
            DO                                                          68194000
              BEGIN                                                     68196000
              TOS := VDSMAP(L.(0:12));                                  68198000
              X := L.(12:4);                                            68200000
              ASSEMBLE(TSBC 0,X);                                       68202000
              VDSMAP(L.(0:12)) := TOS;                                  68204000
              END                                                       68206000
            UNTIL (L:=L+1)>=M;                                          68208000
            ABSENT(ODDDSTN,MAXODDTSIZE);                                68210000
            TOS := LSECT;                                               68212000
            ABSOLUTE(NUMSSECT1) := TOS;                                 68214000
            ABSOLUTE(X:=X-1) := TOS;                                    68216000
            DLSIZE(-MEMSEG);                                   <<01384>>68218000
            GO COOLST;                                                  68222000
            END  <<WARMSTART>>;                                         68224000
                                                                        68226000
                                                                        68228000
          <<------------------                                          68230000
            JOB MASTER TABLE                                            68232000
          ------------------>>                                          68234000
          MEMSEG := ROUND(JMATTSIZE);                          <<01384>>68236000
          DCOREADDR := MAM(MEMSEG);                            <<01384>>68238000
          INSERTDST(COREADDR,JMATDSTN,MEMSEG,0,BANK);          <<01440>>68240000
          SSEA(DCOREADDR+0D, MAXJMATSIZE&LSL(8)+INITJMATSIZE); <<01384>>68242000
          SSEA(DCOREADDR+1D, JMATSIZE);                        <<01384>>68244000
          SSEA(DCOREADDR+2D, JMATSIZE);                        <<01384>>68246000
        <<SSEA(DCOREADDR+DOUBLE(SCHEDHEADP), 0);>>             <<01384>>68248000
          SSEA(DCOREADDR+DOUBLE(SCHEDTAILP), SCHEDHEADP);      <<01384>>68250000
          SSEA(DCOREADDR+5D, %40001);                          <<01384>>68252000
          SSEA(DCOREADDR+6D, %100001);                         <<01384>>68254000
        <<SSEA(DCOREADDR+7D, 0);>>                             <<01384>>68256000
          SSEA(DCOREADDR+8D, CTAB(MAXRSES));                   <<01384>>68258000
          SSEA(DCOREADDR+10D, CTAB(MAXRJOB));                  <<01384>>68260000
          ABSENT(JMATDSTN,MAXJMSIZE);                                   68262000
          <<------------------------                                    68264000
            INPUT DEVICE DIRECTORY                                      68266000
          ------------------------>>                                    68268000
          MEMSEG := ROUND(IDDTSIZE);                           <<01384>>68272000
          DCOREADDR := MAM(MEMSEG);                            <<01384>>68274000
          INSERTDST(COREADDR,IDDDSTN,MEMSEG,0,BANK);           <<01440>>68276000
          SSEA(DCOREADDR+0D, MAXIDDSIZE&LSL(8)+INITIDDSIZE);   <<01384>>68278000
          SSEA(DCOREADDR+1D, XDDHEADSIZE&LSL(8)+XDDSUBSIZE);   <<01384>>68280000
          SSEA(DCOREADDR+3D, 1);                               <<01384>>68282000
          I := 0; K := 3;                                               68284000
          J := 12;                                                      68286000
          WHILE (I:=I+1) <= HLDEV DO                           <<03550>>68288000
            IF LDEV'EXISTS(I) THEN                             <<03550>>68290000
            BEGIN                                              <<03550>>68292000
            << LOOK FOR INPUT/OUTPUT ACCEPTING DEVICES >>      <<03550>>68294000
            IF LDT(I*LDTSIZE+LDT2).RANGE = CONINOUT OR         <<03550>>68296000
            LDT(I*LDTSIZE+LDT2).RANGE = NCONINOUT OR           <<03550>>68298000
            LDT(I*LDTSIZE+LDT2).RANGE = DIRACCESS AND          <<03550>>68300000
            LPDT(I*LPDTSIZE+LPDT1).NSDV = 1 THEN               <<03550>>68302000
              BEGIN  <<INPUT OR OUTPUT>>                                68304000
              LDT(I*LDTSIZE+LDT4).XDDINDEX := K;               <<03550>>68308000
              K := K + 1;                                               68310000
              SSEA(DCOREADDR+DOUBLE(J), I);                    <<01384>>68312000
              SSEA(DCOREADDR+DOUBLE(J+2), J+1);                <<01384>>68314000
              J := J+4;                                        <<01384>>68316000
              END;                                                      68318000
            END;                                                        68320000
          I := 0;                                                       68322000
          WHILE (I:=I+1) <= HLDEV DO                           <<03550>>68324000
            IF LDEV'EXISTS(I) THEN                             <<03550>>68326000
            BEGIN                                                       68328000
            << LOOK FOR INPUT-ONLY DEVICES >>                  <<03550>>68330000
            IF LDT(I*LDTSIZE+LDT2).RANGE = SERINPUT THEN       <<03550>>68332000
              BEGIN  <<INPUT ONLY>>                                     68334000
              LDT(I*LDTSIZE+LDT4).XDDINDEX := K;               <<03550>>68336000
              K := K + 1;                                               68338000
              SSEA(DCOREADDR+DOUBLE(J), I);                    <<01384>>68340000
              SSEA(DCOREADDR+DOUBLE(J+2), J+1);                <<01384>>68342000
              J := J+4;                                        <<01384>>68344000
              END;                                                      68346000
            END;                                                        68348000
          SSEA(DCOREADDR+DOUBLE(SUBAREAP), J);                 <<01384>>68350000
          ABSENT(IDDDSTN,MAXIDDTSIZE);                                  68352000
          <<---------------------------                                 68354000
            OUTPUT DEVICE DIRECTORY                                     68356000
          ------------------------->>                                   68358000
          MEMSEG := ROUND(ODDTSIZE);                           <<01384>>68360000
          DCOREADDR := MAM(MEMSEG);                            <<01384>>68362000
          INSERTDST(COREADDR,ODDDSTN,MEMSEG,0,BANK);           <<01440>>68364000
          SSEA(DCOREADDR+0D, MAXODDSIZE&LSL(8)+INITIDDSIZE);   <<01384>>68366000
          SSEA(DCOREADDR+1D, XDDHEADSIZE&LSL(8)+XDDSUBSIZE);   <<01384>>68368000
          SSEA(DCOREADDR+3D, %100001);                         <<01384>>68370000
          SSEA(DCOREADDR+4D, 1);  << OUTFENCE >>               <<01384>>68372000
          SSEA(DCOREADDR+10D, 9);                              <<01384>>68374000
          I := 0; K := 3;                                               68376000
          J := 12;                                                      68378000
          WHILE (I:=I+1) <= HLDEV DO                           <<03550>>68380000
            IF LDEV'EXISTS(I) THEN                             <<03550>>68382000
            BEGIN                                              <<03550>>68384000
            << LOOK FOR INPUT/OUTPUT ACCEPTING DEVICES >>      <<03550>>68386000
            IF LDT(I*LDTSIZE+LDT2).RANGE = CONINOUT OR         <<03550>>68388000
            LDT(I*LDTSIZE+LDT2).RANGE = NCONINOUT OR           <<03550>>68390000
            LDT(I*LDTSIZE+LDT2).RANGE = DIRACCESS AND          <<03550>>68392000
            LPDT(I*LPDTSIZE+LPDT1).NSDV = 1 THEN               <<03550>>68394000
              BEGIN   <<INPUT AND OUTPUT>>                              68396000
              <<INDEX TO HEAD ALREADY IN LDEVTAB FROM FIXUP OF IDD>>    68398000
              K := K+1;                                                 68400000
              SSEA(DCOREADDR+DOUBLE(J), I);                    <<01384>>68402000
              SSEA(DCOREADDR+DOUBLE(J+2), J+1);                <<01384>>68404000
              J := J+4;                                        <<01384>>68406000
              END;                                                      68408000
            END;                                                        68410000
          I := 0;                                                       68412000
          WHILE (I:=I+1) <= HLDEV DO                           <<03550>>68414000
            IF LDEV'EXISTS(I) THEN                             <<03550>>68416000
            BEGIN                                              <<03550>>68418000
            << LOOK FOR OUPUT-ONLY DEVICES >>                  <<03550>>68420000
            IF LDT(I*LDTSIZE+LDT2).RANGE = SEROUTPUT THEN      <<03550>>68422000
              BEGIN   <<OUTPUT ONLY>>                                   68424000
              LDT(I*LDTSIZE+LDT4).XDDINDEX := K;               <<03550>>68426000
              K := K+1;                                                 68428000
              SSEA(DCOREADDR+DOUBLE(J), I);                    <<01384>>68430000
              SSEA(DCOREADDR+DOUBLE(J+2), J+1);                <<01384>>68432000
              J := J+4;                                        <<01384>>68434000
              END;                                                      68436000
            END;                                                        68438000
          SSEA(DCOREADDR+DOUBLE(SUBAREAP), J);                 <<01384>>68440000
          ABSENT(ODDDSTN,MAXODDTSIZE);                                  68442000
          TOS := 0D;                                                    68444000
          ABSOLUTE(NUMSSECT) := TOS;                                    68446000
          ABSOLUTE(NUMSSECT1) := TOS;                                   68448000
  COOLST:                                                               68450000
          ABSOLUTE(INITINTLAB):=INTLABEL(ABSOLUTE(INITEXTLAB):=         68452000
                                PLABEL(INITNAME));                      68454000
          MOVE BINBUF:="7SPOOLIN";                                      68456000
          ABSOLUTE(SPOOLININTLAB):=INTLABEL(ABSOLUTE(SPOOLINEXTLAB)     68458000
                                             :=PLABEL(BINBUF));         68460000
          MOVE BINBUF:="8SPOOLOUT";                                     68462000
          ABSOLUTE(SPOOLOUTINTLAB):=INTLABEL(ABSOLUTE(SPOOLOUTEXTLAB)   68464000
                                             :=PLABEL(BINBUF));         68466000
      MOVE BINBUF:="6RECLOG";                                  <<00506>>68468000
      ABSOLUTE(RECLOGDELTAP):=INTLABEL(ABSOLUTE(RECLOGPLABEL)  <<00506>>68470000
                                       :=PLABEL(BINBUF));      <<00506>>68472000
      MOVE BINBUF:="8ULOGPROC";                                <<00506>>68474000
      ABSOLUTE(ULOGDELTAP):=INTLABEL(ABSOLUTE(ULOGPLABEL)      <<00506>>68476000
                                        :=PLABEL(BINBUF));     <<00506>>68478000
      MOVE BINBUF:="7RESTART";                                 <<00506>>68480000
      ABSOLUTE(ULOGRSTARTDELTAP):=INTLABEL(ABSOLUTE(ULOGRSTARTPLABEL)   68482000
                                        :=PLABEL(BINBUF));     <<00506>>68484000
          <<--------------------------------                            68486000
            FILE MULTI-ACCESS VECTOR TABLE                              68488000
          -------------------------------->>                            68490000
          DCOREADDR := MAM(128);                               <<01384>>68492000
          INSERTDST(COREADDR,FMAVTDSTN,128,0,BANK);            <<01440>>68494000
          SSEA(DCOREADDR+0D, 128);                             <<01384>>68496000
          SSEA(DCOREADDR+1D, 4);                               <<01384>>68498000
          SSEA(DCOREADDR + 2D, 2048);                          <<04548>>68500000
        <<SSEA(DCOREADDR+3D, 0);>>                             <<01384>>68502000
          ABSENT(FMAVTDSTN,2048);                              <<04548>>68504000
                                                                        68506000
          X := JMATDSTN&LSL(2)+2;                                       68508000
          TOS := DST(X).(8:8);  << HIGH ORDER ADDR >>          <<01756>>68510000
          TOS := DST(X:=X+1);                                           68512000
          INFOD(JMATLOC) := TOS;                                        68514000
          X := IDDDSTN&LSL(2)+2;                                        68516000
          TOS := DST(X).(8:8);  << HIGH ORDER ADDR >>          <<01756>>68518000
          TOS := DST(X:=X+1);                                           68520000
          TOS := DST(X:=X+3).(8:8);  << HIGH ORDER ADDR >>     <<01756>>68522000
          TOS := DST(X:=X+1);                                           68524000
          INFOD(ODDLOC) := TOS;                                         68526000
          INFOD(IDDLOC) := TOS;                                         68528000
          TOS := DCTAB0(KILOSECTS);                                     68530000
          X := ONEK;                                                    68532000
          ASSEMBLE(LDXA,LMPY;CAB,LDXA;MPY,ZERO;DADD);                   68534000
               <<MULTIPLY A INTEGER BY A DOUBLE>>                       68536000
          ABSOLUTE(MAXSSECT1) := TOS;                                   68538000
          ABSOLUTE(MAXSSECT) := TOS;                                    68540000
          ABSOLUTE(EXTSSECT) := CTAB0(EXTSSECT');                       68542000
          <<-------------                                               68544000
            WELCOME MESSAGE                                             68546000
          --------------->>                                             68548000
          MEMSEG := ROUND(LOGONDSTSIZE);                       <<01384>>68550000
          DCOREADDR := MAM(MEMSEG);                            <<01384>>68552000
          IF LOGONLOC = 0 THEN                                          68554000
            BEGIN                                                       68556000
            INSERTDST(COREADDR,LOGONDSTN1,MEMSEG,0,BANK);      <<01440>>68558000
            INSERTDST(COREADDR,LOGONDSTN2,MEMSEG,0,BANK);      <<01440>>68560000
          <<SSEA(DCOREADDR, 0);>>                              <<01384>>68562000
            SSEA(DCOREADDR+1D, MEMSEG);  << LENGTH >>          <<01489>>68564000
            ABSENT(LOGONDSTN1,LOGONDSTSIZE);                            68566000
            ABSENT(LOGONDSTN2,LOGONDSTSIZE);                            68568000
            END                                                         68570000
          ELSE                                                          68572000
            BEGIN                                                       68574000
            IF LOGONLOC=LOGONLOC1 THEN                                  68576000
              BEGIN                                                     68578000
              INSERTDST(COREADDR,LOGONDSTN2,MEMSEG,0,BANK);    <<01440>>68580000
            <<SSEA(DCOREADDR, 0);>>                            <<01384>>68582000
              SSEA(DCOREADDR+1D, MEMSEG);  << LENGTH >>        <<01489>>68584000
              ABSENT(LOGONDSTN2,LOGONDSTSIZE);                          68586000
              END                                                       68588000
            ELSE                                                        68590000
              BEGIN                                                     68592000
              INSERTDST(COREADDR,LOGONDSTN1,MEMSEG,0,BANK);    <<01440>>68594000
            <<SSEA(DCOREADDR, 0);>>                            <<01384>>68596000
              SSEA(DCOREADDR+1D, MEMSEG);  << LENGTH >>        <<01489>>68598000
              ABSENT(LOGONDSTN1,LOGONDSTSIZE);                          68600000
              END;                                                      68602000
            TOS := INFOD(LOGONLOC)-VDSTART;                             68604000
            DELB;                                                       68606000
            TOS := TOS/NSECTPAGE;                                       68608000
            L := S0;                                                    68610000
            M := TOS+WELMESPAGES;                                       68612000
            DO                                                          68614000
              BEGIN                                                     68616000
              TOS := VDSMAP(L.(0:12));                                  68618000
              X := L.(12:4);                                            68620000
              ASSEMBLE(TSBC 0,X);                                       68622000
              VDSMAP(L.(0:12)) := TOS;                                  68624000
              END                                                       68626000
            UNTIL (L:=L+1)>=M;                                          68628000
            DISC(READ,SYSDISC,INFOD(LOGONLOC),LBUF,2);                  68630000
            IF LOGICAL(LOGONLOC) THEN I:=LOGONDSTN2 ELSE                68632000
              I := LOGONDSTN1;                                          68634000
            INSERTDST(COREADDR,I,LBUF(1),0,BANK);              <<01440>>68636000
            DISC'(READ,SYSDISC,INFOD(LOGONLOC),                         68638000
              DCOREADDR,LOGONDSTSIZE);                         <<01384>>68640000
            LOGONLOC := I;                                              68642000
            SSEA(DCOREADDR, %100000);                          <<01384>>68644000
            ABSENT(LOGONLOC,LOGONDSTSIZE);                              68646000
            END;                                                        68648000
          ABSOLUTE(DSTLOGON) := LOGONLOC;                               68650000
          X := LOGONDSTN1&LSL(2)+2;                                     68652000
          TOS:=DST(X);                                         <<MPEIV>>68654000
          TOS := DST(X:=X+1);                                           68656000
          TOS:=DST(X:=X+3);                                    <<MPEIV>>68658000
          TOS := DST(X:=X+1);                                           68660000
          INFOD(LOGONLOC2) := TOS;                                      68662000
          INFOD(X:=X-1) := TOS;                                         68664000
          INFO(LOADMODE) := 0;                                          68666000
          DISC(WRITE,SYSDISC,D'L(INFOSECTOR)),INFO,INFOSIZE);           68668000
          <<--------------->>                                  <<0+.04>>68670000
          <<C.I. LOG ON DST>>                                  <<0+.04>>68672000
          <<--------------->>                                  <<0+.04>>68674000
          DCOREADDR := MAM(4*128);                             <<01384>>68676000
          INSERTDST(COREADDR,CILOGDSTN,4*128,0,BANK);          <<01440>>68678000
          TEMP := (CTAB(MAXRSES)+3)&LSR(2)&LSL(2);             <<0+.04>>68680000
          SSEA(DCOREADDR+0D, TEMP&LSL(8)+4);  <<MAX&CUR SIZE>> <<01384>>68682000
          SSEA(DCOREADDR+1D, 128);   <<ENTRY SIZE>>            <<01384>>68684000
        <<SSEA(DCOREADDR+2D, 0);>>                             <<01384>>68686000
        <<SSEA(DCOREADDR+3D, 0);>>                             <<01384>>68688000
          ABSENT(CILOGDSTN,TEMP&LSL(7));                                68690000
                                                                        68692000
          <<TAPE LABEL TABLE>>                                 <<TL.02>>68694000
          BUILD'TAPE'LABEL'TABLE;                              <<03580>>68698000
                                                               <<TL.02>>68700000
          <<----------------------                                      68702000
            LOGICAL DEVICE TABLE                                        68704000
          ---------------------->>                                      68706000
          DST(LDTDSTN&LSL(2)) := ((HLDEV+1)*(LDTSIZE+LDTXSIZE) <<00.06>>68708000
            +DVCLSIZE&LSR(1)+3)&LSR(2);                        <<00.06>>68710000
          PUSH(DB);                                                     68712000
          TOS := TOS+@LDT;                                              68714000
          DST(X:=X+3) := TOS;                                           68716000
          DST(X:=X-1) := TOS;                                           68718000
          ABSENT(LDTDSTN,-1);                                           68720000
                                                                        68722000
          <<--------------                                              68724000
            VOLUME TABLE                                                68726000
          -------------->>                                              68728000
          DST(VTABDSTN&LSL(2)) := ((MVOL+1)*VTABSIZE+3)&LSR(2);<<RH.PV>>68730000
          PUSH(DB);                                                     68732000
          TOS := TOS+@VTAB;                                             68734000
          DST(X:=X+3) := TOS;                                           68736000
          DST(X:=X-1) := TOS;                                           68738000
          ABSENT(VTABDSTN,-1);                                          68740000
                                                                        68742000
                                                               <<00552>>68744000
<< ASSOCIATION TABLE >>                                        <<00552>>68746000
                                                               <<00552>>68748000
          MEMSEG := ROUND((HLDEV+1)*ASS'SIZE);                 <<01384>>68750000
          DCOREADDR := MAM(MEMSEG);                            <<01384>>68752000
          INSERTDST(COREADDR,ASS'DST,MEMSEG,0,BANK);           <<01440>>68754000
          ABSENT(ASS'DST,-1);                                <<OP.01>>  68756000
                                                                        68758000
          <<--------------------                                 RH.PV  68760000
            MOUNTED VOLUME TABLE                                 RH.PV  68762000
            -------------------->>                             <<RH.PV>>68764000
          MEMSEG := ROUND(MVTABTSIZE);                         <<01384>>68766000
          DCOREADDR := MAM(MEMSEG);                            <<01384>>68768000
          INSERTDST(COREADDR, MVTABDSTN, MEMSEG, 0, BANK);     <<01440>>68770000
          SSEA(DCOREADDR+0D, MVTABSIZE&LSL(8)+MVTABMAX);       <<01384>>68772000
        <<SSEA(DCOREADDR+1D, 0);>>                             <<01384>>68774000
          DIRDISCADDR1.(0:8) := SYSDISC;                       <<01384>>68776000
          SSEA(DCOREADDR+2D, DIRDISCADDR1);  << HODA >>        <<01384>>68778000
          SSEA(DCOREADDR+3D, DIRDISCADDR2);  << LODA >>        <<01384>>68780000
          ABSENT (MVTABDSTN,MVTABTSIZE);                                68782000
                                                               <<RV.PV>>68784000
          <<-------------------------                            RH.PV  68786000
            PRIVATE VOLUME USER TABLE                            RH.PV  68788000
            ------------------------->>                        <<RH.PV>>68790000
          MEMSEG := ROUND(PVUSERTSIZE);                        <<01384>>68792000
          DCOREADDR := MAM(MEMSEG);                            <<01384>>68794000
          INSERTDST(COREADDR,PVUSERDSTN,MEMSEG,0,BANK);        <<01440>>68796000
          SSEA(DCOREADDR+0D, PVUSERTSIZE);                     <<01384>>68798000
          << TABLE (1) := TABLE (2) := 0; >>                   <<01439>>68800000
          SSEA(DCOREADDR+3D, MAXPVUSERTSIZE);                  <<01439>>68802000
          SSEA(DCOREADDR+4D, 5);  << FIRST AVAILABLE WORD >>   <<01384>>68804000
          ABSENT(PVUSERDSTN, MAXPVUSERTSIZE);                  <<01439>>68806000
          <<------------------>>                               <<MPEIV>>68808000
          << BREAKPOINT TABLE >>                               <<MPEIV>>68810000
          <<------------------>>                               <<MPEIV>>68812000
                                                               <<MPEIV>>68814000
                                                               <<MPEIV>>68816000
          << GET SIZE OF TWO TABLES IN BREAKPOINT DST >>       <<MPEIV>>68818000
          STOP'TABSIZE := ROUND((CTAB(STOPNUM)+1)*MAXSTOPSIZE);<<MPEIV>>68820000
          << PCB EXT. TABLE SIZE = MIN OF # OF PCB'S AND >>    <<MPEIV>>68822000
          << MAXIMUM NUMBER OF ENTRIES                   >>    <<MPEIV>>68824000
          STOP'PCB'EXTSIZE :=                                  <<MPEIV>>68826000
             IF CTAB(PCBNUM) <= STOP'TABSIZE/MINSTOPSIZE       <<MPEIV>>68828000
             THEN CTAB(PCBNUM)                                 <<MPEIV>>68830000
             ELSE STOP'TABSIZE/MINSTOPSIZE;                    <<MPEIV>>68832000
          STOP'PCB'EXTSIZE:=ROUND(STOP'PCB'EXTSIZE);<<M>>      <<MPEIV>>68834000
          STOP'DSTSIZE := STOP'PCB'EXTSIZE+STOP'TABSIZE;       <<MPEIV>>68836000
                                                               <<MPEIV>>68838000
          MEMSEG := STOP'DSTSIZE;                              <<MPEIV>>68840000
          DLSIZE(MEMSEG);                                      <<MPEIV>>68842000
          PUSH(DL);                                            <<MPEIV>>68844000
          @TABLE := TOS;                                       <<MPEIV>>68846000
          PUSH(DB);                                            <<MPEIV>>68848000
          TOS := @TABLE;                                       <<MPEIV>>68850000
          ASSEMBLE(ADD);  << ABSOLUTE ADDRESS OF TABLE >>      <<MPEIV>>68852000
          DCOREADDR := TOS;                                    <<MPEIV>>68854000
          INSERTDST (COREADDR,STOPDSTN,MEMSEG,0,BANK);         <<MPEIV>>68856000
                                                               <<MPEIV>>68858000
          ABSOLUTE(SYSSTOPS) := 0;  << MARK TABLE UNLOCKED >>  <<MPEIV>>68860000
          << ENTRY(0) OF PCB EXT. TABLE >>                     <<MPEIV>>68862000
          TABLE(0) := STOP'PCB'EXTSIZE;                        <<MPEIV>>68864000
                                                               <<MPEIV>>68866000
          << ENTRY(0) OF BREAKPOINT TABLE >>                   <<MPEIV>>68868000
          TABLE(STOP'ENT0'X) := STOP'TABSIZE;                  <<MPEIV>>68870000
          << HEAD FREE LIST >>                                 <<MPEIV>>68872000
          TABLE(STOP'ENT0'X+1) := STOP'ENT0'X+MINSTOPSIZE;     <<MPEIV>>68874000
                                                               <<MPEIV>>68876000
          << ENTRY(1) OF BREAKPOINT TABLE             >>       <<MPEIV>>68878000
          << FREE ENTRY - REST OF TABLE (LESS 1 WORD) >>       <<MPEIV>>68880000
          TABLE(STOP'ENT1'X) := STOP'DSTSIZE-STOP'ENT1'X-1;    <<MPEIV>>68882000
          TABLE(STOP'ENT1'X).(0:1) := 1;      <<MARK FREE    >><<MPEIV>>68884000
          TABLE(STOP'ENT1'X+1) := STOP'ENT1'X;<<FORWARD LINK >><<MPEIV>>68886000
          TABLE(STOP'ENT1'X+2) := STOP'ENT1'X;<<BACKWARD LINK>><<MPEIV>>68888000
          << LAST WORD OF TABLE >>                             <<MPEIV>>68890000
          TABLE(STOP'DSTSIZE-1) := 1; << MARK USED ENTRY >>    <<MPEIV>>68892000
                                                               <<MPEIV>>68894000
          ABSENT (STOPDSTN,-1);                                <<MPEIV>>68896000
          DLSIZE(-MEMSEG);                                     <<MPEIV>>68898000
                                                               <<MPEIV>>68900000
                                                               <<RH.PV>>68902000
          <<-------------------------                                   68904000
            LOG BUFFERS AND PROCESS                                     68906000
          ------------------------->>                                   68908000
              MEMSEG := ROUND(CTAB0(LOGRECSIZE)*128);          <<01384>>68912000
              DCOREADDR := MAM(MEMSEG);                        <<01384>>68914000
              INSERTDST(COREADDR,LOG1DSTN,MEMSEG,0,BANK);      <<01384>>68916000
              ABSENT(LOG1DSTN,-1);                                      68918000
              INSERTDST(COREADDR,LOG2DSTN,MEMSEG,0,BANK);      <<01384>>68920000
              ABSENT(LOG2DSTN,-1);                                      68922000
              ABSOLUTE(LOGSTOP) := CREATE(LOGFILE,LOGPROC,LOGPRI,       68924000
                LOGSTACK,FATHERWAIT,4,0,1,2,0)&LSL(8)+LOGSBIT;          68926000
              ABSOLUTE(X:=X+1) := %20;                                  68928000
<<set LOG event masks - 3 words>>                              <<01767>>68930000
              ABSOLUTE(LOGBITS')  := CTAB0(LOGBITS);           <<01767>>68932000
              ABSOLUTE(LOGBITS'+1):= CTAB0(LOGBITS+1);         <<01767>>68934000
              ABSOLUTE(LOGBITS'+2):= CTAB0(LOGBITS+2);         <<01767>>68936000
              TOS := LOG1DSTN;                                          68938000
              TOS.(5:1) := 1;                                           68940000
              ABSOLUTE(LOGBUF1) := TOS;                                 68942000
              ABSOLUTE(LOGBUF2) := LOG2DSTN;                            68944000
              ABSOLUTE(LOGRECSIZE') := CTAB0(LOGRECSIZE);               68946000
              ABSOLUTE(LOGFILESIZE') := CTAB0(LOGFILESIZE);             68948000
           <<----------------                                           68952000
             CREATE MEMLOGP                                             68954000
           ----------------->>                                          68956000
           ABSOLUTE(MEMLGSTOP):=CREATE(MEMLGFILE,MEMLGPROC,MEMLGPRI,    68958000
                                MEMLGSTACK,FATHERWAIT,4,0,1,2,0)&LSL(8)+68960000
                                MEMLGSBIT;                              68962000
           ABSOLUTE(X:=X+1):=%20;                                       68964000
           <<-------------------------------                     RH.PV  68966000
             CREATE PV RECOGNITION PROCESS                       RH.PV  68968000
           ------------------------------->>                   <<RH.PV>>68970000
           CREATE (PVPROCFILE,%222,PVPRI,PVSTACK,FATHERWAIT,   <<RH.PV>>68972000
                  4,0,1,2,0);                                  <<RH.PV>>68974000
                                                                        68976000
$PAGE "MAINSEG4  --  FINISH UP"                                         68978000
                                                                        68980000
          <<-------------                                               68982000
            CREATE UCOP                                                 68984000
          ------------->>                                               68986000
          ABSOLUTE(UCOPSTOP) := CREATE(UCOPFILE,UCOPPROC,UCOPPRI,       68988000
            UCOPSTACK,FATHERWAIT,4,0,1,2,0)&LSL(8)+UCOPSBIT;            68990000
          ABSOLUTE(X:=X+1) := %20;                                      68992000
                                                                        68994000
          <<-----------------------------------                         68996000
            CREATE POWER FAIL RESTART PROCESS                           68998000
          ----------------------------------->>                         69000000
          CREATE(PFAILFILE,PFAILPROC,PFAILPRI,PFAILSTACK,               69002000
                 JUNKWAIT,4,0,1,2,0);                                   69004000
          <<-----------------------------------                         69006000
            CREATE DEVICE RECOGNITION PROCESS                           69008000
          ----------------------------------->>                         69010000
          ABSOLUTE(DEVRECSTOP) := CREATE(DEVRECFILE,DEVRECPROC,         69012000
             DEVRECPRI,DEVRECSTACK,JUNKWAIT,4,0,1,2,0)&LSL(8)           69014000
             +DEVRECSBIT;                                               69016000
          ABSOLUTE(X:=X+1) := %20;                                      69018000
                                                                        69020000
          <<---------------------                                       69022000
            CREATE LOAD PROCESS                                         69024000
          --------------------->>                                       69026000
          CREATE(LOADFILE,LOADPROC,LOADPRI,LOADSTACK,                   69028000
            JUNKWAIT,4,0,1,2,0);                                        69030000
                                                                        69032000
                                                                        69034000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>69036000
          <<-------------------------------------->>           <<00888>>69038000
          <<SET PI AND DBI FOR NON-CONFIGURED DRTS>>           <<00888>>69040000
          <<-------------------------------------->>           <<00888>>69042000
          DRTN:=LOWESTDRT;                                     <<03603>>69044000
          DO                                                   <<00888>>69046000
             BEGIN <<REPEAT FOR ALL DRTS>>                     <<00888>>69048000
             IF INTHS'UNITS(DRTN).NUNIT=0 AND                  <<00888>>69050000
             GETDRT(DRTN,PI)=0 THEN                            <<03002>>69052000
                BEGIN <<DRT NOT CONFIGURED>>                   <<00888>>69054000
                PUTDRT(DRTN,PI,GHOSTEXTLAB);                   <<03002>>69056000
                PUTDRT(DRTN,DBI,TEMP'CPVA);                    <<03002>>69058000
                END;                                           <<00888>>69060000
             END                                               <<00888>>69062000
          UNTIL (DRTN := DRTN+1) > HIDRT;                      <<02707>>69064000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>69066000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>69068000
          <<--------------------------------------                      69070000
            BRING IN I/O INITIALIZATION SEGMENTS                        69072000
          -------------------------------------->>                      69074000
          K := 1; <<INDEX FOR DS DEVICES>>                              69076000
          DRTN := 3;                                                    69078000
          DO IF INTHS'UNITS(DRTN).NUNIT <> 0 THEN                       69080000
            BEGIN  <<FOUND A REAL DRT>>                                 69082000
              N := INTHS'UNITS(DRTN).NINTH; << #  INT. HNDLRS>><<01478>>69084000
             ABSOLUTE(ILTPTR)                                  <<01478>>69086000
               := GETDRT(DRTN,DBI) - SYSBASE;                  <<03002>>69088000
              I := 0;                                                   69090000
              WHILE (I:=I+1)<N DO                                       69092000
                BEGIN  <<HOOK UP CONSECUTIVE DRTS TO THIS ILT>>         69094000
                  IF DRTN+I > HIDRT OR                         <<02707>>69096000
                     INTHS'UNITS(DRTN+I)<>0 THEN               <<01478>>69098000
                    BEGIN  <<REACHED LIMIT FOR THIS DRT>>               69100000
                      N := I;                                           69102000
                      GOTO DONEILT;                                     69104000
                    END;                                                69106000
                  TEMP := ABSOLUTE(ILTPTR)+SYSBASE;            <<03002>>69108000
                  PUTDRT(DRTN+I,DBI,TEMP);                     <<03002>>69110000
                END;                                                    69112000
  DONEILT:    IF GETDRT(DRTN,PI) = 0 THEN                      <<03002>>69114000
                BEGIN  <<NO PRIMARY HANDLER SPECIFIED>>                 69116000
                  I := 0;                                               69118000
                  DO PUTDRT(DRTN+I,PI,PLABEL(GIPNAME))         <<03002>>69120000
                  UNTIL (I:=I+1)=N;                                     69122000
                END;                                                    69124000
            END                                                         69126000
            ELSE IF GETDRT(DRTN,PI) = 0 THEN                   <<03002>>69128000
                   BEGIN <<PUT GHOST PLABEL IN PI>>                     69130000
                    PUTDRT(DRTN,PI,GHOSTEXTLAB);               <<03002>>69132000
                    PUTDRT(DRTN,DBI,TEMP'CPVA);                <<03603>>69134000
                   END                                                  69136000
          UNTIL (DRTN := DRTN+1) > HIDRT;                      <<02707>>69138000
                                                                        69140000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>69142000
          <<---------------------------                                 69144000
            CREATE PROGENITOR PROCESS                                   69146000
          --------------------------->>                                 69148000
          CREATE(PROGFILE,PROGPROC,PROGPRI,PROGSTACK,ACTIVE,            69150000
          4,0,0,2,0);                                          <<MPEIV>>69152000
                                                                        69154000
          <<---------------------------->>                     <<00.DL>>69156000
          <<WRITE LOADMAP & UPDATE LABEL>>                     <<00.DL>>69158000
          <<---------------------------->>                     <<00.DL>>69160000
                                                                        69162000
          I:=-128;                                             <<00.DL>>69164000
          DTEMP:=2D;                                           <<00.DL>>69166000
          DO                                                   <<00.DL>>69168000
            FWRITE(LDMAPFNUM,DTEMP,LDMAPBUF(I:=I+128),128)     <<00.DL>>69170000
          UNTIL (DTEMP:=DTEMP+1D)>26D;                         <<00.DL>>69172000
            DISC(READ,SYSDISC,LOADMAPADR,FLAB,128);                     69174000
            CHECKSUM;                                                   69176000
            FLCHECKSUM := TOS;                                          69178000
            DISC(WRITE,SYSDISC,LOADMAPADR,FLAB,128);                    69180000
                                                                        69182000
          <<-----------------------                                     69184000
            DIRECTORY SPACE TABLE                                       69186000
          ----------------------->>                                     69188000
          ABSENT(DIRDSTN,-1);                                           69190000
          ABSENT (DIRSPDSTN,-1);                               <<RV.PV>>69192000
                                                                        69194000
          <<-----------------------------                               69196000
            WRITE SEGMENT TABLE TO DISK                                 69198000
          ----------------------------->>                               69200000
          MOVE SEGT(SEGTLEN+639) := SEGT(SEGTLEN-1),(-SEGDIRLEN);       69202000
          DST(SEGTDSTN&LSL(2)) := (SEGTLEN+643)&LSR(2);                 69204000
          PUSH(DB);                                                     69206000
          TOS := TOS+@SEGT;                                             69208000
          DST(X:=X+3) := TOS;                                           69210000
          DST(X:=X-1) := TOS;                                           69212000
          ABSENT(SEGTDSTN,SEGTABMAX);                                   69214000
                                                                        69216000
          IF CHANGES OR LOADFROMTAPE THEN                      <<01299>>69218000
            BEGIN                                              <<01299>>69220000
            MESSAGE(M2452, BANK0);                             <<01299>>69222000
            END;                                               <<01299>>69224000
                                                               <<03553>>69226000
  << WARNING!  INITIAL SHOULD NOT PERFOM ANY I/O         >>    <<03553>>69228000
  << OPERATIONS AFTER THIS POINT, BECAUSE BE ARE ABOUT   >>    <<03553>>69230000
  << TO INITIALIZE THE I/O HARDWARE.  THIS INCLUDES NOT  >>    <<03553>>69232000
  << MAKING A CALL TO A PROCEDURE WHICH IS NOT RESIDENT  >>    <<03553>>69234000
  << AND WOULD THUS CAUSE A SWAP.                        >>    <<03553>>69236000
                                                               <<02510>>69238000
          << -------------- >>                                 <<02510>>69240000
          << SETUP STARFISH >>                                 <<02510>>69242000
          << -------------- >>                                 <<02510>>69244000
                                                               <<02510>>69246000
          RESETSTARFISH;                                       <<02510>>69248000
          <<INITIALIZE DST REL INDEX OF LAST ALLOCATED>>       <<WH.20>>69252000
          <<SYSTEM DST AND CST                        >>       <<WH.20>>69254000
          ABSOLUTE(MAXSYSDST):=DST(3)-4;                       <<WH.20>>69256000
          ABSOLUTE(MAXSYSCST):=CST(3)-4+CTAB(DSTNUM)&LSL(2);   <<WH.20>>69258000
          ASSEMBLE(RSW);                                       <<00888>>69260000
          IF TOS.(8:8) <> CLRSW THEN ASSEMBLE(HALT 14);        <<02510>>69262000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>69264000
          TOS := CONSOLEDRT;                                            69266000
          TOS := %100000;  <<MASTER CLEAR>>                             69268000
          ASSEMBLE(CIO 1; BL*-1; DEL);  <<SHUT OFF INTERRUPTS AND ECHO>>69270000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>69272000
   <<  FIND OUT WHAT IMB'S EXIST               >>              <<03002>>69276000
   <<  RMSK RETURNS ZERO IF IMB DOESN'T EXIST  >>              <<03002>>69278000
                                                               <<03002>>69280000
   NRIMB := IF ICF55 THEN 3 ELSE 0;                            <<03002>>69282000
   TOS := -1D;                                                 <<03002>>69284000
   TOS := -1D;                                                 <<03002>>69286000
   ASSEMBLE( SMSK;                                             <<03002>>69288000
             RMSK );  << IMB 0 = S-0, IMB 3 = S-3 >>           <<03002>>69290000
   X := 0;                                                     <<03002>>69292000
   DO BEGIN                                                    <<03002>>69294000
      IMB(X) := TOS;                                           <<03002>>69296000
      X := X+1;                                                <<03002>>69298000
      END UNTIL X > NRIMB;                                     <<03002>>69300000
                                                               <<03002>>69302000
   <<  DO A ROLL CALL ON ALL IMB'S THAT EXIST  >>              <<03002>>69304000
                                                               <<03002>>69306000
   X := 0;                                                     <<03002>>69308000
   DO BEGIN                                                    <<03002>>69310000
      IF IMB(X) <> 0 THEN  << IMB EXISTS? >>                   <<03002>>69312000
         BEGIN                                                 <<03002>>69314000
         IF ICF55 THEN                                         <<03002>>69316000
            BEGIN                                              <<03002>>69318000
            TOS := X&LSL(7);  << FORM IMB NR. >>               <<03002>>69320000
            TOS := %120000;   << ROLL CALL    >>               <<03002>>69322000
            ASSEMBLE( RIOA );                                  <<03002>>69324000
            END                                                <<03002>>69326000
         ELSE                                                  <<03002>>69328000
            BEGIN                                              <<03002>>69330000
            TOS := %120000;   << ROLL CALL    >>               <<03002>>69332000
            ASSEMBLE( RIOC );                                  <<03002>>69334000
            END;                                               <<03002>>69336000
         IMB(X) := TOS; <<REPLACE MASK WITH ROLL CALL>>        <<03002>>69338000
         END;                                                  <<03002>>69340000
      X := X+1;                                                <<03002>>69342000
      END UNTIL X > NRIMB;                                     <<03002>>69344000
                                                               <<03002>>69346000
   <<  INITIALIZE ALL CONFIGURED GICS  >>                      <<03002>>69348000
                                                               <<03002>>69350000
   I := HIDRT.(7:6); << DELETE DEV# >>                         <<03022>>69352000
   DO BEGIN                                                    <<03002>>69354000
      TOS := IMB(I.(10:2));  << IMB NR. >>                     <<03002>>69356000
      X := I.(12:4);         << CHAN NR. >>                    <<03002>>69358000
      ASSEMBLE( TBC 0,X );                                     <<03002>>69360000
      IF <> THEN                                               <<03002>>69362000
         BEGIN                                                 <<03002>>69364000
         TOS := I&LSL(3);    << ADD DEV NR. >>                 <<03002>>69366000
         ASSEMBLE( INIT );                                     <<03002>>69368000
         END;                                                  <<03002>>69370000
      DEL;                                                     <<03002>>69372000
      I := I-1;                                                <<03002>>69374000
      END UNTIL =;                                             <<03002>>69376000
                                                               <<03002>>69378000
          TOS := 0D;                                           <<03002>>69380000
          TOS := 0D;                                           <<03002>>69382000
          ASSEMBLE (SMSK);    <<CLEAR MASK>>                   <<03002>>69384000
          I := LOWESTDRT;                                      <<00888>>69386000
          DO IF GETDRT(I,DBI) <> 0 THEN                        <<03002>>69388000
             ABSOLUTE( GETDRT(I,DBI) ) := 0                    <<03002>>69390000
             << CLEAR CPVA 0 IN CASE INITIAL'S DRIVERS CHANGED IT >>    69392000
          UNTIL (I:=I+1) > HIDRT;                              <<02707>>69394000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>69396000
          IF CS80'LOCK THEN                                    <<04546>>69398000
            UNLOCK'CS80;                                       <<04546>>69400000
          ABSOLUTE(SYSLPDT) := LPDTBASE;  <<WRITE OVER TEMP PTRS>>      69404000
          ABSOLUTE(SYSBASE) := 0;         <<SYSGLOB PNTR>>     <<03603>>69406000
          ABSOLUTE(SYSSIR) := SIRBASE;                                  69408000
          ABSOLUTE(SYSMONBUF) := MONBUFBASE;                            69410000
          ABSOLUTE(DLTPTR) := 0;                               <<0+.04>>69412000
          ABSOLUTE(CPCB):=0;                                   <<MPEIV>>69418000
$IF X1=ON <<SERIES 33 UNIQUE>>                                 <<MPEIV>>69420000
          ABSOLUTE(CPCB):=-1;<<SIGNAL TO INIT LDEV1>>          <<MPEIV>>69422000
$IF                                                            <<MPEIV>>69424000
                                                               <<03553>>69430000
  << WARNING!!   NO EXTERNAL PCAL'S OR I/O OPERATIONS    >>    <<03553>>69432000
  <<    SHOULD BE PERFORMED AFTER THIS POINT, BECAUSE    >>    <<03553>>69434000
  <<    INITIAL'S CST TABLE AND ITS CHANNEL PROGRAM      >>    <<03553>>69436000
  <<    BUFFERS MAY BE WIPED OUT BY INITMEMORYLISTS.     >>    <<03553>>69438000
  <<    INITMEMORYLISTS MUST BE IN THE SAME SEGMENT      >>    <<03553>>69440000
  <<    AS THE CALL TO IT.                               >>    <<03553>>69442000
  <<    ALSO, IMMEDIATELY AFTER THIS WE CHANGE THE CST   >>    <<03553>>69444000
  <<    POINTER TO POINT TO THE SYSTEM'S CST.            >>    <<03553>>69446000
                                                               <<03553>>69448000
          TOS := 0;                << SET UP THE AVAILABLE >>  <<03553>>69450000
          TOS := SYSBASE;          <<    REGION LISTS      >>  <<03553>>69452000
          ASSEMBLE(XCHD; DDUP);                                <<03553>>69454000
          INITMEMORYLISTS(*);                                  <<03553>>69456000
          ASSEMBLE(XCHD; DDEL);                                <<03553>>69458000
                                                               <<03553>>69460000
          ABSOLUTE(CSTP) := ABSOLUTE(SYSCST)+  << SWITCH TO >> <<03553>>69462000
                            SYSBASE;        << SYSTEM'S CST >> <<03553>>69464000
                                                               <<03553>>69466000
          ASSEMBLE(DISP);                                      <<MPEIV>>69468000
      END <<MAINSEG4>> ;                                                69470000
$PAGE "MAIN PROGRAM"                                                    69472000
$CONTROL SEGMENT=BOOTSTRAP                                              69474000
  DISCBOOT:                                                             69476000
          LASTLOADMODE:=X; <<FROM INFOTABLE--SEE BOOTSTRAP>>   <<00888>>69478000
          LOADFROMTAPE := FALSE;                                        69480000
  TAPELOAD:                                                             69482000
          PUSH(DB,Z,Q,S);                                               69484000
          DBVALUE := TOS;                                               69486000
          DEL;                                                          69488000
          ZVALUE := TOS;                                                69490000
          QVALUE := TOS;                                                69492000
          SVALUE := TOS;                                                69494000
          MAINSEG1;                                            <<03603>>69496000
          MAINSEG1A;                                           <<03603>>69498000
          MAINSEG1B;                                           <<01683>>69500000
          MAINSEG2;                                                     69502000
          MAINSEG3;                                                     69504000
          MAINSEG4;                                                     69506000
END. << PROGRAM "INITIAL" >>                                   <<03603>>69508000
