$CONTROL USLINIT,MAP,CODE,DEFINE,LIST                          <<03635>>00004000
<< INITIAL -- MODULE 00 >>                                     <<00873>>00006000
<< HP32002C MPE SOURCE C.00.00 >>                                       00008000
$SET X1=ON                                                    <<4951>>  00010000
<< COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980.           >>  00012000
<<     THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A       >>  00014000
<<     TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR     >>  00016000
<<     STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION >>  00018000
<<     OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED   >>  00020000
<<     WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.>>  00022000
<< **** Note - Dollar Copyright cannot be used with this module *** >>  00024000
$TP                                                            <<00888>>00026000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>00028000
$CONTROL MAIN=INITIAL'II'III,PRIVILEGED                        <<00888>>00030000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>00032000
$CONTROL MAIN=INITIAL'33,PRIVILEGED                            <<00888>>00034000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>00036000
<<----------------------------------------------------------------------00038000
             M P E   I N I T I A L I Z A T I O N   P R O G R A M        00040000
---------------------------------------------------------------------->>00042000
COMMENT   INITIAL PROGRAM CST MAP                              <<03002>>00044000
                                                               <<03002>>00046000
LOGICAL     PHYSICAL     SEGMENT NAME                          <<03002>>00048000
CST         CST                                                <<03002>>00050000
=======     ========     ============                          <<03002>>00052000
                                                               <<03002>>00054000
   0           1           ININ         (CORE RESIDENT)        <<03603>>00056000
   1           2           BOOTSTRAP    (CORE RESIDENT)        <<03603>>00058000
   2           3           RESIDENT     (CORE RESIDENT)        <<03603>>00060000
                                                               <<03603>>00062000
   3           4           MAINSEG1     (NON CORE-RES BUT      <<03603>>00064000
   4           5           MAINSEG1A     PRESENT IN CORE       <<03603>>00066000
   5           6           CONFIGURE     AT COMPLETION         <<03603>>00068000
   6           7           DEFTRACKS     OF COLD LOAD)         <<03603>>00070000
   7          10           SETUP                               <<03603>>00072000
  10          11           TAPEIO                              <<03603>>00074000
  11          12           FILEIO                              <<03603>>00076000
  12          13           DISKSPACE                           <<03603>>00078000
                                                               <<03603>>00080000
  13          14           DIRECTORY1   (NOT PRESENT AT THE    <<03603>>00082000
  14          15           DIRECTORY2    COMPLETION OF THE     <<03603>>00084000
  15          16           SL PROGRAM    COLD LOAD)            <<03603>>00086000
  16          17           PROCESS                             <<03603>>00088000
  17          20           MAINSEG1B                           <<03603>>00090000
  20          21           MAINSEG2                            <<03603>>00092000
  21          22           MAINSEG3                            <<03603>>00094000
  22          23           MAINSEG4                            <<03603>>00096000
                                      END-COMMENT;             <<03002>>00098000
                                                               <<03002>>00100000
                                                                        00102000
BEGIN                                                                   00104000
$PAGE "CONSTANT DEFINITION"                                             00106000
INTEGER ARRAY BK1DSEG(0:7):= 8(0);                             <<32BND>>00108000
   DEFINE EXT'DCL = GLOBAL #; << GLOBAL VARIABLES >>           <<SY>>   00110000
LOGICAL LIST := TRUE;                                          << 8392>>00112000
          <<--------------                                              00114000
            INITIAL INFO                                                00116000
          -------------->>                                              00118000
  EQUATE  NCORRESSEG=    3, <<# OF CORE-RESIDENT INITIAL SEGS>><<03603>>00120000
          NSTARTSEG =    11,<<# OF SEGMENTS INITIALLY IN CORE>><<03603>>00122000
          SWAPDSIZE =    5,          <<SWAP DESCRIPTOR SIZE>>           00124000
          NCORESIZES = 36, << # OF LEGAL MEMORY SIZES>>        <<03603>>00126000
          NTCST     =    32,         <<# OF ENTRIES IN TEMP CST TABLE>> 00128000
          TCSTSIZE  =    4*NTCST,    <<SIZE OF TEMPORARY CST TABLE>>    00130000
          EXPTABLES =   16, <<# OF TABLES WHICH EXPAND>>       <<t8392>>00132000
          MAXSWAPSEG=    15,         <<# OF SEGS WHICH SWAP>>  <<03603>>00134000
          NR'MPE'BANKS=   4,         <<# BANKS RESERVED FOR >> <<03603>>00136000
                                     <<USE BY MPE ONLY      >> <<03603>>00138000
          INITSTACKEXTRA=15140; <<SIZE STACK MAY GROW>>        <<03675>>00140000
                                                                        00142000
DOUBLE                                                         <<s8941>>00144000
          INITIAL'MEMADR;    << SWAPPING CASE ADDRESS OF   >>  <<s8941>>00146000
                             << INITIAL'S CORE RES SEGMENTS>>  <<s8941>>00148000
                                                               <<s8941>>00150000
          <<------------>>                                     <<02510>>00152000
          <<  CPU INFO  >>                                     <<02510>>00154000
          <<------------>>                                     <<02510>>00156000
   EQUATE BITMAP1 = %13;                                       <<bcrap>>00158000
   EQUATE BITMAP2 = %164;                                      <<C8392>>00160000
   EQUATE BITMAP3 = %140;                                      <<C8392>>00162000
   DEFINE SERIESII'III     = BITMAP1&LSR(THISCPU)#;            <<bcrap>>00164000
   <<     POST'SERIES3     = BITMAP2&LSR(THISCPU)#; >>         <<bcrap>>00166000
   DEFINE MULTI'IMB'SYS      = BITMAP3&LSR(THISCPU)#;          <<C8392>>00168000
   DEFINE ICF55              = (THISCPU = 5)#;                 <<03002>>00170000
   DEFINE SERIES37           = (THISCPU = 6)#;                 <<C8392>>00172000
                                                               <<02510>>00174000
          <<-------------------                                         00176000
            TABLE ENTRY SIZES                                           00178000
          ------------------->>                                         00180000
  EQUATE  LDTSIZE   =    7,          <<LOGICAL DEVICE TABLE>>  <<dctab>>00182000
          LDTXSIZE  =    5,          <<LDT EXTENSION>>         <<00.06>>00184000
          LPDTSIZE  =    4,          <<LOGICAL-PHYSICAL DEV>>  <<dctab>>00186000
          DVRSIZE   =    7,          <<DRIVER TABLE>>          <<dctab>>00188000
          VTABSIZE  =    14,         <<VOLUME TABLE>>                   00190000
          DRTSIZE   =    4,          <<DEVICE REFERENCE TABLE>>         00192000
          CSTSIZE   =    4,          <<CODE SEGMENT TABLE>>             00194000
          ASS'SIZE  =    7,   << ASSOCIATE TABLE ENTRY SIZE >> <<01648>>00196000
<<        IOQSIZE   =    12,   >>    <<I/O QUEUE>>             <<s8967>>00198000
<<        DISCREQSIZE=  17,    >>                              <<s8967>>00200000
         SECDISC=15,                                           <<01639>>00202000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>00204000
          TBUFSIZE  =    16,         <<TERMINAL BUFFERS>>      <<00888>>00206000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>00208000
          TBUFSIZE =     32, <<33 TERMINAL BUFFERS>>           <<00888>>00210000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>00212000
<<        SBUFSIZE  =    129,  >>    <<SYSTEM BUFFERS>>        <<s8967>>00214000
          SWAPTABSIZE = 6,                                     <<*sll5>>00216000
                                                               <<MPEIV>>00218000
<<     MONBUFSIZE=1024,        >>                              <<s8967>>00220000
<<        SIRSIZE   =    4,     >>   <<SIR TABLE>>             <<s8967>>00222000
<<        NSIR      =    43,    >>    <<# OF SIRS>>            <<s8967>>00224000
<<        SRTSIZE   =   6,      >>                             <<s8967>>00226000
<<     SRTNUM=20,               >>                             <<s8967>>00228000
          MEASINFOTABSIZE=80,                                  <<MPEIV>>00230000
          TRLSIZE   =    4,          <<TIMER REQUEST LIST>>             00232000
          PPCTSIZE  =    2,          <<PROCESS-PROCESS COMMUNICATION>>  00234000
          MAXIDDSIZE =   255 ,<<MAX # SECTORS FOR IDD>>        <<xddf1>>00236000
          JMATSIZE  =    38,         <<JOB MASTER TABLE>>      <<JMAT*>>00238000
          MAXJMATSIZE = 150,  <<MAX # SECTORS JMAT CAN BE>>    <<JMAT*>>00240000
          INITJMATSIZE=  2,   <<# SECTORS JMAT CREATED WITH>>           00242000
          MAXODDSIZE =   255 ,<<MAX # SECTORS FOR ODD>>        <<xddf1>>00244000
          JCUTSIZE  =    3,          <<JOB CUTOFF TABLE>>               00246000
          MVTABSIZE =    21,         <<MOUNTED VOL TABLE>>     <<RV.PV>>00248000
          TLTSIZE   =    65,         <<TAPE LABEL TABLE>>      <<32BND>>00250000
          MAXSTOPSIZE =   14,        <<MAX STOP ENTRY SIZE>>   <<BRKPT>>00252000
          MINSTOPSIZE =   7,         <<MIN STOP ENTRY SIZE>>   <<BRKPT>>00254000
          DCTHSIZE =  6,  <<HEADER SIZE OF DEV CLASS TAB >>    <<DEVCO>>00256000
          UCRQSIZE    =   2;         <<UCOP REQUEST QUEUE>>             00258000
                                                                        00260000
          <<-------------                                               00262000
            TABLE SIZES                                                 00264000
          ------------->>                                               00266000
  EQUATE  MAXLDEV   =    1024,                                 <<LIMIT>>00268000
          VTABTSIZE =    64*VTABSIZE,<<VOLUME TABLE>>                   00270000
          TBUFLIMIT   =  255,   <<MAX. NO. OF TBUFS      >>    <<03004>>00272000
          JMATTSIZE   =  INITJMATSIZE*128,   <<JMAT SIZE>>              00274000
          MAXJMSIZE   =  MAXJMATSIZE*128,                               00276000
          MAXIDDTSIZE =  MAXIDDSIZE*128,                                00278000
          MAXODDTSIZE =  MAXODDSIZE*128,                                00280000
          MVTABMAX    =  16,         <<MAX MOUNTED VS'S>>      <<RV.PV>>00282000
          MVTABTSIZE  =  MVTABMAX*MVTABSIZE,                   <<RV.PV>>00284000
          PVUSERTSIZE =  128,        <<INITIAL PV USER TAB >>  <<01439>>00286000
          MAXPVUSERTSIZE=4096,       <<MAX PV USER TAB SIZE >> <<01439>>00288000
          VTABSECT  =    (VTABTSIZE+127)/128,                           00290000
          CTABSIZE  =    128,        <<CORESIZE-RELATED CONFIGURATION>> 00292000
          CTAB0SIZE =    128,        <<STD CONFIGURATION TABLE>>        00294000
          SEGT'SIZE =    %2642,   << LOADER SEGMENT TABLE >>   <<03551>>00296000
          DIRSPSIZE =    384,        <<DIRECTORY SPACE DATA SEGMENT>>   00298000
          DIRSPSIZE'=    DIRSPSIZE+20,<<ACTUAL DIRSP SEG SIZE>><<DE>>   00300000
          LOGONDSTSIZE=  1000,   <<MAX SIZE OF WELCOME MESSAGE>>        00302000
          CSDEFSIZE =    MAXLDEV,<<DEFAULT LINE DESCRIPTORS>>  <<LIMIT>>00304000
          CSDVRSIZE =    4,          <<EXTRA DRIVERS>>                  00306000
          CSDRIVERS =    32,         <<MAX # OF EXTRA DRIVERS>>         00308000
          CSDVRTSIZE=    CSDRIVERS*CSDVRSIZE,                           00310000
          SJDTSIZE  =    %34,        <<INITIAL SIZE OF SYS JDT>>        00312000
          MAXSJDTSIZE=   %1000,      <<MAX SIZE OF SYS JDT>>   <<zrela>>00314000
          COMMSIZE   =   128,  <<SYSDUMP/INITIAL COMM>>        <<CONFD>>00316000
          RECBUFLEN  =   4095,                                 <<zrela>>00318000
          TZTBUFLEN  =    255;                                 <<zrela>>00320000
                                                               <<03668>>00322000
          << DISCSIOBUFSIZE IS THE MAXIMUM CHANNEL PROGRAM >>  <<03668>>00324000
          << OR SIO PROGRAM SIZE OF ALL THE DISC DRIVERS.  >>  <<03668>>00326000
          << CURRENTLY, CS80'DRIVER USES THE LARGEST       >>  <<03668>>00328000
          << CHANNEL PROGRAM.                              >>  <<03668>>00330000
                                                               <<03668>>00332000
  EQUATE  DISCSIOBUFSIZE = 98, <<SIO PROGRAM BUFFER FOR DISC>> <<03668>>00334000
$IF X1=OFF  << ******** SERIES II,III UNIQUE ******** >>       <<02510>>00336000
         TERMSIOBUFSIZE= 0, <<TERM SIO AREA NECCESSARY >>      <<02510>>00338000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******** >>             <<02510>>00340000
          TERMSIOBUFSIZE=%53,<<CHANPROG. BUFFER FOR CONSOLE>>  <<03003>>00342000
$IF        << ****** RETURN TO COMMON CODE ******* >>          <<02510>>00344000
          TAPESIOBUFSIZE=100, <<SIO PROGRAM BUFFER FOR TAPE>>  <<00888>>00346000
          SIOBUFSIZE=DISCSIOBUFSIZE+TERMSIOBUFSIZE+TAPESIOBUFSIZE;      00348000
                                                                        00350000
          <<-------------------                                         00352000
            CST CONFIGURATION                                           00354000
          ------------------->>                                         00356000
  EQUATE  ININCSTN  =    1,          <<CST FOR INTERNAL INTERRUPTS>>    00358000
          FREECSTN  =    2;          <<FIRST FREE ENTRY>>               00360000
                                                                        00362000
          <<----------------------------                                00364000
          CST EXTENSION CONFIGURATION                                   00366000
          --------------------------->>                                 00368000
  EQUATE  FREECSTXN =    1;          <<FIRST FREE ENTRY>>               00370000
                                                                        00372000
          <<-------------------                                         00374000
            DST CONFIGURATION                                           00376000
          ------------------->>                                         00378000
  EQUATE  CSTDSTN   =    1,          <<CODE SEGMENT TABLE>>             00380000
          DSTDSTN   =    2,          <<DATA SEGMENT TABLE>>             00382000
          PCBDSTN   =    3,          <<PROCESS CONTROL BLOCK>>          00384000
          CSTXDSTN  =    4,          <<CST EXTENSION>>                  00386000
          SYSDSTN   =    5,          <<SYSTEM GLOBAL AREA>>             00388000
          COREDSTN  =    6,          <<CORE (SPECIAL)>>                 00390000
          ICSDSTN   =    7,          <<INTERRUPT CONTROL STACK>>        00392000
          SBUFDSTN  =    8,          <<SYSTEM BUFFERS>>                 00394000
          UCRQDSTN  =    9,          <<UCOP REQUEST QUEUE>>             00396000
          PPCTDSTN  =    10,         <<PROCESS-PROCESS COM>>            00398000
          IOQDSTN   =    11,         <<I/O QUEUE>>                      00400000
          TBUFDSTN  =    12,         <<TERMINAL BUFFERS>>               00402000
          LPDTDSTN  =    13,         <<LOGICAL-PHYSICAL DEVICE>>        00404000
          LDTDSTN   =    14,         <<LOGICAL DEVICE TABLE>>           00406000
          DLTDSTN   =    15,         <<DRIVER LINKAGE TABLE>>           00408000
          RESQDSTN  =    16,         <<BUSY, HEAD AND TAIL TABLES>>     00410000
          PORT'DICT'DSTN=17,         << PORT DICTIONARY>>      <<PORTS>>00412000
          SEGTDSTN  =    18,         <<SEGMENT TABLE>>                  00414000
          TRLDSTN   =    19,         <<TIMER REQUEST LIST>>             00416000
          DIRDSTN   =    20,         <<DIRECTORY>>                      00418000
          DIRSPDSTN =    21,         <<DIRECTORY SPACE>>                00420000
          RINTDSTN  =    22,         <<RESOURCE IDENTITY NUMBER TABLE>> 00422000
          SWAPTABDSTN=   23,                                   <<MPEIV>>00424000
          JPCTDSTN  =    24,         <<JOB PROCESS COUNT TABLE>>        00426000
          JMATDSTN  =    25,         <<JOB MASTER TABLE>>               00428000
          TLTDSTN  =    26,         <<TAPE LABEL TABLE>>       <<TL.02>>00430000
          LOGDST  =  27,                                       <<00506>>00432000
          RITDSTN   =    28,         <<REPLY INFORMATION TABLE>>        00434000
          VTABDSTN  =    29,         <<VOLUME TABLE>>                   00436000
          STOPDSTN  =    30,         <<BREAKPOINT TABLE>>               00438000
          LOG1DSTN  =    31,         <<LOG BUFFER 1>>                   00440000
          LOG2DSTN  =    32,         <<LOG BUFFER 2>>                   00442000
          LIDDST  =  33,                                       <<00506>>00444000
          ASS'DST=34,          <<ASSOCIATE TABLE DST #>>     <<OP.01>>  00446000
          CSTBLKDSTN=    35,         <<CST BLOCK TABLE>>                00448000
          JCUTDSTN  =    36,         <<JOB CUTOFF TABLE>>               00450000
          SJITDSTN  =    37,         <<SYSTEM JIT>>                     00452000
       SPECREQTABDSTN=38,  <<SPECIAL REQUEST TABLE>>           <<MPEIV>>00454000
          VDSMDSTN  =    39,         <<VM MANAGMENT TABLE >>   <<MPEIV>>00456000
          DCTDSTN   =    40,         <<DEV CLASS & TTDT TABLE>><<dctab>>00458000
          ILTDITDSTN=    42,         <<INTERRUPT LINKAGE AND DEV INFO>> 00460000
          SIRDSTN   =    43,         <<SIR TABLE>>                      00462000
          LOGONDSTN1=    47,      <<WELCOME MESSAGE DST>>               00464000
          LOGONDSTN2=    48,      <<WELCOMR MESSAGE DST>>               00466000
          CSDSTN    =    49,         <<CS DST>>                         00468000
          FMAVTDSTN =    44, <<FILE MULTI-ACCESS VECTOR TABLE>>         00470000
          IDDDSTN   =    45,         <<IDD DST>>                        00472000
          ODDDSTN   =    46,          <<ODD DST>>                       00474000
          JPXREFDSTN=    50,         <<JOB-PROCESS CROSS REF TABLE>>    00476000
          SJDTDSTN  =    51,         <<SYSTEM JDT>>                     00478000
          CILOGDSTN =    52,         <<C.I. LOG ON DST>>       <<0+.04>>00480000
          MVTABDSTN =    53,         <<MOUNTED VOL TABLE>>     <<RH.PV>>00482000
          PVUSERDSTN=    54,         <<PV USER TABLE>>         <<RH.PV>>00484000
          DISCREQTABDSTN=56,                                   <<MPEIV>>00486000
          MSGHARBORTABDSTN=57,       <<"INCORE" IPC FACILITY>> <<PORTS>>00488000
          PORTVECTORDSTN=58,      <<IOWAIT PORT VECTOR TABLE>> <<PORTS>>00490000
          MEASINFOTABDSTN=59,                                  <<MPEIV>>00492000
          << THE FOLLOWING ARE TEMP DSTS USED BY INITIAL >>    <<32BND>>00494000
          ILTDSTN = JMATDSTN,                                  <<32BND>>00496000
          DITDSTN = TLTDSTN,                                   <<32BND>>00498000
          TEMPDSTN = RITDSTN,                                  <<32BND>>00500000
          FREEDSTN = 60;   << FIRST FREE DST >>                <<03554>>00502000
                                                                        00504000
          <<-------------------                                         00506000
            PCB CONFIGURATION                                           00508000
          ------------------->>                                         00510000
  EQUATE  PROGPCBN  =    1;                                    <<bcrap>>00512000
                                                                        00514000
          <<----------------------------------                          00516000
            SYSTEM GLOBAL AREA CONFIGURATION                            00518000
          ---------------------------------->>                          00520000
  EQUATE  SYSBASE   =    %1000,      <<STARTING ADDRESS OF SYSTEM AREA>>00522000
          SYSSIZE=%400,  <<SYS GLOBAL SIZE>>                   <<00101>>00524000
          SYSEXTSIZE=%200,<<SYS GLOBAL EXTENSION SIZE>>        <<00101>>00526000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>00528000
          FIRMWARESIZE=%104,<<AREA FOR FIRMWARE>>              <<02517>>00530000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>00532000
          FIRMWARESIZE=%330,<<RESERVED FOR SOFTDUMP FIRMWARE>> <<02510>>00534000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>00536000
          SYSIX     =    0,          <<SYSGLOBAL>>             <<32BND>>00538000
          CSTIX     =    1,          <<CST TABLE>>                      00540000
          SYSCST    =    SYSBASE+CSTIX,                                 00542000
          DSTIX     =    2,          <<DST TABLE>>                      00544000
          SYSDST    =    SYSBASE+DSTIX,                                 00546000
          PCBIX     =    3,          <<PCB TABLE>>                      00548000
          SYSPCB    =    SYSBASE+PCBIX,                                 00550000
          SWAPTABIX =    %4,                                   <<SYPTR>>00552000
          SYSSWAPTAB=    SYSBASE+SWAPTABIX,                    <<SYPTR>>00554000
          IOQIX     =    5,          <<I/O QUEUE>>                      00556000
          SYSIOQ    =    SYSBASE+IOQIX,                                 00558000
          SBUFIX    =    6,          <<SYSTEM BUFFERS>>                 00560000
          SYSSBUF   =    SYSBASE+SBUFIX,                                00562000
       ICSIX=7,                                                <<MPEIV>>00564000
       SYSICS=SYSBASE+ICSIX,                                   <<MPEIV>>00566000
          LPDTIX    =    %10,        <<LOGICAL-PHYSICAL DEVICE TABLE>>  00568000
          SYSLPDT   =    SYSBASE+LPDTIX,                                00570000
          MONBUFIX  =    %11,        <<MONITORING BUFFER>>     <<SYPTR>>00572000
          SYSMONBUF =    SYSBASE+MONBUFIX,                     <<SYPTR>>00574000
          TRLIX     =    %12,        <<TIMER REQUEST LIST>>             00576000
          SYSTRL    =    SYSBASE+TRLIX,                                 00578000
          JCUTIX    =    %13,        <<JOB CUTOFF TABLE>>               00580000
          SYSJCUT   =    SYSBASE+JCUTIX,                                00582000
          SIRIX     =    %14,        <<SIR TABLE>>                      00584000
          SYSSIR    =    SYSBASE+SIRIX,                                 00586000
          JPCNTIX   =    %15,        <<JOB PROCESS COUNT TABLE>>        00588000
          SYSJPCNT  =    SYSBASE+JPCNTIX,                               00590000
          TBUFIX    =    %16,        <<TERMINAL BUFFERS>>               00592000
          SYSTBUF   =    SYSBASE+TBUFIX,                                00594000
          DISCREQTABIX=  %17,                                  <<SYPTR>>00596000
          SYSDISCREQTAB= SYSBASE+DISCREQTABIX,                 <<SYPTR>>00598000
          TCSTIX    =  %20, << INITIAL'S CST TABLE >>          <<32BND>>00600000
          SYSTCST   =  SYSBASE+TCSTIX,                         <<32BND>>00602000
          DRTIX     =    %24,                                  <<SYPTR>>00604000
          STOPSIX   =    %25,        <<BREAKPOINT TABLE>>      <<SYPTR>>00606000
          SYSSTOPS  =    SYSBASE+STOPSIX,                      <<SYPTR>>00608000
          VDSMTABIX =    %26,        <<VM MANAGEMENT TABLE >>  <<MPEIV>>00610000
          SYSVDSMTAB=    SYSBASE+VDSMTABIX,                    <<MPEIV>>00612000
          STATICFENCE =  %27,                                  <<SYPTR>>00614000
          DFC       =    SYSBASE+%32,<<@CST-@DST>>                      00616000
          DFS       =    SYSBASE+%33,<<@CSTX-@DST>>                     00618000
          SYSDIT8   =    SYSBASE+%35,<<WORD 8 OF SYSTEM DISC DIT>>      00620000
          SYSPMBC   =    SYSBASE+%37,<<ABS ADDR OF PMBC TABLE>><<PMBC*>>00622000
          VDSENTRYIX=    %40,        <<VM ENTRY PTR >>         <<MPEIV>>00624000
          SYSVDSENTRY=   SYSBASE+VDSENTRYIX,                   <<MPEIV>>00626000
          VDSMAPIX  =    %41,        <<VM BITMAP PTR >>        <<MPEIV>>00628000
          SYSVDSMAP=     SYSBASE+VDSMAPIX,                     <<MPEIV>>00630000
       SPECREQTABIX=%42,                                       <<MPEIV>>00632000
       SYSSPECREQTAB=SYSBASE+SPECREQTABIX,                     <<MPEIV>>00634000
  <<      SMONINDEX =    %44,               >>                 <<bcrap>>00636000
          NBANKSIX  =    %47,                                  <<MPEIV>>00638000
          NBANKS    =    SYSBASE+NBANKSIX,                     <<MPEIV>>00640000
          MAXAVAILREGIX= %45,                                  <<MPEIV>>00642000
          CSTBLKIX  =    %51,        <<CST BLOCK TABLE>>                00644000
          SYSCSTBLK =    SYSBASE+CSTBLKIX,                              00646000
          SYSANTICW =    SYSBASE+%52,  <<ANTICIPATORY WRITES>> <<00588>>00648000
          BUSYIX    =    %55,        <<BUSY TABLE>>                     00650000
          SYSBUSY   =    SYSBASE+BUSYIX,                                00652000
          HEADIX    =    %56,        <<HEAD TABLE>>                     00654000
          SYSHEAD   =    SYSBASE+HEADIX,                                00656000
          TAILIX    =    %57,        <<TAIL TABLE>>                     00658000
          SYSTAIL   =    SYSBASE+TAILIX,                                00660000
          HSYSDRT   =    SYSBASE+%71,<<HIGHEST DRT>>                    00662000
          CONSLDEV  =    SYSBASE+%74,<<CONSOLE LOGICAL DEVICE #>>       00664000
          COLD'LOAD'ID=  SYSBASE+%75,<<COLD LOAD ID>>                   00666000
                                                                        00668000
          MAXSSECT  =    SYSBASE+%100,<<FIRST OF MAX SPOOL SECTORS>>    00670000
          MAXSSECT1 =    MAXSSECT+1,                                    00672000
          NUMSSECT  =    SYSBASE+%102,                                  00674000
          NUMSSECT1 =    NUMSSECT+1,                                    00676000
          EXTSSECT  =    SYSBASE+%104,<<# SECTORS/SPOOLFILE EXT>>       00678000
          MAXCODESEG=    SYSBASE+%105,<<MAX CODE SEGMENT SIZE>>         00680000
          MAXSEGPROC=    SYSBASE+%106,<<MAX # OF CODE SEGS PER PROCESS>>00682000
          MAXDATA   =    SYSBASE+%107,<<MAX STACK SIZE (DL-Z)>>         00684000
          STDSTACK  =    SYSBASE+%110,<<DEFAULT STACK SIZE>>            00686000
          MAXXTRADSEG=   SYSBASE+%111,<<MAX XTRA DATA SEG SIZE>>        00688000
          MAXDSEGPROC=   SYSBASE+%112,<<MAX # OF DATA SEGS PER PROCESS>>00690000
                                                                        00692000
<<        CIWSP     =    SYSBASE+%113,  W S PTR FOR C. I. >>   <<bcrap>>00694000
          UPDATEL   =    SYSBASE+%114,<<UPDATE LEVEL>>                  00696000
          FIXL      =    SYSBASE+%115,<<FIX LEVEL>>                     00698000
          VERSION   =    SYSBASE+%116,<<VERSION>>                       00700000
          CPUTIME   =    SYSBASE+%117,<<DEFAULT CPU TIME LIMIT>>        00702000
          LOGONLIM  =    SYSBASE+%120,<<# OF SECONDS TO LOG ON>>        00704000
                                                                        00706000
          MAXSYSDST  =    SYSBASE+%124, <<LAST ALLOC SYS DST>> <<WH.20>>00708000
          MAXSYSCST  =    SYSBASE+%125, <<LAST ALLOC SYS CST>> <<WH.20>>00710000
          SLDISCADR1=    SYSBASE+%126,<<SL.PUB.SYS DISC ADDRESS>>       00712000
          SLDISCADR2=    SLDISCADR1+1,                                  00714000
          DIRDISCADR1=   SYSBASE+%130,<<DIRECTORY DISC ADDRESS>>        00716000
          DIRDISCADR2=   DIRDISCADR1+1,                                 00718000
          INITEXTLAB=    SYSBASE+%122, <<INITIATE EXTERNAL LABEL>>      00720000
          INITINTLAB=    SYSBASE+%123, <<INITIATE INTERNAL LABEL>>      00722000
                                                                        00724000
        CONSHOWCOM'LAB=SYSBASE+%133,<<EXT LABEL FOR>>          <<01165>>00726000
                                    <<SHOWCOM      >>          <<01165>>00728000
          CSIOWLAB  =    SYSBASE+%135,<<EXTERNAL LABEL FOR CSIOWAIT>>   00730000
          CCLOSELAB =    SYSBASE+%140,<<EXTERNAL LABEL FOR CCLOSE>>     00732000
          LPROCTAB  =    SYSBASE+%141,<<LOGICAL PROCESS TABLE>>         00734000
                                                                        00736000
          TERMEXTLAB=    SYSBASE+%155,<<TERMINATE EXTERNAL LABEL>>      00738000
          TERMINTLAB=    SYSBASE+%156,<<TERMINATE INTERNAL LABEL>>      00740000
          CIEXTLAB  =    SYSBASE+%157,<<COMMANDINTERP EXTERNAL LABEL>>  00742000
          CIINTLAB  =    SYSBASE+%160,<<COMMANDINTERP INTERNAL LABEL>>  00744000
          SPOOLINEXTLAB= SYSBASE+%161,<<SPOOLIN EXTERNAL LABEL>>        00746000
          SPOOLININTLAB= SYSBASE+%164,<<SPOOLIN INTERNAL LABEL>>        00748000
          SPOOLOUTEXTLAB=SYSBASE+%165,<<SPOOLOUT EXTERNAL LABEL>>       00750000
          SPOOLOUTINTLAB=SYSBASE+%166,<<SPOOLOUT INTERNAL LABEL>>       00752000
                                                                        00754000
          LOGBITS'  =    SYSBASE+%167,<<WHICH RECORDS TO LOG>>          00756000
          LOGBUF1   =    SYSBASE+%172,<<LOGGING BUFFER 1>>              00758000
          LOGBUF2   =    SYSBASE+%173,<<LOGGING BUFFER 2>>              00760000
          LOGRECSIZE'=   SYSBASE+%174,<<BUFFER SIZE IN SECTORS>>        00762000
          LOGFILESIZE'=  SYSBASE+%204,<<LOG FILE SIZE IN BLOCKS>>       00764000
          LOGFILENUM=    SYSBASE+%205,<<LOG FILE NUMBER>>               00766000
          MAPPINGFIRMWARE=SYSBASE+%220,<<FIRMWARE EXISTS>>     <<*PHY*>>00768000
          NRPHYCST      =SYSBASE+%224,<<NR PHY CSTS>>          <<*PHY*>>00770000
          PHYCSTHEAD    =SYSBASE+%225,<<PHY CST HEAD>>         <<*PHY*>>00772000
          MEASINFOTABIX= %261,                                 <<MPEIV>>00774000
          SYSMEASINFOTAB=SYSBASE+MEASINFOTABIX,                <<MPEIV>>00776000
          DISPQHEADIX=   %271,                                 <<MPEIV>>00778000
          SYSDISPQHEAD=  SYSBASE+DISPQHEADIX,                  <<MPEIV>>00780000
          DISPQTAILIX=   %272,                                 <<MPEIV>>00782000
          SYSDISPQTAIL=  SYSBASE+DISPQTAILIX,                  <<MPEIV>>00784000
          DSTLOGON  =    SYSBASE+%277,<<ACTIVE WELCOME DST>>            00786000
                                                                        00788000
          NPROCSTOP =    SYSBASE+%302,<<# OF WORDS IN STOP TABLE>>      00790000
          DEVRECSTOP=    SYSBASE+%304,<<DEVREC STOP ENTRY>>             00792000
          UCOPSTOP  =    SYSBASE+%306,<<UCOP STOP ENTRY>>               00794000
          LOGSTOP   =    SYSBASE+%310,<<LOGGING STOP ENTRY>>            00796000
          IOMESSSTOP=    SYSBASE+%312,<<I/O MESSAGE STOP ENTRY>>        00798000
          NMMONSTOP =    SYSBASE+%316,<< NMMON STOP ENTRY >>   <<AL.00>>00800000
<<        SDSLDEVLAB=    SYSBASE+%323,  EXT LABEL FOR SDSLDEV>><<c8392>>00802000
          MAXQUEUE  =   SYSBASE+%333,<<MAX JOB PRIORITY>>               00804000
          DEFAULTJOBPRI=200,                                   <<00.EB>>00806000
          DEFAULTQUEUE= SYSBASE+%334,<<DEFUALT JOB PRIORITY>>           00808000
           MEMLGSTOP =     SYSBASE+%314,<<MEMLOGP STOP ENTRY>>          00810000
          DSCHECKLAB=    SYSBASE+%335,<<DSCHECK EXTERNAL LABEL>>        00812000
          DSOPENLAB =    SYSBASE+%336,<<EXTERNAL LABEL FOR DSOPEN>>     00814000
          DSCLOSELAB=    SYSBASE+%337,<<EXTERNAL LABEL FOR DSCLOSE>>    00816000
          MWRITECONVLAB= SYSBASE+%340,<<EXT LABEL FOR MANAGEWRITECONV>> 00818000
          CONSDSLINE'LAB=SYSBASE+%341,<<EXT LABEL FOR CONSDSLINE'>>     00820000
          CONSMPLINE'LAB=SYSBASE+%374,<<EXT LABEL FOR CONSMPLINE'>>     00822000
          CONSMRJE'LAB=  SYSBASE+%375,<<EXT LABEL FOR CONSMRJE>><<MRJE>>00824000
          CXREMOTELAB=   SYSBASE+%342,<<EXT LABEL FOR CXREMOTE>>        00826000
          CXDSLINELAB=   SYSBASE+%343,<<EXT LABEL FOR CXDSLINE>>        00828000
          CXRFALAB  =    SYSBASE+%344,<<EXTERNAL LABEL FOR CXRFA>>      00830000
          DSIMAGELAB=    SYSBASE+%345,<<EXTERNAL LABEL FOR DSIMAGE>>    00832000
         AVR       =  SYSBASE+%346,                            <<TL.02>>00834000
          INITTCP=       SYSBASE+%347,<<TERMINAL>>             <<00888>>00836000
          <<INITIALIZATION CHANNEL PROGRAM>>                   <<00888>>00838000
          <<SEE "INITTCP'" IN ILT DESCRIPTION>>                <<00888>>00840000
          DSBREAKLAB=    SYSBASE+%360,<<EXTERNAL LABEL FOR DSBR<<RH.PV>>00842000
          LASTBANKIX=    %361,                                 <<MPEIV>>00844000
          SYSLASTBANK=   SYSBASE+LASTBANKIX,                   <<MPEIV>>00846000
          LASTBASEIX=    %362,                                 <<MPEIV>>00848000
          SYSLASTBASE=   SYSBASE+LASTBASEIX,                   <<MPEIV>>00850000
          VMOUNTINFO=sysbase+%365, <<PV CONTROL WORD>>         <<WH.01>>00852000
          SYSEXTPTR=SYSBASE+%377; <<PTR TO SYSGLOB EXT>>       <<00101>>00854000
  EQUATE  SYSCONSPEED = %14,                                   <<S7651>>00856000
          CONS3270'LAB= %73,  << SYSGLOBEXT INDEX >>           <<S7651>>00858000
          SYS'STARTUP'OPT = %123, << SYSGLOBEXT INDEX >>       <<I8884>>00860000
          GLOBMITVERSION = %74, << MIT VERSION >>              <<00931>>00862000
          GLOBMITUPDATE  = %75, << MIT UPDATE  >>              <<00931>>00864000
          GLOBMITFIX     = %76, << MIT FIX     >>              <<00931>>00866000
          SYSPORT'PIN = %120,                                  <<PORTS>>00868000
          SYSEXTPTR'DB= %377;                                  <<00838>>00870000
POINTER   SYSGLOBEXT  = SYSEXTPTR'DB;  << LST/SST INSTR. >>    <<00838>>00872000
EQUATE                                                         <<jb.dc>>00874000
   HOLECOUNTIX = %44,                                          <<jb.dc>>00876000
   HOLELISTHEADIX = %250,                                      <<jb.dc>>00878000
   HOLELISTTAILIX = %252;                                      <<jb.dc>>00880000
DOUBLE ARRAY                                                   <<jb.dc>>00882000
   HOLELISTHEAD(*) = DB + HOLELISTHEADIX,                      <<jb.dc>>00884000
   HOLELISTTAIL(*) = DB + HOLELISTTAILIX;                      <<jb.dc>>00886000
INTEGER                                                        <<jb.dc>>00888000
   HOLECOUNT = DB + HOLECOUNTIX;                               <<jb.dc>>00890000
                                                                        00892000
          <<----------------                                            00894000
            PCB DEFINITION                                              00896000
          ---------------->>                                            00898000
DEFINE                                                         <<*pcb*>>00900000
   <<   STOVRALLFLAG=(1:1)#,             >>                    <<03635>>00902000
        STACKFIELD = (2:14)#,                                  <<*pcb*>>00904000
   <<   STK=(1:10)#,                     >>                    <<03635>>00906000
   <<   JUNKWAITFLAG=(7:1)#,             >>                    <<03635>>00908000
   <<   FATHERWAITFLAG=(11:1)#,          >>                    <<03635>>00910000
        MEMWAITFLAG=(15:1)#,                                   <<MPEIV>>00912000
        DISPQFLAG=(0:1)#,                                      <<MPEIV>>00914000
        PSIMFIELD=(0:3)#,                                      <<MPEIV>>00916000
        LIVFLAG=(0:1)#,                                        <<MPEIV>>00918000
        PROCESSTYPEFIELD=(6:3)#,                               <<MPEIV>>00920000
        PROCRESIDENTFLAG=(6:1)#,                               <<MPEIV>>00922000
        LQFLAG=(1:1)#,                                         <<MPEIV>>00924000
        SARFLAG=(0:1)#;                                        <<MPEIV>>00926000
                                                               <<MPEIV>>00928000
EQUATE  ACTIVE =0,                                             <<MPEIV>>00930000
        JUNKWAIT=7,                                            <<MPEIV>>00932000
        FATHERWAIT=11;                                         <<MPEIV>>00934000
                                                               <<MPEIV>>00936000
INTEGER LASTBANK=DB+LASTBANKIX, <<DB ACCESS TO SYSGLOB CELLS>> <<MPEIV>>00938000
        LASTBASE=DB+LASTBASEIX,                                <<MPEIV>>00940000
        SWAPTABSYSBASEINX=DB+SWAPTABIX;                        <<MPEIV>>00942000
                                                               <<MPEIV>>00944000
<<SEGMENT TABLE DESCRIPTORS>>                                  <<MPEIV>>00946000
<< INTEGER ARRAY SEGDESC00(*)=DB+0,         >>                 <<03552>>00948000
   <<         SEGDESC01(*)=DB+1,            >>                 <<03552>>00950000
   <<         SEGDESC02(*)=DB+2,            >>                 <<03552>>00952000
   <<         SEGDESC03(*)=DB+3;            >>                 <<03552>>00954000
                                                               <<MPEIV>>00956000
DEFINE<<SEGDESCFIRMINFO=SEGDESC00(X)#,      >>                 <<03552>>00958000
    <<  ABSENTFLAG=(0:1)#,                  >>                 <<03552>>00960000
    <<  PRIVMODEFLAG=(1:1)#,                >>                 <<03552>>00962000
    <<  REFERENCEDFLAG=(2:1)#,              >>                 <<03552>>00964000
    <<  DATASIZEFIELD=(3:13)#,              >>                 <<03552>>00966000
    <<  CODESIZEFIELD=(4:12)#,              >>                 <<03552>>00968000
    <<  SEGDESCFLAGS=SEGDESC01(X)#,         >>                 <<03552>>00970000
        SEGRESIDENTFLAG=(7:1)#,                                <<MPEIV>>00972000
        SYSTEMFLAG=(6:1)#,                                     <<MPEIV>>00974000
    <<  SEGDESCBANK=SEGDESC02(X)#,          >>                 <<03552>>00976000
    <<  SEGDESCHODA=SEGDESC02(X)#,          >>                 <<03552>>00978000
    <<  SEGDESCADDR=SEGDESC03(X)#,          >>                 <<03552>>00980000
    <<  SEGDESCLODA=SEGDESC03(X)#,          >>                 <<03552>>00982000
        DISCCOPYVALIDFLAG=(0:1)#,                              <<MPEIV>>00984000
       VMALLOC=(9:7)#,                                         <<MPEIV>>00986000
       STKFLAG=(3:1)#;                                         <<MPEIV>>00988000
                                                                        00990000
          <<-------------------------                                   00992000
            PCB EXTENSION EQUATIONS                                     00994000
          ------------------------->>                                   00996000
  EQUATE  PXGLOB    =    12,         <<GLOBAL AREA SIZE>>      <<PCBXG>>00998000
          PXFIXCRSIZE=   80,         <<RES FIXED AREA SIZE>>   <<01798>>01000000
          PXFIXLKSIZE=   80,                                   <<01556>>01002000
          PXFILE    =    200,        <<FILE AREA SIZE>>        <<MPEIV>>01004000
          PXLINK    =    4,          <<LINK AREA SIZE>>        <<MPEIV>>01006000
          PCBXLKSIZE=    PXGLOB+PXFIXLKSIZE+PXFILE+PXLINK,     <<MPEIV>>01008000
          PCBXCRSIZE=    PXGLOB+PXFIXCRSIZE+PXLINK;                     01010000
                                                                        01012000
DEFINE                                                         <<SYPTR>>01014000
   LDTX'TERMID   = LDTX(LDTX'INDEX+2)#;                        <<SYPTR>>01016000
$INCLUDE INCLLDTI                                              <<*LDT*>>01018000
$INCLUDE INCLPDTI                                              <<*LPDT>>01020000
$INCLUDE INCLDVR                                               <<*DVR*>>01022000
$INCLUDE INCLDCT                                              <<<*7777>>01024000
                                                                        01026000
                                                               <<00.06>>01028000
          <<--------------------                                        01030000
            DEVICE CLASS TABLE                                          01032000
          -------------------->>                                        01034000
                                                                        01036000
  EQUATE  DIRACCESS =    0,  <<DIRECT ACCESS>>                          01038000
          SERINPUT  =    1,  <<SERIAL INPUT>>                           01040000
          CONINOUT  =    2,  <<CONCURRENT I/O>>                         01042000
          NCONINOUT =    3,  <<NON CONCURRENT I/O>>                     01044000
          SEROUTPUT =    4,  <<SERIAL OUTPUT>>                          01046000
          TERMDEVTYPE=   16; <<TERMINAL DEVICE TYPE>>                   01048000
  DEFINE  DIRACC    =    (15:1)#,                                       01050000
          SERINP    =    (14:1)#,                                       01052000
          CONIO     =    (13:1)#,                                       01054000
          NCONIO    =    (12:1)#,                                       01056000
          SEROUT    =    (11:1)#;                                       01058000
                                                                        01060000
  EQUATE  MAXSUBTYPES     = 16,  <<MAX. SUBTYPES PER TYPE>>    <<03550>>01062000
          MAXSUBTYPESP1   = MAXSUBTYPES+1;                     <<03550>>01064000
                                                               <<03550>>01066000
  EQUATE  TAPETYPE  =    24;   << DEVICE TYPE FOR MAG TAPE >>  <<03635>>01068000
                                                               <<03635>>01070000
                                                               <<03635>>01072000
                                                               <<03635>>01074000
          <<-----------------                                           01076000
            CS DATA SEGMENT                                             01078000
          ----------------->>                                           01080000
EQUATE     <<CS DATA SEGMENT INFO SECTION>>                             01082000
     COMSYSLEN    = 0,                                         <<01165>>01084000
     CSLDTXENTNUM = 1,                                                  01086000
<<   CSLDTXENTPTR = 2,  >>                                     <<01165>>01088000
     GROUPENTPTR  = 4,                                                  01090000
     DRIVERENTNUM = 5,                                                  01092000
     DRIVERENTPTR = 6;                                                  01094000
                                                                        01096000
DEFINE     << CSLDTX (CS DATA SEGMENT) FIELDS >>                        01098000
     CSLDTXENTRYSIZE     = CSLDTX          #,                  <<01165>>01100000
     CSLDTXDRCHANGEABLE  = CSLDTX( 1).(0: 1)#,                          01102000
     CSLDTXHSI'CHAN      = CSLDTX(1).(1:4)#,                            01104000
     CSLDTXEXP           = CSLDTX( 1).(5:1)#,                  <<01165>>01106000
     CSLDTX'DEV'OPENED   = CSLDTX( 1).(6:1)#,                  <<01165>>01108000
  << CSLDTXEXP1          = CSLDTX( 1).(7:1)#, >>               <<01165>>01110000
     CSLDTXPROTOCOL      = CSLDTX( 1).(8: 8)#,                          01112000
     CSLDTXMODE          = CSLDTX( 2).(6: 4)#,                          01114000
     CSLDTXCODE          = CSLDTX( 2).(10:6)#,                          01116000
<<   CSLDTXMISC          = CSLDTX( 3).(0: 8)#,>>               <<01165>>01118000
     CSLDTXDUAL'SPEED    = CSLDTX( 3).(0: 1)#,                          01120000
     CSLDTXHALF'SPEED    = CSLDTX( 3).(1: 1)#,                          01122000
     CSLDTXXMSN'MODE     = CSLDTX( 3).(2: 2)#,                          01124000
     CSLDTXSPEEDCHNGBLE  = CSLDTX( 3).(4: 1)#,                          01126000
     CSLDTXANSWER        = CSLDTX( 3).(5: 2)#,                          01128000
     CSLDTXDIAL          = CSLDTX( 3).(7: 1)#,                          01130000
     CSLDTXAUTO'DIAL'LDN = CSLDTX( 4)        #,                <<csdec>>01132000
     CSLDTXDOPTIONS      = CSLDTX( 5)        #,                <<csdec>>01134000
     CSLDTXRECV'TIMEOUT  = CSLDTX( 6)        #,                <<csdec>>01136000
     CSLDTXLOCAL'TIMEOUT = CSLDTX( 7)        #,                <<csdec>>01138000
     CSLDTXCONCT'TIMEOUT = CSLDTX( 8)        #,                <<csdec>>01140000
     CSLDTXINSPEED       = CSLDTX( 9)        #,  << 2 WORDS >> <<csdec>>01142000
     CSLDTXOUTSPEED      = CSLDTX(11)        #,  << 2 WORDS >> <<csdec>>01144000
     CSLDTXPBUFFSIZE     = CSLDTX(13)        #,                <<csdec>>01146000
     CSLDTXLDEV          = CSLDTX(14)        #,                <<csdec>>01148000
     CSLDTXDRINDEX       = CSLDTX(15).(8: 8) #,                <<csdec>>01150000
     CSLDTXCONTPTR       = CSLDTX(16)        #,                <<csdec>>01152000
     CSLDTXIDLISTPTR     = CSLDTX(17)        #,                <<csdec>>01154000
     CSLDTXPHLISTPTR     = CSLDTX(18)        #,                <<csdec>>01156000
<<   CSLDTXDUMP'DATE     = CSLDTX(34)        #,  >>            <<bcrap>>01158000
     CSLDTX'DEV'DUMPED   = CSLDTX(35).(0: 1) #,                <<csdec>>01160000
<<   CSLDTXCUR'DUMP'NUM  = CSLDTX(35).(8: 8) #,  >>            <<bcrap>>01162000
     CSLDTXMAX'DUMPS     = CSLDTX(36)        #;                <<csdec>>01164000
                                                                        01166000
DEFINE     << DRIVER ENTRY (CS DATA SEGMENT) FIELDS >>                  01168000
<<   DRENTRYSIZE         = DRIVERENTRY           #,>>                   01170000
     DRNAME              = DRIVERENTRY(1)        #,  << 4 WORDS >>      01172000
     DRDLTP              = DRIVERENTRY(5)        #,                     01174000
     DRLCMPLABEL         = DRIVERENTRY(5)        #,                     01176000
<<   DRSLCPLABEL         = DRIVERENTRY(6)        #,>>                   01178000
<<   DRPHYSDVRPLABEL     = DRIVERENTRY(7)        #,>>                   01180000
<<   DREDITORPLABEL      = DRIVERENTRY(8)        #,>>                   01182000
<<   DRIHPLABEL          = DRIVERENTRY(9)        #,>>                   01184000
     DRCAPSECTSIZE       = DRIVERENTRY(10)       #,                     01186000
<<   DRRETRIES'FLAGS     = DRIVERENTRY(11)       #,>>                   01188000
     DRRETRIES           = DRIVERENTRY(11).(0: 8)#,                     01190000
     DRLCN               = DRIVERENTRY(15)       #;                     01192000
                                                                        01194000
DEFINE     << DLT  FIELDS >>                                            01196000
     LCM'PLABEL          = DLT(1)           #,                          01198000
     CSSLC'PLABEL        = DLT(2)           #,                          01200000
     PHYS'DVR'PLABEL     = DLT(3)           #,                          01202000
     CSIH'PLABEL         = DLT(4)           #,                          01204000
     EDITOR'PLABEL       = DLT(6)           #;                          01206000
                                                                        01208000
DEFINE     << POINTERS SECTION OF DIT >>                                01210000
     CONTROLP            = ABS(DITADR+9)        #;             <<32BND>>01212000
                                                                        01214000
DEFINE     << CS STANDARD DIT FIELDS >>                        <<32BND>>01216000
     CSSUBTYPE           = ABS(STDADR+ 2).(0: 4)#,             <<32BND>>01218000
     CSDEVTYPE           = ABS(STDADR+ 2).(4: 6)#,             <<32BND>>01220000
     CSLCN               = ABS(STDADR+ 2).(10:6)#,             <<32BND>>01222000
     CSMODE              = ABS(STDADR+ 6).(6: 4)#,             <<32BND>>01224000
     CSCODE              = ABS(STDADR+ 6).(10:6)#,             <<32BND>>01226000
     CSPROTOCOL          = ABS(STDADR+ 7).(0: 8)#,             <<32BND>>01228000
     CSDOPTIONS          = ABS(STDADR+ 8)       #,             <<32BND>>01230000
     CSHSI'CHAN          = ABS(STDADR+ 9).(3: 4)#,             <<32BND>>01232000
     CSDUAL'SPEED        = ABS(STDADR+ 9).(8: 1)#,             <<32BND>>01234000
     CSHALF'SPEED        = ABS(STDADR+ 9).(9: 1)#,             <<32BND>>01236000
     CSXMSN'MODE         = ABS(STDADR+ 9).(10:2)#,             <<32BND>>01238000
     CSSPEED'CHNGBLE     = ABS(STDADR+ 9).(12:1)#,             <<32BND>>01240000
     CSANSWER            = ABS(STDADR+ 9).(13:2)#,             <<32BND>>01242000
     CSDIAL              = ABS(STDADR+ 9).(15:1)#,             <<32BND>>01244000
     CSRECV'TIMEOUT      = ABS(STDADR+11)       #,             <<32BND>>01246000
     CSLOCAL'TIMEOUT     = ABS(STDADR+12)       #,             <<32BND>>01248000
     CSCONCT'TIMEOUT     = ABS(STDADR+13)       #,             <<32BND>>01250000
     CSINSPEED           = ABS(STDADR+14)       #,<< 2 WORDS >><<32BND>>01252000
     CSOUTSPEED          = ABS(STDADR+16)       #,<< 2 WORDS >><<32BND>>01254000
<<   CSTRACEINFO         = ABS(STDADR+31)       #,>>           <<32BND>>01256000
<<   CSTRACEALL          = ABS(STDADR+31).(0: 1)#,>>           <<32BND>>01258000
<<   CSTRACEMASK         = ABS(STDADR+31).(1: 7)#,>>           <<32BND>>01260000
<<   CSTRACENTNUM        = ABS(STDADR+31).(8: 8)#,>>           <<32BND>>01262000
     CSMAXRETRIES        = ABS(STDADR+32).(0: 8)#;             <<32BND>>01264000
                                                                        01266000
          DEFINE                                               <<00506>>01268000
          RECLOGPLABEL      =    SYSBASE+ABSOLUTE(SYSEXTPTR)+%62#,      01270000
          RECLOGDELTAP      =    SYSBASE+ABSOLUTE(SYSEXTPTR)+%63#,      01272000
          ULOGPLABEL        =    SYSBASE+ABSOLUTE(SYSEXTPTR)+%60#,      01274000
          ULOGDELTAP        =    SYSBASE+ABSOLUTE(SYSEXTPTR)+%61#,      01276000
          ULOGRSTARTDELTAP  =    SYSBASE+ABSOLUTE(SYSEXTPTR)+%64#,      01278000
          ULOGRSTARTPLABEL  =    SYSBASE+ABSOLUTE(SYSEXTPTR)+%65#;      01280000
  EQUATE  DRINFOSIZE=    11,         <<DRIVER TABLE STD SIZE>>          01282000
          LCMP      =    10,         <<POINTER SECTION OF DIT>>         01284000
          MPESTDSIZE=    13,         <<MPE DIT STD SIZE>>               01286000
          CSSTDSIZE =    70,         <<CS DIT STD SIZE>>       <<01165>>01288000
          INTCOMDELAY=   1, <<INTERCOMPONENT DELAY>>                    01290000
          CIRPDELAY =    2, <<CIRCULAR POLL DELAY >>                    01292000
          CONTRSTART=    37,<<CONTROL TRIBUTARY >>             <<depen>>01294000
                            <<SECTION START     >>             <<01165>>01296000
          CSSHOWCOMLEN=  20,                                   <<CSSEG>>01298000
          CSSHOWCOMINFO= 19,<<SHOWCOMINFO START IN >>          <<CSSEG>>01300000
                            <<CSLDTX               >>          <<01165>>01302000
          MANLANSWER=    1,      <<MANUAL ANSWER>>                      01304000
          AUTOANSWER=    2,      <<AUTOMATIC ANSWER>>                   01306000
          NUMSEQ    =    2,      <<NUMBER OF SEQUENCES>>                01308000
          CSXSTART  =    7,      <<CSLDTX STARTS IN CSTAB>>             01310000
          CONSEQSTART=   5;      <<COMPOENCE SEQUENCE>>        <<01025>>01312000
                              <<START FOR CONTROL SECTION>>    <<01025>>01314000
  EQUATE  CSDEV17 =17,     <<LOWEST LEGAL CS DEVICE TYPE>>     <<00888>>01316000
          CSDEV18 =18,                                         <<00888>>01318000
          CSDEV19 =19;     <<HIGHEST LEGAL CS DEVICE TYPE>>    <<00888>>01320000
  DEFINE  REMOSTAT      = 4).(0:8#,    <<REMOTE STATIONS>>              01322000
          NUMCOMP       = 4).(8:8#,  <<# OF COMPONENTS>>               01324000
          FIRSTCOMP     = 3).(0:8#,                                     01326000
          SUPERVISED=    3<=CSLDTXMODE<=4#,                             01328000
          CSDEVICE  =    CSDEV17<=LDT'DEVICE'TYPE<=CSDEV19#,   <<*LDT*>>01330000
          CSDEV     =    CSDEV17<=TYPE<=CSDEV19#,              <<00888>>01332000
          CSPRESENT =    CSTAB(CSLDTXENTNUM)>0#,                        01334000
          CONTENTION=    1<=CSLDTXMODE<=2#,                             01336000
          CONTROLST =    CSLDTXMODE=3#,                                 01338000
          TRIBUTARY =    CSLDTXMODE=4#;                                 01340000
                                                                        01342000
                                                                        01344000
          <<--------------                                              01346000
            VOLUME TABLE                                                01348000
          -------------->>                                              01350000
  EQUATE  VTABCOLDLOADID=1,          <<COLD LOAD ID IN FIRST ENTRY>>    01352000
          VTABSYSVOLNUM =2,          <<NUMB. OF SYS. ENTRIES>> <<RH.PV>>01354000
          VMINTEGRITY   =3,          << VM DATA INTERGITY WRD>><<MPEIV>>01356000
          VTAB8     =     8,         << VTAB ENTRY WORD 8  >>  <<MPEIV>>01358000
          VTAB9     =     9,         << VTAB ENTRY WORD 9  >>  <<MPEIV>>01360000
          VTAB10    =    10,         << VTAB ENTRY WORD 10 >>  <<MPEIV>>01362000
          VTAB11    =    11,         << VTAB ENTRY WORD 11 >>  <<MPEIV>>01364000
          VTAB12    =    12;         << VTAB ENTRY WORD 12 >>  <<MPEIV>>01366000
  DEFINE  VTABLDEV  =    (0:8)#,     << LOGICAL DEVICE #>>     <<MPEIV>>01368000
          VMS       =    (12:1)#;    << VIR. MEM. SUPPORTING >><<MPEIV>>01370000
                                                                        01372000
          <<-------------------------------->>                 <<MPEIV>>01374000
          <<  VIRTUAL MEM MANAGEMENT TABLE  >>                 <<MPEIV>>01376000
          <<-------------------------------->>                 <<MPEIV>>01378000
                                                               <<MPEIV>>01380000
$INCLUDE INCLVMLD                                              <<MPEIV>>01382000
EQUATE BMOFFSET   = 16;  << VDSMTAB ENTRY HEADER SIZE >>       <<MPEIV>>01384000
  DEFINE L'         = LOGICAL#,                                <<MPEIV>>01386000
         D'         = DOUBLE#;                                 <<MPEIV>>01388000
                                                               <<MPEIV>>01390000
          <<---------------------                                       01392000
            CONFIGURATION TABLE                                         01394000
          --------------------->>                                       01396000
  EQUATE  CTABCURVERSION = 1;   << CURRENT VERSION OF CTAB>>   <<CONFD>>01398000
  EQUATE  CTABCHECKSUM = 0,          <<CHECKSUM OF CTAB>>      <<CONFD>>01400000
          CTABVERSION =  1,          <<VERSION OF CTAB>>       <<CONFD>>01402000
          SSS       =    2,          <<STD STACK SIZE>>                 01404000
          CORESIZE  =    3,          <<CORE SIZE IN K WORDS>>  <<CONFD>>01406000
    <<    TERMPRI   =    4,     >>   <<TERMINAL BOUND PRIOR>>  <<03635>>01408000
    <<    NORMPRI   =    5,     >>   <<NORMAL PRIORITY>>       <<03635>>01410000
    <<    CPUPRI    =    6,     >>   <<CPU BOUND PRIORITY>>    <<03635>>01412000
          LOGON     =    7,          <<NUMBER OF SECONDS TO LOGON>>     01414000
          LOGRECSIZE=    8,          <<LOG FILE RECORD SIZE>>           01416000
          LOGFILESIZE=   9,          <<LOG FILE SIZE IN RECORDS>>       01418000
          LOGBITS   =    11,         <<WHAT IS BEING LOGGED>>           01420000
          CPULIM    =    16,         <<DEFAULT CPU TIME LIMIT>>         01422000
          MAXSPOOLF =    28,         <<MAX OPEN SPOOFLES>>              01424000
          KILOSECTS =    15,        <<DOUBLE INDEX FOR MAX              01426000
                                    SPOOLFILE KILOSECTORS>>             01428000
          EXTSSECT' =    33;        <<SECTORS/SPOOLFILE EXT>>  <<CONFD>>01430000
                                                               <<03002>>01432000
                                                               <<CONFD>>01434000
   <<----------------------------------->>                     <<CONFD>>01436000
   <<   SYSDUMP/INITIAL COMMUNICATION   >>                     <<CONFD>>01438000
   <<----------------------------------->>                     <<CONFD>>01440000
                                                               <<CONFD>>01442000
   EQUATE MITVERSION     =  0,                                 <<CONFD>>01444000
          MITUPDATE      =  1,                                 <<CONFD>>01446000
          MITFIX         =  2,                                 <<CONFD>>01448000
          VERSION'       =  3,                                 <<CONFD>>01450000
          UPDATEL'       =  4,                                 <<CONFD>>01452000
          FIXLEVEL'      =  5,                                 <<CONFD>>01454000
          EXPFLAG'       =  6,                                 <<CONFD>>01456000
          DRTNUM         =  7,                                 <<CONFD>>01458000
          HLDEV'         =  8,                                 <<CONFD>>01460000
          HVOL'          =  9,                                 <<CONFD>>01462000
          NUMADVRS       = 10,                                 <<CONFD>>01464000
          COLDLOADID'    = 11,                                 <<CONFD>>01466000
          FILESDUMPED    = 12,                                 <<CONFD>>01468000
          SERIALDISCLOAD'= 13,                                 <<CONFD>>01470000
          TAPERECSIZE'   = 14,                                 <<CONFD>>01472000
          DISCENTRY'     = 15,                                 <<CONFD>>01474000
          MAXINITSEG'    = 16,                                 <<CONFD>>01476000
          DVCLSIZE'      = 20,                                 <<CONFD>>01478000
          TTDTSIZE'      = 21,                                 <<CONFD>>01480000
          OLDVTABSIZE    = 22,                                 <<CONFD>>01482000
          OLDINFOSIZE    = 23,                                 <<CONFD>>01484000
          CSTABSIZE      = 24,                                 <<CONFD>>01486000
          TLBUFSIZE      = 25,                                 <<t8392>>01488000
          TLBUFENTRIES   = 26,                                 <<t8392>>01490000
          SYSTAPELDEV'   = 27,  << COLD LOAD DEVICE LDEV >>    <<I8884>>01492000
          ID0            = 30,                                 <<t8392>>01494000
<<        ID1            = 31,  >>                             <<bcrap>>01496000
<<        ID2            = 32,  >>                             <<bcrap>>01498000
<<        ID3            = 33,  >>                             <<bcrap>>01500000
          LOGFILENUM'    = 40; << LOG FILE NUMBERT >>          <<CONFD>>01502000
                                                               <<03002>>01504000
  DEFINE  LOADTYPE=(15:1)#, <<SET IF>>                         <<00678>>01506000
                            <<SYSDUMP WAS TO A SERIAL DISC>>   <<00678>>01508000
          LOADDATE=(14:1)#, <<SET IF>>                         <<t8392>>01510000
                            <<SYSDUMP WAS A FUTURE'DATE DUMP>> <<00678>>01512000
          LOADFOS =(13:1)#, <<SET IF>>                         <<I8895>>01514000
                            <<SYSDUMP RUN DEFAULTS>>           <<I8895>>01516000
          MPEVERSION = (15:1)#; <<SET IF >>                    <<t8392>>01518000
                                <<VERSION = MIGHTY MOUSE>>     <<t8392>>01520000
                                                                        01522000
  EQUATE  CSTNUM    =    0,      <<# OF CST ENTRIES>>                   01524000
          DSTNUM    =    1,      <<# OF DST ENTRIES>>                   01526000
          PCBNUM    =    2,      <<# OF PCB ENTRIES>>                   01528000
          IOQNUM    =    3,      <<# OF IOQ ENTRIES>>                   01530000
          TBUFNUM   =    4,      <<# OF TERMINAL BUFFERS>>              01532000
          CSTXNUM   =    5,      <<# OF CST EXTENSION ENTRIES>>         01534000
          ICSSIZE   =    6,      <<# OF WORDS ON ICS>>                  01536000
          UCRQNUM   =    7,      <<# OF UCOP REQ QUEUE ENTRIES>>        01538000
          STOPNUM   =    8,          <<# OF BREAKPOINT TABLE ENTRIES>>  01540000
          TRLNUM    =    9,      <<# OF TIMER REQUEST LIST ENTRIES>>    01542000
          RINS'     =    10,         <<# OF RINS>>                      01544000
          GRINS'    =    11,         <<MAX # OF GLOBAL RINS>>           01546000
          SBUFNUM   =    12,         <<# OF SYSTEM BUFFERS>>            01548000
          CONPROGNUM=    13,         <<# OF CONCURRENT PROGRAMS>>       01550000
          LSTSIZE   =    14,         <<LOADER SEG TABLE>>      <<.LST.>>01552000
          << TYPEBUF (WORD 15) IS RESERVED FOR FUTURE USE >>   <<03708>>01554000
    <<    TYPEBUF   =    15,     << TYPE-AHEAD BUFFER SIZE >>  <<03708>>01556000
          VIRMEMSECT'=   20,     <<SIZE OF VIRTUAL MEMORY>>             01558000
          DIRSECT'  =    21,         <<SIZE OF DIRECTORY IN SECTORS>>   01560000
          MCSS      =    30,     <<MAY CODE SEG SIZE>>                  01562000
          MCSP      =    31,         <<MAX CODE SEGS/PROCESS>>          01564000
          MSTACK    =    32,         <<MAX STACK SIZE>>                 01566000
          MXDSS     =    33,     <<MAX EXTRA DATA SEG SIZE>>            01568000
          MXDSP     =    34,         <<MAX XTRA DATA SEGS/PROCESS>>     01570000
          MAXRSES   =    40,         <<MAX # OF RUNNING SESSION>>       01572000
          MAXRJOB  =  41,                                      <<00506>>01574000
          NLOGPROCS'  =  42,                                   <<00506>>01576000
          LOGIDS'=43,                                          <<01639>>01578000
        DISCREQTABLE=44,            <<DISQ REQUEST TABLE LENGTH>>       01580000
        SPECIALREQTABLE=45,         <<SPECIAL REQUEST TABLE LENGTH>>    01582000
        PRIMARYMSGTABLE=46,         <<PRIMARY REQUEST TABLE LENGTH>>    01584000
        SECNDRYMSGTABLE=48,                                    <<03707>>01586000
        SWAPTABLE=47;               <<SWAP TABLE LENGTH>>      <<01639>>01588000
                                                                        01590000
          <<------------                                                01592000
            DISC LABEL                                                  01594000
          ------------>>                                                01596000
  DEFINE  LABDTYPE  =    (6:6)#,     <<DISC TYPE>>                      01598000
          LABDSUBTYPE=   (12:4)#;    <<DISC SUBTYPE>>                   01600000
  EQUATE  LAB6      =    6,          <<7TH WORD OF ENTRY>>              01602000
          LABSYSID  =    16,         <<SYSTEM ID (BYTE)>>               01604000
          LABVOL    =    10,         <<VOLUME NAME>>                    01606000
          LABVOLB   =    20,         <<VOLUME NAME (BYTE)>>             01608000
          LABCOLDLOADID= 7;          <<COLD LOAD ID>>                   01610000
                                                                        01612000
          <<------------------------------------                        01614000
            MOVING HEAD DISC INFORMATION TABLE                          01616000
          ------------------------------------>>                        01618000
  EQUATE  MHINFOSIZE=    7,          <<ENTRY SIZE>>            <<25.02>>01620000
          MHDEFLPS  =    0,          <<DEFAULT LOGICAL PACK SIZE>>      01622000
          MHMAXLPS  =    1,          <<MAX LOGICAL PACK SIZE>>          01624000
          MHTRKCYL  =    2,          <<TRACKS/CYLINDER>>                01626000
          MHSECTRK  =    3,          <<SECTORS/TRACK>>                  01628000
          MHTRKMULT =    4,          <<TRACK MULTIPLIER>>               01630000
          MHSTHEAD  =    5;          <<STARTING HEAD #>>       <<03550>>01632000
       << MHFRSPCSCT=    6;       SECTORS IN FREE SPACE   >>   <<03550>>01634000
       <<                         TABLE--NO LONGER USED   >>   <<03550>>01636000
                                                                        01638000
          <<------------------------                                    01640000
            DEFECTIVE TRACKS TABLE                                      01642000
          ------------------------>>                                    01644000
  EQUATE  DTTALT    =    126,        <<NEXT AVAILABLE ALTERNATE>>       01646000
          DTTLPS    =    127;        <<LOGICAL PACK SIZE>>              01648000
  EQUATE  MAXDTT    =    120;        <<MAX# DTT ENTRIES>>      <<00463>>01650000
                                                               <<03549>>01652000
               <<------------------------>>                    <<03549>>01654000
               << DEFECTIVE SECTOR TABLE >>                    <<03549>>01656000
               <<------------------------>>                    <<03549>>01658000
                                                               <<03549>>01660000
  EQUATE  DSCT'NUM'ENTRIES = 0,   <<INDEX TO NO. OF ENTRIES>>  <<03549>>01662000
          DSCT'FIRST'ENTRY = 1,   <<INDEX TO FIRST ENTRY>>     <<03549>>01664000
          DSCT'ENTRY'SIZE  = 2,   <<INDEX TO ENTRY SIZE>>      <<03549>>01666000
          DSCT'MAX'ENTRIES = 3,   <<INDEX TO MAX. ENTRIES>>    <<03549>>01668000
          MAX'DSCT         = 61;  <<MAX. NO. OF ENTRIES>>      <<03549>>01670000
                                                               <<03549>>01672000
          <<-------------------------                                   01674000
            DRT ENTRY CONFIGURATION                                     01676000
          ------------------------->>                                   01678000
  EQUATE  MAXUNIT   =    127;                                  <<03002>>01680000
  INTEGER MAXDRT;                                              <<03002>>01682000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>01684000
  EQUATE                                                       <<01025>>01686000
          PI        =    1,   <<INTERRUPT CODE POINTER>>                01688000
          DBI       =    2,   <<INTERRUPT DATA POINTER>>                01690000
          LOWESTDRT =    4,   <<FIRST USABLE DRT #>>           <<00071>>01692000
          ONUNIT = 3; <<ONUNIT IS INDEX OF # OF UNITS IN DRT>> <<01300>>01694000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>01696000
  EQUATE  << IOPROGENT =    0,   IO PROGRAM POINTER>>          <<bcrap>>01698000
          DBI       =    1,   <<INTERRUPT DATA POINTER>>       <<00888>>01700000
          PI        =    2,   <<INTERRUPT CODE POINTER>>       <<00888>>01702000
          LOWESTDRT =    8;   <<FIRST USABLE DRT #>>           <<02510>>01704000
$IF  <<***** RETURN TO COMMON CODE *****>>                     <<03002>>01706000
  DEFINE  NUNIT     =    (8:8)#, <<# OF UNITS ON CONTROLLER>>  <<00888>>01708000
          NINTH     =    (0:8)#;<<#OF INTRPT HANDLERS FOR DRT>><<00888>>01710000
  EQUATE  DEVPERCHAN=    8; <<NUMBER OF DEV'S PER CHANNEL>>    <<02510>>01712000
  EQUATE  GHOSTEXTLAB=%105401;<<INT'S FROM UNCONFIGURED DRT'S>><<03603>>01714000
  EQUATE  CHANSTAT  =    3;   <<CHANNEL STATUS OFFSET>>        <<03002>>01716000
                                                                        01718000
          <<----------------------                                      01720000
            DRIVER LINKAGE TABLE                                        01722000
          ---------------------->>                                      01724000
  DEFINE  DPROC     =    0#,                                            01726000
          QNUMB     =    (0:8)#,     <<RESOURCE QUEUE NUMBER>>          01728000
          NOCREATE  =    (8:1)#,     <<1=DON'T PROCREATE>>     <<32BND>>01730000
          CORERES   =    (10:1)#,    <<CORE RESIDENT>>                  01732000
          DRVRTYPE  =    (14:2)#,    <<DRIVER TYPE>>                    01734000
          DMNTR     =    1#,         <<MONITOR PLABEL>>                 01736000
          DINIT     =    2#,         <<INITIATOR PLABEL>>               01738000
          DCOMP     =    3#,         <<COMPLETOR PLABEL>>               01740000
          DINTP     =    4#,         <<INTERRUPT PLABEL>>               01742000
          DTYPE     =    5#,                                            01744000
          DEDITOR   =    6#,         <<EDITOR PLABEL>>                  01746000
          DINTPL    =    7#,         <<INITIALIZATION PLABEL>> <<0+.04>>01748000
          DITSIZE'  =    (0:8)#,     <<DIT SIZE>>                       01750000
          DEVTYPE   =    (8:8)#,     <<DEVICE TYPE>>                    01752000
          DLTSIZE   =    8#;         <<ENTRY SIZE>>            <<0+.04>>01754000
                                                                        01756000
          <<-------------------------                                   01758000
            INTERRUPT LINKAGE TABLE                                     01760000
          ------------------------->>                                   01762000
  DEFINE                                                       <<bcrap>>01764000
          ICNTRL    =    7#,                                   <<00888>>01766000
          MCHAN     =    (0:1)#,     <<ON CHANNEL WITH OTHER CNTRLRS>>  01768000
          CHANQUE   =    (1:6)#,     <<CHANNEL RESOURCE QUEUE>><<00888>>01770000
          DRTN'     =    (7:9)#,     <<DRT NUMBER>>            <<03002>>01772000
          ISIOP     =    8#,         <<SIO AREA POINTER>>      <<00888>>01774000
          ISTAP     =    9#,       <<POINTER TO STATUS RETURN>><<00888>>01776000
<<        IUNIT     =    10#,  >>  <<UNIT EXTRACT INSTRUCTION>><<s8967>>01778000
          IQUEUE    =    12#,                                  <<00888>>01780000
          IFLAG     =    13#,        <<FLAG WORD OF ILT>>      <<00888>>01782000
<<        RUNWAIT   =    (0:1)#,   DVR REQUIRES IDLE I/O PROG>><<c8392>>01784000
          HCUNIT    =    (9:7)#,     <<HIGHEST CONFIG UNIT #>> <<03022>>01786000
<<        RUNWAIT'  =    (11:1)#,      RUNWAIT BIT IN DVR OB>> <<c8392>>01788000
          SIOPSIZE  =    (0:8)#,     <<SIO PROGRAM AREA SIZE>> <<00888>>01790000
          CNTRLRQ   =    (8:8)#,     <<CONTROLLER RESOURCE QUEUE>>      01792000
          STRETSIZE =    (8:8)#, <<SIZE OF STATUS RETURN AREA>><<00888>>01794000
          IDITP     =    14#,        <<POINTER TO FIRST DIT>>  <<00888>>01796000
          DVR'GLOBAL'VARS=6#,        <<5 VARIABLES+SEEKMASK>>  <<01962>>01798000
          ILTSIZE   =    14#;        <<SIZE OF ILT>>           <<00888>>01800000
  EQUATE                                                       <<MPEIV>>01802000
          DVRDB2    =    2,                                    <<00888>>01804000
          DVRDB3    =    3,                                    <<00888>>01806000
          DVRDB4    =    4;                                    <<00888>>01808000
  EQUATE  HARDRES'SIOAREA = 50;  << SIZE OF HARDRES SIOAREA >> <<C8065>>01810000
  DEFINE                                                       <<00888>>01812000
          INITTCP'=DVRDB4+DITSIZE+SIOSIZE+1#;                  <<00888>>01814000
          <<A SPECIAL INITIALIZATION PROGRAM FOR TERMINALS>>   <<00888>>01816000
          <<WAS NEEDED TO SOLVE A PFAIL PROBLEM.  ONLY ONE>>   <<00888>>01818000
          <<IS NEEDED AS ALL TERMINALS WILL USE IT.  THE  >>   <<00888>>01820000
          <<LENGTH IN WORDS IS LOCATED IN THE DB AREA OF  >>   <<00888>>01822000
          <<THE DRIVER IMMEDIATELY AFTER THE SIO PROGRAM  >>   <<00888>>01824000
          <<AREA WITH THE INIT PROGRAM IMMEDIATELY AFTER  >>   <<00888>>01826000
          <<THAT.  THIS SPECIAL PROGRAM WILL BE MADE CORE >>   <<00888>>01828000
          <<RESIDENT AND A SYSDB-RELATIVE POINTER TO IT   >>   <<00888>>01830000
          <<WILL BE PLACED IN THE INITTCP CELL OF SYSDB.  >>   <<00888>>01832000
                                                                        01834000
          <<--------------------------                                  01836000
            DEVICE INFORMATION TABLE                                    01838000
          -------------------------->>                                  01840000
  DEFINE  DFLAG     =    0#,                                            01842000
  <<      DISCFLAG  =    (1:1)#,       DEVICE IS A DISC>>      <<bcrap>>01844000
          TERM'     =    (0:1)#,     <<DEVICE IS TERMINAL>>             01846000
          SPECIH    =    (4:1)#,     <<SPECIAL INTERRUPT HANDLER>>      01848000
          MUNIT     =    (5:1)#,     <<MULTI-UNIT CONTROLLER>>          01850000
          DLDEV     =    3#,         <<LDEV NUMBER>>           <<DITS*>>01852000
          DDLTP     =    4#,         <<DLT POINTER>>                    01854000
          DILTP     =    5#,         <<ILT POINTER>>                    01856000
          DPCBN     =    8#,         <<PROCESS PIN>>           <<DITS*>>01858000
          DUNIT     =   10#;         <<IOT + UNIT NUMBERS>>    <<DITS*>>01860000
                                                                        01862000
          <<------------                                                01864000
            I/O TABLES                                                  01866000
          ------------>>                                                01868000
  EQUATE  IOHEADSIZE=    12,         <<TABLE HEADER>>          <<IOTAB>>01870000
          SECSBUF   =    2,          <<RESERVED SBUF PORTION>>          01872000
          SECIOQ    =    6,          <<RESERVED IOQ PORTION>>           01874000
          IOPROCSIZE=    10,         <<TEMPORARY PROCESS TABLE>>        01876000
          INTRSIZE  =    3;          <<TEMPORARY INTERRUPT TABLE>>      01878000
                                                                        01880000
          <<------------------                                          01882000
            MEMORY MANAGEMENT                                           01884000
          ------------------->>                                         01886000
                                                               <<MPEIV>>01888000
$INCLUDE INCLREGI                                              <<jb.dc>>01890000
                                                               <<MPEIV>>01892000
  EQUATE  PAGEPOWER  =  7, <<8>>                               <<MPEIV>>01894000
          MMPAGESIZE  =  128, <<256>>                          <<MPEIV>>01896000
          MAXHOLESIZE  =  512,                                 <<MPEIV>>01898000
          NWORDPAGE =    512,        <<# OF WORDS PER PAGE>>            01900000
          NSECTPAGE =    NWORDPAGE/128, <<# OF SECTORS PER PAGE<<xddf2>>01902000
          WELMESPAGES=   (LOGONDSTSIZE+NWORDPAGE-1)/NWORDPAGE, <<MPEIV>>01904000
          JMATPAGES  =   (MAXJMSIZE+NWORDPAGE-1)/NWORDPAGE,    <<MPEIV>>01906000
          IDDPAGES   =   (MAXIDDSIZE+NSECTPAGE-1)/NSECTPAGE,   <<xddf2>>01908000
          ODDPAGES   =   (MAXODDSIZE+NSECTPAGE-1)/NSECTPAGE;   <<xddf2>>01910000
                                                                        01912000
          <<-----                                                       01914000
            ICS                                                         01916000
          ----->>                                                       01918000
  EQUATE  ICSQMINUS =    64,          <<SIZE OF Q MINUS AREA>> <<MPEIV>>01920000
          PSTA      =    15,         <<PSUEDO INTERRUPT STATUS>>        01922000
          PADDR     =    14,         <<PSEUDO INTERRUPT STARTING ADDR>> 01924000
          JCUT'     =    11,         <<ABSOLUTE ADDRESS OF JCUT>>       01926000
          XP        =    10,         <<CURRENT PROCESS PCB>>            01928000
          Z'        =    8,          <<STACK DB RELATIVE Z>>            01930000
          DL'       =    7,          <<STACK DB RELATIVE DL>>           01932000
          SBANK'    =    5,          <<STACK BANK>>                     01934000
          STDB'     =    4;          <<STACK DB>>                       01936000
                                                                        01938000
          <<----------------                                            01940000
            SYSTEM DEVICES                                              01942000
          ---------------->>                                            01944000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>01946000
  EQUATE  CONSOLEDRT=    7,          <<SYSTEM CONSOLE/CLOCK>>           01948000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>01950000
  EQUATE  CONSOLEDRT=    8,          <<SYSTEM CONSOLE>>        <<00888>>01952000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>01954000
          SYSDISC   =    1;          <<SYSTEM DISC LDEV #>>    <<MPEIV>>01956000
          << ----------- >>                                    <<02510>>01958000
          << FIXED CELLS >>                                    <<02510>>01960000
          << ----------- >>                                    <<02510>>01962000
  EQUATE  CSTP      =    0,    <<CST POINTER>>                 <<02510>>01964000
  <<      CSTXP     =    1,      CST EXTENSION POINTER>>       <<bcrap>>01966000
          DSTP      =    2,    <<DST POINTER>>                 <<02510>>01968000
          PCBP      =    3,    <<PROCESS CONTROL>>             <<02510>>01970000
                               <<BLOCK POINTER>>               <<02510>>01972000
          CPCB      =    4,    <<CURRENT PROCESS >>            <<02510>>01974000
                               <<CONTROL BLOCK>>               <<02510>>01976000
          QI        =    5,    <<Q FOR ICS>>                   <<02510>>01978000
          ZI        =    6,    <<Z FOR ICS>>                   <<02510>>01980000
          DRTBANK   =    8,    <<BANK FOR DEV REF TAB>>        <<02510>>01982000
          DRTADDR   =    9,    <<ADDR FOR DEV REF TAB>>        <<02510>>01984000
          DBBANK    =   10,    <<DBBANK FOR INITIAL'S STACK>>  <<02510>>01986000
          DB        =   11;    <<DB FOR INITIAL'S STACK>>      <<02510>>01988000
  EQUATE  SDTYPE    =    1;    <<FOR BOOTSTRAP-SYS-DISC TYPE>> <<02510>>01990000
                               <<DEVICE TYPE OF SYSTEM DISC>>  <<02510>>01992000
                               <<NEEDED DURING COOLSTART/ >>   <<02510>>01994000
                               <<WARMSTART BOOTSTRAP AND>>     <<02510>>01996000
                               <<READTAPES OF UPDATE>>         <<02510>>01998000
                                                               <<02510>>02000000
                               <<12-18 ARE FREE TO INITIAL>>   <<02510>>02002000
                               <<19-23 ARE USED BY THE >>      <<02510>>02004000
                               <<  MICRO-CODE FOR SYSTEM >>    <<02510>>02006000
                               <<  AND PROCESS CLOCKS>>        <<02510>>02008000
                               <<24 IS FREE TO INITIAL>>       <<02510>>02010000
                                                               <<02510>>02012000
  EQUATE  SPEEDCODE = %1420;  <<ADCC CODE FOR CONSOLE SPEED>>  <<03003>>02014000
$IF      << ******** RETURNING TO COMMON CODE ********* >>     <<03603>>02016000
                                                               <<02510>>02018000
  EQUATE  SIOPROG   =  %1410;  <<SIO PROGRAM BUFFER>>          <<02510>>02020000
                                                               <<02510>>02022000
  EQUATE  TEMP'CPVA =  %1400,  <<THRU %1407 TEMPORARY >>       <<02510>>02024000
                               <<CHAN PROG VARIABLE AREA>>     <<02510>>02026000
          CHANPROG  =  %1410,  <<DISC CHAN PROG BUFFER>>       <<02510>>02028000
          TERMCHANPROG=%1411,  <<CHAN PROG BUF FOR CONSOLE>>   <<03603>>02030000
          TAPECHANPROG=%1412;  <<CHAN PROG BUF FOR TAPE>>      <<02510>>02032000
                                                               <<02510>>02034000
  EQUATE  ABSFLAGS  =  %1421;  <<FLAGS FOR INITIAL>>           <<02510>>02036000
          <<  BIT 15 - STARFISH >>                             <<02510>>02038000
          <<  BIT 14 - 7976 MAGTAPE >>                         <<03672>>02040000
          <<  BIT 12 - HP26XX, USED BY TERMINAL DRIVER >>      <<03672>>02042000
          <<  BIT 11 - CS80'LOCK, USED BY CS80'DRIVER >>       <<03672>>02044000
            <<---------------------------------->>             <<03003>>02046000
            << SYSTEM CONSOLE DRIVER PARAMETERS >>             <<03003>>02048000
            <<---------------------------------->>             <<03003>>02050000
  DEFINE  BAUDRATE =   << BAUDRATE CODE FOR HARDWARE >>        <<03003>>02052000
                     ABSOLUTE( SPEEDCODE)#,                    <<03003>>02054000
          CHARCNT  =   << CURRENT COUNT FOR WRITECHAR >>       <<03003>>02056000
                     ABSOLUTE( %1422)#,                        <<03003>>02058000
          HP26XX   =   << TRUE IF CONSOLE IS A 26XX >>         <<03003>>02060000
                     ABSOLUTE( ABSFLAGS).(12:1)#,              <<03003>>02062000
          CONSPEED =   << CONSOLE BAUD RATE  >>                <<03003>>02064000
                     ABSOLUTE( %1423)#;                        <<03003>>02066000
          << COUNT DISC ACCESSES >>                            <<D9089>>02068000
                                                               <<D9089>>02070000
          DEFINE                                               <<D9089>>02072000
             TOTDA     = %1440D#, << TOTAL DISC ACCESS  >>     <<D9089>>02074000
             DIRCDA    = %1442D#, << DIRECTORY ACCESS   >>     <<D9089>>02076000
             FREEDA    = %1444D#, << DFS TABLE ACCESS   >>     <<D9089>>02078000
             FRFWDA    = %1446D#; << FREAD/FWRITE ACCESS>>     <<D9089>>02080000
                                                               <<D9089>>02082000
          <<-----------------------                                     02084000
            LOGICAL PROCESS TABLE                                       02086000
          ----------------------->>                                     02088000
  EQUATE  PROGPROC  =    0,          <<PROGENITOR>>                     02090000
<<******    # 1 IS FREE   *******************>>                <<PORTS>>02092000
          UCOPPROC  =    2,          <<USER CONTROLLER>>                02094000
          PFAILPROC =    3,          <<POWER FAIL>>                     02096000
          DEVRECPROC=    4,          <<DEVICE RECOGNITION>>             02098000
          NMMONPROC =    5,          << NM MONITOR PROCESS >>  <<AL.00>>02100000
<<*********************    #6 IS FREE     *******************>><<00.EB>>02102000
          LOGPROC   =    7,          <<LOGGING>>                        02104000
          LOADPROC  =    8,          <<LOADER>>                         02106000
   <<     IOMESSPROC=    9,   >>     <<I/O MESSAGES AND LOGGING<<*8392>>02108000
           SIOPROC   =     10,          <<SYSTEM I/O PROCESS>>          02110000
           MEMLGPROC =     11;          <<MEMLOGP>>                     02112000
                                                                        02114000
          <<--------------------                                        02116000
            PROCESS STACKSIZES                                          02118000
          -------------------->>                                        02120000
  EQUATE  PROGSTACK  =   1536,       <<PROGENITOR STACK>>      <<00071>>02122000
          CRIOSTACK =    388,        <<RESIDENT I/O STACK>>    <<00181>>02124000
          LKIOSTACK =   1024,        <<LINKED I/O STACK>>      <<01735>>02126000
          NMMONSTACK =   4096,       << NM MONITOR STACK >>    <<AL.00>>02128000
          DEVRECSTACK=   800,        <<DEVICE RECOGNITION>>             02130000
          UCOPSTACK =    512,        <<USER CONTROLLER STACK>>          02132000
          PFAILSTACK=    256,        <<POWER FAIL STACK>>               02134000
          LOGSTACK  =    1536,     << Logging >>               <<03551>>02136000
<<        IOMESSSTACK=   4096,  >>   <<IO messages stack>>     <<*8392>>02138000
          SYSPORTSTACK = 3500,       <<ICS PORT SERVER STACK>> <<PORTS>>02140000
          LOADSTACK =    1000,       <<LOAD PROCESS STACK>>             02142000
          MEMLGSTACK =   1856,     << MEMLOGP STACK >>         <<03551>>02144000
          PVSTACK   =    512;        <<PV PROCESS STACK>>      <<RH.PV>>02146000
                                                                        02148000
          <<--------------------                                        02150000
            PROCESS PRIORITIES                                          02152000
          -------------------->>                                        02154000
  EQUATE                                                       <<03552>>02156000
          PFAILPRI  =    10,         <<POWER FAIL RESTART>>             02158000
          PROGPRI   =    49,         <<PROGENITOR>>                     02160000
          LOGPRI    =    50,         <<LOGGING>>                        02162000
          IOPRI     =    50,         <<I/O PROCESSES>>                  02164000
  <<      IOMESSPRI =    120, >>  <<IO messages and logging>>  <<*8392>>02166000
          UCOPPRI   =    125,        <<USER CONTROLLER>>                02168000
          DEVRECPRI =    125,        <<DEVICE RECOGNITION>>             02170000
          MEMLGPRI  =    125,        <<MEMLOGP>>                        02172000
          NMMONPRI  =    149,        << NM MONITOR PRI >>      <<AL.00>>02174000
          PVPRI     =    125,        <<PV PROCESS PRI>>        <<RH.PV>>02176000
          SYSPORTPRI =   149,        <<ICS PORT SERVER PRI>>   <<PORTS>>02178000
          LOADPRI   =    142;        <<LOAD PROCESS>>                   02180000
                                                                        02182000
          <<-----------                                                 02184000
            STOP BITS                                                   02186000
          ----------->>                                                 02188000
  EQUATE  UCOPSBIT  =    0,          <<UCOP STOP BIT>>                  02190000
          LOGSBIT   =    1,          <<LOG STOP BIT>>                   02192000
          DEVRECSBIT=    2,          <<DEVREC STOP BIT>>                02194000
    <<     IOMESSSBIT=     3,  >>       <<I/O MESSAGE>>        <<*8392>>02196000
           MEMLGSBIT =     4,           <<MEMLOGP>>            <<AL.00>>02198000
           NMMONBIT  =     5;           << NM MONITOR >>       <<AL.00>>02200000
                                                                        02202000
          <<---------------                                             02204000
            SEGMENT TABLE                                               02206000
          --------------->>                                             02208000
EQUATE SEGDIRLEN= 730,   <<DIRECTORY SIZE>>                    <<*MAP*>>02210000
       SEGTPDB  = 38,    <<PRIMARY DB AREA>>                   <<*MAP*>>02212000
       SEG'HEAD = 20,    <<ADR OF HEAD LINKS FOR ENTRIES>>     <<*MAP*>>02214000
       SEG'TAIL = 29,    <<ADR OF TAIL LINKS FOR ENTRIES>>     <<*MAP*>>02216000
       SEGLCTLEN= 22,    <<LENGTH OF LCT>>                     <<*MAP*>>02218000
          SLTYP     =    1;          <<SL ENTRY TYPE>>         <<01025>>02220000
                                                                        02222000
          <<--------------------                                        02224000
            CONFIGURATION FILE                                          02226000
          -------------------->>                                        02228000
  DEFINE  CTAB0RECNUM=   0D#,        <<STD CONFIGURATION RECORD<<DEVCO>>02230000
          CTABRECNUM=    1D#;        <<CORESIZE-RELATED CONFIG. REC>>   02232000
                                                               <<DEVCO>>02234000
          <<------------------------------->>                  <<DEVCO>>02236000
          <<   DEVICE CONFIGURATION FILE   >>                  <<DEVCO>>02238000
          <<------------------------------->>                  <<DEVCO>>02240000
                                                               <<DEVCO>>02242000
  DEFINE  DEVCHECKSUM   = DEVREC0#,  <<RECORD 0 CHECKSUM>>     <<DEVCO>>02244000
          DEVVERSION    = DEVREC0(1)#, << FILE VERSION >>      <<DEVCO>>02246000
          DEVNEXT       = DEVREC0(2)#, << NEXT AVAIL REC >>    <<DEVCO>>02248000
          DEVHLDEV      = DEVREC0(3)#, << HIGHEST LDEV >>      <<DEVCO>>02250000
          DEVHDRT       = DEVREC0(4)#, << HIGHEST DRT  >>      <<DEVCO>>02252000
          DEVNRADVRS    = DEVREC0(5)#; << NR ADD'L DVR >>      <<DEVCO>>02254000
                                                               <<DEVCO>>02256000
  EQUATE  DEVTABENTRIES =  64, << START TABLE OF ENTRIES >>    <<DEVCO>>02258000
          DEVREC0SIZE   = 128, << SIZE OF PARMS REC >>         <<DEVCO>>02260000
          DEVCURVERSION =   1; << CURRENT DEV FILE VERSION >>  <<DEVCO>>02262000
  EQUATE  DEVDVR        =  0,    << DRIVER TABLE >>            <<DEVCO>>02264000
          DEVLPDT       =  1,    << LPDT         >>            <<DEVCO>>02266000
          DEVLDT        =  2,    << LDT          >>            <<DEVCO>>02268000
          DEVLDTX       =  3,    << LDTX         >>            <<DEVCO>>02270000
          DEVDCTH       =  4,    << DEV CLASS HDR>>            <<DEVCO>>02272000
          DEVDCT        =  5,    << CLASS TABLE  >>            <<DEVCO>>02274000
          DEVTTDT       =  6,    << TTDT         >>            <<DEVCO>>02276000
          DEVCSDVR      =  7,    << ADD'L CS DVR >>            <<DEVCO>>02278000
          DEVCSDEF      =  8,    << CS DEF TABLE >>            <<DEVCO>>02280000
          DEVCSTAB      =  9;    << CS TABLE     >>            <<DEVCO>>02282000
                                                               <<DEVCO>>02284000
equate                                                         <<t8392>>02286000
   defcurversion      = 1,                                     <<t8392>>02288000
   defrec0size        =128;                                    <<t8392>>02290000
                                                               <<t8392>>02292000
define                                                         <<t8392>>02294000
   tlh'checksum       = tl'head(0)                #,           <<t8392>>02296000
   tlh'version        = tl'head(1)                #,           <<t8392>>02298000
   tlh'table'size     = tl'head(2)                #,           <<t8392>>02300000
   tlh'ent'size       = tl'head(3)                #,           <<t8392>>02302000
   tlh'num'entries    = tl'head(4)                #,           <<t8392>>02304000
   tlh'first'entry'ptr= tl'head(5)                #;           <<t8392>>02306000
                                                               <<t8392>>02308000
                                                               <<t8392>>02310000
define                                                         <<t8392>>02312000
   tl'dev'name        = tl'entb(0)                 #,          <<t8392>>02314000
   tl'ent'size        = tl'ent( 8)                 #,          <<t8392>>02316000
   tl'num'dev'class   = tl'ent( 9)                 #,          <<t8392>>02318000
   tl'dev'class'ptr   = tl'ent(10)                 #,          <<t8392>>02320000
   tl'ttdf'ptr        = tl'ent(11)                 #,          <<t8392>>02322000
   tl'def'out'dev     = tl'ent(12)                 #,          <<t8392>>02324000
   tl'cs'ldtx'ptr     = tl'ent(13)                 #,          <<t8392>>02326000
   tl'ldev'num        = tl'ent(14)                 #,          <<t8392>>02328000
   tl'id'code         = tl'ent(15)                 #,          <<t8392>>02330000
   tl'drt'num         = tl'ent(16)                 #,          <<t8392>>02332000
   tl'unit'num        = tl'ent(17)                 #,          <<t8392>>02334000
   tl'dev'type        = tl'ent(18).( 0: 6)         #,          <<t8392>>02336000
   tl'dev'subtype     = tl'ent(18).( 6: 4)         #,          <<t8392>>02338000
   tl'job'accept      = tl'ent(18).(10: 1)         #,          <<t8392>>02340000
   tl'data'accept     = tl'ent(18).(11: 1)         #,          <<t8392>>02342000
   tl'interactive     = tl'ent(18).(12: 1)         #,          <<t8392>>02344000
   tl'duplicative     = tl'ent(18).(13: 1)         #,          <<t8392>>02346000
   tl'spool'state     = tl'ent(18).(14: 2)         #,          <<t8392>>02348000
   tl'chan'num        = tl'ent(19).( 0: 3)         #,          <<t8392>>02350000
   tl'core'res        = tl'ent(19).( 3: 1)         #,          <<t8392>>02352000
   tl'cs'dev          = tl'ent(19).( 4: 1)         #,          <<t8392>>02354000
   tl'spool'queues    = tl'ent(19).( 5: 1)         #,          <<t8392>>02356000
   tl'def'out'class   = tl'ent(19).( 6: 1)         #,          <<t8392>>02358000
   tl'auto'incr       = tl'ent(19).( 7: 1)         #,          <<t8392>>02360000
   tl'rec'width       = tl'ent(19).( 8: 8)         #,          <<t8392>>02362000
   tl'term'type       = tl'ent(20).( 0: 7)         #,          <<t8392>>02364000
   tl'auto'reply      = tl'ent(20).( 7: 1)         #,          <<s8967>>02366000
   tl'term'speed      = tl'ent(21)                 #,          <<t8392>>02368000
   tl'driver'name     = tl'entb(54)                #;          <<t8392>>02370000
                                                               <<t8392>>02372000
INTEGER ARRAY DEFREC0( 0 : DEFREC0SIZE - 1);                   <<t8392>>02374000
                                                               <<t8392>>02376000
          <<--------------                                              02378000
            SIO COMMANDS                                                02380000
          -------------->>                                              02382000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>02384000
  EQUATE  SIORES    =    %10000,     <<RETURN RESIDUE>>                 02386000
          SIOBANK   =    %14000,     <<SET BANK REGISTER>>              02388000
          SIOEND    =    %30000,     <<END>>                            02390000
          SIOENDINT =    %34000,     <<END WITH INTERRUPT>>             02392000
          SIOCNTRL  =    %40000,     <<CONTROL>>                        02394000
          SIOWRITE  =    %60000,     <<WRITE>>                          02396000
          SIOREAD   =    %70000;     <<READ>>                           02398000
$IF << ****** RETURNING TO COMMON CODE ****** >>               <<02510>>02400000
                                                                        02402000
          <<--------------->>                                  <<02510>>02404000
          <<  IMB ADAPTER  >>                                  <<02510>>02406000
          <<--------------->>                                  <<02510>>02408000
  DEFINE  MB0        = ABSOLUTE(%770)#,                        <<02510>>02410000
          MB1        = ABSOLUTE(%771)#,                        <<02510>>02412000
          MB2        = ABSOLUTE(%772)#,                        <<02510>>02414000
          MB3        = ABSOLUTE(%773)#,                        <<02510>>02416000
          MB4        = ABSOLUTE(%774)#;                        <<02510>>02418000
  EQUATE  ADAPTERDRT = %175;                                   <<02510>>02420000
  DEFINE  STARFISH   = ABSOLUTE(ABSFLAGS).(15:1)#;             <<02510>>02422000
                                                               <<02510>>02424000
          <<------------------------                                    02426000
            DISC TYPES AND SUBTYPES                                     02428000
          ------------------------->>                                   02430000
  EQUATE  MHDISCTYPE=    0,          <<MOVING HEAD DISC>>               02432000
          FHDISCTYPE=    1,          <<FIXED HEAD DISC>>                02434000
          NMHSUBTYPES = 14;     <<# OF MOVING HEAD SUBTYPES>>  <<00904>>02436000
  EQUATE  UH7900    =   0,          <<UPPER HALF OF 7900 SUBTYPE>>      02438000
          UH7905    =   4,           <<SUBTYPE 7905 UP. HALF>> <<RH.PV>>02440000
          S7920     =   8,           <<SUBTYPE 7920>>          <<RH.PV>>02442000
          S7925     =   9;           <<SUBTYPE 7925>>          <<25.03>>02444000
  EQUATE  UH7906    =   10,      <<UPPER HALF OF 7906 SUBTYPE>><<00071>>02446000
          LH7906    =   11,      <<LOWER HALF OF 7906 SUBTYPE>><<00071>>02448000
          S7910     =   13,   <<SUBTYPE 7910--NOT SUPPORTED>>  <<03550>>02450000
        << ******** TYPE 3 (CS'80) SUBTYPES ******** >>        <<03550>>02452000
          BUFFALO   =   3,    << SUBTYPE OF BUFFALO >>         <<*8392>>02454000
          LINUS     =   0;    << SUBTYPE OF LINUS >>           <<03550>>02456000
    <<    S7911     =   1, >> << SUBTYPE OF 7911 >>            <<03635>>02458000
    <<    S7912     =   2, >> << SUBTYPE OF 7912 >>            <<03635>>02460000
    <<    S7935     =   8; >> << SUBTYPE OF 7935 >>            <<bcrap>>02462000
                                                                        02464000
          <<---------------                                             02466000
            TAPE COMMANDS                                               02468000
          --------------->>                                             02470000
  EQUATE REWUNLOAD =    1, <<REWIND AND UNLOAD THE TAPE>>      <<00678>>02472000
         FWDSPFILE =    2, <<FORWARD SPACE FILE>>              <<00678>>02474000
         TAPEREADY =    3, <<WAIT FOR TAPE TO BE READIED>>     <<00678>>02476000
         REWIND    =    4; <<ONLY USED FOR SERIAL DISCS>>      <<00678>>02478000
          <<------------                                                02480000
            TAPE LABEL                                                  02482000
          ------------>>                                                02484000
  DEFINE  LABELTEXT =    "STORE/RESTORE LABEL-HP/3000."#,               02486000
          XFIELD    =    LBUF(21)#,  <<FILE CONTINUED ON NEXT TAPE>>    02488000
          ZFIELD    =    LBUF(22)#,  <<END OF TAPE SET>>                02490000
          REELNUM   =    LBUF(23)#,  <<REEL NUMBER>>                    02492000
          CHDATE    =    LBUF(24)#,  <<DATE>>                           02494000
          CHHHMM    =    LBUF(25)#;  <<HOURS AND MINUTES>>     <<01025>>02496000
                                                                        02498000
          <<----------------------------------                          02500000
            DISC COLD LOAD INFORMATION TABLE                            02502000
          ---------------------------------->>                          02504000
  EQUATE  INFOSIZE  =    256,        <<TABLE SIZE>>                     02506000
          INFOSECTOR=    28,         <<SECTOR NUMBER IN MPE2B>><<00.DL>>02508000
          TABPTR    =    0,          <<PTR TO TABLE INFORMATION>>       02510000
          TCSTPTR   =    1,          <<PTR TO TCST INFO>>               02512000
          NREAD     =    2,          <<# OF ENTRIES TO READ>>           02514000
          NUTCST'   =    3,          <<NUMBER OF ENTRIES IN TCST AREA>> 02516000
          INITDB    =    4,          <<DB FOR INITIAL>>                 02518000
          INITDL    =    5,          <<DL FOR INITIAL>>                 02520000
          INITZ     =    6,          <<Z FOR INITIAL>>                  02522000
          INITQ     =    7,          <<Q FOR INITIAL>>                  02524000
          INITS     =    8,          <<S FOR INITIAL>>                  02526000
          DISCTST   =    9,          <<SYS DISC TYPE & SUBTYPE>>        02528000
          COLD'LOAD'ID'= 10,         <<COLD LOAD ID>>                   02530000
          DIRADR    =    6,          <<DIRECTORY ADDRESS (DOUBLE)>>     02532000
          VIRMEMADR =    7,          <<VIRTUAL MEMORY ADDRESS (DOUBLE)>>02534000
          NLOGPROCS   =   16,                                  <<00506>>02536000
          LOGIDS      =   17,                                  <<00506>>02538000
          RINADR    =    9,          <<RIN TABLE ADDRESS (DOUBLE)>>     02540000
          DIRSECT   =    20,         <<DIRECTORY SIZE>>                 02542000
          VIRMEMSECT=    21,         <<VIRTUAL MEMORY SIZE>>            02544000
          RINSECT   =    23,         <<RIN TABLE SIZE>>                 02546000
          RINS      =    24,         <<# OF RINS>>                      02548000
          GRINS     =    25,         <<# OF GLOBAL RINS>>               02550000
          LOADMODE  =    26,         <<TYPE OF COLD LOAD>>              02552000
          H'VOL'    =    27,         <<HIGHEST VOLUME #>>               02554000
          DISCENTRY =    28,         <<DISC COLD LOAD ENTRY POINT>>     02556000
          SYSDISCDRT'=   29,         <<SYSTEM DISC DRT #>>              02558000
          JMATLOC   =    15,      <<JMAT DISC ADDRESS>>                 02560000
          IDDLOC    =    16,      <<IDD DISC ADDRESS>>                  02562000
          ODDLOC    =    17,      <<ODD DISC ADDRESS>>                  02564000
          LOGONLOC1 =    18,      <<DISC ADDRESS OF WELCOME DST>>       02566000
          LOGONLOC2 =    19,      <<DISC ADDR OF WELCOME DST>>          02568000
          LOGIDADDR   =   20,                                  <<00506>>02570000
          LOGTABADDR  =   21,                                  <<00506>>02572000
          LOGIDSECT   =   44,                                  <<00506>>02574000
          LOGTABSECT  =   45,                                  <<00506>>02576000
          LOWINFOWORDS=   46,                                  <<00506>>02578000
          NTABLES   =    16,         <<#ENTS IN TABLE AREA>>   <<t8392>>02580000
          DVRINFOX  =     0,    <<DRIVER TABLE>>                        02582000
          CTAB0INFOX=     5,    <<STD CONFIGURATION>>                   02584000
          CTABINFOX =    10,    <<CORESIZE-RELATED CONFIGURATION>>      02586000
          CSDVRINFOX=    15,    <<EXTRA CS DRIVERS>>                    02588000
          CSDEFINFOX=    20,    <<DEFAULT LINE DESCRIPTORS>>            02590000
          CSTABINFOX=    25,    <<CS DATA SEGMENT>>                     02592000
          LPDTINFOX =    30,    <<LOG-PHYS DEVICE TABLE>>               02594000
          LDTINFOX  =    35,    <<LOGICAL DEVICE TABLE>>                02596000
          DVCLINFOX =    40,    <<DEVICE CLASS TABLE>>                  02598000
          VTABINFOX =    45,    <<VOLUME TABLE>>                        02600000
          LDTXINFOX =    50,    <<LOG. DEV. TABLE EXTENSION>>           02602000
          STACKINFOX=    55,    <<STACK FOR INITIAL>>                   02604000
          DCTHINFOX    = 60,    << DEV CLASS TAB HDR >>                 02606000
          TTDTINFOX =    65,    <<TERMTYPE DESC TAB>>                   02608000
          COMMINFOX =    70,    <<SYSDUMP/INITIAL COMM>>       <<t8392>>02610000
          TLBUFINFOX=    75;    <<TABLE LOOKUP BUFFER>>        <<t8392>>02612000
  DEFINE  INFODTYPE =    (6:6)#,     <<SYSTEM DISC TYPE>>               02614000
          INFODSUBTYPE=  (12:4)#,    <<SYSTEM DISC SUBTYPE>>            02616000
          TLMODE    =    (13:1)#,    <<COLD LOAD FROM TAPE>>            02618000
          RLMODE    =    (14:1)#,    <<RELOAD>>                         02620000
          RYMODE    =    (15:1)#;    <<RECOVERY>>                       02622000
                                                                        02624000
          <<----------------------->>                          <<CONFD>>02626000
          <<  COLD LOAD EXT TABLE  >>                          <<CONFD>>02628000
          <<----------------------->>                          <<CONFD>>02630000
                                                               <<CONFD>>02632000
  DEFINE  CLEXTSECT       = 32D#;                              <<CONFD>>02634000
  EQUATE  LOG'FILE'NUM'   = 21;                                <<CONFD>>02636000
                                                               <<CONFD>>02638000
EQUATE SIOCOREADR = %1000;                                     <<c8392>>02640000
$IF X1=ON                                                      <<c8392>>02642000
  DEFINE  COMMSECTOR  = 31D#;                                  <<c8392>>02644000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<c8392>>02646000
  DEFINE  ININ'HALT = ASSEMBLE( HALT 1 )#;                     <<03603>>02648000
                                                                        02650000
          <<-----------------------                                     02652000
            CONFIGURATION OPTIONS                                       02654000
          ----------------------->>                                     02656000
  EQUATE  WARM      =    0,          <<WARMSTART>>                      02658000
          COOL      =    1,          <<COOLSTART>>                      02660000
          COLD      =    2,          <<COLDSTART>>                      02662000
          UP        =    3,          <<UPDATE>>                         02664000
          REL       =    4,          <<RELOAD>>                         02666000
          SPRD      =    4,          <<SPREAD>>                         02668000
          REST      =    6,          <<RESTORE>>                        02670000
          NRELOPTS  =    5,          <<# OF RELOAD OPTIONS>>            02672000
          NOPT      =    3;          <<NUMBER OF OPTIONS>>              02674000
  DEFINE  SPREAD    =    (OPT=SPRD)#,   <<SPREAD,ACC,NULL>>    <<03714>>02676000
          RESTORING =    (OPT>SPRD)#,   <<COMPACT,RESTORE>>    <<03714>>02678000
          UPDATE    =    (OPT=UP)#,     << UPDATE >>           <<03714>>02680000
          RESTORE   =    (OPT=REST)#,   << RESTORE >>          <<03714>>02682000
          WARMSTART =    (OPT=WARM)#;   << WARM >>             <<03714>>02684000
                                                                        02686000
          <<THE MICROCODE WILL STORE THE CONTROL B COMMAND>>   <<F8392>>02688000
          <<INTO QI-11 (ABS 5)  (SERIES 37 ONLY) >>            <<F8392>>02690000
                                                               <<F8392>>02692000
  DEFINE  STARTTYPE =    ABS(ABS(5)-11)#;                      <<F8392>>02694000
  EQUATE  CBSTART   =    0,          <<START,DISC,DISK>>       <<F8392>>02696000
          CBWARM    =    1,          <<WARM, NO DIALOGUE>>     <<F8392>>02698000
          CBCOOL    =    2,          <<COOL, NO DIALOGUE>>     <<F8392>>02700000
          CBLOAD    =    %10,        <<LOAD,TAPE>>             <<F8392>>02702000
          CBUP      =    %11,        <<UPDATE, NO DIALOG>>     <<F8392>>02704000
          CBCOLD    =    %12,        <<COLDSTART, NO DIALOG>>  <<F8392>>02706000
          CBREL     =    %13,        <<RELOAD SPR, NO DIALOG>> <<F8392>>02708000
          CBNEW     =    %14,        <<RELOAD SPR, NO DIALOG>> <<F8392>>02710000
          CBDUMP    =    %20;        <<DUMP>>                  <<F8392>>02712000
                                                               <<F8392>>02714000
          <<------------------------                                    02716000
            DIRECTORY DATA SEGMENT                                      02718000
          ------------------------>>                                    02720000
  EQUATE  DIRMAXENTZ=    54,                                   <<RV.PV>>02722000
          DIRX      =    22,                                            02724000
          DIRY      =    16+2,                                 <<RV.PV>>02726000
          DIRZ      =    139,                                  <<38.PV>>02728000
  <<      DSAIBZ    =    3,   >>                               <<bcrap>>02730000
  <<      DAUIBZ    =    1,   >>                               <<bcrap>>02732000
  <<      DAGIBZ    =    1,   >>                               <<bcrap>>02734000
  <<      DGVSIBZ   =    1,   >>                               <<bcrap>>02736000
  <<      DGFIBZ    =    2,   >>                               <<bcrap>>02738000
  <<      DAEBZ     =    3,   >>                               <<bcrap>>02740000
  <<      DUEBZ     =    2,   >>                               <<bcrap>>02742000
  <<      DGEBZ     =    2,   >>                               <<bcrap>>02744000
  <<      DFEBZ     =    2,   >>                               <<bcrap>>02746000
          DVSEBZ    =    1,                                    <<RV.PV>>02748000
          DMAXBZ    =    3,                                             02750000
          DIRLEN    =    ((2*DIRX+DIRY+DIRZ+256*DMAXBZ+DIRMAXENTZ+3)/4) 02752000
                           *4;                                          02754000
                                                                        02756000
 DEFINE  << FILE LABEL DEFINITION >>                                    02758000
 FLFILECODE  =FLAB(26)#,       << FILE CODE >>                          02760000
 FLFCBVECT   =FLABDBL(16)#,    << FCB VECTOR >>                <<*FLAB>>02762000
 FLFLIM      =FLABDBL(15)#,    << FILE LIMIT >>                         02764000
 FLPVINFO    =FLAB (27) #,     << PVINFO WORD >>               <<*FLAB>>02766000
 FLCHECKSUM  =FLAB (34)#,      <<CHECKSUM OF FLAB CONTENTS>>            02768000
                      <<EXCLUDING FLCHECKSUM,FLCLID & MISC INDICES>>    02770000
 FLCLID      =FLAB(35)#,       << COLD LOAD ID >>                       02772000
 FLFOPTIONS  =FLAB(36)#,       << FOPTIONS >>                           02774000
 FLRECSIZE   =FLAB(37)#,       << RECORD SIZE >>                        02776000
 FLBLKSIZE   =FLAB(38)#,       << BLOCK SIZE >>                         02778000
 FLSECTOFF   =FLAB(39).(0:8)#, << SECTOR OFFSET TO DATA >>              02780000
 FLNUMEXTS   =FLAB(39).(11:5)#,<<NUMBER OF EXTENTS>>                    02782000
 FLNEXTWORD  =FLAB(39)#,                                                02784000
 FLLASTEXTSIZE=FLAB(40)#,      <<SIZE OF LAST EXTENT>>                  02786000
 FLEXTSIZE   =FLAB(41)#,       << EXTENT SIZE >>                        02788000
FLCLASS     =FLAB(124)#,      <<FILE DISC CLASS>>                       02790000
FLCLASSB    =BFLAB(248)#,                                               02792000
 FLEOF       =FLABDBL(21)#,    << END-OF-DATA POINTER >>                02794000
 FLEXT0      =FLABDBL(22)#,    <<1ST EXTENT>>                           02796000
EXT0        =22#,                                                       02798000
 FLEXTMAP    =FLAB(44)#;       << ORIGIN OF EXTENT MAP >>               02800000
                                                                        02802000
 DEFINE                                                                 02804000
 CHECKSUM    =                                                          02806000
     X := 127;                                                          02808000
     TOS := -1;                                                         02810000
     DO BEGIN                                                           02812000
            IF X <> FLCHECKSUMX AND                                     02814000
              X <> FLMISCX AND X<> FLCLIDX THEN                         02816000
              TOS:=TOS XOR LOGICAL (FLAB (X));                          02818000
            X:=X-1;                                                     02820000
        END UNTIL <#,                                                   02822000
 FLMISCX     =28#,             <<LOAD,READ,ETC INDEX>>                  02824000
 FLCHECKSUMX =34#,             <<CHECKSUM INDEX>>                       02826000
 FLCLIDX     =35#;             <<COLD LOAD ID INDEX>>                   02828000
  EQUATE  FCBSIZE   =    72,                                            02830000
          FCBDSIZE  =    36,                                            02832000
          FCBEXTMAP =    0,                                             02834000
          FCBLDEV   =    64,                                            02836000
          FCBEXTSIZE=    65,                                            02838000
          FCBNEXTWORD=   66,                                            02840000
          FCBEOF    =    34,                                            02842000
          FCBFILESIZE=   35;                                            02844000
  DEFINE  FCBSECTOFF=    66).(0:8#;                                     02846000
                                                                        02848000
  EQUATE  FILETYPE  =    0,                                             02850000
          GRPTYPE   =    %10,                                           02852000
          ACCTYPE   =    %20,                                           02854000
          USERTYPE  =    %30;                                           02856000
                                                               <<03672>>02858000
  DEFINE  CS80'LOCK = << TRUE IF RELEASE TIMEOUT IS         >> <<03672>>02860000
                      << CURRENTLY DISABLED ON CS'80 DEVICES>> <<03672>>02862000
                      ABSOLUTE(ABSFLAGS).(11:1)#;              <<03672>>02864000
                                                               <<03672>>02866000
                                                                        02868000
          <<------------------------------->>                  <<03672>>02870000
          <<     DISC DRIVER FUNCTIONS     >>                  <<03672>>02872000
          <<------------------------------->>                  <<03672>>02874000
                                                               <<03672>>02876000
  EQUATE  READ      =    0,                                             02878000
          NON'FATAL'READ=6,                                    <<01889>>02880000
          WRITE     =    1,                                    <<RH.PV>>02882000
          RSTAT     =    5,     <<REQUEST STATUS>>             <<03550>>02884000
          INIT'DEV  =    7,     <<Initialize Device>>          <<03598>>02886000
          UNLOCK'DEV=   12,     << ENABLE RELEASE TIMEOUT >>   <<03715>>02888000
                                << --CS80'DRIVER ONLY     >>   <<03672>>02890000
          LOCK'DEV  =   11;     << DISABLE RELEASE TIMEOUT  >> <<03672>>02892000
                                << --CS80'DRIVER ONLY       >> <<03672>>02894000
                                                                        02896000
          <<-----------------                                           02898000
            CONDITION CODES                                             02900000
          ----------------->>                                           02902000
  EQUATE  CCG       =    0,          <<GREATER>>                        02904000
          CCL       =    1,          <<LESS>>                           02906000
          CCE       =    2;          <<EQUAL>>                          02908000
                                                               <<03004>>02910000
$IF X1=ON  << *********** SERIES 33,44,55 UNIQUE ********** >> <<03004>>02912000
          <<------------------------------>>                   <<03004>>02914000
          << CHANNEL IDENTIFICATION CODES >>                   <<03004>>02916000
          <<------------------------------>>                   <<03004>>02918000
  EQUATE  LYNX'BOARD  = %50017,                                <<SYPTR>>02920000
          TIC'BOARD   = %50004,                                <<08392>>02922000
          ADCC'MAIN   = %100001,                               <<SYPTR>>02924000
          ADCC'EXT    = %100021;                               <<SYPTR>>02926000
                                                               <<03004>>02928000
$IF        << ******* RETURNING TO COMMON CODE ************ >> <<03004>>02930000
                                                                        02932000
          <<--------------                                              02934000
            I/O COMMANDS                                                02936000
          -------------->>                                              02938000
  DEFINE  TIO0      =    BEGIN                                 <<01103>>02940000
                         ASSEMBLE( TIO 0 );                    <<01103>>02942000
                         IF < THEN ERRMESSAGE(M1,S0);          <<01103>>02944000
                         END#,                                 <<01103>>02946000
          WIO1      =    DO BEGIN                              <<01103>>02948000
                            ASSEMBLE( WIO 1 );                 <<01103>>02950000
                            IF < THEN ERRMESSAGE(M1,S1);       <<01103>>02952000
                            IF > THEN DEL;                     <<01103>>02954000
                            END UNTIL =#,                      <<01103>>02956000
          WIO2      =    DO BEGIN                              <<01103>>02958000
                            ASSEMBLE( WIO 2 );                 <<01103>>02960000
                            IF < THEN ERRMESSAGE(M1,S2);       <<01103>>02962000
                            IF > THEN DEL;                     <<01103>>02964000
                            END UNTIL =#,                      <<02510>>02966000
          SIO1      =    DO BEGIN                              <<02510>>02968000
                            ASSEMBLE( SIO 1 );                 <<02510>>02970000
                            IF < THEN ERRMESSAGE(M1,S2);       <<02510>>02972000
                            IF > THEN DEL;                     <<02510>>02974000
                            END UNTIL =#;                      <<02510>>02976000
DEFINE    RIOA      =    CON %20302; CON %13#;                 <<03002>>02978000
                         <<COMPLIER DOESNT KNOW RIOA YET>>     <<03002>>02980000
DEFINE    WIOA      =    CON %20302; CON %14#;                 <<03004>>02982000
                         <<COMPILER DOESN'T KNOW WIOA YET>>    <<03004>>02984000
                                                                        02986000
  DEFINE  D'L       =    DOUBLE(LOGICAL#;                               02988000
                                                                        02990000
  DEFINE  LBITE     =    (0:8)#,     <<LEFT BYTE>>                      02992000
          RBITE     =    (8:8)#;     <<RIGHT BYTE>>                     02994000
  DEFINE  DUPLICATE =    TOS:=S0#;                                      02996000
  EQUATE  BLANK     =    %6440;                                         02998000
  EQUATE  CR'COMMA  =    %6454;                                <<06067>>03000000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>03002000
  EQUATE NPROTECTED=    12;                                    <<DEVCO>>03004000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>03006000
  EQUATE NPROTECTED=    33;                                    <<D8637>>03008000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>03010000
                                                                        03012000
           <<---------------                                            03014000
             SPOOLING TABLES                                            03016000
            ---------------- >>                                         03018000
  EQUATE XDDSUBSIZE=    32,    <<XDD SUBENTRY SIZE>>           <<*XDD*>>03020000
          SUSPENDED =    4,                                    <<01.00>>03022000
          XDDEOF    =    28;                                   <<bcrap>>03024000
  << DEFINE STATEFLD  =    (0:6)#,           >>                <<c8392>>03026000
  <<        SPSTATE   =    24).(0:1#,        >>                <<c8392>>03028000
  <<      MAINPIN   =    22).(0:8#,           >>               <<bcrap>>03030000
  <<      GAU       =    (8:3)#,              >>               <<bcrap>>03032000
<<        RESTART   =    24).(1:1#,   >>                       <<c8392>>03034000
  <<        XDDSTATE  =    (1:2)#,            >>               <<c8392>>03036000
  <<      JOBNUM    =    1).(2:14#,           >>               <<bcrap>>03038000
  <<      IDDREST   =    26).(2:1#,           >>               <<bcrap>>03040000
  <<        VDVFLD    =    21#,           >>                   <<c8392>>03042000
  <<        SQUEEZE  =    26).(0:1#,      >>                   <<c8392>>03044000
  <<      OUTFENCE  =    4).(12:4#,           >>               <<bcrap>>03046000
  <<        XDDINDEX  =    (8:8)#,            >>               <<c8392>>03048000
  <<        XDDHEADX  =    19).(8:8#,         >>               <<c8392>>03050000
  <<      JOBID     =    18).(1:15#,         >>                <<bcrap>>03052000
  <<        SPOOLQUE  =    (7:1)#;           >>                <<c8392>>03054000
   EQUATE SCHEDHEADP=    3,                                             03056000
          SCHEDTAILP=    4,                                             03058000
          SUBAREAP   =    2,                                            03060000
          XDDHEADSIZE=   4;                                             03062000
EQUATE  << MESSAGE NUMBER EQUATES >>                           <<01103>>03064000
   M0      = 0,                                                <<01103>>03066000
   M1      = 1,                                                <<01103>>03068000
   M2      = 2,                                                <<01103>>03070000
   M3      = 3,                                                <<01103>>03072000
<< M4      = 4, >>                                             <<bcrap>>03074000
   M5      = 5,                                                <<01103>>03076000
<< M6      = 6, >>                                             <<bcrap>>03078000
   M7      = 7,                                                <<01103>>03080000
   M8      = 8,                                                <<01103>>03082000
   M9      = 9,                                                <<01103>>03084000
<< M10     = 10,  >>                                           <<bcrap>>03086000
<< M11     = 11,  >>                                           <<bcrap>>03088000
   M12     = 12,                                               <<01103>>03090000
   M13     = 13,                                               <<01103>>03092000
   M14     = 14,                                               <<01103>>03094000
   M15     = 15,                                               <<01103>>03096000
   M16     = 16,                                               <<01103>>03098000
   M17     = 17,                                               <<01103>>03100000
   M18     = 18,                                               <<01103>>03102000
   M19     = 19,                                               <<01103>>03104000
   M20     = 20,                                               <<01103>>03106000
   M21     = 21,                                               <<01103>>03108000
   M22     = 22,                                               <<01103>>03110000
   M23     = 23,                                               <<01103>>03112000
   M24     = 24,                                               <<01103>>03114000
   M25     = 25,                                               <<01103>>03116000
   M26     = 26,                                               <<01103>>03118000
   M27     = 27,                                               <<01103>>03120000
   M28     = 28,                                               <<01103>>03122000
<< M29     = 29, >>                                            <<bcrap>>03124000
   M30     = 30,                                               <<03550>>03126000
   M31     = 31,                                               <<03550>>03128000
   M32     = 32,                                               <<03550>>03130000
   M33     = 33,                                               <<03550>>03132000
   M34     = 34,                                               <<03550>>03134000
   M100    = 100,                                              <<01103>>03136000
   M101    = 101,                                              <<01103>>03138000
   M102    = 102,                                              <<01103>>03140000
   M103    = 103,                                              <<01103>>03142000
   M104    = 104,                                              <<01103>>03144000
   M105    = 105,                                              <<01103>>03146000
   M106    = 106,                                              <<01103>>03148000
   M107    = 107,                                              <<01103>>03150000
   M108    = 108,                                              <<01103>>03152000
<< M109    = 109, >>                                           <<bcrap>>03154000
   M110    = 110,                                              <<01103>>03156000
   M111    = 111,                                              <<01103>>03158000
   M112    = 112,                                              <<01103>>03160000
   M113    = 113,                                              <<01103>>03162000
   M114    = 114,                                              <<01103>>03164000
<< M115    = 115, >>                                           <<bcrap>>03166000
   M116    = 116,                                              <<01103>>03168000
   M117    = 117,                                              <<01103>>03170000
   M118    = 118,                                              <<01103>>03172000
   M119    = 119,                                              <<01103>>03174000
   M120    = 120,                                              <<01103>>03176000
   M121    = 121,                                              <<01103>>03178000
   M122    = 122,                                              <<01103>>03180000
   M123    = 123,                                              <<01103>>03182000
   M124    = 124,                                              <<01103>>03184000
<< M125    = 125, >>                                           <<bcrap>>03186000
   M126    = 126,                                              <<01103>>03188000
   M127    = 127,                                              <<d9020>>03190000
   M128    = 128,                                              <<03002>>03192000
   M129    = 129,                                              <<03002>>03194000
   M130    = 130,                                              <<03004>>03196000
   M131    = 131,                                              <<03004>>03198000
   M132    = 132,                                              <<03004>>03200000
   M133    = 133,                                              <<03004>>03202000
   M134    = 134,                                              <<03004>>03204000
   M135    = 135,                                              <<02707>>03206000
<< M136    = 136, >>                                           <<bcrap>>03208000
   M137    = 137,                                              <<LIMIT>>03210000
   M138    = 138,                                              <<*8392>>03212000
   M200    = 200,                                              <<01103>>03214000
   M201    = 201,                                              <<01103>>03216000
   M202    = 202,                                              <<01103>>03218000
   M203    = 203,                                              <<01103>>03220000
   M204    = 204,                                              <<01103>>03222000
   M205    = 205,                                              <<01103>>03224000
   M225    = 225,                                              <<01103>>03226000
   M226    = 226,                                              <<01103>>03228000
   M227    = 227,                                              <<01103>>03230000
   M228    = 228,                                              <<01103>>03232000
   M229    = 229,                                              <<01103>>03234000
   M230    = 230,                                              <<01103>>03236000
   M231    = 231,                                              <<01103>>03238000
   M232    = 232,                                              <<01103>>03240000
   M233    = 233,                                              <<03550>>03242000
   M234    = 234,                                              <<03550>>03244000
   M235    = 235,                                              <<03550>>03246000
   M236    = 236,                                              <<03612>>03248000
   M237    = 237,                                              <<03613>>03250000
   M250    = 250,                                              <<01103>>03252000
   M251    = 251,                                              <<01103>>03254000
   M252    = 252,                                              <<01103>>03256000
   M253    = 253,                                              <<01103>>03258000
   M254    = 254,                                              <<01103>>03260000
<< M275    = 275, >>                                           <<bcrap>>03262000
<< M276    = 276, >>                                           <<bcrap>>03264000
   M277    = 277,                                              <<01103>>03266000
   M300    = 300,                                              <<01103>>03268000
   M301    = 301,                                              <<01103>>03270000
   M302    = 302,                                              <<01103>>03272000
   M303    = 303,                                              <<01103>>03274000
   M304    = 304,                                              <<01103>>03276000
<< M305    = 305, >>                                           <<bcrap>>03278000
   M325    = 325,                                              <<01103>>03280000
   M326    = 326,                                              <<01103>>03282000
   M327    = 327,                                              <<01103>>03284000
   M328    = 328,                                              <<01442>>03286000
   M329    = 329,                                              <<01442>>03288000
   M330    = 330,                                              <<MPEIV>>03290000
   M331    = 331,                                              <<03551>>03292000
   M332    = 332,                                              <<03551>>03294000
   M333    = 333,                                              <<03551>>03296000
   M334    = 334,                                              <<03550>>03298000
   M335    = 335,                                              <<03550>>03300000
   M350    = 350,                                              <<01103>>03302000
   M351    = 351,                                              <<01103>>03304000
<< M352    = 352, >>                                           <<bcrap>>03306000
   M374    = 374,                                              <<01103>>03308000
   M375    = 375,                                              <<01103>>03310000
   M376    = 376,                                              <<01103>>03312000
   M377    = 377,                                              <<01103>>03314000
   M378    = 378,                                              <<01103>>03316000
   M379    = 379,                                              <<01103>>03318000
   M400    = 400,                                              <<01103>>03320000
   M401    = 401,                                              <<03551>>03322000
   M450    = 450,                                              <<03603>>03324000
   M451    = 451,                                              <<03603>>03326000
   M452    = 452,                                              <<03603>>03328000
   M500    = 500,                                              <<03550>>03330000
   M501    = 501,                                              <<03550>>03332000
   M2000   = 2000,                                             <<01103>>03334000
   M2001   = 2001,                                             <<01103>>03336000
   M2002   = 2002,                                             <<01103>>03338000
   M2003   = 2003,                                             <<01103>>03340000
   M2004   = 2004,                                             <<01103>>03342000
   M2005   = 2005,                                             <<01103>>03344000
   M2006   = 2006,                                             <<01103>>03346000
   M2007   = 2007,                                             <<01103>>03348000
   M2008   = 2008,                                             <<01103>>03350000
   M2009   = 2009,                                             <<01103>>03352000
   M2010   = 2010,                                             <<01103>>03354000
   M2011   = 2011,                                             <<01103>>03356000
   M2012   = 2012,                                             <<01103>>03358000
   M2013   = 2013,                                             <<01103>>03360000
   M2014   = 2014,                                             <<01103>>03362000
   M2015   = 2015,                                             <<01103>>03364000
   M2016   = 2016,                                             <<01103>>03366000
<< M2017   = 2017, >>                                          <<bcrap>>03368000
   M2018   = 2018,                                             <<01103>>03370000
   M2019   = 2019,                                             <<01103>>03372000
   M2020   = 2020,                                             <<01103>>03374000
   M2021   = 2021,                                             <<01103>>03376000
   M2022   = 2022,                                             <<01103>>03378000
   M2023   = 2023,                                             <<01103>>03380000
   M2024   = 2024,                                             <<01103>>03382000
   M2025   = 2025,                                             <<01103>>03384000
   M2026   = 2026,                                             <<01103>>03386000
   M2027   = 2027,                                             <<01103>>03388000
   M2028   = 2028,                                             <<01103>>03390000
<< M2029   = 2029, >>                                          <<bcrap>>03392000
   M2040  = 2040,                                              <<I8392>>03394000
    M2041  = 2041,                                             <<*8392>>03396000
    M2042  = 2042,                                             <<*8392>>03398000
    M2043  = 2043,                                             <<*8392>>03400000
    M2044  = 2044,                                             <<*8392>>03402000
    M2045  = 2045,                                             <<*8392>>03404000
    M2046  = 2046,                                             <<*8392>>03406000
    M2047  = 2047,                                             <<*8392>>03408000
    M2048  = 2048,                                             <<*8392>>03410000
    M2049  = 2049,                                             <<*8392>>03412000
    M2050  = 2050,                                             <<*8392>>03414000
    M2051  = 2051,                                             <<*8392>>03416000
    M2052  = 2052,                                             <<*8392>>03418000
    M2053  = 2053,                                             <<*8392>>03420000
    M2054  = 2054,                                             <<*8392>>03422000
   M2055   = 2055,                                             <<s8967>>03424000
   M2056   = 2056,                                             <<s8967>>03426000
   M2100   = 2100,                                             <<01103>>03428000
   M2101   = 2101,                                             <<01103>>03430000
   M2102   = 2102,                                             <<01103>>03432000
   M2103   = 2103,                                             <<01103>>03434000
   M2104   = 2104,                                             <<01103>>03436000
   M2105   = 2105,                                             <<01103>>03438000
   M2106   = 2106,                                             <<01103>>03440000
   M2107   = 2107,                                             <<01103>>03442000
   M2108   = 2108,                                             <<01103>>03444000
   M2109   = 2109,                                             <<01103>>03446000
   M2110   = 2110,                                             <<01103>>03448000
   M2111   = 2111,                                             <<01103>>03450000
   M2112   = 2112,                                             <<01103>>03452000
   M2113   = 2113,                                             <<01103>>03454000
   M2114   = 2114,                                             <<01103>>03456000
   M2115   = 2115,                                             <<01103>>03458000
   M2116   = 2116,                                             <<01103>>03460000
   M2117   = 2117,                                             <<01103>>03462000
   M2118   = 2118,                                             <<01103>>03464000
<< M2119   = 2119, >>                                          <<bcrap>>03466000
   M2120   = 2120,                                             <<01103>>03468000
   M2121   = 2121,                                             <<01103>>03470000
   M2122   = 2122,                                             <<01103>>03472000
   M2123   = 2123,                                             <<01103>>03474000
   M2124   = 2124,                                             <<01103>>03476000
   M2125   = 2125,                                             <<01103>>03478000
   M2126   = 2126,                                             <<01103>>03480000
   M2127   = 2127,                                             <<01103>>03482000
   M2128   = 2128,                                             <<01103>>03484000
   M2129   = 2129,                                             <<01103>>03486000
   M2130   = 2130,                                             <<01103>>03488000
   M2131   = 2131,                                             <<01103>>03490000
   M2140   = 2140,                                             <<01103>>03492000
   M2141   = 2141,                                             <<01103>>03494000
<< M2150   = 2150, >>                                          <<bcrap>>03496000
   M2151   = 2151,                                             <<01103>>03498000
   M2200   = 2200,                                             <<01103>>03500000
   M2201   = 2201,                                             <<01103>>03502000
   M2202   = 2202,                                             <<01103>>03504000
   M2203   = 2203,                                             <<01103>>03506000
   M2204   = 2204,                                             <<01103>>03508000
   M2205   = 2205,                                             <<01103>>03510000
   M2206   = 2206,                                             <<01103>>03512000
   M2207   = 2207,                                             <<01103>>03514000
<< M2208   = 2208, >>                                          <<bcrap>>03516000
   M2210   = 2210,                                             <<01103>>03518000
   M2211   = 2211,                                             <<01103>>03520000
   M2215   = 2215,                                             <<MPEIV>>03522000
   M2216   = 2216,                                             <<MPEIV>>03524000
   M2217   = 2217,                                             <<MPEIV>>03526000
   M2218   = 2218,                                             <<MPEIV>>03528000
   M2219   = 2219,                                             <<MPEIV>>03530000
   M2220   = 2220,                                             <<01682>>03532000
   M2225   = 2225,                                             <<01103>>03534000
   M2226   = 2226,                                             <<01103>>03536000
   M2227   = 2227,                                             <<01103>>03538000
   M2228   = 2228,                                             <<01103>>03540000
   M2229   = 2229,                                             <<01103>>03542000
   M2230   = 2230,                                             <<01103>>03544000
   M2231   = 2231,                                             <<01103>>03546000
   M2232   = 2232,                                             <<01103>>03548000
   M2233   = 2233,                                             <<01103>>03550000
   M2234   = 2234,                                             <<01103>>03552000
   M2235   = 2235,                                             <<01103>>03554000
<< M2236   = 2236, >>                                          <<bcrap>>03556000
   M2237   = 2237,                                             <<01103>>03558000
   M2238   = 2238,                                             <<01103>>03560000
   M2239   = 2239,                                             <<01103>>03562000
   M2240   = 2240,                                             <<01103>>03564000
   M2241   = 2241,                                             <<01103>>03566000
   M2242   = 2242,                                             <<01103>>03568000
   M2243   = 2243,                                             <<01103>>03570000
   M2244   = 2244,                                             <<01103>>03572000
<< M2245   = 2245, >>                                          <<bcrap>>03574000
   M2246   = 2246,                                             <<01103>>03576000
   M2247   = 2247,                                             <<03613>>03578000
   M2248   = 2248,                                             <<03613>>03580000
   M2250   = 2250,                                             <<03612>>03582000
   M2251   = 2251,                                             <<*8392>>03584000
   M2275   = 2275,                                             <<01103>>03586000
   M2276   = 2276,                                             <<01103>>03588000
   M2277   = 2277,                                             <<01103>>03590000
   M2278   = 2278,                                             <<01103>>03592000
   M2279   = 2279,                                             <<01103>>03594000
<< M2280   = 2280, >>                                          <<bcrap>>03596000
   M2281   = 2281,                                             <<01103>>03598000
<< M2282   = 2282, >>                                          <<bcrap>>03600000
   M2283   = 2283,                                             <<01103>>03602000
   M2284   = 2284,                                             <<01103>>03604000
<< M2285   = 2285, >>                                          <<bcrap>>03606000
   M2286   = 2286,                                             <<03668>>03608000
   M2287   = 2287,                                             <<03668>>03610000
   M2288   = 2288,                                             <<03668>>03612000
<< M2289   = 2289,  >>                                         <<c8392>>03614000
<< M2290   = 2290,  >>                                         <<c8392>>03616000
   M2292   = 2292,                                             <<*8392>>03618000
   M2300   = 2300,                                             <<01103>>03620000
   M2301   = 2301,                                             <<01103>>03622000
   M2302   = 2302,                                             <<01103>>03624000
   M2303   = 2303,                                             <<01103>>03626000
   M2304   = 2304,                                             <<01103>>03628000
   M2305   = 2305,                                             <<01103>>03630000
   M2306   = 2306,                                             <<01103>>03632000
   M2307   = 2307,                                             <<01103>>03634000
   M2308   = 2308,                                             <<01103>>03636000
<< M2309   = 2309,  >>                                         <<c8392>>03638000
   M2310   = 2310,                                             <<06067>>03640000
   M2311   = 2311,                                             <<06067>>03642000
   M2312   = 2312,                                             <<06067>>03644000
   M2313   = 2313,                                             <<06067>>03646000
   M2314   = 2314,                                             <<06067>>03648000
   M2315   = 2315,                                             <<06067>>03650000
   M2316   = 2316,                                             <<06067>>03652000
<< M2325   = 2325, >>                                          <<bcrap>>03654000
   M2326   = 2326,                                             <<01103>>03656000
   M2327   = 2327,                                             <<01103>>03658000
   M2328   = 2328,                                             <<01103>>03660000
   M2329   = 2329,                                             <<01103>>03662000
   M2330   = 2330,                                             <<01103>>03664000
   M2331   = 2331,                                             <<01103>>03666000
   M2332   = 2332,                                             <<01103>>03668000
   M2333   = 2333,                                             <<01103>>03670000
   M2334   = 2334,                                             <<01115>>03672000
   M2350   = 2350,                                             <<01103>>03674000
   M2351   = 2351,                                             <<01103>>03676000
   M2352   = 2352,                                             <<01103>>03678000
   M2353   = 2353,                                             <<01103>>03680000
   M2354   = 2354,                                             <<01103>>03682000
   M2355   = 2355,                                             <<01103>>03684000
   M2356   = 2356,                                             <<01103>>03686000
   M2357   = 2357,                                             <<02834>>03688000
   M2400   = 2400,                                             <<01103>>03690000
   M2401   = 2401,                                             <<01103>>03692000
   M2402   = 2402,                                             <<01103>>03694000
   M2403   = 2403,                                             <<01103>>03696000
   M2404   = 2404,                                             <<01103>>03698000
   M2405   = 2405,                                             <<01103>>03700000
   M2406   = 2406,                                             <<01103>>03702000
   M2407   = 2407,                                             <<01103>>03704000
   M2408   = 2408,                                             <<01103>>03706000
<< M2409   = 2409, >>                                          <<bcrap>>03708000
   M2410   = 2410,                                             <<01103>>03710000
   M2411   = 2411,                                             <<s9008>>03712000
   M2412   = 2412,                                             <<s9008>>03714000
   M2450   = 2450,                                             <<01103>>03716000
   M2451   = 2451,                                             <<01103>>03718000
   M2452   = 2452,                                             <<01103>>03720000
   M2453   = 2453,                                             <<01103>>03722000
   M2454   = 2454,                                             <<01103>>03724000
   M2455   = 2455,                                             <<01103>>03726000
   M2456   = 2456,                                             <<01103>>03728000
   M2457   = 2457,                                             <<s9008>>03730000
   M2458   = 2458,                                             <<03550>>03732000
   M2459   = 2459,                                             <<s9008>>03734000
   M2473   = 2473,                                             <<i9073>>03736000
   M2500   = 2500,                                             <<03550>>03738000
   M2501   = 2501,                                             <<03550>>03740000
<< M2502   = 2502, >>                                          <<bcrap>>03742000
   M2503   = 2503,                                             <<03630>>03744000
   M2504   = 2504,                                             <<03630>>03746000
   M2505   = 2505,                                             <<03630>>03748000
   M2506   = 2506,                                             <<s9008>>03750000
   M2551   = 2551,                                             <<*8392>>03752000
   M3050   = 3050,                                             <<s9008>>03754000
   M3051   = 3051,                                             <<s9008>>03756000
   M3052   = 3052,                                             <<s9008>>03758000
   M3053   = 3053,                                             <<s9008>>03760000
   M3054   = 3054,                                             <<s9008>>03762000
   M3055   = 3055,                                             <<s9008>>03764000
   M3056   = 3056,                                             <<s9008>>03766000
   M3057   = 3057,                                             <<s9008>>03768000
   M3058   = 3058,                                             <<s9008>>03770000
   M3059   = 3059,                                             <<s9008>>03772000
   M3060   = 3060,                                             <<s9008>>03774000
   M3061   = 3061,                                             <<s9008>>03776000
   M3062   = 3062,                                             <<s9008>>03778000
   M3063   = 3063,                                             <<s9008>>03780000
   M3064   = 3064,                                             <<s9008>>03782000
   M3065   = 3065,                                             <<s9008>>03784000
   M3066   = 3066,                                             <<s9008>>03786000
   M3067   = 3067,                                             <<s9008>>03788000
   M3068   = 3068,                                             <<s9008>>03790000
   M3069   = 3069;                                             <<s9008>>03792000
                                                               <<s9008>>03794000
$PAGE "VARIABLE DECLARATIONS"                                  <<01103>>03796000
  INTEGER ARRAY TABLEPTRS(0:EXPTABLES)=DB; <<PTRS TO EXPANDING TABLES>> 03798000
  EXT'DCL << Pointers used in INITIAL subprogram >>            <<SY>>   03800000
  INTEGER POINTER DIRSP=TABLEPTRS,   <<DIRECTORY SPACE TABLE>>          03802000
                  DIR=TABLEPTRS+1,   <<DIRECTORY DATA SEGMENT>>         03804000
                  SEGT = TABLEPTRS+2,   << SEGMENT TABLE >>    <<03551>>03806000
                  CSTAB=TABLEPTRS+3, <<CS DATA SEGMENT>>                03808000
                  TCLASS=TABLEPTRS+4, << TEMP CLASS TABLE >>   <<tclas>>03810000
                  DCT'HEAD=TABLEPTRS+5, << DCTAB HEADER>>      <<tclas>>03812000
                  DCTAB   =TABLEPTRS+6, <<DEVICE CLASS TABLE>> <<tclas>>03814000
                  TDTAB=TABLEPTRS+7,  <<TERMTYPE DESCR TAB>>   <<*7777>>03816000
                 TL'BUF   =TABLEPTRS+ 8,<< TABLE LOOKUP      >><<t8392>>03818000
                 VTAB     =TABLEPTRS+ 9,<< VOLUME TABLE      >><<t8392>>03820000
                 OLDVTAB  =TABLEPTRS+10,<< OLD VOLUME TABLE  >><<t8392>>03822000
                 OLDINFO  =TABLEPTRS+11,<< OLD INFO   TABLE  >><<t8392>>03824000
                 RECBUF   =TABLEPTRS+12,                       <<t8392>>03826000
                 TZTBUF   =TABLEPTRS+13,                       <<t8392>>03828000
                 CTAB     =TABLEPTRS+14, << CORESIZE REL CONF>><<t8392>>03830000
                 CTAB0    =TABLEPTRS+15,<< STD CONFIGURATION >><<t8392>>03832000
                 COMM = TABLEPTRS+16;<<SYSDUMP/INITIAL COMM>>  <<t8392>>03834000
  GLOBAL INTEGER POINTER LDT,                                  <<zrela>>03836000
                         LPDT;                                 <<zrela>>03838000
  INTEGER POINTER        LDTX,                                 <<zrela>>03840000
                         DVRTAB;                               <<zrela>>03842000
  INTEGER ARRAY TABLEINCRS(0:EXPTABLES-1)=DB:=EXPTABLES(0);             03844000
  INTEGER DIRSPINCR = TABLEINCRS,                              <<03675>>03846000
          DIRINCR   = TABLEINCRS+1,                            <<03675>>03848000
          SEGTINCR  = TABLEINCRS+2,                            <<03675>>03850000
          CSTABINCR=TABLEINCRS+3,    <<CS DATA SEGMENT>>       <<03675>>03852000
          TCLASSINCR=TABLEINCRS+4,   << TEMP CLASS TABLE >>    <<tclas>>03854000
          << NO INCREMENT NEEDED FOR DCT'HEAD        >>        <<zrela>>03856000
          DCTABINCR=TABLEINCRS+6,  <<DEVICE CLASS TABLE>>      <<tclas>>03858000
          TDTABINCR   =TABLEINCRS+7,  <<TERMTYPE DESCR TAB>>   <<*7777>>03860000
               TL'INCR    =TABLEINCRS+ 8,<<TABLE LOOKUP INCR >><<t8392>>03862000
               VTABINCR   =TABLEINCRS+ 9,<<VOLUME TABLE      >><<t8392>>03864000
          << NO INCREMENT NEEDED FOR OLDVTAB           >>      <<zrela>>03866000
               OLDINFOINCR=TABLEINCRS+11,<<OLD INFO TABLE    >><<t8392>>03868000
               RECBUFINCR =TABLEINCRS+12,                      <<t8392>>03870000
               TZTBUFINCR = TABLEINCRS + 13;                   <<t8392>>03872000
  INTEGER POINTER CST=CSTIX,         <<CODE SEGMENT TABLE>>             03874000
                  DST=DSTIX,         <<DATA SEGMENT TABLE>>             03876000
                  PCB=PCBIX,         <<PROCESS CONTROL BLOCK TABLE>>    03878000
                  TRL=TRLIX,         <<TIMER REQUEST LIST>>             03880000
                  JCUT=JCUTIX,       <<JOB CUTOFF TABLE>>               03882000
                  STOPS=STOPSIX,     <<BREAKPOINT TABLE>>               03884000
                  XDD;               <<DEVICE DIRECTORY>>      <<MPEIV>>03886000
   LOGICAL POINTER JPCNT = JPCNTIX; <<JOB PROCESS COUNT TAB>>  <<JPCNT>>03888000
  LOGICAL POINTER VDSMTAB=VDSMTABIX; << VM MGT TABLE >>        <<32BND>>03890000
  INTEGER POINTER SWAPTAB=SWAPTABIX,                           <<SYPTR>>03892000
                  SYSGLOBEXT'=%377,                            <<MPEIV>>03894000
                  CSTBLK=CSTBLKIX,   <<CST BLOCK TABLE>>                03896000
                  SYS = SYSIX,                                 <<32BND>>03898000
                  TCST = TCSTIX, << INITIAL'S CST TABLE >>     <<32BND>>03900000
                  SLL  = SWAPTABIX, << SWAP TABLE >>           <<*SLL*>>03902000
                  ICS=ICSIX;        <<INTERRUPT CONTROL STACK>><<03603>>03904000
                                                               <<MPEIV>>03906000
  DEFINE  FIRSTMEMBANK=SYSGLOBEXT'(1)#,                        <<MPEIV>>03908000
          FIRSTMEMBASE=SYSGLOBEXT'(2)#,                        <<MPEIV>>03910000
          MEMORYPAGESIZE=SYSGLOBEXT'(5)#;                      <<MPEIV>>03912000
                                                               <<MPEIV>>03914000
  INTEGER POINTER                                              <<bcrap>>03916000
                  TABLEINFO,         <<INFO TAB AREA>>                  03918000
                  OLDTABLEINFO,      <<OLD INFO TAB>>                   03920000
                  TCSTINFO,          <<INFO TEMP CST>>                  03922000
                  OLDTCSTINFO,       <<OLD INFO TEMP CST>>              03924000
                  CSDEF,             <<DEFAULT LINE DESCRIPTORS>>       03926000
                  CSDVR,             <<EXTRA CS DRIVERS>>               03928000
                  TDT,               <<TERM DESCR. TABLE>>     <<*7777>>03930000
                  CSDVRAREA,         <<CS DRIVER TABLE WORKAREA>>       03932000
                  DRIVERENTRY,       <<CURRENT CS DRIVER ENTRY>>        03934000
                  CSLDTX,            <<CURRENT CS LINE DESCRIPTOR>>     03936000
                  IOPROC,            <<IO PROCESS TABLE>>               03938000
                  TAPEBUF,           <<SYS TAPE BUF>>          <<03603>>03940000
                  DLT',              <<TEMPORARY DRIVER LINKAGE TABLE>> 03942000
                  SEGXFORM,          <<SEGMENT TRANSFORM TABLE>>        03944000
                  SEGDIR,            <<SEGMENT DIRECTORY>>              03946000
                  LOGTAB,                                      <<00506>>03948000
                LIDTAB,                                        <<t8392>>03950000
          TL'ENT,                                              <<t8392>>03952000
          TL'HEAD;                                             <<t8392>>03954000
                                                               <<MPEIV>>03956000
   BYTE POINTER                                                <<*7777>>03958000
          TL'ENTB,                                             <<t8392>>03960000
      TDT'B;                 << TERM DESCR.TABLE POINTER >>    <<*7777>>03962000
                                                               <<MPEIV>>03964000
<<>>                                                           <<MPEIV>>03966000
<<PCB WORDS AND FIELDS>>                                       <<MPEIV>>03968000
<<>>                                                           <<MPEIV>>03970000
                                                               <<MPEIV>>03972000
<< LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION>>      <<*pcb*>>03974000
Comment                                                        <<*pcb*>>03976000
<<=========================================================    <<*pcb*>>03978000
=                                                         =    <<*pcb*>>03980000
=                  INCLPCB - A2                           =    <<*pcb*>>03982000
=                                                         =    <<*pcb*>>03984000
=========================================================>>    <<*pcb*>>03986000
;                                                              <<*pcb*>>03988000
                                                               <<*pcb*>>03990000
                                                               <<*pcb*>>03992000
Comment                                                        <<*pcb*>>03994000
                                                               <<*pcb*>>03996000
   When using this include file please be aware of the followin<<*pcb*>>03998000
requirements :                                                 <<*pcb*>>04000000
                                                               <<*pcb*>>04002000
   (1)  PCBPT is a logical variable which is the result of     <<*pcb*>>04004000
        multiplying the pin number by PCBSIZE, thus yielding   <<*pcb*>>04006000
        a PCB base relative index of the first word of the pin <<*pcb*>>04008000
        in question.                                           <<*pcb*>>04010000
                                                               <<*pcb*>>04012000
   (2)  PCB should be a logical pointer equated to SYSPCBINDEX.<<*pcb*>>04014000
                                                               <<*pcb*>>04016000
   (3)  As a general rule only the SPCB..... declarations are  <<*pcb*>>04018000
        necessary for modules outside the KERNEL.              <<*pcb*>>04020000
                                                               <<*pcb*>>04022000
   (4)  When accessing a particular field within one's own     <<*pcb*>>04024000
        PCB , please use the CURPRC (current process) to       <<*pcb*>>04026000
        set the value of PCBPT.                                <<*pcb*>>04028000
                                                               <<*pcb*>>04030000
   (5)  At all costs avoid the use of ABSOLUTE constructs when <<*pcb*>>04032000
        accessing the PCB and for that matter any other system <<*pcb*>>04034000
        tables which could reside outside of bank 0.           <<*pcb*>>04036000
                                                               <<*pcb*>>04038000
;                                                              <<*pcb*>>04040000
<< Equates for the Process Control Block Table >>              <<*pcb*>>04042000
                                                               <<*pcb*>>04044000
EQUATE                                                         <<*pcb*>>04046000
                                                               <<*pcb*>>04048000
   RESABORTINFOWORDNUM         = 0,                            <<*pcb*>>04050000
   SLLIXWORDNUM                = 1,                            <<*pcb*>>04052000
   DBXDSINFOWORDNUM            = 2,                            <<*pcb*>>04054000
   STKINFOWORDNUM              = 3,                            <<*pcb*>>04056000
   WAKEMASKWORDNUM             = 4,                            <<*pcb*>>04058000
   FATHERINFOWORDNUM           = 5,                            <<*pcb*>>04060000
   SONINFOWORDNUM              = 6,                            <<*pcb*>>04062000
   BROTHERINFOWORDNUM          = 7,                            <<*pcb*>>04064000
   PIINFOWORDNUM               = 8,                            <<*pcb*>>04066000
   PROCSTATEWORDNUM            = 9,                            <<*pcb*>>04068000
<< EVENTFLAGSWORDNUM           = 10, >>                        <<bcrap>>04070000
<< LASTREFCODEWORDNUM          = 11, >>                        <<*pcb*>>04072000
   QUEUEINGINFOWORDNUM         = 13,                           <<*pcb*>>04074000
   PBXWORDNUM                  = 14,                           <<*pcb*>>04076000
   MAPDSTWORDNUM               = 15,                           <<*pcb*>>04078000
<< PIMPPINWORDNUM              = 16, >>                        <<*pcb*>>04080000
<< NIMPPINWORDNUM              = 17, >>                        <<*pcb*>>04082000
<< BPTLINKWORDNUM              = 18, >>                        <<*pcb*>>04084000
<< NQPTRWORDNUM                = 19, >>                        <<*pcb*>>04086000
   PQPTRWORDNUM                = 20;                           <<*pcb*>>04088000
                                                               <<*pcb*>>04090000
EQUATE                                                         <<*pcb*>>04092000
                                                               <<*pcb*>>04094000
   PCBSIZE                     = 21,                           <<*pcb*>>04096000
   SYSPCBINDEX                 = 3;                            <<*pcb*>>04098000
                                                               <<*pcb*>>04100000
                                                               <<*pcb*>>04102000
LOGICAL POINTER                                                <<*pcb*>>04104000
                                                               <<*pcb*>>04106000
   LPCB                        = 3;                            <<*pcb*>>04108000
                                                               <<*pcb*>>04110000
Comment                                                        <<*pcb*>>04112000
DEFINE                                                         <<*pcb*>>04114000
                                                               <<*pcb*>>04116000
   CURPRC                      = ABSOLUTE(4)#;                 <<*pcb*>>04118000
                                                               <<*pcb*>>04120000
                                                               <<*pcb*>>04122000
DEFINE                                                         <<*pcb*>>04124000
                                                               <<*pcb*>>04126000
   RESABORTINFO        = LPCB(PCBPT + RESABORTINFOWORDNUM)#,   <<*pcb*>>04128000
   SLLPTR              = LPCB(PCBPT + SLLIXWORDNUM)#,          <<*pcb*>>04130000
   DBXDSINFO           = LPCB(PCBPT + DBXDSINFOWORDNUM)#,      <<*pcb*>>04132000
   STKINFO             = LPCB(PCBPT + STKINFOWORDNUM)#,        <<*pcb*>>04134000
   WAKEMASK            = LPCB(PCBPT + WAKEMASKWORDNUM)#,       <<*pcb*>>04136000
   FATHERINFO          = LPCB(PCBPT + FATHERINFOWORDNUM)#,     <<*pcb*>>04138000
   SONINFO             = LPCB(PCBPT + SONINFOWORDNUM)#,        <<*pcb*>>04140000
   BROTHERINFO         = LPCB(PCBPT + BROTHERINFOWORDNUM)#,    <<*pcb*>>04142000
<< BPTLINK             = LPCB(PCBPT + BPTLINKWORDNUM)#, >>     <<*pcb*>>04144000
<< PIMPPIN             = LPCB(PCBPT + PIMPPINWORDNUM)#, >>     <<*pcb*>>04146000
<< EVENTFLAGS          = LPCB(PCBPT + EVENTFLAGSWORDNUM)#, >>  <<*pcb*>>04148000
   PROCSTATE           = LPCB(PCBPT + PROCSTATEWORDNUM)#,      <<*pcb*>>04150000
   PIINFO              = LPCB(PCBPT + PIINFOWORDNUM)#,         <<*pcb*>>04152000
<< NIMPPIN             = LPCB(PCBPT + NIMPPINWORDNUM)#, >>     <<bcrap>>04154000
<< LASTREFCODESEG0     = LPCB(PCBPT + LASTREFCODEWORDNUM)#, >> <<*pcb*>>04156000
<< LASTREFCODESEG1     = LPCB(PCBPT + LASTREFCODEWORDNUM + 1)#,<<*pcb*>>04158000
   PBX                 = LPCB(PCBPT + PBXWORDNUM)#,            <<*pcb*>>04160000
   QUEUEINGINFO        = LPCB(PCBPT + QUEUEINGINFOWORDNUM)#,   <<*pcb*>>04162000
   MAPDST              = LPCB(PCBPT + MAPDSTWORDNUM)#;         <<bcrap>>04164000
<< NQPTR               = LPCB(PCBPT + NQPTRWORDNUM)#, >>       <<*pcb*>>04166000
<< PQPTR               = LPCB(PCBPT + PQPTRWORDNUM)#; >>       <<bcrap>>04168000
                                                               <<*pcb*>>04170000
                                                               <<*pcb*>>04172000
<< Misc. bits for TBC , TRBC etc. >>                           <<*pcb*>>04174000
                                                               <<*pcb*>>04176000
Comment These lines are not needed here                        <<*pcb*>>04178000
EQUATE                                                         <<*pcb*>>04180000
                                                               <<*pcb*>>04182000
   SARBIT                   = 0,                               <<*pcb*>>04184000
   CRITBIT                  = 2,                               <<*pcb*>>04186000
   HASSIRBIT                = 3,                               <<*pcb*>>04188000
   PIOVRBIT                 = 4,                               <<*pcb*>>04190000
   INCOREPROTECTEXPBIT      = 6,                               <<*pcb*>>04192000
   PREEMPTCAPBIT            = 7,                               <<*pcb*>>04194000
   MUSTPREEMPTBIT           = 8,                               <<*pcb*>>04196000
   IMPEDEDWAITBIT           = 12,                              <<*pcb*>>04198000
   SIRWAITBIT               = 13,                              <<*pcb*>>04200000
   TIMWAITBIT               = 14,                              <<*pcb*>>04202000
   MEMORYWAITBIT            = 15,                              <<*pcb*>>04204000
   IMPEDEDWAKEBIT           = 12,                              <<*pcb*>>04206000
   SIRWAKEBIT               = 13,                              <<*pcb*>>04208000
   TIMWAKEBIT               = 14,                              <<*pcb*>>04210000
   MEMORYWAKEBIT            = 15,                              <<*pcb*>>04212000
   WWSBIT                   = 15,                              <<*pcb*>>04214000
   DISPQBIT                 = 0,                               <<*pcb*>>04216000
   MAIN                     = 2,                               <<*pcb*>>04218000
   SOFTKILL                 = %20,                             <<*pcb*>>04220000
   LSCHEDBIT                = 1,                               <<*pcb*>>04222000
   CSCHEDBIT                = 2,                               <<*pcb*>>04224000
   DSCHEDBIT                = 3,                               <<*pcb*>>04226000
   ESCHEDBIT                = 4,                               <<*pcb*>>04228000
   INTERACTIVEBIT           = 5,                               <<*pcb*>>04230000
   CORERESBIT               = 6,                               <<*pcb*>>04232000
   HOLDSIRPRIBIT            = 5;                               <<*pcb*>>04234000
                                                               <<*pcb*>>04236000
                                                               <<*pcb*>>04238000
DEFINE                                                         <<*pcb*>>04240000
                                                               <<*pcb*>>04242000
<< SARFLAG                  = (0:1)#, >>                       <<*pcb*>>04244000
<< CRITFLAG                 = (2:1)#, >>                       <<bcrap>>04246000
<< HASSIRFLAG               = (3:1)#, >>                       <<*pcb*>>04248000
<< CRITSIRFLAG              = (2:2)#, >>                       <<*pcb*>>04250000
<< PIOVRFLAG                = (4:1)#, >>                       <<*pcb*>>04252000
<< INCPROTECTEXPFLAG        = (6:1)#, >>                       <<*pcb*>>04254000
<< PREEMPTCAPFLAG           = (7:1)#, >>                       <<*pcb*>>04256000
<< MUSTPREEMPTFLAG          = (8:1)#, >>                       <<*pcb*>>04258000
<< PCBLONGWAITFLAG          = (9:1)#, >>                       <<*pcb*>>04260000
<< PCBSHORTWAITFLAG         = (10:1)#, >>                      <<*pcb*>>04262000
<< PCBTERMREADFLAG          = (11:1)#, >>                      <<*pcb*>>04264000
<< USEDQUANTUMFLAG          = (12:1)#, >>                      <<*pcb*>>04266000
<< HOLDIMPPRIFLAG           = (13:1)#, >>                      <<*pcb*>>04268000
<< DELAYSOFTFLAG            = (8:1)#, >>                       <<*pcb*>>04270000
<< STOVABORTFLAG            = (14:1)#, >>                      <<*pcb*>>04272000
<< RITBRKFLAG               = (15:1)#, >>                      <<*pcb*>>04274000
   ABSDBFLAG                = (0:1)#,                          <<*pcb*>>04276000
   XDSDSTFIELD              = (2:14)#,                         <<*pcb*>>04278000
<< STOVRALLFLAG             = (0:1)#, >>                       <<*pcb*>>04280000
   STKDSTFIELD              = (2:14)#,                         <<*pcb*>>04282000
<< INSYSTEMFLAG             = (1:1)#, >>                       <<*pcb*>>04284000
<< OAFIELD                  = (4:2)#, >>                       <<*pcb*>>04286000
<< CRITEVENTFIELD           = (12:4)#, >>                      <<*pcb*>>04288000
<< NONCRITEVENTFIELD        = (0:12)#, >>                      <<*pcb*>>04290000
<< NONCRITEVENTFLD'         = (0:10)#, >>                      <<*pcb*>>04292000
<< MOURNWAITFLAG            = (0:1)#, >>                       <<*pcb*>>04294000
<< BLKDIOWAITFLAG           = (4:1)#, >>                       <<*pcb*>>04296000
<< IMPEDEDWAITFLAG          = (12:1)#, >>                      <<*pcb*>>04298000
<< SIRWAITFLAG              = (13:1)#,>>                       <<*pcb*>>04300000
<< RIT'UCOPWAITFLAG         = (6:1)#, >>                       <<*pcb*>>04302000
<< MAILWAITFLAG             = (3:1)#, >>                       <<*pcb*>>04304000
<< JUNKWAITFLAG             = (7:1)#,  >>                      <<bcrap>>04306000
   TIMERWAITFLAG            = (14:1)#,                         <<*pcb*>>04308000
<< FATHERSONWAKEFLAGS       = (10:2)#, >>                      <<bcrap>>04310000
<< FATHERWAITFLAG           = (11:1)#, >>                      <<*pcb*>>04312000
<< ABORTWAKEFLAGS           = (8:4)#, >>                       <<*pcb*>>04314000
<< INTFASONWAITFLAGS        = (9:3)#, >>                       <<*pcb*>>04316000
<< MEMORYWAITFLAG           = (15:1)#, >>                      <<bcrap>>04318000
<< MOURNWAKEFLAG            = (0:1)#, >>                       <<*pcb*>>04320000
<< IMPEDEDWAKEFLAG          = (12:1)#, >>                      <<*pcb*>>04322000
<< SIRWAKEFLAG              = (13:1)#, >>                      <<*pcb*>>04324000
   TIMERWAKEFLAG            = (14:1)#,                         <<*pcb*>>04326000
   WWS                      = (15:1)#,                         <<*pcb*>>04328000
<< MEMORYWAKEFLAG           = (15:1)#, >>                      <<bcrap>>04330000
<< PTYPEFIELD               = (6:3)#,  >>                      <<bcrap>>04332000
<< PTYPEFIELD'              = (6:2)#,  >>                      <<bcrap>>04334000
<< FACFLAG                  = (7:1)#,  >>                      <<bcrap>>04336000
<< STOVFLAG                 = (5:1)#, >>                       <<*pcb*>>04338000
   SYSTEMPROCFLAG           = (6:1)#,                          <<*pcb*>>04340000
<< SONOFMAINFLAG            = (8:1)#,  >>                      <<bcrap>>04342000
<< MAINPROCFLAG             = (7:1)#,  >>                      <<bcrap>>04344000
<< DEADFLAG                 = (6:1)#, >>                       <<bcrap>>04346000
<< PPCFIELD                 = (3:2)#, >>                       <<*pcb*>>04348000
<< SOFTKILLFLAG             = (11:1)#, >>                      <<*pcb*>>04350000
<< HARDKILLFLAG             = (10:1)#, >>                      <<*pcb*>>04352000
<< PPCWAITFIELD             = (1:2)#, >>                       <<*pcb*>>04354000
<< QUEUEFIELD'              = (1:3)#,  >>                      <<bcrap>>04356000
<< SOFTINTFLAG              = (9:1)#, >>                       <<*pcb*>>04358000
<< SIPIFLAGSFIELD           = (9:7)#, >>                       <<*pcb*>>04360000
<< PIFLAGSFIELD             = (10:6)#, >>                      <<*pcb*>>04362000
<< HYBERNATEFLAG            = (13:1)#, >>                      <<*pcb*>>04364000
<< STOPFLAG                 = (12:1)#, >>                      <<*pcb*>>04366000
<< CYFLAG                   = (14:1)#, >>                      <<*pcb*>>04368000
<< BKFLAG                   = (15:1)#, >>                      <<*pcb*>>04370000
<< PSIMFIELD                = (0:3)#, >>                       <<*pcb*>>04372000
<< WAKESOFTFLAG             = (3:1)#, >>                       <<*pcb*>>04374000
<< DISPQFLAG                = (0:1)#, >>                       <<*pcb*>>04376000
<< LSCHEDFLAG               = (1:1)#, >>                       <<bcrap>>04378000
<< CSCHEDFLAG               = (2:1)#, >>                       <<bcrap>>04380000
<< DSCHEDFLAG               = (3:1)#, >>                       <<bcrap>>04382000
<< ESCHEDFLAG               = (4:1)#, >>                       <<bcrap>>04384000
<< INTERACTIVEFLAG          = (5:1)#, >>                       <<bcrap>>04386000
<< PROCRESIDENTFLAG         = (6:1)#, >>                       <<*pcb*>>04388000
<< HOLDSIRPRIFLAG           = (5:1)#, >>                       <<*pcb*>>04390000
<< QUEUEFIELD               = (1:4)#, >>                       <<bcrap>>04392000
<< ALLOWSOFTFLAG            = (7:1)#, >>                       <<*pcb*>>04394000
   PRIFIELD                 = (8:8)#;                          <<*pcb*>>04396000
                                                               <<*pcb*>>04398000
Comment The following are not needed by Initial                <<*pcb*>>04400000
DEFINE                                                         <<*pcb*>>04402000
   SPCBCRIT       = PCB(PCBPT).CRITFLAG#,                      <<*pcb*>>04404000
   SPCBCRITSIR    = PCB(PCBPT).CRITSIRFLAG#,                   <<*pcb*>>04406000
   SPCBPIOVRFLAG  = PCB(PCBPT).PIOVRFLAG#,                     <<*pcb*>>04408000
   SPCBDELAYSOFT  = PCB(PCBPT).DELAYSOFTFLAG#,                 <<*pcb*>>04410000
   SPCBWAITFIELD  = PCB(PCBPT+WAKEMASKWORDNUM).(0:15)#,        <<*pcb*>>04412000
   SPCBNONCRITWAIT= PCB(PCBPT+WAKEMASKWORDNUM).NONCRITEVENTFIEL<<*pcb*>>04414000
   SPCBABORTWAKE  = PCB(PCBPT+WAKEMASKWORDNUM).ABORTWAKEFLAGS#,<<*pcb*>>04416000
   SPCBIMPEDE     = PCB(PCBPT+WAKEMASKWORDNUM).IMPEDEDWAITFLAG#<<*pcb*>>04418000
   SPCBPSIM       = PCB(PCBPT+PIINFOWORDNUM).PSIMFIELD#,       <<*pcb*>>04420000
   SPCBWAKESOFT   = PCB(PCBPT+PIINFOWORDNUM).WAKESOFTFLAG#,    <<*pcb*>>04422000
   SPCBSOFTINT    = PCB(PCBPT+PROCSTATEWORDNUM).SOFTINTFLAG#,  <<*pcb*>>04424000
   SPCBPIFLAGS    = PCB(PCBPT+PROCSTATEWORDNUM).PIFLAGSFIELD#, <<*pcb*>>04426000
   SPCBDISPQ      = PCB(PCBPT+QUEUEINGINFOWORDNUM).DISPQFLAG#, <<*pcb*>>04428000
   SPCBALLOWSOFT  = PCB(PCBPT+QUEUEINGINFOWORDNUM).ALLOWSOFTFLA<<*pcb*>>04430000
   SPCBSTKDST     = PCB(PCBPT+STKINFOWORDNUM).STKDSTFIELD#,    <<*pcb*>>04432000
   SPCBXDSDST     = PCB(PCBPT+DBXDSINFOWORDNUM).XDSDSTFIELD#,  <<*pcb*>>04434000
   SPCBFATHERINFO = PCB(PCBPT+FATHERINFOWORDNUM)#,             <<*pcb*>>04436000
   SPCBSONINFO    = PCB(PCBPT+SONINFOWORDNUM)#,                <<*pcb*>>04438000
   SPCBBROTHERINFO= PCB(PCBPT+BROTHERINFOWORDNUM)#,            <<*pcb*>>04440000
   SPCBPIMPPIN    = PCB(PCBPT+PIMPPINWORDNUM)#,                <<*pcb*>>04442000
   SPCBNIMPPIN    = PCB(PCBPT+NIMPPINWORDNUM)#,                <<*pcb*>>04444000
   SPCBPTYPE      = PCB(PCBPT+PROCSTATEWORDNUM).PTYPEFIELD#,   <<*pcb*>>04446000
   SPCBPTYPE'     = PCB(PCBPT+PROCSTATEWORDNUM).PTYPEFIELD'#,  <<*pcb*>>04448000
   SPCBQTYPE      = PCB(PCBPT+QUEUEINGINFOWORDNUM).QUEUEFIELD#,<<*pcb*>>04450000
   SPCBPBX        = PCB(PCBPT+PBXWORDNUM)#,                    <<*pcb*>>04452000
   SPCBMAPDST     = PCB(PCBPT+MAPDSTWORDNUM)#,                 <<*pcb*>>04454000
   SPCBPPRI       = PCB(PCBPT+QUEUEINGINFOWORDNUM).PRIFIELD#;  <<*pcb*>>04456000
                                                               <<*pcb*>>04458000
Comment                                                        <<*pcb*>>04460000
<<=========================================================    <<*pcb*>>04462000
=                                                         =    <<*pcb*>>04464000
=                  END INCLPCB                            =    <<*pcb*>>04466000
=                                                         =    <<*pcb*>>04468000
=========================================================>>    <<*pcb*>>04470000
;                                                              <<*pcb*>>04472000
<<>>                                                           <<MPEIV>>04474000
<<LOCALITY LISTS>>                                             <<MPEIV>>04476000
<<>>                                                           <<MPEIV>>04478000
                                                               <<MPEIV>>04480000
                                                               <<*SLL*>>04482000
                                                               <<*SLL*>>04484000
                                                               <<MPEIV>>04486000
  DOUBLE POINTER TCSTDISC,           <<INITIAL'S SEGS DISC ADDRS>>      04488000
                 OLDINFOD=OLDINFO,   <<OLD INFO TABLE>>                 04490000
                 ENTRE,              <<EXTENT POINTER>>                 04492000
                 DCTAB0=CTAB0;                                 <<bcrap>>04494000
  INTEGER POINTER ENTRE0 = ENTRE;                              <<bcrap>>04496000
  BYTE POINTER BPINBUF,              <<INPUT BUFFER POINTER>>           04498000
               INTR;            <<INTERRUPT PROCEDURES' STT'S>><<DCLAS>>04500000
  BYTE ARRAY PROCNAMES(0:71) :=                                <<03552>>04502000
    <<  0>>  "ININ    ",                                       <<03552>>04504000
    <<  8>>  "PROGEN  ",                                       <<03552>>04506000
    << 16>>  "UCOP    ",                                       <<03552>>04508000
    << 24>>  "PFAIL   ",                                       <<03552>>04510000
    << 32>>  "LOAD    ",                                       <<03552>>04512000
    << 40>>  "DEVREC  ",                                       <<03552>>04514000
    << 48>>  "LOG     ",                                       <<03552>>04516000
    << 56>>  "MEMLOGP ",                                       <<03552>>04518000
    << 64>>  "PVPROC  ";                                       <<03552>>04520000
BYTE ARRAY BAMISC(0:182):=                                     <<t8392>>04522000
        <<00>>  "CONFDATA ",0,                                 <<DEVCO>>04524000
        <<10>>  "DEVDATA ",                                    <<DEVCO>>04526000
        <<18>>  "SL      ",                                    <<DEVCO>>04528000
        <<26>>  "CSDUMMY ",                                    <<DEVCO>>04530000
        <<34>>  "7TRACE0'",                                    <<DEVCO>>04532000
        <<42>>  "=COMMANDINTERP",                              <<DEVCO>>04534000
        <<56>>  "9TERMINATE",                                  <<DEVCO>>04536000
        <<66>>  "9PSEUDOINT",                                  <<DEVCO>>04538000
        <<76>>  "3DSP",                                        <<DEVCO>>04540000
        <<80>>  ":IOMESSPROC",0,                               <<DEVCO>>04542000
        <<92>>  "3GIP",                                        <<DEVCO>>04544000
        <<96>>  "4TICK ",                                      <<DEVCO>>04546000
        <<102>> "9SYSIOPROC      ",                            <<SYSIO>>04548000
        <<118>> "8INITIATE",0,                                 <<DEVCO>>04550000
        <<128>> "6CCLOSE",0,                                   <<DEVCO>>04552000
        <<136>> "8CSIOWAIT",0,                                 <<PORTS>>04554000
        <<146>> "=SYSPORTSERVER",                              <<iopad>>04556000
        <<160>> "6IOPAD1",0,                                   <<AL.00>>04558000
       <<168>> "5NMMON",                                       <<t8392>>04560000
       <<174>> "DEFDATA ",0;                                   <<t8392>>04562000
DEFINE  CTABFILE     = BAMISC#,                                <<DEVCO>>04564000
        DEVFILE      = BAMISC(10)#,                            <<DEVCO>>04566000
        SLFILE       = BAMISC(18)#,                            <<DEVCO>>04568000
        CSDUMMY      = BAMISC(26)#,                            <<DEVCO>>04570000
        TRACENAME    = BAMISC(34)#,                            <<DEVCO>>04572000
        CINAME       = BAMISC(42)#,                            <<DEVCO>>04574000
        TERMNAME     = BAMISC(56)#,                            <<DEVCO>>04576000
        PSINTNAME    = BAMISC(66)#,                            <<DEVCO>>04578000
        DISPATCHNAME = BAMISC(76)#,                            <<DEVCO>>04580000
        IOMESSNAME   = BAMISC(80)#,                            <<DEVCO>>04582000
 <<     GIPNAME      = BAMISC(92)#,        >>                  <<bcrap>>04584000
 <<     CLOCKNAME    = BAMISC(96)#,        >>                  <<bcrap>>04586000
        SYSIOPROC    = BAMISC(102)#,                           <<SYSIO>>04588000
        INITNAME     = BAMISC(118)#,                           <<DEVCO>>04590000
        CCLOSENAME   = BAMISC(128)#,                           <<DEVCO>>04592000
        CSIOWAITNAME = BAMISC(136)#,                           <<PORTS>>04594000
        SYSPORTNAME  = BAMISC(146)#,                           <<iopad>>04596000
  <<    IOPAD1NAME   = BAMISC(160)#,  >>                       <<bcrap>>04598000
       NMMONNAME     = BAMISC(168)#,                           <<t8392>>04600000
       DEFFILE       = BAMISC(174)#;                           <<t8392>>04602000
  DEFINE ININFILE    = PROCNAMES#,                             <<03552>>04604000
         PROGFILE    = PROCNAMES(8)#,                          <<03552>>04606000
         UCOPFILE    = PROCNAMES(16)#,                         <<03552>>04608000
         PFAILFILE   = PROCNAMES(24)#,                         <<03552>>04610000
         LOADFILE    = PROCNAMES(32)#,                         <<03552>>04612000
         DEVRECFILE  = PROCNAMES(40)#,                         <<03552>>04614000
         LOGFILE     = PROCNAMES(48)#,                         <<03552>>04616000
         MEMLGFILE   = PROCNAMES(56)#,                         <<03552>>04618000
         PVPROCFILE  = PROCNAMES(64)#;                         <<03552>>04620000
    LOGICAL ARRAY CSDRTN (0:31);                               <<03002>>04622000
        <<BIT ARRAY OF DRT'S, BIT IS SET IF DRT OF CS DEVICE>>          04624000
  BYTE ARRAY PROTECTED(0:NPROTECTED*8-1) := "CONFDATA","SYSDUMP ",      04626000
                     "SEGDVR  ","SEGPROC ","LOG     ","LOADMAP ",       04628000
                     "MAKECAT ","CATALOG ","INITIAL ",         <<03745>>04630000
                     "DEVDATA ","PVINIT  ","STORE   "          <<DEVCO>>04632000
                    ,"DEFDATA "                                <<D8637>>04634000
$IF X1=ON  << ADDITIONAL SERIES 33 PROGRAMS >>                 <<00888>>04636000
                ,"SDFLOAD ","SDFCHECK","SDFCOM  ","SDFGEN  "   <<00888>>04638000
                ,"TT4     ","TT6     ","TT9     "              <<06067>>04640000
                ,"TT10    ","TT12    ","TT13    "              <<06067>>04642000
                ,"TT15    ","TT16    ","TT18    "              <<06067>>04644000
                ,"TT19    ","TT20    ","TT21    "              <<06067>>04646000
                ,"TT22    ","TT31    ","VFC31B7 "              <<06067>>04648000
                ,"VFC31B8 "                                    <<06067>>04650000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>04652000
                 ;                                             <<00888>>04654000
                                                               <<i9073>>04656000
 << ------------------------------------------------ >>        <<i9073>>04658000
 << Unique system program files that are dumped on a >>        <<i9073>>04660000
 << FOS tape must also be "purge"-protected.  However>>        <<i9073>>04662000
 << because the file is only dumped when a FOS is    >>        <<i9073>>04664000
 << created and we cannot guarantee the file is      >>        <<i9073>>04666000
 << always there, a separate list needs to be main-  >>        <<i9073>>04668000
 << tained and checked when loading system files.    >>        <<i9073>>04670000
 << Note that the procedure is the same for WCS files>>        <<i9073>>04672000
 << ------------------------------------------------ >>        <<i9073>>04674000
                                                               <<i9073>>04676000
 EQUATE NR'FOSFILES = 1;                                       <<i9073>>04678000
 ARRAY FOSFILES(0:NR'FOSFILES*4-1) :=                          <<i9073>>04680000
       "AUTOINST";                                             <<i9073>>04682000
                                                               <<i9073>>04684000
  INTEGER ARRAY PAGES(0:2):=JMATPAGES,IDDPAGES,ODDPAGES;       <<MPEIV>>04686000
  INTEGER ARRAY SYSINFO(0:25) := 0,0,%177777,%713,0,0,         <<D8063>>04688000
"        ",0,0,%77777,-1,0,0,%77777,-1,0,0,%77777,-1,          <<2B.00>>04690000
          [2/2,2/1,2/1,2/1,2/2,2/1],150,0,0;                   <<RV.PV>>04692000
INTEGER ARRAY PUBINFO(0:36):=0,"        ",0,0,%77777,-1,0,0,   <<14.PV>>04694000
          %77777,-1,0,0,%77777,-1,                             <<02836>>04696000
          [2/0,5/16,5/6,4/3], [1/0,5/6,5/16,5/6],              <<02836>>04698000
          %713,0,0,"        ","        ","        ",0,0,0;     <<02836>>04700000
  INTEGER ARRAY MANAGERINFO(0:14) := %177777,%713,0,0,         <<D8063>>04702000
          "        ","PUB     ",0,150,0;                                04704000
  INTEGER ARRAY SYSACCT(0:3) := "SYS     ";                             04706000
  INTEGER ARRAY PUBGRP(0:3) := "PUB     ";                              04708000
  INTEGER ARRAY MANUSER(0:3) := "MANAGER ";                             04710000
  INTEGER ARRAY NULLNAME(0:3) := "        ";                            04712000
                                                               <<25.02>>04714000
  << TO ADD NEW 13037-COMPATIBLE MOVING HEAD DISC SUBTYPES  >> <<25.03>>04716000
  << (MUST BE <= 15):                                       >> <<25.03>>04718000
  <<   1.  MODIFY NMHSUBTYPES (NUMBER OF MOVING HEAD        >> <<25.02>>04720000
  << SUBTYPES),                                             >> <<25.02>>04722000
  <<   2.  ADD THE APPROPRIATE SUBTYPE ENTRIES TO MHINFO.   >> <<25.02>>04724000
  << EACH SUBTYPE CONSISTS OF SEVEN ENTRIES (ONE LINE) IN   >> <<25.02>>04726000
  << MHINFO.  SEE ENTRY DESCRIPTIONS IN THE MOVING HEAD     >> <<25.02>>04728000
  << DISC INFORMATION TABLE (STARTS AT MHINFOSIZE),         >> <<25.02>>04730000
  <<   3.  ADD ENTRIES TO ARRAYS "FILEMASK", "SEC'CYL" AND  >> <<25.02>>04732000
  << "HEADBASE" IN PROCEDURE MH7905,                        >> <<25.02>>04734000
  <<   4.  ADD ENTRIES TO ARRAYS "SCTPERHD" AND "HDBASE" IN >> <<25.02>>04736000
  << PROCEDURE SIOREADENT.                                  >> <<25.02>>04738000
  <<   NOTE:  DO NOT TRY TO GATHER THE VARIOUS ARRAYS IN    >> <<25.02>>04740000
  << MH7905, MHDISC AND SIOREADENT INTO MHINFO.  IT DOESN'T >> <<25.02>>04742000
  << WORK BECAUSE THOSE PROCEDURES RUN IN STRANGE           >> <<25.02>>04744000
  << DB RELATIVE PLACES THAT DON'T KNOW ABOUT MHINFO.       >> <<25.02>>04746000
  <<   5.  MODIFY SUBROUTINE "INITIALIZE" OF MH7905, IF     >> <<25.03>>04748000
  << REQUIRED, SO THAT AN ENTIRE TRACK IS INITIALIZED.      >> <<25.03>>04750000
                                                               <<25.03>>04752000
  INTEGER ARRAY MHINFO (0:NMHSUBTYPES*MHINFOSIZE - 1) :=       <<25.00>>04754000
            200,203, 1,48,2,0,12,  << 7900, REMOVABLE CART. >> <<25.02>>04756000
            200,203, 1,48,2,2,12,  << 7900, FIXED PLATTER   >> <<25.02>>04758000
            200,203, 2,48,2,0,16,  << 7900, BOTH PLATTERS   >> <<25.02>>04760000
            400,406,20,23,1,0,32,  << ISS DISC              >> <<25.02>>04762000
            400,411, 2,48,1,0,20,  << 7905, REMOVABLE CART. >> <<25.02>>04764000
            400,411, 1,48,1,2,16,  << 7905, FIXED PLATTER   >> <<25.02>>04766000
            400,411, 3,48,1,0,24,  << 7905, BOTH PLATTERS   >> <<25.02>>04768000
            120,125, 3,48,1,0,16,  << 7905, FH DISC RPLCMNT >> <<25.02>>04770000
            815,823, 5,48,1,0,32,  << 7920                  >> <<25.02>>04772000
            815,823, 9,64,1,0,64,  <<7925                   >> <<01359>>04774000
      400,411,2,48,1,0,20,   <<STYPE 10, 7906, RMOVEABLE CART>><<00888>>04776000
      400,411,2,48,1,2,20,   <<STYPE 11, 7906, FIXED PLATTER>> <<00888>>04778000
      400,411,4,48,1,0,32,   <<STYPE 12, 7906, BOTH PLATTERS>> <<00904>>04780000
      735,748,2,32,1,0,20;   <<STYPE 13, 7910         >>       <<00904>>04782000
  INTEGER ARRAY FHINFO(0:2):=128,256,512;                               04784000
  INTEGER ARRAY FHVOLS(-1:MAXSUBTYPES-1):=MAXSUBTYPESP1(1);    <<03550>>04786000
  INTEGER ARRAY MHVOLS(-1:MAXSUBTYPES-1):=MAXSUBTYPESP1(1);    <<03550>>04788000
  INTEGER ARRAY CS80VOLS(-1:MAXSUBTYPES-1):=MAXSUBTYPESP1(1);  <<03550>>04790000
GLOBAL INTEGER ARRAY LINE(0:35) := 36("  ");                            04792000
BYTE ARRAY BLINE(*) = LINE;                                    <<00888>>04794000
   INTEGER ARRAY FLAB(0:127),   <<FILE LABEL>>                 <<00888>>04796000
                FCB(0:215),          <<FILE CONTROL BLOCK>>             04798000
                INFO(0:INFOSIZE-1),  <<DISC COLD LOAD INFO TABLE>>      04800000
                LBUF(0:1023),        <<LARGE BUFFER>>                   04802000
                BUF(0:511),          <<I/O BUFFER>>                     04804000
                DTT(*)=LBUF(128),    <<DEFECTIVE TRACKS TABLE>>         04806000
                DSCT(*)=LBUF(128),   <<DEFECTIVE SECTOR TABLE>><<03550>>04808000
                SLREC0(*)=LBUF,      <<SL FILE RECORD 0>>               04810000
                SLREC1(*)=LBUF(128), <<SL FILE RECORD 1>>               04812000
                REFTAB(0:127),       <<SL REFERENCE TABLE>>             04814000
                EXTLIST(*)=LBUF(256),<<EXTERNAL LIST>>                  04816000
                STT(*)=LBUF(512),    <<SEGMENT TRANSFER TABLE>>         04818000
                PREC0(*)=LBUF(896),  <<PROGRAM FILE RECORD 0>>          04820000
                EXTBUF(*)=BUF,       <<PROGRAM EXTERNAL BUFFER>>        04822000
                EXTSAT(*)=BUF(256),  <<SATISFIED EXTERNAL LIST>>        04824000
                REC0(*)=LBUF,        <<PROGRAM FILE RECORD 0>>          04826000
                DBINFO(*)=LBUF(128),  <<DRIVER DB AREA>>                04828000
                OBINFO(*)=LBUF(512),  <<DRIVER OUTER BLOCK>>            04830000
                DVREXT(*)=LBUF(768),  <<DRIVER EXTERNALS>>              04832000
                DEVREC0(0:DEVREC0SIZE-1), << FIRST RECORD OF DE<<DEVCO>>04834000
                INBUF(0:35),         <<INPUT BUFFER>>                   04836000
                VNAMEI(0:3),         <<VOLUME NAME>>                    04838000
                SWAPD(0:(MAXSWAPSEG-1)*SWAPDSIZE);             <<c8392>>04840000
                << SWAPPING DESCRIPTOR TABLE >>                <<01683>>04842000
  INTEGER ARRAY INTHS'UNITS(0:511):=512(0); <<# OF IH'S & U'S>><<03002>>04844000
                             <<AND # OF UNITS FOR CONTROLLER>> <<00888>>04846000
  LOGICAL ARRAY MHINFOL(*)=MHINFO;                                      04848000
   BYTE ARRAY BBUF(*)=BUF,                                     <<00888>>04850000
             BFLAB(*)=FLAB,                                             04852000
             BINBUF(*)=INBUF,                                           04854000
             BEXTLIST(*)=EXTLIST,                                       04856000
             VNAME(*)=VNAMEI,                                           04858000
          BTYP(*)=VNAME,                                                04860000
             BLBUF(*)=LBUF,                                             04862000
             DEVCLASS(0:8),          <<DEVICE CLASS NAME>>              04864000
             IOPROCNAME(0:15),       <<I/O PROCESS NAME>>               04866000
             BPREC0(*)=PREC0;                                           04868000
  BYTE ARRAY FQFNAME(0:25);           <<FULLY QUAL. FILENAME>> <<06067>>04870000
  INTEGER ARRAY IFQFNAME(*) = FQFNAME;   <<SAME>>              <<06067>>04872000
                                                               <<03557>>04874000
                                                               <<03549>>04876000
  EQUATE  MAX'REASS = 150;   << MAX. NO. OF DISC AREAS WHICH>> <<03549>>04878000
                             <<   LOST DATA DURING SPARING  >> <<03549>>04880000
  INTEGER ARRAY                     << SPARED AREAS OF DISC >> <<03549>>04882000
     REASSIGNED(0:(MAX'REASS+1)*5-1);  << WHICH LOST DATA   >> <<03714>>04884000
                                                               <<03549>>04886000
  DEFINE NREASS = REASSIGNED(0)#;   <<CURRENT NO. OF ENTRIES>> <<03714>>04888000
                                    <<  IN 'REASSIGNED'     >> <<03714>>04890000
  DOUBLE ARRAY FCBDBL(*)=FCB,        <<FILE CONTROL BLOCK>>             04892000
               EXTSIZES(0:31),       <<EXTENT SIZES>>                   04894000
               SEGDISCADR(0:20),     <<INITIAL'S SEGMENTS DISC ADDRS>>  04896000
               INFOD(*)=INFO,                                           04898000
               FLABDBL(*)=FLAB;      <<FILE LABEL>>                     04900000
  INTEGER ARRAY IAS0(*)=S-0;                                            04902000
  GLOBAL ARRAY IDINFO(0:999*3);                                <<I8392>>04904000
  DOUBLE  STTADR,                    <<DISC ADDRESS OF STT>>            04906000
          SECTORS=STTADR,            <<# OF SECTORS IN FILE>>           04908000
          DTEMP,                     <<TEMPORARY>>                      04910000
          DIRDISCADR,                <<DIRECTORY DISC ADDRESS>>         04912000
          DEVFILEADR,    << ADR OF FIRST REC OF DEVDATA >>     <<DEVCO>>04914000
          LOADMAPADR;                <<DISC ADDR. OF LOADMAP>> <<03557>>04916000
  INTEGER DIRDISCADDR1 = DIRDISCADR,  << HODA >>               <<01384>>04918000
          DIRDISCADDR2 = DIRDISCADR+1;  << LODA >>             <<01384>>04920000
EQUATE ANYWHERE'TAB  = 0,                                      <<32BND>>04922000
       BANK0ONLY     = 1,                                      <<32BND>>04924000
       BANK0ABOVE    = 2,                                      <<32BND>>04926000
       TEMPORARY'TAB = 4;                                      <<32BND>>04928000
LOGICAL TABSIZE;                                               <<32BND>>04930000
DOUBLE MEMADR;                                                 <<32BND>>04932000
LOGICAL LCMEMLOC;    <<LOW CORE MEMORY POINTER>>               <<32BND>>04934000
   INTEGER COREX,              <<CORE SIZE INDEX>>             <<00888>>04936000
ADRBASE, <<BASE ADR OF CHAN SEEK COMMAND FOR BOOTSTRAP PROG>>  <<00888>>04938000
          CLRSW,                     << CL. VALUE OF SW. REG.>><<02510>>04940000
          OPT,                       <<OPTION>>                         04942000
          DISCLASS'X,             <<INDEX INTO DCTAB FOR DISC>><<DCLAS>>04944000
          NSWAPSEG,                  <<NUMBER OF SWAPPING SEGMENTS>>    04946000
          SYSVOL,                    <<SYSTEM DISC VOLUME NUMBER>>      04948000
          COLDLOADID,                <<COLD LOAD ID>>                   04950000
          COLDLOADLDEV,              <<COLDLOAD DEVICE LDEV>>  <<I8884>>04952000
          NVOL,                      <<VOLUME TABLE COUNTS>>   <<RH.PV>>04954000
          ALT,                       <<ALTERNATE TRACK>>                04956000
          SYSDISCTYPE,               <<TYPE OF SYSTEM DISC>>            04958000
          SYSDISCSUBTYPE,            <<SYSTEM DISC SUBTYPE>>            04960000
          NDISCDEV,                  <<# OF DEVICES IN CLASS DISC>>     04962000
          DISCLDEV:=0,               <<CURRENT DISC CLASS INDEX>>       04964000
          NNODISC,                   <<# OF FILES WITH NO DISC SPACE>>  04966000
          LEN,                       <<LENGTH OF MAG TAPE RECORD>>      04968000
          TAPERECSIZE,                                         <<03603>>04970000
          NBLKS,                     <<# OF BLOCKS READ>>               04972000
          BLOCKSWRITTEN,             <<# OF BLOCKS WRITTEN SO FAR>>     04974000
          DRTN,                      <<DRT #>>                          04976000
          HIDRT,                     <<HIGHEST ALLOCATED DRT>> <<02707>>04978000
          LDEV,                      <<LOGICAL DEVICE #>>               04980000
          HLDEV,                     <<HIGHEST LOGICAL DEVICE>>         04982000
          TLNUMENTRIES,              <<# ENTS IN DEFDATA FILE>><<t8392>>04984000
          TLTABLESIZE,               <<SIZE OF DEFDATA FILE  >><<t8392>>04986000
          NUSERFILES,                <<# OF USER FILES IN DIRECTORY>>   04988000
          XPPUBFILES, <<PTR INTO DIR FILE INDEX BLK >>         <<S9090>>04990000
                      <<FOR PUB.SYS                 >>         <<S9090>>04992000
          MEMSEG,                    <<LENGTH OF SEGMENT>>              04994000
          FCBHD,                     <<HEAD OF FCB FREE LIST>>          04996000
          CTABFNUM,                  <<CONFIGURATION FILE NUMBER>>      04998000
          DEFFNUM,                   <<DEFAULT DEVICE FILE NUMB<<t8392>>05000000
          DEVFNUM,                   <<I/O CONF FILE NUM>>     <<DEVCO>>05002000
          SLFNUM,                    <<SL FILE NUMBER>>                 05004000
          SLRTNUM,    << REFERENCE TABLE REC NUMBER >>         <<S9090>>05006000
          STTLDEV,                   <<LOG DEV # FOR CURRENT STT>>      05008000
          STTINDEX,                  <<POINTER TO PL>>                  05010000
          STTADR1=STTADR,            <<FIRST WORD OF STT DISC ADDRESS>> 05012000
          STTADR2=STTADR+1,          <<2ND WORD OF STT DISC ADDRESS>>   05014000
          NPROCQ=LEN,                <<# OF I/O PROCESS QUEUES>>        05016000
          NCNTRLQ=NBLKS,             <<# OF CONTROLLER QUEUES>>         05018000
          NIOPROC=BLOCKSWRITTEN,     <<# OF I/O PROCESSES>>             05020000
          NDLT,                      <<# OF DLT ENTRIES>>      <<03714>>05022000
          DVRFNUM,                   <<DRIVER FILE NUMBER>>    <<02510>>05024000
          INTRINDEX,                 <<INDEX INTO INTERRUPT TAB<<02510>>05026000
          DLTINDEX=NUSERFILES,       <<INDEX INTO DLT>>                 05028000
          DVRTYPE=NNODISC,           <<DRIVER TYPE>>                    05030000
          NRESQ=DISCLDEV,            <<#0OF RESOURCE QUEUES>>           05032000
          SAGL,                      <<STARTING ADDRESS OF GARBAGE>>    05034000
          HCST,                      <<HIGHEST CST NUMBER>>             05036000
          DLTPTR',                   <<POINTER TO DLT>>                 05038000
          SEGTLEN,                   <<SEGMENT TABLE LENGTH>>           05040000
          RTNUM,                     <<# OF REFERENCE TABLE ENTRIES>>   05042000
          CSTN,                      <<CURRENT CST NUMBER>>             05044000
          CSTINDEX,                  <<CST NUMBER OF PROGRAM>>          05046000
          DSTINDEX,                  <<DST NUMBER OF STACK>>            05048000
          PROCSTART,                 <<ENTRY POINT FOR PROGRAM>>        05050000
          GLOB,                      <<SIZE OF DB AREA>>                05052000
          DBVALUE,                   <<LOCATION OF DB>>                 05054000
          DLVALUE,                   <<SIZE OF DL AREA>>                05056000
          SVALUE,                    <<RELATIVE LOCATION OF S>>         05058000
          ZVALUE,                    <<RELATIVE LOCATION OF Z>>         05060000
          QVALUE,                    <<RELATIVE VALUE OF Q>>            05062000
          MAXD,                      <<MAXDATA>>                        05064000
          BANK0,                     <<BANK0 DEP.MEM SIZE>>    <<01299>>05066000
          LOGONLOC := 0,     <<ACTIVE LOGON MESSAGE DST>>               05068000
          CSDVRAREASIZE,             <<SIZE OF DRIVER WORK AREA>>       05070000
          LDMAPFNUM,                 <<LOADMAP FILE #>>                 05072000
          EXPFLAG,                   <<FLAG FOR EXP SOFTWARE>> <<06069>>05074000
          INDEX;                     <<TABLE INDEX>>                    05076000
LOGICAL MAXSTACKSIZE;   <<STACK SIZE LIMIT>>                   <<04261>>05078000
  INTEGER POINTER SIOPNTR;                                     <<03557>>05080000
  DEFINE NREADYF = (14:1)#;  <<VOLUME ON-LINE/OFF-LINE>>       <<RH.PV>>05082000
                                                               <<RH.PV>>05084000
  DEFINE                                                       <<RH.PV>>05086000
          MVOL = NVOL.(0:8)#,        <<MAX VOLS IN VTAB>>      <<RH.PV>>05088000
          HVOL = NVOL.(8:8)#;        <<SYS VOLS IN VTAB>>      <<RH.PV>>05090000
                                                               <<RH.PV>>05092000
                                                               <<RH.PV>>05094000
  INTEGER I,J,K,L,M,N,TEMP;        <<TEMPORARIES>>             <<02510>>05096000
   INTEGER POINTER RESTOREBUF:=0;<<RESTORE FILE BUFFER>>       <<KS.88>>05098000
   BYTE POINTER BRESTOREBUF;                                   <<KS.88>>05100000
INTEGER LASTLOADMODE=TEMP;                                     <<00888>>05102000
                                                               <<RH.PV>>05104000
  INTEGER DTEMP2=DTEMP+1;                                      <<MPEIV>>05106000
                                                               <<RH.PV>>05108000
INTEGER DISPQHEAD=DB+DISPQHEADIX,                              <<MPEIV>>05110000
        DISPQTAIL=DB+DISPQTAILIX,                              <<MPEIV>>05112000
        MAXAVAILREG=DB+MAXAVAILREGIX,                          <<MPEIV>>05114000
        SYSBANKCOUNT=DB+NBANKSIX;                              <<MPEIV>>05116000
   LOGICAL MORE,               <<MORE DEVICE CLASS ENTRIES>>   <<00888>>05118000
        DEV'DEFAULTS,                                          <<t8392>>05120000
          LINKED,                    <<SEGMENT IN LINKED MEMORY>>       05122000
          LOGGING,                   <<LOGGING ENABLED>>                05124000
          RECOVERY,                  <<RECOVERING DISC SPACE>>          05126000
          VALID=MORE,                <<LABEL IS A VALID ONE>>           05128000
          FLAGGED=LINKED,            <<TRACK IS FLAGGED DEFECTIVE>>     05130000
          ACCTSONLY,                 <<RELOAD ACCOUNTS ONLY>>           05132000
          RELOAD,                    <<RELOAD OPTION>>                  05134000
          DATAFLAG,                  <<DATA IN TAPE BUFFER>>            05136000
          LOADMAP,                   <<TRUE IF LOADMAP DESIRED>>        05138000
          CHANGES,                   <<TRUE IF CONFIGURATION CHANGES>>  05140000
          SECONDPASS,                <<SECOND PASS THRU CONFIGURATION>> 05142000
          CNT,                       <<SECTOR COUNT>>                   05144000
          NN=SECONDPASS,                                                05146000
          MM,                                                           05148000
          SECTORSLEFT=MORE,          <<# OF SECTORS LEFT IN EXTENT>>    05150000
          FIRST=MORE,                <<FIRST DIT>>                      05152000
          NEWDLT=SECONDPASS,         <<NEW ENTRY ADDED TO DLT>>         05154000
          RESIDENT=CNT,              <<DRIVER IS CORE RESIDENT>>        05156000
          INITLOGONDST := FALSE,<<INITIALIZE LOGON MESSAGE>>            05158000
          HEADING'PRINTED,  << USED IN PROCEDURE PRINTFNR >>   <<01442>>05160000
          HCLIMIT,                   <<LAST AVAIL. WORD BANK 0><<03603>>05162000
          LOADFROMTAPE:=TRUE;        <<COLD LOAD IS FROM TAPE>>         05164000
           INTEGER CSDUMMYINDEX;                                        05166000
  INTEGER X=X;                       <<X REGISTER>>                     05168000
  INTEGER S0=S-0,S1=S-1,S2=S-2,S3=S-3,S4=S-4,S7=S-7;           <<bcrap>>05170000
  DOUBLE DS1=S-1,DS3=S-3,DS5=S-5,DS6=S-6;                      <<bcrap>>05172000
  INTEGER POINTER PS0=S-0;  <<<TOP OF STACK POINTERS>>         <<bcrap>>05174000
  BYTE POINTER BPS0=S-0,BPS1=S-1;    <<TOP OF STACK BYTE POINTERS>>     05176000
  BYTE BS0 = S-0, BS1 = S-1;                                   <<03603>>05178000
DEFINE ABS = ABSOLUTE#;                                        <<03603>>05180000
INTEGER PARMQ4 = Q - 4;                                                 05182000
  LOGICAL STAT=Q-1;                  <<STATUS WORD IN MARKER>>          05184000
  LOGICAL STATUS = Q-1;                                        <<MPEIV>>05186000
LOGICAL RETURNP'=Q-2;  <<MAP FLAG,DELTAP IN MARKER>>           <<*MAP*>>05188000
DEFINE  RETURNP= RETURNP'.(2:14)#; <<DELTAP IN MARKER>>        <<*MAP*>>05190000
EQUATE LDMAP'SIZE = 3200;                                      <<03668>>05192000
                                                               <<03668>>05194000
<< LDMAPBUF IS USED TO HOLD, IN ORDER OF THEIR OCCURRENCE: >>  <<03744>>05196000
<< (1) THE LIST OF FILES WHICH LOST DATA DURING SPARING    >>  <<03744>>05198000
<< THAT THE USER WILL BE GIVEN THE OPPORTUNITY TO SAVE     >>  <<03744>>05200000
<< AFTER RECOVER LOST DISC SPACE, (2) THE DRT TABLE WHEN   >>  <<03744>>05202000
<< IT MUST BE MOVED, (3) THE LOADMAP, WHICH IS EVENTUALLY  >>  <<03744>>05204000
<< COPIED TO THE FILE LOADMAP.PUB.SYS                      >>  <<03744>>05206000
                                                               <<03744>>05208000
ARRAY LDMAPBUF(0:LDMAP'SIZE-1);                                <<03668>>05210000
EQUATE MAXBANKS          = 64,                                 <<01756>>05212000
       CORERES'          = 0,                                  <<01384>>05214000
       ABSENT'           = 2;                                  <<03635>>05216000
                                                               <<01384>>05218000
DEFINE  MEMORYSIZE       = LOGICAL(CTAB0(CORESIZE))#,          <<CONFD>>05220000
        NUM'BANKS        = LOGICAL(CTAB0(CORESIZE)+63)&LSR(6)#;<<CONFD>>05222000
ARRAY   ADDRESS(0:MAXBANKS-1) := MAXBANKS(HEADERLENGTH);       <<MPEIV>>05224000
        << PTRS TO AVAILABLE SPACE, SAVE ROOM FOR HEADERS>>    <<MPEIV>>05226000
                                                               <<SY>>   05228000
                                                               <<SY>>   05230000
<< ******************************************************** >> <<SY>>   05232000
<<      G L O B A L    V A R I A B L E    D E C L .         >> <<SY>>   05234000
<< ******************************************************** >> <<SY>>   05236000
   EXT'DCL INTEGER POINTER                                     <<SY>>   05238000
                   BUF'     =  BUF,  << I/O BUFFER    >>       <<SY>>   05240000
                   LBUF'    =  LBUF, << LARGE BUFFER  >>       <<SY>>   05242000
                   FLAB'    =  FLAB, << FILE LABEL    >>       <<SY>>   05244000
                   MHINFO'  =  MHINFO,                         <<SY>>   05246000
                   REASSIGNED' = REASSIGNED;                   <<SY>>   05248000
                                                               <<SY>>   05250000
   EXT'DCL LOGICAL LISTPURGE;                                  <<SY>>   05252000
<< MISCELLANEOUS DECLARATIONS >>                                        05254000
   DEFINE  ASMB      = ASSEMBLE#,                              <<MPEIV>>05256000
           PDISABLE  = ASSEMBLE(NOP,NOP)#,                     <<MPEIV>>05258000
           PENABLE   = ASSEMBLE(NOP,NOP)#;                     <<MPEIV>>05260000
   INTEGER                                                              05262000
      XREG = X;                                                         05264000
   LOGICAL                                                              05266000
      LS0 = S-0,                                                        05268000
      LS1 = S-1;                                               <<03552>>05270000
DOUBLE DS0 = S - 1;      <<DOUBLE TOP OF STACK>>                        05272000
   DEFINE                                                               05274000
      CCFLD = (6:2) #,                                         <<MPEIV>>05276000
      CC = STAT.(6:2) #;                                                05278000
   INTEGER REEL;<<RELOAD TAPE REEL COUNTER TO BE USED>>        <<00.06>>05280000
                <<IN CASE OF PARITY ERROR WHILE READING>>      <<00.06>>05282000
                <<TAPE TRAILER LABEL>>                         <<00.06>>05284000
   LOGICAL HEDLABP;<<FLAG TO DENOTE THAT REEL NUMBER AND>>     <<00.06>>05286000
                   <<CREATION DATE ARE AVAILABLE FROM>>        <<00.06>>05288000
                   <<HEADER LABEL--ONLY USED WHEN NOT>>        <<00.06>>05290000
                   <<AVAILABLE FROM TRAILER LABEL>>            <<00.06>>05292000
   INTEGER ARRAY ITMP(0:2);<<THREE WORD ARRAY TO HOLD>>        <<00.06>>05294000
           <<CREATION DATE FROM HEADER LABEL OF RESTORE>>      <<00.06>>05296000
           <<TAPE>>                                            <<00.06>>05298000
                                                               <<03000>>05300000
  <<---------------------------->>                             <<03000>>05302000
  <<      WCS PARAMETERS        >>                             <<03000>>05304000
  <<---------------------------->>                             <<03000>>05306000
                                                               <<03000>>05308000
  DOUBLE ARRAY DISCWCSTAB(*) = LBUF(%25);                      <<03000>>05310000
  EQUATE NR'WCS'FILES = 2;                                     <<08392>>05312000
  ARRAY WCSNAMES(0:NR'WCS'FILES*6-1) :=                        <<03000>>05314000
     <<  NAME  >> << PROTECT MAP >> << WCS TABLE INDEX >>      <<03000>>05316000
     "SYSWCS64",           %40,               0,               <<08392>>05318000
     "SYSWCS37",          %100,               1;               <<08392>>05320000
                                                               <<03598>>05322000
        <<*********************>>                              <<03598>>05324000
        <<SERIAL DISC INTERFACE>>                              <<03598>>05326000
        <<*********************>>                              <<03598>>05328000
                                                               <<03598>>05330000
             <<ERRORCODES>>                                    <<03598>>05332000
                                                               <<03598>>05334000
EQUATE  SDERR17 = 17, <<OUT OF SYNC WITH GAPTABLE ON READ>>    <<03598>>05336000
        SDERR23 = 23, <<CURRENTBUFFINDEX OUTSIDE OF RECBUFF>>  <<03598>>05338000
        SDERR24 = 24, <<ATTEMPTED TO BSF BEYOND BOT>>          <<03598>>05340000
        SDERR28 = 28, <<NOT A COLDLOADABLE SDISC TYPE>>        <<03598>>05342000
        SDERR30 = 30, <<LEADING AND TRAILING RECLENS DIFFER>>  <<03598>>05344000
        SDERR31 = 31; <<FINDGAP FAIL-TRIED TO OVERFILL RECBUF>><<03598>>05346000
                                                               <<03598>>05348000
  INTEGER ARRAY DBINT(0:30):=31(0);                            <<*DVR*>>05350000
LOGICAL ARRAY DBLOG(*)=DBINT;                                  <<03598>>05352000
                                                               <<03598>>05354000
DEFINE  SYSTAPELDEV    = DBINT( 0)#,     <<LDEV# OF THE SDISC>><<03598>>05356000
        SYSTAPEDRT     = DBINT( 1)#,        <<DRT# & UNIT#>>   <<*DVR*>>05358000
        SYSTAPETYPE    = DBINT( 2)#,           << TYPE >>      <<03598>>05360000
        SYSTAPESTYPE   = DBINT( 3)#,           <<SUBTYPE>>     <<03598>>05362000
<<LOGICAL MAPPING INFORMATION>>                                <<*MAP*>>05364000
        SDISCREEL      = DBINT( 4)#,                           <<03598>>05366000
        SDISCDATE      = DBINT( 5)#,                           <<03598>>05368000
        SDISCTIME1     = DBINT( 6)#,                           <<03598>>05370000
        SDISCTIME2     = DBINT( 7)#,                           <<03598>>05372000
        SDISCSECTLEN   = DBINT( 8)#,                           <<03598>>05374000
        SDISCBOT       = DBINT( 9)#,                           <<03598>>05376000
        RECBUFINDEX    = DBINT(10)#,                           <<03598>>05378000
        WORDSINRECBUF  = DBINT(11)#,                           <<03598>>05380000
        TZTBUFINDEX    = DBINT(12)#,                           <<03598>>05382000
        TZTSECTOR      = DBINT(13)#,                           <<03598>>05384000
        SD'FLAGS       = DBLOG(14)#,                           <<03598>>05386000
        SD'ONLINE      = SD'FLAGS.(0:1)#,                      <<03598>>05388000
        END'OF'TAPE    = SD'FLAGS.(1:1)#,                      <<03598>>05390000
  <<    END'OF'FIL     = SD'FLAGS.(2:1)#, >>                   <<bcrap>>05392000
        FUTURE'DATE    = SD'FLAGS.(3:1)#,                      <<03598>>05394000
        SERIALDISCLOAD = SD'FLAGS.(4:1)#,                      <<03598>>05396000
        NEXTRECINBUF   = SD'FLAGS.(5:1)#,                      <<03598>>05398000
        TZT'TYPE       = DBINT(14).(13:3)#,                    <<03598>>05400000
        SYSD'NSECTS    = DBINT(15)#;                           <<03598>>05402000
                                                               <<03598>>05404000
                                                               <<03598>>05406000
                                                               <<03551>>05408000
DEFINE                                                         <<03551>>05410000
            NUTCST = DBINT(16)#,     <<# OF USED TEMP CSTS >>  <<03551>>05412000
            TCST1 = DBINT(17)#,      << FIRST TEMP CST >>      <<03551>>05414000
            RECSIZE = DBINT(18)#,    << SIZE OF RESTORE BLOCKS <<03551>>05416000
            DLSAVE = DBINT(19)#,       << OLD DL VALUE >>      <<03551>>05418000
            CONSOLELDEV = DBINT(20)#,  << LDEV # OF SYS CONSOLE<<03551>>05420000
            LLSWAP = DBINT(21)#,       << LEAST LIKELY SEG TO  <<03551>>05422000
            MLSWAP = DBINT(22)#,       << MOST LIKELY SEG TO   <<03551>>05424000
            SYSDISCDRT = DBINT(29)#,   << DRT FOR SYS DISC >>  <<*DVR*>>05426000
            SYSTAPEUNIT= DBINT(30)#;   << UNIT FOR SYS TAPE>>  <<*DVR*>>05428000
DEFINE LOGICALMAPPING'=ABSOLUTE(ABSOLUTE(QI)-9)#,              <<*MAP*>>05430000
       <<TRUE IF NEW FIRMWARE PRESENT--USE WHEN >>             <<*MAP*>>05432000
       <<TESTING BEFORE SYSGLOB INITIALIZED     >>             <<*MAP*>>05434000
       LOGICALMAPPING=ABSOLUTE(MAPPINGFIRMWARE)#,              <<*PHY*>>05436000
       <<TRUE IF NEW FIRMWARE PRESENT--USE WHEN >>             <<*MAP*>>05438000
       <<TESTING AFTER SYSGLOB INITIALIZED    >>               <<*MAP*>>05440000
       MAPFLAG=(1:1)#;  <<MAPPING FLAG IN STACK MARKER>>       <<*MAP*>>05442000
EQUATE MAXPHYCST=256,   <<MAX # PHYSICALLY MAPPED CST'S>>      <<*MAP*>>05444000
       SYSPHYCST=192;   <<# CST'S ALLOCATED TO PHYSICALLY>>    <<*MAP*>>05446000
                        <<MAPPED SEGMENTS                >>    <<*MAP*>>05448000
                                                               <<SD.00>>05450000
DEFINE PMBCFIRMWARE = ABS(%1220).(14:1)#;                      <<PMBC*>>05452000
                                                               <<SD.00>>05454000
                                                               <<SD.00>>05456000
                                                               <<SD.00>>05458000
                                                               <<SD.00>>05460000
                                                               <<SD.00>>05462000
                                                               <<SD.00>>05464000
                                                               <<SD.00>>05466000
                                                               <<03598>>05468000
DOUBLE  ARRAY DBDOUB(0:10):=11(0D);                            <<03598>>05470000
                                                               <<03598>>05472000
DEFINE  EOTSECTR       = DBDOUB( 0)#, << LBL 17&18    EOT >>   <<03598>>05474000
        EODSECTR       = DBDOUB( 1)#, << LBL 19&20    EOD >>   <<03598>>05476000
        SYSD'TZTBASE   = DBDOUB( 2)#, <<ADDRS OF TZT ON DISC>> <<03598>>05478000
        SD'SECTR       = DBDOUB( 3)#, <<SECT# OF NEXT BLOCK>>  <<03598>>05480000
                                      <<CURENTLY IN RECBUFF>>  <<03598>>05482000
        DISCINRECBUF   = DBDOUB( 9)#, <<SECT OF STRT OF BLK>>  <<03598>>05484000
        TZT'ADDR       = DBDOUB(10)#; <<Addrs of Next Entry>>  <<03598>>05486000
                                                               <<03598>>05488000
                                                               <<03598>>05490000
                                                               <<03551>>05492000
   << ===========================================>>            <<03551>>05494000
                                                               <<03551>>05496000
   << Definitions for disc free space management >>            <<03551>>05498000
                                                               <<03551>>05500000
   <<============================================>>            <<03551>>05502000
                                                               <<03551>>05504000
   << The following are constants declared on INCLDFS2, >>     <<03551>>05506000
   << but the include file can't be used because it     >>     <<03551>>05508000
   << would overflow the symbol table.                  >>     <<03551>>05510000
                                                               <<03551>>05512000
   EQUATE                                                      <<03551>>05514000
      sector'size = 128,   << Size of disc sector in words >>  <<03551>>05516000
      page'size = 1,       << Bit map page size in sectors >>  <<03551>>05518000
                                                               <<03551>>05520000
      << Words of data per bit map page (less checksum) >>     <<03551>>05522000
                                                               <<03551>>05524000
      words'per'page = (page'size * sector'size) - 1,          <<03551>>05526000
                                                               <<03551>>05528000
      << Words per bit map page, including checksum word >>    <<03551>>05530000
                                                               <<03551>>05532000
      actual'words'per'page = page'size * sector'size,         <<03551>>05534000
                                                               <<03551>>05536000
      bits'per'word = 16,   << HP/3000 word size >>            <<03551>>05538000
                                                               <<03551>>05540000
      << Number of bits of data per page >>                    <<03551>>05542000
                                                               <<03551>>05544000
      bits'per'page = bits'per'word * words'per'page,          <<03551>>05546000
                                                               <<03551>>05548000
      << Index of the checksum word in a page (last word) >>   <<03551>>05550000
                                                               <<03551>>05552000
      check'sum'word = words'per'page,                         <<03551>>05554000
                                                               <<03551>>05556000
      dt'entry'size = 3,  << Size of descriptor table entry >> <<03551>>05558000
                                                               <<03551>>05560000
      << Value placed in descriptor table entry to indicate >> <<03551>>05562000
      << that the page has been flaged as bad.              >> <<03551>>05564000
                                                               <<03551>>05566000
      bad'page = -1;                                           <<03551>>05568000
                                                               <<03551>>05570000
      DEFINE DBL = DOUBLE#;                                    <<03551>>05572000
                                                               <<03551>>05574000
   << The following equate should be set to the maximum >>     <<03551>>05576000
   << number of disc drives that can be configured on   >>     <<03551>>05578000
   << any system.                                       >>     <<03551>>05580000
                                                               <<03551>>05582000
   EQUATE max'disc'drives = 32;                                <<03551>>05584000
                                                               <<03551>>05586000
   << This array has ldevs of disc drives whose free    >>     <<03551>>05588000
   << space map has been accessed. Empty entries are    >>     <<03551>>05590000
   << marked with a -1.  The index that get you to the  >>     <<03551>>05592000
   << ldev will get you to info about that ldev in all  >>     <<03551>>05594000
   << the following arrays. This is the ldev-index.     >>     <<03551>>05596000
                                                               <<03551>>05598000
   INTEGER ARRAY ldev'index'to'ldev (0:max'disc'drives-1);     <<03551>>05600000
                                                               <<03551>>05602000
   << This array has the disc address of the bit map    >>     <<03551>>05604000
   << for each accessed disc.                           >>     <<03551>>05606000
                                                               <<03551>>05608000
   DOUBLE ARRAY bit'map'disc'address (0:max'disc'drives-1);    <<03551>>05610000
                                                               <<03551>>05612000
   << This array has the disc address of the descriptor >>     <<03551>>05614000
   << table for each accessed disc.                     >>     <<03551>>05616000
                                                               <<03551>>05618000
   DOUBLE ARRAY dt'disc'address (0:max'disc'drives-1);         <<03551>>05620000
                                                               <<03551>>05622000
   << This array has the size of the last block         >>     <<03551>>05624000
   << allocated for each accessed disc, or if not known >>     <<03551>>05626000
   << then it is set to the size of the disc.           >>     <<03551>>05628000
                                                               <<03551>>05630000
   DOUBLE ARRAY size'of'last'allocation (0:max'disc'drives-1); <<03551>>05632000
                                                               <<03551>>05634000
   << This array has the page num corresponding to the  >>     <<03551>>05636000
   << above allocated blocks.                           >>     <<03551>>05638000
                                                               <<03551>>05640000
   INTEGER ARRAY last'page'allocated'from(0:max'disc'drives-1);<<03551>>05642000
                                                               <<03551>>05644000
   << This array has the page num of the first page     >>     <<03551>>05646000
   << space, or a -1. if the page is not known. It is   >>     <<03551>>05648000
   << only used for reloads.                            >>     <<03551>>05650000
                                                               <<03551>>05652000
   INTEGER ARRAY first'page'with'space (0:max'disc'drives-1);  <<03551>>05654000
                                                               <<03551>>05656000
   << This array contains the page number of the last   >>     <<03551>>05658000
   << page of the map for each accessed disc ldev.      >>     <<03551>>05660000
                                                               <<03551>>05662000
   INTEGER ARRAY last'page'of'map (0:max'disc'drives-1);       <<03551>>05664000
                                                               <<03551>>05666000
   << This array contains the size of the disc in       >>     <<03551>>05668000
   << sectors for each accessed disc drive.             >>     <<03551>>05670000
                                                               <<03551>>05672000
   DOUBLE ARRAY disc'size (0:max'disc'drives-1);               <<03551>>05674000
                                                               <<03551>>05676000
   << This array indicates certain problem conditions   >>     <<03551>>05678000
   << involving the free space map. If the entry is in  >>     <<03551>>05680000
   << use it can have the following values: zero - all  >>     <<03551>>05682000
   << is normal, 1 - there are some bad pages in the    >>     <<03551>>05684000
   << map and the descriptor table will have to be      >>     <<03551>>05686000
   << checked each time a page is read. -1 - the map    >>     <<03551>>05688000
   << has been flaged as bad in the disc label and no   >>     <<03551>>05690000
   << space may be allocated on this disc.              >>     <<03551>>05692000
                                                               <<03551>>05694000
   INTEGER ARRAY dfs'map'problems (0:max'disc'drives-1);       <<03551>>05696000
                                                               <<03551>>05698000
                                                               <<03551>>05700000
   << This is the buffer for the descriptor table.  The >>     <<03551>>05702000
   << table is looked at in sector pages since INITIAL  >>     <<03551>>05704000
   << does a shitty job of handling memory.             >>     <<03551>>05706000
                                                               <<03551>>05708000
   INTEGER ARRAY dt'buffer (0:sector'size-1);                  <<03551>>05710000
                                                               <<03551>>05712000
   << This contains the ldev of the disc whose          >>     <<03551>>05714000
   << descriptor table page is in the above buffer, or  >>     <<03551>>05716000
   << a -1 if the buffer is empty.                             <<03551>>05718000
                                                               <<03551>>05720000
   INTEGER ldev'of'dt'page'in'buffer;                          <<03551>>05722000
                                                               <<03551>>05724000
   << This contains the disc address of the page of the >>     <<03551>>05726000
   << descriptor table in the above buffer.             >>     <<03551>>05728000
                                                               <<03551>>05730000
   DEFINE add'of'dt'page'in'buffer = DBDOUB (4)#;              <<03551>>05732000
                                                               <<03551>>05734000
                                                               <<03551>>05736000
   << This buffer is used to hold a page of a bit map.  >>     <<03551>>05738000
   << The symbol "ds'page'ptr" is defined for the use   >>     <<03551>>05740000
   << routines that are common with INITIAL and the     >>     <<03551>>05742000
   << system.                                           >>     <<03551>>05744000
                                                               <<03551>>05746000
   ARRAY bit'map'buffer (0:actual'words'per'page-1);           <<03551>>05748000
   ARRAY ds'page'ptr (*) = bit'map'buffer;                     <<03551>>05750000
                                                               <<03551>>05752000
   << This contains the ldev of the map page that is    >>     <<03551>>05754000
   << currently in the buffer, on -1 if empty.          >>     <<03551>>05756000
                                                               <<03551>>05758000
   INTEGER ldev'of'map'in'buffer;                              <<03551>>05760000
                                                               <<03551>>05762000
   << This contains the page number of the page that    >>     <<03551>>05764000
   << is currently in the buffer.                       >>     <<03551>>05766000
                                                               <<03551>>05768000
   DEFINE page'of'map'in'buffer = DBINT(24)#;                  <<03551>>05770000
                                                               <<03551>>05772000
   << This contains the disc address of the page of the >>     <<03551>>05774000
   << bit map that is currently in the buffer.          >>     <<03551>>05776000
                                                               <<03551>>05778000
   DEFINE add'of'map'page'in'buffer = DBDOUB (5)#;             <<03551>>05780000
                                                               <<03551>>05782000
   << The following are scratch variables used by the   >>     <<03551>>05784000
   << various disc space management routines.           >>     <<03551>>05786000
                                                               <<03551>>05788000
   DEFINE ds'disc'address = DBDOUB(6)#;                        <<03551>>05790000
   DEFINE ds'page'number = DBINT(25)#;                         <<03551>>05792000
   DEFINE ds'word'number = DBINT(26)#;                         <<03551>>05794000
   INTEGER ds'bit'number;                                      <<03551>>05796000
   INTEGER ds'bit'count;                                       <<03551>>05798000
   DEFINE ds'starting'word'number = DBINT(27)#;                <<03551>>05800000
   DEFINE ds'starting'bit'number = DBINT(28)#;                 <<03551>>05802000
                                                               <<03551>>05804000
   << This equate defines the amount of space, in       >>     <<03551>>05806000
   << sectors, that is reserved at the beginning of     >>     <<03551>>05808000
   << each system disc.                                 >>     <<03551>>05810000
                                                               <<03551>>05812000
   EQUATE ldev'1'reserved'area'size = 400;                     <<03551>>05814000
   EQUATE other'disc'reserved'area'size = 10;                  <<03551>>05816000
                                                               <<03551>>05818000
   << = = = = End of disc free space definitions = = = = >>    <<03551>>05820000
                                                               <<03551>>05822000
                                                               <<03549>>05824000
  << BOOTSPACEMAP IS A BIT MAP DEFINING FREE SPACE IN THE >>   <<03549>>05826000
  <<    RESERVED AREA                                     >>   <<03549>>05828000
                                                               <<03549>>05830000
  EQUATE BOOTSPACE'SECTOR = 4;  <<DISC ADDR. OF BOOTSPACEMAP>> <<03714>>05832000
                                                               <<03714>>05834000
  INTEGER ARRAY BOOTSPACEMAP(0:(LDEV'1'RESERVED'AREA'SIZE      <<03549>>05836000
                                              +15)/16 - 1);    <<03549>>05838000
                                                               <<03598>>05840000
ENTRY   TAPELOAD,          <<Entry Point for Load From Tape>>  <<03598>>05842000
        DISCBOOT;          <<Entry Point for Load From Tape>>  <<03598>>05844000
                                                               <<03598>>05846000
        <<*********************>>                              <<03598>>05848000
        <<FORWARD  DECLARATIONS>>                              <<03598>>05850000
        <<*********************>>                              <<03598>>05852000
                                                               <<03598>>05854000
LOGICAL PROCEDURE GET'RESERVED( DADDR , SIZE );                <<03598>>05856000
   VALUE SIZE;                                                 <<03598>>05858000
   DOUBLE DADDR;                                               <<03598>>05860000
   INTEGER SIZE;                                               <<03598>>05862000
   OPTION FORWARD;                                             <<03598>>05864000
                                                               <<03598>>05866000
PROCEDURE RELEASE'RESERVED( DADDR , SIZE );                    <<03598>>05868000
   VALUE DADDR,SIZE;                                           <<03598>>05870000
   DOUBLE DADDR;                                               <<03598>>05872000
   INTEGER SIZE;                                               <<03598>>05874000
   OPTION FORWARD;                                             <<03598>>05876000
                                                               <<03598>>05878000
                                                               <<03598>>05880000
PROCEDURE BOOTSTRAP;                                           <<03603>>05882000
   OPTION FORWARD;                                             <<03603>>05884000
PROCEDURE MAKEPRESENT;                                         <<03603>>05886000
   OPTION FORWARD;                                             <<03603>>05888000
LOGICAL PROCEDURE ON'ICS;                                      <<03603>>05890000
   OPTION FORWARD;                                             <<03603>>05892000
PROCEDURE CHECKMEM;                                            <<01384>>05894000
  OPTION FORWARD;                                              <<01384>>05896000
INTEGER PROCEDURE THISCPU;                                     <<03603>>05898000
   OPTION FORWARD;                                             <<03603>>05900000
                                                               <<01384>>05902000
  PROCEDURE FREAD(FILENUM,RECORD,BUF,WORDS);                            05904000
    VALUE FILENUM,RECORD,WORDS;                                         05906000
    INTEGER FILENUM,WORDS;                                              05908000
    DOUBLE RECORD;                                                      05910000
    ARRAY BUF;                                                          05912000
    OPTION FORWARD;                                                     05914000
  PROCEDURE FREAD'(FILENUM,RECORD,COREADR,WORDS);                       05916000
    VALUE FILENUM,RECORD,COREADR,WORDS;                                 05918000
    INTEGER FILENUM,WORDS;                                              05920000
    DOUBLE RECORD,COREADR;                                              05922000
    OPTION FORWARD;                                                     05924000
                                                               <<03715>>05926000
DOUBLE PROCEDURE GETDISCSPACE(LDEV,NSECT);                     <<03715>>05928000
VALUE LDEV,NSECT;                                              <<03715>>05930000
INTEGER LDEV;                                                  <<03715>>05932000
DOUBLE NSECT;                                                  <<03715>>05934000
OPTION FORWARD;                                                <<03715>>05936000
                                                               <<03715>>05938000
PROCEDURE RETDISCSPACE(LDEV,NSECT,DADDR);                      <<03715>>05940000
VALUE LDEV,NSECT,DADDR;                                        <<03715>>05942000
INTEGER LDEV;                                                  <<03715>>05944000
DOUBLE NSECT,DADDR;                                            <<03715>>05946000
OPTION FORWARD;                                                <<03715>>05948000
                                                               <<03715>>05950000
  LOGICAL PROCEDURE GETEXTLEN(I);                                       05952000
    VALUE I;                                                            05954000
    INTEGER I;                                                          05956000
    OPTION FORWARD;                                                     05958000
INTEGER PROCEDURE COLD'LOAD'MEDIA(FUNC,BUF,WORDC,RTN);         <<00678>>05960000
VALUE FUNC,WORDC,RTN;                                          <<00678>>05962000
INTEGER FUNC,WORDC;                                            <<00678>>05964000
LOGICAL RTN;                                                   <<00678>>05966000
ARRAY BUF;                                                     <<00678>>05968000
OPTION VARIABLE,FORWARD;                                       <<00678>>05970000
                                                               <<SD.00>>05972000
PROCEDURE SDISCCTRL(FUNC);                                     <<SD.00>>05974000
VALUE FUNC;                                                    <<SD.00>>05976000
INTEGER FUNC;                                                  <<SD.00>>05978000
OPTION FORWARD;                                                <<SD.00>>05980000
                                                               <<SD.00>>05982000
  PROCEDURE EXCHANGEDB(DSTN);                                           05984000
    VALUE DSTN;                                                         05986000
    INTEGER DSTN;                                                       05988000
    OPTION FORWARD;                                                     05990000
                                                                        05992000
  PROCEDURE HELP;                                                       05994000
    OPTION FORWARD;                                                     05996000
                                                                        05998000
PROCEDURE MESSAGE(MSGNR,NUM1,NUM2,NUM3,NUM4,STRING1,STRING2);  <<01103>>06000000
   VALUE MSGNR, NUM1, NUM2, NUM3, NUM4;                        <<01103>>06002000
   INTEGER MSGNR;                                              <<01103>>06004000
   LOGICAL NUM1, NUM2, NUM3, NUM4;                             <<01103>>06006000
   BYTE ARRAY STRING1, STRING2;                                <<01103>>06008000
   OPTION VARIABLE, FORWARD;                                   <<01103>>06010000
                                                               <<01103>>06012000
PROCEDURE ERRMESSAGE(MSGNR,NUM1,NUM2,NUM3,NUM4,STRING1,        <<01103>>06014000
   STRING2);                                                   <<01103>>06016000
   VALUE MSGNR, NUM1, NUM2, NUM3, NUM4;                        <<01103>>06018000
   INTEGER MSGNR;                                              <<01103>>06020000
   LOGICAL NUM1, NUM2, NUM3, NUM4;                             <<01103>>06022000
   BYTE ARRAY STRING1, STRING2;                                <<01103>>06024000
   OPTION VARIABLE, FORWARD;                                   <<01103>>06026000
                                                                        06028000
  PROCEDURE MOVEDLTABLES;                                               06030000
    OPTION FORWARD;                                                     06032000
LOGICAL PROCEDURE WRITECHAR(CHAR);                             <<03003>>06034000
    VALUE CHAR;                                                <<01101>>06036000
    INTEGER CHAR;                                              <<01101>>06038000
    OPTION FORWARD;                                            <<01101>>06040000
  INTEGER PROCEDURE ALTTRACK(LDEV,TRACK);                               06042000
    VALUE LDEV,TRACK;                                                   06044000
    INTEGER LDEV,TRACK;                                                 06046000
    OPTION FORWARD;                                                     06048000
INTEGER PROCEDURE READCHAR( WAITMS);                           <<03003>>06050000
  VALUE WAITMS;                                                <<03003>>06052000
  LOGICAL WAITMS;                                              <<03003>>06054000
  OPTION FORWARD, VARIABLE;                                    <<03003>>06056000
PROCEDURE PRINT( BUF, LENGTH, CONTROL);                        <<00888>>06058000
   VALUE LENGTH, CONTROL;                                      <<00888>>06060000
   ARRAY BUF;                                                  <<00888>>06062000
   INTEGER LENGTH, CONTROL;                                    <<00888>>06064000
   OPTION FORWARD;                                             <<00888>>06066000
PROCEDURE READINPUT( BUFFER);                                  <<00888>>06068000
   INTEGER ARRAY BUFFER;                                       <<00888>>06070000
   OPTION FORWARD, VARIABLE;                                   <<00888>>06072000
                                                               <<MPEIV>>06074000
  LOGICAL PROCEDURE GOOD'DSCT(DSCT);                           <<03668>>06076000
  INTEGER ARRAY DSCT;                                          <<03668>>06078000
  OPTION FORWARD;                                              <<03668>>06080000
                                                               <<03668>>06082000
  LOGICAL PROCEDURE ADD'BADFILE(FNAME);                        <<03668>>06084000
  ARRAY FNAME;                                                 <<03668>>06086000
  OPTION FORWARD;                                              <<03668>>06088000
                                                               <<03668>>06090000
  PROCEDURE REMOVE'BADFILE(FNAME);                             <<03668>>06092000
  ARRAY FNAME;                                                 <<03668>>06094000
  OPTION FORWARD;                                              <<03668>>06096000
                                                               <<03668>>06098000
  PROCEDURE RETURNDELETES( LDEV);                              <<03549>>06100000
  VALUE LDEV;                                                  <<03549>>06102000
  LOGICAL LDEV;                                                <<03549>>06104000
  OPTION FORWARD;                                              <<03549>>06106000
                                                               <<MPEIV>>06108000
  PROCEDURE REM'RET'REASS(RETRN,LDEV,DTT);                     <<03549>>06110000
  VALUE RETRN,LDEV;                                            <<03549>>06112000
  LOGICAL RETRN;                                               <<03549>>06114000
  INTEGER LDEV;                                                <<03549>>06116000
  INTEGER ARRAY DTT;                                           <<03549>>06118000
  OPTION FORWARD;                                              <<03549>>06120000
                                                               <<03549>>06122000
  LOGICAL PROCEDURE GET'AREA(AREA'LIST,ENTRY',MAX'ENTRIES,     <<03549>>06124000
                           LDEV,DISC'ADDR,LENGTH);             <<03549>>06126000
  VALUE ENTRY',MAX'ENTRIES;                                    <<03549>>06128000
  INTEGER ARRAY AREA'LIST;                                     <<03549>>06130000
  INTEGER ENTRY',MAX'ENTRIES,LDEV;                             <<03549>>06132000
  DOUBLE DISC'ADDR,LENGTH;                                     <<03549>>06134000
  OPTION FORWARD;                                              <<03549>>06136000
                                                               <<03549>>06138000
  PROCEDURE ZEROBUF(BUF,LEN);                                  <<03549>>06140000
  VALUE LEN;                                                   <<03549>>06142000
  ARRAY BUF;                                                   <<03549>>06144000
  INTEGER LEN;                                                 <<03549>>06146000
  OPTION FORWARD;                                              <<03549>>06148000
                                                               <<03549>>06150000
  LOGICAL PROCEDURE SDISC'TYPE( TYPE, SUBTYP);                 <<03550>>06152000
  VALUE TYPE, SUBTYP;                                          <<03550>>06154000
  INTEGER TYPE, SUBTYP;                                        <<03550>>06156000
  OPTION FORWARD;                                              <<03550>>06158000
                                                               <<03550>>06160000
  LOGICAL PROCEDURE SYSDISC'TYPE(TYPE,SUBTYP);                 <<03550>>06162000
  VALUE TYPE,SUBTYP;                                           <<03550>>06164000
  INTEGER TYPE,SUBTYP;                                         <<03550>>06166000
  OPTION FORWARD;                                              <<03550>>06168000
                                                               <<32BND>>06170000
LOGICAL PROCEDURE TESTBIT(BIT'MAP,BIT'NUM);                    <<32BND>>06172000
  VALUE BIT'NUM;                                               <<32BND>>06174000
  INTEGER ARRAY BIT'MAP;      << BIT MAP >>                    <<32BND>>06176000
  INTEGER       BIT'NUM;      << BIT NUMBER >>                 <<32BND>>06178000
  OPTION FORWARD;                                              <<32BND>>06180000
                                                               <<03550>>06182000
                                                               <<03022>>06184000
  PROCEDURE SIOP( DEVNR, CHANADR);                             <<03022>>06186000
  VALUE DEVNR, CHANADR;                                        <<03022>>06188000
  INTEGER DEVNR, CHANADR;                                      <<03022>>06190000
  OPTION FORWARD;                                              <<03022>>06192000
                                                               <<03022>>06194000
  PROCEDURE WIOC( DRT, COMMAND, DATAWORD);                     <<03022>>06196000
  VALUE DRT, COMMAND, DATAWORD;                                <<03022>>06198000
  INTEGER DRT, COMMAND, DATAWORD;                              <<03022>>06200000
  OPTION FORWARD;                                              <<03022>>06202000
                                                               <<03022>>06204000
  INTEGER PROCEDURE RIOC( DRT, PARM);                          <<03022>>06206000
  VALUE DRT, PARM;                                             <<03022>>06208000
  INTEGER DRT, PARM;                                           <<03022>>06210000
  OPTION FORWARD;                                              <<03022>>06212000
                                                               <<03022>>06214000
  PROCEDURE INIT( CHANNR);                                     <<03022>>06216000
  VALUE CHANNR;                                                <<03022>>06218000
  INTEGER CHANNR;                                              <<03022>>06220000
  OPTION FORWARD;                                              <<03022>>06222000
                                                               <<04546>>06224000
PROCEDURE UNLOCK'CS80;                                         <<04546>>06226000
  OPTION FORWARD;                                              <<04546>>06228000
                                                               <<04546>>06230000
PROCEDURE DISC'( FUNC, LDEV, RECORD, BUF, CNT);                <<N8581>>06232000
   VALUE FUNC, LDEV, RECORD, BUF, CNT;                         <<N8581>>06234000
   INTEGER FUNC, LDEV, CNT;                                    <<N8581>>06236000
   DOUBLE RECORD, BUF;                                         <<N8581>>06238000
   OPTION FORWARD;                                             <<N8581>>06240000
                                                               <<N8581>>06242000
PROCEDURE DISC( FUNC, LDEV, RECORD, BUF, CNT);                 <<N8581>>06244000
   VALUE FUNC, LDEV, RECORD, CNT;                              <<N8581>>06246000
   INTEGER FUNC, LDEV, CNT;                                    <<N8581>>06248000
   DOUBLE RECORD;                                              <<N8581>>06250000
   ARRAY BUF;                                                  <<N8581>>06252000
   OPTION FORWARD;                                             <<N8581>>06254000
                                                               <<N8581>>06256000
$PAGE "EXTERNAL PROCEDURE DECLARATIONS"                        <<SY>>   06258000
        <<***********************>>                            <<SY>>   06260000
        << EXTERNAL DECLARATIONS >>                            <<SY>>   06262000
        <<***********************>>                            <<SY>>   06264000
                                                               <<SY>>   06266000
                                                               <<SY>>   06268000
                                                               <<SY>>   06270000
PROCEDURE DIRSET (WHICH);                                      <<SY>>   06272000
   VALUE   WHICH;                                              <<SY>>   06274000
   INTEGER WHICH;                                              <<SY>>   06276000
   OPTION  EXTERNAL;                                           <<SY>>   06278000
                                                               <<SY>>   06280000
PROCEDURE DIRXXXLOCATE (PNTRIN, PPSIZE, SETTO);                <<SY>>   06282000
   VALUE   PNTRIN, PPSIZE, SETTO;                              <<SY>>   06284000
   LOGICAL PNTRIN, SETTO;                                      <<SY>>   06286000
   INTEGER PPSIZE;                                             <<SY>>   06288000
   OPTION  EXTERNAL;                                           <<SY>>   06290000
                                                               <<SY>>   06292000
LOGICAL PROCEDURE DIRALLOCATE (PPSIZE);                        <<SY>>   06294000
   VALUE   PPSIZE;                                             <<SY>>   06296000
   INTEGER PPSIZE;                                             <<SY>>   06298000
   OPTION  EXTERNAL;                                           <<SY>>   06300000
                                                               <<SY>>   06302000
PROCEDURE DIRDEALLOCATE (PNTR, PPSIZE);                        <<SY>>   06304000
   VALUE   PNTR, PPSIZE;                                       <<SY>>   06306000
   LOGICAL PNTR;                                               <<SY>>   06308000
   INTEGER PPSIZE;                                             <<SY>>   06310000
   OPTION  EXTERNAL;                                           <<SY>>   06312000
                                                               <<SY>>   06314000
PROCEDURE DIRWRITE (WHICH);                                    <<SY>>   06316000
   VALUE   WHICH;                                              <<SY>>   06318000
   LOGICAL WHICH;                                              <<SY>>   06320000
   OPTION  EXTERNAL;                                           <<SY>>   06322000
                                                               <<SY>>   06324000
LOGICAL PROCEDURE DIRNEWINDEX (IBSIZE,ILEVEL,EBSIZE,ESIZE);    <<SY>>   06326000
   VALUE   IBSIZE, ILEVEL, EBSIZE, ESIZE;                      <<SY>>   06328000
   INTEGER IBSIZE, ILEVEL, EBSIZE, ESIZE;                      <<SY>>   06330000
   OPTION  EXTERNAL;                                           <<SY>>   06332000
                                                               <<SY>>   06334000
DOUBLE PROCEDURE DIRECNULL (NUMSECT);                          <<SY>>   06336000
   VALUE   NUMSECT;                                            <<SY>>   06338000
   INTEGER NUMSECT;                                            <<SY>>   06340000
   OPTION  EXTERNAL;                                           <<SY>>   06342000
                                                               <<SY>>   06344000
INTEGER PROCEDURE DIRSCAN (ENTRYNAME, TYPE'WHICH);             <<SY>>   06346000
   VALUE   TYPE'WHICH;                                         <<SY>>   06348000
   ARRAY   ENTRYNAME;                                          <<SY>>   06350000
   LOGICAL TYPE'WHICH;                                         <<SY>>   06352000
   OPTION  EXTERNAL;                                           <<SY>>   06354000
                                                               <<SY>>   06356000
DOUBLE PROCEDURE DIRINSERT (INDEXPOINTER);                     <<SY>>   06358000
   VALUE   INDEXPOINTER;                                       <<SY>>   06360000
   LOGICAL INDEXPOINTER;                                       <<SY>>   06362000
   OPTION  EXTERNAL;                                           <<SY>>   06364000
                                                               <<SY>>   06366000
DOUBLE PROCEDURE DIRFIND (INDEXPOINTER);                       <<SY>>   06368000
   VALUE   INDEXPOINTER;                                       <<SY>>   06370000
   LOGICAL INDEXPOINTER;                                       <<SY>>   06372000
   OPTION  EXTERNAL;                                           <<SY>>   06374000
                                                               <<SY>>   06376000
PROCEDURE DIRREMOVE (ELEMENT, WHICH);                          <<SY>>   06378000
   VALUE   WHICH;                                              <<SY>>   06380000
   LOGICAL WHICH;                                              <<SY>>   06382000
   ARRAY   ELEMENT;                                            <<SY>>   06384000
   OPTION  EXTERNAL;                                           <<SY>>   06386000
                                                               <<SY>>   06388000
PROCEDURE DIRRESET (NUMSECTS);                                 <<SY>>   06390000
   VALUE   NUMSECTS;                                           <<SY>>   06392000
   DOUBLE  NUMSECTS;                                           <<SY>>   06394000
   OPTION  EXTERNAL;                                           <<SY>>   06396000
                                                               <<SY>>   06398000
DOUBLE PROCEDURE DIRSTARTOFF (PARR,NUMSECTS,RECIP, PARMS);     <<SY>>   06400000
   VALUE   NUMSECTS, PARMS;                                    <<SY>>   06402000
   ARRAY   PARR;                                               <<SY>>   06404000
   DOUBLE  NUMSECTS;                                           <<SY>>   06406000
   INTEGER PROCEDURE RECIP;                                    <<SY>>   06408000
   INTEGER PARMS;                                              <<SY>>   06410000
   OPTION  VARIABLE, EXTERNAL;                                 <<SY>>   06412000
                                                               <<SY>>   06414000
DOUBLE PROCEDURE DIRECINSERT (TYPE, INDEXP, ANAME, GUNAME,     <<SY>>   06416000
                              FNAME, INSERT);                  <<SY>>   06418000
   VALUE   TYPE, INDEXP;                                       <<SY>>   06420000
   LOGICAL TYPE, INDEXP;                                       <<SY>>   06422000
   ARRAY   ANAME, GUNAME, FNAME, INSERT;                       <<SY>>   06424000
   OPTION  EXTERNAL;                                           <<SY>>   06426000
                                                               <<SY>>   06428000
DOUBLE PROCEDURE DIRECINSERTFILE (NUMSECTS, ANAME, GNAME,      <<SY>>   06430000
                             FNAME, FADDR);                    <<SY>>   06432000
   VALUE   NUMSECTS, FADDR;                                    <<SY>>   06434000
   DOUBLE  NUMSECTS, FADDR;                                    <<SY>>   06436000
   ARRAY   ANAME, GNAME, FNAME;                                <<SY>>   06438000
   OPTION  EXTERNAL;                                           <<SY>>   06440000
                                                               <<SY>>   06442000
DOUBLE PROCEDURE DIRECFIND (TYPE, INDEXP, ANAME, GUNAME,       <<SY>>   06444000
                            FNAME, PRETURN);                   <<SY>>   06446000
   VALUE   TYPE, INDEXP;                                       <<SY>>   06448000
   INTEGER TYPE, INDEXP;                                       <<SY>>   06450000
   ARRAY   ANAME, GUNAME, FNAME, PRETURN;                      <<SY>>   06452000
   OPTION  EXTERNAL;                                           <<SY>>   06454000
                                                               <<SY>>   06456000
DOUBLE PROCEDURE DIRECFINDFILE (TYPE, INDEXP, ANAME,           <<SY>>   06458000
                            GNAME, FNAME, PRETURN);            <<SY>>   06460000
   VALUE   TYPE, INDEXP;                                       <<SY>>   06462000
   LOGICAL TYPE, INDEXP;                                       <<SY>>   06464000
   ARRAY   ANAME, GNAME, FNAME, PRETURN;                       <<SY>>   06466000
   OPTION  EXTERNAL;                                           <<SY>>   06468000
                                                               <<SY>>   06470000
DOUBLE PROCEDURE DIRECPURGE (TYPE, INDEXP, ANAME, GUNAME,      <<SY>>   06472000
                             FNAME);                           <<SY>>   06474000
   VALUE   TYPE, INDEXP;                                       <<SY>>   06476000
   INTEGER TYPE, INDEXP;                                       <<SY>>   06478000
   ARRAY   ANAME, GUNAME, FNAME;                               <<SY>>   06480000
   OPTION  EXTERNAL;                                           <<SY>>   06482000
                                                               <<SY>>   06484000
DOUBLE PROCEDURE DIRECPURGEFILE (TYPE, INDEXP, ANAME, GNAME,   <<SY>>   06486000
                             FNAME);                           <<SY>>   06488000
   VALUE   TYPE, INDEXP;                                       <<SY>>   06490000
   INTEGER TYPE, INDEXP;                                       <<SY>>   06492000
   ARRAY   ANAME, GNAME, FNAME;                                <<SY>>   06494000
   OPTION  EXTERNAL;                                           <<SY>>   06496000
                                                               <<SY>>   06498000
DOUBLE PROCEDURE DIRECADJUST (NUMSECTS, ANAME, GNAME);         <<SY>>   06500000
   VALUE   NUMSECTS;                                           <<SY>>   06502000
   DOUBLE  NUMSECTS;                                           <<SY>>   06504000
   ARRAY   ANAME, GNAME;                                       <<SY>>   06506000
   OPTION  EXTERNAL;                                           <<SY>>   06508000
                                                               <<SY>>   06510000
LOGICAL PROCEDURE DIRDOENTRY (ELEMENT, LEAFLEVEL, RECIP,       <<SY>>   06512000
                              PARMS, GETSIRRESULT);            <<SY>>   06514000
   VALUE   LEAFLEVEL, PARMS, GETSIRRESULT;                     <<SY>>   06516000
   ARRAY   ELEMENT;                                            <<SY>>   06518000
   INTEGER LEAFLEVEL, PARMS, GETSIRRESULT;                     <<SY>>   06520000
   INTEGER PROCEDURE  RECIP;                                   <<SY>>   06522000
   OPTION  EXTERNAL;                                           <<SY>>   06524000
                                                               <<SY>>   06526000
PROCEDURE DIRSCANTREE (INDEX, LEAFLEVEL, RECIP, PARMS,         <<SY>>   06528000
                       GETSIRRESULT);                          <<SY>>   06530000
   VALUE   INDEX, LEAFLEVEL, PARMS, GETSIRRESULT;              <<SY>>   06532000
   INTEGER INDEX, LEAFLEVEL, PARMS, GETSIRRESULT;              <<SY>>   06534000
   INTEGER PROCEDURE RECIP;                                    <<SY>>   06536000
   OPTION  EXTERNAL;                                           <<SY>>   06538000
                                                               <<SY>>   06540000
DOUBLE PROCEDURE DIRECSCAN (TYPE, INDEXP, ANAME, GUNAME,       <<SY>>   06542000
                            FNAME, RECIP, PARMS);              <<SY>>   06544000
   VALUE   TYPE, INDEXP;                                       <<SY>>   06546000
   INTEGER TYPE, INDEXP;                                       <<SY>>   06548000
   INTEGER PROCEDURE RECIP;                                    <<SY>>   06550000
   ARRAY   ANAME, GUNAME, FNAME, PARMS;                        <<SY>>   06552000
   OPTION  EXTERNAL;                                           <<SY>>   06554000
                                                               <<SY>>   06556000
INTEGER PROCEDURE DIRECTORYCLEAN (ELEMENT, LEVEL, PARMS,       <<SY>>   06558000
                                  GARBAGE);                    <<SY>>   06560000
   VALUE   LEVEL, PARMS, GARBAGE;                              <<SY>>   06562000
   ARRAY   ELEMENT;                                            <<SY>>   06564000
   INTEGER LEVEL, PARMS;                                       <<SY>>   06566000
   DOUBLE  GARBAGE;                                            <<SY>>   06568000
   OPTION  EXTERNAL;                                           <<SY>>   06570000
                                                               <<SY>>   06572000
INTEGER PROCEDURE USERCLEAN (ELEMENT, LEVEL, PARMS, GARBAGE);  <<SY>>   06574000
   VALUE   LEVEL, PARMS, GARBAGE;                              <<SY>>   06576000
   ARRAY   ELEMENT;                                            <<SY>>   06578000
   INTEGER LEVEL, PARMS;                                       <<SY>>   06580000
   DOUBLE  GARBAGE;                                            <<SY>>   06582000
   OPTION  EXTERNAL;                                           <<SY>>   06584000
                                                               <<SY>>   06586000
INTEGER PROCEDURE SET'1'MGR (ELEMENT, LEVEL, PARMS, GARBAGE);  <<SY>>   06588000
   VALUE   LEVEL, PARMS, GARBAGE;                              <<SY>>   06590000
   ARRAY   ELEMENT;                                            <<SY>>   06592000
   INTEGER LEVEL, PARMS;                                       <<SY>>   06594000
   DOUBLE  GARBAGE;                                            <<SY>>   06596000
   OPTION  EXTERNAL;                                           <<SY>>   06598000
                                                               <<SY>>   06600000
INTEGER PROCEDURE VSDCLEAN (ELEMENT, LEVEL, PARMS, GARBAGE);   <<SY>>   06602000
   VALUE   LEVEL, PARMS, GARBAGE;                              <<SY>>   06604000
   ARRAY   ELEMENT;                                            <<SY>>   06606000
   INTEGER LEVEL, PARMS;                                       <<SY>>   06608000
   DOUBLE  GARBAGE;                                            <<SY>>   06610000
   OPTION  EXTERNAL;                                           <<SY>>   06612000
                                                               <<SY>>   06614000
INTEGER PROCEDURE FILEPURGE (ELEMENT, LEVEL, PARMS, GARBAGE);  <<SY>>   06616000
   VALUE   LEVEL, PARMS, GARBAGE;                              <<SY>>   06618000
   ARRAY   ELEMENT;                                            <<SY>>   06620000
   INTEGER LEVEL, PARMS;                                       <<SY>>   06622000
   DOUBLE  GARBAGE;                                            <<SY>>   06624000
   OPTION  EXTERNAL;                                           <<SY>>   06626000
                                                               <<I8392>>06628000
PROCEDURE IOMAP;                                               <<I8392>>06630000
   OPTION EXTERNAL;                                            <<I8392>>06632000
$PAGE "DUMMY CODE SEGMENTATION PROCEDURES"                     <<SY>>   06634000
COMMENT                                                                 06636000
  THESE PROCEDURES PERFORM TWO FUNCTIONS. THE FIRST IS TO ORDER         06638000
INITIAL'S SEGMENTS SO THAT WHEN IT IS PREPARED, THE BOOTSTRAP           06640000
SEGMENT WILL HAVE THE HIGHEST LOGICAL CST NUMBER, FOLLOWED IN DESCENDING06642000
ORDER BY OTHER CORE RESIDENT SEGMENTS, THE SEGMENT FROM WHICH           06644000
CODE SWAPPING IS STARTED (MAINSEG1), NON-RESIDENT SEGMENTS              06646000
WHICH MUST BE IN CORE WHEN EXECUTION STARTS (I.E. THOSE                 06648000
NEEDED BEFORE WE START SWAPPING), AND FINALLY THOSE SEGMENTS            06650000
NOT NEEDED UNTIL AFTER CODE SWAPPING HAS BEGUN. THE                     06652000
SECOND FUNCTION IS TO PROVIDE A PCAL TO HELP SO THAT ITS                06654000
LABEL WILL BE IN THE STT OF EACH SEGMENT;                               06656000
                                                                        06658000
$CONTROL SEGMENT=MAINSEG4                                      <<03603>>06660000
   PROCEDURE MAINSEG4HELP; HELP;                               <<03603>>06662000
                                                               <<03603>>06664000
$CONTROL SEGMENT=MAINSEG3                                      <<03603>>06666000
   PROCEDURE MAINSEG3HELP; HELP;                               <<03603>>06668000
                                                               <<03603>>06670000
$CONTROL SEGMENT=MAINSEG2                                      <<03603>>06672000
   PROCEDURE MAINSEG2HELP; HELP;                               <<03603>>06674000
                                                               <<03603>>06676000
$CONTROL SEGMENT=MAINSEG1B                                     <<03603>>06678000
   PROCEDURE MAINSEG1BHELP; HELP;                              <<03603>>06680000
                                                               <<03603>>06682000
$CONTROL SEGMENT=PROCESS                                       <<03603>>06684000
   PROCEDURE PROCESSHELP; HELP;                                <<03603>>06686000
                                                               <<03603>>06688000
$CONTROL SEGMENT=SL'PROGRAM                                    <<03603>>06690000
   PROCEDURE SL'PROGRAMHELP; HELP;                             <<03603>>06692000
                                                               <<03603>>06694000
$CONTROL SEGMENT=DIRECTORY2                                    <<03603>>06696000
   PROCEDURE DIRECTORY2HELP; HELP;                             <<03603>>06698000
                                                               <<03603>>06700000
$CONTROL SEGMENT=DIRECTORY1                                    <<03603>>06702000
   PROCEDURE DIRECTORY1HELP; HELP;                             <<03603>>06704000
                                                               <<03603>>06706000
$CONTROL SEGMENT=DISCSPACE                                     <<03603>>06708000
   PROCEDURE DISCSPACEHELP; HELP;                              <<03603>>06710000
                                                               <<03603>>06712000
$CONTROL SEGMENT=FILEIO                                        <<03603>>06714000
   PROCEDURE FILEIOHELP; HELP;                                 <<03603>>06716000
                                                               <<03603>>06718000
$CONTROL SEGMENT=TAPEIO                                        <<03603>>06720000
   PROCEDURE TAPEIOHELP; HELP;                                 <<03603>>06722000
                                                               <<03603>>06724000
$CONTROL SEGMENT=SETUP                                         <<03603>>06726000
   PROCEDURE SETUPHELP; HELP;                                  <<03603>>06728000
                                                               <<03603>>06730000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03603>>06732000
   PROCEDURE DEFECTRACKSHELP; HELP;                            <<03603>>06734000
                                                               <<03603>>06736000
$CONTROL SEGMENT=CONFIGURE                                     <<03603>>06738000
   PROCEDURE CONFIGUREHELP; HELP;                              <<03603>>06740000
                                                               <<03603>>06742000
$CONTROL SEGMENT=MAINSEG1A                                     <<03603>>06744000
   PROCEDURE MAINSEG1AHELP; HELP;                              <<03603>>06746000
                                                               <<03603>>06748000
$CONTROL SEGMENT=MAINSEG1                                      <<03603>>06750000
   PROCEDURE MAINSEG1HELP; HELP;                               <<03603>>06752000
                                                               <<03603>>06754000
$CONTROL SEGMENT=RESIDENT                                      <<03603>>06756000
   PROCEDURE RESIDENTHELP; HELP;                               <<03603>>06758000
                                                               <<03603>>06760000
$CONTROL SEGMENT=BOOTSTRAP                                     <<03603>>06762000
   PROCEDURE BOOTSTRAPHELP; HELP;                              <<03603>>06764000
                                                               <<03603>>06766000
$CONTROL SEGMENT=ININ                                          <<03603>>06768000
   PROCEDURE ININHELP; HELP;                                   <<03603>>06770000
$PAGE "INTERNAL INTERRUPT HANDLER"                             <<03603>>06772000
$CONTROL SEGMENT=ININ                                          <<03603>>06774000
<<       The order of the following procedures        >>       <<03603>>06776000
<<       must not be changed.  Neither may any        >>       <<03603>>06778000
<<       procedure be added or deleted.  We are       >>       <<03603>>06780000
<<       depending on the order, to construct         >>       <<03603>>06782000
<<       the STT in such a way that the entry         >>       <<03603>>06784000
<<       points will be correct for the hardware.     >>       <<03603>>06786000
PROCEDURE CL'DISC;                                             <<03603>>06788000
   OPTION INTERRUPT;                                           <<03603>>06790000
BEGIN                                                          <<03603>>06792000
   <<  This procedure will be executed for disc boots >>       <<03603>>06794000
   <<  only.  INITIAL will change STT %44 to point to >>       <<03603>>06796000
   <<  this procedure before segment ININ to writtern >>       <<03603>>06798000
   <<  to disc.                                       >>       <<03603>>06800000
                                                               <<*MAP*>>06802000
   LOGICAL                                                     <<*MAP*>>06804000
      FMAPFLAG   = Q-9;                                        <<*MAP*>>06806000
                                                               <<*MAP*>>06808000
   <<  The mapping firmware will store a 1 at QI-9  >>         <<*MAP*>>06810000
   <<  on coldload as an indication that is exists. >>         <<*MAP*>>06812000
                                                               <<*MAP*>>06814000
   LOGICALMAPPING := FMAPFLAG;                                 <<*MAP*>>06816000
   ABS(%1230) := 0; <<BANK FOR MABS LOGGING >>                 <<M7654>>06818000
   ABS(%1231) := 0; <<ADR  FOR MABS LOGGING >>                 <<M7654>>06820000
                                                               <<03603>>06822000
   PUSH( Q ); SET( DL ); << BECAUSE OF A 33 MICROCODE BUG >>   <<03603>>06824000
   BOOTSTRAP;                                                  <<03603>>06826000
END;                                                           <<03603>>06828000
PROCEDURE COLD'LOAD;                                           <<03603>>06830000
   OPTION INTERRUPT;                                           <<03603>>06832000
BEGIN                                                          <<03603>>06834000
   LOGICAL                                                     <<03603>>06836000
      QI'DB     = Q-4,                                         <<*MAP*>>06838000
      QI'SBANK  = Q-5,                                         <<*MAP*>>06840000
      QI'S      = Q-6,                                         <<*MAP*>>06842000
      QI'DL     = Q-7,                                         <<*MAP*>>06844000
      QI'Z      = Q-8,                                         <<*MAP*>>06846000
      FMAPFLAG  = Q-9,                                         <<*MAP*>>06848000
      SAVED'S   = Q-10;                                        <<03603>>06850000
   <<  The cold load trap destroys QI-6 so SYSDUMP  >>         <<03603>>06852000
   <<  stores what QI-6 should be in QI-10.         >>         <<03603>>06854000
   <<  This is the entry point for tape boots.      >>         <<03603>>06856000
                                                               <<03603>>06858000
   QI'S := SAVED'S;                                            <<*MAP*>>06860000
                                                               <<*MAP*>>06862000
   <<  The mapping firmware will store a 1 at QI-9  >>         <<*MAP*>>06864000
   <<  on coldload as an indication that it exists. >>         <<*MAP*>>06866000
                                                               <<*MAP*>>06868000
   TOS := QI'SBANK;                                            <<*MAP*>>06870000
   TOS := QI'DB + QI'S - 4; << LOCATION OF DELTA P >>          <<*MAP*>>06872000
   ASSEMBLE( LSEA );     << LOAD DELTA P >>                    <<*MAP*>>06874000
   TOS.MAPFLAG := FMAPFLAG;<< PHY MAPPED, IF FIRMWARE EXISTS >><<*MAP*>>06876000
   ASSEMBLE( SSEA );     << REPLACE DELTA P >>                 <<*MAP*>>06878000
   LOGICALMAPPING := FMAPFLAG;                                 <<*MAP*>>06880000
   ABS(%1230) := 0; <<BANK FOR MABS LOGGING >>                 <<M7654>>06882000
   ABS(%1231) := 0; <<ADR  FOR MABS LOGGING >>                 <<M7654>>06884000
END;                                                           <<03603>>06886000
PROCEDURE PWR'ON;                                              <<03603>>06888000
   OPTION  INTERRUPT;                                          <<03603>>06890000
BEGIN                                                          <<03603>>06892000
   TOS := %43;                                                 <<03603>>06894000
   ININ'HALT;                                                  <<03603>>06896000
END;                                                           <<03603>>06898000
PROCEDURE DATA'ABSENT;                                         <<03603>>06900000
BEGIN                                                          <<03603>>06902000
   TOS := %42;                                                 <<03603>>06904000
   ININ'HALT;                                                  <<03603>>06906000
END;                                                           <<03603>>06908000
PROCEDURE STT'UNCALLABLE;                                      <<03603>>06910000
BEGIN                                                          <<03603>>06912000
   TOS := %41;                                                 <<03603>>06914000
   ININ'HALT;                                                  <<03603>>06916000
END;                                                           <<03603>>06918000
PROCEDURE TRACE;                                               <<03603>>06920000
BEGIN                                                          <<03603>>06922000
   TOS := %40;                                                 <<03603>>06924000
   ININ'HALT;                                                  <<03603>>06926000
END;                                                           <<03603>>06928000
PROCEDURE CODE'ABSENT;                                         <<03603>>06930000
BEGIN                                                          <<03603>>06932000
   MAKEPRESENT;                                                <<03603>>06934000
END;                                                           <<03603>>06936000
PROCEDURE TRAP36;                                              <<03603>>06938000
BEGIN                                                          <<03603>>06940000
   TOS := %36;                                                 <<03603>>06942000
   ININ'HALT;                                                  <<03603>>06944000
END;                                                           <<03603>>06946000
PROCEDURE TRAP35;                                              <<03603>>06948000
BEGIN                                                          <<03603>>06950000
   TOS := %35;                                                 <<03603>>06952000
   ININ'HALT;                                                  <<03603>>06954000
END;                                                           <<03603>>06956000
PROCEDURE TRAP34;                                              <<03603>>06958000
BEGIN                                                          <<03603>>06960000
   TOS := %34;                                                 <<03603>>06962000
   ININ'HALT;                                                  <<03603>>06964000
END;                                                           <<03603>>06966000
PROCEDURE TRAP33;                                              <<03603>>06968000
BEGIN                                                          <<03603>>06970000
   TOS := %33;                                                 <<03603>>06972000
   ININ'HALT;                                                  <<03603>>06974000
END;                                                           <<03603>>06976000
PROCEDURE TRAP32;                                              <<03603>>06978000
BEGIN                                                          <<03603>>06980000
   TOS := %32;                                                 <<03603>>06982000
   ININ'HALT;                                                  <<03603>>06984000
END;                                                           <<03603>>06986000
PROCEDURE USER'TRAPS;                                          <<03603>>06988000
BEGIN                                                          <<03603>>06990000
   TOS := %31;                                                 <<03603>>06992000
   ININ'HALT;                                                  <<03603>>06994000
END;                                                           <<03603>>06996000
PROCEDURE STK'OVERF;                                           <<03603>>06998000
   OPTION INTERRUPT;                                           <<03603>>07000000
BEGIN                                                          <<03603>>07002000
   TOS := %30;                                                 <<03603>>07004000
   ININ'HALT;                                                  <<03603>>07006000
END;                                                           <<03603>>07008000
PROCEDURE TRAP27;                                              <<03603>>07010000
BEGIN                                                          <<03603>>07012000
   TOS := %27;                                                 <<03603>>07014000
   ININ'HALT;                                                  <<03603>>07016000
END;                                                           <<03603>>07018000
PROCEDURE TRAP26;                                              <<03603>>07020000
BEGIN                                                          <<03603>>07022000
   TOS := %26;                                                 <<03603>>07024000
   ININ'HALT;                                                  <<03603>>07026000
END;                                                           <<03603>>07028000
PROCEDURE PRIV'VOIL;                                           <<03603>>07030000
BEGIN                                                          <<03603>>07032000
   TOS := %25;                                                 <<03603>>07034000
   ININ'HALT;                                                  <<03603>>07036000
END;                                                           <<03603>>07038000
PROCEDURE STK'UNDERF;                                          <<03603>>07040000
BEGIN                                                          <<03603>>07042000
   TOS := %24;                                                 <<03603>>07044000
   ININ'HALT;                                                  <<03603>>07046000
END;                                                           <<03603>>07048000
PROCEDURE DST'VIOL;                                            <<03603>>07050000
BEGIN                                                          <<03603>>07052000
   TOS := %23;                                                 <<03603>>07054000
   ININ'HALT;                                                  <<03603>>07056000
END;                                                           <<03603>>07058000
PROCEDURE CST'VIOL;                                            <<03603>>07060000
BEGIN                                                          <<03603>>07062000
   TOS := %22;                                                 <<03603>>07064000
   ININ'HALT;                                                  <<03603>>07066000
END;                                                           <<03603>>07068000
PROCEDURE STT'VIOL;                                            <<03603>>07070000
BEGIN                                                          <<03603>>07072000
   TOS := %21;                                                 <<03603>>07074000
   ININ'HALT;                                                  <<03603>>07076000
END;                                                           <<03603>>07078000
PROCEDURE UNIMP'INST;                                          <<03603>>07080000
BEGIN                                                          <<03603>>07082000
   TOS := %20;                                                 <<03603>>07084000
   ININ'HALT;                                                  <<03603>>07086000
END;                                                           <<03603>>07088000
PROCEDURE TRAP17;                                              <<03603>>07090000
BEGIN                                                          <<03603>>07092000
   TOS := %17;                                                 <<03603>>07094000
   ININ'HALT;                                                  <<03603>>07096000
END;                                                           <<03603>>07098000
PROCEDURE TRAP16;                                              <<03603>>07100000
BEGIN                                                          <<03603>>07102000
   TOS := %16;                                                 <<03603>>07104000
   ININ'HALT;                                                  <<03603>>07106000
END;                                                           <<03603>>07108000
PROCEDURE TRAP15;                                              <<03603>>07110000
BEGIN                                                          <<03603>>07112000
   TOS := %15;                                                 <<03603>>07114000
   ININ'HALT;                                                  <<03603>>07116000
END;                                                           <<03603>>07118000
PROCEDURE TRAP14;                                              <<03603>>07120000
BEGIN                                                          <<03603>>07122000
   TOS := %14;                                                 <<03603>>07124000
   ININ'HALT;                                                  <<03603>>07126000
END;                                                           <<03603>>07128000
PROCEDURE TRAP13;                                              <<03603>>07130000
BEGIN                                                          <<03603>>07132000
   TOS := %13;                                                 <<03603>>07134000
   ININ'HALT;                                                  <<03603>>07136000
END;                                                           <<03603>>07138000
PROCEDURE TRAP12;                                              <<03603>>07140000
BEGIN                                                          <<03603>>07142000
   TOS := %12;                                                 <<03603>>07144000
   ININ'HALT;                                                  <<03603>>07146000
END;                                                           <<03603>>07148000
PROCEDURE PWR'FAIL;                                            <<03603>>07150000
   OPTION INTERRUPT;                                           <<03603>>07152000
BEGIN                                                          <<03603>>07154000
   TOS := %11;                                                 <<03603>>07156000
   << FLUSH THE CACHE IF AN ICF/55 >>                          <<03603>>07158000
   IF ICF55 THEN ASSEMBLE( CON %20104; CON 5 );                <<03603>>07160000
   ININ'HALT;                                                  <<03603>>07162000
END;                                                           <<03603>>07164000
PROCEDURE TRAP10;                                              <<03603>>07166000
BEGIN                                                          <<03603>>07168000
   TOS := %10;                                                 <<03603>>07170000
   ININ'HALT;                                                  <<03603>>07172000
END;                                                           <<03603>>07174000
PROCEDURE MOD'INT;                                             <<03603>>07176000
   OPTION INTERRUPT;                                           <<03603>>07178000
BEGIN                                                          <<03603>>07180000
   TOS := 7;                                                   <<03603>>07182000
   ININ'HALT;                                                  <<03603>>07184000
END;                                                           <<03603>>07186000
PROCEDURE DATA'PARITY;                                         <<03603>>07188000
   OPTION INTERRUPT;                                           <<03603>>07190000
BEGIN                                                          <<03603>>07192000
   TOS := 6;                                                   <<03603>>07194000
   ININ'HALT;                                                  <<03603>>07196000
END;                                                           <<03603>>07198000
PROCEDURE ADR'PARITY;                                          <<03603>>07200000
   OPTION INTERRUPT;                                           <<03603>>07202000
BEGIN                                                          <<03603>>07204000
   TOS := 5;                                                   <<03603>>07206000
   ININ'HALT;                                                  <<03603>>07208000
END;                                                           <<03603>>07210000
PROCEDURE SYS'PARITY;                                          <<03603>>07212000
   OPTION INTERRUPT;                                           <<03603>>07214000
BEGIN                                                          <<03603>>07216000
   TOS := 4;                                                   <<03603>>07218000
   ININ'HALT;                                                  <<03603>>07220000
END;                                                           <<03603>>07222000
PROCEDURE ILL'ADR;                                             <<I8503>>07224000
BEGIN COMMENT                                                  <<03603>>07226000
   The function of this procedure is to allow INITIAL          <<03603>>07228000
   to recover from the non-responding-module interrupt         <<03603>>07230000
   generated because a disc device is configured, but          <<03603>>07232000
   the GIC is not physically present.  Also to recover         <<03603>>07234000
   from the non-responding-module interrupt generated          <<03603>>07236000
   from a user giving us an invalid memory size.               <<03603>>07238000
   ;                                                           <<03603>>07240000
   ENTRY                                                       <<I8503>>07242000
      NON'RESP'MOD;                                            <<I8503>>07244000
   EQUATE                                                      <<03603>>07246000
      I'O'INSTR = %20302, << If the non-responding-module   >> <<03603>>07248000
                          << interrupt is due to a missing  >> <<03603>>07250000
                          << GIC, this will be in the X-REG >> <<03603>>07252000
      LSEA      = %20340, << If the non-responding-module   >> <<03603>>07254000
      SSEA      = %20341; << interrupt is due to a missing  >> <<03603>>07256000
                          << memory controller, this will   >> <<03603>>07258000
                          << be in the X-REG---see test of  >> <<03603>>07260000
                          << memsize in MAINSEG1            >> <<03603>>07262000
NON'RESP'MOD:                                                  <<I8503>>07264000
   IF X = I'O'INSTR THEN                                       <<03603>>07266000
      BEGIN                                                    <<03603>>07268000
      CC := CCL; << Return CCL to the code which originated >> <<03603>>07270000
                 << the SIOP to inform it that something    >> <<03603>>07272000
                 << went wrong.                             >> <<03603>>07274000
      END                                                      <<03603>>07276000
ELSE                                                           <<03603>>07278000
   << Different series respond differently to illmemadr >>     <<03603>>07280000
   << Series II/III do blind LSEA but trap on SSEA      >>     <<03603>>07282000
   << Series 33,44,55 will trap prior to LSEA on SSEA   >>     <<03603>>07284000
   IF X <> LSEA AND X <> SSEA THEN                             <<03603>>07286000
      ERRMESSAGE( M400); << NON-RESPONDING-MODULE INTERRUPT >> <<03603>>07288000
END;                                                           <<03603>>07290000
PROCEDURE BNDS'VOIL;                                           <<03603>>07292000
BEGIN                                                          <<03603>>07294000
   TOS := 1;                                                   <<03603>>07296000
   ININ'HALT;                                                  <<03603>>07298000
END;                                                           <<03603>>07300000
$CONTROL SEGMENT=RESIDENT                                      <<03001>>07302000
  PROCEDURE HELP;                                              <<03001>>07304000
    COMMENT                                                    <<03001>>07306000
   STAND-ALONE DEBUGGING PROCEDURE FOR DEBUGING INITIAL.       <<03001>>07308000
   INTERFACES THRU THE CONSOLE PART OF THE SYSTEM CLOCK        <<03001>>07310000
   BOARD. EACH SEGMENT WHERE IT IS TO BE USED MUST CONTAIN     <<03001>>07312000
   A PCAL TO HELP;                                             <<03001>>07314000
                                                               <<03001>>07316000
      BEGIN                                                    <<03001>>07318000
                                                               <<03001>>07320000
ENTRY HELP'MAKE'PRESENT;                                       <<03001>>07322000
      <<A SPECIAL ENRTY POINT - CALLED FROM MAKE'PRESENT>>     <<03001>>07324000
      <<WHENEVER A NEW CODE SEGMENT IS MADE PRESENT IN CORE>>  <<03001>>07326000
ENTRY HELP'MAKE'ABSENT;                                        <<03001>>07328000
ENTRY HELP'INIT'BPTAB;    <<ENTRY TO INITIALIZE BRKPT-TABLE>>  <<03001>>07330000
                                                               <<03001>>07332000
DEFINE                                                         <<03001>>07334000
        DISABLE = ASMB(SED 0)#,                                <<03001>>07336000
        CST'SIZE = 4#,                                         <<03001>>07338000
        F = ABSOLUTE#,                                         <<03001>>07340000
        BANKS'CONFIGURED = F(%1047)#;                          <<03001>>07342000
                                                               <<03001>>07344000
                                                               <<03001>>07346000
EQUATE BANK'BITS = 3;                                          <<03001>>07348000
                                                               <<03001>>07350000
EQUATE  MAX'BRKPTS = 10,                                       <<03001>>07352000
        BPT'ENTRY'SIZE = 3,     <<3 WORDS PER ENTRY>>          <<03001>>07354000
        BPT'TBL'SIZE = MAX'BRKPTS * BPT'ENTRY'SIZE,            <<03001>>07356000
        BPT'COPY'SIZE = BPT'TBL'SIZE + 2;  <<NUMBP + DEBUG>>   <<03001>>07358000
                                                               <<03001>>07360000
DEFINE  NUM'BRKPTS = BPTAB( BPT'TBL'SIZE )#;                   <<03001>>07362000
DEFINE  BP'DEBUG = BPTAB(BPT'TBL'SIZE+1)#;                     <<03001>>07364000
                                                               <<03001>>07366000
                                                               <<03001>>07368000
EQUATE  EMPTY'BRKPT = 0,      <<ENTRY IS AVAILABLE>>           <<03001>>07370000
        USER'BRKPT  = 1,      <<USER SET BRKPT>>               <<03001>>07372000
        FAKE'BRKPT  = 2,      <<FAKE BRKPT>>                   <<03001>>07374000
        ABSENT'BRKPT= 3;      <<SEGMENT IS ABSENT BRKPT>>      <<03001>>07376000
                                                               <<03001>>07378000
EQUATE  BP'TYPE'CST = 0,      <<  TYPE-CST  WORD-0 >>          <<03001>>07380000
        BP'ADDR     = 1,      <<    P       WORD-1 >>          <<03001>>07382000
        BP'INSTR    = 2;      <<  INSTR     WORD-2 >>          <<03001>>07384000
                                                               <<03001>>07386000
DEFINE  BP'TYPE = (0:8)#,     << FIELD FOR BRKPT-TYPE>>        <<03001>>07388000
        BP'CST  = (8:8)#;     << FIELD FOR BRKPT-CST >>        <<03001>>07390000
                                                               <<03001>>07392000
                                                               <<03001>>07394000
DEFINE EMPTY'FAKE'BRKPT = %1000#;    <<TYPE=FAKE,CST=0>>       <<03001>>07396000
                                                               <<03001>>07398000
EQUATE NUM'ZEROS = BPT'TBL'SIZE -1;  <<INITIALIZED ZEROS>>     <<03001>>07400000
                                                               <<03001>>07402000
ARRAY PB'REL'BRKPT'TBL(*)=PB:=EMPTY'FAKE'BRKPT,NUM'ZEROS(0),   <<03001>>07404000
                              0,0;                             <<03001>>07406000
DOUBLE ARRAY PBBASES(*) = PB := 0D,<< CODE >>                  <<H8649>>07408000
                                0D,<< DISC >>                  <<H8649>>07410000
                                0D;<< DATA >>                  <<H8649>>07412000
 COMMENT                                                       <<03001>>07414000
   THIS ARRAY HOLDS THE INFORMATION REQUIRED FOR BREAKPOINTS.  <<03001>>07416000
   EACH ENTRY IN THE TABLE IS 3 WORDS LONG. THE TABLE IS       <<03001>>07418000
   ENDED WITH A -1. IT MAY BE EXTENDED BY  CHANGING THE NUMBER <<03001>>07420000
   OF INITIALIZATION ZEROS IN THE ABOVE DECLARATION. THE WORDS <<03001>>07422000
   IN  A TABLE ENTRY ARE USED AS FOLLOWS:                      <<03001>>07424000
                                                               <<03001>>07426000
   WORD0.(0:8) =  0    EMPTY TABLE ENTRY                       <<03001>>07428000
                  1    USER SET BREAKPOINT                     <<03001>>07430000
                  2    "FAKE" BREAKPOINT                       <<03001>>07432000
                  3    ABSENT BREAKPOINT                       <<03001>>07434000
                                                               <<03001>>07436000
   WORD0.(8:8) =       CST FOR THE BREAKPOINT. IF ZERO THEN    <<03001>>07438000
                       THIS TABLE ENTRY IS FREE.               <<03001>>07440000
                                                               <<03001>>07442000
   WORD1       =       PB RELATIVE ADDRESS FOR THE BREAKPOINT. <<03001>>07444000
                       IF ZERO THEN THE ENTRY IS FREE.         <<03001>>07446000
                                                               <<03001>>07448000
   WORD2       =       SAVED INSTRUCTION IF A BRKPOINT IS SET. <<03001>>07450000
                                                               <<03001>>07452000
END COMMENT;                                                   <<03001>>07454000
                                                               <<03001>>07456000
                                                               <<03001>>07458000
INTEGER ARRAY  DB'BPTAB(*) = DB+0;  << BREAKPOINT TABLE >>     <<03001>>07460000
INTEGER ARRAY BPTAB(0:BPT'TBL'SIZE+1) = Q;  <<Q-REL COPY>>     <<03001>>07462000
     <<SEE SUBROUTINE COPY'BRKPT'TABLE >>                      <<03001>>07464000
                                                               <<03001>>07466000
                                                               <<03001>>07468000
                                                               <<03001>>07470000
INTEGER BUFX;                                                  <<03001>>07472000
                                                               <<03001>>07474000
EQUATE NUM'CMDS = 10;                                          <<H8649>>07476000
                                                               <<03001>>07478000
            <<ORDER IS IMPORTANT-SEE MAINLINE CASE STATMENT>>  <<03001>>07480000
            <<---------------------------------------------->> <<03001>>07482000
INTEGER ARRAY  COMM(*) = PB := %102,   <<B BREAK>>             <<03001>>07484000
                               %103,   <<C CLEAR>>             <<03001>>07486000
                               %104,   <<D DUMP>>              <<03001>>07488000
                               %105,   <<E ENV>>               <<N8581>>07490000
                               %106,   <<F FILL>>              <<N8581>>07492000
                               %114,   <<L LIST>>              <<03001>>07494000
                               %115,   <<M MODIFY>>            <<03001>>07496000
                               %122,   <<R RESUME>>            <<03001>>07498000
                               %124,   <<T TRACE>>             <<03001>>07500000
                               %75;    <<= EXPR>>              <<03001>>07502000
<< OCTAL VALUES OF THE CHARACTER COMMANDS >>                   <<03001>>07504000
                                                               <<03001>>07506000
                                                               <<03001>>07508000
EQUATE    OCTAL'MODE   = 0,                                    <<03001>>07510000
          DECIMAL'MODE = 1,                                    <<03001>>07512000
          HEX'MODE     = 2,                                    <<03001>>07514000
          ASCII'MODE   = 3,                                    <<03001>>07516000
          BINARY'MODE  = 4;                                    <<03001>>07518000
                                                               <<03001>>07520000
EQUATE NUM'MODES       = 5;                                    <<03001>>07522000
                                                               <<03001>>07524000
INTEGER ARRAY MODES(*)=PB:=  %117,   <<O OCTAL>>               <<03001>>07526000
                             %111,   <<I DECIMAL>>             <<03001>>07528000
                             %110,   <<H HEX>>                 <<03001>>07530000
                             %101,   <<A ASCII>>               <<03001>>07532000
                             %102;   <<B BINARY>>              <<03001>>07534000
                                                               <<03001>>07536000
INTEGER ARRAY  REL(*) = PB := %74,%75,%76,%43;                 <<03001>>07538000
<<  THE ABOVE ARE THE ALLOWABLE RELATIONAL OPERATORS >>        <<03001>>07540000
                                                               <<03001>>07542000
INTEGER ARRAY  PRE(*) = PB := "HELP    . ";                    <<03001>>07544000
                                                               <<03001>>07546000
INTEGER ARRAY CHARS(*) = PB :=  %60,%61,%62,%63,%64,%65,       <<03001>>07548000
    %66,%67,%70,%71,%101,%102,%103,%104,%105,%106;             <<03001>>07550000
<<CHARS FOR HEX CONVERSION:  0,1,2,..9,A,B,C,D,E,F >>          <<03001>>07552000
                                                               <<03001>>07554000
DOUBLE  P1, P2,   << PARAMETERS FOR COMMANDS >>                <<03001>>07556000
        OLDDB,    << CALLERS DB >>                             <<03001>>07558000
        SAVEDB,   << DB FOR BRKPT-TBL IN CODE>>                <<03001>>07560000
        K,  << TEMPORARY VARIABLE >>                           <<03001>>07562000
        CUR'VALUE,    <<TEMP VALUE FOR DUMP,MODIFY>>           <<03001>>07564000
        BRKPT'ADDR,   <<ABS ADDR FOR BRKPT>>                   <<03001>>07566000
        DS4 = S-4,   << S RELATIVE TEMPS >>                    <<03001>>07568000
        DS5 = S-5,                                             <<03001>>07570000
        DS2 = S-2,                                             <<N8581>>07572000
        DS1 = S-1;                                             <<03001>>07574000
                                                               <<03001>>07576000
DOUBLE BASECODE, BASEDISC, BASEDATA;                           <<H8649>>07578000
INTEGER BASECODE1 = BASECODE,                                  <<H8649>>07580000
        BASECODE2 = BASECODE+1,                                <<H8649>>07582000
        BASEDISC1 = BASEDISC,                                  <<H8649>>07584000
        BASEDISC2 = BASEDISC+1,                                <<H8649>>07586000
        BASEDATA1 = BASEDATA,                                  <<H8649>>07588000
        BASEDATA2 = BASEDATA+1;                                <<H8649>>07590000
                                                               <<H8649>>07592000
LOGICAL  P2F,   << SET IF 2ND PARAMETER EXISTS >>              <<03001>>07594000
         REG,   << REGISTER USE FLAG >>                        <<03001>>07596000
         A'SPECIAL'ENTRY;   <<TRUE IF HELP IS >>               <<03001>>07598000
             <<ENTERED AT SPECIAL MAKE-PRESENT ENTRY PT>>      <<03001>>07600000
                                                               <<03001>>07602000
                                                               <<03001>>07604000
INTEGER  X = X,   << DEFINE REGISTERS AND TOS VARIABLES >>     <<03001>>07606000
         S0 = S-0,                                             <<03001>>07608000
         S1 = S-1,                                             <<03001>>07610000
         S2 = S-2,                                             <<03001>>07612000
         S3 = S-3,                                             <<03001>>07614000
         S4 = S-4,                                             <<03001>>07616000
         S5 = S-5,                                             <<03001>>07618000
         S6 = S-6,                                             <<03001>>07620000
         S7 = S-7,                                             <<03001>>07622000
         ENV := 0,                                             <<N8581>>07624000
         TOKEN,  << OUTPUT OF CHAR SUBROUTINE >>               <<03001>>07626000
         BRKPT'INSTR,  <<INSTRUCTION TO REPLACE>>              <<03001>>07628000
         BRKPT'TYPE,   <<TYPE OF BREAKPOINT>>                  <<03001>>07630000
         BRKPT'INX,    <<INDEX INTO BPTAB >>                   <<03001>>07632000
         ENTRY'BRKPT'INX,  <<INDEX OF USER BRKPT AT ENTRY>>    <<03001>>07634000
         ENTRY'CST,        <<SEGMENT OF THE ENTRY BRKPT>>      <<03001>>07636000
         ENTRY'P,          <<ADDR OF THE ENTRY BRKPT>>         <<03001>>07638000
         I, J, L, M,  << TEMPORARY VARIABLES >>                <<N8581>>07640000
         OLDS,  << S VALUE TO RESET IN FAIL >>                 <<03001>>07642000
         COM,  << COMMAND # >>                                 <<03001>>07644000
         CST,  << CST VALUE FOR B AND C COMMANDS >>            <<03001>>07646000
         P,  << P VALUE FOR ABOVE >>                           <<03001>>07648000
         PIN,                                                  <<03001>>07650000
         WIDTH,                                                <<03001>>07652000
         MODE,                                                 <<03001>>07654000
         SMP = Q-2,  << P FROM STACK MARKER >>                 <<03001>>07656000
         SMSTA = Q-1,  << STATUS FROM STACK MARKER >>          <<03001>>07658000
         SPECIAL'FUNCTION = Q - 5,   <<0=CLEAR  1 =PRSENT>>    <<03001>>07660000
         NEW'PRESENT'SEG = Q-4;    <<SPECIAL PARAMETER>>       <<03001>>07662000
            <<PUSHED ON TOS PRIOR TO CALL TO HELP BY>>         <<03001>>07664000
            <<MAKE'PRESENT WHEN A NEW SEGMENT HAS BEEN>>       <<03001>>07666000
            <<MADE PRESENT IN CORE>>                           <<03001>>07668000
                                                               <<03001>>07670000
                                                               <<CONFD>>07672000
INTEGER ARRAY WRDIO(0:39) = Q; << OUTPUT BUFFER >>             <<CONFD>>07674000
BYTE ARRAY IO(*) = WRDIO;                                      <<CONFD>>07676000
                                                               <<CONFD>>07678000
INTEGER ARRAY INBUF(0:39) = Q; << INPUT BUFFER >>              <<CONFD>>07680000
BYTE ARRAY BINBUF(*) = INBUF;                                  <<CONFD>>07682000
$PAGE "HELP         BRKPT'TABLE SETUP"                         <<03001>>07684000
DOUBLE SUBROUTINE CST'ADDR( CST );                             <<03001>>07686000
<<===============================>>                            <<03001>>07688000
   VALUE CST; INTEGER CST;                                     <<03001>>07690000
                                                               <<03001>>07692000
<<COMPUTES THE BASE ADDRESS FOR A SEGMENT GIVEN THE CST. >>    <<03001>>07694000
                                                               <<03001>>07696000
   BEGIN                                                       <<03001>>07698000
   IF  F(F(0)) < CST  THEN  ASMB(HALT 1);  << ILLEGAL CST >>   <<03001>>07700000
   X := X+CST*CST'SIZE;                                        <<03001>>07702000
   IF  F(X) < 0  THEN  ASMB(HALT 2);  << ABSENT, ERROR >>      <<03001>>07704000
   TOS := F(X:=X+2);  << GET BANK >>                           <<03001>>07706000
   TOS := F(X:=X+1);  << GET ADDRESS IN THE BANK >>            <<03001>>07708000
   DS5 := TOS;  << RETURN THE VALUE >>                         <<03001>>07710000
   END;                                                        <<03001>>07712000
DOUBLE SUBROUTINE RDCODE( PBADR);                              <<H8649>>07714000
   VALUE PBADR;                                                <<H8649>>07716000
   INTEGER PBADR;                                              <<H8649>>07718000
BEGIN                                                          <<H8649>>07720000
   TOS := 0D;                                                  <<H8649>>07722000
   PUSH( STATUS );                                             <<H8649>>07724000
   TOS := TOS.(8:8);                                           <<H8649>>07726000
   TOS := CST'ADDR( * );                                       <<H8649>>07728000
   TOS := TOS+S3;                                              <<H8649>>07730000
   ASSEMBLE( LDEA; DXCH,DDEL );                                <<H8649>>07732000
   DS5 := TOS;                                                 <<H8649>>07734000
END;                                                           <<H8649>>07736000
SUBROUTINE STCODE( PBADR, DATA);                               <<H8649>>07738000
   VALUE PBADR,DATA;                                           <<H8649>>07740000
   INTEGER PBADR;                                              <<H8649>>07742000
   DOUBLE DATA;                                                <<H8649>>07744000
BEGIN                                                          <<H8649>>07746000
   TOS := 0D;                                                  <<H8649>>07748000
   PUSH( STATUS );                                             <<H8649>>07750000
   TOS := TOS.(8:8);                                           <<H8649>>07752000
   TOS := CST'ADDR( * );                                       <<H8649>>07754000
   TOS := TOS+S5;                                              <<H8649>>07756000
   TOS := DS4;                                                 <<H8649>>07758000
   ASSEMBLE( SDEA; DDEL );                                     <<H8649>>07760000
END;                                                           <<H8649>>07762000
                                                               <<03001>>07764000
                                                               <<03001>>07766000
SUBROUTINE COPY'BRKPT'TABLE;                                   <<03001>>07768000
<<=========================>>                                  <<03001>>07770000
BEGIN                                                          <<03001>>07772000
    TOS := ABS(DBBANK);  <<AIM DB AT STACK>>                   <<03001>>07774000
    TOS := ABS(DB);                                            <<03001>>07776000
    ASMB(DDUP);   <<COPY FOR DEST CALC. FOR MABS>>             <<03001>>07778000
    ASMB(XCHD);                                                <<03001>>07780000
    OLDDB := TOS;        <<SAVE ORIG USER'S DB >>              <<03001>>07782000
    TOS := TOS +@BPTAB;   <<CALC. FINAL DEST IN STACK>>        <<03001>>07784000
                                                               <<03001>>07786000
    TOS := 0D;   <<FOR RETURN VALUE FROM CST'ADDR(*) >>        <<03001>>07788000
    PUSH(STATUS);                                              <<03001>>07790000
    TOS:=TOS.(8:8);    <<GRAB SEG NUMBER OF HELP>>             <<03001>>07792000
    TOS := CST'ADDR(*);   <<ABS ADDRESS>>                      <<03001>>07794000
    TOS := TOS + @PB'REL'BRKPT'TBL;  <<SRC FOR MABS>>          <<03001>>07796000
    ASMB (DDUP);  SAVEDB:= TOS;  <<SAVE SEG ADDR OF BPTAB>>    <<03001>>07798000
                                                               <<03001>>07800000
    TOS := BPT'COPY'SIZE;  <<LEN FOR MABS>>                    <<03001>>07802000
                                                               <<03001>>07804000
    ASMB( MABS);  <<MAKE A Q-REL COPY OF BPTAB FROM CODE SEG>> <<03001>>07806000
                                                               <<H8649>>07808000
    TOS := @PBBASES;  I := TOS;                                <<H8649>>07810000
    BASECODE := RDCODE( I);                                    <<H8649>>07812000
    TOS := @PBBASES(1);  I := TOS;                             <<H8649>>07814000
    BASEDISC := RDCODE( I);                                    <<H8649>>07816000
    TOS := @PBBASES(2);  I := TOS;                             <<H8649>>07818000
    BASEDATA := RDCODE( I);                                    <<H8649>>07820000
END;                                                           <<03001>>07822000
                                                               <<03001>>07824000
                                                               <<03001>>07826000
SUBROUTINE SAVE'BRKPT'TABLE;                                   <<03001>>07828000
<<=========================>>                                  <<03001>>07830000
BEGIN                                                          <<03001>>07832000
    TOS := SAVEDB;   <<ADDR IN SEG OF BPTAB>>                  <<03001>>07834000
                     <<DST FOR MABS>>                          <<03001>>07836000
                                                               <<03001>>07838000
    TOS := ABS(DBBANK);                                        <<03001>>07840000
    TOS := ABS(DB);                                            <<03001>>07842000
    TOS := TOS +@BPTAB;  <<SRC FOR MABS>>                      <<03001>>07844000
                                                               <<03001>>07846000
    TOS := BPT'COPY'SIZE;  <<LEN>>                             <<03001>>07848000
                                                               <<03001>>07850000
    ASMB(MABS);  <<COPY BACK FROM STACK TO SEG>>               <<03001>>07852000
                                                               <<03001>>07854000
                                                               <<03001>>07856000
    TOS := OLDDB;                                              <<03001>>07858000
    SET(DB);     <<RESTORE DB BACK TO CALLERS ORIG DB>>        <<03001>>07860000
                                                               <<H8649>>07862000
    TOS := @PBBASES;                                           <<H8649>>07864000
    STCODE(*,BASECODE);                                        <<H8649>>07866000
    TOS := @PBBASES(1);                                        <<H8649>>07868000
    STCODE(*,BASEDISC);                                        <<H8649>>07870000
    TOS := @PBBASES(2);                                        <<H8649>>07872000
    STCODE(*,BASEDATA);                                        <<H8649>>07874000
END;                                                           <<03001>>07876000
                                                               <<03001>>07878000
$PAGE "HELP          IO ROUTINES"                              <<03001>>07880000
SUBROUTINE PRINTLINE (CNTL);                                   <<03001>>07882000
<<=======================>>                                    <<03001>>07884000
    VALUE CNTL; INTEGER CNTL;                                  <<03001>>07886000
    << 0 = CR-LF   1 = STAY ON SAME LINE >>                    <<03001>>07888000
    <<PRINTS THE CONTENTS OF THE "IO" BUFFER>>                 <<03001>>07890000
    <<BUFX POINTS TO NEXT FREE BYTE, AND THEREFORE>>           <<03001>>07892000
    <<EQUALS THE NUMBER OF LOADED BYTES>>                      <<03001>>07894000
BEGIN                                                          <<03001>>07896000
   PRINT(WRDIO,-BUFX,CNTL);                                    <<03001>>07898000
   BUFX := 0;  <<RESET THE BUFFER INDEX>>                      <<03001>>07900000
END;                                                           <<03001>>07902000
INTEGER SUBROUTINE  CHAR;                                      <<H8649>>07904000
<<===============>>                                            <<03001>>07906000
<<THIS PLACES THE NEXT BYTE IN BINBUF INTO TOKEN>>             <<03001>>07908000
<<AND ADVANCES PIN- THE INPUT BUFFER INDEX>>                   <<03001>>07910000
   BEGIN                                                       <<03001>>07912000
   DO BEGIN                                                    <<03001>>07914000
      TOKEN := BINBUF(PIN);                                    <<03001>>07916000
      PIN := PIN+1;                                            <<03001>>07918000
      END UNTIL TOKEN <> " ";                                  <<03001>>07920000
   IF "a" <= TOKEN <= "z" THEN                                 <<H8649>>07922000
      TOKEN := TOKEN - %40;                                    <<H8649>>07924000
   CHAR := TOKEN;                                              <<H8649>>07926000
   END;                                                        <<03001>>07928000
                                                               <<03001>>07930000
SUBROUTINE  NUMOUT( N, L, S );                                 <<03001>>07932000
<<============================>>                               <<03001>>07934000
   VALUE  N,L,S;                                               <<03001>>07936000
   DOUBLE N;                                                   <<03001>>07938000
   INTEGER L,S;                                                <<03001>>07940000
<<N IS THE NUMBER TO PRINT. >>                                 <<03001>>07942000
<<L IS THE LOCATION IN "IO" TO PLACE IT>>                      <<03001>>07944000
<<S IS THE SIZE IN CHARACTERS FOR THE CONVERTED NUMBER.>>      <<03001>>07946000
   BEGIN                                                       <<03001>>07948000
   X := L+S;  << SET UP THE INDEX >>                           <<03001>>07950000
   TOS := N;  << GET NUMBER >>                                 <<03001>>07952000
   DO                                                          <<03001>>07954000
      BEGIN  << CONVERT ONE DIGIT >>                           <<03001>>07956000
      X := X-1;                                                <<03001>>07958000
      DUPLICATE;                                               <<03001>>07960000
      IO(X) := (TOS LAND 7) LOR %60;                           <<03001>>07962000
      TOS := TOS&DASR(3);                                      <<03001>>07964000
      END                                                      <<03001>>07966000
   UNTIL  S4 = X;                                              <<03001>>07968000
   DDEL;  << DELETE N'S REMAINS >>                             <<03001>>07970000
   END;                                                        <<03001>>07972000
                                                               <<03001>>07974000
SUBROUTINE HEXOUT( NUM, NRCHARS);                              <<N8581>>07976000
   VALUE NUM, NRCHARS;                                         <<N8581>>07978000
   DOUBLE NUM;                                                 <<N8581>>07980000
   INTEGER NRCHARS;                                            <<N8581>>07982000
BEGIN                                                          <<N8581>>07984000
   M := NRCHARS;                                               <<N8581>>07986000
   WHILE NRCHARS > 0 DO                                        <<N8581>>07988000
      BEGIN                                                    <<N8581>>07990000
      NRCHARS := NRCHARS-1;                                    <<N8581>>07992000
      IO(BUFX+NRCHARS) := CHARS(LOGICAL(NUM).(12:4));          <<N8581>>07994000
      NUM := NUM &DCSR(4);                                     <<N8581>>07996000
      END;                                                     <<N8581>>07998000
   BUFX := BUFX+M;                                             <<N8581>>08000000
END;                                                           <<N8581>>08002000
                                                               <<N8581>>08004000
                                                               <<03001>>08006000
DOUBLE SUBROUTINE DLSEA (ADDR);                                <<03001>>08008000
<<============================>>                               <<03001>>08010000
   VALUE ADDR; DOUBLE ADDR;                                    <<03001>>08012000
                                                               <<03001>>08014000
   <<GETS THE VALUE AT ADDR, AND CONVERTS IT TO A>>            <<03001>>08016000
   <<DOUBLE VALUE, WITH HI PART = 0>>                          <<03001>>08018000
BEGIN                                                          <<03001>>08020000
   TOS := ADDR;                                                <<03001>>08022000
   ASMB (LSEA);  <<GET THE VALUE>>                             <<03001>>08024000
   S7 := 0;  <<RETURN A 0 FOR HI PART>>                        <<03001>>08026000
   S6 := TOS;  <<RETURN LO PART>>                              <<03001>>08028000
   DDEL;     <<CUT ADDRESS FOR LSEA OFF>>                      <<03001>>08030000
END;                                                           <<03001>>08032000
                                                               <<03001>>08034000
                                                               <<03001>>08036000
                                                               <<03001>>08038000
SUBROUTINE BLANKOUT ( SPACES);                                 <<03001>>08040000
<<===========================>>                                <<03001>>08042000
    VALUE SPACES; INTEGER SPACES;                              <<03001>>08044000
BEGIN                                                          <<03001>>08046000
    WHILE SPACES > 0 DO                                        <<03001>>08048000
    BEGIN                                                      <<03001>>08050000
        IO(BUFX) := " ";    <<LOAD A BLANK>>                   <<03001>>08052000
        BUFX := BUFX + 1;                                      <<03001>>08054000
        SPACES := SPACES - 1;                                  <<03001>>08056000
    END;                                                       <<03001>>08058000
END;                                                           <<03001>>08060000
                                                               <<03001>>08062000
                                                               <<03001>>08064000
                                                               <<03001>>08066000
SUBROUTINE OCTNUMOUT (NUM, WIDTH);                             <<03001>>08068000
<<===============================>>                            <<03001>>08070000
   VALUE NUM,WIDTH; DOUBLE NUM; INTEGER WIDTH;                 <<03001>>08072000
    <<LOADS "IO" BUFFER AT CURRENT POSITION OF BUFX>>          <<03001>>08074000
    <<ONLY WIDTH BYTES OF OCTAL CONVERSION ARE LOADED>>        <<03001>>08076000
    <<BUFX IS ADVANCED TO NEXT FREE BYTE>>                     <<03001>>08078000
BEGIN                                                          <<03001>>08080000
    NUMOUT( NUM,BUFX,WIDTH);                                   <<03001>>08082000
    BUFX := BUFX + WIDTH;      <<ADVANCE BUFX >>               <<03001>>08084000
END;                                                           <<03001>>08086000
                                                               <<03001>>08088000
SUBROUTINE BYTESOUT (NUM);                                     <<03001>>08090000
<<=======================>>                                    <<03001>>08092000
    VALUE NUM; DOUBLE NUM;                                     <<03001>>08094000
BEGIN                                                          <<03001>>08096000
    TOS := NUM;                                                <<03001>>08098000
    DELB;                     <<KILL HI PART- LEAVE LO >>      <<03001>>08100000
    OCTNUMOUT( DOUBLE(S0.(0:8)),3);  <<LEFT BYTE>>             <<03001>>08102000
    BLANKOUT( 1 );            <<LOAD SPACE BETWEEN BYTES>>     <<03001>>08104000
    OCTNUMOUT( DOUBLE(TOS.(8:8)),3);  <<RIGHT BYTE>>           <<03001>>08106000
END;                                                           <<03001>>08108000
                                                               <<03001>>08110000
                                                               <<03001>>08112000
SUBROUTINE ASCIINUMOUT (NUM);                                  <<03001>>08114000
<<=========================>>                                  <<03001>>08116000
    VALUE NUM; DOUBLE NUM;                                     <<03001>>08118000
    <<LOADS THE TWO BYTES IN THE LO PORTION OF NUM>>           <<03001>>08120000
    <<INTO THE "IO" BUFFER, AND ADVANCES BUFX>>                <<03001>>08122000
BEGIN                                                          <<03001>>08124000
                                                               <<03001>>08126000
    TOS := NUM;                 <<COPY OF NUM>>                <<03001>>08128000
    DELB;                       <<CHUCK HI PART>>              <<03001>>08130000
    DUPLICATE;                  <<NOW 2 COPIES OF LO PART>>    <<03001>>08132000
                                                               <<03001>>08134000
    TOS := TOS.(0:8);           <<GRAB LEFT BYTE>>             <<03001>>08136000
    IF S0 < %40 OR S0 > %176    <<NON-PRINTABLE>>              <<03001>>08138000
    THEN S0 := %56;             <<USE A PERIOD>>               <<03001>>08140000
    IO(BUFX) := TOS;            <<LOAD BYTE INTO IO-BUF>>      <<03001>>08142000
    BUFX:=BUFX + 1;             <<ADVANCE TO NEXT BYTE>>       <<03001>>08144000
                                                               <<03001>>08146000
    TOS := TOS.(8:8);           <<GRAB RIGHT BYTE>>            <<03001>>08148000
    IF S0 < %40 OR S0 > %176    <<NON-PRINTABLE>>              <<03001>>08150000
    THEN S0 := %56;             <<USE A PERIOD>>               <<03001>>08152000
    IO(BUFX) := TOS;            <<LOAD BYTE INTO IO-BUF>>      <<03001>>08154000
    BUFX:=BUFX + 1;             <<ADVANCE TO NEXT BYTE>>       <<03001>>08156000
END;  <<SUBROUTINE ASCIINUMOUT>>                               <<03001>>08158000
                                                               <<03001>>08160000
                                                               <<03001>>08162000
SUBROUTINE BITSOUT( NUM);                                      <<03001>>08164000
<<======================>>                                     <<03001>>08166000
    VALUE NUM; DOUBLE NUM;                                     <<03001>>08168000
BEGIN                                                          <<03001>>08170000
    TOS := NUM; DELB;     << S1 = NUMBER>>                     <<03001>>08172000
    TOS := 0;             << S0 = COUNT (0-15) >>              <<03001>>08174000
    DO BEGIN                                                   <<03001>>08176000
        IF (S0-1) MOD 3 = 0                                    <<03001>>08178000
        THEN BLANKOUT( 1 );  <<LOAD A SPACE>>                  <<03001>>08180000
        IO(BUFX) := CHARS( S1.(0:1));   <<LOAD "0" OR "1" >>   <<03001>>08182000
        BUFX := BUFX + 1;                                      <<03001>>08184000
        S1 := S1&LSL(1);                                       <<03001>>08186000
        S0 := S0 + 1;                                          <<03001>>08188000
    END UNTIL S0 > 15;   <<LOAD ALL 16 BITS>>                  <<03001>>08190000
    DDEL;                                                      <<03001>>08192000
END;  <<SUBROUTINE BITSOUT>>                                   <<03001>>08194000
                                                               <<03001>>08196000
                                                               <<03001>>08198000
SUBROUTINE ADDROUT (ADDR);                                     <<03001>>08200000
<<======================>>                                     <<03001>>08202000
    VALUE ADDR; DOUBLE ADDR;                                   <<03001>>08204000
BEGIN                                                          <<03001>>08206000
                                                               <<03001>>08208000
    TOS := ADDR&DLSR(16);       <<BANK NUMBER>>                <<03001>>08210000
    OCTNUMOUT(*,BANK'BITS);     <<LOAD BANK NUMBER>>           <<03001>>08212000
    MOVE IO(BUFX) := " @";      <<BANK NOTATION>>              <<03001>>08214000
    BUFX := BUFX + 2;           <<ADVANCE BUFX>>               <<03001>>08216000
                                                               <<03001>>08218000
    TOS := ADDR&DLSL(16);       <<SHIFT BANK PART OUT>>        <<03001>>08220000
    TOS := TOS&DLSR(16);        <<SHIFT ADDR BACK IN>>         <<03001>>08222000
    OCTNUMOUT(*,6);             <<LOAD ADDR PART>>             <<03001>>08224000
    MOVE IO(BUFX) := ": ";      <<LOAD COLON,SPACE>>           <<03001>>08226000
    BUFX := BUFX + 2;                                          <<03001>>08228000
END;                                                           <<03001>>08230000
                                                               <<03001>>08232000
$PAGE "HELP          SYNTAX PARSING ROUTNES"                   <<03001>>08234000
                                                               <<03001>>08236000
DOUBLE SUBROUTINE MARKER( ENV);                                <<N8581>>08238000
   VALUE ENV;                                                  <<N8581>>08240000
   INTEGER ENV;                                                <<N8581>>08242000
BEGIN                                                          <<N8581>>08244000
   PUSH( SBANK );                                              <<N8581>>08246000
   PUSH( DB );                                                 <<N8581>>08248000
   DELB;                                                       <<N8581>>08250000
   PUSH( Q );                                                  <<N8581>>08252000
   TOS := TOS+TOS;                                             <<N8581>>08254000
   K := TOS;                                                   <<N8581>>08256000
                                                               <<N8581>>08258000
   J := 0;                                                     <<N8581>>08260000
   WHILE J < ENV DO                                            <<N8581>>08262000
      BEGIN                                                    <<N8581>>08264000
      IF DLSEA(K) = 0D THEN                                    <<N8581>>08266000
         BEGIN                                                 <<N8581>>08268000
         MARKER := -1D; << BAD RETURN >>                       <<N8581>>08270000
         RETURN;                                               <<N8581>>08272000
         END;                                                  <<N8581>>08274000
      K := K - DLSEA(K);                                       <<N8581>>08276000
      J := J+1;                                                <<N8581>>08278000
      END;                                                     <<N8581>>08280000
   MARKER := K;                                                <<N8581>>08282000
END;                                                           <<N8581>>08284000
                                                               <<03001>>08286000
SUBROUTINE  FAIL;                                              <<03001>>08288000
<<===============>>                                            <<03001>>08290000
<<THIS IS CALLED ON A COMMAND FAILURE. IT CUTS THE STACK>>     <<03001>>08292000
<<BACK AS NEEDED AND RETURNS TO THE COMMAND INPUT LOOP.>>      <<03001>>08294000
    BEGIN                                                      <<03001>>08296000
    WRDIO := "??";                                             <<03001>>08298000
    BUFX := 2;   <<LENGTH = 2 BYTES>>                          <<03001>>08300000
    PRINTLINE (0);  <<OUTPUT ERROR, CRLF>>                     <<03001>>08302000
    TOS := OLDS;  << RESET S AS REQUIRED >>                    <<03001>>08304000
    SET (  S  );                                               <<03001>>08306000
    GO COMIN;                                                  <<03001>>08308000
    END;                                                       <<03001>>08310000
                                                               <<03001>>08312000
LOGICAL SUBROUTINE ABSENT'CST ( CST);                          <<03001>>08314000
<<==================================>>                         <<03001>>08316000
    VALUE CST; INTEGER CST;                                    <<03001>>08318000
BEGIN                                                          <<03001>>08320000
    <<RETURNS TRUE IF SEGMENT "CST" IS ABSENT >>               <<03001>>08322000
                                                               <<03001>>08324000
    IF F(F(0)) < CST                                           <<03001>>08326000
    THEN BEGIN                                                 <<03001>>08328000
        MOVE IO := "ILLEGAL CST";                              <<03001>>08330000
        BUFX := 11;                                            <<03001>>08332000
        PRINTLINE (0);                                         <<03001>>08334000
        RETURN;                                                <<03001>>08336000
     END;                                                      <<03001>>08338000
                                                               <<03001>>08340000
    X := X+CST*CST'SIZE;                                       <<03001>>08342000
    IF F(X) < 0    <<SEGMENT IS ABSENT>>                       <<03001>>08344000
    THEN ABSENT'CST := TRUE                                    <<03001>>08346000
    ELSE ABSENT'CST := FALSE;                                  <<03001>>08348000
END;                                                           <<03001>>08350000
                                                               <<03001>>08352000
                                                               <<03001>>08354000
DOUBLE SUBROUTINE OCTINT;                                      <<03001>>08356000
<<========================>>                                   <<03001>>08358000
<<COMPUTES AND RETURNS AN OCTAL INTEGER. THE INTEGER MUST>>    <<03001>>08360000
<<HAVE BETWEEN 1 AND 6 DIGITS INCLUSIVE>>                      <<03001>>08362000
   BEGIN                                                       <<03001>>08364000
   L := 0;  << ZERO THE DIGIT COUNTER >>                       <<03001>>08366000
   TOS := 0D;  << INITIAL VALUE OF OCTINT >>                   <<03001>>08368000
   WHILE  %60 <= TOKEN <= %67  DO                              <<03001>>08370000
      BEGIN  << GET A DIGIT >>                                 <<03001>>08372000
      L := L+1;                                                <<03001>>08374000
      TOS := TOS&DCSL(3);                                      <<03001>>08376000
      TOS := 0;   << FORM DOUBLE VALUE FOR NEW DIGIT >>        <<03001>>08378000
      TOS := TOKEN-%60;                                        <<03001>>08380000
      ASMB( DADD );                                            <<03001>>08382000
      CHAR;  << GET THE NEXT CHARACTER >>                      <<03001>>08384000
      END;                                                     <<03001>>08386000
   IF  NOT( 1 <= L <= 6 )  THEN  FAIL;                         <<03001>>08388000
      <<TOO FEW OR TOO MANY>>                                  <<03001>>08390000
   DS4 := TOS;  << RETURN THE VALUE >>                         <<03001>>08392000
   END;                                                        <<03001>>08394000
                                                               <<03001>>08396000
DOUBLE SUBROUTINE NUMBER;                                      <<03001>>08398000
<<======================>>                                     <<03001>>08400000
<<COMPUTES A SIGNED NUMBER >>                                  <<03001>>08402000
                                                               <<03001>>08404000
   IF  TOKEN = "-"  THEN                                       <<03001>>08406000
      BEGIN                                                    <<03001>>08408000
      CHAR;  << GET NEXT >>                                    <<03001>>08410000
      NUMBER := -OCTINT;                                       <<03001>>08412000
      END                                                      <<03001>>08414000
   ELSE                                                        <<03001>>08416000
      BEGIN                                                    <<03001>>08418000
      IF  TOKEN = "+"  THEN  CHAR;  << IGNORE IT >>            <<03001>>08420000
      NUMBER := OCTINT;                                        <<03001>>08422000
      END;                                                     <<03001>>08424000
                                                               <<03001>>08426000
                                                               <<03001>>08428000
                                                               <<03001>>08430000
DOUBLE SUBROUTINE PRI';                                        <<03001>>08432000
<<====================>>                                       <<03001>>08434000
                                                               <<03001>>08436000
<<COMPUTES A PRI, SEE DOCUMENTATION FOR DEFINITION >>          <<03001>>08438000
                                                               <<03001>>08440000
   IF  "D" <= TOKEN <= "Z"  THEN                               <<03001>>08442000
      BEGIN << A REGISTER IS GIVEN >>                          <<03001>>08444000
      REG := TRUE;                                             <<03001>>08446000
      PUSH(SBANK);  << GET THE STACK BANK >>                   <<03001>>08448000
      PUSH( DB );                                              <<03001>>08450000
      DELB;   << GET RID OF DB BANK >>                         <<03001>>08452000
      IF  TOKEN = "D"  THEN                                    <<03001>>08454000
         BEGIN  << DL OR DB >>                                 <<03001>>08456000
         CHAR;  << GET THE B OR L >>                           <<03001>>08458000
         IF  TOKEN = "B"  THEN                                 <<03001>>08460000
            BEGIN  << DB >>                                    <<03001>>08462000
            DDEL;  << CUT DB AND SBANK >>                      <<03001>>08464000
            TOS := OLDDB;                                      <<03001>>08466000
            TOS := 0;   << DB REL DB >>                        <<03001>>08468000
            END                                                <<03001>>08470000
         ELSE  IF  TOKEN  = "L"  THEN  PUSH( DL )              <<03001>>08472000
         ELSE  FAIL;  << ILLEGAL REGISTER GIVEN >>             <<03001>>08474000
         END                                                   <<03001>>08476000
      ELSE                                                     <<03001>>08478000
         BEGIN                                                 <<03001>>08480000
         IF  TOKEN = "Q"  THEN                                 <<03001>>08482000
            BEGIN  << Q >>                                     <<03001>>08484000
            DDEL;                                              <<N8581>>08486000
            TOS := MARKER( ENV+1);                             <<N8581>>08488000
            TOS := 0;                                          <<N8581>>08490000
            TOS := -TOS;  << BUILD USER'S Q >>                 <<03001>>08492000
            END                                                <<03001>>08494000
         ELSE  IF  TOKEN = "S"  THEN                           <<03001>>08496000
            BEGIN  << S >>                                     <<03001>>08498000
            DDEL;                                              <<N8581>>08500000
            TOS := MARKER( ENV) - 4D;                          <<N8581>>08502000
            TOS := 0;                                          <<N8581>>08504000
            END                                                <<03001>>08506000
         ELSE  IF  TOKEN = "Z"  THEN  PUSH( Z )                <<03001>>08508000
         ELSE  FAIL;                                           <<03001>>08510000
         END;                                                  <<03001>>08512000
      CHAR;  << SCAN OFF THE REGISTER >>                       <<03001>>08514000
      TOS := TOS+TOS;   << CHANGE DB REL TO ABS >>             <<03001>>08516000
      DS4 := TOS;  << RETURN THE VALUE >>                      <<03001>>08518000
      END                                                      <<03001>>08520000
   ELSE                                                        <<03001>>08522000
      PRI' := NUMBER;                                          <<03001>>08524000
                                                               <<03001>>08526000
DOUBLE SUBROUTINE FACTOR;                                      <<03001>>08528000
<<=====================>>                                      <<03001>>08530000
    <<COMPUTES A FACTOR:    >>                                 <<03001>>08532000
    <<FACTOR ::= PRI' ! FACTOR * PRI' >>                       <<03001>>08534000
BEGIN                                                          <<03001>>08536000
   TOS := PRI';   <<GET A PRIMARY>>                            <<03001>>08538000
L: IF TOKEN = "*" THEN                                         <<03001>>08540000
      BEGIN                                                    <<03001>>08542000
      CHAR;  <<SCAN OFF THE - >>                               <<03001>>08544000
      TOS := PRI';                                             <<03001>>08546000
      IF REG                                                   <<03001>>08548000
      THEN ASMB(DELB,MPY)                                      <<03001>>08550000
      ELSE ASMB(DMUL);                                         <<03001>>08552000
      GO L;                                                    <<03001>>08554000
      END;                                                     <<03001>>08556000
   IF TOKEN = "/" THEN                                         <<N8581>>08558000
      BEGIN                                                    <<N8581>>08560000
      CHAR;    << SCAN OFF THE / >>                            <<N8581>>08562000
      TOS := PRI';                                             <<N8581>>08564000
      IF REG THEN ASMB( DELB, DIV, DEL)                        <<N8581>>08566000
         ELSE ASMB( DDIV; DDEL);                               <<N8581>>08568000
      GO L;                                                    <<N8581>>08570000
      END;                                                     <<N8581>>08572000
   DS4 := TOS;                                                 <<03001>>08574000
END;                                                           <<03001>>08576000
                                                               <<03001>>08578000
                                                               <<03001>>08580000
DOUBLE SUBROUTINE SEXP;                                        <<03001>>08582000
<<=====================>>                                      <<03001>>08584000
<< COMPUTES A <SEXP> >>                                        <<03001>>08586000
   BEGIN                                                       <<03001>>08588000
   TOS := FACTOR;                                              <<03001>>08590000
L: IF  TOKEN = "+"  THEN                                       <<03001>>08592000
      BEGIN                                                    <<03001>>08594000
      CHAR;  << SCAN OFF + >>                                  <<03001>>08596000
      TOS := FACTOR;                                           <<03001>>08598000
      IF REG THEN ASMB(DELB,ADD) ELSE ASMB(DADD);              <<03001>>08600000
      GO L;                                                    <<03001>>08602000
      END;                                                     <<03001>>08604000
   IF  TOKEN = "-"  THEN                                       <<03001>>08606000
      BEGIN                                                    <<03001>>08608000
      CHAR;  << SCAN OFF THE - >>                              <<03001>>08610000
      TOS := FACTOR;                                           <<03001>>08612000
      IF REG THEN ASMB(DELB,SUB) ELSE ASMB(DSUB);              <<03001>>08614000
      GO L;                                                    <<03001>>08616000
      END;                                                     <<03001>>08618000
   IF (TOKEN="I") OR (TOKEN=":") THEN                          <<03001>>08620000
      BEGIN  << INDIRECT >>                                    <<03001>>08622000
      CHAR;  << SCAN OFF THE I >>                              <<03001>>08624000
      ASMB(LSEA);  << GET THE ADDRESS' CONTENTS >>             <<03001>>08626000
      DELB; DELB;  << CUT ADDRESS >>                           <<03001>>08628000
      IF REG THEN ASMB(LDD OLDDB; CAB,ADD) ELSE                <<03001>>08630000
      ASMB( ZERO,XCH );  << FORM A DOUBLE >>                   <<03001>>08632000
      GO L;                                                    <<03001>>08634000
      END;                                                     <<03001>>08636000
   DS4 := TOS;                                                 <<03001>>08638000
   END;                                                        <<03001>>08640000
                                                               <<03001>>08642000
                                                               <<03001>>08644000
                                                               <<03001>>08646000
DOUBLE SUBROUTINE  EXP;                                        <<03001>>08648000
<<====================>>                                       <<03001>>08650000
<< COMPUTES A <EXP>  >>                                        <<03001>>08652000
   BEGIN                                                       <<03001>>08654000
   REG := FALSE;                                               <<03001>>08656000
   TOS := SEXP;                                                <<03001>>08658000
   IF  TOKEN = "."  THEN                                       <<03001>>08660000
      BEGIN                                                    <<03001>>08662000
      DUPLICATE;                                               <<03001>>08664000
      CST := S0;                                               <<03001>>08666000
      CHAR;                                                    <<03001>>08668000
      IF ABSENT'CST(CST)                                       <<03001>>08670000
      THEN BEGIN   <<SEG IS ABSENT- ABS ADDR NOT POSSIBLE>>    <<03001>>08672000
          DDEL; DEL;   <<CLEAN UP STACK>>                      <<03001>>08674000
          TOS := EXP;  <<GET OFFSET IN SEG>>                   <<03001>>08676000
          P := S0;     <<SAVE P>>                              <<03001>>08678000
          S1 := CST;   <<FORM  S1=CST, S0=P(OFFSET) PAIR>>     <<03001>>08680000
          END                                                  <<03001>>08682000
      ELSE BEGIN  <<SEG PRESENT- FORM ABSOLUTE ADDR>>          <<03001>>08684000
         TOS := CST'ADDR(*);                                   <<03001>>08686000
         TOS := SEXP;                                          <<03001>>08688000
         P := S0;                                              <<03001>>08690000
         IF P<0 THEN FAIL;                                     <<03001>>08692000
         ASMB(DADD);                                           <<03001>>08694000
        END;  <<SEG IS PRESENT>>                               <<03001>>08696000
                                                               <<03001>>08698000
      END                                                      <<03001>>08700000
   ELSE IF TOKEN = "@"                                         <<03001>>08702000
        THEN BEGIN                                             <<03001>>08704000
            DELB;                                              <<03001>>08706000
            CHAR;                                              <<03001>>08708000
            TOS := SEXP;                                       <<03001>>08710000
            DELB;                                              <<03001>>08712000
         END;                                                  <<03001>>08714000
                                                               <<03001>>08716000
   DS4 := TOS;                                                 <<03001>>08718000
   END;                                                        <<03001>>08720000
                                                               <<03001>>08722000
SUBROUTINE GETP1;                                              <<03001>>08724000
<<==============>>                                             <<03001>>08726000
    <<LOADS GLOBAL P1 WITH AN EXP>>                            <<03001>>08728000
BEGIN                                                          <<03001>>08730000
    P1 := EXP;      <<LOAD P1 WITH EXP>>                       <<03001>>08732000
END;                                                           <<03001>>08734000
                                                               <<03001>>08736000
SUBROUTINE GETP2;                                              <<03001>>08738000
<<==============>>                                             <<03001>>08740000
    <<LOADS GLOBAL P2 WITH OPTIONAL EXP>>                      <<03001>>08742000
BEGIN                                                          <<03001>>08744000
    IF TOKEN =","  <<DOES IT LOOK LIKE WE HAVE ANOTHER>>       <<03001>>08746000
    THEN BEGIN                                                 <<03001>>08748000
       CHAR;       <<SCAN OFF THE COMMA>>                      <<03001>>08750000
       P2 := EXP;  <<LOAD P2 WITH AN EXP>>                     <<03001>>08752000
       P2F := TRUE;                                            <<03001>>08754000
    END;                                                       <<03001>>08756000
END;                                                           <<03001>>08758000
                                                               <<03001>>08760000
SUBROUTINE GETWIDTH;                                           <<03001>>08762000
<<=================>>                                          <<03001>>08764000
    <<LOADS GLOBAL WIDTH WITH AN INTEGER EXP>>                 <<03001>>08766000
BEGIN                                                          <<03001>>08768000
    IF TOKEN = ","                                             <<03001>>08770000
    THEN BEGIN                                                 <<03001>>08772000
       CHAR;       <<SCAN OFF THE COMMA>>                      <<03001>>08774000
       TOS := EXP;    <<GET DOUBLE EXP>>                       <<03001>>08776000
       DELB;          <<CHUCK HI PART>>                        <<03001>>08778000
       WIDTH := TOS;  <<STORE IN GLOBAL WIDTH>>                <<03001>>08780000
    END;                                                       <<03001>>08782000
END;                                                           <<03001>>08784000
                                                               <<03001>>08786000
SUBROUTINE GETMODE;                                            <<03001>>08788000
<<================>>                                           <<03001>>08790000
    <<CHECKS FOR OPTIONAL MODE PARAMETER:"0,I,H,A,B">>         <<03001>>08792000
    <<FOR OUTPUT MODES:OCTAL,DECIMAL,HEX,ASCII,BINARY>>        <<03001>>08794000
BEGIN                                                          <<03001>>08796000
    IF TOKEN = ","                                             <<03001>>08798000
    THEN BEGIN                                                 <<03001>>08800000
        CHAR;       <<SCAN OFF THE COMMA>>                     <<03001>>08802000
        X := NUM'MODES -1;                                     <<03001>>08804000
        MODE := OCTAL'MODE;   <<DEFAULT>>                      <<03001>>08806000
                                                               <<03001>>08808000
        DO BEGIN                                               <<03001>>08810000
           IF TOKEN = MODES(X)                                 <<03001>>08812000
           THEN BEGIN                                          <<03001>>08814000
              MODE := X;                                       <<03001>>08816000
              GO FND;                                          <<03001>>08818000
            END;                                               <<03001>>08820000
           X := X - 1;                                         <<03001>>08822000
        END UNTIL <;                                           <<03001>>08824000
                                                               <<03001>>08826000
        PIN := PIN -2;   <<TRICKY!! BACK UP 2 BYTES>>          <<03001>>08828000
           <<NEGATE THE EFFECT OF OUR PREV CHAR PEEK>>         <<03001>>08830000
           <<GAMES WITH PTR TO INPUT BUFFER>>                  <<03001>>08832000
                                                               <<03001>>08834000
FND:    CHAR;   <<IF FOUND,SCAN OFF THE MODE>>                 <<03001>>08836000
                <<IF NOT FOUND,RESET TOKEN TO ORIG COMMA>>     <<03001>>08838000
    END;  <<IF TOKEN = COMMA>>                                 <<03001>>08840000
END;  <<SUBROUTINE GETMODE>>                                   <<03001>>08842000
SUBROUTINE ADDBASE;                                            <<H8649>>08844000
BEGIN                                                          <<H8649>>08846000
   IF CST = BASECODE1 THEN                                     <<H8649>>08848000
      P := P+BASECODE2;                                        <<H8649>>08850000
END;                                                           <<H8649>>08852000
                                                               <<03001>>08854000
                                                               <<03001>>08856000
$PAGE "HELP          BREAKPOINT ROUTINES"                      <<03001>>08858000
SUBROUTINE  IMPCST;                                            <<03001>>08860000
<<===============>>                                            <<03001>>08862000
<<CHECKS FOR AN IMPLIED CST IN THE C OR B COMMANDS>>           <<03001>>08864000
   IF  CST = 0  THEN                                           <<03001>>08866000
      BEGIN  << IMPLIED CST >>                                 <<03001>>08868000
      CST := SMSTA.(8:8);                                      <<03001>>08870000
      TOS := P1;  DELB;  P := TOS;                             <<03001>>08872000
      IF P<0 THEN FAIL;                                        <<03001>>08874000
      END;                                                     <<03001>>08876000
                                                               <<03001>>08878000
                                                               <<03001>>08880000
INTEGER SUBROUTINE FIND'BRKPT(TYPE,CST,P);                     <<03001>>08882000
<<=====================================>>                      <<03001>>08884000
   VALUE TYPE,CST,P;  INTEGER TYPE,CST,P;                      <<03001>>08886000
                                                               <<03001>>08888000
BEGIN                                                          <<03001>>08890000
                                                               <<03001>>08892000
  <<THIS ROUTINE IS USED TO FIND ENTRIES IN THE BP'TAB>>       <<03001>>08894000
  <<IF TYPE,CST, AND P MATCH STORED BRKPT ENTRY VALUES>>       <<03001>>08896000
  <<THEN FIND'BRKPT RETURNS AS THE INDEX OF THE FIRST>>        <<03001>>08898000
  <<WORD OF THE ENTRY IN THE BP'TAB, OTHERWISE AS -1 >>        <<03001>>08900000
                                                               <<03001>>08902000
  I := 0;   <<START OF TABLE>>                                 <<03001>>08904000
  FIND'BRKPT := -1;   <<ASSUME THE WORST>>                     <<03001>>08906000
                                                               <<03001>>08908000
  DO                                                           <<03001>>08910000
    IF BPTAB (I+BP'TYPE'CST).BP'CST = CST AND                  <<03001>>08912000
       BPTAB (I+BP'TYPE'CST).BP'TYPE = TYPE AND                <<03001>>08914000
       BPTAB (I+BP'ADDR) = P                                   <<03001>>08916000
    THEN BEGIN                                                 <<03001>>08918000
       FIND'BRKPT := I;  <<RETURN INDEX>>                      <<03001>>08920000
       RETURN;                                                 <<03001>>08922000
     END                                                       <<03001>>08924000
  UNTIL (I:=I+BPT'ENTRY'SIZE) = BPT'TBL'SIZE;                  <<03001>>08926000
END;                                                           <<03001>>08928000
                                                               <<03001>>08930000
                                                               <<03001>>08932000
                                                               <<03001>>08934000
                                                               <<03001>>08936000
LOGICAL SUBROUTINE CHECK'BRKPT'INSTRUCTION;                    <<03001>>08938000
<<========================================>>                   <<03001>>08940000
BEGIN                                                          <<03001>>08942000
    <<THIS ROUTINE EXAMINES THE CODE INSTRUCTION >>            <<03001>>08944000
    <<CONTAINED IN GLOBAL VARIABLE: "BRKPT'INSTR">>            <<03001>>08946000
    <<IF THE INSTR CAN BE REPLACED BY A BRKPT,   >>            <<03001>>08948000
    <<THEN RETURNS TRUE ELSE FALSE.              >>            <<03001>>08950000
                                                               <<03001>>08952000
  CHECK'BRKPT'INSTRUCTION := FALSE;  <<ASSUME FAILURE>>        <<03001>>08954000
  IF BRKPT'INSTR.(0:4) = %14  <<BRANCHES>>                     <<03001>>08956000
  THEN RETURN;                                                 <<03001>>08958000
  IF BRKPT'INSTR.(0:4) = 3  AND                                <<03001>>08960000
     1 <= BRKPT'INSTR.(4:4) <= 4                               <<03001>>08962000
  THEN RETURN;                                                 <<03001>>08964000
  IF BRKPT'INSTR.(0:4) = 1                                     <<03001>>08966000
  THEN BEGIN                                                   <<03001>>08968000
     TOS := BRKPT'INSTR;                                       <<03001>>08970000
     TOS := %117001703D;                                       <<03001>>08972000
     TOS := TOS&DCSL(S2.(5:5));                                <<03001>>08974000
     IF <                                                      <<03001>>08976000
     THEN BEGIN                                                <<03001>>08978000
       DDEL; <<DELETE MAGIC CONSTANT>>                         <<03001>>08980000
       DEL;  <<DELETE INSTRUCTION>>                            <<03001>>08982000
       RETURN;                                                 <<03001>>08984000
      END;                                                     <<03001>>08986000
     DDEL;  <<DELETE MAGIC CONSTANT>>                          <<03001>>08988000
     DEL;   <<DELETE INSTRUCTION>>                             <<03001>>08990000
   END;                                                        <<03001>>08992000
                                                               <<03001>>08994000
   CHECK'BRKPT'INSTRUCTION := TRUE;                            <<03001>>08996000
      <<GETTING THIS FAR IMPLIES IT IS O.K.>>                  <<03001>>08998000
END;  <<SUBROUTINE CHECK'BRKPT'INSTR>>                         <<03001>>09000000
                                                               <<03001>>09002000
                                                               <<03001>>09004000
                                                               <<03001>>09006000
SUBROUTINE PUT'BRKPT'INTO'CODE;                                <<03001>>09008000
<<============================>>                               <<03001>>09010000
BEGIN                                                          <<03001>>09012000
                                                               <<03001>>09014000
  <<ASUMES THE FOLLOWING GLOBALS ARE LOADED:   >>              <<03001>>09016000
  <<   BRKPT'ADDR    ABS ADDR OF THE INSTR     >>              <<03001>>09018000
  <<   CST           SEGMENT NUMBER            >>              <<03001>>09020000
  <<   P             PB RELATIVE ADDR OF INSTR >>              <<03001>>09022000
  <<                                           >>              <<03001>>09024000
  <<LOADS A BRKPT INTO THE CODE                >>              <<03001>>09026000
                                                               <<03001>>09028000
                                                               <<03001>>09030000
   TOS := BRKPT'ADDR -                                         <<03001>>09032000
     DOUBLE(P)+DOUBLE(F(F(0)+CST*CST'SIZE).(4:12)*4)-1D;       <<03001>>09034000
   << THE ABOVE MONSTER IS THE ADDRESS OF PL >>                <<03001>>09036000
   << CHECK FOR P IN BOUNDS >>                                 <<03001>>09038000
   IF  BRKPT'ADDR > DS1                                        <<03001>>09040000
   THEN BEGIN                                                  <<03001>>09042000
      MOVE IO := "ADDRESS OUT OF BOUNDS";                      <<03001>>09044000
      BUFX := 21;                                              <<03001>>09046000
      PRINTLINE(0);                                            <<03001>>09048000
      DDEL;                                                    <<03001>>09050000
      RETURN;                                                  <<03001>>09052000
   END;                                                        <<03001>>09054000
                                                               <<03001>>09056000
   ASMB(LSEA);  << GET STT SIZE >>                             <<03001>>09058000
   X := TOS.(8:8);                                             <<03001>>09060000
   J :=  I := 0;  << INITIAL PL VALUES >>                      <<03001>>09062000
   DO                                                          <<03001>>09064000
      BEGIN  << SEARCH THE STT >>                              <<03001>>09066000
      I := I+1;                                                <<03001>>09068000
      S0 := S0-1;  << BACK UP ADDRESS POINTER >>               <<03001>>09070000
      ASMB(LSEA);  << GET THE LABEL >>                         <<03001>>09072000
      IF  TOS = @HELP  THEN  J := I;  << FOUND IT >>           <<03001>>09074000
      END                                                      <<03001>>09076000
   UNTIL  DXBZ;                                                <<03001>>09078000
   PUSH(STATUS);  IF  TOS.(8:8) = CST  THEN  J := @HELP.(1:7); <<03001>>09080000
   IF  J = 0                                                   <<03001>>09082000
   THEN BEGIN                                                  <<03001>>09084000
      MOVE IO:="BRKPT NOT SET";                                <<03001>>09086000
      BUFX := 13;                                              <<03001>>09088000
      PRINTLINE(0);                                            <<03001>>09090000
      DDEL;                                                    <<03001>>09092000
      RETURN;                                                  <<03001>>09094000
    END;                                                       <<03001>>09096000
                                                               <<03001>>09098000
   DDEL;  << GET RID OF THE ADDRESS INTO THE STT >>            <<03001>>09100000
                                                               <<03001>>09102000
   TOS := BRKPT'ADDR;   <<ABS ADDR OF INSTRUCTION TO REPLACE>> <<03001>>09104000
   TOS := J+%031000;    <<FORM THE PCAL TO HELP>>              <<03001>>09106000
   ASMB (SSEA);         <<STORE IT>>                           <<03001>>09108000
   DDEL;                <<GET RID OF THE ADDRESS>>             <<03001>>09110000
                                                               <<03001>>09112000
END;  <<SUBROUTINE PUT'BRKPT'INTO'CODE>>                       <<03001>>09114000
                                                               <<03001>>09116000
                                                               <<03001>>09118000
SUBROUTINE SET'BRKPT(TYPE'OF'BRKPT);                           <<03001>>09120000
<<===============================>>                            <<03001>>09122000
   VALUE TYPE'OF'BRKPT; INTEGER TYPE'OF'BRKPT;                 <<03001>>09124000
BEGIN                                                          <<03001>>09126000
  <<IF ROOM EXISTS IN THE BREAKPOINT TABLE, THIS WILL SET>>    <<03001>>09128000
  <<A BREAKPOINT AT A SPECIFIED "CST" AND "P".           >>    <<03001>>09130000
  <<AT ENTRY, THE FOLLOWING GLOBALS SHOULD BE LOADED:    >>    <<03001>>09132000
  <<   "CST"    THE CST FOR THE BREAKPOINT               >>    <<03001>>09134000
  <<   "P"      PB RELATIVE ADDRESS FOR THE BREAKPOINT   >>    <<03001>>09136000
  <<                                                     >>    <<03001>>09138000
  << IF THE CST IS PRESENT, THEN A  BREAKPOINT WILL      >>    <<03001>>09140000
  << BE SET, AND THE BREAK PUT INTO THE CODE SEGMENT .   >>    <<03001>>09142000
  << IF THE CST IS ABSENT, THEN AN ABSENT-BREAKPOINT WILL>>    <<03001>>09144000
  << BE LOADED INTO THE BREAKPOINT TABLE, AND AS SOON AS >>    <<03001>>09146000
  << THE SEGMENT IS MADE PRESENT, THE ACTUAL BREAK WILL  >>    <<03001>>09148000
  << BE LOADED INTO THE CODE.                            >>    <<03001>>09150000
                                                               <<03001>>09152000
                                                               <<03001>>09154000
                         <<MAKE SURE WE HAVE ROOM IN TABLE>>   <<03001>>09156000
                         <<-------------------------------->>  <<03001>>09158000
                                                               <<03001>>09160000
  IF NUM'BRKPTS >= MAX'BRKPTS -1 <<NO ROOM IN BREAKPOINT TBL>> <<03001>>09162000
  THEN BEGIN                                                   <<03001>>09164000
     MOVE IO := "FULL";                                        <<03001>>09166000
     BUFX := 4;                                                <<03001>>09168000
     PRINTLINE (0);                <<PRINT FULL ERROR>>        <<03001>>09170000
     RETURN;                                                   <<03001>>09172000
   END;                                                        <<03001>>09174000
                                                               <<03001>>09176000
                         <<TRY TO LOCATE EXISTING BREAKPOINT>> <<03001>>09178000
                         <<--------------------------------->> <<03001>>09180000
                                                               <<03001>>09182000
  BRKPT'INX := FIND'BRKPT( TYPE'OF'BRKPT,CST,P); <<EXISTING?>> <<03001>>09184000
  IF BRKPT'INX <> -1     <<IF IT EXISTS,THEN ERROR>>           <<03001>>09186000
  THEN BEGIN                                                   <<03001>>09188000
    MOVE IO := "ALREADY SET";                                  <<03001>>09190000
    BUFX := 11;                                                <<03001>>09192000
    PRINTLINE (0);                 <<PRINT ALREADY SET ERROR>> <<03001>>09194000
    RETURN;                                                    <<03001>>09196000
   END;                                                        <<03001>>09198000
                                                               <<03001>>09200000
                        <<GET FREE ENTRY FROM BRKPT-TABLE>>    <<03001>>09202000
                        <<------------------------------->>    <<03001>>09204000
                                                               <<03001>>09206000
  TOS := (IF TYPE'OF'BRKPT = FAKE'BRKPT                        <<03001>>09208000
          THEN FAKE'BRKPT     <<ALLOC THE FAKE>>               <<03001>>09210000
          ELSE EMPTY'BRKPT);  <<EMPTY BRKPT>>                  <<03001>>09212000
                                                               <<03001>>09214000
  BRKPT'INX := FIND'BRKPT( S0 <<TYPE>>,0,0); <<ALLOC A BRKPT>> <<03001>>09216000
  IF BRKPT'INX = -1    <<SOMETHING SCREWED UP WITH COUNT>>     <<03001>>09218000
  THEN BEGIN                                                   <<03001>>09220000
    DEL;    <<DELETE THE TYPE>>                                <<03001>>09222000
    MOVE IO := "FULL";                                         <<03001>>09224000
    BUFX := 4;                                                 <<03001>>09226000
    PRINTLINE(0);                                              <<03001>>09228000
    RETURN;                                                    <<03001>>09230000
  END;                                                         <<03001>>09232000
  DEL;   <<DELETE THE TYPE>>                                   <<03001>>09234000
                                                               <<03001>>09236000
                         <<CHECK TO SEE IF SEGMENT IS ABSENT>> <<03001>>09238000
                         <<--------------------------------->> <<03001>>09240000
                                                               <<03001>>09242000
  IF ABSENT'CST( CST )    <<IS SEGMENT ABSENT? >>              <<03001>>09244000
  THEN BEGIN                                                   <<03001>>09246000
    BRKPT'TYPE := USER'BRKPT;   <<WILL SET ABSENT-BRKPT>>      <<03001>>09248000
     <<WE WILL ALWAYS CHECK TO SEE IF SEG IS STILL PRESENT>>   <<03001>>09250000
    BRKPT'INSTR := -1;             <<DONT CARE ABOUT INSTR>>   <<03001>>09252000
    MOVE IO := "BRKPT SET FOR ABSENT SEGMENT";                 <<03001>>09254000
    BUFX := 24;                                                <<03001>>09256000
    PRINTLINE (0);                                             <<03001>>09258000
    END                                                        <<03001>>09260000
  ELSE BEGIN    <<SEGMENT IS IN CORE>>                         <<03001>>09262000
    BRKPT'TYPE := TYPE'OF'BRKPT;   <<USER OR FAKE BRKPT>>      <<03001>>09264000
                                                               <<03001>>09266000
    BRKPT'ADDR := CST'ADDR( CST) + DOUBLE(P);                  <<03001>>09268000
                <<DETERMINE ABS ADDR OF INSTRUCTION>>          <<03001>>09270000
                                                               <<03001>>09272000
    TOS := BRKPT'ADDR;    <<ABS ADDR OF INSTR TO REPLACE>>     <<03001>>09274000
    ASMB (LSEA);          <<GET THE INSTRUCTION>>              <<03001>>09276000
    BRKPT'INSTR := TOS;    <<SAVE THE INSTR>>                  <<03001>>09278000
    DDEL;                 <<DELETE ADDR OF INSTR>>             <<03001>>09280000
                                                               <<03001>>09282000
                          <<CAN WE SET BREAKPOINT AT THIS>>    <<03001>>09284000
                          <<PARTICULAR INSTR IN THE CODE>>     <<03001>>09286000
                          <<IF NOT PRINT ERROR>>               <<03001>>09288000
    IF TYPE'OF'BRKPT = USER'BRKPT  AND   <<ON USER BP >>       <<03001>>09290000
       NOT CHECK'BRKPT'INSTRUCTION    <<CHECK OUT INSTR>>      <<03001>>09292000
    THEN BEGIN                                                 <<03001>>09294000
      MOVE IO := "BAD INSTR FOR BRKPT AT: ";                   <<03001>>09296000
      BUFX := 24;                                              <<03001>>09298000
      OCTNUMOUT(DOUBLE(CST),2);                                <<03001>>09300000
      MOVE IO(BUFX) := ".";                                    <<03001>>09302000
      BUFX := BUFX + 1;                                        <<03001>>09304000
      OCTNUMOUT(DOUBLE(P),5);                                  <<03001>>09306000
      PRINTLINE (0);      <<PRINT ERROR>>                      <<03001>>09308000
      RETURN;                                                  <<03001>>09310000
    END;                                                       <<03001>>09312000
                                                               <<03001>>09314000
                         <<PUT BREAKPOINT INTO CODE SEGMENT>>  <<03001>>09316000
                         <<-------------------------------->>  <<03001>>09318000
                                                               <<03001>>09320000
    PUT'BRKPT'INTO'CODE;                                       <<03001>>09322000
                                                               <<03001>>09324000
 END;  <<SEGMENT IS IN CORE>>                                  <<03001>>09326000
                                                               <<03001>>09328000
                         <<LOAD BREAKPOINT TABLE ENTRY>>       <<03001>>09330000
                         <<--------------------------->>       <<03001>>09332000
                                                               <<03001>>09334000
 BPTAB( BRKPT'INX + BP'TYPE'CST).BP'TYPE := BRKPT'TYPE;        <<03001>>09336000
                         <<LOAD TYPE OF BREAKPOINT>>           <<03001>>09338000
                                                               <<03001>>09340000
 BPTAB( BRKPT'INX + BP'TYPE'CST).BP'CST := CST;                <<03001>>09342000
                         <<LOAD CST FOR BREAKPOINT>>           <<03001>>09344000
                                                               <<03001>>09346000
 BPTAB( BRKPT'INX + BP'ADDR) := P;                             <<03001>>09348000
                         <<LOAD P FOR BREAKPOINT>>             <<03001>>09350000
                                                               <<03001>>09352000
 BPTAB( BRKPT'INX + BP'INSTR) := BRKPT'INSTR;                  <<03001>>09354000
                         <<LOAD REPLACED INSTR>>               <<03001>>09356000
                                                               <<03001>>09358000
 NUM'BRKPTS := NUM'BRKPTS + 1;   <<ONE LESS FREE ENTRY>>       <<03001>>09360000
                                                               <<03001>>09362000
END;  <<SUBROUTINE BREAK>>                                     <<03001>>09364000
                                                               <<03001>>09366000
                                                               <<03001>>09368000
SUBROUTINE CLEAR'BRKPT( TYPE'OF'BRKPT);                        <<03001>>09370000
<<===================================>>                        <<03001>>09372000
   VALUE TYPE'OF'BRKPT; INTEGER TYPE'OF'BRKPT;                 <<03001>>09374000
BEGIN                                                          <<03001>>09376000
                                                               <<03001>>09378000
  <<THIS ROUTINE WILL CLEAR A BREAKPOINT.                >>    <<03001>>09380000
  <<AT ENTRY, THE FOLLOWING GLOBALS SHOULD BE LOADED:    >>    <<03001>>09382000
  <<   "CST"    THE CST FOR THE BRKPT TO BE CLEARED      >>    <<03001>>09384000
  <<   "P"      PB RELATIVE ADDRESS FOR THE BREAKPOINT   >>    <<03001>>09386000
  <<                                                     >>    <<03001>>09388000
  << IF THE SEGMENT IS STILL PRESENT, THEN THE REPLACED  >>    <<03001>>09390000
  << INSTRUCTION WILL BE RESTORED, AND THE ENTRY IN THE  >>    <<03001>>09392000
  << BREAKPOINT TABLE WILL BE CLEARED.                   >>    <<03001>>09394000
  << IF THE CST IS ABSENT, THEN THE ENTRY IN THE TABLE   >>    <<03001>>09396000
  << WILL BE CLEARED. WHEN THE SEMENT IS LATER MADE      >>    <<03001>>09398000
  << PRESENT, IT WILL BE BROUGHT INTO CORE IN ITS        >>    <<03001>>09400000
  << ORIGINAL  (BREAKPOINT-LESS) CONDITION.              >>    <<03001>>09402000
                                                               <<03001>>09404000
  BRKPT'INX := FIND'BRKPT( TYPE'OF'BRKPT,CST,P);               <<03001>>09406000
  IF BRKPT'INX = -1    <<NOT FOUND>>                           <<03001>>09408000
  THEN BEGIN                                                   <<03001>>09410000
     MOVE IO := "NOT FOUND";                                   <<03001>>09412000
     BUFX := 9;                                                <<03001>>09414000
     PRINTLINE (0);                                            <<03001>>09416000
     RETURN;                                                   <<03001>>09418000
   END;                                                        <<03001>>09420000
                                                               <<03001>>09422000
  IF NOT ABSENT'CST(CST)    <<HAS SEGMENT BEEN SWAPPED>>       <<03001>>09424000
  THEN BEGIN                                                   <<03001>>09426000
                 <<BRKPT IS SET IN CODE-REPLACE INSTR>>        <<03001>>09428000
     TOS := CST'ADDR(CST) + DOUBLE (P);                        <<03001>>09430000
                 <<ABSOLUTE ADDR OF INSTR TO REPLACE>>         <<03001>>09432000
                                                               <<03001>>09434000
     TOS := BPTAB(BRKPT'INX+BP'INSTR);  <<INSTRUCTION>>        <<03001>>09436000
     ASMB (SSEA);   <<RESTORE ORIGINAL INSTRUCTION>>           <<03001>>09438000
     DDEL;          <<DELETE ADDRESS>>                         <<03001>>09440000
   END;                                                        <<03001>>09442000
                                                               <<03001>>09444000
         <<IF WE CLEAR THE FAKE BREAKPOINT, THEN WE MUST>>     <<03001>>09446000
         <<LEAVE THE TYPE AS FAKE'BRKPT, SINCE THE FAKE >>     <<03001>>09448000
         <<MUST REMAIN AS THE FIRST ENTRY, USED OR NOT  >>     <<03001>>09450000
                                                               <<03001>>09452000
  BPTAB(BRKPT'INX+BP'TYPE'CST).BP'TYPE :=                      <<03001>>09454000
     ( IF TYPE'OF'BRKPT = FAKE'BRKPT                           <<03001>>09456000
       THEN FAKE'BRKPT                                         <<03001>>09458000
       ELSE EMPTY'BRKPT );                                     <<03001>>09460000
                                                               <<03001>>09462000
  BPTAB(BRKPT'INX+BP'TYPE'CST).BP'CST := EMPTY'BRKPT;          <<03001>>09464000
  BPTAB(BRKPT'INX+BP'ADDR)     := EMPTY'BRKPT;                 <<03001>>09466000
  BPTAB(BRKPT'INX+BP'INSTR) := <<EMPTY'BRKPT>> %5555;          <<03001>>09468000
         <<CLEAR TYPE,CST,ADDR, & INSTR IN BREAKPOINT TBL>>    <<03001>>09470000
                                                               <<03001>>09472000
  NUM'BRKPTS := NUM'BRKPTS -1 ;  <<FREE THE ENTRY>>            <<03001>>09474000
                                                               <<03001>>09476000
END;                                                           <<03001>>09478000
                                                               <<03001>>09480000
                                                               <<03001>>09482000
                                                               <<03001>>09484000
SUBROUTINE BRKPT'MAKE'PRESENT;                                 <<03001>>09486000
<<===========================>>                                <<03001>>09488000
BEGIN                                                          <<03001>>09490000
  <<PROCEDURE MAKE'PRESENT PUSHED THE NEW SEG NUMBER>>         <<03001>>09492000
  <<PRIOR TO CALLING HELP.  NEW'PRESENT'SEG = Q-4     >>       <<03001>>09494000
  << ALL BREAKPOINT ENTRIES (FOR THE PREV ABSENT SEG) >>       <<03001>>09496000
  << IN THE BREAKPOINT TABLE WHICH ARE SET FOR THAT   >>       <<03001>>09498000
  << SEGMENT  (USER OR ABSENT) WILL BE RESET FOR THIS >>       <<03001>>09500000
  << FRESH NEW SEGMENT OF THE CODE                    >>       <<03001>>09502000
                                                               <<03001>>09504000
                                                               <<03001>>09506000
  CST := NEW'PRESENT'SEG;    <<PASSED BY MAKE'PRESENT>>        <<03001>>09508000
         <<LOCATED AT Q-4>>                                    <<03001>>09510000
                                                               <<03001>>09512000
                                                               <<03001>>09514000
IF BP'DEBUG = 1                                                <<03001>>09516000
THEN BEGIN                                                     <<03001>>09518000
MOVE IO:="SEG: ";                                              <<03001>>09520000
BUFX :=5;                                                      <<03001>>09522000
OCTNUMOUT(DOUBLE(CST),2);                                      <<03001>>09524000
PRINTLINE(0);        <<   DEBUGGING !!!!!!!!    >>             <<03001>>09526000
END;                                                           <<03001>>09528000
                                                               <<03001>>09530000
  BRKPT'INX := 0;    <<START AT BEGINNING OF BPTAB>>           <<03001>>09532000
                                                               <<03001>>09534000
  DO BEGIN           <<SEARCH THE BREAKPOINT TABLE>>           <<03001>>09536000
                                                               <<03001>>09538000
     TOS := BRKPT'INX;     <<SAVE THE GLOBAL INDEX>>           <<03001>>09540000
                                                               <<03001>>09542000
     IF BPTAB(BRKPT'INX+BP'TYPE'CST).BP'CST=CST <<SAME SEG?>>  <<03001>>09544000
        AND BPTAB(BRKPT'INX+BP'TYPE'CST).BP'TYPE<>FAKE'BRKPT   <<03001>>09546000
     THEN BEGIN    <<FOUND ONE TO CORRECT>>                    <<03001>>09548000
                                                               <<03001>>09550000
        P := BPTAB(BRKPT'INX + BP'ADDR);  <<GET ADDR>>         <<03001>>09552000
                                                               <<03001>>09554000
        IF BP'DEBUG = 1   <<DEBUGGING>>                        <<03001>>09556000
        THEN BEGIN                                             <<03001>>09558000
        MOVE IO := "    BRKPT AT P: ";                         <<03001>>09560000
        BUFX := 16;                                            <<03001>>09562000
        OCTNUMOUT(DOUBLE(P),5);                                <<03001>>09564000
        PRINTLINE(0);                                          <<03001>>09566000
          END;                                                 <<03001>>09568000
                                                               <<03001>>09570000
                                                               <<03001>>09572000
        BPTAB (BRKPT'INX +BP'TYPE'CST) := EMPTY'BRKPT;         <<03001>>09574000
        BPTAB (BRKPT'INX +BP'ADDR)     := EMPTY'BRKPT;         <<03001>>09576000
        NUM'BRKPTS := NUM'BRKPTS - 1;                          <<03001>>09578000
           <<WE CANT USE CLEAR-BRKPT ROUTINE SINCE SEG >>      <<03001>>09580000
           <<IS PRESENT AND WE MIGHT ATTEMPT TO REPLACE>>      <<03001>>09582000
           <<THE ORIGINAL INSTRUCTION>>                        <<03001>>09584000
          <<CLEAR OUT THE OLD ENTRY IN THE TABLE>>             <<03001>>09586000
          <<WE WILL SET A NEW ONE>>                            <<03001>>09588000
                                                               <<03001>>09590000
        SET'BRKPT (USER'BRKPT);    <<SET A NEW BREAKPOINT>>    <<03001>>09592000
           <<WE KNOW SEG IS PRESENT, AND TABLE HAS ROOM>>      <<03001>>09594000
           <<FOR THIS NEW ENRTY>>                              <<03001>>09596000
           <<WE HOPE IT IS A LEGAL INSTR FOR A BRKPT>>         <<03001>>09598000
                                                               <<03001>>09600000
      END;  <<WE FOUND AN ENRTY IN SEG TO CORRECT>>            <<03001>>09602000
                                                               <<03001>>09604000
    BRKPT'INX := TOS + BPT'ENTRY'SIZE;                         <<03001>>09606000
         <<RESTORE AND ADVANCE THE TABLE INDEX>>               <<03001>>09608000
                                                               <<03001>>09610000
  END UNTIL BRKPT'INX = BPT'TBL'SIZE;                          <<03001>>09612000
                                                               <<03001>>09614000
END;  <<SUBROUTINE BRKPT'MAKE'PRESENT>>                        <<03001>>09616000
                                                               <<03001>>09618000
                                                               <<03001>>09620000
                                                               <<03001>>09622000
SUBROUTINE BRKPT'MAKE'ABSENT;                                  <<03001>>09624000
<<===========================>>                                <<03001>>09626000
BEGIN                                                          <<03001>>09628000
   <<INITIAL WRITES ITSELF TO DISC, HOPEFULLY WITHOUT BRKPTS>> <<03001>>09630000
   <<THREFORE IT CALL BRKPT-MAKE-ABSENT TO CLEAN UP A COPY>>   <<03001>>09632000
   <<OF A SEG MENT BEFORE WRITING IT TO DISC>>                 <<03001>>09634000
   << AT ENTRY:   Q-5 = 0   (FOR BRKPT MAKE ABSENT) >>         <<03001>>09636000
   <<             Q-4 = SEGMENT NUMBER TO CLEAR>>              <<03001>>09638000
                                                               <<03001>>09640000
                                                               <<03001>>09642000
                                                               <<03001>>09644000
  CST := NEW'PRESENT'SEG;    <<PASSED BY MAKE'PRESENT>>        <<03001>>09646000
         <<LOCATED AT Q-4>>                                    <<03001>>09648000
                                                               <<03001>>09650000
IF BP'DEBUG=1 THEN BEGIN <<DEBUGGING>>                         <<03001>>09652000
MOVE IO:="CLEARING SEG: ";                                     <<03001>>09654000
BUFX :=14;                                                     <<03001>>09656000
OCTNUMOUT(DOUBLE(CST),2);                                      <<03001>>09658000
PRINTLINE(0);        <<   DEBUGGING !!!!!!!!    >>             <<03001>>09660000
END;  <<DEBUGGING>>                                            <<03001>>09662000
  BRKPT'INX := 0;    <<START AT BEGINNING OF BPTAB>>           <<03001>>09664000
                                                               <<03001>>09666000
  DO BEGIN           <<SEARCH THE BREAKPOINT TABLE>>           <<03001>>09668000
                                                               <<03001>>09670000
     TOS := BRKPT'INX;     <<SAVE THE GLOBAL INDEX>>           <<03001>>09672000
                                                               <<03001>>09674000
     IF BPTAB(BRKPT'INX+BP'TYPE'CST).BP'CST=CST <<SAME SEG?>>  <<03001>>09676000
        AND BPTAB(BRKPT'INX+BP'TYPE'CST).BP'TYPE=USER'BRKPT    <<03001>>09678000
     THEN BEGIN    <<FOUND ONE TO CLEAR>>                      <<03001>>09680000
                                                               <<03001>>09682000
        P := BPTAB(BRKPT'INX + BP'ADDR);  <<GET ADDR>>         <<03001>>09684000
        IF BP'DEBUG=1 THEN BEGIN  <<DEBUGGING>>                <<03001>>09686000
        MOVE IO := "    BRKPT AT P: ";                         <<03001>>09688000
        BUFX := 16;                                            <<03001>>09690000
        OCTNUMOUT(DOUBLE(P),5);  END; <<DEBUGGING>>            <<03001>>09692000
        IF NOT ABSENT'CST(CST)                                 <<03001>>09694000
        THEN BEGIN                                             <<03001>>09696000
           TOS := CST'ADDR(CST) +DOUBLE(P);                    <<03001>>09698000
           TOS := BPTAB(BRKPT'INX+BP'INSTR);  <<ORIG INSTR>>   <<03001>>09700000
           ASMB(SSEA);  DDEL;                                  <<03001>>09702000
         END;                                                  <<03001>>09704000
      END; <<FOUND ONE TO CLEAR>>                              <<03001>>09706000
    BRKPT'INX := TOS + BPT'ENTRY'SIZE;                         <<03001>>09708000
         <<RESTORE AND ADVANCE THE TABLE INDEX>>               <<03001>>09710000
  END UNTIL BRKPT'INX = BPT'TBL'SIZE;                          <<03001>>09712000
                                                               <<03001>>09714000
END;  <<SUBROUTINE BRKPT'MAKE'ABSENT>>                         <<03001>>09716000
                                                               <<03001>>09718000
$PAGE "HELP          MISC. SERVICE ROUTINES"                   <<03001>>09720000
                                                               <<03001>>09722000
SUBROUTINE DUMPER( ADDR, COUNT, WIDTH, MODE );                 <<03001>>09724000
<<===========================================>>                <<03001>>09726000
   VALUE ADDR,COUNT,WIDTH,MODE;                                <<03001>>09728000
   DOUBLE ADDR,COUNT;  INTEGER WIDTH,MODE;                     <<03001>>09730000
                                                               <<03001>>09732000
BEGIN                                                          <<03001>>09734000
   CASE MODE OF   <<NUMBER OF OUTPUT VALUES PER LINE>>         <<03001>>09736000
   BEGIN   <<BASED ON THE WIDTH OF OUTPUT AND TERMINAL WIDTH>> <<03001>>09738000
      <<0 OCTAL>>    L := 8;                                   <<03001>>09740000
      <<1 DEC  >>    L := 8;                                   <<03001>>09742000
      <<2 HEX  >>    L := 10;                                  <<03001>>09744000
      <<3 ASCII>>    L := 30;                                  <<03001>>09746000
      <<4 BINARY>>   L := 1;                                   <<03001>>09748000
   END;                                                        <<03001>>09750000
                                                               <<03001>>09752000
                                                               <<03001>>09754000
   DO BEGIN  <<DUMP ALL REQUESTED>>                            <<03001>>09756000
     J := 1;  <<RESET WIDTH COUNTER>>                          <<03001>>09758000
     DO BEGIN  <<DUMP A WIDTH'S WORTH>>                        <<03001>>09760000
                                                               <<03001>>09762000
        IF J = 1   <<FIRST PASS FOR WIDTHS WORTH>>             <<03001>>09764000
        THEN ADDROUT (ADDR)   <<OUTPUT THE START ADDRESS>>     <<03001>>09766000
        ELSE BLANKOUT ( 10 + BANK'BITS);  <<OUTPUT BLANKS>>    <<03001>>09768000
                                                               <<03001>>09770000
        IF MODE= ASCII'MODE                                    <<03001>>09772000
        THEN BEGIN                                             <<03001>>09774000
           IO(BUFX) := %42;   <<LOAD LEADING " >>              <<03001>>09776000
           BUFX := BUFX + 1;                                   <<03001>>09778000
        END;                                                   <<03001>>09780000
                                                               <<03001>>09782000
        I := 1;  <<RESET COUNTER FOR LINE>>                    <<03001>>09784000
        DO BEGIN  <<DUMP A LINES WORTH, "L" ENTRIES>>          <<03001>>09786000
           CUR'VALUE := DLSEA( ADDR );  <<GET VALUE FROM MEM>> <<03001>>09788000
           ADDR := ADDR + 1D;       <<READY FOR NEXT>>         <<03001>>09790000
           COUNT := COUNT -1D;      <<1 LESS TO DUMP>>         <<03001>>09792000
           J := J + 1;         << COUNTER FOR WIDTH >>         <<03001>>09794000
           I := I + 1;         << COUNTER FOR LINE >>          <<03001>>09796000
                                                               <<03001>>09798000
           CASE MODE OF                                        <<03001>>09800000
           BEGIN                                               <<03001>>09802000
             <<0 OCTAL>>  BEGIN                                <<03001>>09804000
                            OCTNUMOUT (CUR'VALUE,6);           <<03001>>09806000
                            BLANKOUT(2);                       <<03001>>09808000
                          END;                                 <<03001>>09810000
                                                               <<03001>>09812000
             <<1 DEC  >>  ;                                    <<03001>>09814000
             <<2 HEX  >>  BEGIN                                <<N8581>>09816000
                            HEXOUT( CUR'VALUE, 4);             <<N8581>>09818000
                            BLANKOUT(2);                       <<N8581>>09820000
                          END;                                 <<N8581>>09822000
                                                               <<03001>>09824000
             <<4 ASCII>>  ASCIINUMOUT (CUR'VALUE);             <<03001>>09826000
                                                               <<03001>>09828000
             <<4 BINARY>> BEGIN                                <<03001>>09830000
                            OCTNUMOUT( CUR'VALUE,6);           <<03001>>09832000
                            BLANKOUT(3);                       <<03001>>09834000
                                                               <<03001>>09836000
                            BYTESOUT( CUR'VALUE);              <<03001>>09838000
                            BLANKOUT(3);                       <<03001>>09840000
                                                               <<03001>>09842000
                            BITSOUT (CUR'VALUE);               <<03001>>09844000
                          END;                                 <<03001>>09846000
                                                               <<03001>>09848000
           END;  <<CASE>>                                      <<03001>>09850000
          END  <<DUMP A LINES WORTH>>                          <<03001>>09852000
        UNTIL (I>L) OR (J>WIDTH)  OR (COUNT = 0D);             <<03001>>09854000
                                                               <<03001>>09856000
        IF MODE = ASCII'MODE                                   <<03001>>09858000
        THEN BEGIN                                             <<03001>>09860000
           IO(BUFX) := %42;  <<LOAD TRAILING " >>              <<03001>>09862000
           BUFX := BUFX + 1;                                   <<03001>>09864000
        END;                                                   <<03001>>09866000
                                                               <<03001>>09868000
        PRINTLINE(0);  <<OUTPUT THE BUFFER,CR-LF, RESET BUFX>> <<03001>>09870000
                                                               <<03001>>09872000
     END UNTIL (J>WIDTH) <<WIDTHS WORTH>> OR (COUNT=0D);       <<03001>>09874000
  END UNTIL COUNT = 0D;  <<REQUESTED AMOUNT DUMPED>>           <<03001>>09876000
                                                               <<03001>>09878000
END;  <<SUBROUTINE DUMPER>>                                    <<03001>>09880000
                                                               <<03001>>09882000
                                                               <<03001>>09884000
SUBROUTINE MODIFIER (ADDR,COUNT);                              <<03001>>09886000
<<==============================>>                             <<03001>>09888000
    VALUE ADDR,COUNT;  DOUBLE ADDR,COUNT;                      <<03001>>09890000
BEGIN                                                          <<03001>>09892000
                                                               <<03001>>09894000
    WHILE COUNT > 0D DO                                        <<03001>>09896000
    BEGIN                                                      <<03001>>09898000
        ADDROUT( ADDR);   <<SHOW ADDRESS>>                     <<03001>>09900000
                                                               <<03001>>09902000
        CUR'VALUE := DLSEA(ADDR);  <<GET EXISTING VALUE>>      <<03001>>09904000
        OCTNUMOUT (CUR'VALUE,6);   <<PRINT IT>>                <<03001>>09906000
        MOVE IO(BUFX) := " _"; <<MODIFY PROMPT>>               <<03001>>09908000
        BUFX := BUFX + 2;      <<BUMP BUFX>>                   <<03001>>09910000
        PRINTLINE ( 1 );    <<STAY ON SAME LINE >>             <<03001>>09912000
                                                               <<03001>>09914000
        TOS := OLDDB;                                          <<03001>>09916000
        ASMB(XCHD);                                            <<03001>>09918000
        READINPUT(INBUF);                                      <<03001>>09920000
        PIN := 0;                                              <<03001>>09922000
        SET (DB);                                              <<03001>>09924000
        CHAR;                                                  <<03001>>09926000
                                                               <<03001>>09928000
        TOS := ADDR;           <<PUSH ADDRESS>>                <<03001>>09930000
        TOS := EXP;            <<GET NEW VALUE>>               <<03001>>09932000
        DELB;                  <<SHORTEN IT>>                  <<03001>>09934000
        ASMB( SSEA);           <<STORE IT>>                    <<03001>>09936000
        DDEL;                  <<DELETE ADDRESS>>              <<03001>>09938000
                                                               <<03001>>09940000
        ADDR := ADDR + 1D;     <<BUMP TO NEXT WORD>>           <<03001>>09942000
        COUNT := COUNT-1D;     <<ONE LESS TO GO>>              <<03001>>09944000
    END;  <<WHILE COUNT > 0>>                                  <<03001>>09946000
END;  <<SUBROUTINE MODIFIER>>                                  <<03001>>09948000
                                                               <<03001>>09950000
                                                               <<03001>>09952000
                                                               <<03001>>09954000
SUBROUTINE  EXIT;                                              <<03001>>09956000
<<==============>>                                             <<03001>>09958000
     <<RETURNS TO THE USER PROGRAM >>                          <<03001>>09960000
 BEGIN                                                         <<03001>>09962000
   P := ENTRY'P.(2:14);   <<RESTORE ENTRY VALUES FOR P,CST>>   <<HELP2>>09964000
   CST := ENTRY'CST;                                           <<03001>>09966000
                                                               <<03001>>09968000
      <<WE WERE POSSIBLY STOPPED AT A USER BREAKPOINT>>        <<03001>>09970000
      <<WHEN WE FIRST ENTERED HELP, AND SHOULD RESTORE>>       <<03001>>09972000
      <<THE ORIG INSTRUCTION.  HOWEVER, DURING THE LAST>>      <<03001>>09974000
      <<SESSION OF USER INTERACTION, THAT VERY BRKPT>>         <<03001>>09976000
      <<COULD HAVE BEEN CLEARED, SO WE MUST CHECK NOW>>        <<03001>>09978000
                                                               <<03001>>09980000
   ENTRY'BRKPT'INX := FIND'BRKPT(USER'BRKPT,CST,P);            <<03001>>09982000
   IF ENTRY'BRKPT'INX <> -1                                    <<03001>>09984000
   THEN BEGIN  <<YES, A USER BRKPT>>                           <<03001>>09986000
                                                               <<03001>>09988000
      <<WE MUST RESTORE THE INSTRUCTION SO EXECUTION CAN >>    <<03001>>09990000
      <<BE RESUMED "THRU" THE BRKPT. WE WILL SET A FAKE >>     <<03001>>09992000
      <<BRKPT AT P+1 (THE NEXT INSTR), AND WHEN WE BREAK>>     <<03001>>09994000
      <<THERE, REINSERT THE USER BRKPT AT P.            >>     <<03001>>09996000
                                                               <<03001>>09998000
      TOS := CST'ADDR( CST) + DOUBLE(P);                       <<03001>>10000000
      TOS := BPTAB(ENTRY'BRKPT'INX + BP'INSTR);                <<03001>>10002000
             <<RESTORE INSTRUCTION AT THE USER-BRKPT>>         <<03001>>10004000
      ASMB(SSEA);  DDEL;                                       <<03001>>10006000
      P := P+1;  << SET A FAKE BREAKPOINT >>                   <<03001>>10008000
      SET'BRKPT(FAKE'BRKPT);                                   <<03001>>10010000
    END;  <<USER BREKPOINT AT ENRTY>>                          <<03001>>10012000
                                                               <<03001>>10014000
   SAVE'BRKPT'TABLE;   <<COPY FROM Q-REL BACK INTO CODE SEG>>  <<03001>>10016000
                                                               <<03001>>10018000
   ASMB( EXIT 0 );                                             <<03001>>10020000
   END;                                                        <<03001>>10022000
                                                               <<03001>>10024000
SUBROUTINE LIST;                                               <<03001>>10026000
<<=============>>                                              <<03001>>10028000
    <<LIST USER SET BREAKPOINTS>>                              <<03001>>10030000
BEGIN                                                          <<03001>>10032000
                                                               <<03001>>10034000
   I := BRKPT'INX := 0;                                        <<03001>>10036000
   DO                                                          <<03001>>10038000
     IF BPTAB(BRKPT'INX+BP'TYPE'CST).BP'TYPE = USER'BRKPT      <<03001>>10040000
     THEN BEGIN                                                <<03001>>10042000
        CST := BPTAB(BRKPT'INX+BP'TYPE'CST).BP'CST;            <<03001>>10044000
        OCTNUMOUT( DOUBLE(CST),3);                             <<03001>>10046000
        MOVE IO(BUFX) := ".";                                  <<03001>>10048000
        BUFX := BUFX+1;                                        <<03001>>10050000
        TOS := DOUBLE(BPTAB(BRKPT'INX+BP'ADDR));               <<03001>>10052000
        OCTNUMOUT( *,5);                                       <<03001>>10054000
        IF ABSENT'CST (CST)                                    <<03001>>10056000
        THEN BEGIN                                             <<03001>>10058000
           MOVE IO(BUFX) := " A";                              <<03001>>10060000
           BUFX := BUFX + 2;                                   <<03001>>10062000
         END;                                                  <<03001>>10064000
        PRINTLINE (0);                                         <<03001>>10066000
        END                                                    <<03001>>10068000
     UNTIL (BRKPT'INX:=BRKPT'INX+BPT'ENTRY'SIZE)=BPT'TBL'SIZE; <<03001>>10070000
END;                                                           <<03001>>10072000
                                                               <<03001>>10074000
                                                               <<03001>>10076000
                                                               <<03001>>10078000
SUBROUTINE STACKTRACE;                                         <<03001>>10080000
<<===================>>                                        <<03001>>10082000
BEGIN                                                          <<03001>>10084000
    PUSH(SBANK);       <<GET STACK BANK>>                      <<03001>>10086000
    PUSH(DB);                                                  <<03001>>10088000
    DELB;              <<DELETE DB-BANK>>                      <<03001>>10090000
    PUSH(Q);           <<DB RELATIVE Q>>                       <<03001>>10092000
    TOS := TOS+TOS;    <<ABS ADDR OF Q>>                       <<03001>>10094000
    K := TOS;          <<KEEP IN DOUBLE K>>                    <<03001>>10096000
                                                               <<03001>>10098000
    DO BEGIN                                                   <<03001>>10100000
        DUMPER(K-3D,4D,4,OCTAL'MODE);   <<DUMP A MARKER>>      <<03001>>10102000
        K := K - DLSEA(K);   <<LINK BACK>>                     <<03001>>10104000
    END UNTIL DLSEA(K) =0D;                                    <<03001>>10106000
END;                                                           <<03001>>10108000
                                                               <<03001>>10110000
                                                               <<03001>>10112000
SUBROUTINE EXPRESSION;                                         <<03001>>10114000
<<===================>>                                        <<03001>>10116000
BEGIN                                                          <<03001>>10118000
   CASE MODE OF                                                <<03001>>10120000
   BEGIN                                                       <<03001>>10122000
     <<0 OCTAL>>  BEGIN                                        <<03001>>10124000
                    OCTNUMOUT (P1,6);                          <<03001>>10126000
                    BLANKOUT(2);                               <<03001>>10128000
                  END;                                         <<03001>>10130000
                                                               <<03001>>10132000
     <<1 DEC  >>  ;                                            <<03001>>10134000
     <<2 HEX  >>  ;                                            <<03001>>10136000
                                                               <<03001>>10138000
     <<4 ASCII>>  ASCIINUMOUT (P1);                            <<03001>>10140000
                                                               <<03001>>10142000
     <<4 BINARY>> BEGIN                                        <<03001>>10144000
                    OCTNUMOUT( P1,6);                          <<03001>>10146000
                    BLANKOUT(3);                               <<03001>>10148000
                                                               <<03001>>10150000
                    BYTESOUT( P1);                             <<03001>>10152000
                    BLANKOUT(3);                               <<03001>>10154000
                                                               <<03001>>10156000
                    BITSOUT (P1);                              <<03001>>10158000
                  END;                                         <<03001>>10160000
    END;  <<CASE>>                                             <<03001>>10162000
    PRINTLINE(0);                                              <<03001>>10164000
END;                                                           <<03001>>10166000
                                                               <<03001>>10168000
                                                               <<03001>>10170000
SUBROUTINE MOVE'COMMAND;                                       <<N8581>>10172000
BEGIN                                                          <<N8581>>10174000
   <<    MOVE <TARGET ADR/REG>,<SOURCE ADR/REG>,<CNT>   >>     <<H8649>>10176000
   GETP1;                                                      <<N8581>>10178000
   GETP2;                                                      <<N8581>>10180000
   GETWIDTH;                                                   <<N8581>>10182000
   TOS := P1;                                                  <<N8581>>10184000
   TOS := P2;                                                  <<N8581>>10186000
   TOS := WIDTH;                                               <<N8581>>10188000
   ASSEMBLE( MABS 5 );                                         <<N8581>>10190000
END;                                                           <<N8581>>10192000
                                                               <<N8581>>10194000
SUBROUTINE FILL'COMMAND;                                       <<N8581>>10196000
BEGIN                                                          <<N8581>>10198000
   <<    F <ADR/REG>,<FILL WORD>,<CNT>    >>                   <<H8649>>10200000
   GETP1;                                                      <<N8581>>10202000
   WIDTH := 0;                                                 <<N8581>>10204000
   GETWIDTH;                                                   <<N8581>>10206000
   I := WIDTH;                                                 <<N8581>>10208000
   WIDTH := 0;                                                 <<N8581>>10210000
   GETWIDTH;                                                   <<N8581>>10212000
   X := 0;                                                     <<N8581>>10214000
   TOS := P1;                                                  <<N8581>>10216000
   WHILE X < WIDTH DO                                          <<N8581>>10218000
      BEGIN                                                    <<N8581>>10220000
      TOS := I;                                                <<N8581>>10222000
      ASSEMBLE( SSEA );                                        <<N8581>>10224000
      TOS := TOS+1D;                                           <<N8581>>10226000
      X := X+1;                                                <<N8581>>10228000
      END;                                                     <<N8581>>10230000
   DDEL;                                                       <<N8581>>10232000
END;                                                           <<N8581>>10234000
                                                               <<N8581>>10236000
SUBROUTINE VIRTUAL'COMMAND;                                    <<N8581>>10238000
BEGIN                                                          <<N8581>>10240000
   <<    DV <LDEV>,<SECTOR>,<CNT>,<MODE>   >>                  <<H8649>>10242000
   P2 := 0D;                                                   <<N8581>>10244000
   GETP1;                                                      <<N8581>>10246000
   GETP2;                                                      <<N8581>>10248000
   P2 := P2+BASEDISC;                                          <<H8649>>10250000
   WIDTH := 1;                                                 <<N8581>>10252000
   MODE := OCTAL'MODE;                                         <<N8581>>10254000
   GETMODE;                                                    <<N8581>>10256000
   GETWIDTH;                                                   <<N8581>>10258000
   GETMODE;                                                    <<N8581>>10260000
   ASSEMBLE( ADDS 128 );                                       <<N8581>>10262000
   PUSH( DB );                                                 <<N8581>>10264000
   TOS := TOS + @S2-127;                                       <<N8581>>10266000
   TOS := WIDTH;                                               <<N8581>>10268000
   WHILE > DO                                                  <<N8581>>10270000
      BEGIN                                                    <<N8581>>10272000
      MOVE IO := "SECTOR %",2;                                 <<N8581>>10274000
      BUFX := TOS-@IO;                                         <<N8581>>10276000
      OCTNUMOUT( P2, 8);                                       <<N8581>>10278000
      PRINTLINE(0);                                            <<N8581>>10280000
      DISC'( READ, LOGICAL(P1), P2, DS2, 128);                 <<N8581>>10282000
      DUMPER( DS2, 128D, 8, MODE);                             <<N8581>>10284000
      PRINT( WRDIO, 0, 0);                                     <<N8581>>10286000
      P2 := P2+1D;                                             <<N8581>>10288000
      TOS := TOS-1;                                            <<N8581>>10290000
      END;                                                     <<N8581>>10292000
   ASSEMBLE( SUBS 131 );                                       <<N8581>>10294000
END;                                                           <<N8581>>10296000
                                                               <<N8581>>10298000
SUBROUTINE MODIFY'VIRTUAL'CMD;                                 <<N8581>>10300000
BEGIN                                                          <<N8581>>10302000
   <<   MV <LDEV>,<SECTOR>,<WORD>,<CNT>    >>                  <<N8581>>10304000
   GETP1;                                                      <<N8581>>10306000
   GETP2;                                                      <<N8581>>10308000
   IF TOKEN = %15 THEN FAIL;                                   <<N8581>>10310000
   P2 := P2+BASEDISC;                                          <<H8649>>10312000
   GETWIDTH;                                                   <<N8581>>10314000
   M := WIDTH;                                                 <<N8581>>10316000
   IF NOT( 0 <= M <= 127 ) THEN FAIL;                          <<N8581>>10318000
   WIDTH := 1;                                                 <<N8581>>10320000
   GETWIDTH;                                                   <<N8581>>10322000
   IF WIDTH+M > 128 THEN FAIL;                                 <<N8581>>10324000
   ASSEMBLE( ADDS 128 );                                       <<N8581>>10326000
   PUSH( DB );                                                 <<N8581>>10328000
   TOS := TOS + @S2-127;                                       <<N8581>>10330000
   DISC'( READ, LOGICAL(P1), P2, DS1, 128);                    <<N8581>>10332000
   MODIFIER( DS1+DOUBLE(M), DOUBLE(WIDTH));                    <<N8581>>10334000
   DISC'( WRITE, LOGICAL(P1), P2, DS1, 128);                   <<N8581>>10336000
   ASSEMBLE( SUBS 130 );                                       <<N8581>>10338000
END;                                                           <<N8581>>10340000
                                                               <<N8581>>10342000
SUBROUTINE ENV'COMMAND;                                        <<N8581>>10344000
BEGIN                                                          <<N8581>>10346000
   <<     E <NR OF STACK MARKERS>    >>                        <<H8649>>10348000
   IF TOKEN = %15 THEN                                         <<N8581>>10350000
      ENV := 0                                                 <<N8581>>10352000
   ELSE                                                        <<N8581>>10354000
      BEGIN                                                    <<N8581>>10356000
      GETP1;                                                   <<N8581>>10358000
      WIDTH := LOGICAL(P1);                                    <<N8581>>10360000
      IF MARKER(WIDTH+1) <> -1D THEN                           <<N8581>>10362000
         ENV := WIDTH                                          <<N8581>>10364000
      ELSE                                                     <<N8581>>10366000
         FAIL;                                                 <<N8581>>10368000
      END;                                                     <<N8581>>10370000
END;                                                           <<N8581>>10372000
                                                               <<N8581>>10374000
SUBROUTINE BASE'COMMAND;                                       <<H8649>>10376000
BEGIN                                                          <<H8649>>10378000
   <<               ,<CODE> (DEFAULT)   >>                     <<H8649>>10380000
   <<     BASE <NUM>,<DISC>             >>                     <<H8649>>10382000
   <<               ,<DATA>             >>                     <<H8649>>10384000
   BASECODE := 0D;                                             <<H8649>>10386000
   IF TOKEN = %15 THEN RETURN;                                 <<H8649>>10388000
   GETP1;                                                      <<H8649>>10390000
   IF TOKEN = %15 THEN                                         <<H8649>>10392000
      BEGIN                                                    <<H8649>>10394000
C:    IMPCST;                                                  <<H8649>>10396000
      BASECODE1 := CST;                                        <<H8649>>10398000
      BASECODE2 := P;                                          <<H8649>>10400000
      RETURN;                                                  <<H8649>>10402000
      END                                                      <<H8649>>10404000
   ELSE                                                        <<H8649>>10406000
      IF TOKEN <> "," THEN FAIL;                               <<H8649>>10408000
   CHAR;                                                       <<H8649>>10410000
   IF TOKEN = "C" THEN GOTO C;                                 <<H8649>>10412000
   IF TOKEN <> "D" THEN FAIL;                                  <<H8649>>10414000
   CHAR;                                                       <<H8649>>10416000
   IF TOKEN = "I" THEN                                         <<H8649>>10418000
      BASEDISC := P1                                           <<H8649>>10420000
   ELSE                                                        <<H8649>>10422000
      IF TOKEN = "A" THEN                                      <<H8649>>10424000
         BASEDATA := P1                                        <<H8649>>10426000
      ELSE                                                     <<H8649>>10428000
         FAIL;                                                 <<H8649>>10430000
END;                                                           <<H8649>>10432000
SUBROUTINE BREAK'COMMAND;                                      <<03001>>10434000
<<=====================>>                                      <<03001>>10436000
BEGIN                                                          <<03001>>10438000
    IF TOKEN = "A" AND CHAR = "S" AND CHAR = "E" THEN          <<H8649>>10440000
       BEGIN                                                   <<H8649>>10442000
       CHAR;                                                   <<H8649>>10444000
       BASE'COMMAND;                                           <<H8649>>10446000
       RETURN;                                                 <<H8649>>10448000
       END;                                                    <<H8649>>10450000
    GETP1;                                                     <<03001>>10452000
    IF TOKEN <> %15 THEN FAIL;                                 <<03001>>10454000
    IMPCST;   <<SET UP CST AND P >>                            <<03001>>10456000
    ADDBASE;                                                   <<H8649>>10458000
    SET'BRKPT( USER'BRKPT);                                    <<03001>>10460000
                                                               <<03001>>10462000
END;                                                           <<03001>>10464000
                                                               <<03001>>10466000
SUBROUTINE CLEAR'COMMAND;                                      <<03001>>10468000
<<======================>>                                     <<03001>>10470000
BEGIN                                                          <<03001>>10472000
    GETP1;                                                     <<03001>>10474000
    IF TOKEN <> %15 THEN FAIL;                                 <<03001>>10476000
    IMPCST;    <<SET UP CST AND P >>                           <<03001>>10478000
    ADDBASE;                                                   <<H8649>>10480000
    CLEAR'BRKPT(USER'BRKPT);                                   <<03001>>10482000
END;                                                           <<03001>>10484000
                                                               <<03001>>10486000
SUBROUTINE DUMP'COMMAND;                                       <<03001>>10488000
<<====================>>                                       <<03001>>10490000
BEGIN                                                          <<03001>>10492000
    IF TOKEN = "V" THEN                                        <<N8581>>10494000
       BEGIN                                                   <<N8581>>10496000
       CHAR;                                                   <<N8581>>10498000
       VIRTUAL'COMMAND;                                        <<N8581>>10500000
       RETURN;                                                 <<N8581>>10502000
       END;                                                    <<N8581>>10504000
    P2 := 1D;  <<DEFAULT TO DUMP LENGTH=1>>                    <<03001>>10506000
    WIDTH := 8;  MODE := OCTAL'MODE;                           <<03001>>10508000
    GETP1;                                                     <<03001>>10510000
    P1 := P1+BASEDATA;                                         <<H8649>>10512000
    GETP2;                                                     <<03001>>10514000
                                                               <<03001>>10516000
    GETMODE;                                                   <<03001>>10518000
    GETWIDTH;                                                  <<03001>>10520000
    GETMODE;                                                   <<03001>>10522000
    IF TOKEN <> %15 THEN FAIL;                                 <<03001>>10524000
                                                               <<03001>>10526000
    DUMPER (P1,P2, WIDTH,MODE);                                <<03001>>10528000
END;                                                           <<03001>>10530000
                                                               <<03001>>10532000
SUBROUTINE LIST'COMMAND;                                       <<03001>>10534000
<<====================>>                                       <<03001>>10536000
BEGIN                                                          <<03001>>10538000
    IF TOKEN <> %15 THEN FAIL;                                 <<03001>>10540000
    LIST;                                                      <<03001>>10542000
END;                                                           <<03001>>10544000
                                                               <<03001>>10546000
SUBROUTINE MODIFY'COMMAND;                                     <<03001>>10548000
<<=======================>>                                    <<03001>>10550000
BEGIN                                                          <<03001>>10552000
   IF TOKEN = "O" AND CHAR = "V" AND CHAR = "E" THEN           <<H8649>>10554000
      BEGIN                                                    <<N8581>>10556000
      CHAR;                                                    <<H8649>>10558000
      MOVE'COMMAND;                                            <<N8581>>10560000
      RETURN;                                                  <<N8581>>10562000
      END;                                                     <<N8581>>10564000
   IF TOKEN = "V" THEN                                         <<N8581>>10566000
      BEGIN                                                    <<N8581>>10568000
      CHAR;                                                    <<N8581>>10570000
      MODIFY'VIRTUAL'CMD;                                      <<N8581>>10572000
      RETURN;                                                  <<N8581>>10574000
      END;                                                     <<N8581>>10576000
    P2 := 1D;   <<DEFAULT TO MODIFY LENGTH = 1>>               <<03001>>10578000
    GETP1;                                                     <<03001>>10580000
    P1 := P1+BASEDATA;                                         <<H8649>>10582000
    GETP2;                                                     <<03001>>10584000
    IF TOKEN <> %15 THEN FAIL;                                 <<03001>>10586000
                                                               <<03001>>10588000
    MODIFIER(P1,P2);                                           <<03001>>10590000
END;                                                           <<03001>>10592000
                                                               <<03001>>10594000
SUBROUTINE EXIT'COMMAND;                                       <<03001>>10596000
<<=====================>>                                      <<03001>>10598000
BEGIN                                                          <<03001>>10600000
    IF TOKEN <> %15 THEN FAIL;                                 <<03001>>10602000
    EXIT;                                                      <<03001>>10604000
END;                                                           <<03001>>10606000
                                                               <<03001>>10608000
SUBROUTINE TRACE'COMMAND;                                      <<03001>>10610000
<<======================>>                                     <<03001>>10612000
BEGIN                                                          <<03001>>10614000
    IF TOKEN <> %15 THEN FAIL;                                 <<03001>>10616000
    STACKTRACE;                                                <<03001>>10618000
END;                                                           <<03001>>10620000
                                                               <<03001>>10622000
                                                               <<03001>>10624000
SUBROUTINE EXPRESSION'COMMAND;                                 <<03001>>10626000
<<===========================>>                                <<03001>>10628000
BEGIN                                                          <<03001>>10630000
    MODE := OCTAL'MODE;                                        <<03001>>10632000
    GETP1;                                                     <<03001>>10634000
    GETMODE;                                                   <<03001>>10636000
    IF TOKEN <> %15 THEN FAIL;                                 <<03001>>10638000
    EXPRESSION;                                                <<03001>>10640000
END;                                                           <<03001>>10642000
                                                               <<03001>>10644000
$PAGE "HELP          MAIN PROGRAM BODY"                        <<03001>>10646000
                                                               <<03001>>10648000
<<=============  START OF THE MAIN PROGRAM ==============>>    <<03001>>10650000
A'SPECIAL'ENTRY := FALSE;    <<NORMAL ENTRY>>                  <<03001>>10652000
                                                               <<03001>>10654000
GOTO NORMAL'ENTRY;      <<SKIP SPECIAL MAKE'PRESENT ENTRY>>    <<03001>>10656000
                                                               <<03001>>10658000
HELP'INIT'BPTAB:    <<ENTER HERE TO INITIALIZE BPTAB>>         <<03001>>10660000
<<=============>>                                              <<03001>>10662000
    COPY'BRKPT'TABLE;                                          <<03001>>10664000
    BPTAB := EMPTY'FAKE'BRKPT;                                 <<03001>>10666000
    BPTAB(1) := EMPTY'BRKPT;                                   <<03001>>10668000
    MOVE BPTAB(2) := BPTAB(1),(NUM'ZEROS-1);                   <<03001>>10670000
    NUM'BRKPTS := 0;                                           <<03001>>10672000
    BP'DEBUG := 0;  <<CLEAR DEBUGGING FLAG>>                   <<03001>>10674000
    SAVE'BRKPT'TABLE;   <<SAVE CLEARED BPTAB INTO CODE>>       <<03001>>10676000
   TOS := @PBBASES;                                            <<H8649>>10678000
   STCODE(*,0D);                                               <<H8649>>10680000
   TOS := @PBBASES(1);                                         <<H8649>>10682000
   STCODE(*,0D);                                               <<H8649>>10684000
   TOS := @PBBASES(2);                                         <<H8649>>10686000
   STCODE(*,0D);                                               <<H8649>>10688000
    RETURN;                                                    <<03001>>10690000
                                                               <<03001>>10692000
HELP'MAKE'PRESENT: <<ENTER HERE WHEN NEW SEG IS MADE PRESENT>> <<03001>>10694000
<<===============>>                                            <<03001>>10696000
HELP'MAKE'ABSENT:   <<ENTER HERE TO RESTORE INSTR INTO A SEG>> <<03001>>10698000
<<===============>>                                            <<03001>>10700000
                                                               <<03001>>10702000
  A'SPECIAL'ENTRY := TRUE;                                     <<03001>>10704000
                                                               <<03001>>10706000
NORMAL'ENTRY:                                                  <<03001>>10708000
                                                               <<03001>>10710000
                                                               <<03001>>10712000
DISABLE;  << TURN OFF INTERRUPTS >>                            <<03001>>10714000
TOS := 0D;  <<FOR RETURN VALUE FROM CST'ADDR(*) >>             <<03001>>10716000
PUSH(STATUS);                                                  <<03001>>10718000
TOS.(2:1) := 0;  SET(STATUS);  << TURN OFF THE TRAPS >>        <<03001>>10720000
                                                               <<03001>>10722000
COPY'BRKPT'TABLE;    <<SAVE THE CALLERS DB AND MAKE A COPY>>   <<03001>>10724000
      <<OF THE BRKPT-TABLE (FROM THE CODE SEG) TO AN EASILY>>  <<03001>>10726000
      <<ACCESSIBLE Q-REL ARRAY>>                               <<03001>>10728000
                                                               <<03001>>10730000
      <<SET DB TO INITIALS STACK,  ALLOWS BYTE ADDRESSING,IO>> <<03001>>10732000
ENTRY'P := SMP-1;  << GET P FROM STACK MARKER >>               <<HELP2>>10734000
CST := SMSTA.(8:8);  << GET SEG FROM THE STATUS >>             <<03001>>10736000
P := ENTRY'P.(2:14);   <<SAVE ENTRY VALUES FOR P AND CST>>     <<HELP2>>10738000
ENTRY'CST := CST;                                              <<03001>>10740000
                                                               <<03001>>10742000
                                                               <<03001>>10744000
      <<WERE WE CALLED FROM MAKE-PRESENT>>                     <<03001>>10746000
      <<================================>>                     <<03001>>10748000
IF A'SPECIAL'ENTRY                                             <<03001>>10750000
THEN BEGIN                                                     <<03001>>10752000
    IF SPECIAL'FUNCTION = 0 THEN BRKPT'MAKE'ABSENT             <<03001>>10754000
                            ELSE BRKPT'MAKE'PRESENT;           <<03001>>10756000
    SAVE'BRKPT'TABLE;    RETURN;                               <<03001>>10758000
  END;                                                         <<03001>>10760000
      <<ARE WE AT A FAKE BREAKPOINT >>                         <<03001>>10762000
      <<============================>>                         <<03001>>10764000
BRKPT'INX := FIND'BRKPT(FAKE'BRKPT, CST,P);                    <<03001>>10766000
IF BRKPT'INX <> -1   <<FOUND A FAKE BRKPT>>                    <<03001>>10768000
THEN BEGIN                                                     <<03001>>10770000
      <<THIS FAKE BRKPT ALLOWS US TO PUT THE BRKPT BACK>>      <<03001>>10772000
      <<INTO THE CODE AT ADDR P-1. WE HAD TO RESTORE THE>>     <<03001>>10774000
      <<ORIG INSTR TO ALLOW THE USER TO RESUME EXECUTION>>     <<03001>>10776000
                                                               <<03001>>10778000
   TOS := CST'ADDR(CST) + DOUBLE(P);                           <<03001>>10780000
   ASMB(LSEA);  <<GRAB PCAL TO HELP>>                          <<03001>>10782000
   S1 := S1-1;  <<BACK ADDR UP TO USER BRKPT>>                 <<03001>>10784000
   ASMB(SSEA);  <<RESTORE ORIG USER BRKPT>>                    <<03001>>10786000
   DDEL;        <<DELETE THE ADDR>>                            <<03001>>10788000
                                                               <<03001>>10790000
   CLEAR'BRKPT(FAKE'BRKPT);   <<CLEAR THE FAKE BRKPT>>         <<03001>>10792000
                                                               <<03001>>10794000
   SAVE'BRKPT'TABLE;  <<COPY FROM Q-REL BACK TO CODE SEG>>     <<03001>>10796000
                                                               <<03001>>10798000
   SMP := ENTRY'P;    <<DECREMENT THE RETURN ADDR>>            <<HELP2>>10800000
   RETURN;      <<FAKE BRKPTS ARE INVISIBLE TO USER>>          <<03001>>10802000
END;  <<IN THE BREAKPOINT TABLE>>                              <<03001>>10804000
                                                               <<03001>>10806000
                                                               <<03001>>10808000
       <<ARE WE LOCATED AT A USER BREAKPOINT >>                <<03001>>10810000
       <<====================================>>                <<03001>>10812000
ENTRY'BRKPT'INX := FIND'BRKPT( USER'BRKPT,CST,P);              <<03001>>10814000
IF ENTRY'BRKPT'INX <> -1   <<WE ARE AT A USER BRKPT>>          <<03001>>10816000
THEN BEGIN                                                     <<03001>>10818000
    SMP := ENTRY'P;    <<DECREMENT THE EXIT ADDRESS>>          <<HELP2>>10820000
        <<WE WILL HAVE TO RESTORE THE ORIG INSTR LATER>>       <<03001>>10822000
        <<AS WELL AS SET A FAKE BRKPT WHEN WE EXIT >>          <<03001>>10824000
  END;   <<AT A USER BRKPT>>;                                  <<03001>>10826000
                                                               <<03001>>10828000
                                                               <<03001>>10830000
         <<PRINT WELCOME MSG, PROMPT, PROCESS COMMANDS>>       <<03001>>10832000
         <<===========================================>>       <<03001>>10834000
                                                               <<03001>>10836000
<< PRINT THE WELCOME MESSAGE >>                                <<03001>>10838000
BUFX := 0;   <<INITIALZE THE INDEX INTO OUTPUT BUFFER>>        <<03001>>10840000
PRINTLINE (0);       <<NEW LINE>>                              <<03001>>10842000
MOVE IO := "HELP      ";                                       <<03001>>10844000
BUFX := 10;                                                    <<03001>>10846000
OCTNUMOUT (DOUBLE(ENTRY'CST),3);    <<LOAD CST>>               <<03001>>10848000
MOVE IO(BUFX) := ".";                                          <<03001>>10850000
BUFX := BUFX + 1;                                              <<03001>>10852000
OCTNUMOUT (DOUBLE(P),5);    <<LOAD P >>                        <<HELP2>>10854000
 IF BASECODE1 = ENTRY'CST THEN                                 <<H8649>>10856000
    BEGIN                                                      <<H8649>>10858000
    MOVE IO(BUFX) := " (";                                     <<H8649>>10860000
    BUFX := BUFX+2;                                            <<H8649>>10862000
    OCTNUMOUT(DOUBLE(P-BASECODE2), 6);                         <<H8649>>10864000
    IO(BUFX) := ")";                                           <<H8649>>10866000
    BUFX := BUFX+1;                                            <<H8649>>10868000
    END;                                                       <<H8649>>10870000
PRINTLINE (0);       <<PRINT WELCOME, CRLF>>                   <<03001>>10872000
                                                               <<03001>>10874000
PUSH( S );  OLDS := TOS;  << SAVE FOR FAIL >>                  <<03001>>10876000
                                                               <<03001>>10878000
WIDTH := 8;   <<DEFAULT OUTPUT WIDTH>>                         <<03001>>10880000
<< COMMAND INPUT LOOP >>                                       <<03001>>10882000
                                                               <<03001>>10884000
COMIN:                                                         <<03001>>10886000
                                                               <<03001>>10888000
   IO := "-";     <<LOAD PROMPT>>                              <<03001>>10890000
   BUFX := 1;     <<1 BYTE PROMPT>>                            <<03001>>10892000
   PRINTLINE (1); <<PRINT THE PROMPT, STAY ON SAME LINE>>      <<03001>>10894000
                                                               <<03001>>10896000
   PIN := CST := 0;                                            <<03001>>10898000
   READINPUT( INBUF);                                          <<03001>>10900000
   CHAR;                                                       <<03001>>10902000
   X := NUM'CMDS -1;                                           <<03001>>10904000
   DO                                                          <<03001>>10906000
      BEGIN                                                    <<03001>>10908000
      IF  COMM(X) = TOKEN  THEN  GO FND;                       <<03001>>10910000
      X := X-1;                                                <<03001>>10912000
      END                                                      <<03001>>10914000
   UNTIL <;                                                    <<03001>>10916000
   FAIL;  << ILLEGAL COMMAND >>                                <<03001>>10918000
                                                               <<03001>>10920000
   FND:  << LEGAL COMMAND IF YOU GET HERE >>                   <<03001>>10922000
                                                               <<03001>>10924000
   COM := X;  << SAVE THE COMMAND >>                           <<03001>>10926000
   CHAR;  << SCAN OFF THE COMMAND >>                           <<03001>>10928000
                                                               <<03001>>10930000
   P2 := 0D;  P2F := FALSE;                                    <<03001>>10932000
                                                               <<03001>>10934000
                                                               <<03001>>10936000
   BUFX := 0;                                                  <<03001>>10938000
                                                               <<03001>>10940000
   CASE  *COM  OF                                              <<03001>>10942000
      BEGIN                                                    <<03001>>10944000
                 <<NOTE: SEE ORDER OF CHARS IN COMM>>          <<03001>>10946000
      << 0 B >>  BREAK'COMMAND;                                <<03001>>10948000
      << 1 C >>  CLEAR'COMMAND;                                <<03001>>10950000
      << 2 D >>  DUMP'COMMAND;                                 <<03001>>10952000
      << 3 E >>  ENV'COMMAND;                                  <<N8581>>10954000
      << 4 F >>  FILL'COMMAND;                                 <<N8581>>10956000
      << 3 L >>  LIST'COMMAND;                                 <<03001>>10958000
      << 4 M >>  MODIFY'COMMAND;                               <<03001>>10960000
      << 5 R >>  EXIT'COMMAND;   <<RESUME>>                    <<03001>>10962000
      << 6 T >>  TRACE'COMMAND;                                <<03001>>10964000
      << 7 = >>  EXPRESSION'COMMAND;                           <<03001>>10966000
      END;                                                     <<03001>>10968000
GO COMIN;                                                      <<03001>>10970000
                                                               <<03001>>10972000
END <<HELP>> ;                                                 <<03001>>10974000
<<  $CONTROL NOLIST >>                                         <<03001>>10976000
$CONTROL SEGMENT=RESIDENT                                      <<04306>>10978000
        <<---------------------------------------->>           <<04306>>10980000
        <<  CONVERT BYTE ADDRESS TO WORD ADDRESS  >>           <<04306>>10982000
        <<---------------------------------------->>           <<04306>>10984000
INTEGER PROCEDURE WORDADDRESS(BYTEADDRESS);                    <<04306>>10986000
VALUE BYTEADDRESS;                                             <<04306>>10988000
BYTE POINTER                                                   <<04306>>10990000
   BYTEADDRESS;     << BYTE POINTER TO BE CONVERTED >>         <<04306>>10992000
COMMENT                                                        <<04306>>10994000
THIS PROCEDURE RETURNS THE GIVEN BYTE ADDRESS CONVERTED TO     <<04306>>10996000
A WORD ADDRESS.  IT WORKS NO MATTER WHERE THE ADDRESS IS       <<04306>>10998000
LOCATED -- IN DB+ OR DB- AREA.                                 <<04306>>11000000
;                                                              <<04306>>11002000
BEGIN                                                          <<04306>>11004000
INTEGER                                                        <<04306>>11006000
   TEMP,    << TEMP. VARIABLE >>                               <<04306>>11008000
   ZREG;    << TEMP. FOR Z-REGISTER >>                         <<04306>>11010000
                                                               <<04306>>11012000
TEMP := WORDADDRESS := @BYTEADDRESS&LSR(1);                    <<04306>>11014000
PUSH(Z);                                                       <<04306>>11016000
ZREG := TOS;                                                   <<04306>>11018000
IF TEMP > ZREG THEN           << IF WORDADDRESS > Z    >>      <<04306>>11020000
   WORDADDRESS.(0:1) := 1;    << MUST BE A DB- ADDRESS >>      <<04306>>11022000
END;   << WORDADDRESS >>                                       <<04306>>11024000
$CONTROL SEGMENT=RESIDENT                                      <<04306>>11026000
        <<---------------------------------------->>           <<04306>>11028000
        <<  CONVERT WORD ADDRESS TO BYTE ADDRESS  >>           <<04306>>11030000
        <<---------------------------------------->>           <<04306>>11032000
INTEGER PROCEDURE BYTEADDRESS(WORDADDRESS);                    <<04306>>11034000
VALUE WORDADDRESS;                                             <<04306>>11036000
POINTER                                                        <<04306>>11038000
   WORDADDRESS;    << POINTER TO BE CONVERTED >>               <<04306>>11040000
COMMENT                                                        <<04306>>11042000
THIS PROCEDURE RETURNS THE GIVEN WORD ADDRESS CONVERTED TO     <<04306>>11044000
A BYTE ADDRESS.  IT WORKS NO MATTER WHERE THE ADDRESS IS       <<04306>>11046000
LOCATED -- IN DB+ OR DB- AREA.                                 <<04306>>11048000
;                                                              <<04306>>11050000
BEGIN                                                          <<04306>>11052000
BYTEADDRESS := @WORDADDRESS&LSL(1);                            <<04306>>11054000
END;   << BYTEADDRESS >>                                       <<04306>>11056000
PROCEDURE FILL' (BUF', LEN, CHAR);                             <<*7777>>11058000
         VALUE LEN, CHAR;                                      <<*7777>>11060000
         BYTE ARRAY BUF';                                      <<*7777>>11062000
         INTEGER LEN;                                          <<*7777>>11064000
         BYTE CHAR;                                            <<*7777>>11066000
   BEGIN                                                       <<*7777>>11068000
                                                               <<*7777>>11070000
   BUF':=CHAR;                                                 <<*7777>>11072000
   IF LEN > 1 THEN                                             <<*7777>>11074000
      MOVE BUF'(1):=BUF'(0),(LEN-1);                           <<*7777>>11076000
                                                               <<*7777>>11078000
   END <<FILL' PROC>>;                                         <<*7777>>11080000
$CONTROL SEGMENT=BOOTSTRAP                                     <<02510>>11082000
INTEGER PROCEDURE THISCPU;                                     <<02510>>11084000
   BEGIN                                                       <<02510>>11086000
   << THIS PROCEDURE DETECTS THE CURRENT TYPE  >>              <<02510>>11088000
   << OF CPU IN EXECUTION AND RETURNS A VALUE  >>              <<02510>>11090000
   <<        0  IF SERIES I                    >>              <<02510>>11092000
   <<        1  IF SERIES II                   >>              <<02510>>11094000
   <<        2  IF SERIES 33                   >>              <<02510>>11096000
   <<        3  IF SERIES III                  >>              <<02510>>11098000
   <<        4  IF ICF/44                      >>              <<02510>>11100000
   <<        5  IF ICF/55                      >>              <<02510>>11102000
   <<        6  IF SERIES-37                >>                 <<C8392>>11104000
                                                               <<02510>>11106000
   INTEGER ARRAY PHYLOGCPU(1:8)=PB :=                          <<02510>>11108000
     1,3,4,5,6,-1,-1,2;                                        <<C8392>>11110000
   INTEGER X=X, S0=S-0;                                        <<02510>>11112000
   ASSEMBLE( DZRO,NOT); << INITIALIZE RETURN (SERIES I) >>     <<02510>>11114000
                        << TEST FLAG - ILLEGAL BANK #   >>     <<02510>>11116000
   PUSH( DB );          << 1 WORD ON SERIES I           >>     <<02510>>11118000
                        << 2 WORD ON SERIES II/33       >>     <<02510>>11120000
   DEL;                 << DON'T NEED DB ADDRESS        >>     <<02510>>11122000
   IF TOS <> -1 THEN    << WAS BANK # PUSHED?           >>     <<02510>>11124000
      BEGIN             << YES - NOT SERIES I           >>     <<02510>>11126000
      ASSEMBLE( PCN );  << GET MICROCODE CPU #          >>     <<02510>>11128000
      X := TOS;         << SETUP FOR RANGE CHECK        >>     <<02510>>11130000
      DDEL;             << DELETE TEST FLAG             >>     <<02510>>11132000
                        << DELETE RETURN VALUE          >>     <<02510>>11134000
      IF NOT(1 <= X <= 8) THEN ASSEMBLE( HALT 0 );             <<02510>>11136000
      TOS := PHYLOGCPU(X);                                     <<02510>>11138000
      IF < THEN ASSEMBLE( HALT 0 );<< CPU NOT SUPPORTED >>     <<02510>>11140000
      END;                                                     <<02510>>11142000
   THISCPU := TOS;  << RETURN VALUE >>                         <<02510>>11144000
   END;  << END THISCPU >>                                     <<02510>>11146000
LOGICAL PROCEDURE ON'ICS;                                      <<03603>>11148000
BEGIN                                                          <<03603>>11150000
   PUSH( DB, Z);                                               <<03603>>11152000
   ASSEMBLE( CAB, LADD);                                       <<03603>>11154000
   PUSH( SBANK );                                              <<03603>>11156000
   S2 := TOS;                                                  <<03603>>11158000
   IF TOS = D'L(ABS(ZI))) THEN ON'ICS := TRUE;                 <<03603>>11160000
END;                                                           <<03603>>11162000
PROCEDURE MABS( DBANK, DADDRESS, SBANK, SADDRESS, COUNT);      <<02517>>11164000
   VALUE DBANK, DADDRESS, SBANK, SADDRESS, COUNT;              <<02517>>11166000
   INTEGER DBANK, DADDRESS, SBANK, SADDRESS, COUNT;            <<02517>>11168000
BEGIN                                                          <<02517>>11170000
   DOUBLE                                                      <<02517>>11172000
      DESTINATION = DBANK,                                     <<02517>>11174000
      SOURCE      = SBANK;                                     <<02517>>11176000
                                                               <<02517>>11178000
   TOS := DESTINATION;                                         <<02517>>11180000
   TOS := SOURCE;                                              <<02517>>11182000
   TOS := COUNT;                                               <<02517>>11184000
   ASSEMBLE( MABS );                                           <<02517>>11186000
END;                                                           <<02517>>11188000
$CONTROL SEGMENT=CONFIGURE                                     <<03550>>11190000
       <<---------------------------------->>                  <<03550>>11192000
       <<      SEE IF LDEV EXISTS          >>                  <<03550>>11194000
       <<---------------------------------->>                  <<03550>>11196000
LOGICAL PROCEDURE LDEV'EXISTS( LDEV);                          <<03550>>11198000
VALUE LDEV;                                                    <<03550>>11200000
INTEGER LDEV;   << LDEV TO BE CHECKED >>                       <<03550>>11202000
COMMENT                                                        <<03550>>11204000
THIS PROCEDURE RETURNS TRUE IF THE GIVEN LDEV IS               <<03550>>11206000
ACTUALLY CONFIGURED, FALSE OTHERWISE.                          <<03550>>11208000
;                                                              <<03550>>11210000
BEGIN                                                          <<03550>>11212000
INTEGER DVR'INDEX;                                             <<*DVR*>>11214000
DVR'INDEX := LDEV * DVRSIZE;                                   <<*DVR*>>11216000
IF 1 <= LDEV <= HLDEV AND                                      <<03550>>11218000
   (DVRDRTNUM <> 0 OR DVRDSBIT = 1) THEN                       <<*DVR*>>11220000
   LDEV'EXISTS := TRUE                                         <<03550>>11222000
ELSE                                                           <<03550>>11224000
   LDEV'EXISTS := FALSE;                                       <<03550>>11226000
END;  << LDEV'EXISTS >>                                        <<03550>>11228000
$CONTROL SEGMENT=CONFIGURE                                     <<03550>>11230000
      <<----------------------------------------->>            <<03550>>11232000
      << SEE IF LDEV EXISTS AND IS NOT DS DEVICE >>            <<03550>>11234000
      <<----------------------------------------->>            <<03550>>11236000
LOGICAL PROCEDURE NON'DS'LDEV(LDEV);                           <<03550>>11238000
VALUE LDEV;                                                    <<03550>>11240000
INTEGER LDEV;   << LDEV TO BE CHECKED >>                       <<03550>>11242000
COMMENT                                                        <<03550>>11244000
THIS PROCEDURE RETURNS TRUE IF THE GIVEN LDEV IS ACTUALLY      <<03550>>11246000
CONFIGURED AND IS NOT A DS DEVICE.  IT RETURNS FALSE           <<03550>>11248000
OTHERWISE.                                                     <<03550>>11250000
;                                                              <<03550>>11252000
BEGIN                                                          <<03550>>11254000
INTEGER DVR'INDEX;                                             <<*DVR*>>11256000
DVR'INDEX := LDEV * DVRSIZE;                                   <<*DVR*>>11258000
IF 1 <= LDEV <= HLDEV AND                                      <<03550>>11260000
   DVRDSBIT = 0 AND DVRDRTNUM <> 0 THEN                        <<*DVR*>>11262000
   NON'DS'LDEV := TRUE                                         <<03550>>11264000
ELSE                                                           <<03550>>11266000
   NON'DS'LDEV := FALSE;                                       <<03550>>11268000
END;  << NON'DS'LDEV >>                                        <<03550>>11270000
$CONTROL SEGMENT=RESIDENT                                      <<03668>>11272000
$CONTROL SEGMENT=CONFIGURE                                     <<03668>>11274000
            <<------------------------------------>>           <<02707>>11276000
            << RETURN THE MAXIMUM OF TWO INTEGERS >>           <<02707>>11278000
            <<------------------------------------>>           <<02707>>11280000
INTEGER PROCEDURE MAX( A, B);                                  <<02707>>11282000
VALUE A, B;                                                    <<02707>>11284000
INTEGER A,      << FIRST INTEGER >>                            <<02707>>11286000
        B;      << SECOND INTEGER >>                           <<02707>>11288000
COMMENT                                                        <<02707>>11290000
   THIS PROCEDURE RETURNS THE MAXIMUM OF A OR B.               <<02707>>11292000
   ;                                                           <<02707>>11294000
   BEGIN                                                       <<02707>>11296000
   MAX := IF A > B THEN A                                      <<02707>>11298000
                   ELSE B;                                     <<02707>>11300000
   END;   << MAX >>                                            <<02707>>11302000
$CONTROL SEGMENT=RESIDENT                                      <<03550>>11304000
           <<-------------------------------->>                <<03550>>11306000
           <<  RETURN CURRENT PROCESS CLOCK  >>                <<03550>>11308000
           <<-------------------------------->>                <<03550>>11310000
LOGICAL PROCEDURE RCLK;                                        <<03550>>11312000
COMMENT                                                        <<03550>>11314000
THIS PROCEDURE DOES AN RCLK INTRUCTION AND RETURNS             <<03550>>11316000
THE CURRENT CLOCK VALUE IT LEAVES ON THE STACK.                <<03550>>11318000
WARNING:  THIS CLOCK DOES NOT INCREMENT WHEN YOU'RE            <<03550>>11320000
RUNNING ON THE ICS.                                            <<03550>>11322000
;                                                              <<03550>>11324000
BEGIN                                                          <<03550>>11326000
ASSEMBLE(RCLK);    << GET THE CLOCK >>                         <<03550>>11328000
RCLK := TOS;       << RETURN IT     >>                         <<03550>>11330000
END;   << RCLK >>                                              <<03550>>11332000
$CONTROL SEGMENT=RESIDENT                                      <<03550>>11334000
INTEGER PROCEDURE MOVEAN( TO'BUF, FROM'BUF, MAX'COUNT);        <<01103>>11336000
   VALUE MAX'COUNT;                                            <<01103>>11338000
   BYTE ARRAY TO'BUF, FROM'BUF;                                <<01103>>11340000
   INTEGER MAX'COUNT;                                          <<01103>>11342000
BEGIN                                                          <<01103>>11344000
   X := 0;                                                     <<01103>>11346000
   WHILE FROM'BUF(X) <> SPECIAL AND X < MAX'COUNT DO           <<01103>>11348000
      BEGIN                                                    <<01103>>11350000
      TO'BUF(X) := FROM'BUF(X);                                <<01103>>11352000
      X := X+1;                                                <<01103>>11354000
      END;                                                     <<01103>>11356000
   MOVEAN := X;                                                <<01103>>11358000
END;                                                           <<01103>>11360000
                                                               <<03002>>11362000
$CONTROL SEGMENT=BOOTSTRAP                                     <<03002>>11364000
  INTEGER PROCEDURE GETDRT(DRT,OFFSET);                        <<03002>>11366000
  <<=================================>>                        <<03002>>11368000
      VALUE DRT,OFFSET;                                        <<03002>>11370000
      INTEGER DRT,OFFSET;                                      <<03002>>11372000
                                                               <<03002>>11374000
      COMMENT: USE FIXED LOW CORE CELLS "DRTBANK","DRTADDR"    <<03002>>11376000
        TO GET DEVICE REF TABLE START ADDRESS, THEN INDEX      <<03002>>11378000
        TO THE DESIRED "DRT" ENTRY (4 WORD), AND USE           <<03002>>11380000
        "OFFSET" TO SPECIFY THE DESIRED WORD.                  <<03002>>11382000
        GETDRT RETURNS AS THE VALUE OF THAT WORD IN THE TABLE; <<03002>>11384000
                                                               <<03002>>11386000
  BEGIN                                                        <<03002>>11388000
    TOS := ABSOLUTE(DRTBANK);                                  <<03002>>11390000
    TOS := ABSOLUTE(DRTADDR)+DRT &LSL(2) + OFFSET;             <<03002>>11392000
    ASSEMBLE(LSEA);                                            <<03002>>11394000
    PUSH(STATUS);                                              <<03002>>11396000
    TOS := TOS.(6:2);                                          <<03002>>11398000
    CC := TOS;  <<SET CC FOR FUTURE TEST>>                     <<03002>>11400000
       <<ORIG CODE ASSIGNMENT SET THE CC>>                     <<03002>>11402000
    GETDRT:= TOS;                                              <<03002>>11404000
  END;                                                         <<03002>>11406000
                                                               <<03002>>11408000
  PROCEDURE PUTDRT(DRT,OFFSET,NUM);                            <<03002>>11410000
  <<==============================>>                           <<03002>>11412000
      VALUE DRT,OFFSET,NUM;                                    <<03002>>11414000
      INTEGER DRT,OFFSET,NUM;                                  <<03002>>11416000
                                                               <<03002>>11418000
      COMMENT: USE FIXED LOW CORE CELLS "DRTBANK","DRTADDR"    <<03002>>11420000
        TO GET DEVICE REF TABLE START ADDRESS, THEN INDEX      <<03002>>11422000
        TO THE DESIRED "DRT" ENTRY (4 WORD), AND USE           <<03002>>11424000
        "OFFSET" TO SPECIFY THE DESIRED WORD.                  <<03002>>11426000
        LOAD THE VALUE "NUM" INTO THAT WORD IN THE TABLE;      <<03002>>11428000
                                                               <<03002>>11430000
  BEGIN                                                        <<03002>>11432000
    TOS := ABSOLUTE(DRTBANK);                                  <<03002>>11434000
    TOS := ABSOLUTE(DRTADDR) + DRT &LSL(2) + OFFSET;           <<03002>>11436000
    TOS := NUM;                                                <<03002>>11438000
    ASSEMBLE(SSEA);                                            <<03002>>11440000
  END;                                                         <<03002>>11442000
                                                               <<03002>>11444000
  PROCEDURE INITDRT( DRT );                                    <<03002>>11446000
  <<=====================>>                                    <<03002>>11448000
     VALUE DRT; INTEGER DRT;                                   <<03002>>11450000
  BEGIN                                                        <<03002>>11452000
     PUTDRT(DRT,0,0);                                          <<03002>>11454000
     PUTDRT(DRT,PI,0);                                         <<03002>>11456000
     PUTDRT(DRT,DBI,TEMP'CPVA);                                <<03002>>11458000
     PUTDRT(DRT,CHANSTAT,0);                                   <<03002>>11460000
  END;                                                         <<03002>>11462000
$PAGE "CONSOLE DRIVER"                                         <<01103>>11464000
$CONTROL SEGMENT=CONFIGURE                                              11466000
          <<----------------------------                                11468000
            DETERMINE SPEED OF CONSOLE                                  11470000
          ---------------------------->>                                11472000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>11474000
PROCEDURE SPEEDSENSE;                                          <<01101>>11476000
BEGIN COMMENT                                                  <<01101>>11478000
                                                               <<01101>>11480000
     WILL TRY FOR AN AUTOMATIC SPEED SENSE IF POSSIBLE, THIS   <<01101>>11482000
  WORKS ONLY FOR THE HP26XX TYPE TERMINALS.  IF THIS FAILS     <<01101>>11484000
  WILL HOOK UP UNIT 0 TO THE DIAGNOSTIC CHANNELS AT 5          <<01101>>11486000
  DIFFERENT SPEEDS AND WAIT FOR A CARRIAGE RETURN TO BE        <<01101>>11488000
  INPUT TO DETERMINE THE SPEED.  THE CORRECT BAUD RATE         <<01101>>11490000
  PARAMETER IS STORED IN BAUDRATE;                             <<01101>>11492000
                                                               <<01101>>11494000
   INTEGER ARRAY BRPARAM(0:5) = PB := <<BAUD RATE PARAMETERS>> <<01101>>11496000
            %5,    <<2400>>                                    <<01101>>11498000
           %13,    <<1200>>                                    <<01101>>11500000
           %27,    <<600>>                                     <<01101>>11502000
           %57,    <<300>>                                     <<01101>>11504000
          %137,    <<150>>                                     <<01101>>11506000
          %202;    <<110>>                                     <<01101>>11508000
   ARRAY TIME(0:5) = PB := 10, 18, 30, 70, 130, 200;           <<01101>>11510000
   ARRAY SPEEDS(0:5) = PB := 240, 120, 60, 30, 15, 10;         <<01101>>11512000
   EQUATE ENQ=5, ACK=6, CR=13;                                 <<01101>>11514000
   INTEGER CHAR,UNIT,I;                                        <<01101>>11516000
   LOGICAL WAITMS;                                             <<01101>>11518000
                                                               <<01101>>11520000
   SUBROUTINE SETRECSPEED;                                     <<01101>>11522000
      BEGIN                                                    <<01101>>11524000
      TOS := CONSOLEDRT;                                       <<01101>>11526000
      TOS := BAUDRATE+%131000; <<ENABLE INTS,ECHO,REC>>        <<01101>>11528000
      IF BAUDRATE = %202 THEN TOS.(7:1) := 1;                  <<01101>>11530000
      WIO1;  << SET BAUDRATE >>                                <<01101>>11532000
      TOS := 2;  << UNIT 0 >>                                  <<01101>>11534000
      CIO1;  << SEND TO CHANNEL >>                             <<01101>>11536000
      DEL;                                                     <<01101>>11538000
      END;                                                     <<01101>>11540000
                                                               <<01101>>11542000
   SUBROUTINE READCHAR;                                        <<01101>>11544000
   BEGIN                                                       <<01101>>11546000
      CHAR := 0;                                               <<01101>>11548000
      TOS := 0;                                                <<01101>>11550000
      ASSEMBLE( SCLK );                                        <<01101>>11552000
      TOS := CONSOLEDRT;                                       <<01101>>11554000
      DO BEGIN                                                 <<01101>>11556000
         TIO0;                                                 <<01101>>11558000
         IF TOS.(4:1) THEN  <<COMPLETION>>                     <<01101>>11560000
            BEGIN                                              <<01101>>11562000
            TIO0;                                              <<01101>>11564000
            IF NOT TOS.(5:1) THEN << RECEIVE? >>               <<01101>>11566000
               BEGIN                                           <<01101>>11568000
               RIO0;                                           <<01101>>11570000
               UNIT := S0.(0:5);                               <<01101>>11572000
               CHAR := TOS.(9:7);                              <<01101>>11574000
               END;                                            <<01101>>11576000
            TOS := 1;                                          <<01101>>11578000
            CIO1;   <<ACK INT>>                                <<01101>>11580000
            END;                                               <<01101>>11582000
         ASSEMBLE( RCLK );                                     <<01101>>11584000
         END UNTIL TOS > WAITMS OR CHAR <> 0;                  <<01101>>11586000
      DEL;  <<DEVICE NUMBER>>                                  <<01101>>11588000
   END;  << READCHAR >>                                        <<01101>>11590000
                                                               <<01101>>11592000
   CHARCNT := 0;     <<INIT. CHAR COUNT FOR WRITECHAR>>        <<03003>>11594000
   TOS := CONSOLEDRT;                                          <<01101>>11596000
   TOS := %100000;                                             <<01101>>11598000
   CIO1;   <<MASTER CLEAR -- READY THE BOARD>>                 <<01101>>11600000
   HP26XX := FALSE;                                            <<01101>>11602000
                                                               <<01101>>11604000
   <<  * * *   AUTOMATIC SPEED SENSE   * * *  >>               <<01101>>11606000
                                                               <<01101>>11608000
   I := 0;                                                     <<01101>>11610000
   DO BEGIN                                                    <<01101>>11612000
      BAUDRATE := BRPARAM(I);                                  <<01101>>11614000
      CONSPEED := SPEEDS(I);                                   <<01101>>11616000
      WAITMS := TIME(I);                                       <<01101>>11618000
      SETRECSPEED;                                             <<01101>>11620000
      WRITECHAR( ENQ);                                         <<01101>>11622000
      READCHAR;                                                <<01101>>11624000
      IF UNIT = 0 AND CHAR = ACK THEN HP26XX := TRUE;          <<01101>>11626000
      I := I+1;                                                <<01101>>11628000
      END UNTIL I > 5 OR HP26XX;                               <<01101>>11630000
   IF HP26XX THEN RETURN ELSE BAUDRATE := 0;                   <<01101>>11632000
                                                               <<01101>>11634000
   <<  * * *   MUST NOT BE A 26XX TERMINAL   * * *   >>        <<01101>>11636000
   <<  * * *   SET UP DIAGNOSTIC CHANNELS    * * *   >>        <<01101>>11638000
                                                               <<01101>>11640000
   TOS := [1/1,1/0,    <<OUTPUT RECIEVE PARAMETERS>>           <<01101>>11642000
           1/1,        <<INTERRUPTS ENABLED>>                  <<01101>>11644000
           1/0,        <<ECHO OFF>>                            <<01101>>11646000
           1/0,        <<NO DATA TO AUX CHANNELS>>             <<01101>>11648000
           3/2,        <<10 BIT CHARACTER>>                    <<01101>>11650000
           8/0];       <<BAUD RATE>>                           <<01101>>11652000
   TOS := S0+BRPARAM;   <<2400 BAUD>>                          <<01101>>11654000
   TOS.(4:1) := 1;  <<SEND DATA TO AUX CHANNELS>>              <<01101>>11656000
   WIO2;                                                       <<01101>>11658000
   TOS := 2;                                                   <<01101>>11660000
   CIO2;   <<SEND TO UNIT 0>>                                  <<01101>>11662000
   UNIT := 16;                                                 <<01101>>11664000
   DO BEGIN  <<CONFIGURE DIAGNOSTIC CHANNELS>>                 <<01101>>11666000
      TOS := S0+BRPARAM(UNIT-15);                              <<01101>>11668000
      IF BRPARAM(X)=%202 THEN TOS.(7:1) := 1; <<11 BIT CHAR>>  <<01101>>11670000
      WIO2;                                                    <<01101>>11672000
      TOS := UNIT&LSL(9)+2;   <<CONTROL WORD>>                 <<01101>>11674000
      CIO2;   <<SEND TO PROPER UNIT>>                          <<01101>>11676000
      UNIT := UNIT+1;                                          <<01101>>11678000
      END UNTIL UNIT=21;  <<LAST DIAGNOSTIC CHANNEL>>          <<01101>>11680000
   DEL;   <<CONTROL WORD>>                                     <<01101>>11682000
                                                               <<01101>>11684000
   WAITMS := -1;                                               <<01101>>11686000
   DO BEGIN                                                    <<01101>>11688000
      READCHAR;                                                <<01101>>11690000
      IF CHAR = CR AND NOT(1 <= UNIT <= 15) THEN               <<01101>>11692000
         BEGIN   << GOT A CARRIAGE RETURN >>                   <<01101>>11694000
         X := IF UNIT = 0 THEN 0 ELSE UNIT-15;                 <<01101>>11696000
         BAUDRATE := BRPARAM(X);                               <<01101>>11698000
         CONSPEED := SPEEDS(X);                                <<01101>>11700000
         END;                                                  <<01101>>11702000
      END UNTIL BAUDRATE <> 0;                                 <<01101>>11704000
                                                               <<01101>>11706000
   TOS := %100000; << MASTER CLEAR--STOP DIAG CHANNELS>>       <<01101>>11708000
   CIO1;                                                       <<01101>>11710000
END;   <<SPEEDSENSE>>                                          <<01101>>11712000
$IF         << ********** RETURNING TO COMMON CODE ******** >> <<03004>>11714000
$CONTROL SEGMENT=RESIDENT                                      <<03715>>11716000
         <<-------------------------------------->>            <<03715>>11718000
         <<  DELAY FOR A NUMBER OF MILLISECONDS  >>            <<03715>>11720000
         <<-------------------------------------->>            <<03715>>11722000
PROCEDURE DELAY( WAIT'TIME);                                   <<03715>>11724000
VALUE WAIT'TIME;                                               <<03715>>11726000
DOUBLE                                                         <<03715>>11728000
   WAIT'TIME;         << NO. OF MILLISECONDS TO DELAY >>       <<03715>>11730000
                                                               <<03715>>11732000
COMMENT                                                        <<03715>>11734000
THIS PROCEDURE DELAYS (WAITS) FOR THE NUMBER OF MILLISECONDS   <<03715>>11736000
SPECIFIED BY "WAIT'TIME".  IT USES THE PROCESS CLOCK TO        <<03715>>11738000
TIME THE DELAY (RCLK INSTRUCTION).  SINCE THIS CLOCK DOES NOT  <<03715>>11740000
INCREMENT WHEN RUNNING ON THE ICS, THIS PROCEDURE WILL RETURN  <<03715>>11742000
IMMEDIATELY IN THAT CASE.  WE CANNOT RELY ON THE WAY           <<03715>>11744000
THAT RCLK ROLLS OVER, SO WE KEEP A SEPARATE COUNTER THAT       <<03715>>11746000
COUNTS CHANGES IN RCLK.                                        <<03715>>11748000
;                                                              <<03715>>11750000
BEGIN                                                          <<03715>>11752000
LOGICAL                                                        <<03715>>11754000
   NEW'RCLK,             << LATEST VALUE OF RCLK >>            <<03715>>11756000
   LAST'RCLK;            << PREVIOUS VALUE OF RCLK >>          <<03715>>11758000
DOUBLE                                                         <<03715>>11760000
   CURTIME;              << CURRENT TIMEOUT CLOCK VALUE >>     <<03715>>11762000
                                                               <<03715>>11764000
IF ON'ICS THEN         << IF RUNNING ON ICS, RCLK DOES NOT >>  <<03715>>11766000
   RETURN;             <<    INCREMENT, SO JUST RETURN     >>  <<03715>>11768000
                                                               <<03715>>11770000
CURTIME := 0D;         << SET INITIAL TIMEOUT CLOCK >>         <<03715>>11772000
LAST'RCLK := RCLK;     << GET INITIAL RCLK >>                  <<03715>>11774000
                                                               <<03715>>11776000
DO                                                             <<03715>>11778000
   BEGIN    << WAIT FOR SPECIFIED NO. OF MILLISECONDS >>       <<03715>>11780000
   NEW'RCLK := RCLK;                                           <<03715>>11782000
   IF NEW'RCLK <> LAST'RCLK THEN     << INCREMENT CLOCK IF >>  <<03715>>11784000
      CURTIME := CURTIME + 1D;       <<    RCLK HAS TICKED >>  <<03715>>11786000
   LAST'RCLK := NEW'RCLK;                                      <<03715>>11788000
                                                               <<03715>>11790000
   END                                                         <<03715>>11792000
UNTIL CURTIME > WAIT'TIME;                                     <<03715>>11794000
END;  << DELAY >>                                              <<03715>>11796000
$PAGE                                                          <<03004>>11798000
$IF X1=ON   << ********* SERIES 33,44,55 UNIQUE ********** >>  <<03004>>11800000
$CONTROL SEGMENT=CONFIGURE                                     <<03004>>11802000
           <<----------------------------->>                   <<03004>>11804000
           <<    DETERMINE BOARD TYPE     >>                   <<03004>>11806000
           <<----------------------------->>                   <<03004>>11808000
  INTEGER PROCEDURE GETBOARDTYPE( DRT);                        <<03004>>11810000
  VALUE DRT;                                                   <<03004>>11812000
  LOGICAL DRT;     << DRT NUMBER OF DEVICE >>                  <<03004>>11814000
  COMMENT                                                      <<03004>>11816000
     THIS PROCEDURE RETURNS THE BOARD IDENTIFICATION           <<03004>>11818000
     FOUND ON A PARTICULAR CHANNEL IN THE LOW-ORDER            <<03004>>11820000
     4 BITS.  IF NO BOARD RESPONDS, IT RETURNS NEGATIVE.       <<03004>>11822000
     CAUTION:  THIS PROCEDURE INITIALIZES THE DRT SO NO        <<03004>>11824000
     CHANNEL PROGRAM MAY BE ACTIVE WHEN IT IS CALLED;          <<03004>>11826000
                                                               <<03004>>11828000
     BEGIN                                                     <<03004>>11830000
     EQUATE RE   = %(16)E;                                     <<03004>>11832000
     INTEGER TEMP;                                             <<03022>>11834000
     LOGICAL READ'COMMAND := 0,                                <<03004>>11836000
             REG'NUMB     := RE;                               <<03004>>11838000
     DRT := DRT LAND %770;  << STRIP OFF DEVICE NO. >>         <<03004>>11840000
     INITDRT( DRT);  << INITIALIZE DRT, ESPECIALLY SO THAT >>  <<03004>>11842000
                     << BIT 2 OF 4TH WORD OF DRT = 0       >>  <<03004>>11844000
                                                               <<03022>>11846000
     << READ BOARD IDENTIFICATION >>                           <<03022>>11848000
     TEMP := RIOC( DRT, READ'COMMAND CAT REG'NUMB(4:12:4));    <<03022>>11850000
                                                               <<03022>>11852000
     IF < THEN     << BOARD DID NOT RESPOND >>                 <<03004>>11854000
        GETBOARDTYPE := -1                                     <<03004>>11856000
     ELSE                                                      <<03004>>11858000
        GETBOARDTYPE := TEMP;                                  <<SYPTR>>11860000
     END;  << GETBOARDTYPE >>                                  <<03004>>11862000
$IF X1=OFF   << ********** SERIES II,III UNIQUE *********** >> <<03003>>11864000
$CONTROL SEGMENT=RESIDENT                                      <<03003>>11866000
          <<---------------------------->>                     <<03003>>11868000
          <<WRITE A CHARACTER ON CONSOLE>>                     <<03003>>11870000
          <<---------------------------->>                     <<03003>>11872000
  LOGICAL PROCEDURE WRITECHAR(CHAR);                           <<03003>>11874000
    VALUE CHAR;                                                <<03003>>11876000
    INTEGER CHAR;  <<CHARACTER TO BE OUTPUT>>                  <<03003>>11878000
    COMMENT                                                    <<03003>>11880000
      OUTPUTS A CHARACER TO THE CONSOLE;                       <<03003>>11882000
      BEGIN                                                    <<03003>>11884000
          EQUATE  ENQ=5, ACK=6;                                <<03003>>11886000
          TOS := CONSOLEDRT;                                   <<03003>>11888000
          TOS := BAUDRATE+%161000; <<ENABLE INTS-SEND PARAM.>> <<03003>>11890000
          IF BAUDRATE=%202 THEN TOS.(7:1) := 1; <<11 BIT CHAR>><<03003>>11892000
          WIO1;                                                <<03003>>11894000
          TOS := 2;    <<UNIT 0>>                              <<03003>>11896000
          CIO1;  <<SEND TO CHANNEL>>                           <<03003>>11898000
          TOS := CHAR.(9:7)+%43400;  <<CHARACTER TO SEND>>     <<03003>>11900000
          WIO1;                                                <<03003>>11902000
          TOS := 2;                                            <<03003>>11904000
          CIO1;  <<SEND TO UNIT 0>>                            <<03003>>11906000
  WAIT:   DO TIO0 UNTIL TOS.(4:1) <> 0; <<WAIT FOR COMPLETION>><<03003>>11908000
          TIO0;                                                <<03003>>11910000
          IF NOT TOS.(5:1) THEN                                <<03003>>11912000
            BEGIN  <<WRONG DIRECTION>>                         <<03003>>11914000
  WRONGUNIT:  TOS := 1;                                        <<03003>>11916000
              CIO1;                                            <<03003>>11918000
              GO WAIT;                                         <<03003>>11920000
            END;                                               <<03003>>11922000
          RIO0;                                                <<03003>>11924000
          IF TOS.(0:5)<>0 THEN GO WRONGUNIT;                   <<03003>>11926000
          TOS := 1;  <<ACK INT>>                               <<03003>>11928000
          CIO1;                                                <<03003>>11930000
          IF HP26XX THEN                                       <<03003>>11932000
             IF (CHARCNT:=CHARCNT+1) >= 79 THEN                <<03003>>11934000
                BEGIN                                          <<03003>>11936000
                CHARCNT := 0; << ZERO CHARACTER COUNTER >>     <<03003>>11938000
                WRITECHAR( ENQ);                               <<03003>>11940000
                DO UNTIL READCHAR.(9:7)=ACK; <<WAIT FOR ACK>>  <<03003>>11942000
                END;                                           <<03003>>11944000
      END <<WRITECHAR>> ;                                      <<03003>>11946000
$PAGE                                                          <<03003>>11948000
$CONTROL SEGMENT=RESIDENT                                      <<03003>>11950000
          <<----------------------------->>                    <<03003>>11952000
          <<READ A CHARACTER FROM CONSOLE>>                    <<03003>>11954000
          <<----------------------------->>                    <<03003>>11956000
  INTEGER PROCEDURE READCHAR( WAITMS);                         <<03003>>11958000
  VALUE WAITMS;                                                <<03003>>11960000
  LOGICAL WAITMS;     <<DUMMY PARAMETER>>                      <<03003>>11962000
  OPTION VARIABLE;                                             <<03003>>11964000
     COMMENT                                                   <<03003>>11966000
     THIS PROCEDURE CAN BE CALLED WITH AN OPTIONAL             <<03003>>11968000
     PARAMETER WHICH IS NOT USED.  IT IS THERE TO MAKE         <<03003>>11970000
     THE PROCEDURE THE SAME AS READCHAR FOR THE SERIES 33,     <<03003>>11972000
     WHICH USES THE PARAMETER AS A READ TIMEOUT FOR AUTO-      <<03003>>11974000
     MATIC SPEED SENSING.  THIS TIMEOUT IS IMPLEMENTED         <<03003>>11976000
     IN PROCEDURE SPEEDSENSE FOR THE SERIES II/III;            <<03003>>11978000
      BEGIN                                                    <<03003>>11980000
          TOS := CONSOLEDRT;                                   <<03003>>11982000
          TOS := BAUDRATE+%131000; <<ENABLE INTS,ECHO>>        <<03003>>11984000
          IF BAUDRATE=%202 THEN TOS.(7:1) := 1; <<11 BIT CHAR>><<03003>>11986000
          WIO1;  <<SET BAUDRATE>>                              <<03003>>11988000
          TOS := 2;    <<UNIT 0>>                              <<03003>>11990000
          CIO1;  <<SEND TO CHANNEL>>                           <<03003>>11992000
  WRONGUNIT:  <<COME HERE IF WRONG UNIT USED>>                 <<03003>>11994000
          DO TIO0 UNTIL TOS.(4:1) <> 0;                        <<03003>>11996000
          TIO0;                                                <<03003>>11998000
          IF TOS.(5:1) THEN                                    <<03003>>12000000
            BEGIN  <<WRONG DIRECTION>>                         <<03003>>12002000
              TOS := 1;                                        <<03003>>12004000
              CIO1;  <<ACK INT>>                               <<03003>>12006000
              GO WRONGUNIT;                                    <<03003>>12008000
            END;                                               <<03003>>12010000
          TOS := 1;                                            <<03003>>12012000
          CIO1;   <<ACK INT>>                                  <<03003>>12014000
          RIO0;    <<READ CHARACTER>>                          <<03003>>12016000
          IF S0.(0:5)<>0 THEN                                  <<03003>>12018000
            BEGIN  <<WRONG UNIT>>                              <<03003>>12020000
              DEL;                                             <<03003>>12022000
              GO WRONGUNIT;                                    <<03003>>12024000
            END;                                               <<03003>>12026000
          READCHAR := TOS.(9:7);  <<RETURN CHARACTER>>         <<03003>>12028000
      END <<READCHAR>> ;                                       <<03003>>12030000
$PAGE                                                          <<03003>>12032000
$IF      <<**********RETURNING TO COMMON CODE************>>    <<03003>>12034000
$CONTROL SEGMENT = RESIDENT                                    <<03003>>12036000
         <<------------------------------->>                   <<03003>>12038000
         << PRINT A LINE ON THE CONSOLE   >>                   <<03003>>12040000
         <<------------------------------->>                   <<03003>>12042000
PROCEDURE PRINT( BUFF, LENGTH, CONTROL);                       <<03003>>12044000
VALUE LENGTH, CONTROL;                                         <<03003>>12046000
ARRAY BUFF;        << OUTPUT BUFFER >>                         <<03003>>12048000
INTEGER LENGTH,  << LENGTH OF TRANSFER, +WORDS OR -BYTES>>     <<03003>>12050000
        CONTROL; << LINE SPACE CONTROL WORD             >>     <<03003>>12052000
                                                               <<03003>>12054000
   COMMENT                                                     <<03003>>12056000
   PRINTS A LINE OF OUTPUT ON THE SYSTEM CONSOLE.              <<03003>>12058000
   IF "CONTROL" IS A ZERO, FOLLOWS WITH CR-LF;                 <<03003>>12060000
                                                               <<03003>>12062000
BEGIN                                                          <<03003>>12064000
   EQUATE CR = %15, LF = %12;                                  <<03003>>12066000
   INTEGER CHAR,         << TEMP. FOR 2 CURRENT CHARS. >>      <<03003>>12068000
           CHARCOUNT := 0;   << CURRENT CHAR. COUNT    >>      <<03003>>12070000
                                                               <<03003>>12072000
   << CONVERT LENGTH TO POSITIVE NO. OF BYTES >>               <<03003>>12074000
   TOS := LENGTH;                                              <<03003>>12076000
   LENGTH := IF > THEN TOS&LSL(1)                              <<03003>>12078000
             ELSE -TOS;                                        <<03003>>12080000
                                                               <<03003>>12082000
   WHILE CHARCOUNT < LENGTH DO     << WRITE OUT BUFFER >>      <<03003>>12084000
      BEGIN                                                    <<03003>>12086000
                                                               <<03003>>12088000
      << IN CASE DB IS NOT POINTING TO THE STACK,      >>      <<03003>>12090000
      << GRAB THE BUFFER A WORD AT A TIME.  IF BUFF    >>      <<03003>>12092000
      << IF NOT WITHIN  32K BYTES OF THE STACK, BYTE   >>      <<03003>>12094000
      << ADDRESSING WOULD NOT WORK.                    >>      <<03003>>12096000
                                                               <<03003>>12098000
      CHAR := BUFF( CHARCOUNT&LSR(1));                         <<03003>>12100000
                                                               <<03003>>12102000
      << IF CHARCOUNT IS EVEN GET LEFT BYTE, ELSE RIGHT  >>    <<03003>>12104000
      WRITECHAR( IF LOGICAL( CHARCOUNT) THEN CHAR.(8:8)        <<03003>>12106000
                                        ELSE CHAR.(0:8));      <<03003>>12108000
      CHARCOUNT := CHARCOUNT + 1;                              <<03003>>12110000
      END;                                                     <<03003>>12112000
                                                               <<03003>>12114000
   IF CONTROL = 0 THEN                                         <<03003>>12116000
      BEGIN                                                    <<03003>>12118000
      WRITECHAR(CR);     << CARRIAGE RETURN >>                 <<03003>>12120000
      WRITECHAR(LF);     << LINE FEED       >>                 <<03003>>12122000
      END;                                                     <<03003>>12124000
END;       << PRINT >>                                         <<03003>>12126000
$CONTROL SEGMENT = RESIDENT                                    <<03003>>12128000
          <<-------------------->>                             <<03003>>12130000
          <<READ A LINE OF INPUT>>                             <<03003>>12132000
          <<-------------------->>                             <<03003>>12134000
  PROCEDURE READINPUT(BUFFER);                                 <<03003>>12136000
  INTEGER ARRAY BUFFER;                                        <<03003>>12138000
  OPTION VARIABLE;                                             <<03003>>12140000
    COMMENT                                                    <<03003>>12142000
      READS A LINE OF INPUT FROM THE SYSTEM CONSOLE INTO THE   <<03003>>12144000
    BUFFER INBUF, UNLESS ANOTHER BUFFER IS SPECIFIED;          <<03003>>12146000
      BEGIN                                                    <<03003>>12148000
        EQUATE CTRLH=%10,CTRLX=%30,LF=%12,CR=%15;              <<03003>>12150000
        INTEGER I:=0,CHAR,PARMS=Q-4;                           <<03003>>12152000
        LOGICAL PREV'H := FALSE; <<LAST CHAR WAS A CTL H>>     <<03003>>12154000
        DOUBLE DELETED := "!!! ";                              <<03003>>12156000
        POINTER WPBUFFER;                                      <<04306>>12158000
        BYTE POINTER BPBUFFER;                                 <<03003>>12160000
        CHARCNT := 0; <<ZERO HP26XX COUNTER>>                  <<03003>>12162000
READAGAIN:                                                     <<03003>>12164000
        IF PARMS.(15:1)=0 THEN                                 <<03003>>12166000
          BEGIN <<USE INBUF>>                                  <<03003>>12168000
          @WPBUFFER := @INBUF;                                 <<04306>>12170000
          @BPBUFFER:=@INBUF&LSL(1);                            <<03003>>12172000
          @BPINBUF := @INBUF&LSL(1);                           <<03003>>12174000
          END                                                  <<03003>>12176000
        ELSE                                                   <<03003>>12178000
          BEGIN                                                <<04306>>12180000
          @WPBUFFER := @BUFFER;                                <<04306>>12182000
          @BPBUFFER:=@BUFFER&LSL(1);                           <<03003>>12184000
          END;                                                 <<04306>>12186000
  NEXTCHAR:                                                    <<03003>>12188000
          CHAR := READCHAR.(9:7);                              <<03003>>12190000
          IF CHAR=0 OR <<NULL>>                                <<03003>>12192000
             CHAR=%23 OR  <<X-OFF>>                            <<03003>>12194000
             CHAR=%12 OR  <<LF>>                               <<03003>>12196000
             CHAR=%177 THEN GO NEXTCHAR;  <<RUBOUT>>           <<03003>>12198000
          IF CHAR=CTRLH THEN                                   <<03003>>12200000
            BEGIN   <<BACKSPACE>>                              <<03003>>12202000
              IF I=0 THEN     << NO CHARACTERS ON LINE >>      <<03003>>12204000
                 IF HP26XX THEN                                <<03003>>12206000
                    WRITECHAR(" ")                             <<03003>>12208000
                 ELSE                                          <<03003>>12210000
                    WRITECHAR("/")                             <<03003>>12212000
              ELSE                                             <<03003>>12214000
                 BEGIN                                         <<03003>>12216000
                 I := I-1;   << DECREMENT CHARACTER COUNT >>   <<03003>>12218000
                 IF HP26XX THEN                                <<03003>>12220000
                    BEGIN                                      <<03003>>12222000
                    IF NOT PREV'H THEN WRITECHAR(LF);          <<03003>>12224000
                    PREV'H := TRUE;                            <<03003>>12226000
                    END                                        <<03003>>12228000
                 ELSE                                          <<03003>>12230000
                    WRITECHAR("/");                            <<03003>>12232000
                 END;                                          <<03003>>12234000
              GOTO NEXTCHAR;                                   <<03003>>12236000
            END;                                               <<03003>>12238000
          IF CHAR=CTRLX THEN                                   <<03003>>12240000
            BEGIN   <<DELETE LINE>>                            <<03003>>12242000
              I := 0;                                          <<03003>>12244000
              PRINT(DELETED,-3,0); << "!!!" >>                 <<03003>>12246000
              GO NEXTCHAR;                                     <<03003>>12248000
            END;                                               <<03003>>12250000
          IF LOGICAL(I) THEN WPBUFFER(I&LSR(1)).(8:8) := CHAR  <<SI.DR>>12252000
                        ELSE WPBUFFER(I&LSR(1)).(0:8) := CHAR; <<SI.DR>>12254000
          IF CHAR=CR THEN                                      <<03003>>12256000
            BEGIN   <<CARRIAGE RETURN>>                        <<03003>>12258000
              WRITECHAR(LF);   <<OUTPUT A LINE FEED>>          <<03003>>12260000
              IF WPBUFFER = [8/"?",8/13] THEN                  <<SI.DR>>12262000
                 BEGIN                                         <<03003>>12264000
                 HELP;                                         <<03003>>12266000
                 MOVE WPBUFFER := "READ PENDING";              <<SI.DR>>12268000
                 PRINT(WPBUFFER,-12,0);                        <<04306>>12270000
                 I := 0;                                       <<03003>>12272000
                 GO READAGAIN;                                 <<03003>>12274000
                 END;                                          <<03003>>12276000
              RETURN;                                          <<03003>>12278000
            END;                                               <<03003>>12280000
          IF I<72 THEN I:=I+1;                                 <<03003>>12282000
          PREV'H := FALSE;                                     <<03003>>12284000
          GOTO NEXTCHAR;                                       <<03003>>12286000
      END <<READINPUT>> ;                                      <<03003>>12288000
$PAGE                                                          <<03003>>12290000
$IF X1=ON   << ********** SERIES 33 UNIQUE **********>>        <<03003>>12292000
$CONTROL SEGMENT = CONFIGURE                                   <<03004>>12294000
           <<-------------------------------->>                <<03004>>12296000
           << RESET THE SYSTEM CONSOLE BOARD >>                <<03004>>12298000
           <<-------------------------------->>                <<03004>>12300000
PROCEDURE CONSOLEINIT;                                         <<03004>>12302000
   COMMENT                                                     <<03004>>12304000
   RESETS THE SYSTEM CONSOLE BOARD, EITHER LYNX OR ADCC.       <<03004>>12306000
   CALLED ONCE BEFORE SPEEDSENSING AND AGAIN IF AUTO-          <<03004>>12308000
   SPEEDSENSE FAILS;                                           <<03004>>12310000
   BEGIN                                                       <<03004>>12312000
                         << ADCC PARAMETERS >>                 <<03004>>12314000
   ARRAY INITPGM(*) = PB :=    << CHANNEL PROGRAM >>           <<03004>>12316000
     <<  0 >>      %2001,  << WRITE, MOD 1                >>   <<03004>>12318000
     <<  1 >>          1,  << MASTER RESET, 1 START,      >>   <<03004>>12320000
     <<  2 >>          1,  << 8 DATA, 1 STOP, NO PARITY   >>   <<03004>>12322000
     <<  3 >>    %160000,                                      <<03004>>12324000
     <<  4 >>          0,                                      <<03004>>12326000
                                                               <<03004>>12328000
     <<  5 >>      %2007,  << WRITE, MOD 7                >>   <<03004>>12330000
     <<  6 >>          1,  << SET LINE REFERENCE TO       >>   <<03004>>12332000
     <<  7 >>          1,  << A KNOWN STATE               >>   <<03004>>12334000
     << 10 >>    %160000,                                      <<03004>>12336000
     << 11 >>          0,                                      <<03004>>12338000
                                                               <<03004>>12340000
     << 12 >>       %600,  << INTERRUPT, HALT             >>   <<03004>>12342000
     << 13 >>          0,                                      <<03004>>12344000
                                                               <<03004>>12346000
     << 14 >>       %231,  << DATA FOR MASTER RESET, ETC. >>   <<03004>>12348000
     << 15 >>        %40;  << DATA FOR SET LINE REFERENCE >>   <<03004>>12350000
                                                               <<03004>>12352000
   EQUATE                                                      <<03004>>12354000
      INIT'RSTADR         =  %4,                               <<03004>>12356000
      INIT'REFADR         = %11,                               <<03004>>12358000
      INIT'MASTERESET     = %14,                               <<03004>>12360000
      INIT'SETREF         = %15,                               <<03004>>12362000
      INIT'LEN            = %16;                               <<03004>>12364000
                                                               <<03004>>12366000
   ARRAY BUF(0:INIT'LEN-1) = Q;  << FOR BUILDING CHAN. PROG.>> <<03004>>12368000
   DOUBLE DADR;         << ABSOLUTE ADDR OF CHAN. PROG. >>     <<03004>>12370000
   INTEGER                                                     <<03004>>12372000
      BANK = DADR,      << BANK OF ARRAY BUF            >>     <<03004>>12374000
      ADR = DADR+1,     << ADDRESS OF ARRAY BUF         >>     <<03004>>12376000
      CPADR;            << ABSOLUTE ADDR. OF CHAN. PROG.>>     <<03004>>12378000
                                                               <<03004>>12380000
                         << LYNX PARAMETERS >>                 <<03004>>12382000
   LOGICAL INIT'COMMAND := %20000;                             <<03004>>12384000
                                                               <<03004>>12386000
                                                               <<03004>>12388000
   IF ((GETBOARDTYPE(CONSOLEDRT) = LYNX'BOARD) OR              <<08392>>12390000
      (GETBOARDTYPE(CONSOLEDRT) = TIC'BOARD)) THEN             <<08392>>12392000
      BEGIN   << CONSOLE IS ON LYNX >>                         <<03004>>12394000
                                                               <<03022>>12396000
      << SEND INIT COMMAND TO LYNX >>                          <<03022>>12398000
      WIOC( CONSOLEDRT, INIT'COMMAND, 0);                      <<03022>>12400000
      IF <> THEN ERRMESSAGE( M1, CONSOLEDRT);   << FAILURE >>  <<03022>>12402000
                                                               <<03022>>12404000
      DELAY( 70D);  <<GIVE INIT TIME TO COMPLETE>>             <<T8392>>12406000
                    <<SERIES 37 IS SLOW>>                      <<T8392>>12408000
      END     << CONSOLE IS ON LYNX >>                         <<03004>>12410000
                                                               <<03004>>12412000
   ELSE                                                        <<03004>>12414000
      BEGIN   << CONSOLE IS ON ADCC >>                         <<03004>>12416000
      CPADR := ABSOLUTE( TERMCHANPROG);                        <<03004>>12418000
      PUSH( DB);                                               <<03004>>12420000
      TOS := TOS + @BUF;                                       <<03004>>12422000
      DADR := TOS;                                             <<03004>>12424000
                                                               <<03004>>12426000
      << SET UP INITIALIZATION CHANNEL PROGRAM ON STACK >>     <<03004>>12428000
                                                               <<03004>>12430000
      MOVE BUF := INITPGM,(INIT'LEN);                          <<03004>>12432000
      BUF( INIT'RSTADR) := CPADR+INIT'MASTERESET;              <<03004>>12434000
      BUF( INIT'REFADR) := CPADR+INIT'SETREF;                  <<03004>>12436000
                                                               <<03004>>12438000
      << MOVE CHAN PGM TO CHAN PGM AREA IN BANK 0 >>           <<03004>>12440000
      MABS( 0,CPADR,BANK,ADR,INIT'LEN);                        <<03004>>12442000
                                                               <<03004>>12444000
      << DO INIT ON CONSOLE                       >>           <<03004>>12446000
      INIT( CONSOLEDRT);                                       <<03022>>12448000
      IF <> THEN ERRMESSAGE( M2, CONSOLEDRT);   << FAILURE >>  <<03022>>12450000
                                                               <<03004>>12452000
      << RUN THE CHANNEL PROGRAM                  >>           <<03004>>12454000
      SIOP( CONSOLEDRT, CPADR);                                <<03022>>12456000
      IF <> THEN ERRMESSAGE( M2, CONSOLEDRT);   << FAILURE >>  <<03022>>12458000
      WHILE GETDRT( CONSOLEDRT, CHANSTAT).(0:2) <> 0 DO;       <<03004>>12460000
      END;    << CONSOLE IS ON ADCC >>                         <<03004>>12462000
   END;   << CONSOLEINIT >>                                    <<03004>>12464000
$CONTROL SEGMENT = CONFIGURE                                   <<03003>>12466000
         <<------------------------------------------>>        <<03003>>12468000
         << TRY TO SPEED SENSE CONSOLE AUTOMATICALLY >>        <<03003>>12470000
         <<------------------------------------------>>        <<03003>>12472000
LOGICAL PROCEDURE AUTOSPEEDSENSE;                              <<03003>>12474000
   COMMENT                                                     <<03003>>12476000
   TRY TO DETERMINE SPEED OF THE TERMINAL BY SENDING ENQ       <<03003>>12478000
   AND WAITING FOR ACK TO RETURN, AT ALL POSSIBLE TERMINAL     <<03003>>12480000
   SPEEDS.  WORKS ONLY FOR 26XX TYPE TERMINALS;                <<03003>>12482000
   BEGIN                                                       <<03003>>12484000
   INTEGER ARRAY BRPARAM(0:10) = PB :=  <<BAUD RATE PARAMS. >> <<03004>>12486000
      %10,         << 9600>>            <<FOR ADCC, LYNX    >> <<03004>>12488000
      %11,         << 4800>>                                   <<03004>>12490000
      %7,          << 2400>>                                   <<03004>>12492000
      %13,         << 1200>>                                   <<03004>>12494000
      %6,          <<  600>>                                   <<03004>>12496000
      %15,         <<  300>>                                   <<03004>>12498000
      %16,         <<  150>>                                   <<03004>>12500000
      %17,         <<  110>>                                   <<03004>>12502000
      %20,         <<19200>>            << THE LAST 3 SPEEDS>> <<03004>>12504000
      %21,         <<38400>>            << FOR LYNX ONLY    >> <<03004>>12506000
      %22;         << 1800>>                                   <<03004>>12508000
   INTEGER ARRAY SPEEDS(0:10) = PB :=   << BAUD RATES IN    >> <<03004>>12510000
      960,480,240,120,60,30,15,10,      <<  CHARS/SECOND    >> <<03004>>12512000
          1920,3840,180;                                       <<03004>>12514000
   EQUATE WAITMS = 200;    << 200 MILLISECOND TIMEOUT >>       <<03003>>12516000
   EQUATE  ENQ=5, ACK=6;                                       <<03003>>12518000
   INTEGER I,               << INDEX VARIABLE               >> <<03003>>12520000
           CHAR,            << TEMP FOR CURRENT CHARACTER   >> <<03004>>12522000
           LIM;             << ARRAY LIMIT                  >> <<03004>>12524000
   LOGICAL FOUND = AUTOSPEEDSENSE;                             <<03003>>12526000
   FOUND := FALSE;                                             <<03003>>12528000
   I := 0;                                                     <<03003>>12530000
   IF ((GETBOARDTYPE(CONSOLEDRT) = LYNX'BOARD) OR              <<08392>>12532000
      (GETBOARDTYPE(CONSOLEDRT) = TIC'BOARD)) THEN LIM:=10     <<08392>>12534000
                                            ELSE LIM := 7;     <<03004>>12536000
   DO BEGIN     <<LOOP, TEST TERMINAL AT ALL POSSIBLE SPEEDS>> <<03003>>12538000
      BAUDRATE := BRPARAM(I);                                  <<03003>>12540000
      CONSPEED := SPEEDS(I);                                   <<03003>>12542000
      WRITECHAR( ENQ);       <<WRITE ENQ TO TERMINAL>>         <<03003>>12544000
      CHAR := READCHAR(WAITMS).(9:7); <<IF TERMINAL RESPONDS>> <<03003>>12546000
      IF CHAR = ACK THEN              << WITH ACK, IT'S AN  >> <<03003>>12548000
          FOUND := TRUE;              << HP26XX, QUIT LOOP >>  <<03003>>12550000
      I := I + 1;                                              <<03003>>12552000
      END                                                      <<03003>>12554000
   UNTIL I > LIM OR FOUND;        << CONTINUE TEST >>          <<03004>>12556000
   END;   << AUTOSPEEDSENSE >>                                 <<03003>>12558000
                                                               <<03003>>12560000
$CONTROL SEGMENT=CONFIGURE                                     <<03003>>12562000
          <<-------------------------->>                       <<03003>>12564000
          <<DETERMINE SPEED OF CONSOLE>>                       <<03003>>12566000
          <<-------------------------->>                       <<03003>>12568000
  PROCEDURE SPEEDSENSE;                                        <<03003>>12570000
    COMMENT                                                    <<03003>>12572000
    DETERMINES THE SPEED OF THE SYSTEM CONSOLE BY FIRST        <<03003>>12574000
    TRYING TO DETECT THE SPEED AUTOMATICALLY USING ENQ-ACK     <<03003>>12576000
    PAIRS (PROCEDURE AUTOSPEEDSENSE).  THIS ONLY WORKS ON      <<03003>>12578000
    26XX TYPE TERMINALS.  IF THIS DOESN'T WORK, IT SETS UP     <<03003>>12580000
    FOR A CERTAIN BAUDRATE, WAITS FOR THE OPERATOR TO TYPE     <<03003>>12582000
    A CR, AND THEN TRIES TO DETERMINE THE BAUDRATE FROM        <<03003>>12584000
    THE GARBAGE THAT COMES BACK;                               <<03003>>12586000
      BEGIN                                                    <<03003>>12588000
EQUATE NUMSPEEDS=15;                                           <<03003>>12590000
INTEGER ARRAY SPEEDS(6:NUMSPEEDS)=PB:=60,240,960,480,          <<03003>>12592000
-1,120,-1,30,15,10;                                            <<03003>>12594000
INTEGER ARRAY SPEEDCODES(6:NUMSPEEDS)=PB:=6,7,8,9,             <<03003>>12596000
-1,11,-1,13,14,15;                                             <<03003>>12598000
<<ADCC CODES FOR FOR SUPPORTED TERMINAL SPEEDS>>               <<03003>>12600000
INTEGER ARRAY GARBAGECHAR(6:NUMSPEEDS)=PB:=                    <<03003>>12602000
%170,%15,%377,%376,-1,%346,-1,%200,%303,%7;                    <<03003>>12604000
<<VALUE EXPECTED IN CHAR FOR EACH SUPPORTED CONSOLE SPEED>>    <<03003>>12606000
                                                               <<03003>>12608000
INTEGER I:=0,                                                  <<03003>>12610000
        BOARD,    << BOARD TYPE ON CONSOLE CHANNEL >>          <<03004>>12612000
        CHAR;                                                  <<03003>>12614000
EQUATE NULL=0, <<THE NULL CHARACTER IS RECEIVED IF THE>>       <<03003>>12616000
       <<CONSOLE IS SENDING TOO SLOW COMPARED TO THE>>         <<03003>>12618000
       <<CONFIGURED SPEED.  USED AS A KEY TO>>                 <<03003>>12620000
       <<RECONFIGURE AND RE-READ.>>                            <<03003>>12622000
       DEFAULTSPEEDCODE=7, <<START BY ASSUMING 2400BAUD>>      <<03003>>12624000
       DEFAULTSPEED=240,                                       <<03003>>12626000
       SECONDSPEEDCODE=14, <<IF 2400 RETURNS THE NULL>>        <<03003>>12628000
       <<CHARACTER, RECONFIGURE AT 150 AND RETRY>>             <<03003>>12630000
       SECONDSPEED=15;                                         <<03003>>12632000
       LOGICAL FOUND := FALSE;                                 <<03003>>12634000
                                                               <<03003>>12636000
                  <<INITIALIZE CHAR. COUNT FOR WRITECHAR >>    <<03003>>12638000
          CHARCNT := 0;                                        <<03003>>12640000
                                                               <<03003>>12642000
          BOARD := GETBOARDTYPE(CONSOLEDRT);                   <<03004>>12644000
          << IF WRONG BOARD OR NO BOARD RESPONDS ON     >>     <<03004>>12646000
          << CONSOLE CHANNEL, DO A HALT %10             >>     <<03004>>12648000
          IF BOARD <> LYNX'BOARD AND BOARD <> ADCC'MAIN AND    <<SYPTR>>12650000
             BOARD <> ADCC'EXT AND BOARD <> TIC'BOARD THEN     <<08392>>12652000
             ASSEMBLE( HALT %10);                              <<03004>>12654000
                                                               <<03004>>12656000
          << INITIALIZE LYNX OR ADCC BOARD >>                  <<03004>>12658000
          CONSOLEINIT;                                         <<03003>>12660000
                                                               <<03003>>12662000
          << CALL AUTOSPEEDSENSE TO TRY TO DETERMINE THE   >>  <<03003>>12664000
          << SYSTEM CONSOLE BAUDRATE AUTOMATICALLY.  ONLY  >>  <<03003>>12666000
          << WORKS FOR 26XX TERMINALS.  AUTOSPEEDSENSE     >>  <<03003>>12668000
          << RETURNS TRUE IF IT SUCCEEDS.                  >>  <<03003>>12670000
                                                               <<03003>>12672000
          HP26XX := FALSE;                                     <<03003>>12674000
          IF AUTOSPEEDSENSE THEN                               <<03003>>12676000
             BEGIN                                             <<03003>>12678000
             HP26XX := TRUE;                                   <<03003>>12680000
             RETURN;                                           <<03003>>12682000
             END;                                              <<03003>>12684000
                                                               <<03003>>12686000
          << NOT AN HP26XX TERMINAL--MUST DETERMINE CONSOLE>>  <<03003>>12688000
          << SPEED BY SETTING THE CONSOLE TO A CERTAIN     >>  <<03003>>12690000
          << SPEED AND INTERPRETING THE GARBAGE THAT COMES >>  <<03003>>12692000
          << BACK, HOPING THE OPERATOR TYPES A CR.         >>  <<03003>>12694000
                                                               <<03003>>12696000
          DO                                                   <<03003>>12698000
             BEGIN <<MAKE OPERATOR TYPE CR>>                   <<03003>>12700000
             CONSOLEINIT;                                      <<03003>>12702000
             BAUDRATE := DEFAULTSPEEDCODE;                     <<03003>>12704000
             CONSPEED:=DEFAULTSPEED;                           <<03003>>12706000
             CHAR:=READCHAR(0).(8:8);                          <<03003>>12708000
                                                               <<03003>>12710000
          << IF CONSOLE IS SENDING TOO SLOW COMPARED TO    >>  <<03003>>12712000
          << THE CONFIGURED SPEED, A NULL CHARACTER IS     >>  <<03003>>12714000
          << RETURNED FROM READCHAR ( BEFORE OPERATOR TYPES>>  <<03003>>12716000
          << ANYTHING).  SO, RECONFIGURE AT LOWEST POSSIBLE>>  <<03003>>12718000
          << SPEED (110) AND READ A CHARACTER.  OTHERWISE, >>  <<03003>>12720000
          << INTERPRET THE GARBAGE THAT CAME BACK.         >>  <<03003>>12722000
                                                               <<03003>>12724000
             IF CHAR=NULL THEN                                 <<03003>>12726000
                BEGIN  << RECONFIGURE AND RETRY >>             <<03003>>12728000
                BAUDRATE := SECONDSPEEDCODE;                   <<03003>>12730000
                CONSPEED:=SECONDSPEED;                         <<03003>>12732000
                CHAR:=READCHAR(0).(8:8);                       <<03003>>12734000
                END;                                           <<03003>>12736000
             I:=6; <<LOWEST SUPPORTED SPEED>>                  <<03003>>12738000
             DO                                                <<03003>>12740000
                BEGIN <<TEST FOR VALID SPEED>>                 <<03003>>12742000
                IF CHAR=GARBAGECHAR(I) THEN                    <<03003>>12744000
                   BEGIN <<FOUND IT>>                          <<03003>>12746000
                   BAUDRATE := SPEEDCODES(I);                  <<03003>>12748000
                   CONSPEED:=SPEEDS(I);                        <<03003>>12750000
                   FOUND:=TRUE;                                <<03003>>12752000
                   END;                                        <<03003>>12754000
                END                                            <<03003>>12756000
             UNTIL (I:=I+1)>NUMSPEEDS;                         <<03003>>12758000
             IF CHAR=%362 THEN                                 <<03003>>12760000
                BEGIN <<SPECIAL ALTERNATE CASE FOR 4800>>      <<03003>>12762000
                BAUDRATE := SPEEDCODES(9);                     <<03003>>12764000
                CONSPEED:=SPEEDS(9);                           <<03003>>12766000
                FOUND:=TRUE;                                   <<03003>>12768000
                END;                                           <<03003>>12770000
             END                                               <<03003>>12772000
          UNTIL FOUND;                                         <<03003>>12774000
      END <<SPEEDSENSE>> ;                                     <<03003>>12776000
$CONTROL SEGMENT=RESIDENT                                      <<03603>>12778000
$CONTROL SEGMENT=RESIDENT                                      <<03004>>12780000
          <<---------------------------->>                     <<03004>>12782000
          <<WRITE A CHARACTER ON CONSOLE>>                     <<03004>>12784000
          <<---------------------------->>                     <<03004>>12786000
  LOGICAL PROCEDURE WRITECHAR(CHAR);                           <<03004>>12788000
    VALUE CHAR;                                                <<03004>>12790000
    INTEGER CHAR;                                              <<03004>>12792000
      COMMENT                                                  <<03004>>12794000
        THIS PROCEDURE OUTPUTS THE BYTE CHAR DIRECTLY TO THE   <<03004>>12796000
        SYSTEM CONSOLE.  THIS PROCEDURE HANDLES BOTH ADCC      <<03004>>12798000
        AND LYNX CONSOLES.  NOTE:  RESPONSIBILITY FOR          <<03004>>12800000
        SUPPORTING THIS PROCEDURE FALLS TO THE PEOPLE THAT     <<03004>>12802000
        SUPPORT TERMINAL SOFTWARE.  DO NOT MAKE ANY CHANGES    <<03004>>12804000
        TO THIS PROCEDURE BEFORE CONSULTING THEM! ;            <<03004>>12806000
                                                               <<03004>>12808000
BEGIN   << START OF WRITECHAR  >>                              <<03004>>12810000
EQUATE                                                         <<03004>>12812000
   R0    = 0,                                                  <<03004>>12814000
   R1    = 1,                                                  <<03004>>12816000
   R2    = 2,                                                  <<03004>>12818000
   R3    = 3,                                                  <<03004>>12820000
   R4    = 4,                                                  <<03004>>12822000
   R5    = 5,                                                  <<03004>>12824000
   R6    = 6,                                                  <<03004>>12826000
   R7    = 7,                                                  <<03004>>12828000
   R8    = 8,                                                  <<03004>>12830000
   R9    = 9,                                                  <<03004>>12832000
   RA    = %(16)A,                                             <<03004>>12834000
   RB    = %(16)B,                                             <<03004>>12836000
   RC    = %(16)C,                                             <<03004>>12838000
   RD    = %(16)D,                                             <<03004>>12840000
   RE    = %(16)E,                                             <<03004>>12842000
   RF    = %(16)F;                                             <<03004>>12844000
EQUATE                                                         <<03004>>12846000
   BIT0 = %100000,                                             <<03004>>12848000
   BIT2 = %20000,                                              <<03029>>12850000
   B14'SET = 2,                                                <<03004>>12852000
   B14'CLEAR = 0,                                              <<03004>>12854000
   CONSOLEDRT = %10,                                           <<03004>>12856000
   DMA'CONTROL = %100000,                                      <<03004>>12858000
   DMA'RIGHT = %40000,                                         <<03004>>12860000
   ENABLE'MASK = %177577,                                      <<03004>>12862000
   GO'LYNX = %(16)3C09,                                        <<T9011>>12864000
   ERROR'CLEAR = %(16)3C0B,                                    <<T9011>>12866000
   ICF'55 = 4,                                                 <<03004>>12868000
   GRIZZLY = 3,                                                <<03004>>12870000
   LYNX'TYPE = %50017,                                         <<03004>>12872000
   TIC'TYPE = %50004,                                          <<08392>>12874000
   PORT'HCP = 8,                                               <<03004>>12876000
   READ'DONE = 6,                                              <<03004>>12878000
   SIO'PORT = 4,                                               <<03004>>12880000
   STD'CONS'AIB = 0,                                           <<03004>>12882000
   STD'CONS'PORT = 0,                                          <<03004>>12884000
   WRITE'DONE = %16;                                           <<03029>>12886000
DEFINE   << DEFINES FOR LYNX REGISTERS >>                      <<03004>>12888000
   WRITE'DMA'ADDR      = R0#,                                  <<03004>>12890000
   WRITE'DMA'BANK       = R1#,                                 <<03004>>12892000
   CONTROL'DMA'ADDR     = R2#,                                 <<03004>>12894000
   CONTROL'DMA'BANK     = R3#,                                 <<03004>>12896000
   READ'DMA'ADDR        = R4#,                                 <<03004>>12898000
   READ'DMA'BANK        = R5#,                                 <<03004>>12900000
   TERM'INTRPT'REASON   = R6#,                                 <<03004>>12902000
   INTRPTS'NO'FLUSH     = R8#,                                 <<03004>>12904000
   PORT'POINTER         = R8#,                                 <<03004>>12906000
   INTRPTS'FLUSH        = R9#,                                 <<03004>>12908000
   BOARD'ENABLE         = R9#,                                 <<03004>>12910000
   DIAG'REGA            = RA#,                                 <<03004>>12912000
   DIAG'WRITE           = RA#,                                 <<03004>>12914000
   DIAG'REGB            = RB#,                                 <<03004>>12916000
   DIRECT'COMMAND       = RB#,                                 <<03004>>12918000
   CHANNEL'CONFIG       = RE#,                                 <<03004>>12920000
   CHANNEL'CONFIG'2     = RF#;                                 <<03004>>12922000
DEFINE                                                         <<03004>>12924000
   DISABLE'INTRPTS = ASSEMBLE( SED 0 )#;                       <<03004>>12926000
LOGICAL   << NOTE !!! - DONT MOVE Q+1 THROUGH Q+8 >>           <<03029>>12928000
   CHARACTER,                                                  <<03004>>12930000
   READ'BRK,                                                   <<03004>>12932000
   CP'WRITECHAR  := %(16)8489, << ATP (LYNX) CONTROL     >>    <<03708>>12934000
   CP'WRITECHAR1 := %(16)0101, << PROGRAM.  SEE ATP      >>    <<03708>>12936000
   CP'WRITECHAR2 := %(16)0101, << DOCUMENTATION FOR THE  >>    <<03708>>12938000
   CP'WRITECHAR3 := %(16)0200, << MEANING OF THESE CODES >>    <<03708>>12940000
   CP'WRITECHAR4 := %(16)0100,                                 <<03708>>12942000
   CP'WRITECHAR5 := %(16)00FF, << END OF CONTROL PROGRAM >>    <<03708>>12944000
   AIB'ENABLE,                                                 <<03004>>12946000
   BOARD'TYPE,                                                 <<03004>>12948000
   CONS'CHANNEL,                                               <<03004>>12950000
   CONS'AIB,                                                   <<03004>>12952000
   CONS'PORT,                                                  <<03004>>12954000
   CPUNUM,                                                     <<03004>>12956000
   CURTIME,                                                    <<03004>>12958000
   DB'REG,      << CURRENT DB FOR PRINT >>                     <<03004>>12960000
   DMA'BANK,    << DMA BANK FOR PRINT   >>                     <<03004>>12962000
   INIT'COMMAND := %20000,                                     <<03004>>12964000
   INTRPT'ERROR,                                               <<03004>>12966000
   INTRPT'REASON,                                              <<03004>>12968000
   LYNX'INTRPT,                                                <<03004>>12970000
   PRINT'ADDR,                                                 <<03004>>12972000
   READ'COMMAND := 0,                                          <<03004>>12974000
   STARTIME,                                                   <<03004>>12976000
   SYS'UP := FALSE,                                            <<03004>>12978000
   TERM'INTRPT  := 0,                                          <<03004>>12980000
   WRITE'COMMAND := 0,                                         <<03004>>12982000
   WAIT'LIMIT := 4;    << 4 MILLISECOND DELAY >>               <<03004>>12984000
INTEGER                                                        <<03004>>12986000
   S2 = S-2,                                                   <<03004>>12988000
   S3 = S-3,                                                   <<03004>>12990000
   I,                                                          <<03004>>12992000
   J;                                                          <<03004>>12994000
INTEGER ARRAY LYNX'CONVERT(6:18) = PB :=  <<ADCC TO LYNX    >> <<03004>>12996000
 2,4,9,5,99,10,99,11,1,0,6,7,3;     <<BAUDRATE CONVERSIONS  >> <<03004>>12998000
                                                               <<03004>>13000000
  DOUBLE OLDDB;  <<DB WHEN PROCEDURE IS CALLED>>               <<03004>>13002000
  LOGICAL CPBASE;    <<BASE OF CHANNEL PROGRAM>>               <<03004>>13004000
  LOGICAL ARRAY CP(*) = DB+0;                                  <<03004>>13006000
  INTEGER ARRAY CHANIOPROG(0:%52)=PB:=                         <<03004>>13008000
                                                               <<03004>>13010000
     %2001,                << WRITE, MOD 1             >>      <<03004>>13012000
     1,                    << MASTER RESET, 1 START    >>      <<03004>>13014000
     1,                    << 8 DATA, 1 STOP,          >>      <<03004>>13016000
     [1/1,1/0,1/1,13/0],   << PARITY DISABLED          >>      <<03004>>13018000
     0,                                                        <<03004>>13020000
                                                               <<03004>>13022000
     %2002,                << WRITE, MOD 2             >>      <<03004>>13024000
     1,                    << TURN OFF ECHO            >>      <<03004>>13026000
     1,                                                        <<03004>>13028000
     [1/1,1/1,1/1,13/0],                                       <<03004>>13030000
     0,                                                        <<03004>>13032000
                                                               <<03004>>13034000
     %2003,                << WRITE, MOD 3             >>      <<03004>>13036000
     1,                    << ENABLE SRQ OUTPUT        >>      <<03004>>13038000
     1,                                                        <<03004>>13040000
     [1/1,1/0,1/1,13/0],                                       <<03004>>13042000
     0,                                                        <<03004>>13044000
                                                               <<03004>>13046000
     %2006,                << WRITE, MOD 6             >>      <<03004>>13048000
     1,                    << SET OUTPUT BAUDRATE      >>      <<03004>>13050000
     1,                                                        <<03004>>13052000
     [1/1,1/1,1/1,13/0],                                       <<03004>>13054000
     0,                                                        <<03004>>13056000
                                                               <<03004>>13058000
     %2006,                << WRITE, MOD 6             >>      <<03004>>13060000
     1,                    << SET INPUT BAUD RATE      >>      <<03004>>13062000
     1,                                                        <<03004>>13064000
     [1/1,1/0,1/1,13/0],                                       <<03004>>13066000
     0,                                                        <<03004>>13068000
                                                               <<03004>>13070000
     %2000,                << WRITE, MOD 0             >>      <<03004>>13072000
     1,                    << OUTPUT DATA              >>      <<03004>>13074000
     1,                                                        <<03004>>13076000
     [1/1,1/1,1/1,13/0],                                       <<03004>>13078000
     0,                                                        <<03004>>13080000
                                                               <<03004>>13082000
     %1000,                << WAIT FOR SRQ             >>      <<03004>>13084000
     0,                                                        <<03004>>13086000
                                                               <<03004>>13088000
     %2003,                << WRITE, MOD 3             >>      <<03004>>13090000
     1,                    << DISABLE SRQ OUTPUT       >>      <<03004>>13092000
     1,                                                        <<03004>>13094000
     [1/1,1/1,1/1,13/0],                                       <<03004>>13096000
     0,                                                        <<03004>>13098000
                                                               <<03004>>13100000
     %600,                 << INTERRUPT, HALT          >>      <<03004>>13102000
     0,                                                        <<03004>>13104000
                                                               <<03004>>13106000
     [8/%231,8/%000],      << MASTER RESET, 1 START,   >>      <<03004>>13108000
                           << 8 DATA, 1 STOP, NO PARITY>>      <<03004>>13110000
                           << ; NO ECHO                >>      <<03004>>13112000
     [8/%005,8/%000],      << SRQ OUTPUT ON; PLACE FOR >>      <<03004>>13114000
                           << OUTPUT BAUDRATE          >>      <<03004>>13116000
     0,                    << PLACE FOR OUTPUT CHAR.   >>      <<03004>>13118000
     [8/%000,8/%001];      << PLACE FOR INPUT BAUDRATE;>>      <<03004>>13120000
                           << SRQ OUTPUT OFF           >>      <<03004>>13122000
                                                               <<03004>>13124000
                                                               <<03004>>13126000
  EQUATE  DATA0 = %47,                                         <<03004>>13128000
          DATA1 = DATA0+1,                                     <<03004>>13130000
          DATA2 = DATA1+1,                                     <<03004>>13132000
          DATA3 = DATA2+1;                                     <<03004>>13134000
  EQUATE  ENQ = 5,                                             <<03004>>13136000
          ACK = 6;                                             <<03004>>13138000
                                                               <<03004>>13140000
SUBROUTINE WRITE'SIB'REG(REG'NUMB, DATA'OUT);                  <<03004>>13142000
VALUE REG'NUMB, DATA'OUT;                                      <<03004>>13144000
LOGICAL REG'NUMB,                                              <<03004>>13146000
        DATA'OUT;                                              <<03004>>13148000
BEGIN                                                          <<03004>>13150000
IF MULTI'IMB'SYS THEN                                          <<C8392>>13152000
   BEGIN   <<MULTIPLE IMB SYSTEM>>                             <<C8392>>13154000
   TOS := CONSOLEDRT;                                          <<03004>>13156000
   TOS := WRITE'COMMAND CAT S3(4:12:4);                        <<03004>>13158000
   TOS := S3;                                                  <<03004>>13160000
   ASSEMBLE( WIOA);                                            <<03004>>13162000
   END                                                         <<03004>>13164000
ELSE                                                           <<03004>>13166000
   BEGIN                                                       <<03004>>13168000
   TOS := WRITE'COMMAND CAT REG'NUMB(4:12:4) LOR               <<03004>>13170000
          CONSOLEDRT;                                          <<03004>>13172000
   TOS := S2;                                                  <<03004>>13174000
   ASSEMBLE( WIOC);                                            <<03004>>13176000
   END;                                                        <<03004>>13178000
END;                                                           <<03004>>13180000
LOGICAL SUBROUTINE READ'SIB'REG(REG'NUMB);                     <<03004>>13182000
VALUE REG'NUMB;                                                <<03004>>13184000
LOGICAL REG'NUMB;                                              <<03004>>13186000
BEGIN                                                          <<03004>>13188000
IF MULTI'IMB'SYS THEN                                          <<C8392>>13190000
   BEGIN   <<MULTIPLE IMB SYSTEM>>                             <<C8392>>13192000
   TOS := CONSOLEDRT;                                          <<03004>>13194000
   TOS := READ'COMMAND CAT S2(4:12:4);                         <<03004>>13196000
   ASSEMBLE( RIOA);                                            <<03004>>13198000
   END     << CPU IS A 55 >>                                   <<03004>>13200000
ELSE                                                           <<03004>>13202000
   BEGIN                                                       <<03004>>13204000
   TOS := READ'COMMAND CAT REG'NUMB(4:12:4) LOR                <<03004>>13206000
          CONSOLEDRT;                                          <<03004>>13208000
   ASSEMBLE( RIOC);                                            <<03004>>13210000
   END;                                                        <<03004>>13212000
S3 := TOS;                                                     <<03004>>13214000
END;                                                           <<03004>>13216000
                                                               <<03004>>13218000
                                                               <<03004>>13220000
<< START OF WRITECHAR PROCEDURE >>                             <<03004>>13222000
ASSEMBLE( PCN );   << WHAT PROCESSOR TYPE >>                   <<03004>>13224000
CPUNUM := TOS;                                                 <<03004>>13226000
BOARD'TYPE := READ'SIB'REG(CHANNEL'CONFIG);                    <<03004>>13228000
IF BOARD'TYPE = LYNX'TYPE OR                                   <<08392>>13230000
   BOARD'TYPE = TIC'TYPE THEN                                  <<08392>>13232000
   BEGIN   << SIB IS A LYNX >>                                 <<03004>>13234000
   DISABLE'INTRPTS;                                            <<03004>>13236000
   AIB'ENABLE := ENABLE'MASK&LSR(STD'CONS'AIB);                <<03004>>13238000
   CONS'PORT := STD'CONS'AIB&LSL(4) LOR STD'CONS'PORT;         <<03004>>13240000
   << THAW LYNX >>                                             <<03004>>13242000
   WRITE'SIB'REG(DIAG'WRITE, GO'LYNX);                         <<03004>>13244000
   << SET UP PORT POINTER TO CONSOLE >>                        <<T8392>>13246000
   WRITE'SIB'REG(PORT'POINTER, CONS'PORT);                     <<T8392>>13248000
   << ENABLE ONLY CONSOLE AIB >>                               <<T8392>>13250000
   WRITE'SIB'REG(BOARD'ENABLE, AIB'ENABLE);                    <<T8392>>13252000
   << THE ORDER OF THE ABOVE THREE STMTS IS VERY IMP >>        <<T8392>>13254000
   PUSH(SBANK);                                                <<03004>>13256000
   DMA'BANK := TOS LOR DMA'CONTROL;                            <<03022>>13258000
   PUSH(DB);                                                   <<03004>>13260000
   PUSH(Q);                                                    <<03004>>13262000
   DB'REG := LOGICAL(TOS) + LOGICAL(TOS);                      <<03004>>13264000
   << SET UP CONTROL BANK >>                                   <<03004>>13266000
   WRITE'SIB'REG(CONTROL'DMA'BANK, DMA'BANK);                  <<03004>>13268000
   << SET UP CONTROL ADDR >>                                   <<03004>>13270000
   CP'WRITECHAR.(12:4) := LYNX'CONVERT(BAUDRATE);              <<03004>>13272000
   PRINT'ADDR := LOGICAL(DB'REG) + LOGICAL(3);                 <<03004>>13274000
   WRITE'SIB'REG(CONTROL'DMA'ADDR, PRINT'ADDR );               <<03004>>13276000
   << SET UP WRITE DMA BANK >>                                 <<03004>>13278000
   WRITE'SIB'REG(WRITE'DMA'BANK, DMA'BANK LOR DMA'RIGHT);      <<03004>>13280000
   << SET UP WRITE DMA ADDR >>                                 <<03004>>13282000
   CHARACTER := CHAR;                                          <<03004>>13284000
   WRITE'SIB'REG(WRITE'DMA'ADDR, LOGICAL(1) +                  <<03004>>13286000
                                 LOGICAL(DB'REG));             <<03004>>13288000
   << SET UP READ DMA BANK >>                                  <<03004>>13290000
   WRITE'SIB'REG(READ'DMA'BANK, DMA'BANK);                     <<03004>>13292000
   << SET UP READ DMA ADDR >>                                  <<03004>>13294000
   PRINT'ADDR := LOGICAL(DB'REG) + LOGICAL(2);                 <<03004>>13296000
   WRITE'SIB'REG(READ'DMA'ADDR, PRINT'ADDR);                   <<03004>>13298000
   ASSEMBLE( RCLK );   << DELAY FOR X MSEC >>                  <<03004>>13300000
   STARTIME := TOS;                                            <<03004>>13302000
   DO                                                          <<03004>>13304000
      BEGIN                                                    <<03004>>13306000
      ASSEMBLE( RCLK );                                        <<03004>>13308000
      CURTIME := TOS;                                          <<03004>>13310000
      END                                                      <<03004>>13312000
   UNTIL CURTIME - STARTIME > WAIT'LIMIT;                      <<03004>>13314000
   << START WRITE CONTROL PROGRAM >>                           <<03004>>13316000
   WRITE'SIB'REG(DIRECT'COMMAND, SIO'PORT);                    <<03004>>13318000
   LYNX'INTRPT := FALSE;                                       <<03004>>13320000
   << LOOP UNTIL WRITE IS COMPLETE >>                          <<03004>>13322000
   WRITECHAR := 0;                                             <<03004>>13324000
   DO                                                          <<03004>>13326000
      BEGIN   << WAIT FOR INTERRUPT >>                         <<03004>>13328000
      TERM'INTRPT := READ'SIB'REG(INTRPTS'NO'FLUSH);           <<03004>>13330000
      IF TERM'INTRPT.(0:1) THEN                                <<03004>>13332000
         BEGIN   << INTERRUPT HAS OCCURED >>                   <<03004>>13334000
         TERM'INTRPT := READ'SIB'REG(INTRPTS'FLUSH);           <<03004>>13336000
         IF TERM'INTRPT.(9:7) = CONS'PORT.(9:7) THEN           <<03004>>13338000
            BEGIN   << CORRECT PORT INTERRUPTED >>             <<03004>>13340000
            LYNX'INTRPT := TRUE;                               <<03004>>13342000
            INTRPT'REASON := READ'SIB'REG(TERM'INTRPT'REASON); <<03004>>13344000
            IF INTRPT'REASON&LSR(8) <> WRITE'DONE THEN         <<03004>>13346000
               BEGIN   << NOT CORRECT REASON - ERROR >>        <<03004>>13348000
               WRITECHAR := INTRPT'REASON.(0:8) LOR            <<03029>>13350000
                            BIT0;                              <<03004>>13352000
               END;    << NOT CORRECT REASON - ERROR >>        <<03004>>13354000
            END      << CORRECT PORT INTERRUPTED >>            <<03004>>13356000
         END     << INTERRUPT HAS OCCURED >>                   <<03004>>13358000
      ELSE                                                     <<03004>>13360000
         BEGIN   << CHECK HARDWARE ERROR >>                    <<03004>>13362000
         IF TERM'INTRPT.(2:1) THEN                             <<03004>>13364000
            BEGIN                                              <<03004>>13366000
            LYNX'INTRPT := TRUE;                               <<03004>>13368000
            INTRPT'ERROR := READ'SIB'REG(DIAG'REGA);           <<03004>>13370000
            WRITECHAR := INTRPT'ERROR.(8:8) LOR BIT2;          <<03029>>13372000
            WRITE'SIB'REG(DIAG'REGA, ERROR'CLEAR);             <<T9011>>13374000
            WRITE'SIB'REG(DIAG'REGA, GO'LYNX);                 <<T9011>>13376000
            END;                                               <<03004>>13378000
         END;    << CHECK HARDWARE ERROR >>                    <<03004>>13380000
      END     << WAIT FOR INTERRUPT >>                         <<03004>>13382000
   UNTIL LYNX'INTRPT = TRUE;                                   <<03004>>13384000
   END     << SIB IS A LYNX >>                                 <<03004>>13386000
ELSE                                                           <<03004>>13388000
   BEGIN   << SIB IS A ADCC >>                                 <<03004>>13390000
                                                               <<03004>>13392000
   PUSH(DB);                                                   <<03004>>13394000
   OLDDB := TOS;  <<SAVE OLD DB>>                              <<03004>>13396000
   TOS := 0;                                                   <<03004>>13398000
   TOS := ABSOLUTE(TERMCHANPROG);                              <<03004>>13400000
   CPBASE := LS0;                                              <<03004>>13402000
   SET(DB);                                                    <<03004>>13404000
   MOVE CP := CHANIOPROG,(%53);                                <<03004>>13406000
   CP( %4) := CP(%11) := CPBASE+DATA0;                         <<03004>>13408000
   CP(%16) := CP(%23) := CPBASE+DATA1;                         <<03004>>13410000
   CP(%35) := CPBASE + DATA2;                                  <<03004>>13412000
   CP(%30) := CP(%44) := CPBASE + DATA3;                       <<03004>>13414000
   CP(DATA1).(8:8) := BAUDRATE;                                <<03004>>13416000
   CP(DATA3).(0:8) := BAUDRATE + %20;                          <<03004>>13418000
   CP(DATA2) := CHAR;                                          <<03004>>13420000
   SIOP( CONSOLEDRT, CPBASE);   << START CHANNEL PROGRAM >>    <<03022>>13422000
   IF <> THEN ERRMESSAGE( M2, CONSOLEDRT);  << FAILURE >>      <<03022>>13424000
   WHILE GETDRT(CONSOLEDRT,CHANSTAT).(0:2)<>0 DO;              <<03004>>13426000
        <<WAIT UNTIL PROGRAM FINISHES>>                        <<03004>>13428000
   TOS := OLDDB;                                               <<03004>>13430000
   SET(DB);                                                    <<03004>>13432000
   END;    << SIB IS A ADCC >>                                 <<03004>>13434000
                                                               <<03004>>13436000
<< FOR 26XX TERMINALS, SEND AN ENQ AND WAIT FOR  >>            <<03004>>13438000
<< AN ACK AFTER EVERY 80 CHARACTERS PRINTED SO   >>            <<03004>>13440000
<< WE DON'T OVERRUN THE TERMINAL'S BUFFER        >>            <<03004>>13442000
                                                               <<03004>>13444000
IF HP26XX THEN                                                 <<03004>>13446000
   IF (CHARCNT := CHARCNT + 1) >= 79 THEN                      <<03004>>13448000
      BEGIN                                                    <<03004>>13450000
      CHARCNT := 0;      << ZERO CHARACTER COUNT >>            <<03004>>13452000
      WRITECHAR( ENQ);                                         <<03004>>13454000
      DO UNTIL READCHAR(0).(9:7)=ACK; <<WAIT ON ACK>>          <<03004>>13456000
      END;                                                     <<03004>>13458000
END;  << WRITECHAR >>                                          <<03004>>13460000
$PAGE                                                          <<03004>>13462000
        <<--------------------------------->>                  <<03004>>13464000
        <<  READ A CHARACTER FROM CONSOLE  >>                  <<03004>>13466000
        <<--------------------------------->>                  <<03004>>13468000
  INTEGER PROCEDURE READCHAR( WAITMS);                         <<03004>>13470000
  VALUE WAITMS;                                                <<03004>>13472000
  LOGICAL WAITMS;    << TIME-OUT FOR READ >>                   <<03004>>13474000
  OPTION VARIABLE;                                             <<03004>>13476000
      COMMENT                                                  <<03004>>13478000
        THIS PROCEDURE READS A BYTE DIRECTLY FROM THE          <<03004>>13480000
        SYSTEM CONSOLE.  THE OPTIONAL PARAMETER IS USED        <<03004>>13482000
        FOR AUTOMATIC SPEED SENSING.  IF AN ACK DOES NOT       <<03004>>13484000
        COME BACK IN WAITMS MILLISECONDS AFTER AN ENQ          <<03004>>13486000
        WAS SENT, THE PROCEDURE RETURNS NULL.  NOTE:           <<03004>>13488000
        THIS PROCEDURE SUPPORTS BOTH ADCC AND LYNX             <<03004>>13490000
        CONSOLES.  RESPONSIBILITY FOR SUPPORTING THIS          <<03004>>13492000
        PROCEDURE RESTS WITH THE TERMINAL SOFTWARE             <<03004>>13494000
        GROUP.  DO NOT MODIFY THIS PROCEDURE BEFORE            <<03004>>13496000
        CONSULTING THEM!                                       <<03004>>13498000
        ;                                                      <<03004>>13500000
                                                               <<03004>>13502000
BEGIN   << START OF READCHAR >>                                <<03004>>13504000
EQUATE                                                         <<03004>>13506000
   R0    = 0,                                                  <<03004>>13508000
   R1    = 1,                                                  <<03004>>13510000
   R2    = 2,                                                  <<03004>>13512000
   R3    = 3,                                                  <<03004>>13514000
   R4    = 4,                                                  <<03004>>13516000
   R5    = 5,                                                  <<03004>>13518000
   R6    = 6,                                                  <<03004>>13520000
   R7    = 7,                                                  <<03004>>13522000
   R8    = 8,                                                  <<03004>>13524000
   R9    = 9,                                                  <<03004>>13526000
   RA    = %(16)A,                                             <<03004>>13528000
   RB    = %(16)B,                                             <<03004>>13530000
   RC    = %(16)C,                                             <<03004>>13532000
   RD    = %(16)D,                                             <<03004>>13534000
   RE    = %(16)E,                                             <<03004>>13536000
   RF    = %(16)F;                                             <<03004>>13538000
EQUATE                                                         <<03004>>13540000
   BIT0 = %100000,                                             <<03004>>13542000
   BIT2 = %20000,                                              <<03029>>13544000
   B14'SET = 2,                                                <<03004>>13546000
   B14'CLEAR = 0,                                              <<03004>>13548000
   CONSOLEDRT = %10,                                           <<03004>>13550000
   DMA'CONTROL = %100000,                                      <<03004>>13552000
   DMA'RIGHT = %40000,                                         <<03004>>13554000
   ENABLE'MASK = %177577,                                      <<03004>>13556000
   GO'LYNX = %(16)3C09,                                        <<T9011>>13558000
   ERROR'CLEAR = %(16)3C0B,                                    <<T9011>>13560000
   HIO'PORT = 8,                                               <<03004>>13562000
   ICF'55 = 4,                                                 <<03004>>13564000
   GRIZZLY = 3,                                                <<03004>>13566000
   LYNX'TYPE = %50017,                                         <<03004>>13568000
   TIC'TYPE = %50004,                                          <<08392>>13570000
   NULL = 0,                                                   <<03004>>13572000
   PORT'HCP = 8,                                               <<03004>>13574000
   READ'DONE = 6,                                              <<03004>>13576000
   SIO'PORT = 4,                                               <<03004>>13578000
   STD'CONS'AIB = 0,                                           <<03004>>13580000
   STD'CONS'PORT = 0,                                          <<03004>>13582000
   WRITE'DONE = %16;                                           <<03029>>13584000
DEFINE   << DEFINES FOR LYNX REGISTERS >>                      <<03004>>13586000
   WRITE'DMA'ADDR      = R0#,                                  <<03004>>13588000
   WRITE'DMA'BANK       = R1#,                                 <<03004>>13590000
   CONTROL'DMA'ADDR     = R2#,                                 <<03004>>13592000
   CONTROL'DMA'BANK     = R3#,                                 <<03004>>13594000
   READ'DMA'ADDR        = R4#,                                 <<03004>>13596000
   READ'DMA'BANK        = R5#,                                 <<03004>>13598000
   TERM'INTRPT'REASON   = R6#,                                 <<03004>>13600000
   INTRPTS'NO'FLUSH     = R8#,                                 <<03004>>13602000
   PORT'POINTER         = R8#,                                 <<03004>>13604000
   INTRPTS'FLUSH        = R9#,                                 <<03004>>13606000
   BOARD'ENABLE         = R9#,                                 <<03004>>13608000
   DIAG'REGA            = RA#,                                 <<03004>>13610000
   DIAG'WRITE           = RA#,                                 <<03004>>13612000
   DIAG'REGB            = RB#,                                 <<03004>>13614000
   DIRECT'COMMAND       = RB#,                                 <<03004>>13616000
   CHANNEL'CONFIG       = RE#,                                 <<03004>>13618000
   CHANNEL'CONFIG'2     = RF#;                                 <<03004>>13620000
DEFINE                                                         <<03004>>13622000
   DISABLE'INTRPTS = ASSEMBLE( SED 0 )#;                       <<03004>>13624000
LOGICAL   << NOTE !!! - DONT MOVE Q+1 THROUGH Q+6 >>           <<03029>>13626000
   CHARACTER,                                                  <<03004>>13628000
   READ'BRK,                                                   <<03004>>13630000
   CP'READCHAR  := %(16)0142,  << ATP (LYNX) CONTROL     >>    <<03708>>13632000
   CP'READCHAR1 := %(16)0000,  << PROGRAM.  SEE ATP      >>    <<03708>>13634000
   CP'READCHAR2 := %(16)0001,  << DOCUMENTATION FOR THE  >>    <<03708>>13636000
   CP'READCHAR3 := %(16)FFFF,  << MEANING OF THESE CODES >>    <<03708>>13638000
   AIB'ENABLE,                                                 <<03004>>13640000
   BOARD'TYPE,                                                 <<03004>>13642000
   CONS'CHANNEL,                                               <<03004>>13644000
   CONS'AIB,                                                   <<03004>>13646000
   CONS'PORT,                                                  <<03004>>13648000
   CPUNUM,                                                     <<03004>>13650000
   DB'REG,      << CURRENT DB FOR PRINT >>                     <<03004>>13652000
   DMA'BANK,    << DMA BANK FOR PRINT   >>                     <<03004>>13654000
   INIT'COMMAND := %20000,                                     <<03004>>13656000
   INTRPT'ERROR,                                               <<03004>>13658000
   INTRPT'REASON,                                              <<03004>>13660000
   LYNX'INTRPT,                                                <<03004>>13662000
   PRINT'ADDR,                                                 <<03004>>13664000
   READ'COMMAND := 0,                                          <<03004>>13666000
   SYS'UP := FALSE,                                            <<03004>>13668000
   TERM'INTRPT  := 0,                                          <<03004>>13670000
   WRITE'COMMAND := 0,                                         <<03004>>13672000
   WAIT'LIMIT := 4,                                            <<03004>>13674000
   CURTIME,                                                    <<03004>>13676000
   STARTIME,                                                   <<03004>>13678000
   TIMEOUT;                                                    <<03004>>13680000
INTEGER                                                        <<03004>>13682000
   S2 = S-2,                                                   <<03004>>13684000
   S3 = S-3,                                                   <<03004>>13686000
   PARMS = Q-4,                                                <<03004>>13688000
   I,                                                          <<03004>>13690000
   J;                                                          <<03004>>13692000
INTEGER ARRAY LYNX'CONVERT(6:18) = PB :=  <<ADCC TO LYNX    >> <<03004>>13694000
 2,4,9,5,99,10,99,11,1,0,6,7,3;    << BAUDRATE CONVERSIONS  >> <<03004>>13696000
                                                               <<03004>>13698000
                                                               <<03004>>13700000
  DOUBLE OLDDB;  <<DB WHEN PROCEDURE IS CALLED>>               <<03004>>13702000
  LOGICAL CPBASE;    <<BASE OF CHANNEL PROGRAM>>               <<03004>>13704000
  LOGICAL ARRAY CP(*) = DB+0;                                  <<03004>>13706000
          ARRAY CHANIOPROG(0:%45)=PB:=                         <<03004>>13708000
                                                               <<03004>>13710000
     %2002,                << WRITE, MOD 2             >>      <<03004>>13712000
     1,                    << TURN ON ECHO             >>      <<03004>>13714000
     1,                                                        <<03004>>13716000
     [1/1,1/0,1/1,13/0],                                       <<03004>>13718000
     0,                                                        <<03004>>13720000
                                                               <<03004>>13722000
     %2006,                << WRITE, MOD 6             >>      <<03004>>13724000
     1,                    << SET INPUT BAUD RATE      >>      <<03004>>13726000
     1,                                                        <<03004>>13728000
     [1/1,1/0,1/1,13/0],                                       <<03004>>13730000
     0,                                                        <<03004>>13732000
                                                               <<03004>>13734000
     %2003,                << WRITE, MOD 3             >>      <<03004>>13736000
     1,                    << ENABLE SRQ INPUT         >>      <<03004>>13738000
     1,                                                        <<03004>>13740000
     [1/1,1/1,1/1,13/0],                                       <<03004>>13742000
     0,                                                        <<03004>>13744000
                                                               <<03004>>13746000
     %1000,                << WAIT FOR SRQ             >>      <<03004>>13748000
     0,                                                        <<03004>>13750000
                                                               <<03004>>13752000
     %1400,                << READ, MOD 0              >>      <<03004>>13754000
     1,                    << GET RECEIVED CHARACTER   >>      <<03004>>13756000
     1,                                                        <<03004>>13758000
     [1/1,1/1,14/0],                                           <<03004>>13760000
     0,                                                        <<03004>>13762000
                                                               <<03004>>13764000
     %2003,                << WRITE, MOD 3             >>      <<03004>>13766000
     1,                    << DISABLE SRQ INPUT        >>      <<03004>>13768000
     1,                                                        <<03004>>13770000
     [1/1,1/0,1/1,13/0],                                       <<03004>>13772000
     0,                                                        <<03004>>13774000
                                                               <<03004>>13776000
     %2002,                << WRITE, MOD 2             >>      <<03004>>13778000
     1,                    << DISABLE ECHO             >>      <<03004>>13780000
     1,                                                        <<03004>>13782000
     [1/1,1/1,1/1,13/0],                                       <<03004>>13784000
     0,                                                        <<03004>>13786000
                                                               <<03004>>13788000
     %600,                 << INTERRUPT, HALT          >>      <<03004>>13790000
     0,                                                        <<03004>>13792000
                                                               <<03004>>13794000
     [8/%020,8/%006],      << ECHO ON; SRQ INPUT ON    >>      <<03004>>13796000
     [8/%002,8/%000],      << SRQ INPUT OFF, ECHO OFF  >>      <<03004>>13798000
     0,                    << PLACE FOR INPUT CHAR.    >>      <<03004>>13800000
     0;                    << PLACE FOR INPUT BAUDRATE >>      <<03004>>13802000
                                                               <<03004>>13804000
  EQUATE  DATA0 = %42,                                         <<03004>>13806000
          DATA1 = DATA0+1,                                     <<03004>>13808000
          DATA2 = DATA1+1,                                     <<03004>>13810000
          DATA3 = DATA2+1;                                     <<03004>>13812000
                                                               <<03004>>13814000
                                                               <<03004>>13816000
                                                               <<03004>>13818000
SUBROUTINE WRITE'SIB'REG(REG'NUMB, DATA'OUT);                  <<03004>>13820000
VALUE REG'NUMB, DATA'OUT;                                      <<03004>>13822000
LOGICAL REG'NUMB,                                              <<03004>>13824000
        DATA'OUT;                                              <<03004>>13826000
BEGIN                                                          <<03004>>13828000
IF MULTI'IMB'SYS THEN                                          <<C8392>>13830000
   BEGIN   <<MULTIPLE IMB SYSTEM>>                             <<C8392>>13832000
   TOS := CONSOLEDRT;                                          <<03004>>13834000
   TOS := WRITE'COMMAND CAT S3(4:12:4);                        <<03004>>13836000
   TOS := S3;                                                  <<03004>>13838000
   ASSEMBLE( WIOA);                                            <<03004>>13840000
   END                                                         <<03004>>13842000
ELSE                                                           <<03004>>13844000
   BEGIN                                                       <<03004>>13846000
   TOS := WRITE'COMMAND CAT REG'NUMB(4:12:4) LOR               <<03004>>13848000
          CONSOLEDRT;                                          <<03004>>13850000
   TOS := S2;                                                  <<03004>>13852000
   ASSEMBLE( WIOC);                                            <<03004>>13854000
   END;                                                        <<03004>>13856000
END;                                                           <<03004>>13858000
LOGICAL SUBROUTINE READ'SIB'REG(REG'NUMB);                     <<03004>>13860000
VALUE REG'NUMB;                                                <<03004>>13862000
LOGICAL REG'NUMB;                                              <<03004>>13864000
BEGIN                                                          <<03004>>13866000
IF MULTI'IMB'SYS THEN                                          <<C8392>>13868000
   BEGIN   <<MULTIPLE IMB SYSTEM>>                             <<C8392>>13870000
   TOS := CONSOLEDRT;                                          <<03004>>13872000
   TOS := READ'COMMAND CAT S2(4:12:4);                         <<03004>>13874000
   ASSEMBLE( RIOA);                                            <<03004>>13876000
   END     << CPU IS A 55 >>                                   <<03004>>13878000
ELSE                                                           <<03004>>13880000
   BEGIN                                                       <<03004>>13882000
   TOS := READ'COMMAND CAT REG'NUMB(4:12:4) LOR                <<03004>>13884000
          CONSOLEDRT;                                          <<03004>>13886000
   ASSEMBLE( RIOC);                                            <<03004>>13888000
   END;                                                        <<03004>>13890000
S3 := TOS;                                                     <<03004>>13892000
END;                                                           <<03004>>13894000
                                                               <<03004>>13896000
                                                               <<03004>>13898000
<< START AND OUTER BLOCK OF READCHAR PROCEDURE >>              <<03004>>13900000
ASSEMBLE( PCN );   << WHAT PROCESSOR TYPE >>                   <<03004>>13902000
CPUNUM := TOS;                                                 <<03004>>13904000
BOARD'TYPE := READ'SIB'REG(CHANNEL'CONFIG);                    <<03004>>13906000
IF BOARD'TYPE = LYNX'TYPE OR                                   <<08392>>13908000
   BOARD'TYPE = TIC'TYPE THEN                                  <<08392>>13910000
   BEGIN   << SIB IS A LYNX >>                                 <<03004>>13912000
   DISABLE'INTRPTS;                                            <<03004>>13914000
   AIB'ENABLE := ENABLE'MASK&LSR(STD'CONS'AIB);                <<03004>>13916000
   CONS'PORT := STD'CONS'AIB&LSL(4) LOR STD'CONS'PORT;         <<03004>>13918000
   << THAW LYNX >>                                             <<03004>>13920000
   WRITE'SIB'REG(DIAG'WRITE, GO'LYNX);                         <<03004>>13922000
   << SET UP PORT POINTER TO CONSOLE >>                        <<T8392>>13924000
   WRITE'SIB'REG(PORT'POINTER, CONS'PORT);                     <<T8392>>13926000
   << ENABLE ONLY CONSOLE AIB >>                               <<T8392>>13928000
   WRITE'SIB'REG(BOARD'ENABLE, AIB'ENABLE);                    <<T8392>>13930000
   << THE ORDER OF THE ABOVE THREE STMTS IS VERY IMP >>        <<T8392>>13932000
   PUSH(SBANK);                                                <<03004>>13934000
   DMA'BANK := TOS LOR DMA'CONTROL;                            <<03022>>13936000
   PUSH(DB);                                                   <<03004>>13938000
   PUSH(Q);                                                    <<03004>>13940000
   DB'REG := LOGICAL(TOS) + LOGICAL(TOS);                      <<03004>>13942000
   << SET UP CONTROL BANK >>                                   <<03004>>13944000
   WRITE'SIB'REG(CONTROL'DMA'BANK, DMA'BANK);                  <<03004>>13946000
   << SET UP CONTROL ADDR >>                                   <<03004>>13948000
   CP'READCHAR.(12:4) := LYNX'CONVERT(BAUDRATE);               <<03004>>13950000
   PRINT'ADDR := LOGICAL(DB'REG) + LOGICAL(3);                 <<03004>>13952000
   WRITE'SIB'REG(CONTROL'DMA'ADDR, PRINT'ADDR );               <<03004>>13954000
   << SET UP READ DMA BANK >>                                  <<03004>>13956000
   WRITE'SIB'REG(READ'DMA'BANK, DMA'BANK LOR DMA'RIGHT);       <<03004>>13958000
   << SET UP READ DMA ADDR >>                                  <<03004>>13960000
   PRINT'ADDR := LOGICAL(DB'REG) + LOGICAL(1);                 <<03004>>13962000
   WRITE'SIB'REG(READ'DMA'ADDR, PRINT'ADDR);                   <<03004>>13964000
   ASSEMBLE( RCLK );   << DELAY FOR X MSEC >>                  <<03004>>13966000
   STARTIME := TOS;                                            <<03004>>13968000
   DO                                                          <<03004>>13970000
      BEGIN                                                    <<03004>>13972000
      ASSEMBLE( RCLK );                                        <<03004>>13974000
      CURTIME := TOS;                                          <<03004>>13976000
      END                                                      <<03004>>13978000
   UNTIL CURTIME - STARTIME > WAIT'LIMIT;                      <<03004>>13980000
   READCHAR := NULL;                                           <<03004>>13982000
   << LOOP UNTIL READ IS COMPLETE >>                           <<03004>>13984000
   IF PARMS.(15:1) = 1 THEN                                    <<03004>>13986000
      BEGIN   << TIME READ >>                                  <<03004>>13988000
      CP'READCHAR := %(16)0143;                                <<03708>>13990000
      TIMEOUT := WAITMS;                                       <<03004>>13992000
      END     << TIME READ >>                                  <<03004>>13994000
   ELSE                                                        <<03004>>13996000
      BEGIN                                                    <<03004>>13998000
      TIMEOUT := 0;                                            <<03004>>14000000
      END;                                                     <<03004>>14002000
   << START READ CONTROL PROGRAM >>                            <<03029>>14004000
   WRITE'SIB'REG(DIRECT'COMMAND, SIO'PORT);                    <<03029>>14006000
   LYNX'INTRPT := FALSE;                                       <<03029>>14008000
   ASSEMBLE(RCLK);  << SAVE CURRENT CLOCK FOR TIMEOUT >>       <<03004>>14010000
   STARTIME := TOS;                                            <<03004>>14012000
   DO                                                          <<03004>>14014000
      BEGIN   << WAIT FOR INTERRUPT >>                         <<03004>>14016000
      TERM'INTRPT := READ'SIB'REG(INTRPTS'NO'FLUSH);           <<03004>>14018000
      IF TERM'INTRPT.(0:1) THEN                                <<03004>>14020000
         BEGIN   << INTERRUPT HAS OCCURED >>                   <<03004>>14022000
         TERM'INTRPT := READ'SIB'REG(INTRPTS'FLUSH);           <<03004>>14024000
         IF TERM'INTRPT.(9:7) = CONS'PORT.(9:7) THEN           <<03004>>14026000
            BEGIN   << CORRECT PORT INTERRUPTED >>             <<03004>>14028000
            LYNX'INTRPT := TRUE;                               <<03004>>14030000
            INTRPT'REASON := READ'SIB'REG(TERM'INTRPT'REASON); <<03004>>14032000
            IF INTRPT'REASON&LSR(8) <> READ'DONE THEN          <<03004>>14034000
               BEGIN   << NOT CORRECT REASON - ERROR >>        <<03004>>14036000
               READCHAR := INTRPT'REASON.(0:8) LOR             <<03029>>14038000
                           BIT0;                               <<03004>>14040000
               END     << NOT CORRECT REASON - ERROR >>        <<03004>>14042000
            ELSE                                               <<03004>>14044000
               READCHAR := CHARACTER.(8:8);                    <<03004>>14046000
            END      << CORRECT PORT INTERRUPTED >>            <<03004>>14048000
         END     << INTERRUPT HAS OCCURED >>                   <<03004>>14050000
      ELSE                                                     <<03004>>14052000
         BEGIN   << CHECK HARDWARE ERROR >>                    <<03004>>14054000
         IF TERM'INTRPT.(2:1) THEN                             <<03004>>14056000
            BEGIN                                              <<03004>>14058000
            LYNX'INTRPT := TRUE;                               <<03004>>14060000
            INTRPT'ERROR := READ'SIB'REG(DIAG'REGA);           <<03004>>14062000
            READCHAR := INTRPT'ERROR.(8:8) LOR BIT2;           <<03029>>14064000
            WRITE'SIB'REG(DIAG'REGA, ERROR'CLEAR);             <<T9011>>14066000
            WRITE'SIB'REG(DIAG'REGA, GO'LYNX);                 <<T9011>>14068000
            END;                                               <<03004>>14070000
         END;    << CHECK HARDWARE ERROR >>                    <<03004>>14072000
      IF LYNX'INTRPT = FALSE AND TIMEOUT <> 0 THEN             <<03004>>14074000
         BEGIN                                                 <<03004>>14076000
         ASSEMBLE( RCLK );                                     <<03004>>14078000
         CURTIME := TOS;                                       <<03004>>14080000
         IF CURTIME-STARTIME > TIMEOUT THEN                    <<03004>>14082000
            BEGIN                                              <<03004>>14084000
            READCHAR := NULL;                                  <<03004>>14086000
            WRITE'SIB'REG(DIRECT'COMMAND, HIO'PORT);           <<03004>>14088000
            DO                                                 <<03004>>14090000
               BEGIN   << WAIT FOR HALT >>                     <<03004>>14092000
               TERM'INTRPT := READ'SIB'REG(INTRPTS'NO'FLUSH);  <<03004>>14094000
               IF TERM'INTRPT.(0:1) THEN                       <<03004>>14096000
                  BEGIN   << HALT OCCURED >>                   <<03004>>14098000
                  TERM'INTRPT := READ'SIB'REG(INTRPTS'FLUSH);  <<03004>>14100000
                  LYNX'INTRPT := TRUE;                         <<03004>>14102000
                  END;    << HALT OCCURED >>                   <<03004>>14104000
               END     << WAIT FOR HALT >>                     <<03004>>14106000
            UNTIL LYNX'INTRPT = TRUE;                          <<03004>>14108000
            END;                                               <<03004>>14110000
         END;                                                  <<03004>>14112000
      END     << WAIT FOR INTERRUPT >>                         <<03004>>14114000
   UNTIL LYNX'INTRPT = TRUE;                                   <<03004>>14116000
   END     << SIB IS A LYNX >>                                 <<03004>>14118000
ELSE                                                           <<03004>>14120000
   BEGIN   << SIB IS A ADCC >>                                 <<03004>>14122000
                                                               <<03004>>14124000
                                                               <<03004>>14126000
   << SET TIME-OUT FOR READ IF PROCEDURE WAS CALLED >>         <<03004>>14128000
   << WITH A TIME-OUT VALUE.                        >>         <<03004>>14130000
                                                               <<03004>>14132000
   IF PARMS.(15:1) = 1 THEN                                    <<03004>>14134000
      TIMEOUT := WAITMS                                        <<03004>>14136000
   ELSE                                                        <<03004>>14138000
      TIMEOUT := 0;                                            <<03004>>14140000
                                                               <<03004>>14142000
   PUSH(DB);                                                   <<03004>>14144000
   OLDDB := TOS;  <<SAVE OLD DB>>                              <<03004>>14146000
   TOS := 0;                                                   <<03004>>14148000
   TOS := ABSOLUTE(TERMCHANPROG);                              <<03004>>14150000
   CPBASE := LS0;                                              <<03004>>14152000
   SET(DB);                                                    <<03004>>14154000
   MOVE CP := CHANIOPROG,(%46);                                <<03004>>14156000
   CP( %4) := CP(%16) := CPBASE+DATA0;                         <<03004>>14158000
   CP(%25) := CPBASE+DATA2;                                    <<03004>>14160000
   CP(%32) := CP(%37) := CPBASE+DATA1;                         <<03004>>14162000
   CP(%11) := CPBASE+DATA3;                                    <<03004>>14164000
   CP(DATA3).(0:8) := BAUDRATE + %20;                          <<03004>>14166000
                  << TURN OFF ECHO IF WAITING FOR >>           <<03004>>14168000
                  << AN ACK FROM THE TERMINAL     >>           <<03004>>14170000
   SIOP( CONSOLEDRT, IF PARMS.(15:1)=1 THEN CPBASE+5           <<03022>>14172000
                                       ELSE CPBASE  );         <<03022>>14174000
   IF <> THEN ERRMESSAGE( M2, CONSOLEDRT);                     <<03022>>14176000
   ASSEMBLE(RCLK);   << SAVE CLOCK FOR TIMEOUTS >>             <<03004>>14178000
   STARTIME := TOS;                                            <<03004>>14180000
                                                               <<03004>>14182000
   DO BEGIN     << LOOP UNTIL CHANNEL PROGRAM ENDS >>          <<03004>>14184000
      ASSEMBLE( RCLK);   << OR TIMEOUT IS REACHED  >>          <<03004>>14186000
      CURTIME := TOS;                                          <<03004>>14188000
      IF TIMEOUT = 0 THEN CURTIME := STARTIME;                 <<03004>>14190000
      END                                                      <<03004>>14192000
   UNTIL ( GETDRT( CONSOLEDRT, CHANSTAT).(0:2) = 0             <<03004>>14194000
             OR CURTIME-STARTIME > TIMEOUT);                   <<03004>>14196000
                                                               <<03004>>14198000
   << IF WE TIMED-OUT, HALT THE CHANNEL PROGRAM    >>          <<03004>>14200000
   << AND RETURN THE NULL CHAR.                    >>          <<03004>>14202000
   IF CURTIME-STARTIME > TIMEOUT THEN                          <<03004>>14204000
      BEGIN                                                    <<03004>>14206000
      READCHAR := NULL;                                        <<03004>>14208000
      TOS := CONSOLEDRT;                                       <<03004>>14210000
      ASSEMBLE( DUP; HIOP; BG*-3; DEL);                        <<03004>>14212000
      END                                                      <<03004>>14214000
   ELSE                                                        <<03004>>14216000
      READCHAR := CP( DATA2);                                  <<03004>>14218000
                                                               <<03004>>14220000
   TOS := OLDDB;     << RESTORE DB >>                          <<03004>>14222000
   SET(DB);                                                    <<03004>>14224000
   END     << SIB IS A ADCC >>                                 <<03004>>14226000
END;  << READCHAR >>                                           <<03004>>14228000
$CONTROL SEGMENT=RESIDENT                                      <<03603>>14230000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>14232000
$CONTROL SEGMENT=RESIDENT                                      <<00888>>14234000
PROCEDURE CLEARLINE;                                           <<00888>>14236000
   <<CLEARS THE LIST BUFFER>>                                  <<00888>>14238000
   BEGIN                                                       <<00888>>14240000
   TOS := @LINE; PS0 := "  ";                                  <<00888>>14242000
   ASSEMBLE(DUP,INCB); TOS := 35; ASSEMBLE(MOVE 3);            <<00888>>14244000
   END;                                                        <<00888>>14246000
$CONTROL SEGMENT=RESIDENT                                      <<00888>>14248000
PROCEDURE BLANKLINE;                                           <<00888>>14250000
   <<PRINTS A BLANK LINE ON THE LIST DEVICE AND CLEARS THE LIST BUFFER>>14252000
   BEGIN                                                       <<00888>>14254000
   IF LIST THEN PRINT(LINE,0,0);                               <<00888>>14256000
   CLEARLINE;                                                  <<00888>>14258000
   END;                                                        <<00888>>14260000
$CONTROL SEGMENT=RESIDENT                                      <<00888>>14262000
PROCEDURE PRINTLINE;                                           <<00888>>14264000
   <<PRINTS THE CONTENTS OF THE LIST BUFFER ON THE LIST DEVICE AND      14266000
     CLEARS THE LIST BUFFER>>                                  <<00888>>14268000
   BEGIN                                                       <<00888>>14270000
   IF LIST THEN                                                <<00888>>14272000
      BEGIN                                                    <<00888>>14274000
      TOS := @LINE;                                            <<00888>>14276000
      TOS := @BLINE(71);  <<POINTER TO LAST CHAR.>>            <<00888>>14278000
      IF BPS0 = " " THEN                                       <<00888>>14280000
         BEGIN                                                 <<00888>>14282000
         ASSEMBLE(DUP,DECB);                                   <<00888>>14284000
         TOS := -71;                                           <<00888>>14286000
         ASSEMBLE(CMPB 2);                                     <<00888>>14288000
         END;                                                  <<00888>>14290000
      TOS := -(TOS-@BLINE+1);  <<NEG. NR. CHAR'S>>             <<00888>>14292000
      PRINT(*,*,0);                                            <<00888>>14294000
      END;                                                     <<00888>>14296000
   CLEARLINE;                                                  <<00888>>14298000
   END;                                                        <<00888>>14300000
$PAGE "MESSAGE ROUTINE"                                                 14302000
$CONTROL SEGMENT=RESIDENT                                               14304000
$INCLUDE INCLMSG                                               <<*8392>>14306000
$CONTROL SEGMENT=RESIDENT                                      <<01103>>14308000
          <<------------------>>                               <<01103>>14310000
          << OUTPUT A MESSAGE >>                               <<01103>>14312000
          <<------------------>>                               <<01103>>14314000
PROCEDURE MESSAGE( MSGNR,NUM1,NUM2,NUM3,NUM4,STRING1,STRING2); <<01103>>14316000
   VALUE MSGNR, NUM1, NUM2, NUM3, NUM4;                        <<01103>>14318000
   INTEGER MSGNR;                                              <<01103>>14320000
   LOGICAL NUM1, NUM2, NUM3, NUM4;                             <<01103>>14322000
   BYTE ARRAY STRING1, STRING2;                                <<01103>>14324000
   OPTION VARIABLE;                                            <<01103>>14326000
BEGIN                                                          <<01103>>14328000
   ARRAY BUF(0:65)=Q; << DIRECT ARRAY - DB SETTING UNKNOWN >>  <<01103>>14330000
   BYTE ARRAY BBUF(*) = BUF;                                   <<01103>>14332000
                                                               <<01103>>14334000
   TOS := ABSOLUTE(DBBANK);                                    <<01103>>14336000
   TOS := ABSOLUTE(DB);                                        <<01103>>14338000
   ASSEMBLE( XCHD );  << SET DB TO STACK >>                    <<01103>>14340000
   XREG := GENMESSAGE( \MSGNR\,BBUF,DOUBLE(NUM1),DOUBLE(NUM2), <<01103>>14342000
                   DOUBLE(NUM3),DOUBLE(NUM4),STRING1,STRING2); <<01103>>14344000
   IF <> THEN << CCA GENERATED BY STAX >>                      <<01103>>14346000
      BEGIN   << THE MESSAGE EXISTS >>                         <<01103>>14348000
      IF MSGNR < 0 THEN                                        <<01103>>14350000
         BEGIN  << IT'S A QUESTION >>                          <<01103>>14352000
         BBUF(XREG) := "?";                                    <<01103>>14354000
         BBUF(XREG:=XREG+1) := " ";                            <<01103>>14356000
         PRINT( BUF, -XREG-1, %320);                           <<01103>>14358000
         END                                                   <<01103>>14360000
      ELSE                                                     <<01103>>14362000
         PRINT( BUF, -XREG, 0);                                <<01103>>14364000
      END;                                                     <<01103>>14366000
   SET( DB );   << RETURN DB TO ORGINAL SETTING >>             <<01103>>14368000
END;  << MESSAGE >>                                            <<01103>>14370000
$CONTROL SEGMENT=BOOTSTRAP                                     <<01103>>14372000
          <<------------>>                                     <<01103>>14374000
          << ERROR QUIT >>                                     <<01103>>14376000
          <<------------>>                                     <<01103>>14378000
PROCEDURE ERRMESSAGE( MSGNR,NUM1,NUM2,NUM3,NUM4,STR1,STR2);    <<01103>>14380000
   VALUE MSGNR, NUM1, NUM2, NUM3, NUM4;                        <<01103>>14382000
   INTEGER MSGNR;                                              <<01103>>14384000
   LOGICAL NUM1, NUM2, NUM3, NUM4;                             <<01103>>14386000
   BYTE ARRAY STR1, STR2;                                      <<01103>>14388000
   OPTION VARIABLE;                                            <<01103>>14390000
BEGIN COMMENT                                                  <<01103>>14392000
                                                               <<01103>>14394000
      This is a fatal error message procedure.  A STACK        <<01103>>14396000
   MARKER TRACE is printed, an error message and then          <<01103>>14398000
   INITIAL halts.  You may enter the HELP debugger by          <<01103>>14400000
   changing the lower eight bits of the switch register        <<01103>>14402000
   to a different value than when cold loaded.                 <<01103>>14404000
                                                               <<01103>>14406000
;                                                              <<01103>>14408000
   INTEGER DELTAQ;  << DELTA Q MUST BE AT Q+1 !!! >>           <<01103>>14410000
   INTEGER ARRAY QARRAY(*) = Q+0;                              <<01103>>14412000
   INTEGER STP, LASTSTP, I, SEG;                               <<01103>>14414000
   DOUBLE OLDDB;                                               <<01103>>14416000
   BYTE ARRAY CNT(0:1) = Q;                                    <<01103>>14418000
   BYTE ARRAY SEGNAMES(*) = PB :=                              <<01103>>14420000
        4,"ININ",                                              <<03603>>14422000
        9,"BOOTSTRAP",                                         <<03603>>14424000
        8,"RESIDENT",                                          <<03603>>14426000
        8,"MAINSEG1",                                          <<03603>>14428000
        9,"MAINSEG1A",                                         <<03603>>14430000
        9,"CONFIGURE",                                         <<03603>>14432000
       10,"DEFCTRACKS",                                        <<03603>>14434000
        5,"SETUP",                                             <<03603>>14436000
        6,"TAPEIO",                                            <<03603>>14438000
        6,"FILEIO",                                            <<03603>>14440000
        9,"DISKSPACE",                                         <<03603>>14442000
       10,"DIRECTORY1",                                        <<03603>>14444000
       10,"DIRECTORY2",                                        <<03603>>14446000
       10,"SL PROGRAM",                                        <<03603>>14448000
        7,"PROCESS",                                           <<03603>>14450000
        9,"MAINSEG1B",                                         <<03603>>14452000
        8,"MAINSEG2",                                          <<03603>>14454000
        8,"MAINSEG3",                                          <<03603>>14456000
        8,"MAINSEG4";                                          <<03603>>14458000
                                                               <<01103>>14460000
   TOS := ABSOLUTE(DBBANK);                                    <<01103>>14462000
   TOS := ABSOLUTE(DB);                                        <<01103>>14464000
   ASSEMBLE( XCHD );  << SET DB TO STACK >>                    <<01103>>14466000
   OLDDB := TOS;  << WE MAY WANT TO KNOW WHERE DB WAS >>       <<01103>>14468000
                                                               <<01103>>14470000
   PUSH( Z );                                                  <<01103>>14472000
   IF TOS <> ABSOLUTE(ZI) THEN  << ICS? >>                     <<01103>>14474000
      BEGIN  << NOT IN BOOTSTRAP >>                            <<01103>>14476000
      MESSAGE(M2454); << STACK MARKER TRACE >>                 <<01103>>14478000
      DELTAQ := 5;                                             <<01103>>14480000
      LASTSTP := STP := 1; << POINTS TO PHONY DELTAQ >>        <<01103>>14482000
                                                               <<01103>>14484000
      DO BEGIN                                                 <<01103>>14486000
         LASTSTP := STP := LASTSTP-QARRAY(STP);                <<01103>>14488000
         NTOA( QARRAY(STP:=STP+1), 8, BLINE(5));               <<01103>>14490000
         NTOA( QARRAY(STP:=STP+1), 8, BLINE(13));              <<01103>>14492000
         NTOA( QARRAY(STP:=STP+1), 8, BLINE(21));              <<01103>>14494000
         SEG := QARRAY(STP).(8:8); << SEGMENT NR. >>           <<01103>>14496000
         NTOA( QARRAY(STP:=STP+1), 8, BLINE(29));              <<01103>>14498000
         IF 1 <= SEG <= %23 THEN                               <<03603>>14500000
            BEGIN                                              <<01103>>14502000
            TOS := @CNT;      << DESTINATION ADR  >>           <<01103>>14504000
            TOS := @SEGNAMES; << SOURCE ADR       >>           <<01103>>14506000
            XREG := XREG-1;   << REL. TO SEGNAMES >>           <<03603>>14508000
            WHILE > DO                                         <<01103>>14510000
               BEGIN                                           <<01103>>14512000
               MOVE * := *PB,(1),1; << LOAD NR. BYTES >>       <<01103>>14514000
               TOS := TOS+CNT;  << BEGINNING OF NEXT NAME >>   <<01103>>14516000
               ASSEMBLE( DECB, DECX );                         <<01103>>14518000
               END;                                            <<01103>>14520000
            MOVE * := *PB,(1),1; << LOAD NR. BYTES >>          <<01103>>14522000
            DELB;  << GET RID OF DESTINATION ADR >>            <<01103>>14524000
            MOVE BLINE(33) := *PB,(CNT);                       <<01103>>14526000
            END;                                               <<01103>>14528000
         PRINTLINE;                                            <<03603>>14530000
         END UNTIL QARRAY(STP) = 0;                            <<01103>>14532000
                                                               <<01103>>14534000
      BLANKLINE;                                               <<01103>>14536000
      BLANKLINE;                                               <<01103>>14538000
      MESSAGE( MSGNR,NUM1,NUM2,NUM3,NUM4,STR1,STR2);           <<01103>>14540000
   IF CS80'LOCK THEN                                           <<04546>>14542000
     UNLOCK'CS80;                                              <<04546>>14544000
      END;                                                     <<01103>>14546000
DIE:                                                           <<01103>>14548000
   ASSEMBLE( HALT 4;                                           <<01103>>14550000
             RSW      );                                       <<01103>>14552000
   IF TOS.(8:8) <> SYSTAPEDRT THEN HELP;                       <<01103>>14554000
   GO DIE;                                                     <<01103>>14556000
END;  << ERRMESSAGE >>                                         <<01103>>14558000
PROCEDURE SUDDENDEATH(PARM);                                   <<04326>>14560000
VALUE PARM;                                                    <<MPEIV>>14562000
INTEGER PARM;                                                  <<MPEIV>>14564000
BEGIN  << VIRTUAL MEMORY SUDDEN DEATH CALL >>                  <<MPEIV>>14566000
ERRMESSAGE(M330, 0);                                           <<MPEIV>>14568000
END;                                                           <<MPEIV>>14570000
$PAGE "CONSOLE INPUT/OUTPUT ROUTINES"                                   14572000
$CONTROL SEGMENT=RESIDENT                                               14574000
                                                                        14576000
  INTEGER PROCEDURE BINARY(STRING,LENGTH);                              14578000
    VALUE LENGTH;                                                       14580000
    INTEGER LENGTH;                                                     14582000
    BYTE ARRAY STRING;                                                  14584000
    BEGIN                                                               14586000
    COMMENT                                                             14588000
      CONVERTS NUMBER POINTED TO BY STRING TO OCTAL.;                   14590000
      INTEGER VAL=BINARY,I:=0;                                          14592000
        TOS := @STRING;                                                 14594000
        DO                                                              14596000
          BEGIN                                                         14598000
          I:=I+1;                                                       14600000
          TOS := VAL;                                                   14602000
          TOS := %10;                                                   14604000
          ASSEMBLE(MPYL,DELB);                                          14606000
          TOS := TOS+INTEGER(BPS1)-%60;                                 14608000
          VAL := TOS;                                                   14610000
          TOS := TOS+1;                                                 14612000
          END                                                           14614000
        UNTIL I=LENGTH;                                                 14616000
     END  <<BINARY>>;                                                   14618000
                                                                        14620000
$PAGE                                                                   14622000
$CONTROL SEGMENT=SETUP                                                  14624000
          <<------------------------                                    14626000
            GET DOUBLE INPUT VALUE                                      14628000
          -------------------------->>                                  14630000
  DOUBLE PROCEDURE DINVAL(ERRLABEL);                                    14632000
    VALUE ERRLABEL;                                                     14634000
    INTEGER ERRLABEL ;                                                  14636000
     COMMENT                                                            14638000
       CONVERTS A DOUBLE INTEGER POINTED TO BY BPINBUF TO               14640000
     BINARY. IF AN ERROR IS DETECTED RETURNS TO ERRLABEL.               14642000
     OTHERWISE RETURNS VALUE AND SETS CONDITION CODE AS                 14644000
     FOLLOWS:                                                           14646000
       CCE - NO VALUE INPUT                                             14648000
       CCG - FOLLOWED BY CARRIAGE RETURN                                14650000
       CCL - FOLLOWED BY COMMA;                                         14652000
     BEGIN                                                              14654000
       EQUATE BLANK=%6440;                                              14656000
       INTEGER CONCODE := CCL,                                          14658000
               TOP = S-0,NCHAR,                                         14660000
               I := -1;                                                 14662000
       DOUBLE TOPD = S-1;                                               14664000
       BYTE POINTER STRING;                                             14666000
          SCAN BPINBUF WHILE BLANK,1;<<DELETE LEADING BLANKS>>          14668000
          IF CARRY THEN                                                 14670000
            BEGIN   <<CARRIAGE RETURN INPUT>>                           14672000
            @BPINBUF := TOS+1;                                          14674000
            CONCODE := CCE;                                             14676000
            GO FIN;                                                     14678000
            END;                                                        14680000
          ASSEMBLE(DUP,DDUP);                                           14682000
          MOVE * := * WHILE N,0; <<FIND FIRST NON-NUMERIC>>             14684000
          SCAN * WHILE BLANK,1;  <<DELETE TRRILING BLANKS>>             14686000
          IF CARRY THEN CONCODE := CCG  <<CR FOLLOWS>>                  14688000
          ELSE IF BPS0<>"," THEN GO TO ERROREXIT;                       14690000
          @BPINBUF := TOS+1; <<UPDATE BUFFER POINTER>>                  14692000
          ASSEMBLE(XCH,SUB); <<COMPUTE LENGTH>>                         14694000
          IF = THEN                                                     14696000
            BEGIN                                                       14698000
            RETURNP := ERRLABEL;                                        14700000
            ASSEMBLE(EXIT 3);                                           14702000
            END;                                                        14704000
          NCHAR := TOS;                                                 14706000
          @STRING := TOS;                                               14708000
          TOS := 0D;                                                    14710000
          WHILE (I:=I+1) <  NCHAR DO                                    14712000
           BEGIN                                                        14714000
           IF TOPD>=%2000000000D THEN                                   14716000
   ERROREXIT:BEGIN   <<TOO BIG>>                                        14718000
             RETURNP := ERRLABEL;                                       14720000
             ASSEMBLE(EXIT 3);                                          14722000
             END;                                                       14724000
           ASSEMBLE(DLSL 1;DDUP;DLSL 2;DADD);                           14726000
           IF OVERFLOW THEN GO ERROREXIT;                               14728000
           TOS := 0;                                                    14730000
           TOS := LOGICAL(STRING(I))-%60;                               14732000
           IF (TOP>9) OR (TOP<0) THEN GO ERROREXIT;                     14734000
           ASSEMBLE(DADD);                                              14736000
           IF OVERFLOW THEN GO ERROREXIT;                               14738000
           END;                                                         14740000
          DINVAL := TOS;                                                14742000
   FIN:   STAT.(6:2) := CONCODE;                                        14744000
     END;                                                               14746000
          <<-----------------                                           14748000
            GET INPUT VALUE                                             14750000
          ----------------->>                                           14752000
  INTEGER PROCEDURE INVAL(ERRLABEL);                                    14754000
    VALUE ERRLABEL;                                                     14756000
    INTEGER ERRLABEL;   <<LABEL FOR ERROR RETURN>>                      14758000
    COMMENT                                                             14760000
      CONVERTS A NUMBER POINTED TO BY BPINBUF TO BINARY. IF AN ERROR    14762000
    IS DETECTED RETURNS TO ERRLABEL. OTHERWISE RETURNS VALUE AND SETS   14764000
    CONDITION CODE AS FOLLOWS:                                          14766000
         CCE - NO VALUE INPUT                                           14768000
         CCG - FOLLOWED BY CARRIAGE RETURN                              14770000
         CCL - FOLLOWED BY COMMA;                                       14772000
      BEGIN                                                             14774000
        EQUATE BLANK=%6440;                                             14776000
        INTEGER CONCODE:=CCL;                                           14778000
        INTEGER BASE:=10;                                      <<00678>>14780000
        INTEGER NCHAR,I:=0,VAL=INVAL;                                   14782000
          TOS  := 0;   <<FOR BINARY RETURN VALUE>>                      14784000
          SCAN BPINBUF WHILE BLANK,1;  <<DELETE LEADING BLANKS>>        14786000
          IF CARRY THEN                                                 14788000
            BEGIN       <<CARRIAGE RETURN INPUT>>                       14790000
              @BPINBUF := TOS+1;                                        14792000
              CONCODE := CCE;                                           14794000
              GOTO FIN;                                                 14796000
            END;                                                        14798000
          IF BPS0="%" THEN                                     <<00678>>14800000
            BEGIN                                              <<00678>>14802000
            BASE:=8;                                           <<00678>>14804000
            TOS:=TOS+1;                                        <<00678>>14806000
            END;                                               <<00678>>14808000
          ASSEMBLE(DUP,DDUP);                                           14810000
          MOVE * := * WHILE N,0;   <<FIND FIRST NON-NUMERIC>>           14812000
          SCAN * WHILE BLANK,1;    <<DELETE TRAILING BLANKS>>           14814000
          IF CARRY THEN CONCODE := CCG    <<CR FOLLOWS>>                14816000
          ELSE IF BPS0<>"," THEN GOTO ERROR; <<ILLEGAL FOLLOWING CHAR>> 14818000
          @BPINBUF := TOS+1;     <<UPDATE BUFFER POINTER>>              14820000
          ASSEMBLE(XCH,SUB);     <<COMPUTE LENGTH>>                     14822000
          IF = THEN                                                     14824000
            BEGIN                                                       14826000
  ERROR:      RETURNP := ERRLABEL;     <<ERROR RETURN LABEL>>           14828000
              ASSEMBLE(EXIT 2);        <<DELETE INVAL'S VALUE>>         14830000
            END;                                                        14832000
          NCHAR := TOS;                                                 14834000
          DO                                                            14836000
            BEGIN                                                       14838000
              I := I+1;                                                 14840000
              TOS := VAL;                                               14842000
              TOS := BASE;                                     <<00678>>14844000
              ASSEMBLE(MPYL,DELB);                                      14846000
              IF CARRY THEN GOTO ERROR;  <<TOO BIG>>                    14848000
              TOS := TOS+INTEGER(BPS1)-%60;                             14850000
              IF OVERFLOW THEN GOTO ERROR;     <<TOO BIG>>              14852000
              VAL := TOS;                                               14854000
              TOS := TOS+1;   <<BUMP CHARACTER POINTER>>                14856000
            END                                                         14858000
          UNTIL I=NCHAR;                                                14860000
  FIN:    STAT.(6:2) := CONCODE;       <<SET CONDITION CODE>>           14862000
      END <<INVAL>> ;                                                   14864000
                                                               <<D8822>>14866000
procedure hexout(number, outstring, length);                   <<D8822>>14868000
   value number, length;                                       <<D8822>>14870000
   double number;                                              <<D8822>>14872000
   integer length;                                             <<D8822>>14874000
   byte array outstring;                                       <<D8822>>14876000
                                                               <<D8822>>14878000
   begin                                                       <<D8822>>14880000
                                                               <<D8822>>14882000
   <<------------------------------------------------------>>  <<D8822>>14884000
   << characters for hexadecimal conversion: 0,1,2,...9,A, >>  <<D8822>>14886000
   <<------------------------------------------------------>>  <<D8822>>14888000
   integer array chars(*) = pb :=                              <<D8822>>14890000
           %60, %61, %62, %63,                                 <<D8822>>14892000
           %64, %65, %66, %67,                                 <<D8822>>14894000
           %70, %71, %101,%102,                                <<D8822>>14896000
          %103, %104,%105,%106;                                <<D8822>>14898000
                                                               <<D8822>>14900000
                                                               <<D8822>>14902000
   while length > 0 do                                         <<D8822>>14904000
      begin                                                    <<D8822>>14906000
      length := length - 1;                                    <<D8822>>14908000
      outstring(length) := chars(logical(number).(12:4));      <<D8822>>14910000
      number := number & dcsr(4);                              <<D8822>>14912000
      end;                                                     <<D8822>>14914000
                                                               <<D8822>>14916000
end; <<hexout>>                                                <<D8822>>14918000
                                                               <<D8822>>14920000
          <<--------------------------                                  14922000
            GET "YES" OR "NO" ANSWER                                    14924000
          -------------------------->>                                  14926000
PROCEDURE GETYESNO(NOLABEL,MESSN,NUM1,NUM2,NUM3,NUM4,          <<03668>>14928000
                                        STRING1,STRING2);      <<03668>>14930000
VALUE NOLABEL,MESSN,NUM1,NUM2,NUM3,NUM4;                       <<03668>>14932000
INTEGER NOLABEL,MESSN,NUM1,NUM2,NUM3,NUM4;                     <<03668>>14934000
BYTE ARRAY STRING1, STRING2;                                   <<03668>>14936000
OPTION VARIABLE;                                               <<03668>>14938000
    COMMENT                                                             14940000
      OUTPUTS A MESSAGE AND LOOKS FOR A "Y" RESPONSE (NORMAL RETURN)    14942000
    OR A "N" OR CARRIAGE RETURN RESPONSE (RETURN TO NOLABEL);           14944000
      BEGIN                                                             14946000
        EQUATE BLANK = %6440;                                           14948000
  AGAIN:  MESSAGE(-MESSN,NUM1,NUM2,NUM3,  << OUTPUT MESSAGE >> <<03668>>14950000
                    NUM4,STRING1,STRING2);                     <<03668>>14952000
          READINPUT;                                                    14954000
          SCAN BINBUF WHILE BLANK,1;                                    14956000
          ASSEMBLE(DUP,DUP);                                            14958000
          MOVE * := * WHILE ANS;                                        14960000
          IF CARRY OR (BPS0="N") THEN                                   14962000
            BEGIN    <<"NO" RESPONSE>>                                  14964000
              RETURNP := NOLABEL;                                       14966000
              RETURN;                                                   14968000
            END                                                         14970000
          ELSE                                                          14972000
          IF BPS0<>"Y" THEN                                    <<01025>>14974000
            BEGIN    <<ERROR>>                                          14976000
              DEL;                                                      14978000
              MESSAGE(M2453);  <<ILLEGAL INPUT>>               <<01103>>14980000
              GO AGAIN;                                                 14982000
            END;                                                        14984000
                    <<FALLS THROUGH IN "Y" CASE>>                       14986000
      END <<GETYESNO>> ;                                                14988000
$CONTROL SEGMENT=SETUP                                         <<00888>>14990000
LOGICAL PROCEDURE LGETYESNO(MESSAGENR,NUM1,NUM2,NUM3,NUM4,     <<03668>>14992000
                                          STRING1,STRING2);    <<03668>>14994000
VALUE MESSAGENR,NUM1,NUM2,NUM3,NUM4;                           <<03668>>14996000
INTEGER MESSAGENR,NUM1,NUM2,NUM3,NUM4;                         <<03668>>14998000
BYTE ARRAY STRING1,STRING2;                                    <<03668>>15000000
OPTION VARIABLE;                                               <<03668>>15002000
BEGIN                                                          <<00888>>15004000
   GETYESNO(@NOLABEL,MESSAGENR,NUM1,NUM2,NUM3,NUM4,            <<03668>>15006000
                                    STRING1,STRING2);          <<03668>>15008000
   LGETYESNO := TRUE;                                          <<00888>>15010000
NOLABEL:                                                       <<00888>>15012000
END;                                                           <<00888>>15014000
                                                               <<t8392>>15016000
logical procedure defyesanswer(mode, messn, defchosen);        <<D8822>>15018000
   value mode, messn;                                          <<t8392>>15020000
   integer mode, messn, defchosen;                             <<D8822>>15022000
   option variable, privileged, uncallable;                    <<D8822>>15024000
   begin                                                       <<t8392>>15026000
                                                               <<D8822>>15028000
   logical pmap = q - 4;  << option variable parameter map>>   <<D8822>>15030000
                                                               <<t8392>>15032000
   equate blank = %6440;                                       <<t8392>>15034000
                                                               <<D8822>>15036000
   again:                                                      <<D8822>>15038000
   fill'(binbuf, 80, " ");                                     <<t8392>>15040000
   binbuf(0) := %3; <<count for genmessage string>>            <<t8392>>15042000
   if pmap then defchosen := false;                            <<D8822>>15044000
   if logical(mode) then                                       <<t8392>>15046000
      move binbuf(1) := " Y "                                  <<t8392>>15048000
   else move binbuf(1) := " N ";                               <<t8392>>15050000
   message(-messn,,,,,binbuf);                                 <<D8822>>15052000
   readinput;                                                  <<t8392>>15054000
   scan binbuf while blank, 1;                                 <<t8392>>15056000
   assemble(dup, dup);                                         <<t8392>>15058000
   move * := * while ans; <<upshift lower case>>               <<t8392>>15060000
   if carry  then                                              <<D8822>>15062000
      begin                                                    <<D8822>>15064000
      if pmap then defchosen := true;                          <<D8822>>15066000
      defyesanswer := logical(mode);                           <<D8822>>15068000
      end                                                      <<D8822>>15070000
   else if bps0 = "Y" then                                     <<D8822>>15072000
      defyesanswer := true                                     <<D8822>>15074000
   else if bps0 = "N" then                                     <<t8392>>15076000
      defyesanswer := false                                    <<D8822>>15078000
   else begin                                                  <<t8392>>15080000
        del;                                                   <<t8392>>15082000
        message (m2453); <<illegal input>>                     <<t8392>>15084000
        go again;                                              <<t8392>>15086000
        end;                                                   <<t8392>>15088000
                                                               <<t8392>>15090000
    end; <<defyesanswer>>                                      <<t8392>>15092000
          <<-----------                                                 15094000
            GET VALUE                                                   15096000
          ----------->>                                                 15098000
  INTEGER PROCEDURE GETVAL(MESSN,LLIM,ULIM,TERM);                       15100000
    VALUE MESSN,LLIM,ULIM,TERM;                                         15102000
    INTEGER MESSN,   <<MESSAGE NUMBER>>                                 15104000
            LLIM,    <<LOWER LIMIT>>                                    15106000
            ULIM,    <<UPPER LIMIT>>                                    15108000
            TERM;    <<TERMINATING CONTROL:                             15110000
                          1 - CR ONLY                                   15112000
                          0 - COMMA ONLY                                15114000
                         -1 - CR OR COMMA  >>                           15116000
    COMMENT                                                             15118000
      OUTPUTS A MESSAGE AND LOOKS FOR THE INPUT OF A NUMBER IN THE      15120000
    RANGE  LLIM <= N <= ULIM. IF THE TERMINATING CONTROL = 1, THE       15122000
    CONDITION CODE IS SET AS FOLLOWS:                                   15124000
         CCG - CARRIAGE RETURN                                          15126000
         CCL - COMMA;                                                   15128000
      BEGIN                                                             15130000
      INTEGER TERMTEST;  << HOLDS VALUE OF TERM >>             <<03709>>15132000
  AGAIN:  MESSAGE(-MESSN);       <<OUTPUT MESSAGE>>                     15134000
          READINPUT;                                                    15136000
          TOS := 0;                                                     15138000
          TOS := @ERROR1;                                               15140000
          TOS := INVAL(*);                                              15142000
          IF = THEN IF TERM<>2 THEN GOTO ERROR                          15144000
          ELSE                                                          15146000
            BEGIN                                                       15148000
              STAT.(6:2) := CCE;                                        15150000
              RETURN;                                                   15152000
            END;                                                        15154000
          PUSH(STATUS);                                                 15156000
          TOS := TOS.(6:2);                                             15158000
          STAT.(6:2) := S0;        <<SET CONDITION CODE>>               15160000
        IF TERM=2 THEN TERMTEST:=1 <<FIX TO ALLOW A CR INPUT>> <<03709>>15162000
        ELSE TERMTEST:=TERM;       <<AFTER A BAD VALUE.     >> <<03709>>15164000
        IF TOS=TERMTEST THEN GOTO ERROR; <<WRONG FOLLOW CHAR>> <<03709>>15166000
          IF (LLIM<=S0<=ULIM) THEN                                      15168000
            BEGIN                                                       15170000
              GETVAL := TOS;                                            15172000
              RETURN;                                                   15174000
            END;                                                        15176000
  ERROR:  DEL;                                                          15178000
  ERROR1: MESSAGE(M2453);                                      <<01103>>15180000
          GO AGAIN;                                                     15182000
      END <<GETVAL>> ;                                                  15184000
          <<-----------------------                                     15186000
            GET REPLACEMENT VALUE                                       15188000
          ----------------------->>                                     15190000
  PROCEDURE GETNEWVAL(MESSN,VAL,LLIM,ULIM,NUM'USED,NO'MIN'MAX);<<m8955>>15192000
    VALUE MESSN,LLIM,ULIM,NUM'USED;                            <<*8392>>15194000
    INTEGER MESSN;      <<MESSAGE NUMBER>>                     <<*8392>>15196000
    LOGICAL                                                    <<*8392>>15198000
            VAL,        <<VALUE TO BE REPLACED>>                        15200000
            LLIM,       <<LOWER LIMIT>>                                 15202000
            ULIM,       <<UPPER LIMIT>>                        <<*8392>>15204000
            NUM'USED,   << NUMBER USED >>                      <<m8955>>15206000
            NO'MIN'MAX; << SUPPRESS MIN/MAX PRINTING >>        <<m8955>>15208000
    OPTION VARIABLE;                                           <<*8392>>15210000
    COMMENT                                                             15212000
        OUTPUTS A MESSAGE FOLLOWED BY THE CURRENT VALUE, A PERIOD (.)   15214000
      AND A QUESTION MARK(?). LOOKS FOR THE INPUT OF A CARRIAGE         15216000
      RETURN, WHICH LEAVES THE VALUE THE SAME, OR AN INTEGER IN THE     15218000
      RANGE  LLIM <= N <= ULIM;                                         15220000
      BEGIN                                                             15222000
          ARRAY BUF(0:39);                                     <<01103>>15224000
          BYTE ARRAY BBUF(*) = BUF;                            <<01103>>15226000
          INTEGER LEN;                                         <<01103>>15228000
          DEFINE NUM'USED'PASSED  =LOGICAL(PARMQ4.(14:1))#,    <<m8955>>15230000
                 NO'MIN'MAX'PASSED=LOGICAL(PARMQ4.(15:1))#;    <<m8955>>15232000
                                                               <<01103>>15234000
          XREG := GENMESSAGE( MESSN, BBUF,0D,0D,0D,0D,BBUF,BBUF);       15236000
          IF = THEN MESSAGE( M374, 1); << FATAL ERROR - NO MESSAGE >>   15238000
          MOVE BBUF(XREG) := " = ",2;                          <<01103>>15240000
          TOS := TOS+ASCII( VAL,10, BPS0);                     <<*8392>>15242000
          IF NO'MIN'MAX'PASSED THEN                            <<m8955>>15244000
             MOVE * := "?",2                                   <<m8955>>15246000
          ELSE BEGIN                                           <<m8955>>15248000
               MOVE * := " (MIN=",2;                           <<m8955>>15250000
               TOS := TOS+ASCII(LLIM,10,BPS0);                 <<m8955>>15252000
               MOVE * := ", MAX=",2;                           <<m8955>>15254000
               TOS := TOS+ASCII(ULIM,10,BPS0);                 <<m8955>>15256000
               IF NUM'USED'PASSED THEN                         <<m8955>>15258000
                  BEGIN                                        <<m8955>>15260000
                  MOVE * := ", USED=",2;                       <<m8955>>15262000
                  TOS := TOS+ASCII(NUM'USED,10,BPS0);          <<m8955>>15264000
                  END;                                         <<m8955>>15266000
               MOVE * := ")?",2;                               <<m8955>>15268000
               END;                                            <<m8955>>15270000
          LEN := TOS-@BBUF;   << LEN OF MESSAGE >>             <<01103>>15272000
AGAIN:    PRINT( BUF, -LEN, %320);                             <<01103>>15274000
          READINPUT;                                                    15276000
          TOS := 0;                                                     15278000
          TOS := @ERROR1;                                               15280000
          TOS := INVAL(*);                                              15282000
          IF = THEN RETURN;                                             15284000
          IF < THEN GOTO ERROR;                                         15286000
          IF (LLIM<=LS0) AND (LS0<=ULIM) THEN                  <<*8392>>15288000
          BEGIN                                                         15290000
              VAL := TOS;                                               15292000
              RETURN;                                                   15294000
            END;                                                        15296000
          MESSAGE(M2458,LLIM,ULIM);                            <<03002>>15298000
          DEL;                                                 <<03002>>15300000
          GO AGAIN;                                            <<03002>>15302000
  ERROR:  DEL;                                                          15304000
  ERROR1: MESSAGE(M2453);                                      <<01103>>15306000
          GO AGAIN;                                                     15308000
      END <<GETNEWVAL>> ;                                               15310000
                                                               <<*8392>>15312000
          <<------------------------------>>                   <<*8392>>15314000
          << GET DOUBLE REPLACEMENT VALUE >>                   <<*8392>>15316000
          <<------------------------------>>                   <<*8392>>15318000
  PROCEDURE GETNEWVAL'DOUB(MESSN,VAL,LLIM,ULIM,NUM'USED);      <<*8392>>15320000
    VALUE MESSN,LLIM,ULIM,NUM'USED;                            <<*8392>>15322000
    INTEGER MESSN;      <<MESSAGE NUMBER>>                     <<*8392>>15324000
    DOUBLE                                                     <<*8392>>15326000
            VAL,        <<VALUE TO BE REPLACED>>               <<*8392>>15328000
            LLIM,       <<LOWER LIMIT>>                        <<*8392>>15330000
            ULIM,       <<UPPER LIMIT>>                        <<*8392>>15332000
            NUM'USED;   << NUMBER USED >>                      <<*8392>>15334000
    OPTION VARIABLE;                                           <<*8392>>15336000
    COMMENT                                                    <<*8392>>15338000
        OUTPUTS A MESSAGE FOLLOWED BY THE CURRENT VALUE, A     <<*8392>>15340000
      PERIOD AND A QUESTION MARK(?). LOOKS FOR THE INPUT OF A  <<*8392>>15342000
      CARRIAGE RETURN, WHICH LEAVES THE VALUE THE SAME, OR AN  <<*8392>>15344000
      INTEGER IN THE RANGE  LLIM <= N <= ULIM;                 <<*8392>>15346000
      BEGIN                                                    <<*8392>>15348000
          ARRAY BUF(0:39);                                     <<*8392>>15350000
          BYTE ARRAY BBUF(*) = BUF;                            <<*8392>>15352000
          INTEGER LEN;                                         <<*8392>>15354000
          DEFINE NUM'USED'PASSED=LOGICAL(PARMQ4.(15:1))#;      <<*8392>>15356000
                                                               <<*8392>>15358000
          X := GENMESSAGE( MESSN, BBUF,0D,0D,0D,0D,BBUF,BBUF); <<*8392>>15360000
          IF = THEN MESSAGE( M374, 1); << FATAL ERROR - NO MESS<<*8392>>15362000
          MOVE BBUF(X) := " = ",2;                             <<*8392>>15364000
          TOS := TOS+LDNTOA( VAL,10, BPS0);                    <<*8392>>15366000
          MOVE * := " (MIN=",2;                                <<*8392>>15368000
          TOS := TOS+LDNTOA(LLIM,10,BPS0);                     <<*8392>>15370000
          MOVE * := ", MAX=",2;                                <<*8392>>15372000
          TOS := TOS+LDNTOA(ULIM,10,BPS0);                     <<*8392>>15374000
          IF NUM'USED'PASSED THEN                              <<*8392>>15376000
             BEGIN                                             <<*8392>>15378000
             MOVE * := ", USED=",2;                            <<*8392>>15380000
             TOS := TOS+LDNTOA(NUM'USED,10,BPS0);              <<*8392>>15382000
             END;                                              <<*8392>>15384000
          MOVE * := ")?",2;                                    <<*8392>>15386000
          LEN := TOS-@BBUF;   << LEN OF MESSAGE >>             <<*8392>>15388000
AGAIN:    PRINT( BUF, -LEN, %320);                             <<*8392>>15390000
          READINPUT;                                           <<*8392>>15392000
          TOS := DINVAL(@ERROR1);                              <<*8392>>15394000
          IF = THEN RETURN;                                    <<*8392>>15396000
          IF < THEN GOTO ERROR;                                <<*8392>>15398000
          IF (LLIM<=DS0) AND (DS0<=ULIM) THEN                  <<*8392>>15400000
          BEGIN                                                <<*8392>>15402000
              VAL := TOS;                                      <<*8392>>15404000
              RETURN;                                          <<*8392>>15406000
            END;                                               <<*8392>>15408000
          X:=GENMESSAGE(M2458,BINBUF,LLIM,ULIM,0D,0D,          <<*8392>>15410000
              BINBUF,BINBUF);                                  <<*8392>>15412000
          IF = THEN MESSAGE(M374,1);                           <<*8392>>15414000
          PRINT(INBUF,-X,%40);                                 <<*8392>>15416000
          DEL;                                                 <<*8392>>15418000
          GO AGAIN;                                            <<*8392>>15420000
  ERROR:  DEL;                                                 <<*8392>>15422000
  ERROR1: MESSAGE(M2453);                                      <<*8392>>15424000
          GO AGAIN;                                            <<*8392>>15426000
      END <<GETNEWVAL>> ;                                      <<*8392>>15428000
                                                               <<t8392>>15430000
          <<*************************>>                        <<t8392>>15432000
          << VERIFY DEVICE VALUES    >>                        <<t8392>>15434000
          <<*************************>>                        <<t8392>>15436000
                                                               <<t8392>>15438000
                                                               <<t8392>>15440000
PROCEDURE VERIFY'VALUES(MESSN,VAL,LLIM,ULIM,TERM);             <<t8392>>15442000
   VALUE MESSN,LLIM,ULIM,TERM;                                 <<t8392>>15444000
   INTEGER MESSN,VAL,LLIM,ULIM,TERM;                           <<t8392>>15446000
   BEGIN                                                       <<t8392>>15448000
                                                               <<m8955>>15450000
   EQUATE NO'MIN'MAX = 1;  << SUPPRESS MIN/MAX PRINTING >>     <<m8955>>15452000
                                                               <<m8955>>15454000
   IF DEV'DEFAULTS THEN                                        <<m8955>>15456000
      GETNEWVAL(MESSN,VAL,LLIM,ULIM,,NO'MIN'MAX)               <<m8955>>15458000
   ELSE                                                        <<m8955>>15460000
      VAL := GETVAL(MESSN,LLIM,ULIM,TERM);                     <<m8955>>15462000
   END; << VERIFY'VALUES >>                                    <<m8955>>15464000
                                                               <<m8955>>15466000
          <<------------                                                15468000
            GET STRING                                                  15470000
          ------------>>                                                15472000
  INTEGER PROCEDURE GETSTR(ADDR,ERRLABEL,TERM,LEN,SPEC);       <<06067>>15474000
    VALUE ERRLABEL,TERM,LEN,SPEC;                                       15476000
    BYTE ARRAY ADDR;    <<DESTINATION ARRAY>>                           15478000
    INTEGER ERRLABEL,   <<ERROR RETURN>>                                15480000
            LEN,        <<MAX LENGTH OF STRING>>                        15482000
            SPEC,        <<SPECIAL CHARACTER>>                          15484000
            TERM;       <<TERMINATING CONTROL                           15486000
                           0 - COMMA ONLY                               15488000
                           1 - CR ONLY                                  15490000
                          -1 - CR OR COMMA(NO INPUT NOT OK)             15492000
                           2 - CR OR COMMA(NO INPUT OK)                 15494000
                           3 - CR ONLY(NO INPUT OK) >>                  15496000
    OPTION VARIABLE;                                                    15498000
    COMMENT                                                             15500000
      EXTRACTS AN UP-TO-8 CHARACTER STRING FROM THE INPUT BUFFER        15502000
    POINTED TO BY BPINBUF AND MOVES IT TO BYTE ARRAY ADDR. IF AN        15504000
    ERROR IS ENCOUNTERED EXITS TO ERRLABEL. IF TERM = 0 SETS            15506000
    CONDITION CODE AS FOLLOWS:                                          15508000
         CCG - FOLLOWED BY CARRIAGE RETURN                              15510000
         CCL - FOLLOWED BY COMMA;                                       15512000
      BEGIN                                                             15514000
        EQUATE BLANK=%6440;                                             15516000
        INTEGER CONCODE;                                                15518000
        LOGICAL SPECPASSED=Q-4;                                         15520000
          TOS := @ADDR;       <<DESTINATION FOR FINAL MOVE>>            15522000
          SCAN BPINBUF WHILE BLANK,1;  <<DELETE LEADING BLANKS>>        15524000
          IF CARRY AND (TERM=3 OR TERM=2)  THEN                         15526000
            BEGIN                                                       15528000
            GETSTR := 0;                                       <<06067>>15530000
            STAT.(6:2) := CCE;                                          15532000
            RETURN;                                                     15534000
            END;                                                        15536000
          IF TERM=2 THEN TERM:=-1 ELSE                                  15538000
          IF TERM=3 THEN TERM:=1;                                       15540000
          IF BPS0<>ALPHA THEN GOTO ERROR;                               15542000
          ASSEMBLE(DUP,DDUP);                                           15544000
  MOVEUP: MOVE *:=* WHILE ANS,0; <<UPSHIFT LOWER CASE>>                 15546000
          IF SPECPASSED AND INTEGER(BPS0)=SPEC THEN                     15548000
            BEGIN                                                       15550000
            ASSEMBLE(INCA,INCB);                                        15552000
            GOTO MOVEUP;                                                15554000
            END;                                                        15556000
          SCAN * WHILE BLANK,1;     <<DELETE TRAILING BLANKS>>          15558000
          IF CARRY THEN CONCODE := CCG                                  15560000
          ELSE IF BPS0="," THEN CONCODE := CCL                          15562000
          ELSE GOTO ERROR;                                              15564000
          IF CONCODE=TERM THEN GOTO ERROR;                              15566000
          STAT.(6:2) := CONCODE;  <<SET CONDITION CODE>>                15568000
          @BPINBUF := TOS+1;  <<UPDATE BUFFER POINTER>>                 15570000
          ASSEMBLE(XCH,SUB; DUP,STAX);  <<COMPUTE LENGTH>>              15572000
          ASSEMBLE (DUP,DUP);                                  <<06067>>15574000
          GETSTR := TOS;  <<LENGTH>>                           <<06067>>15576000
          IF = OR TOS > LEN THEN                               <<06067>>15578000
            BEGIN    <<LENGTH OUT OF RANGE>>                            15580000
  ERROR:      MESSAGE(M2453);                                  <<01103>>15582000
              RETURNP := ERRLABEL;                                      15584000
              ASSEMBLE(EXIT 6);   <<GET RID OF RETURN VALUE>>  <<06067>>15586000
            END;                                                        15588000
          ASSEMBLE(MVB 3);   <<XFER STRING>>                   <<01025>>15590000
          WHILE X < LEN DO                                              15592000
            BEGIN    <<FILL WITH BLANKS>>                               15594000
              ADDR(X) := " ";                                           15596000
              X := X+1;                                                 15598000
            END;                                                        15600000
      END <<GETSTR>> ;                                                  15602000
$PAGE "INPUT/OUTPUT PROCEDURES"                                         15604000
$CONTROL SEGMENT=BOOTSTRAP                                              15606000
          <<---------                                                   15608000
            TEST IO                                                     15610000
          --------->>                                                   15612000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>15614000
  LOGICAL PROCEDURE TESTIO(DRT,MASK);                                   15616000
    VALUE DRT,MASK;                                                     15618000
    INTEGER DRT;    <<DRT NUMBER>>                                      15620000
    LOGICAL MASK;   <<STATUS MASK>>                                     15622000
    COMMENT                                                             15624000
      EXECUTES A TIO INSTRUCTION ON THE INDICATED CONTROLLER AND RETURNS15626000
    THE STATUS ANDED WITH THE MASK;                                     15628000
      BEGIN                                                             15630000
          TOS := DRT;                                                   15632000
          TIO0;                                                <<01103>>15634000
          TESTIO := LOGICAL(TOS) LAND MASK;                             15636000
      END <<TESTIO>> ;                                                  15638000
                                                                        15640000
          <<------------                                                15642000
            CONTROL IO                                                  15644000
          ------------>>                                                15646000
  PROCEDURE CTRLIO(DRT,CONTROL);                                        15648000
    VALUE DRT,CONTROL;                                                  15650000
    INTEGER DRT,         <<DRT NUMBER>>                                 15652000
            CONTROL;     <<CONTROL WORD TO OUTPUT>>                     15654000
    COMMENT                                                             15656000
      DOES A CIO INSTRUCTION TO THE SPECIFIED DEVICE, PASSING THE       15658000
    GIVEN CONTROL WORD;                                                 15660000
      BEGIN                                                             15662000
          TOS := DRT;                                                   15664000
          TOS := CONTROL;                                               15666000
          CIO1;                                                <<01103>>15668000
      END <<CTRLIO>> ;                                                  15670000
                                                                        15672000
          <<---------------------                                       15674000
            EXECUTE SIO PROGRAM                                         15676000
          --------------------->>                                       15678000
  LOGICAL PROCEDURE EXECUTESIO(DRT,ADDRESS);                            15680000
    VALUE DRT,ADDRESS;                                                  15682000
    INTEGER DRT;         <<DRT NUMBER>>                                 15684000
    LOGICAL ADDRESS;     <<ADDRESS OF SIO PROGRAM>>                     15686000
    COMMENT                                                             15688000
      EXECUTES AN SIO INSTRUCTION ON THE SPECIFIED CONTROLLER, WAITS    15690000
    FOR ITS COMPLETION, AND RETURNS THE STATUS;                         15692000
      BEGIN                                                             15694000
        LOGICAL STATUS=EXECUTESIO;                                      15696000
          TOS := DRT;                                                   15698000
          TOS := ADDRESS;                                               15700000
          DO BEGIN                                             <<01103>>15702000
             ASSEMBLE( SIO 1 );                                <<01103>>15704000
             IF < THEN ERRMESSAGE(M1,S1);<< NON-RESP. CTRL >>  <<01103>>15706000
             DEL;   << DRT IF CCE, STATUS IF CCG >>            <<01103>>15708000
             END UNTIL =;                                      <<01103>>15710000
          WHILE STATUS=0 DO                                             15712000
          IF TESTIO(DRT,%120000)<>0 THEN STATUS:=TESTIO(DRT,%177777);   15714000
      END <<EXECUTESIO>> ;                                              15716000
$IF  << ******* RETURNING TO COMMON CODE ********** >>         <<02510>>15718000
$CONTROL SEGMENT=BOOTSTRAP                                     <<02510>>15720000
PROCEDURE SIOP( DEVNR, CHANADR);                               <<02510>>15722000
   VALUE DEVNR, CHANADR;                                       <<02510>>15724000
   INTEGER DEVNR, CHANADR;                                     <<02510>>15726000
BEGIN                                                          <<02510>>15728000
   CC := CCE;                                                  <<02510>>15730000
   IF SERIESII'III THEN                                        <<02510>>15732000
      BEGIN                                                    <<02510>>15734000
      <<  FILL MAILBOX  >>                                     <<02510>>15736000
      MB0 := 0;          << SIOP CODE >>                       <<02510>>15738000
      MB1 := DEVNR;      << CHAN, DEV >>                       <<02510>>15740000
      MB3 := CHANADR;    << ADDRESSS OF CHAN PGM >>            <<02510>>15742000
      <<  STARTUP IMB ADAPTER  >>                              <<02510>>15744000
      TOS := ADAPTERDRT; << IMB ADAPTER DEV # >>               <<02510>>15746000
      TOS := -1;         << SIO POINTER >>                     <<02510>>15748000
      SIO1;                                                    <<02510>>15750000
      <<  WAIT FOR ADAPTER TO ACCEPT SIOP  >>                  <<02510>>15752000
      DO UNTIL MB4 < 0;                                        <<02510>>15754000
      IF MB4 THEN                                              <<02510>>15756000
         BEGIN                                                 <<02510>>15758000
         CC := IF MB4.(5:1) THEN CCL ELSE CCG;                 <<02510>>15760000
         END                                                   <<02510>>15762000
      END                                                      <<02510>>15764000
   ELSE                                                        <<02510>>15766000
      BEGIN                                                    <<02510>>15768000
      TOS := DEVNR;       << CHAN, DEV >>                      <<02510>>15770000
      TOS := CHANADR;     << ADDRESS OF CHAN PGM >>            <<02510>>15772000
      ASSEMBLE( SIOP );                                        <<02510>>15774000
      PUSH( STATUS );                                          <<02510>>15776000
      TOS := TOS.(6:2);  << CONDITION CODE >>                  <<02510>>15778000
      CC := TOS;                                               <<02510>>15780000
      END;                                                     <<02706>>15782000
END;                                                           <<02706>>15784000
PROCEDURE WIOC( DRT, COMMAND, DATAWORD);                       <<02706>>15786000
   VALUE DRT, COMMAND, DATAWORD;                               <<02706>>15788000
   INTEGER DRT, COMMAND, DATAWORD;                             <<02706>>15790000
BEGIN                                                          <<02706>>15792000
   CC := CCE;                                                  <<02706>>15794000
   IF SERIESII'III THEN                                        <<02706>>15796000
      BEGIN                                                    <<02706>>15798000
      <<  FILL MAILBOX  >>                                     <<02706>>15800000
      MB0 := 3;                     << WIOC CODE >>            <<02706>>15802000
      MB1 := DRT CAT COMMAND(0:0:8);<< IMB WRITE COMMAND >>    <<02706>>15804000
      MB2 := DATAWORD;              << DATA TO BE WRITTEN >>   <<02706>>15806000
      MB4 := 0;                     << CLEAR STATUS WORD >>    <<02706>>15808000
      <<  STARTUP IMB ADAPTER  >>                              <<02706>>15810000
      TOS := ADAPTERDRT;            << IMB ADAPTER DEV # >>    <<02706>>15812000
      TOS := -1;                    << SIO POINTER >>          <<02706>>15814000
      SIO1;                                                    <<02706>>15816000
      <<  WAIT FOR ADAPTER TO ACCEPT SIOP  >>                  <<02706>>15818000
      DO UNTIL MB4 < 0;                                        <<02706>>15820000
      IF MB4 THEN CC := CCL;                                   <<02706>>15822000
      END                                                      <<02706>>15824000
   ELSE                                                        <<02706>>15826000
      BEGIN                                                    <<02706>>15828000
      IF MULTI'IMB'SYS THEN                                    <<C8392>>15830000
         BEGIN                                                 <<02706>>15832000
         TOS := DRT;                                           <<02706>>15834000
         TOS := COMMAND;            << IMB WRITE COMMAND >>    <<02706>>15836000
         TOS := DATAWORD;           << DATA TO BE WRITTEN >>   <<02706>>15838000
         ASSEMBLE( WIOA );                                     <<02706>>15840000
         IF <> THEN CC := CCL;                                 <<02706>>15842000
         END                                                   <<02706>>15844000
      ELSE                                                     <<02706>>15846000
         BEGIN                                                 <<02706>>15848000
         TOS := DRT CAT COMMAND(0:0:8);<< IMB WRITE COMMAND >> <<02706>>15850000
         TOS := DATAWORD;           << DATA TO BE WRITTEN >>   <<02706>>15852000
         ASSEMBLE( WIOC );                                     <<02706>>15854000
         IF <> THEN CC := CCL;                                 <<02706>>15856000
         END;                                                  <<02706>>15858000
      END;                                                     <<02706>>15860000
END;                                                           <<02706>>15862000
           <<-------------------------->>                      <<02707>>15864000
           <<     READ FROM DEVICE     >>                      <<02707>>15866000
           <<-------------------------->>                      <<02707>>15868000
INTEGER PROCEDURE RIOC(DRT, PARM);                             <<02707>>15870000
VALUE DRT, PARM;                                               <<02707>>15872000
INTEGER DRT,    << DRT # OF DEVICE >>                          <<02707>>15874000
        PARM;   << READ PARAMETER >>                           <<02707>>15876000
COMMENT                                                        <<02707>>15878000
   THIS PROCEDURE READS FROM AN HPIB DEVICE BY ISSUING         <<02707>>15880000
   AN RIOC OR RIOA (ON MULTI IMB SYS) INSTRUCTION.  IT ALSO    <<C8392>>15882000
   HANDLES DEVICES CONNECTED TO STARFISH.  IT RETURNS          <<02707>>15884000
   A ONE-WORD RESULT.  ALSO, IT RETURNS CCL IF THE             <<02707>>15886000
   INSTRUCTION FAILS, CCE OTHERWISE.  NOTE: FOR SERIES         <<02707>>15888000
   II, III THIS PROCEDURE ASSUMES THERE IS A STARFISH          <<02707>>15890000
   AND THE DEVICE BEING ADDRESSED IS ON THE STARFISH.          <<02707>>15892000
   ;                                                           <<02707>>15894000
   BEGIN                                                       <<02707>>15896000
   CC := CCE;    << INITIALIZE CC RETURN IN STACK MARKER >>    <<02707>>15898000
   IF SERIESII'III THEN                                        <<02707>>15900000
      BEGIN               << SEND COMMAND TO STARFISH >>       <<02707>>15902000
      << FILL MAILBOX >>                                       <<02707>>15904000
      MB0 := 2;     << RIOC CODE >>                            <<02707>>15906000
      MB1 := DRT CAT PARM(0:0:8);   << CHANNEL, READ PARM >>   <<02707>>15908000
      MB4 := 0;                                                <<02707>>15910000
                                                               <<02707>>15912000
      << START UP IMB ADAPTER >>                               <<02707>>15914000
      TOS := ADAPTERDRT;                                       <<02707>>15916000
      TOS := -1;                                               <<02707>>15918000
      SIO1;                                                    <<02707>>15920000
                                                               <<02707>>15922000
      << WAIT FOR ADAPTER TO ACCEPT RIOC >>                    <<02707>>15924000
      DO UNTIL MB4 < 0;                                        <<02707>>15926000
                                                               <<02707>>15928000
      IF MB4 THEN CC := CCL     << COMMAND FAILED >>           <<02707>>15930000
      ELSE RIOC := MB2;         << SUCCESSFUL     >>           <<02707>>15932000
      END                                                      <<02707>>15934000
   ELSE          << ON A POST-SERIES III MACHINE >>            <<02707>>15936000
      BEGIN                                                    <<02707>>15938000
      IF MULTI'IMB'SYS THEN                                    <<C8392>>15940000
         BEGIN            << INSTRUCTION FOR MULTI IMB SYS>>   <<C8392>>15942000
         TOS := DRT;                                           <<02707>>15944000
         TOS := PARM;                                          <<02707>>15946000
         ASSEMBLE(RIOA);  << SEND READ COMMAND >>              <<02707>>15948000
         IF <> THEN CC := CCL   << COMMAND FAILED >>           <<02707>>15950000
         ELSE RIOC := TOS;      << SUCCESSFUL     >>           <<02707>>15952000
         END                                                   <<02707>>15954000
      ELSE                                                     <<02707>>15956000
         BEGIN         << NOT ON A '55 >>                      <<02707>>15958000
         TOS := DRT CAT PARM(0:0:8);                           <<02707>>15960000
         ASSEMBLE(RIOC);  << SEND READ COMMAND >>              <<02707>>15962000
         IF <> THEN CC := CCL    << COMMAND FAILED >>          <<02707>>15964000
         ELSE RIOC := TOS;       << SUCCESSFUL     >>          <<02707>>15966000
         END;                                                  <<02707>>15968000
      END;                                                     <<02707>>15970000
   END;   << RIOC >>                                           <<02707>>15972000
PROCEDURE INIT( CHANNR);                                       <<02510>>15974000
   VALUE CHANNR;                                               <<02510>>15976000
   INTEGER CHANNR;                                             <<02510>>15978000
BEGIN                                                          <<02510>>15980000
   CC := CCE;                                                  <<02510>>15982000
   IF SERIESII'III THEN                                        <<02510>>15984000
      BEGIN                                                    <<02510>>15986000
      <<  FILL MAILBOX  >>                                     <<02510>>15988000
      MB0 := 6;                                                <<02510>>15990000
      MB1 := CHANNR;           << CHANNEL NR. >>               <<02510>>15992000
      MB4 := 0;                << I/O STATUS  >>               <<02510>>15994000
      TOS := ADAPTERDRT;       << IMB ADAPTER NR. >>           <<02510>>15996000
      TOS := -1;               << SIO POINTER >>               <<02510>>15998000
      SIO1;                                                    <<02510>>16000000
      <<  WAIT FOR ADAPTER TO RESPOND >>                       <<02510>>16002000
      DO UNTIL MB4 < 0;                                        <<02510>>16004000
      IF MB4 THEN CC := CCL;                                   <<02510>>16006000
      END                                                      <<02510>>16008000
   ELSE                                                        <<02510>>16010000
      BEGIN                                                    <<02510>>16012000
      TOS := %151515;                                          <<02510>>16014000
      TOS := CHANNR;                                           <<02510>>16016000
      ASSEMBLE( INIT);                                         <<02510>>16018000
      IF TOS <> %151515 THEN  << MISSING GIC >>                <<02510>>16020000
         CC := CCL;                                            <<02510>>16022000
      END;                                                     <<02510>>16024000
END;                                                           <<02510>>16026000
<<----------------------->>                                    <<02510>>16028000
<<EXECUTE CHANNEL PROGRAM>>                                    <<02510>>16030000
<<----------------------->>                                    <<02510>>16032000
PROCEDURE EXECUTESIOP(DRT,ADDRESS);                            <<02510>>16034000
VALUE DRT,ADDRESS;                                             <<02510>>16036000
INTEGER DRT;                                                   <<02510>>16038000
LOGICAL ADDRESS;                                               <<02510>>16040000
COMMENT:                                                       <<02510>>16042000
   EXECUTES A CHANNEL PROGRAM ON THE SPECIFIED CONTROLLER      <<02510>>16044000
   AND WAITS AWHILE FOR IT TO COMPLETE.;                       <<02510>>16046000
BEGIN                                                          <<02510>>16048000
DOUBLE COUNTER := -5000D;                                      <<02510>>16050000
INIT( DRT);                                                    <<02510>>16052000
IF <> THEN RETURN;                                             <<02510>>16054000
SIOP( DRT, ADDRESS);                                           <<02510>>16056000
IF <> THEN RETURN;                                             <<02510>>16058000
                                                               <<02510>>16060000
TEST:                                                          <<02510>>16062000
                                                               <<02510>>16064000
IF GETDRT(DRT,CHANSTAT).(0:2) = 0 THEN                         <<03002>>16066000
           <<TEST CHANNEL STATUS FOR COMPLETION>>              <<03002>>16068000
   RETURN; <<PROGRAM COMPLETED>>                               <<02510>>16070000
IF (COUNTER:=COUNTER+1D)=0D THEN                               <<02510>>16072000
   BEGIN <<TIMEOUT-PROBABLY WRONG DRT-HALT AND RETURN>>        <<02510>>16074000
   PUTDRT(DRT,CHANSTAT,0);                                     <<03002>>16076000
   END                                                         <<02510>>16078000
ELSE                                                           <<02510>>16080000
   GOTO TEST; <<CHANNEL PROGRAM DIDN'T COMPLETE YET>>          <<02510>>16082000
END;                                                           <<02510>>16084000
$CONTROL SEGMENT=MAINSEG4                                      <<02510>>16086000
PROCEDURE RESETSTARFISH;                                       <<02510>>16088000
BEGIN                                                          <<02510>>16090000
   IF STARFISH THEN                                            <<02510>>16092000
      BEGIN                                                    <<02510>>16094000
      MB0 := 5;   << RESET COMMAND >>                          <<02510>>16096000
      MB4 := 0;   << I/O STATUS    >>                          <<02510>>16098000
      TOS := ADAPTERDRT; << IMB ADAPTER NR. >>                 <<02510>>16100000
      TOS := -1;         << SIO POINTER     >>                 <<02510>>16102000
      SIO1;                                                    <<02510>>16104000
      <<  WAIT FOR ADAPTER TO RESPOND  >>                      <<02510>>16106000
      DO UNTIL MB4 < 0;                                        <<02510>>16108000
      END;                                                     <<02510>>16110000
END;                                                           <<02510>>16112000
$CONTROL SEGMENT=BOOTSTRAP                                     <<02510>>16114000
DOUBLE PROCEDURE L'PADR( LDEV,LOGADR);                         <<02510>>16116000
   VALUE LDEV, LOGADR;                                         <<02510>>16118000
   INTEGER LDEV;                                               <<02510>>16120000
   DOUBLE LOGADR;                                              <<02510>>16122000
BEGIN                                                          <<02510>>16124000
   INTEGER TYPE, STYPE,                                        <<*LPDT>>16126000
           LDT'INDEX,LPDT'INDEX;                               <<*LPDT>>16128000
   BYTE VOLNR = LOGADR;                                        <<02510>>16130000
   INTEGER POINTER DISCINFO;                                   <<02510>>16132000
   EQUATE                                                      <<02510>>16134000
      SEC'TRK'FLOP  = 30,                                      <<02510>>16136000
      SEC'CYL'FLOP  = 60;                                      <<02510>>16138000
                                                               <<02510>>16140000
   LDT'INDEX := LDEV * LDTSIZE;                                <<*LDT*>>16142000
   TYPE := LDT'DEVICE'TYPE;                                    <<*LDT*>>16144000
   LPDT'INDEX := LDEV * LPDTSIZE;                              <<*LPDT>>16146000
   STYPE := LPDT'SUBTYPE;                                      <<*LPDT>>16148000
                                                               <<03550>>16150000
IF TYPE = 0 << MH DISC >> OR TYPE = 2 << FLOPPY DISC >> THEN   <<*LDT*>>16152000
   BEGIN      << CONVERT LOGICAL TO PHYSICAL ADDRESS >>        <<03550>>16154000
   @DISCINFO := @MHINFO(STYPE*MHINFOSIZE);                     <<02510>>16156000
                                                               <<02510>>16158000
   VOLNR := 0;                                                 <<02510>>16160000
   TOS := LOGADR;                                              <<02510>>16162000
   TOS := IF TYPE = 2 << FLOPPY DISC >> THEN                   <<*LDT*>>16164000
      SEC'CYL'FLOP                                             <<02510>>16166000
   ELSE                                                        <<02510>>16168000
      DISCINFO(MHSECTRK)*DISCINFO(MHTRKCYL);                   <<02510>>16170000
   ASSEMBLE( LDIV );                                           <<02510>>16172000
   IF OVERFLOW THEN                                            <<02510>>16174000
      BEGIN                                                    <<02510>>16176000
      STAT.(6:2) := CCL;                                       <<02510>>16178000
      RETURN;                                                  <<02510>>16180000
      END                                                      <<02510>>16182000
   ELSE                                                        <<02510>>16184000
      STAT.(6:2) := CCE;                                       <<02510>>16186000
   TOS := IF TYPE = 2 << FLOPPY DISC >> THEN                   <<*LDT*>>16188000
      SEC'TRK'FLOP                                             <<02510>>16190000
   ELSE                                                        <<02510>>16192000
      DISCINFO(MHSECTRK);                                      <<02510>>16194000
   ASSEMBLE( DIV, XCH );                                       <<02510>>16196000
   IF TYPE <> 2 << FLOPPY DISC >> THEN                         <<*LDT*>>16198000
     TOS:=TOS+DISCINFO(MHSTHEAD);                              <<*LDT*>>16200000
   TOS := TOS&LSL(8);                                          <<02510>>16202000
   TOS := TOS+TOS;   << HEAD/SECTOR >>                         <<02510>>16204000
   L'PADR := TOS;                                              <<02510>>16206000
   END                                                         <<03550>>16208000
                                                               <<03550>>16210000
ELSE                                                           <<03550>>16212000
   BEGIN      << CS'80 AND ANY OTHER TYPES >>                  <<03550>>16214000
   VOLNR := 0;             << CLEAR THE VOLUME NUMBER >>       <<03550>>16216000
                           <<    FROM LOGADR          >>       <<03550>>16218000
   L'PADR := LOGADR;       << PASS BACK THE LOGICAL ADDRESS >> <<03550>>16220000
   END;                                                        <<03550>>16222000
END;                                                           <<02510>>16224000
$PAGE "DISC DRIVERS"                                                    16226000
PROCEDURE ZEROABS( ADDRESS, COUNT);                            <<02510>>16228000
   VALUE ADDRESS, COUNT;                                       <<02510>>16230000
   INTEGER ADDRESS, COUNT;                                     <<02510>>16232000
BEGIN                                                          <<02510>>16234000
   X := ADDRESS;                                               <<02510>>16236000
   TOS := COUNT;                                               <<02510>>16238000
   WHILE <> DO                                                 <<02510>>16240000
      BEGIN                                                    <<02510>>16242000
      ABSOLUTE(X) := 0;                                        <<02510>>16244000
      X := X+1;                                                <<02510>>16246000
      TOS := TOS-1;                                            <<02510>>16248000
      END;                                                     <<02510>>16250000
END;                                                           <<02510>>16252000
$CONTROL SEGMENT=RESIDENT                                               16254000
                                                                        16256000
          <<---------------------------                                 16258000
            OUTPUT DISC ERROR MESSAGE                                   16260000
          --------------------------->>                                 16262000
  PROCEDURE DISCERROR(LDEV,ERRSTAT,ADDR,WORDS,MODE,ERRSTAT2);           16264000
    VALUE LDEV,ERRSTAT,ADDR,WORDS,MODE,ERRSTAT2;                        16266000
    INTEGER LDEV,ERRSTAT,WORDS,MODE,ERRSTAT2;                           16268000
    DOUBLE ADDR;                                                        16270000
    COMMENT                                                             16272000
      OUTPUT A MESSAGE INFORMING THE OPERATOR OF A DISC ERROR AND       16274000
    HALTS.  MODE TELLS IF WE WERE READING, WRITING, OR SEEKING WHEN     16276000
    THE ERROR OCCURRED;                                                 16278000
      BEGIN                                                             16280000
        BYTE ARRAY ERRTYPES(0:14)=PB:="READ WRITESEEK ";                16282000
        ARRAY STATUS'TO'MESS(0:%37) =PB :=                     <<01103>>16284000
            <<    0 >>       M0,    << NORMAL          >>      <<01103>>16286000
            <<    1 >>      M12,    << ILL. CMD        >>      <<01103>>16288000
            <<  2-6 >>    5(M0),                               <<01103>>16290000
            <<    7 >>      M13,    << CYL CMP ERR     >>      <<01103>>16292000
            <<  %10 >>      M14,    << UNCORRECTABLE   >>      <<01103>>16294000
            <<  %11 >>      M15,    << HD/SECT CMP     >>      <<01103>>16296000
            <<  %12 >>      M16,    << SIO PGM ERR     >>      <<01103>>16298000
            <<  %13 >>       M0,                               <<01103>>16300000
            <<  %14 >>      M17,    << EOC             >>      <<01103>>16302000
            <<  %15 >>       M0,                               <<01103>>16304000
            <<  %16 >>      M18,    << OVERRUN         >>      <<01103>>16306000
            <<  %17 >>      M19,    << POSS. CORRECT   >>      <<01103>>16308000
            <<  %20 >>      M20,    << ILL. ACCESS     >>      <<01103>>16310000
            <<  %21 >>      M21,    << DEF. TRACK      >>      <<01103>>16312000
            <<  %22 >>      M22,    << HEAD MOVING     >>      <<01103>>16314000
            <<  %23 >>      M23,    << DISC DVR ERR    >>      <<01103>>16316000
            <<%24-25>>    2(M0),                               <<01103>>16318000
            <<  %26 >>      M24,    << PROTECT DEF.TRK >>      <<01103>>16320000
            <<  %27 >>      M25,    << DVR UNAVAIL     >>      <<01103>>16322000
            <<%30-36>>    7(M0),                               <<01103>>16324000
            <<  %37 >>      M26;    << DVR ATTENTION   >>      <<01103>>16326000
          TOS := ABSOLUTE(DBBANK);                                      16328000
          TOS := ABSOLUTE(DB);                                          16330000
          ASSEMBLE(XCHD);  <<SET DB TO STACK>>                          16332000
          MOVE BLINE := "DISC ",2;                             <<00888>>16334000
          MOVE * := ERRTYPES(MODE*5),(5),2;                             16336000
          MOVE * := " ERR ON LDEV #",2;                        <<01101>>16338000
          TOS := TOS+ASCII(LDEV,10,BPS0);                      <<*8392>>16340000
          MOVE * := " STATUS=%",2;                             <<01101>>16342000
          TOS := TOS+LNTOA(ERRSTAT,8,BPS0);                    <<01101>>16344000
          IF ERRSTAT2<>0 THEN                                  <<01101>>16346000
             BEGIN                                             <<01101>>16348000
             MOVE * := ",%",2;                                 <<01101>>16350000
             TOS := TOS+LNTOA(ERRSTAT2,8,BPS0);                <<01101>>16352000
             END;                                              <<01101>>16354000
          MOVE * := " ADDR=%",2;                               <<01101>>16356000
          TOS := TOS+LDNTOA(ADDR,8,BPS0);                      <<01101>>16358000
          IF WORDS <> 0 THEN                                   <<01101>>16360000
             BEGIN                                             <<01101>>16362000
             MOVE * := " WORDS=",2;                            <<01101>>16364000
             ASCII(WORDS,10,BPS0);                             <<*8392>>16366000
             END;                                              <<01101>>16368000
          PRINTLINE;                                           <<00888>>16370000
          ERRMESSAGE(STATUS'TO'MESS(ERRSTAT.(3:5)));           <<01103>>16372000
      END <<DISCERROR>> ;                                               16374000
$PAGE                                                                   16376000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>16378000
$CONTROL SEGMENT=RESIDENT                                      <<02510>>16380000
          <<------------------------                                    16382000
            FIXED-HEAD DISC DRIVER                                      16384000
          ------------------------>>                                    16386000
  PROCEDURE FHDISC(LDEV,DRTUNIT,STYPE,WRITE,RECORD,BUF,WC);             16388000
    VALUE DRTUNIT,STYPE,WRITE,RECORD,BUF,WC,LDEV;                       16390000
    INTEGER DRTUNIT,     <<DRT AND UNIT NUMBER>>                        16392000
            LDEV,         <<LOGICAL DEVICE #>>                          16394000
            STYPE,       <<SUBTYPE - FOR DIFFERENT SIZED DISCS>>        16396000
            WC;          <<WORD COUNT>>                                 16398000
    LOGICAL WRITE;       <<0 FOR READ, 1 FOR WRITE>>                    16400000
    DOUBLE RECORD,       <<SECTOR ADDRESS>>                             16402000
           BUF;          <<CORE BUFFER ABSOLUTE ADDRESS>>               16404000
    COMMENT                                                             16406000
      PERFORMS A DISC TRANSFER ON THE FIXED-HEAD DISC;                  16408000
      BEGIN                                                             16410000
        LOGICAL ADDRESS=RECORD+1;   <<ALL ADDRESSES <17 BITS>>          16412000
        INTEGER FUNC = WRITE;                                  <<02510>>16414000
        EQUATE ARCPTRK     =    32,                                     16416000
               MAXTRK      =    511;                                    16418000
        INTEGER ERROR := 0;                                             16420000
        INTEGER DRT,J;                                                  16422000
        LOGICAL ARCWRD,TRKWRD,                                          16424000
                COM1:=%170000,                                          16426000
                COM2:=%070000;                                          16428000
        ARRAY S(*)=DB+0;        <<SIO PROGRAM BUFFER>>                  16430000
        INTEGER ARRAY TBUFDB(*)=DB+0;   <<TEMPORARY BUFFER>>            16432000
        DOUBLE OLDDB,TBUFA;                                             16434000
        INTEGER TRACK,BUF1=BUF,BUF2=BUF+1;                              16436000
        INTEGER ARRAY TBUF(0:127)=Q;                                    16438000
          << CHECK FOR VALID FUNCTION >>                       <<02510>>16440000
                                                               <<03715>>16442000
          CC := CCE;    << INIT. CONDITION CODE RETURN >>      <<03715>>16444000
                                                               <<03549>>16446000
          IF FUNC = RSTAT THEN    << READ STATUS >>            <<03549>>16448000
             BEGIN                                             <<03549>>16450000
             TOS := BUF;          << ALWAYS RETURN >>          <<03549>>16452000
             TOS := 0D;           <<    READY      >>          <<03549>>16454000
             ASSEMBLE(SDEA;DDEL);                              <<03549>>16456000
             RETURN;                                           <<03549>>16458000
             END;                                              <<03549>>16460000
                                                               <<03549>>16462000
          IF FUNC = INIT'DEV THEN   << INITIALIZE DISC--DO >>  <<03549>>16464000
             RETURN;                <<    NOTHING--RETURN  >>  <<03549>>16466000
                                                               <<03549>>16468000
          DRT := DRTUNIT.DRTFIELD;                             <<03002>>16470000
          TOS := DRT;                                          <<03002>>16472000
          TIO0;                                                <<01103>>16474000
          IF S0.(2:1)=1 THEN                                            16476000
            BEGIN   <<RESET PREVIOUS INTERRUPT>>                        16478000
              TOS := %100000;                                           16480000
              CIO2;                                            <<01103>>16482000
            END;                                                        16484000
          IF TOS.(3:1)=1 THEN                                           16486000
            BEGIN   <<DEVICE NOT READY>>                                16488000
              IF LDEV<>0 THEN MESSAGE(M2408,LDEV);             <<01103>>16490000
  WAITFOREADY:ASSEMBLE(TIO 0; BL *-1);                                  16492000
              IF TOS.(3:1)=1 THEN GO WAITFOREADY;                       16494000
            END;                                                        16496000
          IF WRITE THEN BEGIN COM1:=%160000; COM2:=%60000 END;          16498000
          TOS := 0;                                                     16500000
          TOS := ADDRESS;                                               16502000
          TOS := ARCPTRK;                                               16504000
          ASSEMBLE(LDIV);                                               16506000
          ARCWRD := TOS;                                                16508000
          IF S0>MAXTRK THEN ERRMESSAGE(M27);                   <<01103>>16510000
          TRKWRD := TOS;                                                16512000
          TOS := ABSOLUTE(DBBANK);                                      16514000
          TOS := ABSOLUTE(DB);                                          16516000
          ASSEMBLE(DDUP;XCHD);  <<SET DB TO STACK>>                     16518000
          OLDDB := TOS;  <<SAVE OLD VALUE OF DB>>                       16520000
          TOS := TOS+@TBUF;                                             16522000
          TBUFA := TOS;  <<ABSOLUTE ADDRESS OF TBUF ARRAY>>             16524000
          TOS := 0;                                                     16526000
          TOS := ABSOLUTE(SIOPROG);                                     16528000
          SET(DB);  <<SET DB TO SIO PROGRAM BUFFER>>                    16530000
  TRYAGAIN:                                                             16532000
          J := 0;                                                       16534000
          S := SIOCNTRL LOR ARCWRD;                                     16536000
          S(1) := TRKWRD;                                               16538000
          S(2) := SIOBANK;                                              16540000
          S(3) := BUF1;    <<SET BANK REGISTER>>                        16542000
          WHILE WC>4096 DO                                              16544000
            BEGIN                                                       16546000
              S(X:=X+1) := COM1;                                        16548000
              S(X:=X+1) := BUF2+J;                                      16550000
              J := J+4096;                                              16552000
              WC := WC-4096;                                            16554000
            END;                                                        16556000
          S(X:=X+1) := LOGICAL(-WC).(4:12) LOR COM2;                    16558000
          S(X:=X+1) := BUF2+J;                                          16560000
          S(X:=X+1) := SIOEND;                                          16562000
          S(X:=X+1) := 0;                                               16564000
          TOS := EXECUTESIO(DRT,ABSOLUTE(SIOPROG));                     16566000
          IF TOS.(3:7) <> 0 THEN                                        16568000
          IF (ERROR:=ERROR+1) < 10 THEN                                 16570000
            BEGIN                                                       16572000
              TOS := %100000;                                           16574000
              CIO1;                                            <<01103>>16576000
              GO TRYAGAIN;                                              16578000
            END                                                         16580000
          ELSE                                                          16582000
            BEGIN   <<OUTPUT ERROR MESSAGE>>                            16584000
              TOS := LDEV;                                              16586000
              IF = THEN ASSEMBLE(HALT 2);  <<IN BOOTSTRAP>>    <<2B.00>>16588000
              ASSEMBLE(TIO 1; BL *-1);    <<GET NORMAL STATUS WORD>>    16590000
              TOS := 0;  <<HIGH ORDER WORD OF ADDRESS>>                 16592000
              TOS := 2;  <<SELECT STATUS WORD 2>>                       16594000
              ASSEMBLE(CIO 4; BL*-1; TIO 3; BL*-1);                     16596000
              TOS := TOS.(4:12)&LSL(5);  <<BAD TRACK ADDR>>             16598000
              TOS := 1;  <<SELECT STATUS WORD 2>>                       16600000
              ASSEMBLE(CIO 5; BL*-1; TIO 4; BL*-1);                     16602000
              TOS := TOS.(10:6);  <<ARC ADDRESS>>                       16604000
              ASSEMBLE(ADD);                                            16606000
              TOS := S2;  << GET STATUS >>                              16608000
              IF TOS.(3:7)=%60 THEN  << TRACK SPECIFIC ERROR >>         16610000
                BEGIN                                                   16612000
                  TOS := RECORD&DASR(5);                                16614000
                  DELB;                                                 16616000
                  TRACK := TOS&LSL(2);                                  16618000
                  IF = THEN GOTO T1;                                    16620000
                  FHDISC(LDEV,DRTUNIT,STYPE,0,1D,TBUFA,128);            16622000
                  TOS := TBUFA;                                         16624000
                  ASSEMBLE(XCHD);  <<SET DB TO TBUF ARRAY>>             16626000
                  X := 0;                                               16628000
                  WHILE (X:=X+1)<=TBUFDB DO                             16630000
                    IF TBUFDB(X)=TRACK THEN GOTO T1; << ALREADY THERE >>16632000
                  TBUFDB := TBUFDB+1;                                   16634000
                  IF X>120 THEN GOTO T1; << TABLE FULL >>               16636000
                  TBUFDB(X) := TRACK;                                   16638000
                  FHDISC(LDEV,DRTUNIT,STYPE,1,1D,TBUFA,128);            16640000
                END;         << MARKING BAD TRACK IN MAP >>             16642000
T1:                                                                     16644000
              DISCERROR(*,*,*,0,WRITE,0);                               16646000
            END;                                                        16648000
          TOS := OLDDB;                                                 16650000
          ASSEMBLE(XCHD);  <<RESET DB TO FORMER VALUE>>                 16652000
      END <<FHDISC>> ;                                                  16654000
$CONTROL SEGMENT=BOOTSTRAP                                     <<02510>>16656000
          <<----------------------------------                          16658000
            7900/ISS MOVING HEAD DISC DRIVER                            16660000
          ---------------------------------->>                          16662000
  PROCEDURE MHDISC(LDEV,DRTUNIT,STYPE,WRITE,RECORD,BUF,WC);             16664000
    VALUE LDEV,DRTUNIT,STYPE,WRITE,RECORD,BUF,WC;                       16666000
    INTEGER DRTUNIT,     <<DRT AND UNIT NUMBER>>                        16668000
            LDEV,         <<LOGICAL DEVICE #>>                          16670000
            STYPE,       <<SUBTYPE - FOR DIFFERENT SIZED DISCS>>        16672000
            WC;          <<WORD COUNT>>                                 16674000
   LOGICAL WRITE ;                                                      16676000
       <<   0  -  READ                                                  16678000
            1  -  WRITE                                                 16680000
            2  -  READ AND RETURN CCL IF TRACK FLAGGED DEFECTIVE;       16682000
                    OR CCG IF TRACK SPECIFIC ERROR ELSE CCE             16684000
            3  -  FLAG A TRACK DEFECTIVE; ALT TRK NUMBER IN BUF(0)      16686000
                    REQUIRES A WORD COUNT OF 46 WORDS AND A BUFFER      16688000
                    OF 46 WORDS WHICH MAY BE MODIFIED                   16690000
            4  -  READ ADDRESS OR READ NEXT FULL SECTOR                 16692000
            BIT 1  INDICATES TRANSFER FROM ALTERNATE TRACK              16694000
       >>                                                               16696000
    DOUBLE RECORD,       <<SECTOR ADDRESS>>                             16698000
           BUF;          <<CORE BUFFER ABSOLUTE ADDRESS>>               16700000
    COMMENT                                                             16702000
      PERFORMS A DISC TRANSFER ON THE SPECIFIED MOVING-HEAD DISC;       16704000
      BEGIN                                                             16706000
        INTEGER FUNC = WRITE;                                  <<02510>>16708000
        EQUATE FTD      =%040000,                                       16710000
               SIOSENSE =%050000,                                       16712000
               RA       =%040000,                                       16714000
               RNFS     =%120000,                                       16716000
               ALTFLAG  =%40000,                                        16718000
               WA       =%130000;                                       16720000
        EQUATE DISCREAD    =   0,                                       16722000
               DISCWRITE   =   %100000,                                 16724000
               DISCSTATUS  =   %30000,                                  16726000
               DISCRECAL   =   %10000,                                  16728000
               DISCSEEK    =   %20000;                                  16730000
        EQUATE RESETINT    =   %40000,                                  16732000
               DISCINTRPT =   %20000;                                   16734000
        INTEGER ARRAY SCTPERCYL(0:3)=PB:=48,48,96,460;                  16736000
        INTEGER ARRAY SCTPERHD(0:3)=PB:=24,24,24,23;                    16738000
        INTEGER ARRAY HDBASE(0:3)=PB:=0,2,0,0;                          16740000
        INTEGER ARRAY MAXSCTPREAD(0:3)=PB:=48,48,48,460;                16742000
        INTEGER ARRAY SCTPERTRK(0:3)=PB:=48,48,48,23;                   16744000
        INTEGER NS,           <<# OF SECTORS>>                          16746000
                AS,           <<# OF AVAILABLE SECTORS>>                16748000
                WC1,          <<CURRENT WORD COUNT>>                    16750000
                DRT,          <<DRT NUMBER>>                            16752000
                UNIT,         <<UNIT NUMBER>>                           16754000
                SCTINCYL,     <<NUMBER OF SECTORS IN CYLINDER>>         16756000
                COUNTER,                                                16758000
                I:=0,         <<BUFFER INDEX>>                          16760000
                RWERROR:=0,   <<NUMBER OF READ/WRITE ERRORS>>           16762000
                TRACK,   << DEFECTIVE TRACK NUMBER >>                   16764000
                CONSTAT,            <<CONTROLLER STATUS>>               16766000
                BUF1=BUF, BUF2=BUF+1,                                   16768000
                STATUS = Q-1,                                           16770000
                SEEKERROR:=0; <<NUMBER OF SEEK ERRORS>>                 16772000
        LOGICAL SIOCOM:=SIOREAD,  <<SIO COMMAND>>                       16774000
                DISCCOM:=DISCREAD,<<DISC COMMAND>>                      16776000
                ERRSTAT,      <<ERROR STATUS>>                          16778000
                ERRORBITS,    <<SEEK ERROR BITS>>                       16780000
                COUNTING,      <<TIMING OUT SIO>>                       16782000
                HDSCTR,           <<HEAD AND SECTOR>>                   16784000
                UNITCYL;          <<UNIT AND CYLINDER>>                 16786000
        DOUBLE OLDDB,        <<ORIGINAL VALUE OF DB>>                   16788000
               TBUFA;        <<ABSOLUTE ADDRESS OF TBUF ARRAY>>         16790000
        LOGICAL ARRAY S(*)=DB+0,  <<SIO PROGRAM BUFFER>>                16792000
                      BUFDB(*)=DB+0;                                    16794000
        INTEGER ARRAY TBUFDB(*)=DB+0;                                   16796000
        INTEGER ARRAY TBUF (0:131) = Q;                                 16798000
        LOGICAL SUBROUTINE WAITFORINT;                                  16800000
        BEGIN                                                           16802000
          TOS := DRT;                                                   16804000
  WAIT:   TIO0;                                                <<01103>>16806000
          S3 := S0;  <<STATUS>>                                         16808000
          IF TOS.(2:1)<>1 THEN GOTO WAIT                                16810000
          ELSE                                                          16812000
            BEGIN  <<RESET INTERRUPT>>                                  16814000
              TOS := RESETINT;                                          16816000
              CIO1;                                            <<01103>>16818000
              IF S2.(13:3)<>UNIT THEN GOTO WAIT  <<WRONG UNIT>>         16820000
            END;                                                        16822000
          DEL;                                                          16824000
        END <<WAITFORINT>> ;                                            16826000
                                                                        16828000
        LOGICAL SUBROUTINE EXANWAIT(INDEX,SAMEUNIT);                    16830000
        VALUE INDEX,SAMEUNIT;                                           16832000
        INTEGER INDEX;                                                  16834000
        LOGICAL SAMEUNIT;  <<TRUE IF INTRPT ON THIS UNIT IS VALID>>     16836000
        BEGIN                                                           16838000
          COUNTING := TRUE;                                             16840000
          COUNTER := -32000;  <<1 SECOND>>                              16842000
          S(INDEX) := SIOEND;                                           16844000
          S(X:=X+1) := 0;                                               16846000
          TOS := DRT;                                                   16848000
          EXECUTESIO(DRT,ABSOLUTE(SIOPROG));                   <<01103>>16850000
  TEST:   TIO0;                                                <<01103>>16852000
          S5 := S0;   <<STATUS>>                                        16854000
          IF TOS.(2:1)=1 THEN                                           16856000
            BEGIN   <<INTERRUPT>>                                       16858000
              TOS := RESETINT;                                          16860000
              ASSEMBLE (CIO 1; BL *-1);                                 16862000
              IF S4.(13:3)=UNIT AND LOGICAL(S2) THEN                    16864000
                BEGIN                                                   16866000
                  DO TIO0 UNTIL TOS<0;                         <<01103>>16868000
  GETOUT:         DEL;                                                  16870000
                  RETURN;                                               16872000
                END                                                     16874000
              ELSE                                                      16876000
                BEGIN                                                   16878000
                  COUNTER := -32000;                                    16880000
                  GOTO TEST;                                            16882000
                END;                                                    16884000
            END;                                                        16886000
          IF S4<0 THEN GOTO GETOUT;   <<SIO OK>>                        16888000
          IF (COUNTER:=COUNTER+1)=0 AND COUNTING THEN                   16890000
            BEGIN  <<UNIT 0 NOT READY>>                                 16892000
              IF UNIT=0 AND LDEV<>0 THEN MESSAGE(M2408,LDEV)   <<01103>>16894000
              ELSE                                                      16896000
                BEGIN                                                   16898000
                  TOS := ABSOLUTE(DBBANK);                              16900000
                  TOS := ABSOLUTE(DB);                                  16902000
                  ASSEMBLE(XCHD);  <<SET DB TO STACK>>                  16904000
                  MOVE BINBUF := "DISC IN DRT ";                        16906000
                  COUNTER := ASCII(DRT,10,BINBUF(12));         <<*8392>>16908000
                  MOVE BINBUF(12+COUNTER) := " UNIT 0 NOT READY";       16910000
                  PRINT(INBUF,-29-COUNTER,0);                           16912000
                  SET(DB);   <<RESET DB>>                               16914000
                END;                                                    16916000
              COUNTING := FALSE;                                        16918000
            END;                                                        16920000
          GOTO TEST;  <<WAIT FOR SIO OK OR INTERRUPT>>                  16922000
        END <<EXANWAIT>> ;                                              16924000
          << CHECK FOR VALID FUNCTION >>                       <<02510>>16926000
                                                               <<03715>>16928000
          CC := CCE;    << INIT. CONDITION CODE RETURN >>      <<03715>>16930000
                                                               <<03549>>16932000
          IF FUNC = RSTAT THEN     << READ STATUS >>           <<03549>>16934000
             BEGIN                                             <<03549>>16936000
             TOS := BUF;           << ALWAYS RETURN >>         <<03549>>16938000
             TOS := 0D;            <<    READY      >>         <<03549>>16940000
             ASSEMBLE(SDEA;DDEL);                              <<03549>>16942000
             RETURN;                                           <<03549>>16944000
             END;                                              <<03549>>16946000
                                                               <<03549>>16948000
          IF FUNC = INIT'DEV THEN   << INITIALIZE DISC--DO >>  <<03549>>16950000
             RETURN;                <<    NOTHING--RETURN  >>  <<03549>>16952000
                                                               <<03549>>16954000
          TOS := ABSOLUTE(DBBANK);                                      16956000
          TOS := ABSOLUTE(DB);                                          16958000
          ASSEMBLE(DDUP,DDUP; XCHD);  <<SET DB TO STACK>>               16960000
          OLDDB := TOS;  <<SAVE OLD VALUE OF DB>>                       16962000
          TOS := TOS+@TBUF;                                             16964000
          TBUFA := TOS;   <<ABSOLUTE ADDRESS OF TBUF>>                  16966000
          TOS := 0;                                                     16968000
          TOS := ABSOLUTE(SIOPROG);                                     16970000
          SET(DB);  <<SET DB TO SIO PROGRAM BUFFER>>                    16972000
          DRT := DRTUNIT.DRTFIELD;                             <<03002>>16974000
          UNIT := DRTUNIT.UNITFIELD;                           <<03002>>16976000
          IF STYPE=3 THEN TOS := %7000  ELSE TOS := %47000;             16978000
          ERRORBITS := TOS;                                             16980000
          STATUS.(6:2) := CCE;  << SET CCE >>                           16982000
          S := SIOCNTRL+UNIT&LSL(9);                                    16984000
          S(1) := DISCSTATUS;  <<STATUS CHECK>>                         16986000
  SCAGAIN:TOS := EXANWAIT(2,FALSE);                                     16988000
          IF S0.(13:3)<>UNIT THEN                                       16990000
            BEGIN  <<WRONG UNIT BECAUSE UNIT 0 WASN'T READY>>           16992000
              DEL;                                                      16994000
              GOTO SCAGAIN;                                             16996000
            END;                                                        16998000
          IF TOS.(3:4)<>%10 THEN                                        17000000
            BEGIN  <<NOT READY>>                                        17002000
              MESSAGE(M2408,LDEV); << NOT READY >>             <<01103>>17004000
              WAITFORINT;                                               17006000
            END;                                                        17008000
          NS := LOGICAL(WC+127)&LSR(7);   <<NUMBER OF SECTORS>>         17010000
          IF WRITE THEN                                                 17012000
            BEGIN                                                       17014000
              DISCCOM := DISCWRITE;                                     17016000
              SIOCOM := SIOWRITE;                                       17018000
            END;                                                        17020000
  AGAIN:  TOS := RECORD;                                                17022000
          TOS := SCTPERCYL(STYPE);    <<# OF SECTORS PER CYLINDER>>     17024000
          ASSEMBLE(LDIV,ZERO; XCH,DUP);                                 17026000
          SCTINCYL := TOS;                                              17028000
          TOS := SCTPERHD(X);                                           17030000
          ASSEMBLE(LDIV,XCH);                                           17032000
          TOS := (TOS+HDBASE(X))&LSL(6);                                17034000
          ASSEMBLE(OR);                                                 17036000
          HDSCTR := TOS;  <<HEAD AND SECTOR>>                           17038000
          TOS := UNIT&LSL(9);                                           17040000
          ASSEMBLE(OR);                                                 17042000
          UNITCYL := TOS;  <<UNIT AND CYLINDER>>                        17044000
          TOS := MAXSCTPREAD(X)-SCTINCYL;                               17046000
          IF S0<1 THEN TOS := TOS+MAXSCTPREAD(X);                       17048000
          AS := TOS;   <<NUMBER OF AVAILABLE SECTORS>>                  17050000
          TOS := WC;                                                    17052000
          IF NS>AS THEN                                                 17054000
            BEGIN                                                       17056000
              DEL;                                                      17058000
              TOS := AS&LSL(7);   <<NUMBER OF WORDS WE CAN DO>>         17060000
            END;                                                        17062000
          IF S0>4096 THEN                                               17064000
            BEGIN                                                       17066000
              DEL;                                                      17068000
              TOS := 4096;   <<MAXIMUM TRANSFER>>                       17070000
            END;                                                        17072000
  SHORTRACK:                                                            17074000
          WC1 := TOS;  <<# OF WORDS TO TRANSFER>>                       17076000
  RETRY:  SEEKERROR := 0;                                               17078000
          S := UNITCYL LOR SIOCNTRL;                                    17080000
  RESEEK: S(1) := HDSCTR LOR DISCSEEK;   <<SEEK COMMAND>>               17082000
          TOS := EXANWAIT(2,TRUE);  <<EXECUTE SEEK>>                    17084000
          IF S0.(2:1)=1 THEN                                            17086000
          IF (TOS LAND ERRORBITS)<>0 THEN GOTO SEEKERR ELSE GOTO COM    17088000
          ELSE DEL;                                                     17090000
          IF ((ERRSTAT:=WAITFORINT) LAND ERRORBITS) <> 0 THEN           17092000
            BEGIN                                                       17094000
  SEEKERR:    S(1) := DISCRECAL;  <<RECALIBRATE>>                       17096000
              EXANWAIT(2,TRUE);                                         17098000
              WAITFORINT;                                               17100000
              IF (SEEKERROR:=SEEKERROR+1)>10 THEN                       17102000
                BEGIN   <<SEEK ERROR>>                                  17104000
                  TOS := LDEV;                                          17106000
                  IF = THEN ASSEMBLE(HALT 3);  <<IN BOOTSTRAP>><<2B.00>>17108000
                  DISCERROR(*,ERRSTAT,RECORD,0,2,0);                    17110000
                END;                                                    17112000
              GO RESEEK;  <<TRY AGAIN>>                                 17114000
            END;                                                        17116000
  COM:    S(1) := HDSCTR LOR DISCCOM;  <<READ/WRITE COMMAND>>           17118000
          S(2) := SIOBANK;                                              17120000
          S(3) := BUF1;  <<BANK ADDRESS>>                               17122000
          IF WRITE=3 THEN    << FLAG A TRACK DEFECTIVE  >>              17124000
            BEGIN                                                       17126000
              IF STYPE=3 THEN                                           17128000
                BEGIN      << SET UP FOR WRITE ADDRESS >>               17130000
                  TOS := BUF;                                           17132000
                  ASSEMBLE(XCHD);  <<SET DB TO BUF>>                    17134000
                  BUFDB := BUFDB+%100000;                               17136000
                  X := 0;                                               17138000
                  WHILE (X:=X+1)<46 DO BUFDB(X) := BUFDB;               17140000
                  SET(DB);  <<RESET DB>>                                17142000
                  S(1) := WA LOR HDSCTR;                                17144000
                END                                                     17146000
              ELSE                                                      17148000
                BEGIN      << FORM FLAG TRACK SIO PROGRAM >>            17150000
                  TOS := BUF;                                           17152000
                  ASSEMBLE(LSEA; DELB,DELB);   <<GET FIRST WORD>>       17154000
                  S := TOS LOR SIOCNTRL+(UNITCYL LAND %3000);           17156000
                  S(1) := FTD LOR HDSCTR;                               17158000
                  S(4) := SIOSENSE;                                     17160000
                  I := 1;                                               17162000
                  GOTO T4;                                              17164000
                END;                                                    17166000
            TEMP := %41;<< FORCE CHECKSUM >>                 <<CHECK>>  17168000
                                                                        17170000
          IF WRITE=4 THEN  << READ ADDRESS OR NEXT FULL SECTOR >>       17172000
            S(1) := (IF STYPE=3 THEN RA ELSE RNFS) LOR HDSCTR;          17174000
                                                                        17176000
          S(4) := SIOCOM+(LOGICAL(-WC1) LAND %7777);                    17178000
T4:                                                                     17180000
          S(5) := BUF2+I;  <<ABSOLUTE ADDRESS>>                         17182000
          IF ((ERRSTAT:=EXANWAIT(6,TRUE)).(2:1))<>0 THEN                17184000
            BEGIN                                                       17186000
              CONSTAT := ERRSTAT.(8:5);  <<CONTROLLER STATUS>>          17188000
              IF CONSTAT=6 THEN  <<TRACK FLAGGED DEFECTIVE>>            17190000
                BEGIN                                                   17192000
                  IF WRITE=2 THEN   << RETURN CONDITION CODE CCL >>     17194000
                    BEGIN                                               17196000
            TEMP := %20041;<<SYS SEG, CHECKSUM>>             <<CHECK>>  17198000
                      GOTO EXIT;                                        17200000
            TEMP := %60041;<<CORE RES, CHECKSUM>>            <<CHECK>>  17202000
                  TOS := SCTPERTRK(STYPE);                              17204000
            TEMP := %100041;<<ALLOC, CHECKSUM>>              <<CHECK>>/ 17206000
                  TOS := SCTPERTRK(X);                                  17208000
                  ASSEMBLE(LDIV,DELB; SUB);                             17210000
                  TOS := TOS&LSL(7);                                    17212000
                  IF WC1 > S0 THEN GOTO SHORTRACK                       17214000
                  ELSE DEL;                                             17216000
T1:                                                                     17218000
                  TOS := LDEV;                                          17220000
                  TOS := DRTUNIT;                                       17222000
                  TOS := STYPE;                                         17224000
                  TOS := 4;  <<READ ALTERNATE TRACK>>                   17226000
                  TOS := RECORD;                                        17228000
                  TOS := TOS LOR 1;  <<FOR MV CONTROLLER ERROR>>        17230000
                  MHDISC(*,*,*,*,*,TBUFA,IF STYPE=3 THEN 4 ELSE 132);   17232000
                  X := IF STYPE=3 THEN 2 ELSE 131;                      17234000
                  TOS := TBUFA;                                         17236000
                  ASSEMBLE(XCHD);  <<SET DB TO TBUF>>                   17238000
                  IF TBUFDB<>TBUFDB(X) THEN  << NO TRK # AGREEMENT >>   17240000
                    BEGIN                                               17242000
                      SET(DB);  <<RESET DB BACK WHERE IT WAS>>          17244000
                      IF (RWERROR:=RWERROR+1)>10 THEN  <<IRRECOVERABLE>>17246000
                        BEGIN                                           17248000
                          TOS := LDEV;                                  17250000
                          GOTO T5;                                      17252000
                        END                                             17254000
                      ELSE GOTO T1;                                     17256000
                    END;                                                17258000
                  TOS := LDEV;                                          17260000
                  TOS := DRTUNIT;                                       17262000
                  TOS := STYPE;                                         17264000
                  TOS := WRITE LOR ALTFLAG;                             17266000
                  TOS := TBUFDB.(2:14); <<ALTERNATE TRACK ADDRESS>>     17268000
                  IF STYPE=2 THEN ASSEMBLE(TSBC 7);                     17270000
                  TOS := SCTPERTRK(STYPE);                              17272000
                  ASMB(LMPY,ZERO);                                      17274000
                  TOS := RECORD;  TOS := SCTPERTRK(X);                  17276000
                  ASMB(LDIV,DELB);  << SECTOR NUMBER IN TRACK >>        17278000
                  ASMB(DADD); <<SECTOR ADDRESS OF ALTERNATE AREA>>      17280000
                  TOS := BUF;                                           17282000
                  TOS := TOS+I;  <<ABSOLUTE CORE ADDRESS>>              17284000
                  MHDISC(*,*,*,*,*,*,WC1); <<TRANSFER FROM ALT TRACK>>  17286000
                  SET(DB);  <<RESET DB TO OLD VALUE>>                   17288000
                  GOTO T2;  << CONTINUE ON >>                           17290000
                END;                                                    17292000
              IF (RWERROR:=RWERROR+1)>10 THEN                           17294000
                BEGIN                                                   17296000
                  TOS := LDEV;                                          17298000
                  IF = THEN ASSEMBLE(HALT 4);  <<IN BOOTSTRAP>><<2B.00>>17300000
                  IF 5<=CONSTAT<=%11 OR CONSTAT=%13 OR CONSTAT=%22 THEN 17302000
                    BEGIN   << TRACK SPECIFIC ERROR >>                  17304000
T5:                                                                     17306000
                      IF WRITE=2 THEN << RETURN CCG >>                  17308000
                        BEGIN                                           17310000
                          STATUS.(6:2) := CCG;  << CCG >>               17312000
                          GOTO EXIT;                                    17314000
                        END;                                            17316000
                      TOS := RECORD; TOS := SCTPERTRK(STYPE);           17318000
                      ASMB(LDIV,DEL );   << TRACK NUMBER >>             17320000
                      TOS := WRITE; TOS := ALTFLAG;<< ALT TRK BIT MSK >>17322000
                      TRACK := (TOS LAND TOS LOR TOS)&CSL(2);           17324000
                      IF = THEN GOTO T3;                                17326000
                      MHDISC(LDEV,DRTUNIT,STYPE,0,1D,TBUFA,128);        17328000
                      TOS := TBUFA;                                     17330000
                      SET(DB);   <<SET DB TO TBUF>>                     17332000
                      X := 0;                                           17334000
                      WHILE (X:=X+1)<=TBUFDB DO                         17336000
                        IF TBUFDB(X)=TRACK THEN                         17338000
                          GOTO T3;  << ALREADY IN TABLE >>              17340000
                      TBUFDB := TBUFDB+1;                               17342000
                      IF X>120 THEN GOTO T3;  << NO ROOM >>             17344000
                      TBUFDB(X) := TRACK;                               17346000
                      MHDISC(LDEV,DRTUNIT,STYPE,1,1D,TBUFA,128);        17348000
                    END;                                                17350000
T3:                                                                     17352000
                  DISCERROR(*,ERRSTAT,RECORD,WC1,WRITE.(15:1),0);       17354000
                END;                                                    17356000
              GOTO RETRY;                                               17358000
            END;                                                        17360000
T2:                                                                     17362000
          TOS := WC1;                                                   17364000
          ASSEMBLE(DUP,DUP);                                            17366000
          I := TOS+I;   <<UPDATE BUFFER POINTER>>                       17368000
          WC := -TOS+WC;   <<UPDATE WORD COUNT>>                        17370000
          IF <= THEN                                                    17372000
            BEGIN  <<TRANSFERRED ALL WORDS>>                            17374000
  EXIT:       TOS := OLDDB;                                             17376000
              ASSEMBLE(XCHD);  <<RESET DB TO ORIGINAL VALUE>>           17378000
              RETURN;                                                   17380000
            END;                                                        17382000
          ASSEMBLE(ZERO,XCH);                                           17384000
          TOS := LOGICAL(TOS+127)&LSR(7);  <<# OF SECTORS DONE>>        17386000
          ASSEMBLE(DUP,NEG);                                            17388000
          NS := TOS+NS;  <<# OF SECTORS LEFT TO DO>>                    17390000
          RECORD := TOS+RECORD;                                         17392000
          GO AGAIN;                                                     17394000
      END <<MHDISC>> ;                                                  17396000
          <<----------------------------                                17398000
            7905/7920/7925 DISC DRIVER                                  17400000
          ---------------------------->>                                17402000
$CONTROL SEGMENT=RESIDENT                                      <<02510>>17404000
PROCEDURE MH7905'SIO(LDEV,DRTUNIT,STYPE,FUNCT,RECORD,BUF,WC);  <<02510>>17406000
    VALUE LDEV,DRTUNIT,STYPE,FUNCT,RECORD,BUF,WC;                       17408000
    INTEGER DRTUNIT,        <<DRT AND UNIT NUMBER>>                     17410000
            LDEV,           <<LOGICAL DEVICE NUMBER>>                   17412000
            STYPE,          <<SUBTYPE>>                                 17414000
            WC;             <<WORD COUNT>>                              17416000
    LOGICAL FUNCT;          <<0: READ                                   17418000
                              1: WRITE                                  17420000
                              2: READ AND SET CCE - OK                  17422000
                                              CCL - DEFECTIVE TRACK     17424000
                                              CCG - TRACK SPECIFIC ERROR17426000
                              3: FLAG TRACK DEFECTIVE                   17428000
                              4: READ FULL SECTOR>>                     17430000
    DOUBLE RECORD,          <<DISC ADDRESS>>                            17432000
           BUF;             <<ABSOLUTE ADDRESS OF BUFFER>>              17434000
      BEGIN                                                             17436000
        DEFINE ERRCODE  = (3:5)#,   <<ERROR BITS IN STATUS>>            17438000
               NOTRDY   = (14:1)#;  <<DRIVE NOT READY>>                 17440000
        EQUATE SIOEND   = %30000,   <<SIO END INSTRUCTION>>             17442000
               SIOJUMPC = %4000,    <<SIO CONDITIONAL JUMP>>            17444000
               SIOCNTRL = %40000;   <<SIO CONTROL INSTRUCTION>>         17446000
        EQUATE CDERR    = %17,      <<CORRECTABLE DATA ERROR>>          17448000
               WUPERR   = 2,        <<SET WAKE UP COMPLETED>>  <<00.06>>17450000
               SPT      = %20,      <<SPARE TRACK>>                     17452000
               TFD      = %21;      <<DEFECTIVE TRACK>>                 17454000
        EQUATE D        = 1,        <<DEFECTIVE TRACK BIT>>             17456000
               SP       = 4;        <<SPARE TRACK BIT>>                 17458000
        EQUATE SEEKCOM  = %1200,    <<SEEK COMMAND>>                    17460000
               REQSTAT  = %1400,    <<REQUEST STATUS COMMAAD>>          17462000
               REQADR   = %12000,   <<REQUEST ADDRESS COMMAND>>         17464000
               SETWAKE  = %13000,   <<SET WAKEUP COMMAND>>     <<00.06>>17466000
   <<********************************************************>><<00.06>>17468000
   <<NOTE: THE SET WAKEUP COMMAND IS USED IN THIS DRIVER TO  >><<00.06>>17470000
   <<  INSURE THAT THE CORRECT UNIT NUMBER IS RETURNED IN THE>><<00.06>>17472000
   <<  TIO STATUS AFTER INTERUPT AND TO CLEAR THE TIO ERROR  >><<00.06>>17474000
   <<  STATUS AFTER RUNNING A REQUEST STATUS OR REQUEST      >><<00.06>>17476000
   <<  SYNDROME SIO PROGRAM.                                 >><<00.06>>17478000
   <<********************************************************>><<00.06>>17480000
               SETBANK  = %14000,   <<SET BANK>>                        17482000
               ENDOP    = %12400,   <<END COMMAND>>                     17484000
               REQSYND  = %6400,    <<REQUEST SYNDROME COMMAND>>        17486000
               VFY      = %3400,    <<VERIFY COMMAND>>                  17488000
               INITCOM  = %5400,    <<INITIALIZE COMMAND>>              17490000
               ADRREC   = %6000;    <<ADDRESS RECORD COMMAND>>          17492000
        LOGICAL ARRAY S(*) = DB+0,  <<SIO PROGRAM BUFFER>>              17494000
                      BUFDB(*) = DB+0;                                  17496000
        INTEGER ARRAY SYNRET(0:6)=Q;<<SYNDROME RETURN>>                 17498000
        DOUBLE STATWORDS,           <<STATUS RETURN>>                   17500000
               PHYSADR,             <<CYLINDER, HEAD & SECTOR>>         17502000
               OLDDB,               <<OLD ADDRESS OF DB>>               17504000
               TBUFA,               <<ABSOLUTE ADDRESS OF TBUF>>        17506000
               SYNADR=SYNRET+1,     <<ADDRESS OF ERROR>>                17508000
               ALTADR;              <<ALTERNATE CYLINDER, HEAD & SECT>> 17510000
        INTEGER DRT,                <<DRT NUMBER>>                      17512000
                UNIT,               <<UNIT NUMBER>>            <<03603>>17514000
                SBANK,              <<BANK OF OUR STK>>        <<03603>>17516000
                BUF1=BUF,BUF2=BUF+1,                                    17518000
                I:=0,                                                   17520000
                N,                                                      17522000
                INDEX,                                                  17524000
                CWC,                <<CURRENT WORD COUNT>>              17526000
                RDWRT,              <<COMMAND>>                         17528000
                CONSTAT,            <<CONTROLLER STATUS>>               17530000
                XCNT,               <<WORD COUNT>>                      17532000
                BUFCNT,             <<WORDS FINISHED COUNT>>            17534000
                TRACK,              <<DEFECTIVE TRACK ENTRY>>           17536000
                CYLADR=PHYSADR,                                         17538000
                ALTADR1=ALTADR,                                         17540000
                ALTADR2=ALTADR+1;                                       17542000
        INTEGER ARRAY TBUFDB(*) = DB+0;                                 17544000
        LOGICAL STATWORDABSADR, <<ABSOLUTE ADDR OF STATWORDS>>          17546000
                SYNRETABSADR,   <<ABSOLUTE ADDR OF SYNRET>>             17548000
                PHYSABSADR,     <<ABSOLUTE ADDR OF PHYSADR>>            17550000
                XCNTABSADR,     <<ABSOLUTE ADDR OF XCNT>>               17552000
                ALTABSADR;      <<ABS ADDR OF ALTADR>>                  17554000
        LOGICAL STATWORD1=STATWORDS,                                    17556000
                STATWORD2=STATWORDS+1;                                  17558000
        INTEGER ARRAY TBUF(0:127) = Q;                                  17560000
        INTEGER ARRAY STATSIOPROG(0:13)=PB:=                   <<00.06>>17562000
                %40001,0,           <<CONTROL-REQUEST STATUS>>          17564000
                %14000,0,           <<SET BANK-BANK #>>                 17566000
                %77776,0,           <<READ 2 STATUS WORDS>>             17568000
                %40001,REQADR,      <<CONTROL-RQST DISC ADDR>> <<25.03>>17570000
                %77776,0,           <<READ 2 WORD DISC ADDRESS>>        17572000
                %40000,0,           <<SET WAKEUP  >>           <<00.06>>17574000
                %40000,%12400;      <<CONTROL-END>>                     17576000
        INTEGER ARRAY XFERSIOPROG(0:7)=PB:=                             17578000
                %40000,0,           <<CONTROL-SET MASK>>                17580000
                %40000,ADRREC,      <<CONTROL-ADDRESS RECORD>> <<25.03>>17582000
                %67776,0,           <<WRITE 2 WORD ADDRESS>>            17584000
                %40000,0;           <<CONTROL-TRANSFER ORDER>>          17586000
        INTEGER ARRAY REQSYNSIOPROG(0:13) = PB :=              <<00.06>>17588000
                %40001,REQSYND,     <<CONTROL-REQUEST SYNDRME>><<25.03>>17590000
                %14000,0,           <<SET BANK-BANK #>>                 17592000
                %77771,0,           <<READ 7 WORDS>>                    17594000
                %40001,0,           <<CONTROL-REQUEST STATUS>>          17596000
                %77776,0,           <<READ 2 STATUS WORDS>>             17598000
                %40000,0,           <<SET WAKEUP>>             <<00.06>>17600000
                %40000,%12400;      <<CONTROL-END>>                     17602000
        INTEGER ARRAY VERIFYSIOPROG(0:3)=PB:=                           17604000
                %40000,0,           <<CONTROL-VERIFY>>                  17606000
                %67777,0;           <<WRITE 1 WORD SECTOR COUNT>>       17608000
        INTEGER ARRAY INITSIOPROG(0:11)=PB:=                            17610000
                %40000,ADRREC,      <<CONTROL-ADDRESS RECORD>> <<25.03>>17612000
                %67776,0,           <<WRITE 2 WORD ADDRESS>>            17614000
                %40000,0,           <<CONTROL-INITIALIZE>>              17616000
                %160000,0,          <<WRITE 4K FROM ADDDRESS 0>>        17618000
                %64000,%10000,      <<WRITE 2K FROM ADDRESS 4096>>      17620000
                                    <<  (WRITE 4K IF 7925)  >> <<25.03>>17622000
                %40000,%12400;      <<CONTROL-END>>                     17624000
        INTEGER ARRAY SEEKSIOPROG(0:5)=PB:=                             17626000
                %40000,0,           <<CONTROL-SEEK>>                    17628000
                %14000,0,           <<SET BANK-BANK #>>                 17630000
                %67776,0;           <<WRITE 2 WORD ADDRESS>>            17632000
        INTEGER ARRAY FILEMASK (4:NMHSUBTYPES-1) = PB :=       <<25.02>>17634000
                %7502, %7501, %7503, %7503, %7503, %7503;      <<25.02>>17636000
        INTEGER ARRAY SEC'CYL (4:NMHSUBTYPES-1) = PB :=        <<25.02>>17638000
                96, 48, 144, 144, 240, 576;                    <<25.02>>17640000
        INTEGER ARRAY HEADBASE (4:NMHSUBTYPES-1) = PB :=       <<25.02>>17642000
                0, %1000, 0, 0, 0, 0;                          <<25.02>>17644000
        INTEGER ARRAY SECPERTRK (4:NMHSUBTYPES-1) = PB :=      <<25.02>>17646000
                48, 48, 48, 48, 48, 64;                        <<25.02>>17648000
        INTEGER ARRAY DISKOP(0:4)=PB:=%2400,%4000,%2400,0,%3000;        17650000
        INTEGER ARRAY SIORDWRT(0:1)=PB:=%170000,%160000;                17652000
        LOGICAL SUBROUTINE EXANWAIT(INDEX,SAMEUNIT);                    17654000
        VALUE INDEX,SAMEUNIT;                                           17656000
        INTEGER INDEX;   <<SIO BUFFER INDEX>>                           17658000
        LOGICAL SAMEUNIT;<<TRUE IF INTERRUPT ON THIS UNIT IS VALID>>    17660000
        BEGIN                                                           17662000
          S(INDEX) := SIOEND;                                           17664000
          S(X:=X+1) := 0;                                               17666000
          TOS := DRT;                                                   17668000
          EXECUTESIO(DRT,ABSOLUTE(SIOPROG));                   <<01103>>17670000
  TEST:   TIO0;                                                <<01103>>17672000
          S5 := S0;  <<TIO STATUS>>                                     17674000
          IF TOS.(2:1) THEN                                             17676000
            BEGIN  <<INTERRUPT>>                                        17678000
              TOS := %40000;                                            17680000
              CIO1;                                            <<01103>>17682000
              IF S4.(13:3)=UNIT AND LOGICAL(S2) THEN                    17684000
                BEGIN  <<VALID INTERRUPT>>                              17686000
   GETOUT:        DEL;                                                  17688000
                  RETURN;                                               17690000
                END                                                     17692000
              ELSE GOTO TEST;                                           17694000
            END;                                                        17696000
          IF S4<0 THEN GOTO GETOUT;  <<SIO OK>>                         17698000
          GOTO TEST;                                                    17700000
        END <<EXANWAIT>> ;                                              17702000
        LOGICAL SUBROUTINE GETSTATUS;                                   17704000
        BEGIN                                                           17706000
          MOVE S := STATSIOPROG,(14);                          <<00.06>>17708000
          S(1) := REQSTAT+UNIT;  <<REQUEST STATUS COMMAND>>             17710000
          S(3) := SBANK;                                       <<03603>>17712000
          S(5) := STATWORDABSADR;                                       17714000
                                                               <<25.03>>17716000
          S(9) := SYNRETABSADR+1;  <<FOR ADDRESS RETURN>>               17718000
          S(11) := SETWAKE+UNIT;                               <<00.06>>17720000
          GETSTATUS := EXANWAIT(14,FALSE);                     <<00.06>>17722000
        END <<GETSTATUS>> ;                                             17724000
        SUBROUTINE SEEK;                                                17726000
        BEGIN                                                           17728000
          MOVE S := SEEKSIOPROG,(6);                                    17730000
          S(1) := SEEKCOM+UNIT;                                         17732000
          S(3) := SBANK;                                       <<03603>>17734000
          S(5) := PHYSABSADR;                                           17736000
        END <<SEEK>> ;                                                  17738000
        DOUBLE SUBROUTINE L'PADR(LOGADR);                               17740000
        VALUE LOGADR;                                                   17742000
        DOUBLE LOGADR;  <<LOGICAL ADDRESS>>                             17744000
        BEGIN                                                           17746000
          TOS := LOGADR;                                                17748000
          TOS := SEC'CYL(STYPE);                                        17750000
          ASSEMBLE(LDIV);                                               17752000
          IF OVERFLOW THEN                                              17754000
            BEGIN    <<BAD ADDRESS>>                                    17756000
            TOS := ABSOLUTE(DBBANK);                                    17758000
            TOS := ABSOLUTE(DB);                                        17760000
            SET(DB);  <<SET DB TO INITIAL STACK>>                       17762000
            ERRMESSAGE(M27);                                   <<01103>>17764000
            END;                                                        17766000
          TOS := SECPERTRK (STYPE);                            <<25.02>>17768000
          ASSEMBLE(DIV,XCH);                                            17770000
          TOS := TOS&LSL(8)+HEADBASE(STYPE)+TOS;  <<HEAD/SECTOR>>       17772000
          DS6 := TOS;                                                   17774000
        END <<L'PADR>> ;                                                17776000
        DOUBLE SUBROUTINE CONVERTADR(PHYSADR);                          17778000
        VALUE PHYSADR;                                                  17780000
        DOUBLE PHYSADR;  <<PHYSICAL DISC ADDRESS>>                      17782000
        BEGIN                                                           17784000
          TOS := PHYSADR;                                               17786000
          TOS := S0;                                                    17788000
          TOS := (TOS - HEADBASE(STYPE))& LSR(8) *             <<25.02>>17790000
            SECPERTRK (STYPE);                                 <<25.02>>17792000
          ASSEMBLE(XCH);                                                17794000
          TOS := TOS.(8:8);  <<SECTOR #>>                               17796000
          ASSEMBLE(ADD,ZERO; XCH,CAB);                                  17798000
          TOS := SEC'CYL(X);                                            17800000
          ASSEMBLE(LMPY,DADD);                                          17802000
          DS6 := TOS;  <<SECTOR ADDRESS>>                               17804000
        END <<CONVERTADR>> ;                                            17806000
        SUBROUTINE INITIALIZE(SECTOR,ADRRECSECT,BITS,VERIFY);           17808000
        VALUE SECTOR,ADRRECSECT,BITS,VERIFY;                            17810000
        DOUBLE SECTOR,       <<SECTOR FOR SEEK>>                        17812000
               ADRRECSECT;   <<SECTOR FOR ADDRESS RECORD>>              17814000
        INTEGER BITS;        <<SPARE, DEFECTIVE OR ZERO>>               17816000
        LOGICAL VERIFY;      <<TRUE IF VERIFY COM TO BE EXECUTED>>      17818000
        COMMENT:                                                        17820000
          INITIALIZE IS GENERALLY CALLED WITH DB POINTING               17822000
        TO THE STACK SO INITIALIZE SETS DB TO SIO PROGRAM               17824000
        AREA. DB IS LEFT THERE UPON EXIT FROM INITIALIZE;               17826000
        BEGIN                                                           17828000
          TOS := 0;                                                     17830000
          TOS := ABSOLUTE(SIOPROG);<<INITIALIZE CALLED>>                17832000
          SET(DB);                 <<WITH DB AT STACK>>                 17834000
          PHYSADR := L'PADR(SECTOR);                                    17836000
          SEEK;                                                         17838000
          S(6) := SIOCNTRL;                                             17840000
          S(7) := FILEMASK(STYPE)+4;  <<SPARING ENABLED>>               17842000
          IF VERIFY THEN                                                17844000
            BEGIN                                                       17846000
              MOVE S(8) := VERIFYSIOPROG,(4);                           17848000
              S(9) := VFY+UNIT;                                         17850000
              S(11) := XCNTABSADR;                                      17852000
              XCNT := 1;  <<VERIFY ONE SECTOR>>                         17854000
              N := 12;  <<SIO PROG INDEX>>                              17856000
            END                                                         17858000
          ELSE N := 8;                                                  17860000
          MOVE S(N) := INITSIOPROG,(12);                                17862000
                                                               <<25.03>>17864000
          S(N+3) := ALTABSADR;    <<ADDRESS RECORD ADDRESS>>            17866000
          ALTADR2 := 0;                                                 17868000
          IF ADRRECSECT=-1D THEN ALTADR1 := -1                          17870000
          ELSE IF ADRRECSECT=0D THEN ALTADR1 := 0                       17872000
          ELSE ALTADR := L'PADR(ADRRECSECT);                            17874000
          TOS := INITCOM+UNIT;                                          17876000
          TOS.(0:3) := S3;  <<BITS>>                                    17878000
          S(N+5) := TOS;                                                17880000
                                                               <<25.03>>17882000
  << MUST INITIALIZE ENTIRE TRACK.  DEFAULT WORD COUNT           25.03  17884000
     = 6144 (48 SECTORS).  IF DISC = 7925, ONE TRACK = 64        25.03  17886000
     SECTORS, SO ADJUST WORD COUNT ACCORDINGLY.                  25.03>>17888000
                                                               <<25.03>>17890000
          IF STYPE = S7925 THEN S(N+8) := %60000;              <<25.03>>17892000
          IF EXANWAIT(N+12,TRUE).ERRCODE<>0 THEN GOTO GETERRSTAT;       17894000
        END <<INITIALIZE>> ;                                            17896000
                                                                        17898000
          CC := CCE;                                           <<01889>>17900000
          IF FUNCT = NON'FATAL'READ THEN FUNCT := READ;        <<01889>>17902000
          IF ON'ICS THEN                                       <<03603>>17904000
            BEGIN                                              <<03603>>17906000
            TOS := 0;  << BANK 0 >>                            <<03603>>17908000
            TOS := ABS(QI); << DB REGISTER TO QI >>            <<03603>>17910000
            END                                                <<03603>>17912000
          ELSE                                                          17914000
            BEGIN <<LOAD STACK DB POINTER>>                             17916000
            TOS := ABSOLUTE(DBBANK);                                    17918000
            TOS := ABSOLUTE(DB);                                        17920000
            END;                                                        17922000
          ASSEMBLE(DDUP,DDUP;XCHD);  <<SET DB TO STACK>>       <<03603>>17924000
          OLDDB := TOS;  <<SAVE OLD DB>>                       <<03603>>17926000
          SBANK := S1; << STACK WE ARE CURRENTLY RUNNING ON >> <<03603>>17928000
          STATWORDABSADR := S0 + @STATWORDS;<<SAVE ABS ADDR>>           17930000
          SYNRETABSADR := S0 + @SYNRET;                                 17932000
          PHYSABSADR := S0 + @PHYSADR;                                  17934000
          XCNTABSADR := S0 + @XCNT;                                     17936000
          ALTABSADR  := S0 + @ALTADR;                                   17938000
          TOS := TOS + @TBUF;                                           17940000
          TBUFA := TOS;  <<ABSOLUTE ADDRESS OF TBUF>>                   17942000
          TOS := 0;                                                     17944000
          TOS := ABSOLUTE(SIOPROG);                                     17946000
          SET(DB);                                                      17948000
          DRT := DRTUNIT.DRTFIELD;                             <<03002>>17950000
          UNIT := DRTUNIT.UNITFIELD;                           <<03002>>17952000
          IF GETSTATUS.ERRCODE<>WUPERR THEN GOTO ERROR;        <<00.06>>17954000
                                                               <<03549>>17956000
          IF FUNCT = INIT'DEV THEN   << INITIALIZE DONE BY  >> <<03715>>17958000
             BEGIN                   <<     READING STATUS  >> <<03715>>17960000
             IF STATWORD2.NOTRDY THEN                          <<03715>>17962000
                CC := CCL;    << RETURN CCL IF OFFLINE >>      <<03715>>17964000
             GO EXIT;                                          <<03715>>17966000
             END;                                              <<03715>>17968000
                                                               <<03549>>17970000
          IF FUNCT = RSTAT THEN  <<REQUEST STATUS>>            <<RH.PV>>17972000
            BEGIN                                              <<RH.PV>>17974000
              TOS := BUF;                                      <<RH.PV>>17976000
              ASSEMBLE(XCHD);  <<SET DB TO BUF>>               <<RH.PV>>17978000
              BUFDB(0) := STATWORD1;                           <<RH.PV>>17980000
              BUFDB(1) := STATWORD2;                           <<RH.PV>>17982000
              ASSEMBLE(XCHD);  <<RESET DB>>                    <<RH.PV>>17984000
              GO EXIT;                                         <<RH.PV>>17986000
            END;                                               <<RH.PV>>17988000
          IF STATWORD2.NOTRDY THEN                                      17990000
            BEGIN  <<DRIVE NOT READY>>                                  17992000
              MESSAGE(M2408,LDEV); << PRINT NOT READY >>       <<01103>>17994000
              TOS := DRT;                                               17996000
  WAITFORINT: ASSEMBLE(TIO 0; BL *-1);                                  17998000
              IF S0.(2:1)<>1 THEN                                       18000000
                BEGIN  <<NO INTERRUPT YET>>                             18002000
                  DEL;                                                  18004000
                  GOTO WAITFORINT;                                      18006000
                END                                                     18008000
              ELSE                                                      18010000
                BEGIN                                                   18012000
                  TOS := %40000;  <<RESET INTERRUPT>>                   18014000
                  ASSEMBLE(CIO 2; BL *-1);                              18016000
                  IF TOS.(13:3)<>UNIT THEN GOTO WAITFORINT;             18018000
                END;                                                    18020000
              DEL;                                                      18022000
            END;                                                        18024000
          IF FUNCT<>3 THEN                                              18026000
            BEGIN  <<NOT FLAG TRACK>>                                   18028000
  AGAIN:      PHYSADR := L'PADR(RECORD);                                18030000
              SEEK;                                                     18032000
              MOVE S(6) := XFERSIOPROG,(8);                             18034000
              TOS := FILEMASK(STYPE);                                   18036000
              IF FUNCT<2 THEN TOS.(13:1) := 1;  <<SPARING ENABLED>>     18038000
              S(7) := TOS;                                              18040000
                                                               <<25.03>>18042000
              S(11) := PHYSABSADR;    <<POINTER TO PHYSICAL ADDRESS>>   18044000
              S(13) := DISKOP(FUNCT)+UNIT;                              18046000
              TOS := WC;                                                18048000
              IF STYPE=4 THEN                                           18050000
                BEGIN  <<CHECK FOR CYLINDER OVERFLOW>>                  18052000
                  TOS := SEC'CYL(STYPE);                                18054000
                  TOS := RECORD;                                        18056000
                  TOS := S2;                                            18058000
                  ASSEMBLE(LDIV,DELB; SUB);                             18060000
                  TOS := TOS&LSL(7);                                    18062000
                  ASSEMBLE(DDUP,LCMP);                                  18064000
                  IF < THEN ASSEMBLE(XCH);                              18066000
                  DELB;                                                 18068000
                END;                                                    18070000
              ASSEMBLE(DUP,DUP);                                        18072000
              CWC := TOS;  <<# OF WORDS TO TRANSFER>>                   18074000
              XCNT := I;  <<BUFFER INDEX>>                              18076000
              RDWRT := SIORDWRT(FUNCT.(15:1));  <<SIO COMMAND>>         18078000
              S(14) := SETBANK;                                         18080000
              S(15) := BUF1;                                            18082000
              X := 16;                                                  18084000
              WHILE TOS>4096 DO                                         18086000
                BEGIN  <<FORM DATA TRANSFER ORDERS>>                    18088000
                  TOS := TOS-4096;                                      18090000
                  S(X) := RDWRT;                                        18092000
                  S(X:=X+1) := BUF2+XCNT;                               18094000
                  X := X+1;                                             18096000
                  TOS := S0;                                            18098000
                  XCNT := XCNT+4096;                                    18100000
                END;                                                    18102000
              TOS := RDWRT;                                             18104000
              ASSEMBLE(TRBC 0; XCH,NEG);                                18106000
              TOS := TOS LAND %7777 LOR TOS;                            18108000
              S(X) := TOS;                                              18110000
              S(X:=X+1) := BUF2+XCNT;                                   18112000
              S(X:=X+1) := SIOJUMPC;                                    18114000
              TOS := X; <<SAVE X REG. FOR AFTER PRIV LOAD>>             18116000
              TOS := ABSOLUTE(SIOPROG)+8;<<PT TO ADDRESS RECORD>>       18118000
              ASSEMBLE(XCH);                                            18120000
              X := TOS+1;                                               18122000
              S(X) := TOS;                                              18124000
              S(X:=X+1) := SIOCNTRL;                                    18126000
              S(X:=X+1) := ENDOP;                                       18128000
              IF (CONSTAT:=EXANWAIT(X+1,TRUE).ERRCODE)<>0 THEN          18130000
                BEGIN  <<ERROR>>                                        18132000
                  IF CONSTAT=CDERR THEN                                 18134000
                    BEGIN  <<CORRECTABLE DATA ERROR>>                   18136000
                      MOVE S := REQSYNSIOPROG,(14);            <<00.06>>18138000
                                                               <<25.03>>18140000
                      S(3) := SBANK;                           <<03603>>18142000
                      S(5) := SYNRETABSADR;                             18144000
                      S(7) := REQSTAT+UNIT;        <<CAUSE UNIT>>       18146000
                      S(9) := ABSOLUTE(SIOPROG)+15;<<TO BE RETURNED>>   18148000
                      S(11) := SETWAKE+UNIT;                   <<00.06>>18150000
                      IF EXANWAIT(14,TRUE).ERRCODE<>WUPERR THEN<<00.06>>18152000
                       GO TO GETERRSTAT;                                18154000
                      IF SYNRET.ERRCODE=CDERR THEN                      18156000
                        BEGIN  <<CORRECT ERROR>>                        18158000
                          TOS := CONVERTADR(SYNADR)-RECORD;             18160000
                          XCNT := TOS&LSL(7);                           18162000
                          N := TOS;  <<ZERO>>                           18164000
                          TOS := XCNT+SYNRET(3);  <<DISPLACEMENT>>      18166000
                          ASSEMBLE(DUP,NEG);                            18168000
                          BUFCNT := TOS+CWC;  <<BUFFER LIMIT>>          18170000
                          INDEX := TOS;  <<BUFFER INDEX>>               18172000
                          TOS := BUF;                                   18174000
                          ASSEMBLE(XCHD); <<SET DB TO BUF>>             18176000
                          DO IF 0<=(SYNRET(3)+N)<=127 AND (BUFCNT-N)>0  18178000
                            THEN BUFDB(X) := LOGICAL(SYNRET(4+N)) XOR   18180000
                            BUFDB(I+N+INDEX)                            18182000
                          UNTIL (N:=N+1)=3;                             18184000
                          ASSEMBLE(XCHD);  <<RESET DB>>                 18186000
                          CWC := XCNT+128;                              18188000
                          GOTO CONTXFER;                                18190000
                        END;                                            18192000
                      STATWORD1 := SYNRET;                              18194000
                      GOTO UNCORRECTABLE;                               18196000
                    END;                                                18198000
                  IF CONSTAT=SPT THEN                                   18200000
                    BEGIN  <<SPARE TRACK>>                              18202000
                      TOS := ABSOLUTE(DBBANK);                          18204000
                      TOS := ABSOLUTE(DB);                              18206000
                      SET(DB); <<SET DB TO STACK FOR CALL TO ALTTRACK>> 18208000
                      TOS := 0;                                         18210000
                      TOS := LDEV;                                      18212000
                      TOS := RECORD;                                    18214000
                      TOS := SECPERTRK (STYPE);                <<25.02>>18216000
                      ASSEMBLE(LDIV,DEL);                               18218000
                      TOS := ALTTRACK(*,*);  <<GET ALTERNATE ADDRESS>>  18220000
                      IF TOS >= 0 THEN                                  18222000
                        BEGIN  <<A FORMER SPARE TRACK>>                 18224000
                          IF CYLADR>=DTT(DTTLPS) THEN INITIALIZE(RECORD,18226000
                            0D,SP,0)  <<SPARE TRACK>>                   18228000
                          ELSE INITIALIZE(RECORD,RECORD,0,0); <<NORMAL>>18230000
                          CC := CCE;  <<OK>>                            18232000
                        END                                             18234000
                      ELSE                                              18236000
                        BEGIN  <<DEFECTIVE>>                            18238000
  DEFECTIVE:              IF CYLADR>=DTT(DTTLPS) THEN INITIALIZE(RECORD,18240000
                            -1D,SP,0)   <<DEFECTIVE IN SPARE AREA>>     18242000
                          ELSE INITIALIZE(RECORD,-1D,D,0);              18244000
                          CC := CCL;                                    18246000
                        END;                                            18248000
                      GO EXIT;                                          18250000
                    END;                                                18252000
                  IF CONSTAT=TFD THEN GOTO DEFECTIVE; <<FLAGGED TRACK>> 18254000
  GETERRSTAT:      IF GETSTATUS.ERRCODE<>WUPERR THEN           <<00.06>>18256000
                     GOTO PRINTERR;                            <<00.06>>18258000
  ERROR: IF LDEV=0 THEN ASSEMBLE(HALT 5);  <<IN BOOTSTRAP>>    <<2B.00>>18260000
                  IF 7<=CONSTAT<=%11 THEN                               18262000
                    BEGIN  <<TRACK SPECIFIC ERROR>>                     18264000
  UNCORRECTABLE:      IF FUNCT=2 THEN                                   18266000
                        BEGIN  <<RETURN CCG>>                           18268000
                          CC := CCG;                                    18270000
                          GO EXIT;                                      18272000
                        END;                                            18274000
                      TOS := CONVERTADR(SYNADR);                        18276000
                      TOS := SECPERTRK (STYPE);                <<25.02>>18278000
                      ASSEMBLE(LDIV,DEL);  <<TRACK #>>                  18280000
                      TOS := TOS&LSL(2);                                18282000
                      IF <> THEN                                        18284000
                        BEGIN  <<ADD TO DEFECTIVE TRACKS TABLE>>        18286000
                          IF STATWORD1.(0:1) THEN TOS:=TOS+1;<<SPARE>>  18288000
                          TRACK := TOS;                                 18290000
                          MH7905'SIO(LDEV,DRTUNIT,STYPE,0,1D,  <<02510>>18292000
                            TBUFA,128);                        <<02510>>18294000
                          TOS := TBUFA;                                 18296000
                          ASSEMBLE(XCHD); <<SET DB TO TBUF>>            18298000
                          X := 0;                                       18300000
                          WHILE (X:=X+1)<=TBUFDB DO                     18302000
                          IF TBUFDB(X)= TRACK  THEN GOTO PRINTERR;      18304000
                          IF X>120 THEN GOTO PRINTERR;                  18306000
                          TBUFDB := TBUFDB+1;                           18308000
                          TBUFDB(X) := TRACK;                           18310000
                          MH7905'SIO(LDEV,DRTUNIT,STYPE,1,1D,  <<02510>>18312000
                            TBUFA,128);                        <<02510>>18314000
                        END;                                            18316000
                    END;                                                18318000
  PRINTERR:       DISCERROR(LDEV,STATWORD1,CONVERTADR(SYNADR),0,FUNCT.  18320000
                   (15:1),IF INTEGER(STATWORD2)<0 THEN STATWORD2 ELSE   18322000
                   0);                                                  18324000
                END;                                                    18326000
              IF FUNCT=2 THEN                                           18328000
                BEGIN  <<TYPE 2 READ - OK>>                             18330000
                  TOS := ABSOLUTE(DBBANK);                              18332000
                  TOS := ABSOLUTE(DB);                                  18334000
                  ASSEMBLE(XCHD); <<SET DB TO STACK>>                   18336000
                  CC := CCE;                                            18338000
                  IF CYLADR>DTT(DTTLPS) THEN INITIALIZE(RECORD,0D,SP,   18340000
                    0);  <<FLAG AS SPARE>>                              18342000
                  GO EXIT;                                              18344000
                END;                                                    18346000
  CONTXFER:   I := I+CWC;                                               18348000
              WC := WC-CWC;                                             18350000
              IF <= THEN GO EXIT;                                       18352000
              TOS := 0;                                                 18354000
              TOS := (CWC+127)&LSR(7);                                  18356000
              RECORD := TOS+RECORD;                                     18358000
              GOTO AGAIN;                                               18360000
            END                                                         18362000
          ELSE                                                          18364000
            BEGIN  <<FLAG A TRACK DEFECTIVE>>                  <<00888>>18366000
              TOS := BUF;                                      <<00888>>18368000
              ASSEMBLE(LSEA;DELB,DELB);                        <<00888>>18370000
              IF S0<>-1 THEN                                   <<00888>>18372000
                BEGIN <<POINT ALTERNATE AT DEFECTIVE TRACK>>   <<00888>>18374000
                TOS := TOS ** LOGICAL (SECPERTRK (STYPE));     <<00888>>18376000
                INITIALIZE(*,RECORD,SP,0);                     <<00888>>18378000
                END;                                           <<00888>>18380000
              TOS := ABSOLUTE(DBBANK);                         <<00888>>18382000
              TOS := ABSOLUTE(DB);                             <<00888>>18384000
              ASSEMBLE(XCHD;DDEL); <<SET DB TO STACK>>         <<00888>>18386000
              TOS := 0;                                        <<00888>>18388000
              TOS := LDEV;                                     <<00888>>18390000
              TOS := RECORD;                                   <<00888>>18392000
              TOS := SECPERTRK (STYPE);                        <<00888>>18394000
              ASSEMBLE(LDIV,DEL);  <<TRACK #>>                 <<00888>>18396000
              TOS := ALTTRACK(*,*);                            <<00888>>18398000
              IF TOS<>-1 THEN                                  <<00888>>18400000
                BEGIN <<GARBAGE FORMER SPARE TRACK>>           <<00888>>18402000
                INITIALIZE(RECORD,-1D,SP,1);                   <<00888>>18404000
                TOS := ABSOLUTE(DBBANK);                       <<00888>>18406000
                TOS := ABSOLUTE(DB);                           <<00888>>18408000
                ASSEMBLE(XCHD;DDEL);<<RESET DB >>              <<00888>>18410000
                END;                                           <<00888>>18412000
              TOS := RECORD;                                   <<00888>>18414000
              TOS := BUF;                                      <<00888>>18416000
              ASSEMBLE(LSEA;DELB,DELB);                        <<00888>>18418000
              IF S0=-1 THEN                                    <<00888>>18420000
                BEGIN  <<DELETE>>                              <<00888>>18422000
                  DEL;                                         <<00888>>18424000
                  PHYSADR := L'PADR(RECORD);                   <<00888>>18426000
                  TOS := -1D;                                  <<00888>>18428000
                  IF CYLADR >= DTT(DTTLPS) THEN TOS := SP ELSE TOS := D;18430000
                END                                            <<00888>>18432000
              ELSE                                             <<00888>>18434000
                BEGIN  <<REASSIGN>>                            <<00888>>18436000
                  TOS := TOS ** LOGICAL (SECPERTRK (STYPE));   <<00888>>18438000
                  TOS := D;                                    <<00888>>18440000
                END;                                           <<00888>>18442000
              INITIALIZE(*,*,*,0);                             <<00888>>18444000
            END;                                               <<00888>>18446000
  EXIT:   TOS := OLDDB;                                        <<00888>>18448000
          ASSEMBLE(XCHD); <<SET DB TO OLD DB>>                 <<00888>>18450000
      END <<MH7905>> ;                                         <<00888>>18452000
$IF   << ******** RETURNING TO COMMON CODE ******** >>         <<02510>>18454000
$PAGE                                                          <<03550>>18456000
$CONTROL SEGMENT=RESIDENT                                      <<03550>>18458000
PROCEDURE CS'80'ERROR( LDEV, FUNC, DISCADR, CPADR, STATUS);    <<SPFIX>>18460000
   VALUE LDEV, FUNC, CPADR, DISCADR;                           <<SPFIX>>18462000
   INTEGER LDEV, FUNC, CPADR;                                  <<SPFIX>>18464000
   DOUBLE DISCADR;                                             <<SPFIX>>18466000
   INTEGER ARRAY STATUS;                                       <<SPFIX>>18468000
BEGIN                                                          <<SPFIX>>18470000
   INTEGER                                                     <<SPFIX>>18472000
      COL,                                                     <<SPFIX>>18474000
      I,                                                       <<SPFIX>>18476000
      J;                                                       <<SPFIX>>18478000
                                                               <<SPFIX>>18480000
   MOVE BLINE := "LDEV ",2;                                    <<SPFIX>>18482000
   TOS := TOS + ASCII( LDEV, 10, BPS0);                        <<*8392>>18484000
   MOVE * := ",FUNC ",2;                                       <<SPFIX>>18486000
   TOS := TOS + ASCII( FUNC, 10, BPS0);                        <<*8392>>18488000
   MOVE * := ",DISCADR %",2;                                   <<SPFIX>>18490000
   TOS := TOS + LDNTOA( DISCADR, 8, BPS0);                     <<SPFIX>>18492000
   MOVE * := ",CPADR %",2;                                     <<SPFIX>>18494000
   TOS := TOS + LNTOA( CPADR, 8, BPS0);                        <<SPFIX>>18496000
   PRINTLINE;                                                  <<SPFIX>>18498000
   MOVE BLINE(10) := "*** STATUS DISPLAY ***";                 <<SPFIX>>18500000
   PRINTLINE;                                                  <<SPFIX>>18502000
   J := 0;                                                     <<SPFIX>>18504000
   FOR *I := 0 UNTIL 1 DO                                      <<SPFIX>>18506000
      BEGIN                                                    <<SPFIX>>18508000
      FOR *COL := 8 STEP 8 UNTIL 40 DO                         <<SPFIX>>18510000
         BEGIN                                                 <<SPFIX>>18512000
         NTOA( STATUS(J), 8, BLINE(COL));                      <<SPFIX>>18514000
         J := J+1;                                             <<SPFIX>>18516000
         END;                                                  <<SPFIX>>18518000
      PRINTLINE;                                               <<SPFIX>>18520000
      END;                                                     <<SPFIX>>18522000
   PRINTLINE;                                                  <<SPFIX>>18524000
END;                                                           <<SPFIX>>18526000
         <<------------------------------>>                    <<03550>>18528000
         <<     CS'80 DEVICE DRIVER      >>                    <<03550>>18530000
         <<------------------------------>>                    <<03550>>18532000
PROCEDURE CS80'DRIVER(LDEV,DRT,UNIT,STYPE,FUNCT,RECORD,BUF,WC);<<*DVR*>>18534000
VALUE LDEV,DRT,UNIT,STYPE,FUNCT,RECORD,BUF,WC;                 <<*DVR*>>18536000
INTEGER                                                        <<03550>>18538000
   DRT,        << DRT NUMBER >>                                <<*DVR*>>18540000
   UNIT,       << UNIT NUMBER>>                                <<*DVR*>>18542000
   LDEV,       << LOGICAL DEVICE NUMBER >>                     <<03550>>18544000
   STYPE,      << DEVICE SUBTYPE >>                            <<03550>>18546000
   WC;         << NO. OF WORDS TO READ/WRITE >>                <<03550>>18548000
               << NOTE: THIS DRIVER ABORTS IF THE    >>        <<03668>>18550000
               << WORD COUNT EXCEEDS 32K-1           >>        <<03668>>18552000
               << (%77777) FOR ONE TRANSFER          >>        <<03550>>18554000
                                                               <<03550>>18556000
LOGICAL                                                        <<03550>>18558000
   FUNCT;      <<    DRIVER FUNCTION CODE              >>      <<03672>>18560000
               <<  ** NOTE--THOSE FUNCTIONS MARKED     >>      <<03672>>18562000
               <<  '+' ARE USED INTERNALLY ONLY, AND   >>      <<03672>>18564000
               <<  SHOULD NOT BE USED IN CALLING THIS  >>      <<03672>>18566000
               <<  DRIVER.  THE FUNCTIONS MARKED 'N'   >>      <<03672>>18568000
               <<  ARE NON-FATAL, AND DO NOT ABORT ON  >>      <<03672>>18570000
               <<  UNRECOVERABLE ERRORS, BUT RETURN    >>      <<03672>>18572000
               <<  CCL INSTEAD.  SEE SUBROUTINE        >>      <<03672>>18574000
               <<  FATAL'FUNCT.                        >>      <<03672>>18576000
               <<     0      READ                      >>      <<03672>>18578000
               <<     1      WRITE                     >>      <<03672>>18580000
               <<     2      ***UNUSED***              >>      <<03672>>18582000
               <<     3      ***UNUSED***              >>      <<03672>>18584000
               <<     4      ***UNUSED***              >>      <<03672>>18586000
               <<     5    N READ STATUS               >>      <<03672>>18588000
               <<     6    N NON-FATAL READ            >>      <<03672>>18590000
               <<     7    N INITIALIZE DEVICE         >>      <<03715>>18592000
               <<     8    + RELEASE                   >>      <<03672>>18594000
               <<     9    + DENY RELEASE              >>      <<03672>>18596000
               <<    10      DEVICE CLEAR              >>      <<03715>>18598000
               <<    11      SUPPRESS RELEASE TIMEOUT  >>      <<03672>>18600000
               <<    12    N ENABLE RELEASE TIMEOUT    >>      <<03715>>18602000
               <<    13      GET VOLUME LIMIT          >>      <<03672>>18604000
               <<    14      RECOVERY READ             >>      <<03672>>18606000
               <<    15      SPARE RETAINING DATA      >>      <<03672>>18608000
               <<    16      SPARE NOT RETAINING DATA  >>      <<03672>>18610000
               <<    17      DESCRIBE                  >>      <<03672>>18612000
               <<    18      R/W ERT                   >>      <<03672>>18614000
               <<    19      READ SPARE TABLE          >>      <<03672>>18616000
               <<    20    + DSCT READ                 >>      <<03672>>18618000
               <<    21    + DSCT WRITE                >>      <<03672>>18620000
               <<    22      INTERNAL DIAGNOSTIC       >>      <<03672>>18622000
               <<    23      R/O ERT                   >>      <<03672>>18624000
               <<    24    N CLEAR STATUS              >>      <<03672>>18626000
               <<    25    + READ STATUS               >>      <<03672>>18628000
               <<    26    N UNLOAD TAPE               >>      <<03715>>18630000
                                                               <<03550>>18632000
DOUBLE                                                         <<03550>>18634000
   RECORD,      << LOGICAL DISC ADDRESS >>                     <<03550>>18636000
   BUF;         << ABSOLUTE ADDRESS OF R/W BUFFER >>           <<03550>>18638000
                                                               <<03550>>18640000
COMMENT                                                        <<03550>>18642000
CS80'DRIVER IS THE COMMAND SET '80 DEVICE DRIVER.  IT IS USED  <<03550>>18644000
TO TALK TO THE 7911, 7912, 7935, LINUS, AND ALL OTHER CS'80    <<03550>>18646000
DEVICES.                                                       <<03550>>18648000
                                                               <<03550>>18650000
                                                               <<03550>>18652000
                                                               <<03550>>18654000
;                                                              <<03550>>18656000
                                                               <<03550>>18658000
BEGIN                                                          <<03550>>18660000
                                                               <<03550>>18662000
<< CHANNEL PROGRAM OFFSETS >>                                  <<03550>>18664000
                                                               <<03550>>18666000
EQUATE                                                         <<03550>>18668000
   BRANCHPT       = 1,  << BRANCH POINT OFFSET >>              <<03550>>18670000
   DXFER          =  2, << DATA XFER SECTION OFFSET >>         <<03668>>18672000
   STATX          = 23, << READ STATUS OFFSET >>               <<03668>>18674000
   DIAG           = 46, << DIAG SECTION OFFSET >>              <<03668>>18676000
   PON            = 60, << POWER ON OFFSET >>                  <<03668>>18678000
   PON'HALT       = PON+9,                                     <<03668>>18680000
   STAT'AREA      = 73, <<START OF STATUS RETURN AREA>>        <<03668>>18682000
   CDB'AREA'WRD   = 83, <<START OF COMMAND DATA BYTES>>        <<03668>>18684000
   CDB'AREA'BYTE  = CDB'AREA'WRD*2,                            <<03668>>18686000
   STAT'CDB       = 72; << STATUS COMMAND OFFSET >>            <<03668>>18688000
                                                               <<03550>>18690000
<< MISCELLANEOUS DEFINES >>                                    <<03550>>18692000
                                                               <<03550>>18694000
DEFINE                                                         <<03550>>18696000
   CHAN'PROG'BASE = ABS(CHANPROG)#,   <<ABS. BASE ADDR OF CP>> <<03550>>18698000
   CPVAP = ABS(GETDRT(DRT,DBI))#,                              <<03550>>18700000
   ERRCODE = (0:3)#;                                           <<03550>>18702000
                                                               <<03550>>18704000
<< DRIVER FUNCTION CODES >>                                    <<03550>>18706000
                                                               <<03550>>18708000
EQUATE                                                         <<03550>>18710000
   MAX'FUNCT        = 26,    << MAXIMUM FUNCTION NO. USED >>   <<03672>>18712000
   NUM'FUNCTS       = MAX'FUNCT + 1,                           <<03550>>18714000
   RELEASE          = 8,     << RELEASE >>                     <<03550>>18716000
   RELEASE'DENY     = 9,     << DENY RELEASE REQUEST >>        <<03550>>18718000
   CLEAR            = 10,    << SELECTED DEVICE CLEAR >>       <<03550>>18720000
   SUPP'RELEASE     = 11,    << SUPPRESS RELEASE TIMEOUT >>    <<03672>>18722000
   ENAB'RELEASE     = 12,    << ENABLE RELEASE TIMEOUT >>      <<03672>>18724000
   GET'VOL'LIMIT    = 13,    << GET VOLUME LIMIT >>            <<03550>>18726000
   RECOV'READ       = 14,    << READ--TRY TO RECOVER DATA >>   <<03550>>18728000
   SPARE'RETAIN     = 15,    << SPARE RETAINING DATA >>        <<03550>>18730000
   SPARE'NO'RETAIN  = 16,    << SPARE NOT RETAINING DATA >>    <<03550>>18732000
   DESCRIBE         = 17,    << GET DESCRIBE INFO. >>          <<03550>>18734000
   RW'ERT           = 18,    << DO READ/WRITE ERT >>           <<03550>>18736000
   READ'SPARES      = 19,    << READ SPARE TABLE >>            <<03550>>18738000
   DSCT'READ        = 20,    << READ DEFECTIVE SECTOR TABLE >> <<03550>>18740000
   DSCT'WRITE       = 21,    << WRITE DEFECTIVE SECTOR TABLE>> <<03550>>18742000
   DIAGNOSTIC       = 22,    << INTERNAL DIAGNOSTIC >>         <<03550>>18744000
   RO'ERT           = 23,    << READ ONLY ERT >>               <<03668>>18746000
   CLEAR'STAT       = 24,    << READ AND CLEAR STATUS >>       <<03668>>18748000
   GET'STAT         = 25,    << READ STATUS >>                 <<03672>>18750000
   UNLOAD           = 26;    << UNLOAD TAPE >>                 <<03672>>18752000
                                                               <<03550>>18754000
<< MODIFIED CHANNEL PROGRAM WORDS >>                           <<03550>>18756000
                                                               <<03550>>18758000
EQUATE                                                         <<03550>>18760000
   DX'CMD'MSGLEN      = DXFER+1,                               <<03550>>18762000
   DX'CMD'AREA'ADR    = DXFER+4,                               <<03550>>18764000
   DX'5               = DXFER+5,                               <<03550>>18766000
   DX'6               = DXFER+6,                               <<03550>>18768000
   DX'EXEC'SEC        = DXFER+7,                               <<03550>>18770000
   DX'COUNT           = DXFER+8,                               <<03550>>18772000
   DX'DATA'BANK       = DXFER+10,                              <<03550>>18774000
   DX'DATA'ADR        = DXFER+11,                              <<03550>>18776000
   DIAG'CMD'MSGLEN    = DIAG+1,                                <<03550>>18778000
   DIAG'CMD'AREA'ADR  = DIAG+4,                                <<03550>>18780000
   DIAG'NORMAL'JUMP   = DIAG+9,                                <<03550>>18782000
   DIAG'HALT'CODE     = DIAG+13,                               <<03550>>18784000
   STATX'CMD'ADR      = STATX+4,                               <<03550>>18786000
   STATX'DATA'ADR     = STATX+11,                              <<03550>>18788000
   STATX'HALT'CODE    = STATX+20,                              <<03550>>18790000
   STATX'FAIL'CODE    = STATX+22,                              <<03672>>18792000
   PON'HALT'CODE      = PON+10;                                <<03550>>18794000
                                                               <<03550>>18796000
<< MISCELLANEOUS EQUATES >>                                    <<03550>>18798000
                                                               <<03550>>18800000
EQUATE                                                         <<03550>>18802000
   CPSIZE =  98,            << CHANNEL PROGRAM SIZE >>         <<03668>>18804000
   STATUS'RETURN'SIZE = 20, <<SIZE OF STATUS RETURN (BYTES) >> <<03668>>18806000
   STAT'SIZE          = (STATUS'RETURN'SIZE+1)/2,              <<03668>>18808000
   MAX'DESC'BYTE      = 37, <<MAX # DESCRIBE BYTES >>          <<03550>>18810000
   ERT'RETURN         = 10, <<MAX # BYTES RETURN FROM ERT >>   <<03550>>18812000
   SNGL'VEC'LIMIT     = 15, <<VOL. LIMIT ADDRESS IN DESCRIBE>> <<03550>>18814000
   READ'MSGLEN        = 15, <<LENGTH OF READ COMMAND>>         <<03550>>18816000
   WRITE'MSGLEN       = 15, <<LENGTH OF WRITE COMMAND>>        <<03550>>18818000
   CTRL'UNIT          = %17,  << CONTROLLER UNIT NO. >>        <<03550>>18820000
   READ'EXEC'SEC      = %1416,                                 <<03550>>18822000
   WRITE'EXEC'SEC     = %2016;                                 <<03550>>18824000
                                                               <<03550>>18826000
<< CS'80 FUNCTION CODES >>                                     <<03550>>18828000
                                                               <<03550>>18830000
EQUATE                                                         <<03550>>18832000
   CDB'DESCRIBE       = %65,                                   <<03550>>18834000
   CDB'INIT'DIAG      = %63,                                   <<03550>>18836000
   CDB'INIT'UTIL      = %60,                                   <<03550>>18838000
   CDB'READ           = 0,                                     <<03550>>18840000
   CDB'RELEASE        = %16,                                   <<03550>>18842000
   CDB'RELEASE'DENY   = %17,                                   <<03550>>18844000
   CDB'SET'LENGTH     = %30,                                   <<03550>>18846000
   CDB'SET'RELEASE    = %73,                                   <<03550>>18848000
   CDB'SET'SNGL'VEC   = %20,                                   <<03550>>18850000
   CDB'SET'UNIT       = %40,                                   <<03550>>18852000
   CDB'SET'VOL        = %100,                                  <<03550>>18854000
   CDB'SPARE'BLK      = %6,                                    <<03550>>18856000
   CDB'UNLOAD         = %112,                                  <<03672>>18858000
   CDB'WRITE          = %2;                                    <<03550>>18860000
                                                               <<03550>>18862000
<< CHANNEL PROGRAM BRANCH POINTS >>                            <<03550>>18864000
                                                               <<03550>>18866000
EQUATE                                                         <<03550>>18868000
   DXFERCP     = DXFER-BRANCHPT-1,                             <<03550>>18870000
                                                               <<03550>>18872000
   DIAGCP      = DIAG-BRANCHPT-1,                              <<03550>>18874000
   PONCP       = PON-BRANCHPT-1;                               <<03550>>18876000
                                                               <<03550>>18878000
<< STATUS RETURN INDICES >>                                    <<03550>>18880000
                                                               <<03550>>18882000
EQUATE                                                         <<03550>>18884000
   ID'FIELD      = 0,                                          <<03550>>18886000
   REJECT'FIELD  = 1,                                          <<03550>>18888000
   FAULT'FIELD   = 2,                                          <<03550>>18890000
   ACCESS'FIELD  = 3,                                          <<03550>>18892000
   INFOR'FIELD   = 4,                                          <<03550>>18894000
   PARM'FIELD    = 5;                                          <<03550>>18896000
                                                               <<03550>>18898000
<< STATUS RETURN FIELDS >>                                     <<03550>>18900000
                                                               <<03550>>18902000
DEFINE                                                         <<03550>>18904000
                                                               <<03550>>18906000
             << ID'FIELD >>                                    <<03550>>18908000
                                                               <<03550>>18910000
   UNIT'ATTN        = (8:8)#,    <<UNIT ATTENTION>>            <<03550>>18912000
                                                               <<03550>>18914000
             << REJECT'FIELD >>                                <<03550>>18916000
                                                               <<03550>>18918000
   CHAN'PARITY      = (2:1)#,    <<CHANNEL PARITY>>            <<03715>>18920000
   ILLEG'OPCODE     = (5:1)#,    <<ILLEGAL OPCODE>>            <<03715>>18922000
   MOD'ADDR'ERR     = (6:1)#,    <<MODULE ADDR ERROR>>         <<03715>>18924000
   ADDR'BOUND       = (7:1)#,    <<ADDRESS BOUNDS>>            <<03715>>18926000
   PARM'BOUND       = (8:1)#,    <<PARAMETER BOUNDS>>          <<03715>>18928000
   ILLEG'PARM       = (9:1)#,    <<ILLEGAL PARAMETER>>         <<03715>>18930000
   MSG'SEQ'VIOL     =(10:1)#,    <<MSG SEQ VIOLATION>>         <<03715>>18932000
   MSG'LEN'DIFF     =(12:1)#,    <<MSG LENGTH DIFFER>>         <<03715>>18934000
                                                               <<03550>>18936000
             << FAULT'FIELD >>                                 <<03550>>18938000
                                                               <<03550>>18940000
   CROSS'UNIT       = (1:1)#,    <<ERROR DURING COPY OPER>>    <<03715>>18942000
   CTRL'FAULT       = (3:1)#,    <<CONTROLLER FAULT>>          <<03715>>18944000
   UNIT'FAULT       = (6:1)#,    <<UNIT FAULT>>                <<03715>>18946000
   DIAG'FAILED      = (8:1)#,    <<DIAGNOSTIC FAILED>>         <<03715>>18948000
   OPER'REL'REQRD   =(10:1)#,    <<OPER REL REQUIRED>>         <<03715>>18950000
   DIAG'REL'REQRD   =(11:1)#,    <<DIAG REL REQUIRED>>         <<03715>>18952000
   INT'MAINT'REQRD  =(12:1)#,    <<INT MAINT REQUIRED>>        <<03715>>18954000
   POWER'FAIL       =(14:1)#,    <<POWER FAIL>>                <<03715>>18956000
   RETRANSMIT       =(15:1)#,    <<RETRY REQUIRED>>            <<03715>>18958000
                                                               <<03550>>18960000
             << ACCESS'FIELD >>                                <<03550>>18962000
                                                               <<03550>>18964000
   ILLEG'PAR'OPER   = (0:1)#,    <<ILLEGAL // OPER>>           <<03715>>18966000
   UNINIT'MEDIA     = (1:1)#,    <<UNINITIALIZED MEDIA>>       <<03715>>18968000
   NO'SPARE'AVAIL   = (2:1)#,    <<NO SPARE AVAILABLE>>        <<03715>>18970000
   DEV'NOT'RDY      = (3:1)#,    <<DEVICE NOT READY>>          <<03715>>18972000
   WRT'PROTECT      = (4:1)#,    <<WRITE PROTECTED>>           <<03715>>18974000
   NO'DATA'FOUND    = (5:1)#,    <<NO DATA FOUND>>             <<03715>>18976000
   UNRECOV'DATA'OV  = (8:1)#,    <<UNRECOV DATA OVERFLOW>>     <<03715>>18978000
   UNRECOV'DATA     = (9:1)#,    <<UNRECOV DATA>>              <<03715>>18980000
   END'OF'FILE      =(11:1)#,    <<END OF FILE>>               <<03715>>18982000
   END'OF'VOLUME    =(12:1)#,    <<END OF VOLUME>>             <<03715>>18984000
                                                               <<03550>>18986000
             << INFOR'FIELD >>                                 <<03550>>18988000
                                                               <<03550>>18990000
   OPER'REL'REQST   = (0:1)#,    <<OPER RELEASE REQUEST>>      <<03715>>18992000
   DIAG'REL'REQST   = (1:1)#,    <<DIAG RELEASE REQUEST>>      <<03715>>18994000
   INT'MAINT'REQST  = (2:1)#,    <<INT MAINT REQUEST>>         <<03715>>18996000
   MEDIA'WEARING    = (3:1)#,    <<MEDIA WEARING OUT>>         <<03715>>18998000
   DATA'OVERRUN     = (4:1)#,    <<DATA OVERRUN>>              <<03715>>19000000
   DEF'BLK'SPARE    = (7:1)#,    <<DEFEC BLK AUTO SPARED>>     <<03715>>19002000
   RECOV'DATA'OV    = (9:1)#,    <<RECOV DATA OVERFLOW>>       <<03715>>19004000
   MARGINAL'DATA    =(10:1)#,    <<MARGINAL DATA>>             <<03715>>19006000
   RECOV'DATA       =(11:1)#,    <<RECOVERABLE DATA>>          <<03715>>19008000
   MAINT'TRK'OV     =(13:1)#;    <<MAINT TRACK OVERFLOW>>      <<03715>>19010000
                                                               <<03550>>19012000
INTEGER                                                        <<03550>>19014000
   DATA'BANK = BUF,     << BANK OF DATA BUFFER >>              <<03550>>19016000
   DATA'ADDR = BUF+1,   << BANK OFFSET OF DATA BUFFER >>       <<03550>>19018000
   OLD'STAT'ADDR,       << BANK OFFSET OF OLD'STAT >>          <<03668>>19020000
   STAT'ADDR,           << BANK OFFSET OF STATUS >>            <<03668>>19022000
   LOCAL'BUF'BANK,      << BANK OF LOCAL'BUF >>                <<03550>>19024000
   LOCAL'BUF'ADDR,      << BANK OFFSET OF LOCAL'BUF >>         <<03668>>19026000
   T'BANK,              << TEMP. FOR A BANK NO. >>             <<03668>>19028000
   T'ADDR,              << TEMP. FOR A BANK OFFSET >>          <<03668>>19030000
   CPADDRESS;           << BANK OFFSET OF CP >>                <<03550>>19032000
                                                               <<03550>>19034000
DOUBLE                                                         <<03550>>19036000
   OLDDB,         << SAVED DB ON ENTRY TO THE DRIVER >>        <<03672>>19038000
   STARTIME,      << STARTING TIMEOUT CLOCK VALUE >>           <<03672>>19040000
   CURTIME,       << CURRENT TIMEOUT CLOCK VALUE >>            <<03672>>19042000
   TIMEOUT;       << TIME-OUT VALUE IN MILLISECONDS >>         <<03672>>19044000
                                                               <<03550>>19046000
EQUATE                                                         <<03550>>19048000
   MAX'RETRIES = 25;    << MAXIMUM FOR NUM'RETRIES >>          <<03668>>19050000
                                                               <<03550>>19052000
INTEGER                                                        <<03550>>19054000
   NUM'RETRIES;      << NO. OF CHANNEL PROGRAMS RUN >>         <<03550>>19056000
                     <<    DURING THIS DRIVER CALL  >>         <<03550>>19058000
                                                               <<03550>>19060000
EQUATE                                                         <<03550>>19062000
   STACK'MAX = 0,       << INDEX OF TOP OF COMMAND STACK >>    <<03550>>19064000
   STACK'BOTTOM = 15,   << INDEX OF BOTTOM OF COMMAND STACK >> <<03550>>19066000
   STACK'BOTTOMX = STACK'BOTTOM+1;                             <<03550>>19068000
                                                               <<03550>>19070000
INTEGER                                                        <<03550>>19072000
   POINT := STACK'BOTTOMX;  <<STACK POINTER--INITIALLY EMPTY>> <<03550>>19074000
                                                               <<03550>>19076000
LOGICAL                                                        <<03550>>19078000
   GOOD'COMPLETION,       << TRUE IF CP COMPLETED W/0 ERROR >> <<03668>>19080000
   FIRST'OFFLINE := TRUE, << TRUE IF NOT OFF-LINE YET >>       <<03668>>19082000
   CURFUNCT,      << INDEX FOR CASE STATEMENT >>               <<03550>>19084000
   NEW'RCLK,      << LATEST VALUE OF RCLK >>                   <<03672>>19086000
   LAST'RCLK;     << PREVIOUS VALUE OF RCLK >>                 <<03672>>19088000
                                                               <<03550>>19090000
DOUBLE ARRAY                 << DISC TIMEOUTS FOR EACH      >> <<03672>>19092000
   DISC'TIMEOUT(*) = PB :=   <<   FUNCTION IN MILLISECONDS  >> <<03672>>19094000
<< 0- 4>> 5000D,5000D,0D,0D,0D,                                <<03672>>19096000
<< 5- 9>> 0D,5000D,0D,3000D,3000D,                             <<03672>>19098000
<<10-14>> 45000D,3000D,3000D,0D,5000D,                         <<03672>>19100000
<<15-19>> 15000D,15000D,3000D,15000D,5000D,                    <<03672>>19102000
<<20-24>> 5000D,5000D,45000D,15000D,3000D,                     <<03672>>19104000
<<25-26>> 3000D,0D;                                            <<03672>>19106000
                                                               <<03672>>19108000
DOUBLE ARRAY                 << LINUS TIMEOUTS FOR EACH     >> <<03672>>19110000
   TAPE'TIMEOUT(*) = PB :=   <<   FUNCTION IN MILLISECONDS  >> <<03672>>19112000
<< 0- 4>> 100000D,100000D,0D,0D,0D,                            <<03715>>19114000
<< 5- 9>> 0D,100000D,0D,200000D,12000D,                        <<03715>>19116000
<<10-14>> 100000D,15000D,15000D,0D,100000D,                    <<03715>>19118000
<<15-19>> 0D,0D,15000D,0D,0D,                                  <<03715>>19120000
<<20-24>> 0D,0D,200000D,0D,12000D,                             <<03715>>19122000
<<25-26>> 12000D,5000D;                                        <<03715>>19124000
                                                               <<03550>>19126000
BYTE POINTER                                                   <<03550>>19128000
   TEMP;    << TEMP FOR BYTE ADDRESSING >>                     <<03550>>19130000
                                                               <<03550>>19132000
INTEGER                                                        <<03550>>19134000
   COUNT,   << BYTE COUNT FOR READ/WRITE TRANSFERS >>          <<03550>>19136000
   ERROR,   << ERROR NUMBER >>                                 <<03550>>19138000
   PARM,    << TEMP >>                                         <<03550>>19140000
   I;       << TEMP >>                                         <<*DVR*>>19142000
                                                               <<03550>>19144000
ARRAY                                                          <<03550>>19146000
   STACK(STACK'MAX:STACK'BOTTOM),  << DRIVER COMMAND STACK >>  <<03550>>19148000
   LOCAL'BUF(0:18),        << LOCAL BUFFER >>                  <<03550>>19150000
   STATUS(0:9),            << LOCAL STATUS BUFFER >>           <<03550>>19152000
   OLD'STAT(0:9),               << BUFFER FOR SAVED STATUS >>  <<03668>>19154000
   CP(0:CPSIZE-1);         << LOCAL BUFFER FOR CHAN PROG >>    <<03550>>19156000
                                                               <<03550>>19158000
BYTE ARRAY                                                     <<03550>>19160000
   CPB(*) = CP;     << BYTE POINTER FOR CP >>                  <<03550>>19162000
                                                               <<03550>>19164000
$PAGE                                                          <<03550>>19166000
ARRAY CS80'CHAN'PROG(*) = PB :=                                <<03550>>19168000
                                                               <<03550>>19170000
        <<****************************>>                       <<03550>>19172000
        <<      CHANNEL PROGRAM       >>                       <<03550>>19174000
        <<****************************>>                       <<03550>>19176000
                                                               <<03550>>19178000
    << NOTE: A '*' NEXT TO A CHANNEL PROGRAM LOCATION >>       <<03550>>19180000
    << DENOTES A LOCATION WHICH IS (SOMETIMES)        >>       <<03550>>19182000
    << MODIFIED BEFORE EXECUTION.                     >>       <<03550>>19184000
                                                               <<03550>>19186000
<<   0>>       0,  << JUMP TO APPROPRIATE LOCATION >>          <<03550>>19188000
<<*  1>>       0,  << BRANCHPT >>                              <<03550>>19190000
                                                               <<03550>>19192000
  <<***************************************>>                  <<03550>>19194000
  <<   [DXFER] GENERAL PURPOSE COMMANDS    >>                  <<03550>>19196000
  << COMMAND--EXECUTION--REPORTING MESSAGE >>                  <<03550>>19198000
  <<***************************************>>                  <<03550>>19200000
                                                               <<03550>>19202000
<<   0>>   %2005,  << WRITE COMMAND MESSAGE >>                 <<03550>>19204000
<<*  1>>       0,  << COMMAND BUFFER LENGTH >>                 <<03550>>19206000
<<   2>>       0,  << NO BURST >>                              <<03550>>19208000
<<   3>>   %2000,  << COMMAND BUFFER BANK >>                   <<03550>>19210000
<<*  4>>       0,  << COMMAND BUFFER ABSOLUTE ADDRESS >>       <<03550>>19212000
                                                               <<03550>>19214000
<<   5>>   %1000,  << WAIT FOR // POLL RESPONSE >>             <<03550>>19216000
<<   6>>       0,                                              <<03550>>19218000
                                                               <<03550>>19220000
<<*  7>>   %1416,  << EXECUTION MESSAGE SECONDARY >>           <<03550>>19222000
<<*  8>>       0,  << # BYTES TO READ/WRITE >>                 <<03550>>19224000
<<   9>>       0,  << NO BURST >>                              <<03550>>19226000
<<* 10>>       0,  << DATA BANK >>                             <<03550>>19228000
<<* 11>>       0,  << DATA BUFFER ABSOLUTE ADDRESS >>          <<03550>>19230000
                                                               <<03550>>19232000
<<  12>>   %1000,  << WAIT FOR // POLL RESPONSE >>             <<03550>>19234000
<<  13>>       0,                                              <<03550>>19236000
                                                               <<03550>>19238000
<<  14>>   %2402,  << REPORTING MESSAGE >>                     <<03550>>19240000
<<  15>>       0,  << RETURN BYTE >>                           <<03550>>19242000
<<  16>>       0,  << NORMAL COMPLETION >>                     <<03550>>19244000
<<  17>>       2,  << HARD ERROR--REQUEST STATUS >>            <<03550>>19246000
<<  18>>      39,  << POWER ON OCCURRED >>                     <<03550>>19248000
                                                               <<03550>>19250000
<<  19>>    %600,  << INTERRUPT/HALT >>                        <<03550>>19252000
<<  20>>       0,  << HALT CODE OF 0 IN CPVA(0) >>             <<03550>>19254000
                                                               <<03550>>19256000
  <<********************************************>>             <<03550>>19258000
  <<  [STATX] STATUS INTERROGATION SECTION      >>             <<03550>>19260000
  << COMMAND--EXECUTION--REPORTING MESSAGE      >>             <<03550>>19262000
  <<********************************************>>             <<03550>>19264000
                                                               <<03550>>19266000
<<   0>>   %2005,  << COMMAND MESSAGE SECONDARY >>             <<03550>>19268000
<<   1>>       1,  << COMMAND BUFFER LENGTH >>                 <<03550>>19270000
<<   2>>       0,  << NO BURST >>                              <<03550>>19272000
<<   3>>   %2000,  << COMMAND BUFFER BANK >>                   <<03550>>19274000
<<*  4>>       0,  << COMMAND BUFFER ABSOLUTE ADDRESS >>       <<03550>>19276000
                                                               <<03550>>19278000
<<   5>>   %1000,  << WAIT FOR // POLL RESPONSE >>             <<03550>>19280000
<<   6>>       0,                                              <<03550>>19282000
                                                               <<03550>>19284000
<<   7>>   %1416,  << EXECUTION MESSAGE SECONDARY >>           <<03550>>19286000
<<   8>>      20,  << # STATUS BYTES TO READ >>                <<03550>>19288000
<<   9>>       0,  << NO BURST >>                              <<03550>>19290000
<<  10>>       0,  << DATA BANK >>                             <<03550>>19292000
<<* 11>>       0,  << DATA BUFFER ABSOLUTE ADDRESS >>          <<03550>>19294000
                                                               <<03550>>19296000
<<  12>>   %1000,  << WAIT FOR // POLL RESPONSE >>             <<03550>>19298000
<<  13>>       0,                                              <<03550>>19300000
                                                               <<03550>>19302000
<<  14>>   %2402,  << REPORTING MESSAGE SECONDARY >>           <<03550>>19304000
<<  15>>       0,  << RETURN BYTE >>                           <<03550>>19306000
<<  16>>       0,  << NORMAL COMPLETION >>                     <<03550>>19308000
<<  17>>       2,  << HARD ERROR--TERMINATE >>                 <<03550>>19310000
<<  18>>      18,  << POWER ON OCCURRED >>                     <<03668>>19312000
                                                               <<03550>>19314000
<<  19>>    %600,  << INTERRUPT/HALT >>                        <<03550>>19316000
<<* 20>>       1,  << HALT CODE OF 1 IN CPVA(0) >>             <<03550>>19318000
                                                               <<03550>>19320000
<<  21>>    %600,  << INTERRUPT/HALT >>                        <<03550>>19322000
<<* 22>>       3,  << HALT CODE OF 3 IN CPVA(0) >>             <<03672>>19324000
                                                               <<03550>>19326000
  <<************************************************>>         <<03550>>19328000
  << [DIAG] COMPLEMENTARY, GP, DIAG, TRANS COMMANDS >>         <<03550>>19330000
  << COMMAND/TRANS--REPORTING MESSAGE               >>         <<03550>>19332000
  <<************************************************>>         <<03550>>19334000
                                                               <<03550>>19336000
<<   0>>   %2005,  << WRITE COMMAND MESSAGE >>                 <<03550>>19338000
<<*  1>>       0,  << COMMAND BUFFER LENGTH >>                 <<03550>>19340000
<<   2>>       0,  << NO BURST >>                              <<03550>>19342000
<<   3>>   %2000,  << DATA BANK >>                             <<03550>>19344000
<<*  4>>       0,  << COMMAND BUFFER ABS ADDR >>               <<03550>>19346000
                                                               <<03550>>19348000
<<   5>>   %1000,  << WAIT FOR // POLL RESPONSE >>             <<03550>>19350000
<<   6>>       0,                                              <<03550>>19352000
                                                               <<03550>>19354000
<<   7>>   %2402,  << REPORTING MESSAGE SECONDARY >>           <<03550>>19356000
<<   8>>       0,  << RETURN BYTE >>                           <<03550>>19358000
<<*  9>>       0,  << NORMAL COMPLETION >>                     <<03550>>19360000
<<  10>>     -35,  << HARD ERROR--REQUEST STATUS >>            <<03550>>19362000
<<  11>>       2,  << POWER ON OCCURRED >>                     <<03668>>19364000
                                                               <<03550>>19366000
<<  12>>    %600,  << INTERRUPT/HALT >>                        <<03550>>19368000
<<* 13>>       0,  << HALT CODE OF 0 IN CPVA(0) >>             <<03550>>19370000
                                                               <<03550>>19372000
  <<****************************************>>                 <<03550>>19374000
  << [PON] SELECTED DEVICE CLEAR/PARITY     >>                 <<03550>>19376000
  << ENABLED ON POWER ON                    >>                 <<03550>>19378000
  <<****************************************>>                 <<03550>>19380000
                                                               <<03550>>19382000
<<   0>>   %4401,  << SEL. DEV. CLR/PARITY ON >>               <<03550>>19384000
<<   1>>       0,                                              <<03550>>19386000
                                                               <<03550>>19388000
<<   2>>   %1000,  << WAIT FOR // POLL RESPONSE >>             <<03550>>19390000
<<   3>>       0,                                              <<03550>>19392000
                                                               <<03550>>19394000
<<   4>>   %2402,  << REPORTING MESSAGE SECONDARY >>           <<03550>>19396000
<<   5>>       0,  << RETURN BYTE >>                           <<03550>>19398000
<<   6>>       0,  << NORMAL COMPLETION >>                     <<03550>>19400000
<<   7>>       0,  << HOLD OFF ON STATUS REQUEST >>            <<03550>>19402000
<<   8>>      -9,  << POWER ON--REDO DEV. CLR >>               <<03550>>19404000
                                                               <<03550>>19406000
<<   9>>    %600,  << INTERRUPT/HALT >>                        <<03550>>19408000
<<* 10>>       2,  << HALT CODE OF 2 IN CPVA(0) >>             <<03550>>19410000
                                                               <<03550>>19412000
  <<***************************************>>                  <<03550>>19414000
  << MISCELLANEOUS STORAGE AND CONSTANTS   >>                  <<03550>>19416000
  <<***************************************>>                  <<03550>>19418000
                                                               <<03550>>19420000
<<   0>>      -1,                                              <<03550>>19422000
<<   0>> [8/%15,8/0],  << READ STATUS COMMAND (LEFT BYTE)>>    <<03550>>19424000
                                                               <<03550>>19426000
<<   0>>  0,0,0,0,0,  << STATUS RETURN AREA >>                 <<03550>>19428000
<<   5>>  0,0,0,0,0,                                           <<03550>>19430000
                                                               <<03550>>19432000
<<*  0>>  0,0,0,0,0,  << COMMAND DATA BUFFER >>                <<03550>>19434000
<<*  5>>  0,0,0,0,0,                                           <<03550>>19436000
<<* 10>>  0,0,0,0,0;                                           <<03550>>19438000
                                                               <<03550>>19440000
                                                               <<03550>>19442000
$PAGE                                                          <<03550>>19444000
SUBROUTINE SET'CMD'BYTES( RECORD, COUNT);                      <<03550>>19446000
VALUE RECORD, COUNT;                                           <<03550>>19448000
DOUBLE                                                         <<03550>>19450000
   RECORD;      << LOGICAL DISC ADDRESS >>                     <<03550>>19452000
INTEGER                                                        <<03550>>19454000
   COUNT;       << NO. OF BYTES TO READ/WRITE >>               <<03550>>19456000
                                                               <<03550>>19458000
<< FILL COMMAND BUFFER FOR READ/WRITE COMMANDS >>              <<03550>>19460000
BEGIN                                                          <<03550>>19462000
CPB(CDB'AREA'BYTE+ 0) := CDB'SET'UNIT;                         <<03550>>19464000
CPB(CDB'AREA'BYTE+ 1) := CDB'SET'VOL;                          <<03550>>19466000
CPB(CDB'AREA'BYTE+ 2) := CDB'SET'SNGL'VEC;                     <<03550>>19468000
CPB(CDB'AREA'BYTE+ 3) := 0;                                    <<03550>>19470000
CPB(CDB'AREA'BYTE+ 4) := 0;                                    <<03550>>19472000
@TEMP := @RECORD&LSL(1);                                       <<03550>>19474000
CPB(CDB'AREA'BYTE+ 5) := TEMP(0);                              <<03550>>19476000
CPB(CDB'AREA'BYTE+ 6) := TEMP(1);                              <<03550>>19478000
CPB(CDB'AREA'BYTE+ 7) := TEMP(2);                              <<03550>>19480000
CPB(CDB'AREA'BYTE+ 8) := TEMP(3);                              <<03550>>19482000
CPB(CDB'AREA'BYTE+ 9) := CDB'SET'LENGTH;                       <<03550>>19484000
CPB(CDB'AREA'BYTE+10) := 0;                                    <<03550>>19486000
CPB(CDB'AREA'BYTE+11) := 0;                                    <<03550>>19488000
CPB(CDB'AREA'BYTE+12) := COUNT.(0:8);                          <<03550>>19490000
CPB(CDB'AREA'BYTE+13) := COUNT.(8:8);                          <<03550>>19492000
END;   << SET'CMD'BYTES >>                                     <<03550>>19494000
                                                               <<03550>>19496000
SUBROUTINE SET'FOR'ERRORS;                                     <<03550>>19498000
<< SET UP READ STATUS SECTION OF CHANNEL PROGRAM >>            <<03550>>19500000
<< IN CASE RETURN BYTE = 1                       >>            <<03550>>19502000
BEGIN                                                          <<03550>>19504000
CP(STATX'CMD'ADR) := CHAN'PROG'BASE + STAT'CDB;                <<03550>>19506000
CP(STATX'DATA'ADR) := CHAN'PROG'BASE + STAT'AREA;              <<03550>>19508000
END;   << SET'FOR'ERRORS >>                                    <<03550>>19510000
                                                               <<03550>>19512000
LOGICAL SUBROUTINE FATAL'FUNCT( FUNCT);                        <<03550>>19514000
VALUE FUNCT;                                                   <<03550>>19516000
LOGICAL                                                        <<03550>>19518000
      FUNCT;   << DRIVER FUNCTION CODE >>                      <<03550>>19520000
<< RETURNS TRUE IF THE CURRENT FUNCTION ('FUNCT') BEING  >>    <<03550>>19522000
<< PERFORMED BY THE DRIVER IS FATAL IF IT GETS AN        >>    <<03550>>19524000
<< UNRECOVERABLE ERROR.  NON-FATAL FUNCTIONS ENCOUNTERING>>    <<03550>>19526000
<< THE SAME ERROR WILL RETURN WITH CCL.                  >>    <<03550>>19528000
BEGIN                                                          <<03550>>19530000
IF FUNCT = RSTAT OR      << IS IT ONE OF THE NON-FATALS? >>    <<03550>>19532000
   FUNCT = CLEAR'STAT OR                                       <<03668>>19534000
   FUNCT = NON'FATAL'READ OR                                   <<03550>>19536000
   FUNCT = ENAB'RELEASE OR                                     <<03715>>19538000
   FUNCT = UNLOAD OR                                           <<03715>>19540000
   FUNCT = INIT'DEV THEN                                       <<03715>>19542000
   FATAL'FUNCT := FALSE     << YEP, NON-FATAL >>               <<03550>>19544000
                                                               <<03550>>19546000
ELSE                                                           <<03550>>19548000
   FATAL'FUNCT := TRUE;     << NOPE, IT'S CURTAINS >>          <<03550>>19550000
END;   << FATAL'FUNCT >>                                       <<03550>>19552000
                                                               <<03550>>19554000
INTEGER SUBROUTINE SET'BYTE'COUNT( WORDS);                     <<03550>>19556000
VALUE WORDS;                                                   <<03550>>19558000
INTEGER                                                        <<03550>>19560000
   WORDS;    << NO. OF WORDS TO TRANSFER >>                    <<03550>>19562000
<< CONVERT NO. OF WORDS TO NO. OF BYTES AND RETURN IT >>       <<03550>>19564000
BEGIN                                                          <<03550>>19566000
IF WORDS.(0:1) = 1 THEN       << IF WORD COUNT IS TOO >>       <<03550>>19568000
   ERRMESSAGE(M33,LDEV);      <<    LARGE, ABORT      >>       <<03550>>19570000
SET'BYTE'COUNT := WORDS&LSL(1);   <<    LOGICAL SHIFT HERE! >> <<03550>>19572000
END;   << SET'BYTE'COUNT >>                                    <<03550>>19574000
                                                               <<03550>>19576000
SUBROUTINE DESCRIBE'CP;                                        <<03550>>19578000
<< FILL CHANNEL PROGRAM WORDS FOR A DESCRIBE COMMAND >>        <<03550>>19580000
BEGIN                                                          <<03550>>19582000
CP(DX'CMD'MSGLEN) := 3;                                        <<03550>>19584000
CP(DX'CMD'AREA'ADR) := CHAN'PROG'BASE + CDB'AREA'WRD;          <<03550>>19586000
CP(DX'EXEC'SEC) := READ'EXEC'SEC;                              <<03550>>19588000
CP(DX'COUNT) := MAX'DESC'BYTE;                                 <<03550>>19590000
CP(DX'DATA'BANK).(8:8) := LOCAL'BUF'BANK;                      <<03550>>19592000
CP(DX'DATA'ADR) := LOCAL'BUF'ADDR;                             <<03550>>19594000
                                                               <<03550>>19596000
CPB(CDB'AREA'BYTE+ 0) := CDB'SET'UNIT;                         <<03550>>19598000
CPB(CDB'AREA'BYTE+ 1) := CDB'SET'VOL;                          <<03550>>19600000
CPB(CDB'AREA'BYTE+ 2) := CDB'DESCRIBE;                         <<03550>>19602000
                                                               <<03550>>19604000
CP(BRANCHPT) := DXFERCP;                                       <<03550>>19606000
END;   << DESCRIBE'CP >>                                       <<03550>>19608000
                                                               <<03550>>19610000
SUBROUTINE SPARE'CP(RETAIN);                                   <<03550>>19612000
VALUE RETAIN;                                                  <<03550>>19614000
LOGICAL                                                        <<03550>>19616000
   RETAIN;   << IF TRUE, SEND 'SPARE RETAINING DATA', >>       <<03550>>19618000
             <<  ELSE SEND 'SPARE NOT RETAINING DATA' >>       <<03550>>19620000
                                                               <<03550>>19622000
<< SETS UP A CHANNEL PROGRAM FOR EITHER 'SPARE RETAINING   >>  <<03550>>19624000
<< DATA' OR 'SPARE NOT RETAINING DATA', DEPENDING ON THE   >>  <<03550>>19626000
<< VALUE OF 'RETAIN'.                                      >>  <<03550>>19628000
BEGIN                                                          <<03550>>19630000
                                                               <<03550>>19632000
CPB(CDB'AREA'BYTE+ 0) := CDB'SET'UNIT;                         <<03550>>19634000
CPB(CDB'AREA'BYTE+ 1) := CDB'SET'SNGL'VEC;                     <<03550>>19636000
CPB(CDB'AREA'BYTE+ 2) := 0;                                    <<03550>>19638000
CPB(CDB'AREA'BYTE+ 3) := 0;                                    <<03550>>19640000
@TEMP := @RECORD&LSL(1);                                       <<03550>>19642000
CPB(CDB'AREA'BYTE+ 4) := TEMP(0);                              <<03550>>19644000
CPB(CDB'AREA'BYTE+ 5) := TEMP(1);                              <<03550>>19646000
CPB(CDB'AREA'BYTE+ 6) := TEMP(2);                              <<03550>>19648000
CPB(CDB'AREA'BYTE+ 7) := TEMP(3);                              <<03550>>19650000
CPB(CDB'AREA'BYTE+ 8) := CDB'SPARE'BLK;                        <<03550>>19652000
                                                               <<03550>>19654000
IF RETAIN THEN                                                 <<03550>>19656000
   CPB(CDB'AREA'BYTE+ 9) := 0       << RETAINING DATA >>       <<03550>>19658000
ELSE                                                           <<03550>>19660000
   CPB(CDB'AREA'BYTE+ 9) := 1;      << NOT RETAINING DATA >>   <<03550>>19662000
                                                               <<03550>>19664000
CP(DIAG'CMD'MSGLEN) := 10;                                     <<03550>>19666000
CP(DIAG'CMD'AREA'ADR) := CHAN'PROG'BASE + CDB'AREA'WRD;        <<03550>>19668000
                                                               <<03550>>19670000
<< SET UP SO THAT EVEN QSTAT OF 0 RETURNED FROM THE DRIVE >>   <<03550>>19672000
<< WILL CAUSE US TO READ STATUS.  WE DO THIS TO GET THE   >>   <<03550>>19674000
<< AFFECTED AREA OF THE SPARE OPERATION.                  >>   <<03550>>19676000
                                                               <<03550>>19678000
CP(DIAG'NORMAL'JUMP) := STATX - (DIAG'NORMAL'JUMP + 3);        <<03550>>19680000
                                                               <<03550>>19682000
CP(BRANCHPT) := DIAGCP;                                        <<03550>>19684000
END;   << SPARE'CP >>                                          <<03550>>19686000
                                                               <<03550>>19688000
SUBROUTINE MOVE'STATUS;                                        <<03550>>19690000
<< MOVE STATUS RETURN INTO LOCAL BUFFER >>                     <<03550>>19692000
BEGIN                                                          <<03550>>19694000
                                                               <<03668>>19696000
MABS( LOCAL'BUF'BANK, STAT'ADDR, 0,     << MOVE IT IN >>       <<03668>>19698000
      CHAN'PROG'BASE+STAT'AREA, STAT'SIZE);                    <<03668>>19700000
END;   << MOVE'STATUS >>                                       <<03550>>19702000
                                                               <<03550>>19704000
SUBROUTINE SET'STATUS'RETURN( NOT'READY);                      <<03550>>19706000
VALUE NOT'READY;                                               <<03550>>19708000
LOGICAL                                                        <<03550>>19710000
   NOT'READY;    << IF TRUE, SET STATUS TO 'NOT READY' >>      <<03550>>19712000
<< SETS THE RETURN FOR A READ STATUS (RSTAT) FUNCTION CALL >>  <<03550>>19714000
<< TO EITHER READY OR NOT READY.                           >>  <<03550>>19716000
BEGIN                                                          <<03550>>19718000
LOCAL'BUF(0) := 0;            << INITIALIZE LOCAL BUFFER >>    <<03550>>19720000
LOCAL'BUF(1) := 0;                                             <<03550>>19722000
LOCAL'BUF(1).NREADYF := NOT'READY;   << SET READY/NOT READY >> <<03550>>19724000
MABS( DATA'BANK,DATA'ADDR,    << COPY RETURN TO CALLER >>      <<03550>>19726000
      LOCAL'BUF'BANK,                                          <<03550>>19728000
      LOCAL'BUF'ADDR,2);                                       <<03550>>19730000
END;   << SET'STATUS'RETURN >>                                 <<03550>>19732000
                                                               <<03550>>19734000
SUBROUTINE ERT'CP(READ'ONLY);                                  <<03550>>19736000
VALUE READ'ONLY;                                               <<03550>>19738000
LOGICAL                                                        <<03550>>19740000
   READ'ONLY;     << IF TRUE THEN BUILD CP FOR READ-ONLY >>    <<03550>>19742000
                  << ERT, OTHERWISE READ/WRITE ERT       >>    <<03550>>19744000
<< BUILDS A CHANNEL PROGRAM TO DO EITHER A READ ONLY OR  >>    <<03550>>19746000
<< A READ/WRITE ERROR RATE TEST                          >>    <<03550>>19748000
BEGIN                                                          <<03550>>19750000
IF WC > 1 THEN        << IF AFFECTED AREA > SECTOR >>          <<03550>>19752000
   PARM := 1          <<    DO ERT ON WHOLE TRACK  >>          <<03550>>19754000
ELSE                                                           <<03550>>19756000
   PARM := 0;         << OTHERWISE JUST ON SECTOR  >>          <<03550>>19758000
                                                               <<03550>>19760000
CPB(CDB'AREA'BYTE+ 0) := CDB'SET'UNIT;                         <<03550>>19762000
CPB(CDB'AREA'BYTE+ 1) := CDB'SET'SNGL'VEC;                     <<03550>>19764000
CPB(CDB'AREA'BYTE+ 2) := 0;                                    <<03550>>19766000
CPB(CDB'AREA'BYTE+ 3) := 0;                                    <<03550>>19768000
@TEMP := @RECORD&LSL(1);                                       <<03550>>19770000
CPB(CDB'AREA'BYTE+ 4) := TEMP(0);                              <<03550>>19772000
CPB(CDB'AREA'BYTE+ 5) := TEMP(1);                              <<03550>>19774000
CPB(CDB'AREA'BYTE+ 6) := TEMP(2);                              <<03550>>19776000
CPB(CDB'AREA'BYTE+ 7) := TEMP(3);                              <<03550>>19778000
CPB(CDB'AREA'BYTE+ 8) := CDB'INIT'UTIL + 2;                    <<03550>>19780000
                                                               <<03550>>19782000
IF READ'ONLY THEN                                              <<03550>>19784000
   CPB(CDB'AREA'BYTE+ 9) := %311    << R/O ERT >>              <<03550>>19786000
ELSE                                                           <<03550>>19788000
   CPB(CDB'AREA'BYTE+ 9) := %310;   << PATTERN ERT >>          <<03550>>19790000
                                                               <<03550>>19792000
CPB(CDB'AREA'BYTE+10) := 5;      << LOOP >>                    <<03550>>19794000
CPB(CDB'AREA'BYTE+11) := 0;      << OFFSET >>                  <<03550>>19796000
CPB(CDB'AREA'BYTE+12) := 0;      << REPORT >>                  <<03550>>19798000
CPB(CDB'AREA'BYTE+13) := PARM;   << TEST AREA >>               <<03550>>19800000
CPB(CDB'AREA'BYTE+14) := 0;      << DATA SOURCE >>             <<03550>>19802000
                                                               <<03550>>19804000
IF READ'ONLY THEN                                              <<03550>>19806000
   CP(DX'CMD'MSGLEN) := 14                                     <<03550>>19808000
ELSE                                                           <<03550>>19810000
   CP(DX'CMD'MSGLEN) := 15;                                    <<03550>>19812000
                                                               <<03550>>19814000
CP(DX'CMD'AREA'ADR) := CHAN'PROG'BASE + CDB'AREA'WRD;          <<03550>>19816000
CP(DX'EXEC'SEC) := READ'EXEC'SEC;                              <<03550>>19818000
CP(DX'COUNT) := ERT'RETURN; << EXPECT 10 BYTES MAX. RETURN >>  <<03550>>19820000
CP(DX'DATA'BANK).(8:8) := LOCAL'BUF'BANK;                      <<03550>>19822000
CP(DX'DATA'ADR) := LOCAL'BUF'ADDR;                             <<03550>>19824000
                                                               <<03550>>19826000
CP(BRANCHPT) := DXFERCP;                                       <<03550>>19828000
END;   << ERT'CP >>                                            <<03550>>19830000
                                                               <<03550>>19832000
SUBROUTINE PUSH'STACK( ITEM);                                  <<03550>>19834000
VALUE ITEM;                                                    <<03550>>19836000
LOGICAL ITEM;   << ITEM TO BE STACKED >>                       <<03550>>19838000
<< PUSH A WORD ONTO THE DRIVER COMMAND STACK >>                <<03550>>19840000
BEGIN                                                          <<03550>>19842000
POINT := POINT - 1;                                            <<03550>>19844000
IF POINT < STACK'MAX THEN       << ABORT--DRIVER COMMAND   >>  <<03550>>19846000
   ERRMESSAGE( M31, LDEV, DRT, UNIT)    << STACK OVERFLOW  >>  <<03550>>19848000
ELSE                                                           <<03550>>19850000
   STACK(POINT) := ITEM;        << PUSH THE ITEM >>            <<03550>>19852000
END;   << PUSH'STACK >>                                        <<03550>>19854000
                                                               <<03550>>19856000
LOGICAL SUBROUTINE POP'STACK( ITEM);                           <<03550>>19858000
LOGICAL ITEM;   << RETURN ITEM >>                              <<03550>>19860000
<< RETURNS IN 'ITEM' THE TOP ELEMENT OF THE DRIVER   >>        <<03550>>19862000
<< COMMAND STACK AND POPS THAT ITEM.  IF THE STACK   >>        <<03550>>19864000
<< IS EMPTY, POP'STACK RETURNS FALSE, OTHERWISE TRUE.>>        <<03550>>19866000
BEGIN                                                          <<03550>>19868000
IF POINT > STACK'BOTTOM THEN    << STACK IS EMPTY >>           <<03550>>19870000
   BEGIN                                                       <<03550>>19872000
   POP'STACK := FALSE;                                         <<03550>>19874000
   RETURN;                                                     <<03550>>19876000
   END                                                         <<03550>>19878000
ELSE                                                           <<03550>>19880000
   BEGIN                        << SOMETHING ON THE STACK >>   <<03550>>19882000
   ITEM := STACK(POINT);        << GET THE ITEM >>             <<03550>>19884000
   POINT := POINT + 1;          << POP THE STACK >>            <<03550>>19886000
   POP'STACK := TRUE;                                          <<03550>>19888000
   END;                                                        <<03550>>19890000
END;   << POP'STACK >>                                         <<03550>>19892000
                                                               <<03668>>19894000
SUBROUTINE READ'CP(WC, RECORD, DATA'BANK, DATA'ADDR);          <<03668>>19896000
VALUE WC,RECORD,DATA'BANK,DATA'ADDR;                           <<03668>>19898000
INTEGER                                                        <<03668>>19900000
   WC,           << NO. OF WORDS TO READ >>                    <<03668>>19902000
   DATA'BANK,    << BANK OF READ BUFFER >>                     <<03668>>19904000
   DATA'ADDR;    << BANK OFFSET OF READ BUFFER >>              <<03668>>19906000
DOUBLE                                                         <<03668>>19908000
   RECORD;       << LOGICAL DISC ADDRESS >>                    <<03668>>19910000
<< CONSTRUCT A READ CHANNEL PROGRAM >>                         <<03668>>19912000
BEGIN                                                          <<03668>>19914000
COUNT := SET'BYTE'COUNT(WC);   <<  CONVERT WORD COUNT >>       <<03668>>19916000
                               <<     TO BYTE COUNT   >>       <<03668>>19918000
SET'CMD'BYTES(RECORD,COUNT);   << FILL COMMAND BUFFER >>       <<03668>>19920000
                                                               <<03668>>19922000
CP(DX'CMD'MSGLEN) := READ'MSGLEN;                              <<03668>>19924000
CP(DX'CMD'AREA'ADR) := CHAN'PROG'BASE + CDB'AREA'WRD;          <<03668>>19926000
                                                               <<03668>>19928000
IF COUNT = 0 THEN                                              <<03668>>19930000
   BEGIN                 << JUMP PAST EXECUTION   >>           <<03668>>19932000
   CP(DX'5) := 0;        <<     MESSAGE FOR ZERO- >>           <<03668>>19934000
   CP(DX'6) := 5;        <<     LENGTH READS      >>           <<03668>>19936000
   END                                                         <<03668>>19938000
ELSE                                                           <<03668>>19940000
   BEGIN                                                       <<03668>>19942000
   CP(DX'EXEC'SEC) := READ'EXEC'SEC;                           <<03668>>19944000
   CP(DX'COUNT) := COUNT;                                      <<03668>>19946000
   CP(DX'DATA'BANK).(8:8) := DATA'BANK;                        <<03668>>19948000
   CP(DX'DATA'ADR) := DATA'ADDR;                               <<03668>>19950000
   END;                                                        <<03668>>19952000
                                                               <<03668>>19954000
CPB(CDB'AREA'BYTE+14) := CDB'READ;                             <<03668>>19956000
                                                               <<03668>>19958000
CP(BRANCHPT) := DXFERCP;                                       <<03668>>19960000
END;   << READ'CP >>                                           <<03668>>19962000
                                                               <<03668>>19964000
SUBROUTINE WRITE'CP(WC, RECORD, DATA'BANK, DATA'ADDR);         <<03668>>19966000
VALUE WC,RECORD,DATA'BANK,DATA'ADDR;                           <<03668>>19968000
INTEGER                                                        <<03668>>19970000
   WC,             << NO. OF WORDS TO WRITE >>                 <<03668>>19972000
   DATA'BANK,      << BANK NO. OF WRITE BUFFER >>              <<03668>>19974000
   DATA'ADDR;      << BANK OFFSET OF WRITE BUFFER >>           <<03668>>19976000
DOUBLE                                                         <<03668>>19978000
   RECORD;         << LOGICAL DISC ADDRESS >>                  <<03668>>19980000
<< CONSTRUCT A WRITE CHANNEL PROGRAM >>                        <<03668>>19982000
BEGIN                                                          <<03668>>19984000
COUNT := SET'BYTE'COUNT(WC);   <<  CONVERT WORD COUNT >>       <<03668>>19986000
                               <<     TO BYTE COUNT   >>       <<03668>>19988000
SET'CMD'BYTES(RECORD,COUNT);   << FILL COMMAND BUFFER >>       <<03668>>19990000
                                                               <<03668>>19992000
CP(DX'CMD'MSGLEN) := WRITE'MSGLEN;                             <<03668>>19994000
CP(DX'CMD'AREA'ADR) := CHAN'PROG'BASE + CDB'AREA'WRD;          <<03668>>19996000
                                                               <<03668>>19998000
IF COUNT = 0 THEN                                              <<03668>>20000000
   BEGIN                 << JUMP PAST EXECUTION   >>           <<03668>>20002000
   CP(DX'5) := 0;        <<     MESSAGE FOR ZERO- >>           <<03668>>20004000
   CP(DX'6) := 5;        <<     LENGTH WRITES     >>           <<03668>>20006000
   END                                                         <<03668>>20008000
ELSE                                                           <<03668>>20010000
   BEGIN                                                       <<03668>>20012000
   CP(DX'EXEC'SEC) := WRITE'EXEC'SEC;                          <<03668>>20014000
   CP(DX'COUNT) := COUNT;                                      <<03668>>20016000
   CP(DX'DATA'BANK).(8:8) := DATA'BANK;                        <<03668>>20018000
   CP(DX'DATA'ADR) := DATA'ADDR;                               <<03668>>20020000
   END;                                                        <<03668>>20022000
                                                               <<03668>>20024000
CPB(CDB'AREA'BYTE+14) := CDB'WRITE;                            <<03668>>20026000
                                                               <<03668>>20028000
CP(BRANCHPT) := DXFERCP;                                       <<03668>>20030000
END;   << WRITE'CP >>                                          <<03668>>20032000
                                                               <<03668>>20034000
SUBROUTINE ADD'DSCT'ENTRY( DSCT, WORD1, WORD2);                <<03668>>20036000
INTEGER ARRAY                                                  <<03668>>20038000
   DSCT;      << DEFECTIVE SECTOR TABLE >>                     <<03668>>20040000
INTEGER                                                        <<03668>>20042000
   WORD1,     << HIGH ORDER WORD OF DISC ADDRESS >>            <<03668>>20044000
   WORD2;     << LOW ORDER WORD OF DISC ADDRESS >>             <<03668>>20046000
<< ADDS AN ENTRY TO THE GIVEN DEFECTIVE SECTOR TABLE, >>       <<03668>>20048000
<< IF THERE IS ROOM AND IF THERE IS NOT ALREADY AN    >>       <<03668>>20050000
<< ENTRY FOR THE GIVEN ADDRESS.                       >>       <<03668>>20052000
BEGIN                                                          <<03668>>20054000
IF DSCT( DSCT'NUM'ENTRIES) < MAX'DSCT THEN                     <<03668>>20056000
   BEGIN           << THERE IS SOME EMPTY SPACE IN THE DSCT >> <<03668>>20058000
                                                               <<03668>>20060000
   I := 0;                                                     <<03668>>20062000
   PARM := DSCT(DSCT'FIRST'ENTRY);                             <<03668>>20064000
   WHILE I < DSCT(DSCT'NUM'ENTRIES) DO    << SCAN FOR       >> <<03668>>20066000
      BEGIN                               <<    DUPLICATES  >> <<03668>>20068000
                                                               <<03668>>20070000
      IF DSCT(PARM)   = WORD1 AND     << IF DUPLICATE ENTRY >> <<03668>>20072000
         DSCT(PARM+1) = WORD2 THEN    <<     JUST RETURN    >> <<03668>>20074000
         RETURN;                                               <<03668>>20076000
                                                               <<03668>>20078000
      I := I + 1;                                              <<03668>>20080000
      PARM := PARM + DSCT(DSCT'ENTRY'SIZE);                    <<03668>>20082000
      END;                                                     <<03668>>20084000
                                                               <<03668>>20086000
   DSCT(PARM) := WORD1;        << NO DUPLICATES FOUND--    >>  <<03668>>20088000
   DSCT(PARM + 1) := WORD2;    <<    INSERT NEW ENTRY.     >>  <<03668>>20090000
   DSCT(DSCT'NUM'ENTRIES) := DSCT(DSCT'NUM'ENTRIES) + 1;       <<03668>>20092000
   END;                                                        <<03668>>20094000
END;   << ADD'DSCT'ENTRY >>                                    <<03668>>20096000
                                                               <<03668>>20098000
SUBROUTINE OFFLINE;                                            <<03668>>20100000
<< HANDLES OFF-LINE DEVICE--WAITS 1 SECOND THEN READS   >>     <<03668>>20102000
<< STATUS AGAIN TO SEE IF DEVICE IS ON-LINE.            >>     <<03668>>20104000
BEGIN                                                          <<03668>>20106000
IF FIRST'OFFLINE THEN                                          <<03668>>20108000
   BEGIN                                                       <<03668>>20110000
   FIRST'OFFLINE := FALSE;    << RESET FLAG >>                 <<03668>>20112000
   PUSH'STACK(CURFUNCT);      << SAVE THE CURRENT FUNCTION >>  <<03668>>20114000
   MESSAGE( M2408, LDEV);     << LDEV #N NOT READY >>          <<03668>>20116000
   END;                                                        <<03668>>20118000
                                                               <<03668>>20120000
NUM'RETRIES := 0;          << UNLIMITED RETRIES >>             <<03668>>20122000
DELAY(1000D);              << DELAY 1 SECOND >>                <<03715>>20124000
PUSH'STACK(GET'STAT);      << TRY READING STATUS AGAIN >>      <<03668>>20126000
END;   << OFFLINE >>                                           <<03668>>20128000
                                                               <<03668>>20130000
SUBROUTINE RSTAT'CP( CLEARING);                                <<03668>>20132000
VALUE CLEARING;                                                <<03668>>20134000
LOGICAL                                                        <<03668>>20136000
   CLEARING;      << IF TRUE, READ AND CLEAR STATUS >>         <<03668>>20138000
<< SET UP CHANNEL PROGRAM TO READ STATUS.  IN ORDER TO GET >>  <<03668>>20140000
<< AN ACCURATE DEVICE READY/NOT READY BIT, WE MUST DO A    >>  <<03668>>20142000
<< ZERO-LENGTH WRITE.  IF WE GET A DSJ OF 1 ON THIS WRITE, >>  <<03668>>20144000
<< WE WILL READ STATUS, OTHERWISE THERE ARE NO STATUS      >>  <<03668>>20146000
<< CONDITIONS.  IF CLEARING IS TRUE, SET UP CHANNEL PROG.  >>  <<03668>>20148000
<< SO THAT STATUS WILL NOT BE INTERROGATED AFTER THE       >>  <<03668>>20150000
<< CHANNEL PROGRAM COMPLETES.                              >>  <<03668>>20152000
BEGIN                                                          <<03668>>20154000
                                                               <<03668>>20156000
CPB(CDB'AREA'BYTE+ 0) := CDB'SET'UNIT;                         <<03668>>20158000
CPB(CDB'AREA'BYTE+ 1) := CDB'SET'LENGTH;                       <<03668>>20160000
CPB(CDB'AREA'BYTE+ 2) := 0;                                    <<03668>>20162000
CPB(CDB'AREA'BYTE+ 3) := 0;    << GIVE IT A LENGTH >>          <<03668>>20164000
CPB(CDB'AREA'BYTE+ 4) := 0;    <<    OF ZERO       >>          <<03668>>20166000
CPB(CDB'AREA'BYTE+ 5) := 0;                                    <<03668>>20168000
CPB(CDB'AREA'BYTE+ 6) := CDB'WRITE;                            <<03668>>20170000
                                                               <<03668>>20172000
CP(DIAG'CMD'MSGLEN) := 7;                                      <<03668>>20174000
CP(DIAG'CMD'AREA'ADR) := CHAN'PROG'BASE + CDB'AREA'WRD;        <<03668>>20176000
                                                               <<03668>>20178000
<< SET UP SO WE WON'T INTERROGATE THE STATUS RETURN >>         <<03668>>20180000
<<    IF WE DO READ IT                              >>         <<03668>>20182000
                                                               <<03668>>20184000
IF CLEARING THEN                                               <<03668>>20186000
   BEGIN                                                       <<03672>>20188000
   CP(STATX'HALT'CODE) := 0;                                   <<03668>>20190000
   CP(STATX'FAIL'CODE) := 0;                                   <<03672>>20192000
   END;                                                        <<03672>>20194000
                                                               <<03668>>20196000
CP(BRANCHPT) := DIAGCP;                                        <<03668>>20198000
END;   << RSTAT'CP >>                                          <<03668>>20200000
                                                               <<03672>>20202000
SUBROUTINE RELEASE'CP( ALLOW);                                 <<03672>>20204000
VALUE ALLOW;                                                   <<03672>>20206000
LOGICAL                                                        <<03672>>20208000
   ALLOW;   << IF TRUE SEND RELEASE, OTHERWISE DENY RELEASE >> <<03672>>20210000
<< BUILDS A CHANNEL PROGRAM TO DO EITHER A RELEASE OR >>       <<03672>>20212000
<< DENY RELEASE, DEPENDING ON THE VALUE OF ALLOW      >>       <<03672>>20214000
BEGIN                                                          <<03672>>20216000
CPB(CDB'AREA'BYTE+ 0) := CDB'SET'UNIT + CTRL'UNIT;             <<03672>>20218000
CPB(CDB'AREA'BYTE+ 1) := IF ALLOW THEN CDB'RELEASE             <<03672>>20220000
                                  ELSE CDB'RELEASE'DENY;       <<03672>>20222000
CP(DIAG'CMD'MSGLEN) := 2;                                      <<03672>>20224000
CP(DIAG'CMD'AREA'ADR) := CHAN'PROG'BASE + CDB'AREA'WRD;        <<03672>>20226000
CP(BRANCHPT) := DIAGCP;                                        <<03672>>20228000
END;   << RELEASE'CP >>                                        <<03672>>20230000
                                                               <<03672>>20232000
SUBROUTINE SET'RELEASE'CP( SUPPRESS);                          <<03672>>20234000
VALUE SUPPRESS;                                                <<03672>>20236000
LOGICAL                                                        <<03672>>20238000
   SUPPRESS;   << IF TRUE SUPPRESS RELEASE TIMEOUT >>          <<03672>>20240000
<< BUILDS CHANNEL PROGRAM TO SET RELEASE MODE >>               <<03672>>20242000
BEGIN                                                          <<03672>>20244000
CPB(CDB'AREA'BYTE+ 0) := CDB'SET'UNIT + CTRL'UNIT;             <<03672>>20246000
CPB(CDB'AREA'BYTE+ 1) := CDB'SET'RELEASE;                      <<03672>>20248000
CPB(CDB'AREA'BYTE+ 2) := 0;                                    <<03672>>20250000
IF SUPPRESS THEN                                               <<03672>>20252000
   CPB(CDB'AREA'BYTE+ 2) := %200;    << SUPPRESS RELEASE >>    <<03672>>20254000
CP(DIAG'CMD'MSGLEN) := 3;                                      <<03672>>20256000
CP(DIAG'CMD'AREA'ADR) := CHAN'PROG'BASE + CDB'AREA'WRD;        <<03672>>20258000
                                                               <<03672>>20260000
CP(BRANCHPT) := DIAGCP;                                        <<03672>>20262000
END;   << SET'RELEASE'CP >>                                    <<03672>>20264000
                                                               <<03550>>20266000
LOGICAL SUBROUTINE SETUP'STACK( FUNCT);                        <<03550>>20268000
VALUE FUNCT;                                                   <<03550>>20270000
LOGICAL FUNCT;   << FUNCTION TO BE PERFORMED >>                <<03550>>20272000
<< PUT SEQUENCE OF SUBFUNCTIONS TO PERFORM THE GIVEN  >>       <<03550>>20274000
<< FUNCTION ON THE COMMAND STACK                      >>       <<03550>>20276000
BEGIN                                                          <<03550>>20278000
SETUP'STACK := TRUE;     << INITIALIZE RETURN VALUE >>         <<03550>>20280000
IF (0 <= INTEGER(FUNCT) <= MAX'FUNCT) THEN                     <<03550>>20282000
   BEGIN                                                       <<03550>>20284000
   CASE FUNCT OF                                               <<03550>>20286000
      BEGIN                                                    <<03550>>20288000
      <<  0 >> PUSH'STACK(READ);       << READ >>              <<03550>>20290000
      <<  1 >> PUSH'STACK(WRITE);      << WRITE >>             <<03550>>20292000
      <<  2 >> SETUP'STACK := FALSE;   << NOT USED >>          <<03550>>20294000
      <<  3 >> SETUP'STACK := FALSE;   << NOT USED >>          <<03550>>20296000
      <<  4 >> SETUP'STACK := FALSE;   << NOT USED >>          <<03550>>20298000
      <<  5 >> BEGIN                   << READ STATUS >>       <<03668>>20300000
               SET'STATUS'RETURN(                              <<03668>>20302000
                  TRUE);                                       <<03668>>20304000
               PUSH'STACK(                                     <<03668>>20306000
                  CLEAR'STAT);                                 <<03668>>20308000
               END;                                            <<03668>>20310000
      <<  6 >> BEGIN                   << NON-FATAL READ >>    <<03550>>20312000
               PUSH'STACK(                                     <<03668>>20314000
                  NON'FATAL'READ);                             <<03668>>20316000
               PUSH'STACK(                                     <<03668>>20318000
                  CLEAR'STAT);                                 <<03668>>20320000
               END;                                            <<03550>>20322000
      <<  7 >> BEGIN                   << INITIALIZE >>        <<03550>>20324000
               PUSH'STACK(CLEAR);      <<    DISC    >>        <<03672>>20326000
               PUSH'STACK(                                     <<03668>>20328000
                  CLEAR'STAT);                                 <<03668>>20330000
               END;                                            <<03550>>20332000
      <<  8 >> SETUP'STACK := FALSE;   << RELEASE--        >>  <<03672>>20334000
                                       <<    INTERNAL ONLY >>  <<03672>>20336000
      <<  9 >> SETUP'STACK := FALSE;   << DENY RELEASE--   >>  <<03672>>20338000
                                       <<    INTERNAL ONLY >>  <<03672>>20340000
      << 10 >> PUSH'STACK(CLEAR);      << DEVICE CLEAR >>      <<03550>>20342000
      << 11 >> PUSH'STACK(             << SUPPRESS RELEASE >>  <<03672>>20344000
                  SUPP'RELEASE);       <<     TIMEOUT      >>  <<03672>>20346000
      << 12 >> PUSH'STACK(             << ENABLE RELEASE >>    <<03672>>20348000
                  ENAB'RELEASE);       <<     TIMEOUT    >>    <<03672>>20350000
      << 13 >> PUSH'STACK(DESCRIBE);   << GET VOLUME LIMIT >>  <<03550>>20352000
      << 14 >> PUSH'STACK(             << RECOVERY READ >>     <<03668>>20354000
                  RECOV'READ);                                 <<03668>>20356000
      << 15 >> PUSH'STACK(             << SPARE RETAINING >>   <<03550>>20358000
                  SPARE'RETAIN);       <<     DATA        >>   <<03550>>20360000
      << 16 >> PUSH'STACK(             << SPARE NOT       >>   <<03550>>20362000
                  SPARE'NO'RETAIN);    <<  RETAINING DATA >>   <<03550>>20364000
      << 17 >> PUSH'STACK(DESCRIBE);   << DESCRIBE >>          <<03550>>20366000
      << 18 >> PUSH'STACK(RW'ERT);     << R/W ERT >>           <<03550>>20368000
      << 19 >> PUSH'STACK(             << READ SPARE TABLE >>  <<03630>>20370000
                  READ'SPARES);                                <<03630>>20372000
      << 20 >> SETUP'STACK := FALSE;   << READ DSCT--      >>  <<03672>>20374000
                                       <<    INTERNAL ONLY >>  <<03672>>20376000
      << 21 >> SETUP'STACK := FALSE;   << WRITE DSCT--     >>  <<03672>>20378000
                                       <<    INTERNAL ONLY >>  <<03672>>20380000
      << 22 >> PUSH'STACK(             << PERFORM DIAGNOSTIC >><<03550>>20382000
                  DIAGNOSTIC);                                 <<03550>>20384000
      << 23 >> PUSH'STACK(RO'ERT);     << R/O ERT >>           <<03550>>20386000
      << 24 >> PUSH'STACK(             << READ, CLEAR STATUS >><<03668>>20388000
                  CLEAR'STAT);                                 <<03668>>20390000
      << 25 >> SETUP'STACK := FALSE;   << READ STATUS--    >>  <<03672>>20392000
                                       <<    INTERNAL ONLY >>  <<03672>>20394000
      << 26 >> PUSH'STACK(UNLOAD);     << UNLOAD TAPE >>       <<03672>>20396000
      END;                                                     <<03550>>20398000
   END                                                         <<03550>>20400000
                                                               <<03550>>20402000
ELSE                                                           <<03550>>20404000
   SETUP'STACK := FALSE;         << FUNCTION NOT USED >>       <<03550>>20406000
END;  << SETUP'STACK >>                                        <<03550>>20408000
$PAGE                                                          <<03550>>20410000
                                                               <<03550>>20412000
<< SET DB TO INITIAL'S STACK, UNLESS WE ARE ON THE ICS. >>     <<03614>>20414000
<< IN THAT CASE, WE SET IT TO Q-INITIAL OF THE ICS.     >>     <<03614>>20416000
                                                               <<03614>>20418000
IF ON'ICS THEN        << RUNNING ON THE ICS >>                 <<03614>>20420000
   BEGIN                                                       <<03614>>20422000
   TOS := 0;           << BANK 0 >>                            <<03614>>20424000
   TOS := ABS(QI);     << DB REGISTER TO QI >>                 <<03614>>20426000
   END                                                         <<03614>>20428000
ELSE                                                           <<03550>>20430000
   BEGIN                       << SET UP TO POINT DB AT >>     <<03550>>20432000
   TOS := ABSOLUTE(DBBANK);    <<    INITIAL'S STACK    >>     <<03550>>20434000
   TOS := ABSOLUTE(DB);                                        <<03550>>20436000
   END;                                                        <<03550>>20438000
ASSEMBLE(XCHD);                << SWITCH DB, BUT      >>       <<03550>>20440000
OLDDB := TOS;                  <<    SAVE THE OLD ONE >>       <<03550>>20442000
                                                               <<03550>>20444000
PUSH(DB);              << COMPUTE ABS. ADDRESS OF     >>       <<03550>>20446000
CPADDRESS := TOS+@CP;  <<    LOCAL CHANNEL PROGRAM    >>       <<03550>>20448000
LOCAL'BUF'BANK := TOS; <<    BUFFER                   >>       <<03668>>20450000
                                                               <<03550>>20452000
PUSH(DB);                   << COMPUTE ABS. ADDRESS OF >>      <<03550>>20454000
LOCAL'BUF'ADDR := TOS + @LOCAL'BUF;    << LOCAL'BUF    >>      <<03550>>20456000
LOCAL'BUF'BANK := TOS;                                         <<03550>>20458000
                                                               <<03668>>20460000
PUSH(DB);                    << COMPUTE ABS. ADDRESS >>        <<03668>>20462000
STAT'ADDR := TOS+@STATUS;    <<   OF STATUS BUFFER   >>        <<03668>>20464000
LOCAL'BUF'BANK := TOS;                                         <<03668>>20466000
                                                               <<03668>>20468000
PUSH(DB);                          << COMPUTE ABS. ADDRESS >>  <<03668>>20470000
OLD'STAT'ADDR := TOS+@OLD'STAT;    << OF OLD STATUS BUFFER >>  <<03668>>20472000
LOCAL'BUF'BANK := TOS;                                         <<03668>>20474000
                                                               <<03550>>20476000
CC := CCE;     << INITIALIZE CONDITION CODE RETURN >>          <<03550>>20478000
                                                               <<03550>>20480000
                                                               <<03550>>20482000
IF NOT SETUP'STACK(FUNCT) THEN      << SET UP THE DRIVER  >>   <<03550>>20484000
   GO FUNCT'ERROR;                  <<      COMMAND STACK >>   <<03550>>20486000
                                                               <<03550>>20488000
NUM'RETRIES := 0;     << INITIALIZE RETRY COUNT >>             <<03550>>20490000
                                                               <<03550>>20492000
WHILE POP'STACK(CURFUNCT) AND    << DO WHILE MORE FUNCTIONS >> <<03550>>20494000
      NUM'RETRIES <= MAX'RETRIES DO    <<   AND RETRIES NOT >> <<03550>>20496000
                                       <<   EXCEEDED        >> <<03550>>20498000
   BEGIN                                                       <<03550>>20500000
                                                               <<03550>>20502000
   NUM'RETRIES := NUM'RETRIES + 1;   <<INCREMENT RETRY COUNT>> <<03550>>20504000
                                                               <<03550>>20506000
   << MOVE CHANNEL PROGRAM TO Q-RELATIVE BUFFER >>             <<03550>>20508000
   MOVE CP := CS80'CHAN'PROG,(CPSIZE);                         <<03550>>20510000
                                                               <<03550>>20512000
   << SET UP CHANNEL PROGRAM TO HANDLE ERRORS >>               <<03550>>20514000
   SET'FOR'ERRORS;                                             <<03550>>20516000
                                                               <<03550>>20518000
$PAGE                                                          <<03550>>20520000
   CASE CURFUNCT OF          << SET UP CHANNEL PROGRAM FOR  >> <<03550>>20522000
      BEGIN                  <<     THE CURRENT FUNCTION    >> <<03550>>20524000
                                                               <<03550>>20526000
      <<********************************>>                     <<03550>>20528000
      <<  0      READ                   >>                     <<03550>>20530000
      <<********************************>>                     <<03550>>20532000
                                                               <<03550>>20534000
      BEGIN                                                    <<03550>>20536000
      READ'CP( WC, RECORD, DATA'BANK, DATA'ADDR);              <<03668>>20538000
      END;                                                     <<03668>>20540000
                                                               <<03668>>20542000
                                                               <<03550>>20544000
      <<*******************************>>                      <<03550>>20546000
      <<  1        WRITE               >>                      <<03550>>20548000
      <<*******************************>>                      <<03550>>20550000
                                                               <<03550>>20552000
      BEGIN                                                    <<03550>>20554000
      WRITE'CP( WC, RECORD, DATA'BANK, DATA'ADDR);             <<03668>>20556000
      END;                                                     <<03668>>20558000
                                                               <<03668>>20560000
                                                               <<03550>>20562000
      BEGIN      <<  2 >>                                      <<03550>>20564000
      GO FUNCT'ERROR;                                          <<03550>>20566000
      END;                                                     <<03550>>20568000
                                                               <<03550>>20570000
      BEGIN      <<  3 >>                                      <<03550>>20572000
      GO FUNCT'ERROR;                                          <<03550>>20574000
      END;                                                     <<03550>>20576000
                                                               <<03550>>20578000
      BEGIN      <<  4 >>                                      <<03550>>20580000
      GO FUNCT'ERROR;                                          <<03550>>20582000
      END;                                                     <<03550>>20584000
                                                               <<03550>>20586000
                                                               <<03550>>20588000
      BEGIN      <<  5 >>                                      <<03668>>20590000
      GO FUNCT'ERROR;                                          <<03668>>20592000
      END;                                                     <<03668>>20594000
                                                               <<03668>>20596000
                                                               <<03550>>20598000
      <<**********************************>>                   <<03668>>20600000
      <<  6      NON-FATAL READ           >>                   <<03668>>20602000
      <<**********************************>>                   <<03668>>20604000
                                                               <<03668>>20606000
      BEGIN                                                    <<03668>>20608000
      READ'CP( WC, RECORD, DATA'BANK, DATA'ADDR);              <<03668>>20610000
      END;                                                     <<03550>>20612000
                                                               <<03550>>20614000
      BEGIN     <<  7 >>                                       <<03550>>20616000
      GO FUNCT'ERROR;                                          <<03550>>20618000
      END;                                                     <<03550>>20620000
                                                               <<03550>>20622000
      <<*********************************>>                    <<03550>>20624000
      <<  8        RELEASE               >>                    <<03550>>20626000
      <<*********************************>>                    <<03550>>20628000
                                                               <<03550>>20630000
      BEGIN                                                    <<03550>>20632000
      RELEASE'CP(TRUE);                                        <<03672>>20634000
      END;                                                     <<03550>>20636000
                                                               <<03550>>20638000
      <<***********************************>>                  <<03550>>20640000
      <<  9        DENY RELEASE            >>                  <<03550>>20642000
      <<***********************************>>                  <<03550>>20644000
                                                               <<03550>>20646000
      BEGIN                                                    <<03550>>20648000
      RELEASE'CP(FALSE);                                       <<03672>>20650000
      END;                                                     <<03550>>20652000
                                                               <<03550>>20654000
      <<************************************>>                 <<03550>>20656000
      <<  10       DEVICE CLEAR             >>                 <<03550>>20658000
      <<************************************>>                 <<03550>>20660000
                                                               <<03550>>20662000
      BEGIN                                                    <<03550>>20664000
      CP(PON'HALT'CODE) := 0;                                  <<03550>>20666000
      CP(BRANCHPT) := PONCP;                                   <<03550>>20668000
      END;                                                     <<03550>>20670000
                                                               <<03550>>20672000
      <<*************************************>>                <<03550>>20674000
      <<  11    SUPPRESS RELEASE TIMEOUT     >>                <<03550>>20676000
      <<*************************************>>                <<03550>>20678000
                                                               <<03550>>20680000
      BEGIN                                                    <<03550>>20682000
      SET'RELEASE'CP(TRUE);                                    <<03672>>20684000
      END;                                                     <<03550>>20686000
                                                               <<03550>>20688000
      <<**************************************>>               <<03672>>20690000
      <<  12    ENABLE RELEASE TIMEOUT        >>               <<03672>>20692000
      <<**************************************>>               <<03672>>20694000
                                                               <<03672>>20696000
      BEGIN                                                    <<03672>>20698000
      SET'RELEASE'CP(FALSE);                                   <<03672>>20700000
      END;                                                     <<03550>>20702000
                                                               <<03550>>20704000
      BEGIN     << 13 >>                                       <<03550>>20706000
      GO FUNCT'ERROR;                                          <<03550>>20708000
      END;                                                     <<03550>>20710000
                                                               <<03550>>20712000
      <<*************************************>>                <<03668>>20714000
      <<  14         RECOVERY READ           >>                <<03668>>20716000
      <<*************************************>>                <<03668>>20718000
                                                               <<03668>>20720000
      BEGIN                                                    <<03668>>20722000
      READ'CP( WC, RECORD, DATA'BANK, DATA'ADDR);              <<03668>>20724000
      END;                                                     <<03550>>20726000
                                                               <<03550>>20728000
      <<*******************************************>>          <<03550>>20730000
      <<  15      SPARE RETAINING DATA             >>          <<03550>>20732000
      <<*******************************************>>          <<03550>>20734000
                                                               <<03550>>20736000
      BEGIN                                                    <<03550>>20738000
      SPARE'CP(TRUE);                                          <<03550>>20740000
      END;                                                     <<03550>>20742000
                                                               <<03550>>20744000
      <<*******************************************>>          <<03550>>20746000
      <<  16      SPARE NOT RETAINING DATA         >>          <<03550>>20748000
      <<*******************************************>>          <<03550>>20750000
                                                               <<03550>>20752000
      BEGIN                                                    <<03550>>20754000
      SPARE'CP(FALSE);                                         <<03550>>20756000
      END;                                                     <<03550>>20758000
                                                               <<03550>>20760000
      <<*******************************************>>          <<03550>>20762000
      <<  17           DESCRIBE                    >>          <<03550>>20764000
      <<*******************************************>>          <<03550>>20766000
                                                               <<03550>>20768000
      BEGIN                                                    <<03550>>20770000
      DESCRIBE'CP;                                             <<03550>>20772000
      END;                                                     <<03550>>20774000
                                                               <<03550>>20776000
      <<*******************************************>>          <<03550>>20778000
      <<  18   READ/WRITE ERROR RATE TEST          >>          <<03550>>20780000
      <<*******************************************>>          <<03550>>20782000
                                                               <<03550>>20784000
      BEGIN                                                    <<03550>>20786000
      ERT'CP(FALSE);                                           <<03550>>20788000
      END;                                                     <<03550>>20790000
                                                               <<03550>>20792000
      <<**************************************>>               <<03550>>20794000
      <<  19      READ SPARE TABLE            >>               <<03550>>20796000
      <<**************************************>>               <<03550>>20798000
                                                               <<03550>>20800000
      BEGIN                                                    <<03550>>20802000
                                                               <<03550>>20804000
      CPB(CDB'AREA'BYTE+ 0) := CDB'SET'UNIT;                   <<03550>>20806000
      CPB(CDB'AREA'BYTE+ 1) := CDB'INIT'UTIL + 2;              <<03550>>20808000
      CPB(CDB'AREA'BYTE+ 2) := %304;   << READ DRIVE TABLES >> <<03550>>20810000
      CPB(CDB'AREA'BYTE+ 3) := 1;      << SPARE TRACK TABLE >> <<03550>>20812000
                                                               <<03550>>20814000
      CP(DX'CMD'MSGLEN) := 4;                                  <<03550>>20816000
      CP(DX'CMD'AREA'ADR) := CHAN'PROG'BASE + CDB'AREA'WRD;    <<03550>>20818000
      CP(DX'EXEC'SEC) := READ'EXEC'SEC;                        <<03550>>20820000
      CP(DX'COUNT) := 512;    << MAX. RETURN BYTES >>          <<03550>>20822000
      CP(DX'DATA'BANK).(8:8) := DATA'BANK;                     <<03550>>20824000
      CP(DX'DATA'ADR) := DATA'ADDR;                            <<03550>>20826000
                                                               <<03550>>20828000
      CP(BRANCHPT) := DXFERCP;                                 <<03550>>20830000
      END;                                                     <<03550>>20832000
                                                               <<03550>>20834000
      <<**************************************>>               <<03668>>20836000
      <<  20   READ DEFECTIVE SECTOR TABLE    >>               <<03668>>20838000
      <<**************************************>>               <<03668>>20840000
                                                               <<03668>>20842000
      BEGIN    << 20 >>                                        <<03550>>20844000
      PUSH(DB);                 << COMPUTE ABS. ADDRESS >>     <<03668>>20846000
      T'ADDR := TOS + @DSCT;    <<    OF DSCT           >>     <<03668>>20848000
      T'BANK := TOS;                                           <<03668>>20850000
      READ'CP( 128, 1D, T'BANK, T'ADDR);                       <<03668>>20852000
      END;                                                     <<03550>>20854000
                                                               <<03550>>20856000
      <<*****************************************>>            <<03668>>20858000
      <<  21    WRITE DEFECTIVE SECTOR TABLE     >>            <<03668>>20860000
      <<*****************************************>>            <<03668>>20862000
                                                               <<03668>>20864000
      BEGIN    << 21 >>                                        <<03550>>20866000
      PUSH(DB);                 << COMPUTE ABS. ADDRESS >>     <<03668>>20868000
      T'ADDR := TOS + @DSCT;    <<    OF DSCT           >>     <<03668>>20870000
      T'BANK := TOS;                                           <<03668>>20872000
      WRITE'CP( 128, 1D, T'BANK, T'ADDR);                      <<03668>>20874000
      END;                                                     <<03550>>20876000
                                                               <<03550>>20878000
      <<*************************************>>                <<03550>>20880000
      <<  22     INTERNAL DIAGNOSTIC         >>                <<03550>>20882000
      <<*************************************>>                <<03550>>20884000
                                                               <<03550>>20886000
      BEGIN                                                    <<03550>>20888000
      CPB(CDB'AREA'BYTE+ 0) := CDB'SET'UNIT + CTRL'UNIT;       <<03550>>20890000
      CPB(CDB'AREA'BYTE+ 1) := CDB'INIT'DIAG;                  <<03550>>20892000
      CPB(CDB'AREA'BYTE+ 2) := 0;      << 2 BYTE       >>      <<03550>>20894000
      CPB(CDB'AREA'BYTE+ 3) := 1;      <<  LOOP COUNT  >>      <<03550>>20896000
      CPB(CDB'AREA'BYTE+ 4) := 0;      << DIAG. SECTION >>     <<03550>>20898000
                                                               <<03550>>20900000
      CP(DIAG'CMD'MSGLEN) := 5;                                <<03550>>20902000
      CP(DIAG'CMD'AREA'ADR) := CHAN'PROG'BASE + CDB'AREA'WRD;  <<03550>>20904000
                                                               <<03550>>20906000
      CP(DIAG'HALT'CODE) := 4;   << THIS FUNCTION ACTS LIKE >> <<03672>>20908000
                                 << DEVICE CLEAR, SO GIVE   >> <<03672>>20910000
                                 << IT A SPECIAL HALT CODE  >> <<03672>>20912000
      CP(BRANCHPT) := DIAGCP;                                  <<03550>>20914000
      END;                                                     <<03550>>20916000
                                                               <<03550>>20918000
      <<**************************************>>               <<03668>>20920000
      <<  23   READ-ONLY ERROR RATE TEST      >>               <<03668>>20922000
      <<**************************************>>               <<03668>>20924000
                                                               <<03668>>20926000
      BEGIN                                                    <<03668>>20928000
      ERT'CP(TRUE);                                            <<03668>>20930000
      END;                                                     <<03668>>20932000
                                                               <<03668>>20934000
      <<***************************************>>              <<03668>>20936000
      <<  24     READ AND CLEAR STATUS         >>              <<03668>>20938000
      <<***************************************>>              <<03668>>20940000
                                                               <<03668>>20942000
      BEGIN                                                    <<03668>>20944000
      RSTAT'CP( TRUE);                                         <<03668>>20946000
      END;                                                     <<03668>>20948000
                                                               <<03668>>20950000
      <<*************************************>>                <<03668>>20952000
      <<  25        READ STATUS              >>                <<03668>>20954000
      <<*************************************>>                <<03668>>20956000
                                                               <<03668>>20958000
      BEGIN                                                    <<03668>>20960000
      RSTAT'CP( FALSE);                                        <<03668>>20962000
      END;                                                     <<03668>>20964000
                                                               <<03668>>20966000
      <<******************************>>                       <<03672>>20968000
      <<  26     UNLOAD TAPE          >>                       <<03672>>20970000
      <<******************************>>                       <<03672>>20972000
                                                               <<03672>>20974000
      BEGIN                                                    <<03672>>20976000
      CPB(CDB'AREA'BYTE+ 0) := CDB'SET'UNIT;                   <<03672>>20978000
      CPB(CDB'AREA'BYTE+ 1) := CDB'UNLOAD;                     <<03672>>20980000
      CP(DIAG'CMD'MSGLEN) := 2;                                <<03672>>20982000
      CP(DIAG'CMD'AREA'ADR) := CHAN'PROG'BASE + CDB'AREA'WRD;  <<03672>>20984000
      CP(BRANCHPT) := DIAGCP;                                  <<03672>>20986000
      END;                                                     <<03672>>20988000
      END;      << CASE STATEMENT >>                           <<03550>>20990000
                                                               <<03550>>20992000
$PAGE                                                          <<03550>>20994000
   << MOVE CHANNEL PROGRAM INTO BANK 0 LOCATION >>             <<03550>>20996000
   MABS( 0,CHAN'PROG'BASE,LOCAL'BUF'BANK,CPADDRESS,CPSIZE);    <<03668>>20998000
                                                               <<03550>>21000000
   ZEROABS(GETDRT(DRT,DBI), 7);  << ZERO THE CPVA AREA >>      <<03550>>21002000
                                                               <<03550>>21004000
   GOOD'COMPLETION := FALSE;    << INIT. COMPLETION FLAG >>    <<03668>>21006000
                                                               <<03668>>21008000
   INIT( DRT);                  << INITIALIZE THE CHANNEL >>   <<03550>>21010000
   IF <> THEN                                                  <<03550>>21012000
      GOTO LAUNCH'ERROR;        << ERROR--ABORT >>             <<03550>>21014000
                                                               <<03550>>21016000
   SIOP( DRT, CHAN'PROG'BASE);  <<START THE CHANNEL PROGRAM>>  <<03550>>21018000
   IF <> THEN                                                  <<03550>>21020000
      GOTO LAUNCH'ERROR;        << ERROR--ABORT >>             <<03550>>21022000
                                                               <<03550>>21024000
   IF STYPE = LINUS OR                                         <<*8392>>21026000
      STYPE = BUFFALO  THEN                << GET TIMEOUT   >> <<*8392>>21028000
      TIMEOUT := TAPE'TIMEOUT(CURFUNCT)    <<  FOR CURRENT  >> <<03672>>21030000
   ELSE                                    <<  FUNCTION     >> <<03672>>21032000
      TIMEOUT := DISC'TIMEOUT(CURFUNCT);                       <<03672>>21034000
                                                               <<03672>>21036000
   STARTIME := 0D;        << SET INITIAL TIME CLOCK >>         <<03672>>21038000
   CURTIME := 0D;         << INITIALIZE CURRENT TIME CLOCK >>  <<03672>>21040000
   LAST'RCLK := RCLK;     << GET INITIAL RCLK >>               <<03672>>21042000
                                                               <<03672>>21044000
   DO                     << LOOP UNTIL CHANNEL PROGRAM     >> <<03672>>21046000
      BEGIN               <<    ENDS OR TIMEOUT IS REACHED  >> <<03672>>21048000
      NEW'RCLK := RCLK;                                        <<03672>>21050000
      IF NEW'RCLK <> LAST'RCLK THEN    <<INCREMENT CLOCK IF >> <<03672>>21052000
         CURTIME := CURTIME + 1D;      <<   RCLK HAS TICKED >> <<03672>>21054000
      LAST'RCLK := NEW'RCLK;                                   <<03672>>21056000
                                                               <<03672>>21058000
                          << TIMEOUT=0 MEANS NEVER TIMEOUT  >> <<03672>>21060000
      IF TIMEOUT = 0D THEN CURTIME := STARTIME;                <<03672>>21062000
      END                                                      <<03672>>21064000
   UNTIL (GETDRT(DRT,CHANSTAT).(0:2) = 0 OR                    <<03672>>21066000
          CURTIME - STARTIME > TIMEOUT);                       <<03672>>21068000
                                                               <<03550>>21070000
   IF CURTIME - STARTIME > TIMEOUT THEN     << TIMED OUT >>    <<03668>>21072000
      BEGIN                                                    <<03668>>21074000
      PARM := GETDRT( DRT, CHANSTAT);     << FAKE CP        >> <<03668>>21076000
      PARM.(0:2) := 0;                    <<    COMPLETION  >> <<03668>>21078000
      PUTDRT(DRT, CHANSTAT, PARM);                             <<03668>>21080000
                                                               <<03668>>21082000
      IF FATAL'FUNCT(FUNCT) THEN      << WAIT FOR CP TO >>     <<03668>>21084000
         OFFLINE                      <<   COME ON-LINE >>     <<03668>>21086000
      ELSE                                                     <<03668>>21088000
         GOTO OFFLINE'ERROR;                                   <<03668>>21090000
      END                                                      <<03668>>21092000
                                                               <<03550>>21094000
   ELSE IF CPVAP.ERRCODE <> 4 THEN     << CHANNEL OR DMA  >>   <<03668>>21096000
      GOTO CPVA'ERROR                  <<    ABORT        >>   <<03668>>21098000
$PAGE                                                          <<03550>>21100000
   ELSE IF CPVAP.(3:13) = 1 THEN                               <<03668>>21102000
      BEGIN        << DIAGNOSE STATUS >>                       <<03550>>21104000
                                                               <<03550>>21106000
      MOVE'STATUS;  << PUT STATUS INTO LOCAL BUFFER >>         <<03550>>21108000
                                                               <<03550>>21110000
      IF STATUS(ID'FIELD).UNIT'ATTN <> %377 AND                <<03550>>21112000
         STATUS(ID'FIELD).UNIT'ATTN <> %17 AND                 <<03550>>21114000
         STATUS(ID'FIELD).UNIT'ATTN <> 0 THEN                  <<03550>>21116000
         GOTO ID'ERROR                                         <<03550>>21118000
                                                               <<03550>>21120000
      ELSE IF STATUS(REJECT'FIELD).CHAN'PARITY OR              <<03550>>21122000
         STATUS(REJECT'FIELD).ILLEG'OPCODE OR                  <<03550>>21124000
         STATUS(REJECT'FIELD).MOD'ADDR'ERR OR                  <<03550>>21126000
         STATUS(REJECT'FIELD).ADDR'BOUND OR                    <<03550>>21128000
         STATUS(REJECT'FIELD).PARM'BOUND OR                    <<03550>>21130000
         STATUS(REJECT'FIELD).ILLEG'PARM OR                    <<03550>>21132000
         STATUS(REJECT'FIELD).MSG'SEQ'VIOL OR                  <<03550>>21134000
         STATUS(REJECT'FIELD).MSG'LEN'DIFF THEN                <<03550>>21136000
         GOTO REJECT'ERROR                                     <<03550>>21138000
                                                               <<03550>>21140000
      ELSE IF STATUS(FAULT'FIELD).CROSS'UNIT OR                <<03550>>21142000
         STATUS(FAULT'FIELD).CTRL'FAULT OR                     <<03550>>21144000
         STATUS(FAULT'FIELD).UNIT'FAULT OR                     <<03550>>21146000
         STATUS(FAULT'FIELD).DIAG'FAILED OR                    <<03550>>21148000
         STATUS(FAULT'FIELD).OPER'REL'REQRD OR                 <<03550>>21150000
         STATUS(FAULT'FIELD).DIAG'REL'REQRD OR                 <<03550>>21152000
         STATUS(FAULT'FIELD).POWER'FAIL THEN                   <<03550>>21154000
         GOTO FAULT'ERROR                                      <<03550>>21156000
                                                               <<03550>>21158000
      ELSE IF STATUS(FAULT'FIELD).RETRANSMIT THEN              <<03550>>21160000
         PUSH'STACK(CURFUNCT)         << RETRY REQUEST >>      <<03550>>21162000
                                                               <<03550>>21164000
      ELSE IF STATUS(ACCESS'FIELD).ILLEG'PAR'OPER OR           <<03550>>21166000
         STATUS(ACCESS'FIELD).UNINIT'MEDIA OR                  <<03550>>21168000
         STATUS(ACCESS'FIELD).NO'SPARE'AVAIL OR                <<03550>>21170000
         STATUS(ACCESS'FIELD).WRT'PROTECT OR                   <<03550>>21172000
         STATUS(ACCESS'FIELD).NO'DATA'FOUND OR                 <<03550>>21174000
         STATUS(ACCESS'FIELD).END'OF'FILE OR                   <<03550>>21176000
         STATUS(ACCESS'FIELD).END'OF'VOLUME THEN               <<03550>>21178000
         GOTO ACCESS'ERROR                                     <<03550>>21180000
                                                               <<03550>>21182000
      ELSE IF STATUS(INFOR'FIELD).MAINT'TRK'OV THEN            <<SPFIX>>21184000
         GOTO INFO'ERROR                                       <<SPFIX>>21186000
                                                               <<SPFIX>>21188000
      ELSE IF STATUS(FAULT'FIELD).INT'MAINT'REQRD OR           <<03550>>21190000
         STATUS(INFOR'FIELD).OPER'REL'REQST OR                 <<03550>>21192000
         STATUS(INFOR'FIELD).DIAG'REL'REQST OR                 <<03550>>21194000
         STATUS(INFOR'FIELD).INT'MAINT'REQST THEN              <<03550>>21196000
         BEGIN                                                 <<03550>>21198000
         PUSH'STACK(CURFUNCT);    << REDO CURRENT FUNCTION >>  <<03550>>21200000
         IF STATUS(FAULT'FIELD).INT'MAINT'REQRD OR             <<03550>>21202000
            STATUS(INFOR'FIELD).INT'MAINT'REQST OR             <<03668>>21204000
            STATUS(INFOR'FIELD).OPER'REL'REQST AND             <<03668>>21206000
            STATUS(ACCESS'FIELD).DEV'NOT'RDY                   <<03668>>21208000
            THEN PUSH'STACK(RELEASE)                           <<03550>>21210000
            ELSE PUSH'STACK(RELEASE'DENY);                     <<03550>>21212000
         END                                                   <<03550>>21214000
                                                               <<03550>>21216000
      ELSE IF STATUS(ACCESS'FIELD).DEV'NOT'RDY THEN            <<03668>>21218000
         IF FATAL'FUNCT(FUNCT) THEN     << WAIT FOR DISC TO >> <<03668>>21220000
            OFFLINE                     <<   COME ON-LINE   >> <<03668>>21222000
         ELSE                                                  <<03668>>21224000
            GOTO OFFLINE'ERROR                                 <<03668>>21226000
                                                               <<03550>>21228000
      ELSE IF STATUS(ACCESS'FIELD).UNRECOV'DATA'OV OR          <<03550>>21230000
              STATUS(ACCESS'FIELD).UNRECOV'DATA THEN           <<03550>>21232000
         BEGIN                                                 <<03550>>21234000
         IF (CURFUNCT = RECOV'READ) OR                         <<SPFIX>>21236000
            (CURFUNCT = SPARE'RETAIN) THEN                     <<SPFIX>>21238000
                                                               <<SPFIX>>21240000
            <<------------------------------------------->>    <<SPFIX>>21242000
            << DO NOTHING HERE.  DRIVER WILL RETURN CCL  >>    <<SPFIX>>21244000
            << FOR BOTH OF THESE FUNCTIONS.              >>    <<SPFIX>>21246000
            <<------------------------------------------->>    <<SPFIX>>21248000
                                                               <<03668>>21250000
         ELSE IF NOT ON'ICS THEN                               <<03668>>21252000
            BEGIN                        << SAVE CURRENT    >> <<03668>>21254000
            MOVE OLD'STAT := STATUS,(STAT'SIZE);  << STATUS >> <<03668>>21256000
            PUSH'STACK( DSCT'READ);    << GO READ THE DSCT  >> <<03668>>21258000
            END                                                <<03668>>21260000
                                                               <<03668>>21262000
         ELSE                     << ADDRESSING VAR. 'DSCT' >> <<03668>>21264000
                                  <<  WHILE RUNNING ON ICS  >> <<03668>>21266000
            GOTO ACCESS'ERROR;    <<  WON'T WORK, SO ABORT  >> <<03668>>21268000
         END                                                   <<03668>>21270000
                                                               <<03668>>21272000
      ELSE            << STATUS RETURN INFORMATIONAL ONLY >>   <<03668>>21274000
         GOOD'COMPLETION := TRUE;                              <<03668>>21276000
      END                                                      <<03668>>21278000
                                                               <<03550>>21280000
 << POWER ON--REDO REQUEST.  WE HAVE JUST COMPLETED A       >> <<03550>>21282000
 << DEVICE CLEAR, SO DOWNLOAD SUP-                          >> <<03668>>21284000
 << PRESS RELEASE TIMEOUT AGAIN FIRST.  WE DON'T DO THIS    >> <<03550>>21286000
 << IF WE HAVEN'T GOTTEN TO THE POINT IN INITIAL WHERE THE  >> <<03668>>21288000
 << DEVICES ARE LOCKED IN.                                  >> <<03668>>21290000
                                                               <<03550>>21292000
   ELSE IF CPVAP.(3:13) = 2 THEN   <<POWER ON - REDO REQUEST>> <<03672>>21294000
      BEGIN                          << IF RELEASE TIMEOUT  >> <<03672>>21296000
      PUSH'STACK(CURFUNCT);          << WAS PREVIOUSLY DIS- >> <<03672>>21298000
      IF CS80'LOCK THEN              << ABLED, MUST RESET   >> <<03672>>21300000
         PUSH'STACK(SUPP'RELEASE);   << IT FIRST.           >> <<03672>>21302000
      END                                                      <<03672>>21304000
                                                               <<03672>>21306000
   ELSE IF CPVAP.(3:13) = 3 THEN   <<PROBLEM READING STATUS>>  <<03672>>21308000
      GOTO UNIT'ERROR             << ABORT THE PROGRAM >>      <<03672>>21310000
                                                               <<03672>>21312000
 << JUST COMPLETED DIAGNOSTIC (FUNCTION 22) -- THIS ACTS >>    <<03672>>21314000
 << LIKE A DEVICE CLEAR, SO WE MUST RE-DOWNLOAD          >>    <<03672>>21316000
 << PARAMETERS JUST AS WE DO AFTER A DEVICE CLEAR        >>    <<03672>>21318000
                                                               <<03672>>21320000
   ELSE IF CPVAP.(3:13) = 4 THEN     <<DIAGNOSTIC COMPLETION>> <<03672>>21322000
      BEGIN                          << IF RELEASE TIMEOUT  >> <<03672>>21324000
      IF CS80'LOCK THEN              << WAS PREVIOUSLY DIS- >> <<03672>>21326000
         PUSH'STACK(SUPP'RELEASE);   << ABLED, MUST RESET   >> <<03672>>21328000
      END                                                      <<03672>>21330000
                                                               <<03668>>21332000
   ELSE                               << NO ERRORS >>          <<03668>>21334000
      GOOD'COMPLETION := TRUE;                                 <<03668>>21336000
                                                               <<03668>>21338000
   IF GOOD'COMPLETION THEN                                     <<03668>>21340000
                                                               <<03668>>21342000
      IF CURFUNCT = DSCT'READ THEN     << HAVE THE DSCT >>     <<03668>>21344000
         IF GOOD'DSCT(DSCT) THEN       << IF IT'S SET UP, >>   <<03668>>21346000
            BEGIN                      <<    ADD AN ENTRY >>   <<03668>>21348000
            ADD'DSCT'ENTRY(DSCT, OLD'STAT(6), OLD'STAT(7));    <<03668>>21350000
            PUSH'STACK(DSCT'WRITE);      << WRITE OUT DSCT >>  <<03668>>21352000
            END                                                <<03668>>21354000
         ELSE                       << DSCT INVALID, JUST >>   <<03668>>21356000
            BEGIN                   <<    QUIT WITH ERROR >>   <<03668>>21358000
            MOVE STATUS := OLD'STAT,(STAT'SIZE);               <<03668>>21360000
            GOTO ACCESS'ERROR;                                 <<03668>>21362000
            END                                                <<03668>>21364000
                                                               <<03668>>21366000
      ELSE IF CURFUNCT = DSCT'WRITE THEN    <<  FINISHED    >> <<03668>>21368000
         BEGIN                              << WRITING DSCT >> <<03668>>21370000
         MOVE STATUS := OLD'STAT,(STAT'SIZE);                  <<03668>>21372000
         GOTO ACCESS'ERROR;           << QUIT WITH ERROR >>    <<03668>>21374000
         END                                                   <<03668>>21376000
                                                               <<03668>>21378000
      ELSE IF NOT FIRST'OFFLINE AND    << RESET FLAG IF ON- >> <<03668>>21380000
           CURFUNCT = GET'STAT THEN    <<   LINE WAIT JUST  >> <<03668>>21382000
         FIRST'OFFLINE := TRUE;        <<   FINISHED        >> <<03668>>21384000
                                                               <<03668>>21386000
   END;  << WHILE POP'STACK(CURFUNCT) AND    >>                <<03668>>21388000
         <<       NUM'RETRIES <= MAX'RETRIES >>                <<03668>>21390000
                                                               <<03550>>21392000
IF NUM'RETRIES > MAX'RETRIES THEN       << ABORT--NUMBER OF >> <<03550>>21394000
   GOTO RETRY'ERROR;                    <<  RETRIES EXCEEDS >> <<03550>>21396000
                                        <<  MAXIMUM         >> <<03550>>21398000
$PAGE                                                          <<03550>>21400000
            <<***********************************>>            <<03550>>21402000
            <<  FUNCTION-DEPENDENT COMPLETION    >>            <<03550>>21404000
            <<***********************************>>            <<03550>>21406000
                                                               <<03550>>21408000
IF FUNCT = RSTAT THEN           << READ STATUS COMPLETION >>   <<03550>>21410000
   BEGIN                                                       <<03550>>21412000
   MOVE'STATUS;                                                <<03550>>21414000
                                                               <<03550>>21416000
   << NOTE: STATUS RETURN IS INITIALIZED TO NOT READY ABOVE >> <<03550>>21418000
                                                               <<03550>>21420000
   IF STATUS(ACCESS'FIELD).DEV'NOT'RDY THEN                    <<03550>>21422000
      SET'STATUS'RETURN(TRUE)      << RETURN NOT READY >>      <<03550>>21424000
                                                               <<03550>>21426000
   ELSE                                                        <<03550>>21428000
      SET'STATUS'RETURN(FALSE);    << RETURN READY >>          <<03550>>21430000
   END                                                         <<03550>>21432000
                                                               <<03550>>21434000
ELSE IF FUNCT = GET'VOL'LIMIT THEN   << GET VOLUME LIMIT    >> <<03550>>21436000
   BEGIN                             <<    COMPLETION       >> <<03550>>21438000
   MABS( DATA'BANK,DATA'ADDR,                                  <<03550>>21440000
         LOCAL'BUF'BANK,             << MOVE IT TO RETURN   >> <<03550>>21442000
         LOCAL'BUF'ADDR+             <<    BUFFER           >> <<03550>>21444000
            SNGL'VEC'LIMIT+1, 2);                              <<03550>>21446000
   END                                                         <<03550>>21448000
                                                               <<03550>>21450000
 <<-------------------------------------------------------->>  <<SPFIX>>21452000
 << SPARE RETAINING DATA OR SPARE NOT RETAINING DATA       >>  <<SPFIX>>21454000
 << COMPLETED.  RETURN THE PARM'FIELD FROM THE STATUS,     >>  <<SPFIX>>21456000
 << WHICH CONTAINS THE ADDRESS & LENGTH OF THE AREA        >>  <<SPFIX>>21458000
 << AFFECTED BY THE SPARE.  IF AN UNRECOVERABLE DATA ERROR >>  <<SPFIX>>21460000
 << WAS ENCOUNTERED (SPARE RETAIN ONLY) RETURN CCL,        >>  <<SPFIX>>21462000
 << OTHERWISE CCE.                                         >>  <<SPFIX>>21464000
 <<-------------------------------------------------------->>  <<SPFIX>>21466000
                                                               <<SPFIX>>21468000
ELSE IF (FUNCT = SPARE'RETAIN) OR                              <<SPFIX>>21470000
        (FUNCT = SPARE'NO'RETAIN) THEN                         <<SPFIX>>21472000
                                                               <<SPFIX>>21474000
   BEGIN                                                       <<SPFIX>>21476000
   MABS(DATA'BANK, DATA'ADDR, 0,                               <<SPFIX>>21478000
        CHAN'PROG'BASE+STAT'AREA+PARM'FIELD, 5);               <<SPFIX>>21480000
                                                               <<SPFIX>>21482000
   IF STATUS(ACCESS'FIELD).UNRECOV'DATA'OV OR                  <<SPFIX>>21484000
      STATUS(ACCESS'FIELD).UNRECOV'DATA THEN                   <<SPFIX>>21486000
                                                               <<SPFIX>>21488000
      GOTO CCL'EXIT;                                           <<SPFIX>>21490000
   END                                                         <<SPFIX>>21492000
                                                               <<SPFIX>>21494000
 <<-------------------------------------------------------->>  <<SPFIX>>21496000
 << IF THE RECOVERY READ FUNCTION WAS UNABLE TO READ THE   >>  <<SPFIX>>21498000
 << DATA, RETURN CCL.                                      >>  <<SPFIX>>21500000
 <<-------------------------------------------------------->>  <<SPFIX>>21502000
                                                               <<SPFIX>>21504000
ELSE IF FUNCT = RECOV'READ THEN                                <<SPFIX>>21506000
                                                               <<SPFIX>>21508000
   BEGIN                                                       <<SPFIX>>21510000
   IF STATUS(ACCESS'FIELD).UNRECOV'DATA'OV OR                  <<SPFIX>>21512000
      STATUS(ACCESS'FIELD).UNRECOV'DATA THEN                   <<SPFIX>>21514000
                                                               <<SPFIX>>21516000
      GOTO CCL'EXIT;                                           <<SPFIX>>21518000
   END                                                         <<SPFIX>>21520000
                                                               <<03550>>21522000
ELSE IF FUNCT = DESCRIBE THEN        << DESCRIBE COMPLETION >> <<03550>>21524000
   MABS(DATA'BANK,DATA'ADDR,                                   <<03550>>21526000
        LOCAL'BUF'BANK,LOCAL'BUF'ADDR,WC)                      <<03630>>21528000
                                                               <<03550>>21530000
 << CHECK RESULTS OF R/W ERT.  IF ONLY ONE BYTE WAS   >>       <<03550>>21532000
 << TRANSFERRED BACK IN THE EXECUTION MESSAGE, THEN   >>       <<03550>>21534000
 << THE ERT WAS SUCCESSFUL.  OTHERWISE, RETURN CCL.   >>       <<03550>>21536000
                                                               <<03550>>21538000
ELSE IF FUNCT = RW'ERT OR FUNCT = RO'ERT THEN                  <<03550>>21540000
   BEGIN                                                       <<03550>>21542000
   IF ABS(CHAN'PROG'BASE+DX'COUNT) <>    << IF NOT ONE BYTE >> <<03550>>21544000
      ERT'RETURN - 1 THEN                <<  TRANSFERRED,   >> <<03550>>21546000
      GOTO CCL'EXIT;                     <<   RETURN CCL    >> <<03550>>21548000
   END;                                                        <<03550>>21550000
                                                               <<03550>>21552000
GOTO EXIT;    << TAKE NORMAL EXIT >>                           <<03550>>21554000
$PAGE                                                          <<03550>>21556000
           <<********************************>>                <<03550>>21558000
           <<        ERROR EXIT              >>                <<03550>>21560000
           <<********************************>>                <<03550>>21562000
                                                               <<03550>>21564000
FUNCT'ERROR:       << INVALID FUNCTION CODE SENT TO DRIVER >>  <<03550>>21566000
                                                               <<03550>>21568000
   ERRMESSAGE( M34, LDEV);                                     <<03550>>21570000
                                                               <<03550>>21572000
LAUNCH'ERROR:         << ERROR LAUNCHING CHANNEL PROGRAM >>    <<03550>>21574000
                                                               <<03550>>21576000
   ERROR := 5;                                                 <<03550>>21578000
   GOTO ERROR'EXIT;                                            <<03550>>21580000
                                                               <<03550>>21582000
CPVA'ERROR:           << CHANNEL ABORT OR DMA ABORT >>         <<03550>>21584000
                                                               <<03550>>21586000
   ERROR := 6;                                                 <<03550>>21588000
   GOTO ERROR'EXIT;                                            <<03550>>21590000
                                                               <<03550>>21592000
OFFLINE'ERROR:                                                 <<03550>>21594000
                                                               <<03550>>21596000
   ERROR := 7;                                                 <<03550>>21598000
   GOTO ERROR'EXIT;                                            <<03550>>21600000
                                                               <<03550>>21602000
UNIT'ERROR:           << ERROR DURING READ STATUS >>           <<03550>>21604000
                                                               <<03550>>21606000
   ERROR := 8;                                                 <<03550>>21608000
   GOTO ERROR'EXIT;                                            <<03550>>21610000
                                                               <<03550>>21612000
INFO'ERROR:                                                    <<SPFIX>>21614000
                                                               <<SPFIX>>21616000
   ERROR := 9;                                                 <<SPFIX>>21618000
   GOTO ERROR'EXIT;                                            <<SPFIX>>21620000
                                                               <<SPFIX>>21622000
ID'ERROR:        << QSTAT = 1, ERROR IN THE ID'FIELD >>        <<03550>>21624000
                                                               <<03550>>21626000
   ERROR := 0;                                                 <<03550>>21628000
   GOTO ERROR'EXIT;                                            <<03550>>21630000
                                                               <<03550>>21632000
REJECT'ERROR:    << QSTAT = 1, ERROR IN THE REJECT'FIELD >>    <<03550>>21634000
                                                               <<03550>>21636000
   ERROR := 1;                                                 <<03550>>21638000
   GOTO ERROR'EXIT;                                            <<03550>>21640000
                                                               <<03550>>21642000
FAULT'ERROR:     << QSTAT = 1, ERROR IN THE FAULT'FIELD >>     <<03550>>21644000
                                                               <<03550>>21646000
   ERROR := 2;                                                 <<03550>>21648000
   GOTO ERROR'EXIT;                                            <<03550>>21650000
                                                               <<03550>>21652000
ACCESS'ERROR:    << QSTAT = 1, ERROR IN THE ACCESS FIELD >>    <<03550>>21654000
                                                               <<03550>>21656000
   ERROR := 3;                                                 <<03550>>21658000
   GOTO ERROR'EXIT;                                            <<03550>>21660000
                                                               <<03550>>21662000
RETRY'ERROR:     << NUMBER OF RETRIES EXCEEDS MAXIMUM >>       <<03550>>21664000
                                                               <<03550>>21666000
   ERROR := 4;                                                 <<03550>>21668000
   GOTO ERROR'EXIT;                                            <<03550>>21670000
                                                               <<03550>>21672000
                                                               <<03550>>21674000
$PAGE                                                          <<03550>>21676000
                                                               <<03550>>21678000
ERROR'EXIT:                                                    <<03550>>21680000
                                                               <<03550>>21682000
IF FATAL'FUNCT(FUNCT) THEN                                     <<03550>>21684000
   BEGIN                                                       <<03550>>21686000
   CS'80'ERROR( LDEV, FUNCT, RECORD, CHAN'PROG'BASE, STATUS);  <<SPFIX>>21688000
   CASE ERROR OF                                               <<03550>>21690000
      BEGIN                                                    <<03550>>21692000
      <<  0 >> ERRMESSAGE(M30,ERROR); << ID'ERROR >>           <<SPFIX>>21694000
      <<  1 >> ERRMESSAGE(M30,ERROR); << REJECT'ERROR >>       <<SPFIX>>21696000
      <<  2 >> ERRMESSAGE(M30,ERROR); << FAULT'ERROR >>        <<SPFIX>>21698000
      <<  3 >> ERRMESSAGE(M30,ERROR); << ACCESS'ERROR >>       <<SPFIX>>21700000
      <<  4 >> ERRMESSAGE(M32,LDEV,   << RETRY'ERROR >>        <<03550>>21702000
                          DRT,UNIT);                           <<03550>>21704000
      <<  5 >> ERRMESSAGE(M2,DRT);    << LAUNCH'ERROR >>       <<03550>>21706000
      <<  6 >> ERRMESSAGE(M3,CPVAP);  << CPVA'ERROR >>         <<03550>>21708000
      <<  7 >> ERRMESSAGE(M30,ERROR); << OFFLINE'ERROR >>      <<SPFIX>>21710000
      <<  8 >> ERRMESSAGE(M30,ERROR); << UNIT'ERROR >>         <<SPFIX>>21712000
      <<  9 >> ERRMESSAGE(M30,ERROR); << INFO'ERROR >>         <<SPFIX>>21714000
      END;                                                     <<03550>>21716000
   ERRMESSAGE(M30,2);     << SHOULD NOT HAPPEN >>              <<03550>>21718000
   END;                                                        <<03550>>21720000
                                                               <<03550>>21722000
CCL'EXIT:                                                      <<03550>>21724000
                                                               <<03550>>21726000
CC := CCL;    << RETURN CCL >>                                 <<03550>>21728000
                                                               <<03550>>21730000
                                                               <<03550>>21732000
EXIT:         << ALL EXITS MUST GO THROUGH THIS POINT! >>      <<03550>>21734000
                                                               <<03550>>21736000
TOS := OLDDB;      << SET DB BACK TO WHERE CALLER HAD IT >>    <<03550>>21738000
ASSEMBLE(XCHD);                                                <<03550>>21740000
                                                               <<03550>>21742000
END;  << CS80'DRIVER >>                                        <<03550>>21744000
$PAGE                                                          <<03550>>21746000
$CONTROL SEGMENT=RESIDENT                                      <<03550>>21748000
PROCEDURE MH7905'HPIB(LDEV,DRT,UNIT,STYPE,FUNCT,RECORD,BUF,WC);<<*DVR*>>21750000
    VALUE LDEV,DRT,UNIT,STYPE,FUNCT,RECORD,BUF,WC;             <<*DVR*>>21752000
    INTEGER DRT,            << DRT NUMBER >>                   <<*DVR*>>21754000
            UNIT,           << UNIT NUMBER >>                  <<*DVR*>>21756000
            LDEV,           <<LOGICAL DEVICE NUMBER>>          <<03550>>21758000
            STYPE,          <<SUBTYPE>>                        <<03550>>21760000
            WC;             <<WORD COUNT>>                     <<03550>>21762000
                      <<NOTE: THIS DRIVER ASSUMES THAT  >>     <<03550>>21764000
                      <<THE WORD COUNT WILL NEVER EXCEED>>     <<00888>>21766000
                      <<16K WORDS FOR ONE TRANSFER.     >>     <<00888>>21768000
    LOGICAL FUNCT;  COMMENT-- 0: READ                          <<00888>>21770000
                              1: WRITE                         <<00888>>21772000
                              2: READ AND SET CCE - OK         <<00888>>21774000
                                              CCL - DEFECTIVE TRACK     21776000
                                              CCG - TRACK SPECIFIC ERROR21778000
                              3: FLAG TRACK DEFECTIVE          <<00888>>21780000
                              4: READ FULL SECTOR              <<01889>>21782000
                              5: READ STATUS                   <<03550>>21784000
                              6: NON-FATAL READ                <<01889>>21786000
                              7: INITIALIZE DEVICE             <<03550>>21788000
                                                               <<03550>>21790000
      <<NOTE!!!!                                               <<00888>>21792000
          THIS DRIVER IS CALLED WITH FUNCT=2 ONLY WHEN         <<00888>>21794000
          INITIALIZING A PACK. THUS THE DEFECTIVE TRACK        <<00888>>21796000
          TABLE IN DTT IS (OR IS BEING GENERATED) FOR          <<00888>>21798000
          LDEV.                                        ;       <<00888>>21800000
          <<**********************************>>                        21802000
           COMMENT:                                                     21804000
             When code was added for 7910 there                         21806000
           were not enough unused line numbers                          21808000
           to put desired comments so please see                        21810000
           end of this procedure for warning of                         21812000
           how 7910 works ;                                             21814000
          <<**********************************>>                        21816000
    DOUBLE RECORD,          <<DISC ADDRESS>>                   <<00888>>21818000
           BUF;             <<ABSOLUTE ADDRESS OF BUFFER>>     <<00888>>21820000
      BEGIN                                                    <<00888>>21822000
        EQUATE CLEARC  = %4400;    <<AMIGO CLEAR>>             <<00888>>21824000
        DEFINE ERRCODE  = (3:5)#,   <<ERROR BITS IN STATUS1>>  <<00888>>21826000
               NOTRDY   = (14:1)#,  <<DRIVE NOT READY>>        <<00888>>21828000
               SEEKCHECK= (13:1)#,  << SEEK CHECK ERROR >>     <<00888>>21830000
               GETSTATUS= BEGIN                                <<03067>>21832000
                          STATUSPROG(0);                       <<03067>>21834000
                          EXANWAIT(24,FALSE);                  <<03067>>21836000
                          END#,                                <<03067>>21838000
               GET'INITIAL'STATUS= IF FUNCT=RSTAT OR           <<03715>>21840000
                                      FUNCT=INIT'DEV THEN      <<03715>>21842000
                                      BEGIN                    <<00888>>21844000
                                      CP:=CLEARC;              <<00888>>21846000
                                      CP(1):=0;                <<00888>>21848000
                                      STATUSPROG(2);           <<00888>>21850000
                                      EXANWAIT(26,FALSE);      <<00888>>21852000
                                      END                      <<00888>>21854000
                                   ELSE                        <<00888>>21856000
                                      GETSTATUS#;              <<00888>>21858000
        EQUATE CHANWAIT = %1000,    <<WAIT INTSRTUCTION>>      <<00888>>21860000
               CHANJUMP = 0,        <<UNCONDITIONAL JUMP>>     <<00888>>21862000
               INTRPT'HLT=%600,     <<INTERRUPT AND HALT>>     <<00888>>21864000
               CHANREAD = %1400,    <<CHANNEL READ ORDER>>     <<00888>>21866000
               CHANWRITE= %2000,    <<CHANNEL WRITE ORDER>>    <<00888>>21868000
               CHANEND  = %177777;                             <<00888>>21870000
        EQUATE CDERR    = %17,      <<CORRECTABLE DATA ERROR>> <<00888>>21872000
               W2ERR    =%23,      <<SEE WORD2 ERROR>>         <<00888>>21874000
               SPT      = %20,      <<SPARE TRACK ERROR>>      <<00888>>21876000
               TFD      = %21;      <<DEFECTIVE TRACK>>        <<00888>>21878000
        EQUATE D        = 1,        <<DEFECTIVE TRACK BIT>>    <<00888>>21880000
               SP       = 4;        <<SPARE TRACK BIT>>        <<00888>>21882000
        EQUATE SEEKCOM  = %1000,    <<SEEK COMMAND>>           <<00888>>21884000
               REQSTAT  = %1400,    <<REQUEST STATUS COMMAND>> <<00888>>21886000
               REQADR   = %2000,    <<REQUEST SECTOR ADDRESS COMMAND>>  21888000
               ENDOP    = %12400,   <<END COMMAND>>            <<00888>>21890000
               REQSYND  = %6400,    <<REQUEST SYNDRONE COMMAND>>        21892000
               READCOM  = %2400,    <<READ COMMAND>>           <<00888>>21894000
               READFS   = %3000,    <<READ FULL SECTOR>>       <<00888>>21896000
               WRITECOM = %4000,    <<WRITE COMMAND>>          <<00888>>21898000
               VFY      = %3400,    <<VERIFY COMMAND>>         <<00888>>21900000
               INITCOM  = %5400,    <<INITIALIZE COMMAND>>     <<00888>>21902000
               ADRREC   = %6000,    <<ADDRESS RECODR COMMAND>> <<00888>>21904000
               SETFMSK  = %7400,    <<SET FILE MASK COMMAND>>  <<00888>>21906000
               REQDISCADR=%12000;   <<REQUEST DISC ADDRESS>>   <<00888>>21908000
        DOUBLE OLDDB,               <<OLD ADDRESS OF DB>>      <<00888>>21910000
               TBUFA,               <<ABSOLUTE ADDRESS OF TBUF>>        21912000
               STATUSRET,           <<LOCAL STORAGE FOR STATUS>>        21914000
               DISCADRRET,          <<LOCAL STORAGE FOR DISCADR>>       21916000
               COUNTER,                                        <<00888>>21918000
               ALTADR;              <<ALTERNATE CYLINSER,HEAD & SECT>>  21920000
        INTEGER SBANK,                                         <<*DVR*>>21922000
                BUF1=BUF,BUF2=BUF+1,                           <<00888>>21924000
                LDT'INDEX,                                     <<*DVR*>>21926000
                I := 0,                                        <<00888>>21928000
                RETRYCOUNT:=0,                                 <<00888>>21930000
                RESIDUEINDEX, << INDEX TO RESIDUE BYTE COUNT >><<00904>>21932000
                N,                                             <<00888>>21934000
                INDEX,                                         <<00888>>21936000
                TYPE,                                          <<00888>>21938000
                CPX,                <<INDEX TO CHANNEL PROGRAM>>        21940000
                CWC,                <<CURRENT WORD COUNT>>     <<00888>>21942000
                CONSTAT,            <<CONTROLLER STATUS>>      <<00888>>21944000
                XCNT,               <<WORD COUNT>>             <<00888>>21946000
                BUFCNT,             <<WORDS FINISHED COUNT>>   <<00888>>21948000
                TRACK,              <<DEFECTIVE TRACK ENTRY>>  <<00888>>21950000
                ALTADR1=ALTADR,                                <<00888>>21952000
                ATLADR2=ALTADR+1,                              <<00888>>21954000
                COMADR;             <<ADDRESS IN BANK OF @COMMANDS>>    21956000
        LOGICAL COUNTING;                                      <<00888>>21958000
        INTEGER INITRETRY;                                     <<00888>>21960000
        INTEGER ARRAY COMMANDS(0:25)=Q; <<BUFFER FOR DISC>>    <<00888>>21962000
                        <<COMMANDS AND RETURNS FROM COMMANDS>> <<00888>>21964000
        LOGICAL STATUS1 = STATUSRET,                           <<00888>>21966000
                STATUS2 = STATUSRET+1,                         <<00888>>21968000
                DISCSTATUS1=COMMANDS+23,                       <<00888>>21970000
                DISCSTATUS2=COMMANDS+24,                       <<00888>>21972000
                DISCADR1= DISCADRRET,                          <<00888>>21974000
                DISCADR2= DISCADRRET+1;                        <<00888>>21976000
        INTEGER SEEKCYLINDER  = COMMANDS+1,                    <<00888>>21978000
                SEEKHDSECT    = COMMANDS+2,                    <<00888>>21980000
                ADRRECCYLINDER= COMMANDS+4,                    <<00888>>21982000
                ADRRECHDSECT  = COMMANDS+5,                    <<00888>>21984000
                VFYSECTCNT    = COMMANDS+20;                   <<00888>>21986000
        DOUBLE DISCSTATUS     = COMMANDS+23,                   <<00888>>21988000
               SEEKPHYSADR    = SEEKCYLINDER,                  <<00888>>21990000
               ADRRECPHYSADR  = ADRRECCYLINDER,                <<00888>>21992000
               SYNADR         = COMMANDS+10,                   <<00888>>21994000
               DISCADR        = COMMANDS+17;                   <<00888>>21996000
        INTEGER ARRAY SYNRET(*) = COMMANDS+9;                  <<00888>>21998000
        EQUATE CMSEEK = 0,        <<SEEK COMMAND INDEX>>       <<00888>>22000000
               CMADR  = 3,        <<ADDRESS RECORD INDEX>>     <<00888>>22002000
               CMEND  = 6,        <<ENDOP INDEX>>              <<00888>>22004000
               CMSFM  = 7,        <<SET FILE MASK INDEX>>      <<00888>>22006000
               CMRQSYN= 8,        <<REQUEST SYNDRONE INDEX>>   <<00888>>22008000
               CMRQDA = 16,       <<REQUEST DISC ADDRESS>>     <<00888>>22010000
               CMVFY  = 19,       <<VERIFY INEX>>              <<00888>>22012000
               CMINIT = 21,       <<INITIALIZE INDEX>>         <<00888>>22014000
               CMRQST = 22,       <<REQUEST STATUS>>           <<00888>>22016000
               CMREAD = 25;       <<READ INDEX>>               <<00888>>22018000
        LOGICAL ARRAY CP(*)   = DB+0, <<CHANNEL PROGRAM BUFFER>>        22020000
                      BUFDB(*)= DB+0;                          <<00888>>22022000
        INTEGER ARRAY TBUFDB(*)=DB+0;                          <<00888>>22024000
    INTEGER TEMP;                                              <<03002>>22026000
        INTEGER ARRAY TBUF(0:127) = Q;                         <<00888>>22028000
        <<------------------------------------->>              <<00888>>22030000
        <<COMMANDS AREA WILL BE USED AS FOLLOWS>>              <<00888>>22032000
        <<------------------------------------->>              <<00888>>22034000
          COMMENT:                                             <<00888>>22036000
          COMMANDS :=                                          <<00888>>22038000
          <<00>> SEEKCOM,                                      <<00888>>22040000
          <<01>> 0,            <<CYLINDER>>                    <<00888>>22042000
          <<02>> 0,            <<HEAD-SECTOR ADDRESS>>         <<00888>>22044000
          <<03>> ADRREC,                                       <<00888>>22046000
          <<04>> 0,            <<CYLINDER>>                    <<00888>>22048000
          <<05>> 0,            <<HEAD-SECTOR ADDRESS>>         <<00888>>22050000
          <<06>> ENDOP,                                        <<00888>>22052000
          <<07>> SETFMSK,                                      <<00888>>22054000
          <<08>> REQSYND,                                      <<00888>>22056000
          <<09>> 0,            <<RQ'SYN1>>                     <<00888>>22058000
          <<10>> 0,            <<RQ'SYN2>>                     <<00888>>22060000
          <<11>> 0,            <<RQ'SYN3>>                     <<00888>>22062000
          <<12>> 0,            <<RQ'SYN4>>                     <<00888>>22064000
          <<13>> 0,            <<RQ'SYN5>>                     <<00888>>22066000
          <<14>> 0,            <<RQ'SYN6>>                     <<00888>>22068000
          <<15>> 0,            <<RQ'SYN7N7>>                   <<00888>>22070000
          <<16>> REQDISCADR,                                   <<00888>>22072000
          <<17>> 0,                                            <<00888>>22074000
          <<18>> 0,                                            <<00888>>22076000
          <<19>> VFY,                                          <<00888>>22078000
          <<20>> 0,            <<SECTOR COUNT>>                <<00888>>22080000
          <<21>> INITCOM,                                      <<00888>>22082000
          <<22>> REQSTAT,                                      <<00888>>22084000
          <<23>> 0,            <<STATUS1>>                     <<00888>>22086000
          <<24>> 0,            <<STATUS2>>                     <<00888>>22088000
          <<25>> READCOM,                                      <<00888>>22090000
          <<25>> WRITECOM,                                     <<00888>>22092000
          <<25>> READCOM,                                      <<00888>>22094000
          <<25>> 0,                                            <<00888>>22096000
          <<25>> READFS;                                       <<00888>>22098000
        INTEGER ARRAY CHANIOPROG(0:11) = PB :=                 <<00888>>22100000
                %1000,0,       <<WAIT>>                        <<00888>>22102000
                %2010,2,0,%2000,0, <<WRITE ORDER TO CONTROLLER>>        22104000
                %1410,4,0,%2000,0; <<READ RETURN   >>          <<00888>>22106000
        INTEGER ARRAY FILEMASK(4:NMHSUBTYPES-1) = PB :=        <<00904>>22108000
        %7402,%7401,%7403,%7403,%7403,%7403,%7402,             <<00904>>22110000
        %7403,%7403,%7400;                                     <<00904>>22112000
        DEFINE SEC'CYL'FLOP=(DISCSTATUS2.(4:1)+1)*SEC'TRK'FLOP#;        22114000
        INTEGER ARRAY SEC'CYL(4:NMHSUBTYPES-1) = PB :=         <<00904>>22116000
          96, 48, 144, 144, 240, 576, 96, 96, 192, 64;         <<00904>>22118000
        INTEGER ARRAY HEADBASE(4:NMHSUBTYPES-1) = PB :=        <<00904>>22120000
          0, %1000, 0, 0, 0, 0, 0, %1000, 0, 0;                <<00904>>22122000
        EQUATE SEC'TRK'FLOP=30;                                <<00888>>22124000
        INTEGER ARRAY SECPERTRK(4:NMHSUBTYPES-1) =PB :=        <<00904>>22126000
          48,48,48,48,48,64,48,48,48,32;                       <<00904>>22128000
        INTEGER ARRAY CHANRDWRT(0:1)=PB:=CHANREAD,CHANWRITE;   <<00888>>22130000
        INTEGER ARRAY DISCOP(0:4) =PB :=                       <<00888>>22132000
          READCOM, WRITECOM, READCOM, 0, READFS, 0, READCOM;   <<01889>>22134000
                                                               <<00888>>22136000
  LOGICAL SUBROUTINE EXANWAIT(INDEX,DUMMY);                    <<00888>>22138000
    VALUE INDEX,DUMMY;                                         <<00888>>22140000
    INTEGER INDEX;                                             <<00888>>22142000
    LOGICAL DUMMY;                                             <<00888>>22144000
      BEGIN                                                    <<00888>>22146000
      COUNTING := TRUE;                                        <<00888>>22148000
      COUNTER := -64000D;                                      <<00888>>22150000
      CP(INDEX) := CHANWAIT;                                   <<00888>>22152000
      CP(X:=X+1) := 0;                                         <<00888>>22154000
      CP(X:=X+1) := INTRPT'HLT;                                <<00888>>22156000
      CP(X:=X+1) := 0;                                         <<00888>>22158000
      CP(X:=X+1) := CHANEND;                                   <<00888>>22160000
      CP(X:=X+1) := 0;                                         <<00888>>22162000
      INIT( DRT);                                              <<02510>>22164000
      IF <> THEN GO MISSINGGIC;                                <<02510>>22166000
      SIOP( DRT, ABSOLUTE(CHANPROG));                          <<02510>>22168000
      IF > THEN                                                <<00888>>22170000
         BEGIN <<FATAL ERROR - BUSY>>                          <<00888>>22172000
         ERRMESSAGE(M2,DRT);                                   <<01103>>22174000
         END;                                                  <<00888>>22176000
      IF < THEN                                                <<00888>>22178000
         BEGIN <<GIC MISSING - SET NOT READY>>                 <<00888>>22180000
MISSINGGIC:                                                    <<00888>>22182000
         TEMP:= GETDRT(DRT,CHANSTAT);  <<GET CHAN STATUS>>     <<03002>>22184000
         TEMP.(0:2):=0;  <<SET "CHANNEL COMPLETED">>           <<03002>>22186000
         PUTDRT(DRT,CHANSTAT,TEMP);                            <<03002>>22188000
         ABSOLUTE(GETDRT(DRT,DBI)).(0:2) := 0;                 <<03002>>22190000
         DISCSTATUS1.ERRCODE:=0;                               <<00888>>22192000
         DISCSTATUS2.NREADYF:=1;                               <<00888>>22194000
         END;  <<GIC MISSING - SIMULATE NOT READY>>            <<00888>>22196000
  TEST:                                                        <<00888>>22198000
          <<TEST CHANNEL STATUS>>                              <<03002>>22200000
      IF GETDRT(DRT,CHANSTAT).(0:2)=0 THEN                     <<03002>>22202000
        BEGIN <<CHANNEL PROGRAM COMPLETED>>                    <<00888>>22204000
        EXANWAIT := DISCSTATUS1;                               <<00888>>22206000
        RETURN;                                                <<00888>>22208000
        END;                                                   <<00888>>22210000
      IF (COUNTER:=COUNTER+1D)=0D AND COUNTING THEN            <<00888>>22212000
        BEGIN                                                  <<00888>>22214000
        IF FUNCT=RSTAT OR FUNCT=INIT'DEV THEN                  <<03715>>22216000
           BEGIN                                               <<00888>>22218000
           DISCSTATUS2.NREADYF:=1; <<RETURN NOT READY>>        <<00888>>22220000
           RETURN;                                             <<00888>>22222000
           END;                                                <<00888>>22224000
        MESSAGE( M2408, LDEV); << LDEV # n NOT READY >>        <<01103>>22226000
        COUNTING := FALSE;                                     <<00888>>22228000
        END;                                                   <<00888>>22230000
      GOTO TEST;                                               <<00888>>22232000
      END  <<EXANWAIT>>;                                       <<00888>>22234000
                                                               <<00888>>22236000
  SUBROUTINE SEEK;                                             <<00888>>22238000
    BEGIN                                                      <<00888>>22240000
    MOVE CP := CHANIOPROG,(7);                                 <<00888>>22242000
    CP(3) := 6;  <<BYTE COUNT>>                                <<00888>>22244000
    CP(5) := SBANK;                                            <<03603>>22246000
    CP(6) := COMADR + CMSEEK;                                  <<00888>>22248000
    COMMANDS(CMSEEK) := SEEKCOM + UNIT;                        <<00888>>22250000
    END;                                                       <<00888>>22252000
                                                               <<00888>>22254000
  SUBROUTINE STATUSPROG(INDEX);                                <<00888>>22256000
    VALUE INDEX;                                               <<00888>>22258000
    INTEGER INDEX;                                             <<00888>>22260000
      BEGIN                                                    <<00888>>22262000
      MOVE CP(INDEX) := CHANIOPROG,(12),2;                     <<00888>>22264000
      MOVE * := CHANIOPROG,(12);                               <<00888>>22266000
      CP(INDEX+5):=CP(INDEX+10):=CP(INDEX+17):=                <<00888>>22268000
        CP(INDEX+22) := SBANK;                                 <<03603>>22270000
      CP(INDEX+6) := COMADR+CMRQST;      <<REQUEST STATUS>>    <<00888>>22272000
      COMMANDS(CMRQST) := REQSTAT+UNIT;                        <<00888>>22274000
      CP(INDEX+11) := COMADR+CMRQST+1;                         <<00888>>22276000
      CP(INDEX+18) := COMADR+CMRQDA;     <<REQUEST DISC ADDRESS>>       22278000
      COMMANDS(CMRQDA) := REQDISCADR;                          <<00888>>22280000
      CP(INDEX+23) := COMADR+CMRQDA+1;                         <<00888>>22282000
      END;                                                     <<00888>>22284000
                                                               <<00888>>22286000
  DOUBLE SUBROUTINE L'PADR(LOGADR);                            <<00888>>22288000
    VALUE LOGADR;                                              <<00888>>22290000
    DOUBLE LOGADR;  <<LOGICAL ADDRESS>>                        <<00888>>22292000
      BEGIN                                                    <<00888>>22294000
      TOS := LOGADR;                                           <<00888>>22296000
      TOS := IF TYPE = 2 << FLOPPY DISC >> THEN                <<*LDT*>>22298000
         SEC'CYL'FLOP                                          <<00888>>22300000
      ELSE                                                     <<00888>>22302000
         SEC'CYL(STYPE);                                       <<00888>>22304000
      ASSEMBLE(LDIV);                                          <<00888>>22306000
      IF OVERFLOW THEN                                         <<00888>>22308000
        BEGIN    <<BAD ADDRESS>>                               <<00888>>22310000
        TOS := ABSOLUTE(DBBANK);                               <<00888>>22312000
        TOS := ABSOLUTE(DB);                                   <<00888>>22314000
        SET(DB);  <<SET DB TO INITIAL STACK>>                  <<00888>>22316000
        ERRMESSAGE(M27);                                       <<01103>>22318000
        END;                                                   <<00888>>22320000
      TOS := IF TYPE = 2 << FLOPPY DISC >> THEN                <<*LDT*>>22322000
         SEC'TRK'FLOP                                          <<00888>>22324000
      ELSE                                                     <<00888>>22326000
         SECPERTRK(STYPE);                                     <<00888>>22328000
      ASSEMBLE(DIV,XCH);                                       <<00888>>22330000
      TOS := TOS&LSL(8);                                       <<00888>>22332000
      IF TYPE <> 2 << FLOPPY DISC >> THEN                      <<*LDT*>>22334000
        TOS:=TOS+HEADBASE(STYPE);                              <<*LDT*>>22336000
      TOS:=TOS+TOS;     <<HEAD/SECTOR>>                        <<00888>>22338000
      DS6 := TOS;                                              <<00888>>22340000
      END <<L'PADR>> ;                                         <<00888>>22342000
                                                               <<00888>>22344000
  DOUBLE SUBROUTINE CONVERTADR(PHYSADR);                       <<00888>>22346000
    VALUE PHYSADR;                                             <<00888>>22348000
    DOUBLE PHYSADR;  <<PHYSICAL DISC ADDRESS>>                 <<00888>>22350000
      BEGIN                                                    <<00888>>22352000
      TOS := PHYSADR;                                          <<00888>>22354000
      TOS := S0;                                               <<00888>>22356000
      TOS := (TOS-HEADBASE(STYPE))&LSR(8)*                     <<00888>>22358000
             SECPERTRK(STYPE);                                 <<00888>>22360000
      ASSEMBLE(XCH);                                           <<00888>>22362000
      TOS := TOS.(8:8);  <<SECTOR #>>                          <<00888>>22364000
      ASSEMBLE(ADD,ZERO; XCH,CAB);                             <<00888>>22366000
      TOS := SEC'CYL(X);                                       <<00888>>22368000
      ASSEMBLE(LMPY,DADD);                                     <<00888>>22370000
      DS6 := TOS;  <<SECTOR ADDRESS>>                          <<00888>>22372000
      END <<CONVERTADR>> ;                                     <<00888>>22374000
                                                               <<00888>>22376000
  SUBROUTINE INITIALIZE(SECTOR,ADRRECSECT,BITS,VERIFY);        <<00888>>22378000
    VALUE SECTOR,ADRRECSECT,BITS,VERIFY;                       <<00888>>22380000
    DOUBLE SECTOR,     <<SECTOR FOR SEEK>>                     <<00888>>22382000
           ADRRECSECT; <<SECTOR FOR ADDRESS RECORD>>           <<00888>>22384000
    INTEGER BITS;      <<SPARE,DEFECTIVE OR ZERO>>             <<00888>>22386000
    LOGICAL VERIFY;    <<TRUE IF VERIFY COM TO BE EXECUTED>>   <<00888>>22388000
      COMMENT:                                                 <<00888>>22390000
        IT IS ASSUMED INITIALIZED IS NEVER CALLED FOR FLOPPY.  <<00888>>22392000
                                                               <<00888>>22394000
        INITIALIZE IS GENERALLY CALLED WITH DB POINTED TO      <<00888>>22396000
        INITIAL'S STACK,SO INITIALIZE SETS DB TO THE CHANNEL   <<00888>>22398000
        PROGRAM AREA. DB IS NOT RESET BEFORE EXITING;          <<00888>>22400000
          BEGIN                                                <<00888>>22402000
          INITRETRY:=0;                                        <<00888>>22404000
RETRYLABEL:                                                    <<00888>>22406000
          TOS := 0;                                            <<00888>>22408000
          TOS := ABSOLUTE(CHANPROG);                           <<00888>>22410000
          SET(DB);                                             <<00888>>22412000
          SEEK;                                                <<00888>>22414000
          SEEKPHYSADR := L'PADR(SECTOR);                       <<00888>>22416000
          MOVE CP(7) := CHANIOPROG,(7);                        <<00888>>22418000
          IF STYPE=S7910 THEN                                  <<00904>>22420000
            BEGIN << 7910, DON'T DO FILEMASK >>                         22422000
            CP(7) := CHANJUMP;                                          22424000
            CP(8) := 5;                                                 22426000
            END;                                                        22428000
          COMMANDS(CMSFM) := FILEMASK(STYPE)+4;<<SPARING ENABLED>>      22430000
          CP(12) := SBANK;                                     <<03603>>22432000
          CP(13) := COMADR+CMSFM;                              <<00888>>22434000
          IF VERIFY THEN                                       <<00888>>22436000
            BEGIN                                              <<00888>>22438000
            MOVE CP(14) := CHANIOPROG,(7);                     <<00888>>22440000
            COMMANDS(CMVFY) := VFY+UNIT;                       <<00888>>22442000
            COMMANDS(X:=X+1) := 1;  <<VERIFY 1 SECTOR>>        <<00888>>22444000
            CP(17) := 4;   <<COMMAND LENGTH IS FOUR BYTES>>    <<00888>>22446000
            CP(19) := SBANK;                                   <<03603>>22448000
            CP(20) := COMADR+CMVFY;                            <<00888>>22450000
            CPX := 21;                                         <<00888>>22452000
            END                                                <<00888>>22454000
          ELSE CPX := 14;                                      <<00888>>22456000
          MOVE CP(CPX) := CHANIOPROG,(7);                      <<00888>>22458000
          COMMANDS(CMADR) := ADRREC;                           <<00888>>22460000
          CP(CPX+3) := 6;   <<SIX BYTES WRITTEN>>              <<00888>>22462000
          CP(CPX+5) := SBANK;                                  <<03603>>22464000
          CP(CPX+6) := COMADR+CMADR;                           <<00888>>22466000
          ADRRECHDSECT := 0;                                   <<00888>>22468000
          IF ADRRECSECT=-1D THEN ADRRECCYLINDER := -1          <<00888>>22470000
          ELSE IF ADRRECSECT=0D THEN ADRRECCYLINDER := 0       <<00888>>22472000
               ELSE ADRRECPHYSADR := L'PADR(ADRRECSECT);       <<00888>>22474000
          CPX := CPX+7;                                        <<00888>>22476000
          MOVE CP(CPX) := CHANIOPROG,(12);                     <<00888>>22478000
          CP(CPX+5):=CP(CPX+10):=SBANK;                        <<03603>>22480000
          TOS := INITCOM+UNIT;                                 <<00888>>22482000
          TOS.(0:3) := S3;  <<BITS>>                           <<00888>>22484000
          COMMANDS(CMINIT) := TOS;                             <<00888>>22486000
          CP(CPX+6) := COMADR+CMINIT;                          <<00888>>22488000
          CP(CPX+7) := CHANWRITE;                              <<00888>>22490000
          CP(CPX+8) := SECPERTRK(STYPE)&LSL(8); <<BYTES IN A TRACK>>    22492000
          STATUSPROG(CPX+12);                                  <<00888>>22494000
          RESIDUEINDEX := CPX+8;     << INDEX TO RESIDUE >>    <<00904>>22496000
          IF (CONSTAT:=EXANWAIT(CPX+36,TRUE).ERRCODE)<>0 THEN  <<00888>>22498000
            BEGIN <<ERROR>>                                    <<00888>>22500000
            IF STYPE=S7910 AND CP(RESIDUEINDEX)=0 THEN         <<00904>>22502000
              RETURN;  << NOT AN ERROR, SEE WARNING ABOVE >>   <<00904>>22504000
            IF(INITRETRY:=INITRETRY+1)<4 THEN GOTO RETRYLABEL; <<00888>>22506000
            STATUSRET := DISCSTATUS;                           <<00888>>22508000
            DISCADRRET := DISCADR;                             <<00888>>22510000
            GOTO ERROR;                                        <<00888>>22512000
            END;                                               <<00888>>22514000
          END;   <<INITIALIZE>>                                <<00888>>22516000
                                                               <<00888>>22518000
          <<--------->>                                        <<00888>>22520000
          <<MAIN CODE>>                                        <<00888>>22522000
          <<--------->>                                        <<00888>>22524000
<< *************** BUG CATCHER *************** >>              <<bugch>>22526000
TOS := %1430D;                                                 <<bugch>>22528000
ASSEMBLE( LDEA );                                              <<bugch>>22530000
IF DS1 <> 0D THEN                                              <<bugch>>22532000
   IF DS1 >= RECORD AND                                        <<bugch>>22534000
      DS1 < RECORD+DOUBLE((WC+127)/128) THEN HELP;             <<bugch>>22536000
DDEL;                                                          <<bugch>>22538000
                                                               <<00888>>22540000
          CC := CCE;                                           <<01889>>22542000
          PUSH( SBANK );                                       <<03603>>22544000
          SBANK := TOS;   << BANK NR. OF OUR STACK >>          <<03603>>22546000
          IF ON'ICS THEN                                       <<03603>>22548000
            BEGIN                                              <<03603>>22550000
            TOS := 0;     << BANK >>                           <<03603>>22552000
            TOS := ABS(QI); << DB REGISTER TO QI >>            <<03603>>22554000
            END                                                <<03603>>22556000
          ELSE                                                 <<00888>>22558000
            BEGIN  <<LOAD STACK'S DB POINTER>>                 <<00888>>22560000
            TOS := ABSOLUTE(DBBANK);                           <<00888>>22562000
            TOS := ABSOLUTE(DB);                               <<00888>>22564000
            END;                                               <<00888>>22566000
          ASSEMBLE(DDUP,XCHD);                                 <<00888>>22568000
          OLDDB := TOS;   <<SAVE OLD DB>>                      <<00888>>22570000
          COMADR := S0+@COMMANDS; <<ADDRESS IN BANK OF COMMANDS>>       22572000
          TOS := TOS + @TBUF;                                  <<00888>>22574000
          TBUFA := TOS;   <<ABSOLUTE ADDRESS OF BUF>>          <<00888>>22576000
          COMMANDS := 0;                                       <<03603>>22578000
          MOVE COMMANDS(1) := COMMANDS,(25);                   <<03603>>22580000
          TOS := ABSOLUTE(DBBANK);                             <<00888>>22582000
          TOS := ABSOLUTE(DB);                                 <<00888>>22584000
          SET(DB);                                             <<00888>>22586000
          LDT'INDEX := LDEV * LDTSIZE;                         <<*LDT*>>22588000
          TYPE := IF LDEV=0 THEN ABSOLUTE(SDTYPE)              <<00892>>22590000
                  ELSE LDT'DEVICE'TYPE;                        <<*LDT*>>22592000
          TOS := 0;                                            <<00888>>22594000
          TOS := ABSOLUTE(CHANPROG);                           <<00888>>22596000
          SET(DB);                                             <<00888>>22598000
          GET'INITIAL'STATUS;                                  <<00888>>22600000
                                                               <<03549>>22602000
          IF FUNCT = INIT'DEV THEN   << INITIALIZE DONE BY  >> <<03715>>22604000
             BEGIN                   <<    READING STATUS   >> <<03715>>22606000
             IF DISCSTATUS2.NREADYF = 1 THEN                   <<03715>>22608000
                CC := CCL;     << RETURN CCL IF OFFLINE >>     <<03715>>22610000
             GO EXIT;                                          <<03715>>22612000
             END;                                              <<03715>>22614000
                                                               <<03549>>22616000
          IF FUNCT=RSTAT THEN                                  <<00888>>22618000
             BEGIN <<REQUEST STATUS>>                          <<00888>>22620000
             TOS:=BUF;                                         <<00888>>22622000
             ASSEMBLE (XCHD);                                  <<00888>>22624000
             BUFDB(0):=DISCSTATUS1;                            <<00888>>22626000
             BUFDB(1):=DISCSTATUS2;                            <<00888>>22628000
             ASSEMBLE (XCHD);                                  <<00888>>22630000
             GOTO EXIT;                                        <<00888>>22632000
             END;                                              <<00888>>22634000
          IF DISCSTATUS2.NOTRDY THEN                           <<00888>>22636000
            BEGIN  <<DRIVE NOT READY>>                         <<00888>>22638000
            MESSAGE(M2408,LDEV); <<NOT READY MESSAGE>>         <<01103>>22640000
            DO                                                 <<00888>>22642000
              BEGIN                                            <<00888>>22644000
              GETSTATUS;                                       <<00888>>22646000
              END                                              <<00888>>22648000
            UNTIL NOT(DISCSTATUS2.NOTRDY);                     <<00888>>22650000
            END;                                               <<00888>>22652000
  STARTOVER:                                                   <<00888>>22654000
          RETRYCOUNT:=RETRYCOUNT+1;                            <<00888>>22656000
          IF FUNCT<>3 THEN                                     <<00888>>22658000
            BEGIN  <<NOT FLAG TRACK>>                          <<00888>>22660000
  AGAIN:    SEEK;                                              <<00888>>22662000
            SEEKPHYSADR := L'PADR(RECORD);                     <<00888>>22664000
            IF TYPE<>2 << FLOPPY DISC >>                       <<*LDT*>>22666000
              AND STYPE <> S7910 THEN                          <<*LDT*>>22668000
              BEGIN  <<7905-MUST SET FILE MASK>>               <<00888>>22670000
              MOVE CP(7) := CHANIOPROG,(7);<<SET FILE MASK>>   <<00888>>22672000
              MOVE CP(14) := CHANIOPROG,(7);<<ADDRESS RECORD>> <<00888>>22674000
                COMMENT:                                       <<00888>>22676000
                  THE ADDRESS RECORD IS NECESSARY AFTER A SEEK <<00888>>22678000
                  BECAUSE IF ANOTHER UNIT COMES ON LINE AFTER  <<00888>>22680000
                  THE SEEK STARTS, THE CONTROLLER MUST BE TOLD <<00888>>22682000
                  WHERE IT DID THE SEEK TO;                    <<00888>>22684000
              TOS := FILEMASK(STYPE);                          <<00888>>22686000
              IF FUNCT<2 OR FUNCT=NON'FATAL'READ THEN          <<01889>>22688000
                TOS.(13:1) := 1;  << SPARING ENABLED >>        <<01889>>22690000
              COMMANDS(CMSFM) := TOS;                          <<00888>>22692000
              CP(12):=CP(19):=SBANK;                           <<03603>>22694000
              CP(13) := COMADR+CMSFM; <<SET FILE MASK>>        <<00888>>22696000
              CP(20) := COMADR+CMADR; <<ADDRESS RECORD>>       <<00888>>22698000
              COMMANDS(CMADR) := ADRREC;                       <<00888>>22700000
              CP(17) := 6;  <<SIX BYTES>>                      <<00888>>22702000
              ADRRECPHYSADR := SEEKPHYSADR;                    <<00888>>22704000
              CPX := 21;                                       <<00888>>22706000
              END                                              <<00888>>22708000
            ELSE CPX := 7;  << FLOPPY OR 7910 >>               <<00904>>22710000
            MOVE CP(CPX) := CHANIOPROG,(7); <<XFER PROGRAM>>   <<00888>>22712000
            MOVE CP(CPX+7) := CHANIOPROG(7),(5);               <<00888>>22714000
            CP(CPX+5) := SBANK;                                <<03603>>22716000
            CP(CPX+6) := COMADR+CMREAD;<<XFER COMMAND>>        <<00888>>22718000
            COMMANDS(CMREAD) := DISCOP(FUNCT)+UNIT;            <<00888>>22720000
            CP(CPX+7):=CHANRDWRT(FUNCT.(15:1));<<CHAN COMND>>  <<00888>>22722000
            TOS := WC;                                         <<00888>>22724000
            IF 10<=STYPE<=11 OR STYPE=4 THEN                   <<00888>>22726000
              BEGIN <<CHECK FOR CYLINDER OVERFLOW>>            <<00888>>22728000
              TOS := SEC'CYL(STYPE);                           <<00888>>22730000
              TOS := RECORD;                                   <<00888>>22732000
              TOS := S2;                                       <<00888>>22734000
              ASSEMBLE(LDIV,DELB;SUB);                         <<00888>>22736000
              TOS := TOS&LSL(7);                               <<00888>>22738000
              ASSEMBLE(DDUP,LCMP);                             <<00888>>22740000
              IF < THEN ASSEMBLE(XCH);                         <<00888>>22742000
              DELB;                                            <<00888>>22744000
              END;                                             <<00888>>22746000
            CWC := S0;  <<# OF WORDS TO TRANSFER>>             <<00888>>22748000
            XCNT := I;                                         <<00888>>22750000
            CP(CPX+8) := CWC&LSL(1);  <<BYTE COUNT>>           <<00888>>22752000
            TOS := BUF1;                                       <<00888>>22754000
            CP(CPX+10) := TOS;  <<BANK NUMBER>>                <<00888>>22756000
            CP(X:=X+1) := BUF2+XCNT;                           <<00888>>22758000
            CPX := (X:=X+1)+24;     <<AFTER STATUS PROG>>      <<00888>>22760000
            STATUSPROG(X);                                     <<00888>>22762000
            IF (CONSTAT:=EXANWAIT(CPX,TRUE).ERRCODE)<>0 THEN   <<00888>>22764000
              BEGIN   <<ERROR>>                                <<00888>>22766000
              STATUSRET := DISCSTATUS;                         <<00888>>22768000
              DISCADRRET := DISCADR;                           <<00888>>22770000
              <<STATUS AND ADR SAVED IN CASE DRIVER CALLED RECURSIVELY>>22772000
              IF (1<=CONSTAT<=%16 OR %22<=CONSTAT<=%37)        <<00888>>22774000
              AND RETRYCOUNT<4 THEN GOTO STARTOVER;            <<00888>>22776000
              IF CONSTAT=W2ERR AND DISCSTATUS2.SEEKCHECK=1 AND <<00888>>22778000
              WC-CWC<=0 THEN                                   <<00888>>22780000
                 BEGIN <<FALSE ERROR DUE TO OVERREAD>>         <<00888>>22782000
                 <<THIS ERROR CONDITION OCCURS WHEN THE>>      <<00888>>22784000
                 <<CONTROLLER FAILS TO GET THE DISC XFER>>     <<00888>>22786000
                 <<STOPPED BEFORE THE DISC RUNS INTO A>>       <<00888>>22788000
                 <<DEFECTIVE TRACK.  THE DISC USUALLY>>        <<00888>>22790000
                 <<READS 3 OR 4 SECTORS BEYOND THE END OF>>    <<00888>>22792000
                 <<TRANSFER BEFORE THE CONTROLLER CAN GET IT>> <<00888>>22794000
                 <<TO STOP, BUT THE CONTROLLER THROWS THE>>    <<00888>>22796000
                 <<DATA INTO THE BIT BUCKET.  IF, HOWEVER, >>  <<00888>>22798000
                 <<THIS EXTRA DATA IS ON A BAD TRACK, A FALSE>><<00888>>22800000
                 <<ERROR MESSAGE WILL BE REPORTED.>>           <<00888>>22802000
                 GOTO NOREALERR;                               <<00888>>22804000
                 END;  <<FALSE ERROR DUE TO OVERREAD>>         <<00888>>22806000
              IF CONSTAT=CDERR THEN                            <<00888>>22808000
                BEGIN <<POSSIBLE CORRECTABLE ERROR>>           <<00888>>22810000
                MOVE CP := CHANIOPROG,(12);                    <<00888>>22812000
                CP(5):=CP(10):= SBANK;                         <<03603>>22814000
                CP(6) := COMADR+CMRQSYN;                       <<00888>>22816000
                COMMANDS(CMRQSYN) := REQSYND;                  <<00888>>22818000
                CP(8) := 14;   <<READ 14 BYTES OF STATUS>>     <<00888>>22820000
                CP(11) := CP(6)+1; <<READ INTO SYNRET>>        <<00888>>22822000
                EXANWAIT(12,TRUE);                             <<00888>>22824000
                IF SYNRET.ERRCODE=CDERR THEN                   <<00888>>22826000
                  BEGIN <<CORRECTABLE ERROR>>                  <<00888>>22828000
                  TOS := CONVERTADR(SYNADR)-RECORD;            <<00888>>22830000
                  XCNT := TOS&LSL(7);                          <<00888>>22832000
                  N := TOS;  <<ZERO>>                          <<00888>>22834000
                  TOS := XCNT+SYNRET(3);  <<DISPLACEMENT>>     <<00888>>22836000
                  ASSEMBLE(DUP,NEG);                           <<00888>>22838000
                  BUFCNT := TOS+CWC;  <<BUFFER LIMIT>>         <<00888>>22840000
                  INDEX := TOS;  <<BUFFER INDEX>>              <<00888>>22842000
                  TOS := BUF;                                  <<00888>>22844000
                  ASSEMBLE(XCHD); <<SET DB TO BUF>>            <<00888>>22846000
                  DO IF 0<=(SYNRET(3)+N)<=127 AND (BUFCNT-N)>0 <<00888>>22848000
                    THEN BUFDB(X) := LOGICAL(SYNRET(4+N)) XOR  <<00888>>22850000
                    BUFDB(I+N+INDEX)                           <<00888>>22852000
                  UNTIL (N:=N+1)=3;                            <<00888>>22854000
                  ASSEMBLE(XCHD);  <<RESET DB>>                <<00888>>22856000
                  CWC := XCNT+128;                             <<00888>>22858000
                  GOTO CONTXFER;                               <<00888>>22860000
                  END;                                         <<00888>>22862000
                STATUS1 := SYNRET;                             <<00888>>22864000
                GOTO UNCORRECTABLE;                            <<00888>>22866000
                END;                                           <<00888>>22868000
              IF CONSTAT=SPT OR STATUS1.(0:1) THEN             <<00904>>22870000
                BEGIN  <<SPARE TRACK>>                         <<00888>>22872000
                TOS := ABSOLUTE(DBBANK);                       <<00888>>22874000
                TOS := ABSOLUTE(DB);                           <<00888>>22876000
                SET(DB); <<SET DB TO STACK FOR CALL TO ALTTRACK>>       22878000
                TOS := 0;                                      <<00888>>22880000
                TOS := LDEV;                                   <<00888>>22882000
                TOS := RECORD;                                 <<00888>>22884000
                TOS := SECPERTRK(STYPE);                       <<00888>>22886000
                ASSEMBLE(LDIV,DEL);                            <<00888>>22888000
                TOS := ALTTRACK(*,*);  <<GET ALTERNATE ADDRESS>>        22890000
                IF TOS >= 0 THEN                               <<00888>>22892000
                  BEGIN  <<A FORMER SPARE TRACK>>              <<00888>>22894000
                  IF SEEKCYLINDER>=DTT(DTTLPS) THEN INITIALIZE(RECORD,  22896000
                    0D,SP,0)  <<SPARE TRACK>>                  <<00888>>22898000
                  ELSE INITIALIZE(RECORD,RECORD,0,0); <<NORMAL>>        22900000
                  CC := CCE;  <<OK>>                           <<00888>>22902000
                  END                                          <<00888>>22904000
                ELSE                                           <<00888>>22906000
                  BEGIN  <<DEFECTIVE>>                         <<00888>>22908000
  DEFECTIVE:      IF SEEKCYLINDER>=DTT(DTTLPS) THEN INITIALIZE(RECORD,  22910000
                    -1D,SP,0)   <<DEFECTIVE IN SPARE AREA>>    <<00888>>22912000
                  ELSE INITIALIZE(RECORD,-1D,D,0);             <<00888>>22914000
                  CC := CCL;                                   <<00888>>22916000
                  END;                                         <<00888>>22918000
                GO EXIT;                                       <<00888>>22920000
                END;                                           <<00888>>22922000
              IF CONSTAT=TFD OR STATUS1.(1:1) THEN             <<00904>>22924000
                GOTO DEFECTIVE;  << FLAGGED TRACK >>           <<00904>>22926000
  ERROR:      IF LDEV=0 THEN ASSEMBLE(HALT 0);  <<IN BOOTSTRAP>>        22928000
              IF 7<=CONSTAT<=%11 THEN                          <<00888>>22930000
                BEGIN  <<TRACK SPECIFIC ERROR>>                <<00888>>22932000
  UNCORRECTABLE:IF FUNCT=2 THEN                                <<00888>>22934000
                  BEGIN  <<RETURN CCG>>                        <<00888>>22936000
                  CC := CCG;                                   <<00888>>22938000
                  GO EXIT;                                     <<00888>>22940000
                  END;                                         <<00888>>22942000
                TOS := CONVERTADR(DISCADRRET);                 <<00888>>22944000
                TOS := SECPERTRK(STYPE);                       <<00888>>22946000
                ASSEMBLE(LDIV,DEL);  <<TRACK #>>               <<00888>>22948000
                TOS := TOS&LSL(2);                             <<00888>>22950000
                IF <> THEN                                     <<00888>>22952000
                  BEGIN  <<ADD TO DEFECTIVE TRACKS TABLE>>     <<00888>>22954000
                  IF STATUS1.(0:1) THEN TOS:=TOS+1;<<SPARE>>   <<00888>>22956000
                  TRACK := TOS;                                <<00888>>22958000
                  MH7905'HPIB(LDEV,DRT,UNIT,STYPE,0,1D,TBUFA,  <<*DVR*>>22960000
                    128);                                      <<02510>>22962000
                  TOS := TBUFA;                                <<00888>>22964000
                  ASSEMBLE(XCHD); <<SET DB TO TBUF>>           <<00888>>22966000
                  X := 0;                                      <<00888>>22968000
                  WHILE (X:=X+1)<=TBUFDB DO                    <<00888>>22970000
                  IF TBUFDB(X)= TRACK  THEN GOTO PRINTERR;     <<00888>>22972000
                  IF X>120 THEN GOTO PRINTERR;                 <<00888>>22974000
                  TBUFDB := TBUFDB+1;                          <<00888>>22976000
                  TBUFDB(X) := TRACK;                          <<00888>>22978000
                  MH7905'HPIB(LDEV,DRT,UNIT,STYPE,1,1D,TBUFA,  <<*DVR*>>22980000
                    128);                                      <<02510>>22982000
                  END;                                         <<00888>>22984000
                END;                                           <<00888>>22986000
                IF FUNCT = NON'FATAL'READ THEN                 <<01889>>22988000
                  BEGIN                                        <<01889>>22990000
                  CC := CCL;                                   <<01889>>22992000
                  GO TO EXIT;                                  <<01889>>22994000
                  END;                                         <<01889>>22996000
  PRINTERR:     DISCERROR(LDEV,STATUS1,CONVERTADR(DISCADRRET),0,FUNCT.  22998000
                 (15:1),IF INTEGER(STATUS2)<0 THEN STATUS2 ELSE<<00888>>23000000
                 0);                                           <<00888>>23002000
              END;                                             <<00888>>23004000
              TOS := ABSOLUTE(GETDRT(DRT,DBI));  <<CPVA0>>     <<03002>>23006000
                 <<FETCH WORD0 OF CPVA,CHECK FOR ABORT>>       <<03002>>23008000
              IF S0.(0:2)=3 AND RETRYCOUNT<4 THEN              <<00888>>23010000
                 BEGIN                                         <<00888>>23012000
                 DEL;                                          <<00888>>23014000
                 GOTO STARTOVER;                               <<00888>>23016000
                 END;                                          <<00888>>23018000
              IF S0.(0:2)=3 THEN                               <<00888>>23020000
                 BEGIN <<IRRECOVERABLE CHANNEL ABORT>>         <<00888>>23022000
                 ERRMESSAGE(M3,S0); << CHANNEL PGM ABORT >>    <<01103>>23024000
                 END                                           <<00888>>23026000
              ELSE                                             <<00888>>23028000
                 DEL;                                          <<00888>>23030000
NOREALERR:  IF FUNCT=2 THEN                                    <<00888>>23032000
              BEGIN  <<TYPE 2 READ - OK>>                      <<00888>>23034000
              TOS := ABSOLUTE(DBBANK);                         <<00888>>23036000
              TOS := ABSOLUTE(DB);                             <<00888>>23038000
              ASSEMBLE(XCHD); <<SET DB TO STACK>>              <<00888>>23040000
              CC := CCE;                                       <<00888>>23042000
              IF SEEKCYLINDER>DTT(DTTLPS) THEN INITIALIZE(RECORD,0D,SP, 23044000
                0);  <<FLAG AS SPARE>>                         <<00888>>23046000
              GO EXIT;                                         <<00888>>23048000
              END;                                             <<00888>>23050000
  CONTXFER: I := I+CWC;                                        <<00888>>23052000
            WC := WC-CWC;                                      <<00888>>23054000
            IF <= THEN GO EXIT;                                <<00888>>23056000
            TOS := 0;                                          <<00888>>23058000
            TOS := (CWC+127)&LSR(7);                           <<00888>>23060000
            RECORD := TOS+RECORD;                              <<00888>>23062000
            GOTO AGAIN;                                        <<00888>>23064000
            END                                                <<00888>>23066000
          ELSE                                                 <<00888>>23068000
            BEGIN  <<FLAG A TRACK DEFECTIVE>>                  <<00888>>23070000
            TOS := BUF;                                        <<00888>>23072000
            ASSEMBLE(LSEA;DELB,DELB);                          <<00888>>23074000
            IF S0<>-1 THEN                                     <<00888>>23076000
              BEGIN <<POINT ALTERNATE AT DEFECTIVE TRACK>>     <<00888>>23078000
              TOS := TOS**LOGICAL(SECPERTRK(STYPE));           <<00888>>23080000
              INITIALIZE(*,RECORD,SP,0);                       <<00888>>23082000
              END;                                             <<00888>>23084000
            TOS := ABSOLUTE(DBBANK);                           <<00888>>23086000
            TOS := ABSOLUTE(DB);                               <<00888>>23088000
            ASSEMBLE(XCHD;DDEL); <<SET DB TO STACK>>           <<00888>>23090000
            TOS := 0;                                          <<00888>>23092000
            TOS := LDEV;                                       <<00888>>23094000
            TOS := RECORD;                                     <<00888>>23096000
            TOS := SECPERTRK(STYPE);                           <<00888>>23098000
            ASSEMBLE(LDIV,DEL);  <<TRACK #>>                   <<00888>>23100000
            TOS := ALTTRACK(*,*);                              <<00888>>23102000
            IF TOS<>-1 THEN                                    <<00888>>23104000
              BEGIN <<GARBAGE FORMER SPARE TRACK>>             <<00888>>23106000
              INITIALIZE(RECORD,-1D,SP,1);                     <<00888>>23108000
              TOS := ABSOLUTE(DBBANK);                         <<00888>>23110000
              TOS := ABSOLUTE(DB);                             <<00888>>23112000
              ASSEMBLE(XCHD;DDEL);<<RESET DB >>                <<00888>>23114000
              END;                                             <<00888>>23116000
            TOS := RECORD;                                     <<00888>>23118000
            TOS := BUF;                                        <<00888>>23120000
            ASSEMBLE(LSEA;DELB,DELB);                          <<00888>>23122000
            IF S0=-1 THEN                                      <<00888>>23124000
              BEGIN  <<DELETE>>                                <<00888>>23126000
              DEL;                                             <<00888>>23128000
              SEEKPHYSADR := L'PADR(RECORD);                   <<00888>>23130000
              TOS := -1D;                                      <<00888>>23132000
              IF SEEKCYLINDER >= DTT(DTTLPS) THEN TOS:=SP ELSE TOS:=D;  23134000
              END                                              <<00888>>23136000
            ELSE                                               <<00888>>23138000
              BEGIN  <<REASSIGN>>                              <<00888>>23140000
              TOS := TOS**LOGICAL(SECPERTRK(STYPE));           <<00888>>23142000
              TOS := D;                                        <<00888>>23144000
              END;                                             <<00888>>23146000
            INITIALIZE(*,*,*,0);                               <<00888>>23148000
            END;                                               <<00888>>23150000
  EXIT:   TOS := OLDDB;                                        <<00888>>23152000
          ASSEMBLE(XCHD); <<SET DB TO OLD DB>>                 <<00888>>23154000
      COMMENT:                                                 <<00904>>23156000
                                                                        23158000
**************************************************************          23160000
            W  A  R  N  I  N  G                                         23162000
**************************************************************          23164000
                                                                        23166000
     The 7910 has a "feature" which                                     23168000
can cause errors to be incorrectly diagnosed.                           23170000
This "feature" is automatic address verication                          23172000
when a seek is issued.  The result is that a status                     23174000
returned after a seek completion(caused by either                       23176000
issuance of a seek command or by an automatic seek                      23178000
following a transfer at the end of a track) to a track                  23180000
which is defective,protected,or spared will indicate an                 23182000
error even if no data is transfered (the 7905/06/20/25                  23184000
interface                                                               23186000
will only return an error if a data transfer is attempted).             23188000
                                                                        23190000
     What this means is that whenever an error is returned,             23192000
some check should be made to be sure that the error                     23194000
did in fact occur in the area of the disc that the                      23196000
caller is transferring to(from).  It seems that to be                   23198000
absolutely sure that the error occured within the area                  23200000
of immediate concern, the disc address of the error                     23202000
should be obtained and compared with where the transfer                 23204000
should have ended.  However, in most cases, the byte                    23206000
count in the channel program can be checked to see if it                23208000
is zero(NOTE: this method may be used iff the channel program           23210000
allows this count to be updated by the I/O processor).                  23212000
                                                                        23214000
     This problem is made a little more cumbersome by                   23216000
the fact that the error returned depends on the type                    23218000
of seek which occurred (whether a seek was issued or                    23220000
an automatic seek by the controller).In the case of seeking             23222000
to a spare track, if the status is following a seek                     23224000
command, then the error returned is illegal access to a                 23226000
spare track.  However, if the status is following an                    23228000
automatic seek as a result of a transfer at the end of a                23230000
track, the error returned is different.  In the latter case             23232000
I think the error returned depends on the address field                 23234000
of the track to which the seek is done.  Since the cases                23236000
that I have encountered have zero in the address field for              23238000
spare tracks which are not assigned as alternates, the error I have     23240000
seen is cylinder miscompare error for this condition.                   23242000
                                                                        23244000
     Note that the HPIB interface for the 7905/06/20/25 disc            23246000
has a similar problem                                                   23248000
on buffered reads.  It does seem that the cases are more                23250000
limit than with the 7910.  The problem seems only to occur              23252000
on reads that would terminate within two                                23254000
sectors of a defective                                                  23256000
area or spare track.  Because data is buffered in advance of            23258000
the actual transfer, an error will be returned even                     23260000
though the error was not in the area of the disc of                     23262000
the requested transfer.  In this situation, it seems to                 23264000
be sufficient to check for a byte residue count of zero.                23266000
The addresses could also be compared to determine if the                23268000
error occured beyond the area of concern.                               23270000
                                                                        23272000
                                                                        23274000
*************************************************************;          23276000
        END <<MH7905>>;                                                 23278000
$CONTROL SEGMENT=RESIDENT                                      <<02510>>23280000
PROCEDURE MH7905(LDEV,DRT,UNIT,STYPE,FUNCT,RECORD,BUF,WC);     <<*DVR*>>23282000
   VALUE LDEV,DRT,UNIT,STYPE,FUNCT,RECORD,BUF,WC;              <<*DVR*>>23284000
   INTEGER LDEV,DRT,UNIT,STYPE,WC;                             <<*DVR*>>23286000
   LOGICAL FUNCT;                                              <<02510>>23288000
   DOUBLE RECORD,BUF;                                          <<02510>>23290000
BEGIN                                                          <<02510>>23292000
$IF X1=OFF << ******* SERIES II/III UNIQUE ******* >>          <<02510>>23294000
   IF SERIESII'III THEN                                        <<02510>>23296000
      BEGIN                                                    <<02510>>23298000
      TOS := DRT;                                              <<*DVR*>>23300000
      ASSEMBLE( TIO 0 );                                       <<02510>>23302000
      IF <> THEN                                               <<02510>>23304000
         BEGIN                                                 <<02510>>23306000
         IF STARFISH THEN                                      <<02510>>23308000
            GO HPIB'DVR                                        <<02510>>23310000
         ELSE                                                  <<02510>>23312000
            ERRMESSAGE(M1,DRT);                                <<*DVR*>>23314000
         END                                                   <<02510>>23316000
      ELSE                                                     <<02510>>23318000
         MH7905'SIO(LDEV,DRTUNIT,STYPE,FUNCT,RECORD,BUF,       <<02510>>23320000
                    WC);                                       <<02510>>23322000
      END                                                      <<02510>>23324000
   ELSE                                                        <<02510>>23326000
$IF << ******** RETURN TO COMMON CODE ********* >>             <<02510>>23328000
HPIB'DVR:                                                      <<02510>>23330000
      MH7905'HPIB(LDEV,DRT,UNIT,STYPE,FUNCT,RECORD,BUF,WC);    <<*DVR*>>23332000
   PUSH( STATUS );                                             <<02510>>23334000
   TOS := TOS.(6:2);                                           <<02510>>23336000
   CC := TOS;                                                  <<02510>>23338000
END;                                                           <<02510>>23340000
$IF X1=ON <<  ******  SERIES 33 UNIQUE  ******* >>             <<02510>>23342000
$CONTROL SEGMENT=RESIDENT                                      <<02510>>23344000
PROCEDURE MHDISC(LDEV,DRT,UNIT,STYPE,FUNCT,RECORD,BUF,WC);     <<*DVR*>>23346000
    VALUE LDEV,DRT,UNIT,STYPE,FUNCT,RECORD,BUF,WC;             <<*DVR*>>23348000
    INTEGER DRT,UNIT,LDEV,STYPE,WC;                            <<*DVR*>>23350000
    LOGICAL FUNCT;                                             <<00888>>23352000
    DOUBLE RECORD,BUF;                                         <<00888>>23354000
BEGIN                                                          <<00888>>23356000
    ERRMESSAGE(M126); <<DRIVER DOES NOT EXIST>>                <<01103>>23358000
END;                                                           <<00888>>23360000
PROCEDURE FHDISC(LDEV,DRT,UNIT,STYPE,FUNCT,RECORD,BUF,WC);     <<*DVR*>>23362000
    VALUE LDEV,DRT,UNIT,STYPE,FUNCT,RECORD,BUF,WC;             <<*DVR*>>23364000
    INTEGER DRT,UNIT,LDEV,STYPE,WC;                            <<*DVR*>>23366000
    LOGICAL FUNCT;                                             <<00888>>23368000
    DOUBLE RECORD,BUF;                                         <<00888>>23370000
BEGIN                                                          <<00888>>23372000
    ERRMESSAGE(M126); <<DRIVER DOES NOT EXIST>>                <<01103>>23374000
END;                                                           <<00888>>23376000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>23378000
$PAGE                                                                   23380000
$CONTROL SEGMENT=RESIDENT                                               23382000
          <<------------------------------>>                   <<00888>>23384000
          <<DISC DRIVER (ABSOLUTE ADDRESS)>>                   <<00888>>23386000
          <<------------------------------>>                   <<00888>>23388000
  PROCEDURE DISC'(WRITE,LDEV,RECORD,BUF,WORDS);                <<00888>>23390000
    VALUE WRITE,LDEV,RECORD,BUF,WORDS;                         <<00888>>23392000
    INTEGER WRITE,    <<0 FOR READ, 1 FOR WRITE>>              <<00888>>23394000
            LDEV,     <<LOGICAL DEVICE #>>                     <<00888>>23396000
            WORDS;    <<# OF WORDS TO TRANSFER>>               <<00888>>23398000
    DOUBLE RECORD,    <<SECTOR ADDRESS>>                       <<00888>>23400000
           BUF;       <<ABSOLUTE CORE ADDRESS>>                <<00888>>23402000
    COMMENT                                                    <<00888>>23404000
      PERFORMS SAME FUNCTION AS PROCEDURE DISC. BUFFER ADDRESS IS       23406000
    ASSUMED TO BE ABSOLUTE;                                    <<00888>>23408000
      BEGIN                                                    <<00888>>23410000
          INTEGER                                              <<*LDT*>>23412000
              LDT'INDEX,                                       <<*DVR*>>23414000
              LPDT'INDEX,                                      <<*DVR*>>23416000
              DVR'INDEX;                                       <<*DVR*>>23418000
          CC := CCE;                                           <<01889>>23420000
          LDT'INDEX := LDEV * LDTSIZE;                         <<*LDT*>>23422000
          LPDT'INDEX := LDEV * LPDTSIZE;                       <<*LPDT>>23424000
          DVR'INDEX  := LDEV * DVRSIZE;                        <<*DVR*>>23426000
          IF WORDS=0 THEN RETURN;                              <<00888>>23428000
          TOS := LDEV;                                         <<00888>>23430000
          TOS := DVRDRTNUM;                                    <<*DVR*>>23432000
          TOS := DVRUNITNUM;                                   <<*DVR*>>23434000
          TOS := LPDT'SUBTYPE;                                 <<*LPDT>>23436000
          TOS := WRITE;                                        <<00888>>23438000
          TOS := RECORD;                                       <<00888>>23440000
          BS1 := 0;                                            <<03603>>23442000
          TOS := BUF;                                          <<00888>>23444000
          TOS := WORDS;                                        <<00888>>23446000
          IF LDT'DEVICE'TYPE = 1 << FH DISC >> THEN            <<*LDT*>>23448000
            TOS := @FHDISC                                     <<*LDT*>>23450000
          ELSE                                                 <<*LDT*>>23452000
            IF LDT'DEVICE'TYPE = 0 << MH DISC >> THEN          <<*LDT*>>23454000
              IF LPDT'SUBTYPE < 4 THEN                         <<*LPDT>>23456000
                TOS := @MHDISC                                 <<*LDT*>>23458000
              ELSE                                             <<*LDT*>>23460000
                IF LPDT'SUBTYPE < NMHSUBTYPES THEN             <<*LPDT>>23462000
                  TOS := @MH7905                               <<*LDT*>>23464000
                ELSE                                           <<*LDT*>>23466000
                  ERRMESSAGE(M126,0)                           <<*LDT*>>23468000
            ELSE                                               <<*LDT*>>23470000
              IF LDT'DEVICE'TYPE = 2 << FLOPPY DISC >> THEN    <<*LDT*>>23472000
                TOS := @MH7905                                 <<*LDT*>>23474000
              ELSE                                             <<*LDT*>>23476000
                IF LDT'DEVICE'TYPE = 3 << CS80 DEVICE >> THEN  <<*LDT*>>23478000
                  TOS := @CS80'DRIVER    <<CALL CS'80>>        <<*LDT*>>23480000
                                         << DRIVER   >>        <<*LDT*>>23482000
                ELSE     << BAD DISC TYPE >>                   <<*LDT*>>23484000
                    ERRMESSAGE(M126,2);                        <<*LDT*>>23486000
          ASSEMBLE(PCAL 0);                                    <<*DVR*>>23488000
                                                               <<03549>>23490000
          PUSH(STATUS);     << PRESERVE CC RETURN FROM      >> <<03549>>23492000
          TOS := TOS.(6:2); << DRIVER.  NOTE: DO NOT        >> <<03549>>23494000
          CC := TOS;        << SHORTEN THESE STEPS--        >> <<03549>>23496000
                            << COMPILER PRODUCES WRONG CODE >> <<03549>>23498000
          << COUNT DISC ACCESSES >>                            <<D9089>>23500000
          TOS := TOTDA;  << LOAD ADDR  >>                      <<D9089>>23502000
          ASMB( LDEA );  << LOAD COUNT >>                      <<D9089>>23504000
          TOS := TOS+1D; << INC COUNT  >>                      <<D9089>>23506000
          ASMB( SDEA );  << STOR COUNT >>                      <<D9089>>23508000
          DDEL;          << DEL ADDRESS>>                      <<D9089>>23510000
      END <<DISC'>> ;                                          <<00888>>23512000
          <<-----------------------------------                         23514000
            DISC DRIVER (DB-RELATIVE ADDRESS)                           23516000
          ----------------------------------->>                         23518000
  PROCEDURE DISC(WRITE,LDEV,RECORD,BUF,WORDS);                          23520000
    VALUE WRITE,LDEV,RECORD,WORDS;                                      23522000
    INTEGER WRITE,       <<0 FOR READ, 1 FOR WRITE>>                    23524000
            LDEV,        <<LOGICAL DEVICE NUMBER OF DISC>>              23526000
            WORDS;       <<NUMBER OF WORDS TO TRANSFER>>                23528000
    DOUBLE RECORD;       <<SECTOR ADDRESS>>                             23530000
    ARRAY BUF;           <<CORE BUFFER>>                                23532000
    COMMENT                                                             23534000
      CALLS THE APPROPRIATE DRIVER BASED ON THE TYPE OF THE DISC        23536000
    FOUND IN THE LDT. THE BUFFER ADDRESS PASSED IS ASSUMED TO BE        23538000
    DB-RELATIVE;                                                        23540000
BEGIN                                                          <<00888>>23542000
   DOUBLE ABSBUF = Q+1;                                        <<00888>>23544000
                                                               <<00888>>23546000
   CC := CCE;                                                  <<01889>>23548000
   PUSH( DB );                                                 <<00888>>23550000
   TOS := TOS+@BUF;                                            <<00888>>23552000
   DISC'( WRITE, LDEV, RECORD, ABSBUF, WORDS);                 <<00888>>23554000
                                                               <<03549>>23556000
   PUSH(STATUS);       << PRESERVE CONDITION CODE RETURN >>    <<03549>>23558000
   TOS := TOS.(6:2);   << FROM DRIVER.  NOTE:  DO NOT    >>    <<03549>>23560000
   CC := TOS;          << SHORTEN THESE STEPS-- COMPILER >>    <<03549>>23562000
                       << PRODUCES WRONG CODE.           >>    <<03549>>23564000
END;                                                           <<00888>>23566000
          <<------------------------                                    23568000
            FLAG A TRACK DEFECTIVE                                      23570000
          ------------------------>>                                    23572000
PROCEDURE FLAGTRACK(LDEV,TRACK,ALT);                                    23574000
  VALUE   LDEV,TRACK,ALT;                                               23576000
  INTEGER LDEV,TRACK,ALT;                                               23578000
    COMMENT                                                             23580000
      FLAGS A TRACK DEFECTIVE ON THE MOVING HEAD DISC, WRITING THE      23582000
    ALTERNATE TRACK ADDRESS IN THE CYLINDER ADDRESS WORD;               23584000
      BEGIN                                                             23586000
        INTEGER STYPE;                                                  23588000
        INTEGER ARRAY B(0:45) = Q;                                      23590000
        INTEGER                                                <<*DVR*>>23592000
            LPDT'INDEX,                                        <<*DVR*>>23594000
            DVR'INDEX;                                         <<*DVR*>>23596000
          LPDT'INDEX := LDEV * LPDTSIZE;                       <<*LPDT>>23598000
          DVR'INDEX  := LDEV * DVRSIZE;                        <<*DVR*>>23600000
          TOS := LDEV;                                                  23602000
          TOS := DVRDRTNUM;                                    <<*DVR*>>23604000
          TOS := DVRUNITNUM;                                   <<*DVR*>>23606000
          TOS := LPDT'SUBTYPE;                                 <<*LPDT>>23608000
          STYPE := S0;                                                  23610000
          TOS := 3;                                                     23612000
          TOS := ALT;  <<ALTERNATE TRACK ADDRESS>>                      23614000
          IF = AND STYPE>3 THEN TOS:=TOS-1;  <<FOR 7905>>               23616000
          IF STYPE=2 THEN ASSEMBLE(TRBC 7);  <<8 BITS ONLY>>            23618000
          B := TOS;                                                     23620000
          TOS := MHINFO (STYPE*MHINFOSIZE + MHSECTRK);         <<25.00>>23622000
          TOS := TRACK;                                                 23624000
          ASSEMBLE(LMPY);                                               23626000
          PUSH(DB);                                                     23628000
          TOS := TOS + @B;                                              23630000
          TOS := 46;  <<WORD COUNT>>                                    23632000
          IF STYPE<4 THEN TOS:=@MHDISC ELSE TOS := @MH7905;             23634000
          ASSEMBLE(PCAL 0);                                             23636000
      END <<FLAGTRACK>> ;                                               23638000
          <<-------------------------------                             23640000
            RETURN ALTERNATE TRACK NUMBER                               23642000
          ------------------------------->>                             23644000
INTEGER PROCEDURE ALTTRACK(LDEV,TRACK);                                 23646000
  VALUE   LDEV,TRACK;                                                   23648000
  INTEGER LDEV,TRACK;                                                   23650000
    COMMENT                                                             23652000
      FINDS THE TRACK NUMBER OF THE ALTERNATE OF THE SPECIFIED TRACK    23654000
    AND RETURNS IT. IF UNABLE TO READ THE ALTERNATE TRACK NUMBER,       23656000
    RETURNS -1;                                                         23658000
      BEGIN                                                             23660000
        INTEGER I := -1;                                                23662000
        INTEGER STYPE;                                                  23664000
        INTEGER INDEX;                                         <<2B.00>>23666000
        INTEGER                                                <<*LPDT>>23668000
            LPDT'INDEX,                                        <<*DVR*>>23670000
            DVR'INDEX;                                         <<*DVR*>>23672000
        DOUBLE SECTOR,BA;                                               23674000
        INTEGER ARRAY B(0:140) = Q;                                     23676000
          LPDT'INDEX := LDEV * LPDTSIZE;                       <<*LPDT>>23678000
          DVR'INDEX  := LDEV * DVRSIZE;                        <<*DVR*>>23680000
          PUSH(DB);                                                     23682000
          TOS := TOS+@B;                                                23684000
          BA := TOS;  <<ABSOLUTE ADDRESS OF B>>                         23686000
          TOS := LPDT'SUBTYPE;                                 <<*LPDT>>23688000
          ASSEMBLE(DUP,STAX);                                           23690000
          STYPE := TOS;  <<SUB TYPE>>                                   23692000
          TOS := MHINFO ((INDEX := STYPE*MHINFOSIZE)+MHSECTRK);<<25.00>>23694000
          TOS := TRACK;                                                 23696000
          ASSEMBLE(LMPY);                                               23698000
          SECTOR := TOS;                                                23700000
          IF STYPE<4 THEN                                               23702000
          WHILE (I:=I+1)<10 DO                                          23704000
            BEGIN                                                       23706000
              MHDISC(LDEV,DVRDRTNUM,DVRUNITNUM,STYPE,4,        <<*DVR*>>23708000
                SECTOR,BA, IF STYPE=3 THEN 4 ELSE 132);        <<*DVR*>>23710000
              X := IF STYPE=3 THEN 2 ELSE 131;                          23712000
              IF B=B(X) THEN                                            23714000
                BEGIN                                                   23716000
                  TOS := B.(2:14);                                      23718000
                  IF STYPE=2 THEN ASSEMBLE(TSBC 7);                     23720000
                  ALTTRACK := TOS;                                      23722000
                  RETURN;                                               23724000
                END;                                                    23726000
            END                                                         23728000
          ELSE WHILE (I:=I+1) < (MHINFO(INDEX+MHSECTRK)-1) DO  <<25.00>>23730000
            BEGIN                                                       23732000
              PUSH(DB);                                                 23734000
              TOS := TOS+@B;                                            23736000
              BA := TOS;                                                23738000
              MH7905(LDEV,DVRDRTNUM,DVRUNITNUM,STYPE,4,        <<*DVR*>>23740000
                     SECTOR+DOUBLE(I),BA,141);                 <<*DVR*>>23742000
              IF B(1)=B(139) AND B(2).(3:5)=B(140).(3:5) THEN           23744000
                BEGIN  <<VALID ALTERNATE ADDRESS>>                      23746000
                  IF B(1)=-1 THEN ALTTRACK := -1                        23748000
                  ELSE IF B(1)=0 AND B(2).(3:5)=0 THEN ALTTRACK:=0      23750000
                  ELSE ALTTRACK := B(1) * MHINFO (INDEX        <<25.00>>23752000
                    +MHTRKCYL)+B(2).(3:5)-MHINFO(INDEX+MHSTHEAD);       23754000
                  RETURN;                                               23756000
                END;                                                    23758000
            END;                                                        23760000
          ALTTRACK := -2;  <<NO GOOD ALT TRACK READ>>                   23762000
      END <<ALTTRACK>> ;                                                23764000
$PAGE "SERIAL DISC DRIVER"                                     <<SD.00>>23766000
$CONTROL SEGMENT=TAPEIO                                        <<03715>>23768000
     <<------------------------------------------->>           <<03715>>23770000
     <<    CHECK FOR A VALID SERIAL DISC LABEL    >>           <<03715>>23772000
     <<------------------------------------------->>           <<03715>>23774000
LOGICAL PROCEDURE VALID'SERDISC(DLABEL,TYPE,SUBTYP);           <<03715>>23776000
VALUE TYPE, SUBTYP;                                            <<03715>>23778000
INTEGER ARRAY                                                  <<03715>>23780000
   DLABEL;      << DISC LABEL >>                               <<03715>>23782000
INTEGER                                                        <<03715>>23784000
   TYPE,        << DEVICE TYPE >>                              <<03715>>23786000
   SUBTYP;      << DEVICE SUBTYPE >>                           <<03715>>23788000
COMMENT                                                        <<03715>>23790000
CHECKS TO SEE IF THE DISC LABEL 'DLABEL' IS VALID FOR A        <<03715>>23792000
SERIAL DISC WITH THE GIVEN TYPE AND SUBTYPE.  IF SO,           <<03715>>23794000
VALID'SERDISC RETURNS TRUE, OTHERWISE FALSE. FURTHERMORE,      <<*8994>>23796000
CHECK FOR LINUS/BUFFALO CARTRIDGE INTERCHANGEABILITY.          <<*8994>>23798000
;                                                              <<03715>>23800000
BEGIN                                                          <<03715>>23802000
BYTE ARRAY                                                     <<03715>>23804000
   BLABEL(*) = DLABEL;                                         <<03715>>23806000
EQUATE                                                         <<*8994>>23808000
   DISC3     = 3;                                              <<*8994>>23810000
                                                               <<03715>>23812000
IF BLABEL(LABVOLB) = "SERDISC" AND                                      23814000
   TYPE = DLABEL(LAB6).LABDTYPE AND                            <<03715>>23816000
   SUBTYP = DLABEL(LAB6).LABDSUBTYPE THEN                      <<03715>>23818000
                                                               <<03715>>23820000
   VALID'SERDISC := TRUE                                       <<03715>>23822000
                                                               <<03715>>23824000
ELSE IF TYPE = DISC3 THEN                                      <<*8994>>23826000
     IF SUBTYP = LINUS OR SUBTYP = BUFFALO  AND                <<*8994>>23828000
        DLABEL(LAB6).LABDSUBTYPE = LINUS OR                    <<*8994>>23830000
        DLABEL(LAB6).LABDSUBTYPE = BUFFALO                     <<*8994>>23832000
        THEN VALID'SERDISC := TRUE                             <<*8994>>23834000
        ELSE VALID'SERDISC := FALSE                            <<*8994>>23836000
                                                               <<03715>>23838000
ELSE VALID'SERDISC := FALSE;                                   <<*8994>>23840000
END;   << VALID'SERDISC >>                                     <<03715>>23842000
$CONTROL SEGMENT=TAPEIO                                        <<03603>>23844000
                                                               <<03598>>23846000
<<------------------------------------------------->>          <<03598>>23848000
                                                               <<03598>>23850000
PROCEDURE TZT'INCR;                                            <<03598>>23852000
                                                               <<03598>>23854000
COMMENT:                                                       <<03598>>23856000
                                                               <<03598>>23858000
   TZT'INCR increments the TZTBUFINDEX and refills TZTBUF      <<03598>>23860000
   when necessary.  It then extracts the TZT'TYPE and          <<03598>>23862000
   TZT'ADDR from the current entry.                 ;          <<03598>>23864000
                                                               <<03598>>23866000
BEGIN  <<Tzt'incr>>                                            <<03598>>23868000
                                                               <<03598>>23870000
   EQUATE  TZT'START   =   4,<<First entry in First Sector>>   <<03598>>23872000
           SYSDSECTLEN = 128;<<Words per Sector on SysDisc>>   <<03598>>23874000
                                                               <<03598>>23876000
   DEFINE  TZT'ADRFLD  = (3:13)#,<<High Order Part of Adr>>    <<03598>>23878000
           TZT'TYPFLD  = (0: 3)#;<< Gap Table Entry Type >>    <<03598>>23880000
                                                               <<03598>>23882000
   IF(TZTBUFINDEX:=TZTBUFINDEX+2) > TZTBUFLEN THEN             <<03598>>23884000
   BEGIN                                                       <<03598>>23886000
      DISC(READ,SYSDISC,SYSD'TZTBASE+DOUBLE(TZTSECTOR),        <<03598>>23888000
                                   TZTBUF,TZTBUFLEN+1);        <<03598>>23890000
      TZTBUFINDEX:=(IF TZTSECTOR=0 THEN TZT'START ELSE 0);     <<03598>>23892000
      TZTSECTOR:=TZTSECTOR+(TZTBUFLEN+1)/SYSDSECTLEN;          <<03598>>23894000
   END;                                                        <<03598>>23896000
   TZT'TYPE:=TZTBUF(TZTBUFINDEX).TZT'TYPFLD;                   <<03598>>23898000
   TOS:=TZTBUF(TZTBUFINDEX).TZT'ADRFLD;                        <<03598>>23900000
   TOS:=TZTBUF(TZTBUFINDEX+1);                                 <<03598>>23902000
   TZT'ADDR:=TOS;                                              <<03598>>23904000
   IF TZT'ADDR+1D<SD'SECTR THEN                                <<03598>>23906000
      ERRMESSAGE(M2326,SDERR17);                               <<03598>>23908000
                                                               <<03598>>23910000
END;   <<Tzt'incr>>                                            <<03598>>23912000
                                                               <<03598>>23914000
<<------------------------------------------------->>          <<03598>>23916000
                                                               <<03598>>23918000
LOGICAL PROCEDURE TZT'INIT;                                    <<03715>>23920000
                                                               <<03598>>23922000
COMMENT:                                                       <<03598>>23924000
                                                               <<03598>>23926000
   TZT'INIT reads and verifies the label on serial discs and   <<03598>>23928000
   initializes the SD GLOBAL variables with the label info.    <<03598>>23930000
   Gets space on Ldev 1 and copies TZT from SerDisc to SysDisc.<<03598>>23932000
   It calls TZT'INCR to fill the TZTBUF the first time.        <<03715>>23934000
   This procedure returns true if a valid serial disc label    <<03715>>23936000
   and TZT are found, false otherwise;                         <<03715>>23938000
                                                               <<03598>>23940000
BEGIN <<Tzt'init>>                                             <<03598>>23942000
                                                               <<03598>>23944000
   EQUATE  SYSDSECTLEN = 128,<<Words per Sector on SysDisc>>   <<03598>>23946000
           SERD'TZTBASE=   4;<<First Sector of Gap Table >>    <<03598>>23948000
                                                               <<03598>>23950000
   DEFINE  SECTR'MLTPLR=(SDISCSECTLEN/SYSDSECTLEN)#;           <<03598>>23952000
                                                               <<03598>>23954000
                                                               <<03602>>23956000
   IF NOT SDISC'TYPE(SYSTAPETYPE,SYSTAPESTYPE) THEN            <<03602>>23958000
      ERRMESSAGE(M2326,SDERR28);<<Not a Valid Serial Disc Dev>><<03602>>23960000
                                                               <<03602>>23962000
                                                               <<03715>>23964000
   DISC(READ,SYSTAPELDEV,0D,RECBUF,128); << Get Sdisc Label >> <<03598>>23966000
                                                               <<03715>>23968000
   IF NOT VALID'SERDISC(RECBUF,SYSTAPETYPE,SYSTAPESTYPE) THEN  <<03715>>23970000
      BEGIN                                                    <<03715>>23972000
      TZT'INIT := FALSE;     << INVALID SERIAL DISC LABEL >>   <<03715>>23974000
      RETURN;                << JUST EXIT                 >>   <<03715>>23976000
      END;                                                     <<03715>>23978000
                                                               <<03715>>23980000
   << init. WDS/SEC, SEC/TRK, BOT, EOT, EOD from Sdisc Label >><<03598>>23982000
   SDISCSECTLEN:=RECBUF(14);                                   <<03598>>23984000
   SDISCBOT:=RECBUF(16);                                       <<03598>>23986000
   TOS:=RECBUF(17);                                            <<03598>>23988000
   TOS:=RECBUF(18);                                            <<03598>>23990000
   EOTSECTR:=TOS;                                              <<03598>>23992000
   TOS:=RECBUF(19);                                            <<03598>>23994000
   TOS:=RECBUF(20);                                            <<03598>>23996000
   EODSECTR:=TOS;                                              <<03598>>23998000
                    <<Get enough space on sysdisc to copy TZT>><<03598>>24000000
   IF SYSD'NSECTS<>0 THEN ERRMESSAGE (M326,SYSDISC);           <<03598>>24002000
   SYSD'NSECTS:=(SDISCBOT-SERD'TZTBASE)*SECTR'MLTPLR;          <<03598>>24004000
   TOS := GETDISCSPACE(SYSDISC, D'L(SYSD'NSECTS)));            <<03715>>24006000
   IF <> THEN                                                  <<03715>>24008000
      ERRMESSAGE(M326,SYSDISC);    << OUT OF DISC SPACE >>     <<03715>>24010000
   SYSD'TZTBASE := TOS;                                        <<03715>>24012000
   TZTSECTOR:=SERD'TZTBASE;                                    <<03598>>24014000
   TZTBUFINDEX:=0;                                             <<03598>>24016000
   DO                                                          <<03598>>24018000
   BEGIN <<Copy TZT from SerDisc to SysDisc>>                  <<03598>>24020000
      DISC(READ,SYSTAPELDEV,DOUBLE(TZTSECTOR),                 <<03598>>24022000
                                 RECBUF,SDISCSECTLEN);         <<03598>>24024000
      DISC(WRITE,SYSDISC,SYSD'TZTBASE+DOUBLE(TZTBUFINDEX),     <<03598>>24026000
                                 RECBUF,SDISCSECTLEN);         <<03598>>24028000
      TZTBUFINDEX:=TZTBUFINDEX+SECTR'MLTPLR;                   <<03598>>24030000
   END   <<Copy TZT from SerDisc to SysDisc>>                  <<03598>>24032000
   UNTIL (TZTSECTOR:=TZTSECTOR+1)=SDISCBOT;                    <<03598>>24034000
   SD'SECTR:=DOUBLE(SDISCBOT);                                 <<03598>>24036000
   NEXTRECINBUF:=FALSE;                                        <<03598>>24038000
   END'OF'TAPE:=FALSE;                                         <<03598>>24040000
   TZTSECTOR:=0;                                               <<03598>>24042000
   TZTBUFINDEX:=TZTBUFLEN;  <<Set to cause buffer overflow &>> <<03598>>24044000
   TZT'INCR;               <<Fill TZTBUF and set TZTBUFINDEX>> <<03598>>24046000
   IF INTEGER(TZTBUF.(3:13))<>SDISCBOT THEN                    <<03598>>24048000
   BEGIN << Invalid TZT, try another disc >>                   <<03598>>24050000
      TZT'INIT := FALSE;     << Take error return >>           <<03715>>24052000
   END;  << Invalid TZT, try another disc >>                   <<03598>>24054000
   TZT'INIT := TRUE;      << Take good return >>               <<03715>>24056000
END;  <<Tzt'init>>                                             <<03598>>24058000
                                                               <<03598>>24060000
<<------------------------------------------------->>          <<03598>>24062000
                                                               <<03598>>24064000
PROCEDURE READBLOCK;                                           <<03598>>24066000
                                                               <<03598>>24068000
COMMENT:                                                       <<03598>>24070000
                                                               <<03598>>24072000
   Readblock fills RECBUF starting at SD'SECTR address         <<03598>>24074000
   on Serial Disc.  It skips around Holes and Cont. Blocks in  <<03598>>24076000
   order to fill buffer, but returns partial bkock if an eof is<<03598>>24078000
   encountered.  Sets WORDSINRECBUF and resets RECBUFINDEX.;   <<03598>>24080000
                                                               <<03598>>24082000
BEGIN <<Readblock>>                                            <<03598>>24084000
                                                               <<03598>>24086000
   DOUBLE  ENDSECTOR;                                          <<03598>>24088000
   INTEGER OFFSET:=0,                                          <<03598>>24090000
           WRDCNT,                                             <<03598>>24092000
           GAPTYPE,                                            <<03598>>24094000
           EOF;                                                <<03598>>24096000
                                                               <<03598>>24098000
   CC:=CCE;       <<check serial disc unit is on line>>        <<03598>>24100000
   IF NOT SD'ONLINE THEN ERRMESSAGE(M2326,SDERR24);            <<03598>>24102000
   DISCINRECBUF:=SD'SECTR;                                     <<03598>>24104000
   DO                                                          <<03598>>24106000
   BEGIN  <<Try to Read a Block from Sdisc>>                   <<03598>>24108000
      ENDSECTOR:=SD'SECTR                                      <<03598>>24110000
                +DOUBLE((RECBUFLEN+1)/SDISCSECTLEN)            <<03598>>24112000
                -DOUBLE(OFFSET/SDISCSECTLEN)-1D;               <<03598>>24114000
      IF TZT'ADDR > ENDSECTOR THEN                             <<03598>>24116000
      BEGIN  <<No Problems with Transfer>>                     <<03598>>24118000
         DISC(READ,SYSTAPELDEV,SD'SECTR,                       <<03598>>24120000
              RECBUF(OFFSET),RECBUFLEN+1-OFFSET);              <<03598>>24122000
         SD'SECTR:=ENDSECTOR+1D;                               <<03598>>24124000
         RECBUFINDEX:=0;                                       <<03598>>24126000
         NEXTRECINBUF:=TRUE;   <<True>>                        <<03598>>24128000
         WORDSINRECBUF:=RECBUFLEN+1;                           <<03598>>24130000
         RETURN;                                               <<03598>>24132000
      END    <<No Problems with Transfer>>                     <<03598>>24134000
      ELSE                                                     <<03598>>24136000
      BEGIN  <<Will Hit Gap or Eof Before End of Block>>       <<03598>>24138000
         EOF:=(IF TZT'TYPE=0 OR TZT'TYPE=6 THEN 1 ELSE 0);     <<03598>>24140000
         WRDCNT:=(INTEGER(TZT'ADDR-SD'SECTR)+EOF)              <<03598>>24142000
                 *SDISCSECTLEN;                                <<03598>>24144000
         IF WRDCNT+OFFSET > RECBUFLEN+1 THEN                   <<03598>>24146000
            ERRMESSAGE(M2326,SDERR31);                         <<03598>>24148000
         IF WRDCNT>0 THEN                                      <<03598>>24150000
            DISC(READ,SYSTAPELDEV,SD'SECTR,                    <<03598>>24152000
                 RECBUF(OFFSET),WRDCNT);                       <<03598>>24154000
         OFFSET:=OFFSET+WRDCNT;                                <<03598>>24156000
         IF (GAPTYPE:=TZT'TYPE)=2 OR GAPTYPE=4 THEN            <<03598>>24158000
         BEGIN                                                 <<03598>>24160000
            TZT'INCR;                                          <<03598>>24162000
            IF GAPTYPE+1<>TZT'TYPE THEN                        <<03598>>24164000
               ERRMESSAGE(M2326,SDERR17);<<Out of Sync w TZT>> <<03598>>24166000
            SD'SECTR:=TZT'ADDR+1D;                             <<03598>>24168000
            TZT'INCR;                                          <<03598>>24170000
         END;                                                  <<03598>>24172000
      END;   <<Will Hit Gap or Eof Before End of Block>>       <<03598>>24174000
   END    <<Try to Read a Block from Sdisc>>                   <<03598>>24176000
   UNTIL EOF=1;                                                <<03598>>24178000
   WORDSINRECBUF:=OFFSET;                                      <<03598>>24180000
   RECBUFINDEX:=0;                                             <<03598>>24182000
   NEXTRECINBUF:=TRUE;   <<True>>                              <<03598>>24184000
END;  <<Readblock>>                                            <<03598>>24186000
                                                               <<03598>>24188000
<<------------------------------------------------->>          <<03598>>24190000
                                                               <<03598>>24192000
PROCEDURE SDISCCTRL(CONTROL);                                  <<03598>>24194000
VALUE CONTROL;                                                 <<03598>>24196000
INTEGER CONTROL;                                               <<03598>>24198000
                                                               <<03598>>24200000
COMMENT:                                                       <<03598>>24202000
                                                               <<03598>>24204000
   SDISCCTRL simulates tape control functions for Serial Disc  <<03598>>24206000
                                                               <<03598>>24208000
   Valid Control Functions:  %10 - Rewind                      <<03598>>24210000
                             %11 - Rewind and Unload           <<03598>>24212000
                             %12 - Wait for New Mount          <<03598>>24214000
                             %17 - Forward Space File       ;  <<03598>>24216000
                                                               <<03598>>24218000
BEGIN  <<Sdiscctrl>>                                           <<03598>>24220000
                                                               <<03598>>24222000
   EQUATE  UNLOAD    = 26;  << UNLOAD LINUS FUNCTION >>        <<03672>>24224000
   EQUATE  TZT'START = 4;<<First entry in First Sector>>       <<03598>>24226000
                                                               <<03598>>24228000
   CC := CCE;       << INITIALIZE CC RETURN >>                 <<03715>>24230000
                                                               <<03715>>24232000
   CASE (CONTROL-%10) OF                                       <<03598>>24234000
   BEGIN <<Case on Function>>                                  <<03598>>24236000
                                                               <<03598>>24238000
      BEGIN <<%10-Rewind>>                                     <<03598>>24240000
        IF SYSTAPETYPE =  2 << FLOPPY DISC >> THEN             <<*LDT*>>24242000
          DISC(INIT'DEV,SYSTAPELDEV,0D,DTEMP,2);               <<04844>>24244000
                                                               <<04844>>24246000
         << IF SERIAL DISC IS CS'80 TYPE, DISABLE >>           <<03715>>24248000
         << RELEASE TIMEOUT.                      >>           <<03715>>24250000
                                                               <<03715>>24252000
         IF SYSTAPETYPE = 3 << CS80 DEVICE >> THEN             <<*LDT*>>24254000
            DISC(LOCK'DEV,SYSTAPELDEV,0D,DTEMP,2);             <<03715>>24256000
                                                               <<03715>>24258000
         SD'ONLINE:=TRUE;                                      <<03602>>24260000
         IF NOT TZT'INIT THEN         << READ IN TZT >>        <<03715>>24262000
            ERRMESSAGE(M2326,SDERR28);    << BAD TZT >>        <<03715>>24264000
      END;  <<%10-Rewind>>                                     <<03598>>24266000
                                                               <<03598>>24268000
      BEGIN <<%11-Rewind and Unload>>                          <<03598>>24270000
         SD'ONLINE:=FALSE;  <<False>>                          <<03598>>24272000
         NEXTRECINBUF:=FALSE;  <<False>>                       <<03598>>24274000
         TZTBUFINDEX:=TZT'START;                               <<03598>>24276000
         TZTSECTOR:=0;                                         <<03598>>24278000
         IF SYSD'NSECTS<>0 THEN   <<Return SysDisc space held>><<03598>>24280000
            RETDISCSPACE(SYSDISC,D'L(SYSD'NSECTS)),            <<03715>>24282000
                                     SYSD'TZTBASE);            <<03715>>24284000
         SYSD'NSECTS:=0;                                       <<03598>>24286000
         SYSD'TZTBASE:=0D;                                     <<03598>>24288000
                                                               <<03672>>24290000
         << IF CS'80 TYPE, SEND UNLOCK TO RE-ENABLE RELEASE >> <<03715>>24292000
         << TIMEOUT, SO THE USER CAN UNLOAD THE PACK.       >> <<03715>>24294000
         << IF IT IS A LINUS, WE ALSO SEND AN UNLOAD TO     >> <<03715>>24296000
         << UNLOAD THE CARTRIDGE OURSELVES.                 >> <<03715>>24298000
                                                               <<03672>>24300000
         IF SYSTAPETYPE = 3 << CS80 DEVICE >> THEN             <<*LDT*>>24302000
            BEGIN                                              <<03672>>24304000
            DISC(UNLOCK'DEV,SYSTAPELDEV,0D,RECBUF,10);         <<03715>>24306000
            IF SYSTAPESTYPE = LINUS OR                         <<*8392>>24308000
               SYSTAPESTYPE = BUFFALO THEN                     <<*8392>>24310000
               DISC(UNLOAD,SYSTAPELDEV,0D,RECBUF,10);          <<03672>>24312000
            END;                                               <<03672>>24314000
      END;  <<%11-Rewind and Unload>>                          <<03598>>24316000
                                                               <<03598>>24318000
      BEGIN <<%12 - Wait for Sdisc to be readied>>             <<03598>>24320000
         SD'ONLINE := FALSE;                                   <<03715>>24322000
         DO UNTIL LGETYESNO(M2332);       << Ready? >>         <<03715>>24324000
                                                               <<03715>>24326000
         << CLEAR SERIAL DISC >>                               <<03715>>24328000
         DISC(INIT'DEV,SYSTAPELDEV,0D,DTEMP,2);                <<03715>>24330000
                                                               <<03715>>24332000
         DISC(RSTAT,SYSTAPELDEV,0D,DTEMP,2);   <<READ STATUS>> <<03715>>24334000
         IF DTEMP2.NREADYF = 1 THEN                            <<03715>>24336000
            BEGIN               << SERIAL DISC IS NOT READY >> <<03715>>24338000
            MESSAGE(M2408,SYSTAPELDEV);    <<LDEV NOT READY>>  <<03715>>24340000
            CC := CCG;                     << RETURN CCG   >>  <<03715>>24342000
            RETURN;                                            <<03715>>24344000
            END;                                               <<03715>>24346000
                                                               <<03715>>24348000
         << IF SERIAL DISC IS CS'80 TYPE, DISABLE >>           <<03715>>24350000
         << RELEASE TIMEOUT.                      >>           <<03715>>24352000
                                                               <<03715>>24354000
         IF SYSTAPETYPE = 3 << CS80 DEVICE >> THEN             <<*LDT*>>24356000
            DISC(LOCK'DEV,SYSTAPELDEV,0D,DTEMP,2);             <<03715>>24358000
                                                               <<03715>>24360000
         SD'ONLINE := TRUE;                                    <<03715>>24362000
         IF NOT TZT'INIT THEN     << READ IN GAP TABLE >>      <<03715>>24364000
            BEGIN                 << BAD SERIAL DISC FORMAT >> <<03715>>24366000
            MESSAGE(M2333,SYSTAPEDRT,      << NOT SERIAL >>    <<03715>>24368000
                          SYSTAPEUNIT);                        <<03715>>24370000
            CC := CCG;                     << RETURN CCG >>    <<03715>>24372000
            RETURN;                                            <<03715>>24374000
            END;                                               <<03715>>24376000
      END;  <<%12 - Wait for Sdisc to be readied>>             <<03598>>24378000
                                                               <<03598>>24380000
      ;;;;  <<%13-%16>>                                        <<03598>>24382000
                                                               <<03598>>24384000
      BEGIN <<%17-Forward Space File>>                         <<03598>>24386000
         WHILE (2<=TZT'TYPE<=5) DO TZT'INCR;                   <<03598>>24388000
         SD'SECTR:=TZT'ADDR+1D;                                <<03598>>24390000
         IF TZT'TYPE=1 OR TZT'TYPE=6 THEN END'OF'TAPE:=TRUE;   <<03598>>24392000
         TZT'INCR;                                             <<03598>>24394000
         NEXTRECINBUF:=FALSE;  <<False>>                       <<03598>>24396000
      END;  <<%17-Forward Space File>>                         <<03598>>24398000
   END;  <<Case on Function>>                                  <<03598>>24400000
END;  <<Sdiscctrl>>                                            <<03598>>24402000
                                                               <<03598>>24404000
<<------------------------------------------------->>          <<03598>>24406000
                                                               <<03598>>24408000
INTEGER PROCEDURE READSDISC(BUFFER,WORDC);                     <<03598>>24410000
VALUE WORDC;  INTEGER WORDC;  ARRAY BUFFER;                    <<03598>>24412000
                                                               <<03598>>24414000
COMMENT:                                                       <<03598>>24416000
                                                               <<03598>>24418000
   READSDISC Transfers the next logical record from the        <<03598>>24420000
   Serial Disc Buffer to the User's Buffer.           ;        <<03598>>24422000
                                                               <<03598>>24424000
BEGIN  <<Readsdisc>>                                           <<03598>>24426000
                                                               <<03598>>24428000
   INTEGER NEXTBUFINDEX,                                       <<03598>>24430000
           NEXTWORD,                                           <<03598>>24432000
           RECLEN,                                             <<03598>>24434000
           BYTEC,                                              <<03598>>24436000
           TRANSFERC,                                          <<03598>>24438000
           TRANSFERLENGTH;                                     <<03598>>24440000
   LOGICAL TRANSFERMODE,                                       <<03598>>24442000
           TRANSFERCOMPLETE;                                   <<03598>>24444000
   DOUBLE  STARTSECTOR;                                        <<03598>>24446000
   BYTE POINTER BPTEMP1,                                       <<03598>>24448000
                BPTEMP2;                                       <<03598>>24450000
   DEFINE  BYTES=TRUE#;                                        <<03598>>24452000
                                                               <<03598>>24454000
   EQUATE  EOT'RECLN  = -2,                                    <<03598>>24456000
           FILLCHAR   = -1,                                    <<03598>>24458000
           EOF'RECLN  =  0;                                    <<03598>>24460000
                                                               <<03598>>24462000
                                                               <<03598>>24464000
   CC:=CCE;                                                    <<03598>>24466000
   IF NOT SD'ONLINE THEN ERRMESSAGE(M2326,SDERR24);            <<03598>>24468000
   IF NOT NEXTRECINBUF THEN READBLOCK;                         <<03598>>24470000
   IF RECBUFINDEX>=WORDSINRECBUF THEN                          <<03598>>24472000
      ERRMESSAGE(M2326,SDERR23);                               <<03598>>24474000
   STARTSECTOR:=DISCINRECBUF+DOUBLE(RECBUFINDEX/               <<03598>>24476000
      SDISCSECTLEN);                                           <<03598>>24478000
   RECLEN:=RECBUF(RECBUFINDEX);                                <<03598>>24480000
   IF RECLEN=EOF'RECLN OR RECLEN=EOT'RECLN THEN                <<03598>>24482000
   BEGIN  <<End of File>>                                      <<03598>>24484000
      IF RECLEN=EOT'RECLN THEN END'OF'TAPE:=TRUE;  <<True>>    <<03598>>24486000
      IF RECLEN=EOF'RECLN THEN CC:=CCG;                        <<03598>>24488000
      RECBUFINDEX:=(RECBUFINDEX/SDISCSECTLEN+1)                <<03598>>24490000
         *SDISCSECTLEN;                                        <<03598>>24492000
      IF RECBUFINDEX>=WORDSINRECBUF THEN                       <<03598>>24494000
         NEXTRECINBUF:=FALSE;  <<FALSE>>                       <<03598>>24496000
      IF STARTSECTOR=TZT'ADDR THEN                             <<03598>>24498000
      BEGIN                                                    <<03598>>24500000
         SD'SECTR:=TZT'ADDR+1D;                                <<03598>>24502000
         TZT'INCR;                                             <<03598>>24504000
         RETURN;                                               <<03598>>24506000
      END                                                      <<03598>>24508000
      ELSE ERRMESSAGE(M2326,SDERR17);<<Out of Sync with TZT>>  <<03598>>24510000
   END;   <<End of File>>                                      <<03598>>24512000
   IF RECLEN=FILLCHAR THEN                                     <<03598>>24514000
   BEGIN  <<Must be Last Sector Before a Gap>>                 <<03598>>24516000
      RECBUFINDEX:=(RECBUFINDEX/SDISCSECTLEN+1)                <<03598>>24518000
         *SDISCSECTLEN;                                        <<03598>>24520000
      IF RECBUFINDEX>=WORDSINRECBUF THEN                       <<03598>>24522000
      BEGIN <<Transfer>>                                       <<03598>>24524000
         READBLOCK;                                            <<03598>>24526000
         RECLEN:=RECBUF(RECBUFINDEX);                          <<03598>>24528000
      END;  <<Transfer>>                                       <<03598>>24530000
   END;   <<Must be Last Sector Before a Gap>>                 <<03598>>24532000
   NEXTBUFINDEX:=RECBUFINDEX+(RECLEN+1)&LSR(1)+2;              <<03598>>24534000
   IF WORDC<0 THEN TRANSFERMODE:=BYTES; <<TRUE>>               <<03598>>24536000
   BYTEC:=IF WORDC<0 THEN -WORDC ELSE WORDC&LSL(1);            <<03598>>24538000
   TRANSFERC:=IF BYTEC>RECLEN THEN RECLEN ELSE BYTEC;          <<03598>>24540000
   READSDISC:=IF WORDC<0 THEN TRANSFERC                        <<03598>>24542000
                 ELSE (TRANSFERC+1)&LSR(1);                    <<03598>>24544000
   TRANSFERCOMPLETE:=FALSE;                                    <<03598>>24546000
   NEXTWORD:=RECBUFINDEX+1;                                    <<03598>>24548000
   TOS:=@BUFFER;                                               <<03598>>24550000
   DO                                                          <<03598>>24552000
   BEGIN <<Move Rec to User Buffer>>                           <<03598>>24554000
      IF (TRANSFERC+1)&LSR(1)+RECBUFINDEX<=RECBUFLEN THEN      <<03598>>24556000
      BEGIN  <<Transfer can be completed>>                     <<03598>>24558000
         MOVE *:=RECBUF(NEXTWORD),(TRANSFERC&LSR(1)),1;        <<03598>>24560000
         IF TRANSFERMODE AND LOGICAL(TRANSFERC) THEN           <<03598>>24562000
         BEGIN  <<Move Last Byte>>                             <<03598>>24564000
            @BPTEMP1 := TOS&LSL(1);                            <<03715>>24566000
            @BPTEMP2 := TOS&LSL(1);                            <<03715>>24568000
            MOVE BPTEMP2:=BPTEMP1,(1);                         <<03598>>24570000
         END    <<Move Last Byte>>                             <<03598>>24572000
         ELSE                                                  <<03598>>24574000
         DDEL;                                                 <<03598>>24576000
         TRANSFERCOMPLETE:=TRUE;                               <<03598>>24578000
      END    <<Transfer can be Completed>>                     <<03598>>24580000
      ELSE                                                     <<03598>>24582000
      BEGIN  <<Transfer Remainder of Recbuff>>                 <<03598>>24584000
         MOVE *:=RECBUF(NEXTWORD),(TRANSFERLENGTH:=            <<03598>>24586000
         RECBUFLEN-NEXTWORD+1),2;                              <<03598>>24588000
         NEXTBUFINDEX:=NEXTBUFINDEX-WORDSINRECBUF;             <<03598>>24590000
         READBLOCK;                                            <<03598>>24592000
         NEXTWORD:=0;                                          <<03598>>24594000
         TRANSFERC:=TRANSFERC-TRANSFERLENGTH&LSL(1);           <<03598>>24596000
      END;   <<Transfer Remainder of Recbuff>>                 <<03598>>24598000
   END    <<Transfer Record to User Buffer>>                   <<03598>>24600000
   UNTIL TRANSFERCOMPLETE;                                     <<03598>>24602000
   IF NEXTBUFINDEX>=WORDSINRECBUF THEN                         <<03598>>24604000
   BEGIN                                                       <<03598>>24606000
      NEXTBUFINDEX:=NEXTBUFINDEX-WORDSINRECBUF;                <<03598>>24608000
      READBLOCK;                                               <<03598>>24610000
   END;                                                        <<03598>>24612000
   RECBUFINDEX:=NEXTBUFINDEX;                                  <<03598>>24614000
   IF RECBUFINDEX>0 THEN                                       <<03598>>24616000
      IF INTEGER(RECBUF(RECBUFINDEX-1))<>RECLEN THEN           <<03598>>24618000
         ERRMESSAGE(M2326,SDERR30);<<Ld & Tr Reclen Mismatch>> <<03598>>24620000
END;   <<Readsdisc>>                                           <<03598>>24622000
                                                               <<03598>>24624000
<<------------------------------------------------->>          <<03598>>24626000
                                                               <<03598>>24628000
INTEGER PROCEDURE SDISCDVR(FUNC, BUF, WORDC);                  <<03598>>24630000
VALUE FUNC,WORDC;  INTEGER FUNC,WORDC;  ARRAY BUF;             <<03598>>24632000
                                                               <<03598>>24634000
COMMENT                                                        <<03598>>24636000
                                                               <<03598>>24638000
   SDISCDRVR serves as an outer block for the Serial Disc      <<03598>>24640000
   Routines.  It translates the function Codes and Xfers       <<03598>>24642000
   Control to the Appropriate Procedure to do the work.  ;     <<03598>>24644000
                                                               <<03598>>24646000
BEGIN  <<Sdiscdrvr>>                                           <<03598>>24648000
                                                               <<03598>>24650000
   EQUATE  SDISCREWIND    = %10,                               <<03598>>24652000
           SDISCREWUNLOAD = %11, <<Serial Disc Funct Codes>>   <<03598>>24654000
           SDISCTAPEREADY = %12, <<are Different than Tape>>   <<03598>>24656000
           SDISCFWDSPFILE = %17; <<Function Codes>>            <<03598>>24658000
                                                               <<03598>>24660000
   CC:=CCE;                                                    <<03598>>24662000
   CASE FUNC OF                                                <<03598>>24664000
   BEGIN  <<Case on Function>>                                 <<03598>>24666000
      SDISCDVR:=READSDISC(BUF,WORDC);                          <<03598>>24668000
      SDISCCTRL(SDISCREWUNLOAD);                               <<03598>>24670000
      SDISCCTRL(SDISCFWDSPFILE);                               <<03598>>24672000
      SDISCCTRL(SDISCTAPEREADY);                               <<03598>>24674000
      SDISCCTRL(SDISCREWIND);                                  <<03598>>24676000
   END;   <<Case on Function>>                                 <<03598>>24678000
   IF > THEN                                                   <<03598>>24680000
      CC := CCG                                                <<03598>>24682000
   ELSE                                                        <<03598>>24684000
      IF < THEN                                                <<03598>>24686000
      BEGIN                                                    <<03598>>24688000
         SDISCDVR := 1;  << Flag Fatal Error >>                <<03598>>24690000
         CC := CCL;                                            <<03598>>24692000
      END;                                                     <<03598>>24694000
END;   <<Sdiscdrvr>>                                           <<03598>>24696000
                                                               <<03598>>24698000
<<------------------------------------------------->>          <<03598>>24700000
                                                               <<03598>>24702000
$PAGE "MAG TAPE DRIVER"                                                 24704000
$CONTROL SEGMENT=TAPEIO                                        <<03603>>24706000
          <<----------------------------------                          24708000
            EXECUTE SIO PROGRAM FOR MAG TAPE                            24710000
          ---------------------------------->>                          24712000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>24714000
  INTEGER PROCEDURE TAPESIO;                                            24716000
    <<  THIS PROCEDURE USES GLOBAL DB RELATIVE VARIABLES SO  >><<01028>>24718000
    <<  DB MUST NOT BE SWITCHED TO SIO PROGRAM AREA ON ENTRY.>><<01028>>24720000
    COMMENT                                                             24722000
      EXECUTES AN SIO PROGRAM ON THE SYSTEM MAG TAPE;                   24724000
      BEGIN                                                             24726000
        INTEGER STATUS = TAPESIO;                              <<01028>>24728000
          TOS := SYSTAPEDRT;                                   <<01028>>24730000
          TOS := ABSOLUTE(SIOPROG);                                     24732000
  DOSIO:  ASSEMBLE( SIO 1 );                                   <<01103>>24734000
          IF < THEN ERRMESSAGE(M1,S1);                         <<01103>>24736000
          IF > THEN                                                     24738000
            BEGIN  <<CMD REJECTED>>                                     24740000
              IF TOS.(2:1) THEN                                         24742000
                BEGIN  <<INTERRUPT>>                                    24744000
                  TOS := %40000;                                        24746000
                  CIO2;                                        <<01103>>24748000
                END;                                                    24750000
              GOTO DOSIO;                                               24752000
            END;                                                        24754000
  TEST:   TIO0;                                                <<01103>>24756000
          STATUS:=TOS;                                         <<01028>>24758000
          IF STATUS.(2:1) = 1 THEN                             <<01028>>24760000
            BEGIN  <<INTERRUPT>>                                        24762000
              TOS := %40000;                                            24764000
              CIO1;                                            <<01103>>24766000
              IF STATUS.(3:2)=SYSTAPEUNIT THEN RETURN;         <<01028>>24768000
            END;                                                        24770000
          GOTO TEST;                                                    24772000
      END <<TAPESIO>> ;                                                 24774000
          <<---------------------------                                 24776000
            INSURE TAPE UNIT IS READY                                   24778000
          --------------------------->>                                 24780000
  PROCEDURE READYTAPE;                                         <<00678>>24782000
    COMMENT                                                             24784000
      INSURES THAT UNIT ZERO OF THE SYSTEM MAG TAPE IS READY;           24786000
      BEGIN                                                             24788000
        LOGICAL STATUS;                                        <<04443>>24790000
          TOS := SYSTAPEDRT;                                   <<01028>>24792000
          <<WAIT UNTIL INTERRUPT REQUEST IS TRUE>>             <<00.06>>24794000
          <<I.E.  UNTIL "UNIT NOT READY" BECOMES "READY">>     <<00.06>>24796000
  TEST:   TIO0;                                                <<01103>>24798000
          STATUS:= S0;                                         <<04443>>24800000
          IF NOT TOS.(2:1) THEN GOTO TEST;                              24802000
          TOS:=%40000; <<CLEAR INTERRUPT REQUEST FLAG>>        <<00.06>>24804000
          CIO1;                                                <<01103>>24806000
          IF INTEGER(STATUS.(3:2))<>SYSTAPEUNIT THEN GOTO TEST;<<04443>>24808000
          IF NOT STATUS.(7:1) THEN                             <<04443>>24810000
            BEGIN                                              <<01092>>24812000
              MESSAGE(M2407,SYSTAPEUNIT);                      <<01103>>24814000
              GO TO TEST;                                      <<01092>>24816000
            END;                                               <<01092>>24818000
          CC:= CCE;                                            <<04443>>24820000
      END <<TAPEREADY>> ;                                               24822000
          <<-----------------------------                               24824000
            OUTPUT CONTROL TO TAPE UNIT                                 24826000
          ----------------------------->>                               24828000
INTEGER PROCEDURE TAPECTRL(CONTROL);                           <<01103>>24830000
    VALUE CONTROL;                                                      24832000
    INTEGER CONTROL;   <<CONTROL WORD>>                                 24834000
    COMMENT                                                             24836000
      OUTPUTS A CONTROL WORD TO THE SYSTEM TAPE DRIVE;                  24838000
      BEGIN                                                             24840000
        INTEGER ARRAY STATUS'TO'MESSAGE(0:7) = PB :=           <<01103>>24842000
          M0,M6,M5,M9,M8,M7,M6,M0;                             <<01103>>24844000
        INTEGER UNIT, STATUS;                                  <<01028>>24846000
        ARRAY S(*)=DB+0;  <<SIO PROGRAM BUFFER>>                        24848000
        UNIT:=SYSTAPEUNIT;                                     <<01028>>24850000
        CC := CCE;                                             <<01092>>24852000
          TOS := 0;                                                     24854000
          TOS := ABSOLUTE(SIOPROG);                                     24856000
          ASSEMBLE(XCHD);  <<SET DB TO SIO PROGRAM BUFFER>>             24858000
          S := SIOCNTRL;                                                24860000
          S(1) := UNIT&LSL(8);  <<UNIT NUMBER TO BITS 6&7>>    <<01028>>24862000
          S(2) := SIOCNTRL;                                             24864000
          S(3) := CONTROL;                                              24866000
          S(4) := SIOENDINT;                                            24868000
          S(5) := 0;                                                    24870000
          SET(DB);  <<RESET DB>>                                        24872000
          STATUS := TAPESIO;  <<EXECUTE SIO PROGRAM>>          <<01028>>24874000
          <<TAPESIO WILL LOOP IF STAT IS NOT FOR SYSTAPEUNIT >><<01028>>24876000
          <<SO NO NEED TO RECHECK IT FOR CORRRECT UNIT HERE. >><<01028>>24878000
                                                               <<01028>>24880000
          TAPECTRL := STATUS'TO'MESSAGE(STATUS.(12:3));        <<01103>>24882000
          IF = THEN RETURN;                                    <<01103>>24884000
          CC := CCL;                                           <<01092>>24886000
                                                               <<01092>>24888000
          RETURN;                                              <<01028>>24890000
      END <<TAPECTRL>> ;                                                24892000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>24894000
          <<---------------------------                                 24896000
            READ RECORD FROM MAG TAPE                                   24898000
          --------------------------->>                                 24900000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>24902000
  INTEGER PROCEDURE READTAPE (BUF, WORDS);                     <<01122>>24904000
    VALUE WORDS;                                               <<01122>>24906000
    ARRAY BUF;      <<CORE BUFFER>>                                     24908000
    INTEGER WORDS;  <<TRANSFER LENGTH>>                                 24910000
    COMMENT                                                             24912000
      READS A RECORD OF LENGTH WORDS FROM THE SYSTEM MAG TAPE INTO      24914000
    THE CORE BUFFER BUF.  RETURNS # OF WORDS READ.             <<00.06>>24916000
    STATUS ON RETURN:                                          <<00.06>>24918000
      CCL-TAPE READ ERROR                                      <<01122>>24920000
      CCG-EOF READ                                             <<00.06>>24922000
      CCE-RECORD READ OKAY                                     <<00.06>>24924000
      ;                                                        <<00.06>>24926000
      BEGIN                                                             24928000
        INTEGER ARRAY STATUS'TO'MESSAGE(0:7) = PB :=           <<01103>>24930000
          M0,M6,M5,M9,M8,M7,M6,M0;                             <<01103>>24932000
        EQUATE BSCOM     =    %12,     <<TAPE BACKSPACE COMMAND>>       24934000
               RDRCOM    =    %6;      <<TAPE READ RECORD COMMAND>>     24936000
        DEFINE EOFFLD    =    (11:1)#, <<END OF FILE>>                  24938000
               RESFLD    =    (12:3)#; <<RESIDUE>>                      24940000
        INTEGER UNIT;                                          <<01028>>24942000
        DOUBLE STACKDB;                                                 24944000
        INTEGER STACKDB1=STACKDB,STACKDB2=STACKDB+1;                    24946000
        LOGICAL STATUS;                                                 24948000
        INTEGER ERRCNT:=0;             <<NUMBER OF TAPE ERRORS>>        24950000
        ARRAY S(*)=DB+0;   <<SIO PROGRAM BUFFER>>                       24952000
        STAT.(6:2):=CCE; <<ALL OKAY>>                          <<SD.00>>24954000
        UNIT:=SYSTAPEUNIT;                                     <<01028>>24956000
  AGAIN:                                                                24958000
          IF WORDS = 0 THEN RETURN;                            <<03603>>24960000
          TOS := @BUF;  <<DB-RELATIVE ADDRESS>>                         24962000
          TOS := 0;                                                     24964000
          TOS := ABSOLUTE(SIOPROG);                                     24966000
          ASSEMBLE(XCHD);  <<SET DB TO SIO PROGRAM BUFFER>>             24968000
          STACKDB := TOS;  <<SAVE STACK DB>>                            24970000
          S := SIOCNTRL;                                                24972000
          S(1) := UNIT&LSL(8); <<SELECT UNIT>>                 <<01028>>24974000
          S(2) := SIOCNTRL;                                             24976000
          S(3) := RDRCOM;                                               24978000
          S(4) := SIOBANK;                                              24980000
          S(5) := STACKDB1;  <<BANK ADDRESS>>                           24982000
          TOS := WORDS;                                                 24984000
          S(6) := (-TOS) CAT 0(0:15:1);                                 24986000
          S(7) := TOS+STACKDB2;   <<BUFFER ADDRESS>>                    24988000
          S(8) := SIORES;                                               24990000
          S(9) := 0;                                                    24992000
          S(10) := SIOENDINT;                                           24994000
          S(11) := 0;                                                   24996000
          TOS := STACKDB;                                      <<01028>>24998000
          SET(DB);  << RESET DB TO STACK >>                    <<01028>>25000000
          STATUS:=TAPESIO; <<EXECUTE SIO PROGRAM>>             <<00.06>>25002000
          IF STATUS.EOFFLD THEN TOS:= CCG ELSE TOS:=CCE;                25004000
          STAT.(6:2) := TOS;  <<SET CONDITION CODE FOR EOF>>            25006000
          TOS := WORDS;                                                 25008000
          TOS := 0;                                            <<01028>>25010000
          TOS := ABSOLUTE(SIOPROG) + 9;                        <<01028>>25012000
          ASSEMBLE(LSEA; DELB, DELB);  << TOS := S(9) >>       <<01028>>25014000
          ASSEMBLE(NEG; LSL 4; LSR 4; NEG,ADD);                         25016000
          READTAPE := TOS;  <<# OF WORDS READ>>                         25018000
          IF STATUS.RESFLD = 4 OR STATUS.RESFLD = 5 THEN       <<01028>>25020000
            << TIMING/PARITY ERROR RESPECTIVELY >>             <<01028>>25022000
            IF (ERRCNT := ERRCNT + 1) < 10 THEN                <<01028>>25024000
              BEGIN                                            <<01028>>25026000
                TOS := %100000;                                <<01028>>25028000
                WHILE (TOS:=TOS-1)>0 DO <<DELAY FOR ..>>       <<00888>>25030000
                      BEGIN END;  <<..MULTIPLE TAPE ERRORS>>   <<00888>>25032000
                TOS := SYSTAPEDRT;  <<CLEAR SECOND INTERRUPT>> <<01028>>25034000
                TOS := SIOCNTRL;                               <<00888>>25036000
                CIO1; DEL;                                     <<01103>>25038000
                TAPECTRL(BSCOM);                               <<01028>>25040000
                GO AGAIN;                                      <<00888>>25042000
              END;                                             <<00888>>25044000
          IF STATUS.RESFLD = 7 THEN RETURN;                    <<01103>>25046000
          IF STATUS.RESFLD = 0 THEN                            <<01103>>25048000
             BEGIN                                             <<01103>>25050000
             READYTAPE;                                        <<01103>>25052000
             RETURN;                                           <<01103>>25054000
             END;                                              <<01103>>25056000
          READTAPE := STATUS'TO'MESSAGE(STATUS.RESFLD);        <<01103>>25058000
           CC := CCL;                                          <<01092>>25060000
                                                               <<01092>>25062000
      END <<READTAPE>> ;                                       <<00888>>25064000
$IF   << ******** RETURNING TO COMMON CODE ******** >>         <<02510>>25066000
$CONTROL SEGMENT=TAPEIO                                        <<03603>>25068000
$TITLE "HP 7970E MAG TAPE DRIVER"                              <<01028>>25070000
INTEGER PROCEDURE MTAPE(FCODE, BUFF, WORDS);                   <<01122>>25072000
                                                               <<01028>>25074000
  VALUE  FCODE, WORDS;                                         <<01122>>25076000
  INTEGER  FCODE,WORDS;                                        <<01028>>25078000
  ARRAY  BUFF;                                                 <<01028>>25080000
  OPTION  VARIABLE;                                            <<01028>>25082000
                                                               <<01028>>25084000
  COMMENT                                                      <<01028>>25086000
                                                               <<01028>>25088000
          FCODE = 0 - READ,                                    <<01028>>25090000
                  1 - REWIND/OFFLINE,                          <<01028>>25092000
                  2 - FORWARD SPACE FILE,                      <<01028>>25094000
                  3 - WAIT FOR TAPE READY,                     <<00799>>25096000
                  4 - BACKSPACE RECORD (CALLED RECURSIVELY TO  <<00799>>25098000
                      RECOVER FROM A PARITY ERROR).            <<01028>>25100000
                                                               <<01028>>25102000
     STATUS RETURNED IN THE STATUS CONDITION CODE:             <<01028>>25104000
             CC = CCE - REQUESTED COMPLETED,                   <<01028>>25106000
                  CCG - EOF READ,                              <<01028>>25108000
                  CCL - TRANSFER ERROR.                        <<01028>>25110000
                                                               <<01028>>25112000
     MTAPE IS GIVEN THE READ LENGTH ON A SUCCESSFUL READ,      <<01028>>25114000
     MTAPE = ERROR MESSAGE NUMBER AND CCL ON IRRECOVERABLE     <<01103>>25116000
     ERRORS.                                                   <<01103>>25118000
  ;                                                            <<01028>>25120000
                                                               <<01028>>25122000
BEGIN                                                          <<01028>>25124000
                                                               <<01028>>25126000
  INTEGER ARRAY  CHANIOPROG(0:53) = PB :=                      <<01028>>25128000
                                                               <<01028>>25130000
  << 0>>      %2001,  << SELECT UNIT >>                        <<01028>>25132000
  << 1>>          1,                                           <<01028>>25134000
  << 2>>          0,                                           <<01028>>25136000
  << 3>>     %42000,                                           <<01028>>25138000
  << 4>>          0,                                           <<01028>>25140000
                                                               <<01028>>25142000
  << 5>>      %1000,  << WAIT >>                               <<01028>>25144000
  << 6>>          0,                                           <<01028>>25146000
                                                               <<01028>>25148000
  << 7>>      %2401,  << DSJ - TO CLEAR PP RESPONSE >>         <<01028>>25150000
  << 8>>          0,                                           <<01028>>25152000
  << 9>>          0,                                           <<01028>>25154000
  <<10>>         36,                                           <<01028>>25156000
                                                               <<01028>>25158000
  <<11>>      %2001,  << ISSUE MOTION COMMAND >>               <<01028>>25160000
  <<12>>          1,                                           <<01028>>25162000
  <<13>>          0,                                           <<01028>>25164000
  <<14>>     %42000,                                           <<01028>>25166000
  <<15>>          0,                                           <<01028>>25168000
                                                               <<01028>>25170000
  <<16>>      %1000,  << WAIT >>                               <<01028>>25172000
  <<17>>          0,                                           <<01028>>25174000
                                                               <<01028>>25176000
  <<18>>      %2401,  << DSJ - TO CLEAR PP RESPONSE >>         <<01028>>25178000
  <<19>>          0,                                           <<01028>>25180000
  <<20>>          0,  << JMP *+0/25, READ/COMMAND MODE >>      <<01028>>25182000
  <<21>>         25,  << STATUS DIAGNOSIS REQUIRED >>          <<01028>>25184000
                                                               <<01028>>25186000
  <<22>>      %1400,  << READ RECORD >>                        <<01028>>25188000
  <<23>>          0,                                           <<01028>>25190000
  <<24>>      %2100,                                           <<01028>>25192000
  <<25>>    %100000,                                           <<01028>>25194000
  <<26>>          0,                                           <<01028>>25196000
                                                               <<01028>>25198000
  <<27>>          0,  << JMP *+2, EOI RECEIVED >>              <<01028>>25200000
  <<28>>          2,                                           <<01028>>25202000
                                                               <<01028>>25204000
  <<29>>          0,                                           <<01028>>25206000
  <<30>>        -15,  << JMP *-15, BURST COMPLETED >>          <<01028>>25208000
                                                               <<01028>>25210000
  <<31>>      %2007,  << WRITE END COMMAND >>                  <<01028>>25212000
  <<32>>          1,                                           <<01028>>25214000
  <<33>>          0,                                           <<01028>>25216000
  <<34>>     %42000,                                           <<01028>>25218000
  <<35>>          0,                                           <<01028>>25220000
                                                               <<01028>>25222000
  <<36>>      %1402,  << DUMMY XFER COUNT READ >>              <<01028>>25224000
  <<37>>          2,                                           <<01028>>25226000
  <<38>>          0,                                           <<01028>>25228000
  <<39>>      %2000,                                           <<01028>>25230000
  <<40>>          0,                                           <<01028>>25232000
                                                               <<01028>>25234000
  <<41>>      %1000,  << WAIT FOR READ TO COMPLETE >>          <<01028>>25236000
  <<42>>          0,                                           <<01028>>25238000
                                                               <<01028>>25240000
  <<43>>      %2401,  << DSJ - CLEARS FINAL PP RESPONSE >>     <<01028>>25242000
  <<44>>          0,                                           <<01028>>25244000
  <<45>>          0,                                           <<01028>>25246000
  <<46>>          0,                                           <<01028>>25248000
                                                               <<01028>>25250000
  <<47>>      %1401,  << READ STATUS >>                        <<01028>>25252000
  <<48>>          3,                                           <<01028>>25254000
  <<49>>          0,                                           <<01028>>25256000
  <<50>>      %2000,                                           <<01028>>25258000
  <<51>>          0,                                           <<01028>>25260000
                                                               <<01028>>25262000
  <<52>>       %601,  << INTERRUPT/HALT >>                     <<01028>>25264000
  <<53>>          0;                                           <<01028>>25266000
                                                               <<01028>>25268000
  LOGICAL                                                      <<01028>>25270000
    STATUS, GOOD'IO, PASS'1, RETRY;                            <<01028>>25272000
                                                               <<01028>>25274000
  INTEGER                                                      <<01028>>25276000
    UNIT, DRT, CMDBUFADR, ERRCOUNT;                            <<01103>>25278000
                                                               <<01028>>25280000
  DOUBLE                                                       <<01028>>25282000
    OLDDB;                                                     <<01028>>25284000
                                                               <<01028>>25286000
  INTEGER ARRAY  CMDBUFF(0:5) = Q;  << COMMAND BUFFER >>       <<01028>>25288000
                                                               <<01028>>25290000
  LOGICAL ARRAY  CP(*) = DB+0;                                 <<01028>>25292000
                                                               <<01028>>25294000
  EQUATE                                                       <<01028>>25296000
    CUNIT       =      0,  << UNIT NUMBER >>                   <<01028>>25298000
    CMOTIONCMD  =      1,  << MOTION COMMAND >>                <<01028>>25300000
    CSPFD       =      2,  << STOP POLLING FOR DATA COMMAND >> <<01028>>25302000
    CSTATBUFF   =      3,  << STATUS BUFFER >>                 <<01028>>25304000
    CDXFERCNT   =      5;  << DUMMY XFER COUNT BUFFER >>       <<01028>>25306000
                                                               <<01028>>25308000
                                                               <<01028>>25310000
  EQUATE                                                       <<01028>>25312000
    CMDREAD     =    %10,  << READ RECORD COMMAND >>           <<01028>>25314000
    CMDBSREC    =    %12,  << BACK SPACE RECORD COMMAND >>     <<01028>>25316000
    CMDFSFILE   =    %13,  << FORWARD SPACE FILE COMMAND >>    <<01028>>25318000
    CMDREW'OFF  =    %16,  << REWIND/OFFINE COMMAND >>         <<01028>>25320000
    ERRMASK     = %05037;  << ERROR MASK >>                    <<01028>>25322000
                                                               <<01028>>25324000
  DEFINE                                                       <<01028>>25326000
    EOF         = CMDBUFF(CSTATBUFF).( 0:1)#,<< EOF DETECTED >><<01028>>25328000
    CMD'REJ     = ( 4:1)#,  << COMMAND CMD'REJED >>            <<01028>>25330000
    TRACKERR    = ( 6:1)#,  << MULTIPLE TRACK ERROR >>         <<01028>>25332000
    ONLINE      = CMDBUFF(CSTATBUFF).(7:1)#,  << UNIT ONLINE >><<01028>>25334000
    TIMINGERR   = (11:1)#,  << TIMING ERROR >>                 <<01028>>25336000
    TAPERUN     = (12:1)#,  << TAPE RUNAWAY >>                 <<01028>>25338000
    BUSY        = (13:3)#,  << UNIT/INTERFACE BUSY OR REWIND >><<01028>>25340000
    MEMX        = ( 8:8)#;  << BANK NUMBER >>                  <<01028>>25342000
                                                               <<01028>>25344000
                                                               <<01028>>25346000
                                                               <<01028>>25348000
                                                               <<01028>>25350000
  SUBROUTINE STATUS'CHECK;                                     <<01028>>25352000
                                                               <<01028>>25354000
  BEGIN                                                        <<01028>>25356000
    RETRY := FALSE;                                            <<01028>>25358000
    GOOD'IO := TRUE;                                           <<01028>>25360000
    STATUS := LOGICAL(CMDBUFF(CSTATBUFF)) LAND ERRMASK;        <<01028>>25362000
                                                               <<01028>>25364000
    IF LOGICAL(ONLINE) AND STATUS=0                            <<01028>>25366000
      OR FCODE = 1 AND NOT STATUS.CMD'REJ THEN RETURN;         <<01028>>25368000
      << NORMAL RETURN; FCODE=1 => REWIND/OFFLINE >>           <<01028>>25370000
                                                               <<01028>>25372000
    << IF YOU GOT HERE, SOMETHING IS WRONG >>                  <<01028>>25374000
    GOOD'IO := FALSE;                                          <<01028>>25376000
    IF NOT LOGICAL(ONLINE) OR STATUS.BUSY <> 0 THEN            <<01028>>25378000
      BEGIN                                                    <<01028>>25380000
        RETRY := TRUE;                                         <<01028>>25382000
        IF PASS'1 AND FCODE <> 3 THEN                          <<00799>>25384000
          BEGIN                                                <<01028>>25386000
            MESSAGE(M2407,UNIT);  << UNIT NOT READY >>         <<01103>>25388000
            PASS'1 := FALSE;                                   <<01028>>25390000
          END;                                                 <<01028>>25392000
      END;                                                     <<01028>>25394000
                                                               <<01028>>25396000
    IF FCODE = 0 AND (STATUS.TRACKERR OR STATUS.TIMINGERR) THEN<<01028>>25398000
      << PARITY/TIMING ERROR DURING READ >>                    <<01028>>25400000
        IF (ERRCOUNT := ERRCOUNT + 1) < 10 THEN                <<01028>>25402000
          BEGIN                                                <<01028>>25404000
            MTAPE(4);  << SEE NOTE 1 AT END >>                 <<01092>>25406000
            IF = THEN                                          <<01028>>25408000
              RETRY := TRUE;                                   <<01028>>25410000
          END;                                                 <<01092>>25412000
                                                               <<01028>>25414000
    IF NOT RETRY THEN  << PRINT ERROR(S) >>                    <<01028>>25416000
      BEGIN                                                    <<01028>>25418000
        IF STATUS.CMD'REJ   THEN MTAPE := M5;                  <<01103>>25420000
        IF STATUS.TRACKERR  THEN MTAPE := M7;                  <<01103>>25422000
        IF STATUS.TIMINGERR THEN MTAPE := M8;                  <<01103>>25424000
        IF STATUS.TAPERUN   THEN MTAPE := M9;                  <<01103>>25426000
        IF STATUS.BUSY      THEN MESSAGE(M2407,UNIT);          <<01103>>25428000
      END;                                                     <<01028>>25430000
                                                               <<01028>>25432000
                                                               <<01028>>25434000
    <<  NOTE 1:  THE CALL TO MTAPE IS A RECURSIVE BACK       >><<01028>>25436000
    <<  SPACE RECORD COMMAND.  RECURSION CAN ONLY BE ONE     >><<01028>>25438000
    <<  LEVEL DEEP SINCE THE RECURSIVE CALL USES AN FCODE    >><<01028>>25440000
    <<  OF 3 AND RECURSION CAN ONLY OCCUR WITH AN FCODE OF   >><<01028>>25442000
    <<  0 (READ).                                            >><<01028>>25444000
                                                               <<01028>>25446000
    RETURN;                                                    <<01028>>25448000
  END;                                                         <<01028>>25450000
                                                               <<01028>>25452000
$PAGE                                                          <<01028>>25454000
     <<     S T A R T   O F   D R I V E R     >>               <<01028>>25456000
                                                               <<01028>>25458000
                                                               <<01028>>25460000
                                                               <<00799>>25462000
  TOS := ABSOLUTE(DBBANK);                                     <<01028>>25464000
  TOS := ABSOLUTE(DB);                                         <<01028>>25466000
  ASSEMBLE (DDUP,XCHD);   << SET DB >>                         <<01028>>25468000
  OLDDB := TOS;       << SAVE OLD DB >>                        <<01028>>25470000
    << ONE SET OF DBBANK & DB ADDR ARE STILL ON STACK >>       <<01028>>25472000
  CMDBUFADR := TOS+@CMDBUFF;  << GET ADDRESS OF CMD BUFFER >>  <<01028>>25474000
  DEL;  << DELETE BANK ADDR FROM TOS >>                        <<01028>>25476000
                                                               <<01028>>25478000
  ZEROABS( TEMP'CPVA, 8);                                      <<02510>>25480000
  ERRCOUNT := 0;                                               <<01028>>25482000
  MTAPE := 0;                                                  <<01028>>25484000
  PASS'1 := TRUE;                                              <<01028>>25486000
  DRT := SYSTAPEDRT;  <<SAVE DRT NUMBER>>                      <<03002>>25488000
  UNIT := SYSTAPEUNIT;                                         <<01103>>25490000
  CMDBUFF(CUNIT) := UNIT+1;                                    <<01103>>25492000
    << UNIT # IS INCREMENTED BY 1 ON TOOTHPICK BECAUSE    >>   <<01028>>25494000
    << THE DESIGNERS USED TOO MANY DRUGS.                 >>   <<01028>>25496000
                                                               <<01028>>25498000
  TOS := 0;                                                    <<01028>>25500000
  TOS := ABSOLUTE(TAPECHANPROG);                               <<01028>>25502000
  SET(DB);   << SET DB TO CHAN PROG AREA >>                    <<01028>>25504000
                                                               <<01028>>25506000
                                                               <<01028>>25508000
                                                               <<01028>>25510000
                                                               <<01028>>25512000
<< S E T   U P   &   E X E C U T E   C H A N   P R O G R A M >><<01028>>25514000
                                                               <<01028>>25516000
  DO                                                           <<01028>>25518000
    BEGIN                                                      <<01028>>25520000
      MOVE CP     := CHANIOPROG,(54);                          <<01028>>25522000
      CP(3).MEMX  := ABSOLUTE(DBBANK).MEMX;                    <<01028>>25524000
      CP(4)       := CMDBUFADR+CUNIT;                          <<01028>>25526000
      CP(14).MEMX := ABSOLUTE(DBBANK).MEMX;                    <<01028>>25528000
      CP(15)      := CMDBUFADR+CMOTIONCMD;                     <<01028>>25530000
      CP(50).MEMX := ABSOLUTE(DBBANK).MEMX;                    <<01028>>25532000
      CP(51)      := CMDBUFADR+CSTATBUFF;                      <<01028>>25534000
      CMDBUFF(CSTATBUFF) := -1;  << INITIALIZE STATUS TO BAD >><<00799>>25536000
                                                               <<01028>>25538000
      IF FCODE = 0 THEN                                        <<01028>>25540000
        BEGIN                                                  <<01028>>25542000
          CP(20)      := 0;  << SET DSJ SWITCH FOR READ >>     <<01028>>25544000
          CP(23)      := WORDS&LSL(1); << BYTE COUNT TO READ >><<04306>>25546000
          CP(25)      := ABSOLUTE(DBBANK) + %100000;           <<01028>>25548000
          CP(26)      := ABSOLUTE(DB) + @BUFF;                 <<01028>>25550000
          CP(34).MEMX := ABSOLUTE(DBBANK).MEMX;                <<01028>>25552000
          CP(35)      := CMDBUFADR + CSPFD;                    <<01028>>25554000
          CP(39).MEMX := ABSOLUTE(DBBANK).MEMX;                <<01028>>25556000
          CP(40)      := CMDBUFADR + CDXFERCNT;                <<01028>>25558000
          CMDBUFF(CMOTIONCMD) := CMDREAD;                      <<01028>>25560000
          CMDBUFF(CSPFD) := %23;                               <<01028>>25562000
        END                                                    <<01028>>25564000
      ELSE  << MUST BE A COMMAND >>                            <<01028>>25566000
        BEGIN                                                  <<01028>>25568000
          CP(20) := 25;<<SET DSJ SWITCH TO BRANCH AROUND READ>><<01028>>25570000
          CASE *FCODE OF << RANGE CHECKED BY COLD'LOAD'MEDIA >><<01028>>25572000
            BEGIN                                              <<01028>>25574000
              ;                   << FCODE FOR READ >>         <<01028>>25576000
              CMDBUFF(CMOTIONCMD) := CMDREW'OFF;               <<01028>>25578000
              CMDBUFF(CMOTIONCMD) := CMDFSFILE;                <<01028>>25580000
              CP(9) := 36;        << READYTAPE >>              <<00799>>25582000
              CMDBUFF(CMOTIONCMD) := CMDBSREC;                 <<01028>>25584000
            END;  << END OF CASE >>                            <<01028>>25586000
        END;                                                   <<01028>>25588000
                                                               <<01028>>25590000
      INIT( DRT);                                              <<02510>>25592000
      IF <> THEN ERRMESSAGE( M2, DRT);                         <<02510>>25594000
      SIOP( DRT, ABSOLUTE(TAPECHANPROG));                      <<02510>>25596000
      IF <> THEN ERRMESSAGE( M2, DRT);                         <<02510>>25598000
                                                               <<02510>>25600000
      DO  << WIAT FOR CHAN PROG TO COMPLETE >>                 <<01028>>25602000
           <<POLL CHANNEL STATUS>>                             <<03002>>25604000
      UNTIL GETDRT(DRT,CHANSTAT).(0:2) = 0;                    <<03002>>25606000
                                                               <<01028>>25608000
      STATUS'CHECK;                                            <<01028>>25610000
                                                               <<01028>>25612000
    END  << SET UP & EXECUTE >>                                <<01028>>25614000
  UNTIL NOT RETRY;                                             <<01028>>25616000
                                                               <<01028>>25618000
  IF FCODE = 0 AND GOOD'IO THEN                                <<01028>>25620000
    MTAPE:=WORDS-INTEGER(CP(23)+1)&LSR(1);  <<RETURN XFER LOG>><<01028>>25622000
                                                               <<01028>>25624000
  TOS := OLDDB;    << RESTORE OLD DB >>                        <<01028>>25626000
  SET(DB);                                                     <<01028>>25628000
                                                               <<01028>>25630000
  IF GOOD'IO THEN                                              <<01028>>25632000
    IF LOGICAL(EOF) THEN CC := CCG                             <<01028>>25634000
    ELSE CC := CCE                                             <<01028>>25636000
  ELSE                                                         <<01028>>25638000
    CC := CCL;                                                 <<01028>>25640000
  RETURN;                                                      <<01028>>25642000
                                                               <<01028>>25644000
END;  << MTAPE >>                                              <<01028>>25646000
INTEGER PROCEDURE MT7976( FUNCTION, BUF, WORDS);               <<02517>>25648000
   VALUE FUNCTION, WORDS;                                      <<02517>>25650000
   INTEGER FUNCTION, WORDS;                                    <<02517>>25652000
   ARRAY BUF;                                                  <<02517>>25654000
   OPTION VARIABLE;                                            <<02517>>25656000
BEGIN                                                          <<02517>>25658000
   COMMENT                                                     <<02517>>25660000
                                                               <<02517>>25662000
                                                               <<02517>>25664000
        FUNCTION = 0 - READ,                                   <<02517>>25666000
                   1 - REWIND/OFFLINE,                         <<02517>>25668000
                   2 - FORWARD SPACE FILE,                     <<02517>>25670000
                   3 - WAIT FOR TAPE READY,                    <<02517>>25672000
                                                               <<02517>>25674000
        RETURNS                                                <<02517>>25676000
              CC = CCE - REQUEST COMPLETED,                    <<02517>>25678000
                   CCG - EOF READ,                             <<02517>>25680000
                   CCL - TRANSFER ERROR,                       <<02517>>25682000
                                                               <<02517>>25684000
        MT7976 IS GIVEN THE READ LENGTH ON A SUCCESSFULL READ  <<02517>>25686000
        MT7976 = ERROR MESSAGE NUMBER AND CCL ON IRRECOVERABLE <<02517>>25688000
        ERRORS.                                                <<02517>>25690000
   ;                                                           <<02517>>25692000
   INTEGER ARRAY BASEPGM(*) = PB :=                            <<02517>>25694000
     <<  0 >>        0, << JUMP TO START                   >>  <<02517>>25696000
     <<  1 >>       21,                                        <<02517>>25698000
                                                               <<02517>>25700000
     <<  2 >>[8/1,8/2], << CLEAR POLL / STOP TRANSFER      >>  <<02517>>25702000
     <<  3 >>[8/4,8/%10],<<ENABLE POLL / END TRANSACTION   >>  <<02517>>25704000
                                                               <<02517>>25706000
     <<  4*>>        0, << COMMAND BUFFER                  >>  <<02517>>25708000
     <<  5*>>        0,                                        <<02517>>25710000
                                                               <<02517>>25712000
     <<  6 >>        0, << TRANSFER COUNT BUFFER           >>  <<02517>>25714000
                                                               <<02517>>25716000
     <<  7 >>        0, << STATUS BUFFER                   >>  <<02517>>25718000
     <<  8 >>        0,                                        <<02517>>25720000
     <<  9 >>        0,                                        <<02517>>25722000
                                                               <<02517>>25724000
     << 10 >>        0, << DUMMY READ BUFFER               >>  <<02517>>25726000
                                                               <<02517>>25728000
     << 11 >>    %1401, << READ STATUS                     >>  <<02517>>25730000
     << 12 >>        5, << FIVE BYTES OF STATUS            >>  <<02517>>25732000
     << 13 >>        0,                                        <<02517>>25734000
     << 14 >>    %2000,                                        <<02517>>25736000
     << 15*>>        0, << STATUS BUFFER ADDRESS           >>  <<02517>>25738000
                                                               <<02517>>25740000
     << 16 >>    %2007, << STOP POLLING FOR DATA           >>  <<02517>>25742000
     << 17 >>        1,                                        <<02517>>25744000
     << 18 >>        0,                                        <<02517>>25746000
     << 19 >>   %42000,                                        <<02517>>25748000
     << 20*>>        0,                                        <<02517>>25750000
                                                               <<02517>>25752000
     << 21 >>     %600, << INT/HALT                        >>  <<02517>>25754000
     << 22 >>        1; << BAD CODE                        >>  <<02517>>25756000
   INTEGER ARRAY CTLPGM(*) = PB :=                             <<02517>>25758000
     <<  0 >>    %2001, << SEND COMMANDS                   >>  <<02517>>25760000
     <<  1 >>        0, << NR. OF COMMANDS                 >>  <<02517>>25762000
     <<  2 >>        1, << BURST SIZE = 1                  >>  <<02517>>25764000
     <<  3 >>  %100000,                                        <<02517>>25766000
     <<  4*>>        0, << ADDRESS OF COMMAND BUFFER       >>  <<02517>>25768000
                                                               <<02517>>25770000
     <<  5 >>        0, << JUMP COMPLETE                   >>  <<02517>>25772000
     <<  6 >>        2,                                        <<02517>>25774000
                                                               <<02517>>25776000
     <<  7 >>        0, << JUMP NEXT COMMAND               >>  <<02517>>25778000
     <<  8 >>       -9;                                        <<02517>>25780000
   INTEGER ARRAY READPGM(*) = PB :=                            <<02517>>25782000
     <<  0 >>    %1000, << WAIT FOR CMD COMPLETION         >>  <<02517>>25784000
     <<  1 >>        0,                                        <<02517>>25786000
                                                               <<02517>>25788000
     <<  2 >>    %2401, << DSJ                             >>  <<02517>>25790000
     <<  3 >>        0,                                        <<02517>>25792000
     <<  4 >>        0, << A-OK                            >>  <<02517>>25794000
     <<  5*>>        0, << ERROR JUMP                      >>  <<02517>>25796000
                                                               <<02517>>25798000
                                                               <<02517>>25800000
     <<  6 >>    %1400, << READ THE RECORD                 >>  <<02517>>25802000
     <<  7*>>        0,                                        <<02517>>25804000
     <<  8 >>        0,                                        <<02517>>25806000
     <<  9*>>        0, << BANK                            >>  <<02517>>25808000
     << 10*>>        0, << ADDRESS                         >>  <<02517>>25810000
                                                               <<02517>>25812000
     << 11 >>    %2007, << STOP POLLING FOR DATA           >>  <<02517>>25814000
     << 12 >>        1,                                        <<02517>>25816000
     << 13 >>        0,                                        <<02517>>25818000
     << 14 >>   %42000,                                        <<02517>>25820000
     << 15*>>        0,                                        <<02517>>25822000
                                                               <<02517>>25824000
     << 16 >>    %1402, << READ TRANSFER COUNT             >>  <<02517>>25826000
     << 17 >>        2,                                        <<02517>>25828000
     << 18 >>        0,                                        <<02517>>25830000
     << 19 >>    %2000,                                        <<02517>>25832000
     << 20*>>        0, << TRANSFER COUNT BUFFER           >>  <<02517>>25834000
                                                               <<02517>>25836000
     << 21 >>    %2401, << DSJ                             >>  <<02517>>25838000
     << 22 >>        0,                                        <<02517>>25840000
     << 23 >>        0, << A-OK                            >>  <<02517>>25842000
     << 24*>>        0, << ERROR JUMP                      >>  <<02517>>25844000
                                                               <<02517>>25846000
     << 25 >>    %1401, << READ STATUS                     >>  <<02517>>25848000
     << 26 >>        5,                                        <<02517>>25850000
     << 27 >>        0,                                        <<02517>>25852000
     << 28 >>    %2000,                                        <<02517>>25854000
     << 29*>>        0, << ADDRESS OF STATUS BUFFER        >>  <<02517>>25856000
                                                               <<02517>>25858000
     << 30 >>    %2007, << STOP POLLING FOR DATA           >>  <<02517>>25860000
     << 31 >>        1,                                        <<02517>>25862000
     << 32 >>        0,                                        <<02517>>25864000
     << 33 >>   %42000,                                        <<02517>>25866000
     << 34*>>        0;                                        <<02517>>25868000
   INTEGER ARRAY DSJPGM(*) = PB :=                             <<02517>>25870000
     <<  0 >>    %2401, << DSJ                             >>  <<02517>>25872000
     <<  1 >>        0,                                        <<02517>>25874000
     <<  2 >>        0, << A-OK                            >>  <<02517>>25876000
     <<  3*>>        0; << ERROR JUMP                      >>  <<02517>>25878000
   INTEGER ARRAY STATPGM(*) = PB :=                            <<02517>>25880000
     <<  0 >>    %1401, << READ STATUS                     >>  <<02517>>25882000
     <<  1 >>        5,                                        <<02517>>25884000
     <<  2 >>        0,                                        <<02517>>25886000
     <<  3 >>    %2000,                                        <<02517>>25888000
     <<  4*>>        0,                                        <<02517>>25890000
                                                               <<02517>>25892000
     <<  5 >>    %2007, << STOP POLLING FOR DATA           >>  <<02517>>25894000
     <<  6 >>        1,                                        <<02517>>25896000
     <<  7 >>        0,                                        <<02517>>25898000
     <<  8 >>   %42000,                                        <<02517>>25900000
     <<  9*>>        0;                                        <<02517>>25902000
   INTEGER ARRAY IDLEPGM(*) = PB :=                            <<02517>>25904000
     <<  0 >>    %2007, << ENABLE PARALLEL POLL FOR ALL    >>  <<02517>>25906000
     <<  1 >>        1, << SEND ONE BYTE                   >>  <<02517>>25908000
     <<  2 >>        0,                                        <<02517>>25910000
     <<  3 >>    %2000, << START LEFT BYTE                 >>  <<02517>>25912000
     <<  4 >>        0; << ADDRESS OF COMMAND              >>  <<02517>>25914000
   INTEGER ARRAY WAITPGM(*) = PB :=                            <<02517>>25916000
     <<  0 >>    %1000,                                        <<02517>>25918000
     <<  1 >>        0;                                        <<02517>>25920000
   INTEGER ARRAY INTHALTPGM(*) = PB :=                         <<02517>>25922000
     <<  0 >>     %600,                                        <<02517>>25924000
     <<  1 >>        0; << GOOD CODE                       >>  <<02517>>25926000
   EQUATE                                                      <<02517>>25928000
      BASE'SPFDCMD     =  2,                                   <<02517>>25930000
      BASE'ENAPOLL     =  3,                                   <<02517>>25932000
      BASE'ENDCMD      =  3,                                   <<02517>>25934000
      BASE'CMDBUF      =  4,                                   <<02517>>25936000
      BASE'TRANSBUF    =  6,                                   <<02517>>25938000
      BASE'STATBUF     =  7,                                   <<02517>>25940000
      BASE'DUMMY       = 10,                                   <<02517>>25942000
      BSTAT'ENTRY      = 11,                                   <<02517>>25944000
      BSTAT'STATBUF    = 15,                                   <<02517>>25946000
      BSTAT'STOPPOLL   = 20,                                   <<02517>>25948000
      BASE'LEN         = 23,                                   <<02517>>25950000
      CTL'BYTECNT      =  1,                                   <<02517>>25952000
      CTL'BUFADR       =  4,                                   <<02517>>25954000
      CTL'LEN          =  9,                                   <<02517>>25956000
      RD'DSJ1'BAD      =  5,                                   <<02517>>25958000
      RD'BYTECNT       =  7,                                   <<02517>>25960000
      RD'BANK          =  9,                                   <<02517>>25962000
      RD'ADR           = 10,                                   <<02517>>25964000
      RD'STOPPOLL1     = 15,                                   <<02517>>25966000
      RD'TRANSBUF      = 20,                                   <<02517>>25968000
      RD'DSJ2'BAD      = 24,                                   <<02517>>25970000
      RD'STATUS        = 29,                                   <<02517>>25972000
      RD'STOPPOLL2     = 34,                                   <<02517>>25974000
      RD'LEN           = 35,                                   <<02517>>25976000
      DSJBAD           =  3,                                   <<02517>>25978000
      DSJ'LEN          =  4,                                   <<02517>>25980000
      STAT'BUFADR      =  4,                                   <<02517>>25982000
      STAT'STOPPOLL    =  9,                                   <<02517>>25984000
      STAT'LEN         = 10,                                   <<02517>>25986000
      IDLE'ADR         =  4,                                   <<02517>>25988000
      IDLE'LEN         =  5,                                   <<02517>>25990000
      WAIT'LEN         =  2,                                   <<02517>>25992000
      INTHALT'LEN      =  2;                                   <<02517>>25994000
   EQUATE                                                      <<02517>>25996000
      CPLEN = BASE'LEN+CTL'LEN+RD'LEN+WAIT'LEN+INTHALT'LEN;    <<02517>>25998000
   EQUATE                                                      <<02517>>26000000
      READCMD     = %10,  << READ RECORD COMMAND             >><<02517>>26002000
      FSFCMD      = %13,  << FORWARD SPACE FILE              >><<02517>>26004000
      FSRCMD      = %11,  << FORWARD SPACE RECORD            >><<02517>>26006000
      RWOFFCMD    = %16,  << REWIND UNLOAD COMMAND           >><<02517>>26008000
      ERRMASK     = %15037;                                    <<02517>>26010000
   ARRAY UNITSEL(0:3) = PB := 0, 2, 3, 4;                      <<02517>>26012000
   ARRAY LOGPHYCMD(*) = PB := READCMD,RWOFFCMD,FSFCMD,0,FSRCMD;<<02517>>26014000
   INTEGER POINTER                                             <<02517>>26016000
      OPPNTR,   << CURRENT PROGRAM POINTER >>                  <<02517>>26018000
      CPPNTR;   << NEXT INSTUCTION POINTER >>                  <<02517>>26020000
   INTEGER ARRAY CPBUF(0:CPLEN);                               <<02517>>26022000
   BYTE ARRAY CMDBUF(*) = CPBUF(BASE'CMDBUF);                  <<02517>>26024000
   LOGICAL                                                     <<02517>>26026000
      STATUS,                                                  <<02561>>26028000
      STATUS1,                                                 <<02561>>26030000
      STATUS2;                                                 <<02561>>26032000
   INTEGER                                                     <<02517>>26034000
      ISTATUS = STATUS,                                        <<02517>>26036000
      RTN = MT7976,                                            <<02517>>26038000
      CPADR,                                                   <<02517>>26040000
      BANK,                                                    <<02517>>26042000
      ADDRESS,                                                 <<02517>>26044000
      CMDCNT,                                                  <<02517>>26046000
      IBANK,                                                   <<02517>>26048000
      IADR;                                                    <<02517>>26050000
   DEFINE                                                      <<02517>>26052000
      EOF         = STATUS.(0:1)#,                             <<02517>>26054000
      BOT         = STATUS.(1:1)#,                             <<02517>>26056000
      EOT         = STATUS.(2:1)#,                             <<02517>>26058000
      CMD'REJ     = STATUS.(4:1)#,                             <<02517>>26060000
      WRTPROTECT  = STATUS.(5:1)#,                             <<02517>>26062000
      TRACKERR    = STATUS.(6:1)#,                             <<02517>>26064000
      ONLINE      = STATUS.(7:1)#,                             <<02517>>26066000
      UNIT        = ISTATUS.(9:2)#,                            <<02517>>26068000
      TIMINGERR   = STATUS.(11:1)#,                            <<02517>>26070000
      TAPERUN     = STATUS.(12:1)#,                            <<02517>>26072000
      BUSY        = ISTATUS.(13:3)#,                           <<02517>>26074000
      PRIORERRABT = STATUS1.(8:3) = 5#,                        <<02561>>26076000
      MEMX        = (8:8)#,                                    <<02517>>26078000
      READ        = FUNCTION = 0#,                             <<02517>>26080000
      REWIND      = FUNCTION = 1#,                             <<02517>>26082000
      FSF         = FUNCTION = 2#,                             <<02517>>26084000
      FSR         = FUNCTION = 4#,                             <<02517>>26086000
      ERRCODE     = (0:3)#,                                    <<02517>>26088000
      NEWREQ      = ABS(ABSFLAGS).(14:1)#;                     <<02517>>26090000
                                                               <<02517>>26092000
   SUBROUTINE CONTROL( CODE);                                  <<02517>>26094000
      VALUE CODE;                                              <<02517>>26096000
      INTEGER CODE;                                            <<02517>>26098000
   BEGIN                                                       <<02517>>26100000
      IF CMDCNT = 0 THEN                                       <<02517>>26102000
         BEGIN                                                 <<02517>>26104000
         @OPPNTR := @CPPNTR;                                   <<02517>>26106000
         MOVE OPPNTR := CTLPGM,(CTL'LEN),2;                    <<02517>>26108000
         @CPPNTR := TOS;                                       <<02517>>26110000
         OPPNTR( CTL'BUFADR) := CPADR+BASE'CMDBUF;             <<02517>>26112000
         END;                                                  <<02517>>26114000
      CMDBUF( CMDCNT) := UNITSEL( SYSTAPEUNIT);                <<02517>>26116000
      CMDCNT := CMDCNT+1;                                      <<02517>>26118000
      CMDBUF( CMDCNT) := CODE;                                 <<02517>>26120000
      CMDCNT := CMDCNT+1;                                      <<02517>>26122000
      OPPNTR( CTL'BYTECNT) := CMDCNT;                          <<02517>>26124000
   END;                                                        <<02517>>26126000
                                                               <<02517>>26128000
   SUBROUTINE WAIT;                                            <<02517>>26130000
   BEGIN                                                       <<02517>>26132000
      MOVE CPPNTR := WAITPGM,(WAIT'LEN),2;                     <<02517>>26134000
      @CPPNTR := TOS;                                          <<02517>>26136000
   END;                                                        <<02517>>26138000
                                                               <<02517>>26140000
   SUBROUTINE INTHALT;                                         <<02517>>26142000
   BEGIN                                                       <<02517>>26144000
      MOVE CPPNTR := INTHALTPGM,(INTHALT'LEN),2;               <<02517>>26146000
      @CPPNTR := TOS;                                          <<02517>>26148000
   END;                                                        <<02517>>26150000
                                                               <<02517>>26152000
   SUBROUTINE STAT';                                           <<02517>>26154000
   BEGIN                                                       <<02517>>26156000
      @OPPNTR := @CPPNTR;                                      <<02517>>26158000
      MOVE OPPNTR := STATPGM,(STAT'LEN),2;                     <<02517>>26160000
      @CPPNTR := TOS;                                          <<02517>>26162000
      OPPNTR( STAT'BUFADR) := CPADR+BASE'STATBUF;              <<02517>>26164000
      OPPNTR( STAT'STOPPOLL) := CPADR+BASE'ENDCMD;             <<02517>>26166000
   END;                                                        <<02517>>26168000
                                                               <<02517>>26170000
   SUBROUTINE DSJ;                                             <<02517>>26172000
   BEGIN                                                       <<02517>>26174000
      @OPPNTR := @CPPNTR;                                      <<02517>>26176000
      MOVE OPPNTR := DSJPGM,(DSJ'LEN),2;                       <<02517>>26178000
      @CPPNTR := TOS;                                          <<02517>>26180000
      OPPNTR( DSJBAD) := @CPBUF( BSTAT'ENTRY)                  <<02517>>26182000
         -@OPPNTR( DSJBAD+1);                                  <<02517>>26184000
   END;                                                        <<02517>>26186000
                                                               <<02517>>26188000
   SUBROUTINE BUILD'READ( DUMMYREAD);                          <<02517>>26190000
      VALUE DUMMYREAD;                                         <<02517>>26192000
      LOGICAL DUMMYREAD;                                       <<02517>>26194000
   BEGIN                                                       <<02517>>26196000
      @OPPNTR := @CPPNTR;                                      <<02517>>26198000
      MOVE OPPNTR := READPGM,(RD'LEN),2;                       <<02517>>26200000
      @CPPNTR := TOS;                                          <<02517>>26202000
                                                               <<02517>>26204000
      OPPNTR( RD'DSJ1'BAD) := @CPBUF(BSTAT'ENTRY)              <<02517>>26206000
         -@OPPNTR( RD'DSJ1'BAD+1);                             <<02517>>26208000
      IF DUMMYREAD OR WORDS = 0 THEN                           <<02561>>26210000
         BEGIN                                                 <<02517>>26212000
         OPPNTR( RD'BYTECNT) := 2;                             <<02517>>26214000
         OPPNTR( RD'BANK).MEMX := 0;                           <<02517>>26216000
         OPPNTR( RD'ADR) := CPADR+BASE'DUMMY;                  <<02517>>26218000
         END                                                   <<02517>>26220000
      ELSE                                                     <<02517>>26222000
         BEGIN                                                 <<02517>>26224000
         OPPNTR( RD'BYTECNT) := WORDS&LSL(1);                  <<02517>>26226000
         OPPNTR( RD'BANK).MEMX := BANK;                        <<02517>>26228000
         OPPNTR( RD'ADR) := ADDRESS;                           <<02517>>26230000
         END;                                                  <<02517>>26232000
      OPPNTR( RD'STOPPOLL1) := CPADR+BASE'SPFDCMD;             <<02517>>26234000
      OPPNTR( RD'TRANSBUF) := CPADR+BASE'TRANSBUF;             <<02517>>26236000
      OPPNTR( RD'DSJ2'BAD) := @CPBUF(BSTAT'ENTRY)              <<02517>>26238000
         -@OPPNTR( RD'DSJ2'BAD+1);                             <<02517>>26240000
      OPPNTR( RD'STATUS) := CPADR+BASE'STATBUF;                <<02517>>26242000
      OPPNTR( RD'STOPPOLL2) := CPADR+BASE'ENDCMD;              <<02517>>26244000
   END;                                                        <<02517>>26246000
                                                               <<02517>>26248000
   SUBROUTINE LAUNCH;                                          <<02517>>26250000
   BEGIN                                                       <<02517>>26252000
      PUSH( DB );                                              <<02517>>26254000
      TOS := TOS+@CPBUF;                                       <<02517>>26256000
      IADR := TOS;   << ADDRESS >>                             <<02517>>26258000
      IBANK := TOS;  << BANK    >>                             <<02517>>26260000
      MABS( 0,CPADR,IBANK,IADR,@CPPNTR-@CPBUF);                <<02517>>26262000
      INIT( SYSTAPEDRT);                                       <<02517>>26264000
      IF <> THEN ERRMESSAGE( M2, SYSTAPEDRT);                  <<02517>>26266000
      SIOP( SYSTAPEDRT, CPADR);                                <<02517>>26268000
      IF <> THEN ERRMESSAGE( M2, SYSTAPEDRT);                  <<02517>>26270000
         << WAIT FOR PROGRAM TO COMPLETE >>                    <<02517>>26272000
      WHILE GETDRT(SYSTAPEDRT,CHANSTAT).(0:2) <>0 DO;          <<03002>>26274000
      STATUS := ABS(CPADR+BASE'STATBUF);                       <<02517>>26276000
      STATUS1 := ABS(X:=X+1);                                  <<02561>>26278000
      STATUS2 := ABS(X:=X+1);                                  <<02561>>26280000
   END;                                                        <<02517>>26282000
                                                               <<02517>>26284000
   SUBROUTINE WAITFORREADY;                                    <<02517>>26286000
   BEGIN                                                       <<02517>>26288000
      DO BEGIN                                                 <<02517>>26290000
         @OPPNTR := @CPPNTR;                                   <<02517>>26292000
         MOVE OPPNTR := IDLEPGM,(IDLE'LEN),2;                  <<02517>>26294000
         @CPPNTR := TOS;                                       <<02517>>26296000
         OPPNTR(IDLE'ADR) := CPADR+BASE'ENAPOLL;               <<02517>>26298000
         WAIT;                                                 <<02517>>26300000
         DSJ;                                                  <<02517>>26302000
         STAT';                                                <<02517>>26304000
         INTHALT;                                              <<02517>>26306000
         LAUNCH;                                               <<02517>>26308000
         @CPPNTR := @CPBUF(BASE'LEN);                          <<02517>>26310000
         END UNTIL ONLINE AND BUSY = 0 AND UNIT = SYSTAPEUNIT; <<02517>>26312000
   END;                                                        <<02517>>26314000
                                                               <<02517>>26316000
   CPADR := ABS( TAPECHANPROG);                                <<02517>>26318000
   PUSH( DB );                                                 <<02517>>26320000
   TOS := TOS+@BUF;                                            <<02517>>26322000
   ADDRESS := TOS;                                             <<02517>>26324000
   BANK := TOS;                                                <<02517>>26326000
START:                                                         <<02517>>26328000
   MOVE CPBUF := BASEPGM,(BASE'LEN),2;                         <<02517>>26330000
   @CPPNTR := TOS;                                             <<02517>>26332000
   CMDCNT := 0;                                                <<02517>>26334000
      << INITIALIZE BASE PROGRAM >>                            <<02517>>26336000
   CPBUF( BSTAT'STATBUF) := CPADR+BASE'STATBUF;                <<02517>>26338000
   CPBUF( BSTAT'STOPPOLL) := CPADR+BASE'ENDCMD;                <<02517>>26340000
   ZEROABS( TEMP'CPVA, 8);                                     <<02517>>26342000
                                                               <<02517>>26344000
   IF FUNCTION = 3 THEN                                        <<02517>>26346000
      BEGIN                                                    <<02517>>26348000
      WAITFORREADY;                                            <<02517>>26350000
      CC := CCE;                                               <<02517>>26352000
      RETURN;                                                  <<02517>>26354000
      END;                                                     <<02517>>26356000
                                                               <<02517>>26358000
   IF NEWREQ THEN                                              <<02517>>26360000
      BEGIN                                                    <<02517>>26362000
      IF READ THEN                                             <<02517>>26364000
         BEGIN                                                 <<02517>>26366000
         CONTROL( READCMD);                                    <<02517>>26368000
         CONTROL( READCMD);                                    <<02517>>26370000
         BUILD'READ( FALSE);                                   <<02517>>26372000
         NEWREQ := FALSE;                                      <<02517>>26374000
         END                                                   <<02517>>26376000
      ELSE                                                     <<02517>>26378000
         BEGIN                                                 <<02517>>26380000
         CONTROL( LOGPHYCMD(FUNCTION));                        <<02517>>26382000
         WAIT;                                                 <<02517>>26384000
         DSJ;                                                  <<02517>>26386000
         STAT';                                                <<02517>>26388000
         END;                                                  <<02517>>26390000
      END                                                      <<02517>>26392000
   ELSE                                                        <<02517>>26394000
      BEGIN                                                    <<02517>>26396000
      IF READ THEN                                             <<02517>>26398000
         BEGIN                                                 <<02517>>26400000
         CONTROL( READCMD);                                    <<02517>>26402000
         BUILD'READ( FALSE);                                   <<02517>>26404000
         END                                                   <<02517>>26406000
      ELSE                                                     <<02517>>26408000
         BEGIN                                                 <<02517>>26410000
         BUILD'READ( TRUE); << FINISH OLD REQUEST >>           <<02517>>26412000
         INTHALT;                                              <<02517>>26414000
         LAUNCH;                                               <<02517>>26416000
         IF ABS( TEMP'CPVA).ERRCODE <> 4 THEN                  <<02517>>26418000
            GO CHECKSTATUS;                                    <<02517>>26420000
         NEWREQ := TRUE;                                       <<02517>>26422000
         IF FSR THEN GO CHECKSTATUS;                           <<02517>>26424000
         IF FSF AND EOF THEN GO CHECKSTATUS;                   <<02517>>26426000
         GO START;                                             <<02517>>26428000
         END;                                                  <<02517>>26430000
      END;                                                     <<02517>>26432000
                                                               <<02517>>26434000
   INTHALT;                                                    <<02517>>26436000
   LAUNCH;                                                     <<02517>>26438000
                                                               <<02517>>26440000
CHECKSTATUS:                                                   <<02517>>26442000
   IF ABS( TEMP'CPVA).ERRCODE <> 4 THEN                        <<02517>>26444000
      ERRMESSAGE( M3, ABS(TEMP'CPVA));                         <<02517>>26446000
   IF ABS( TEMP'CPVA).(3:13) <> 0 THEN                         <<02517>>26448000
      BEGIN   << BETTER CHECK STATUS >>                        <<02517>>26450000
      IF CMD'REJ THEN                                          <<02561>>26452000
         BEGIN                                                 <<02561>>26454000
         IF NOT ONLINE THEN                                    <<02561>>26456000
            BEGIN                                              <<02561>>26458000
            MESSAGE( M2407, SYSTAPEUNIT);                      <<02561>>26460000
            WAITFORREADY;                                      <<02561>>26462000
            GO START; << TRY IT AGAIN !!! >>                   <<02561>>26464000
            END                                                <<02561>>26466000
         ELSE                                                  <<02561>>26468000
            MT7976 := M5;                                      <<02561>>26470000
         END;                                                  <<02561>>26472000
      IF TRACKERR THEN MT7976 := M7;                           <<02561>>26474000
      IF TIMINGERR THEN MT7976 := M8;                          <<02561>>26476000
      IF TAPERUN THEN MT7976 := M9;                            <<02561>>26478000
      IF RTN <> 0 THEN                                         <<02561>>26480000
         BEGIN                                                 <<02561>>26482000
         IF NOT NEWREQ THEN << BIG TROUBLE !!! >>              <<02561>>26484000
            BEGIN<<MT ABORTED SECOND REQUEST - SO FINISH IT OFF<<02561>>26486000
            @CPPNTR := @CPBUF(BASE'LEN);                       <<02561>>26488000
            BUILD'READ( TRUE);                                 <<02561>>26490000
            INTHALT;                                           <<02561>>26492000
            LAUNCH;                                            <<02561>>26494000
            NEWREQ := TRUE;                                    <<02561>>26496000
            END;                                               <<02561>>26498000
         CC := CCL;                                            <<02561>>26500000
         RETURN;                                               <<02561>>26502000
         END;                                                  <<02561>>26504000
      END;                                                     <<02561>>26506000
   CC := CCE;                                                  <<02561>>26508000
   IF READ THEN  << RETURN TRANSFER COUNT >>                   <<02561>>26510000
      BEGIN                                                    <<02561>>26512000
      MT7976 := (ABS(CPADR+BASE'TRANSBUF)+1)&LSR(1);           <<02561>>26514000
      IF EOF THEN                                              <<02561>>26516000
         BEGIN                                                 <<02561>>26518000
         CC := CCG;                                            <<02561>>26520000
         IF NOT NEWREQ THEN << BIG TROUBLE !!! >>              <<02561>>26522000
            BEGIN<<MT ABORTED OUR 2nd REQUEST-SO FINISH IT OFF <<02561>>26524000
            @CPPNTR := @CPBUF(BASE'LEN);                       <<02561>>26526000
            BUILD'READ( TRUE);                                 <<02561>>26528000
            INTHALT;                                           <<02561>>26530000
            LAUNCH;                                            <<02561>>26532000
            IF ABS( TEMP'CPVA).ERRCODE <> 4 THEN               <<02561>>26534000
               GO CHECKSTATUS;                                 <<02561>>26536000
            IF NOT (CMD'REJ LAND PRIORERRABT) THEN             <<02561>>26538000
               ERRMESSAGE( M374, 1);                           <<02561>>26540000
            NEWREQ := TRUE;                                    <<02561>>26542000
            END;                                               <<02561>>26544000
         END;                                                  <<02561>>26546000
      END;                                                     <<02561>>26548000
END;                                                           <<02561>>26550000
INTEGER PROCEDURE COLD'LOAD'MEDIA( FUNC, BUF, WORDC, RTN);     <<02510>>26552000
   VALUE FUNC, WORDC, RTN;                                     <<02510>>26554000
   INTEGER FUNC, WORDC;                                        <<02510>>26556000
   LOGICAL RTN;                                                <<02510>>26558000
   ARRAY BUF;                                                  <<02510>>26560000
   OPTION VARIABLE;                                            <<02510>>26562000
BEGIN                                                          <<02510>>26564000
   LOGICAL VAR = Q-4;                                          <<02510>>26566000
   INTEGER MSGNR = COLD'LOAD'MEDIA;                            <<02510>>26568000
   CC := CCE;                                                  <<02510>>26570000
   IF NOT VAR THEN RTN := FALSE;                               <<02510>>26572000
   IF SERIALDISCLOAD THEN                                      <<02510>>26574000
      COLD'LOAD'MEDIA := SDISCDVR( FUNC, BUF, WORDC)           <<02510>>26576000
   ELSE                                                        <<02510>>26578000
$IF X1=OFF   << ***** SERIES II,III UNIQUE ******* >>          <<02510>>26580000
      IF SERIESII'III THEN                                     <<02510>>26582000
         BEGIN                                                 <<02510>>26584000
         TOS := SYSTAPEDRT;                                    <<02510>>26586000
         ASSEMBLE( TIO 0 );                                    <<02510>>26588000
         IF <> THEN                                            <<02510>>26590000
            BEGIN                                              <<02510>>26592000
            IF STARFISH THEN                                   <<02510>>26594000
               GO HPIB'MTDVR                                   <<02510>>26596000
            ELSE                                               <<02510>>26598000
               ERRMESSAGE( M1, SYSTAPEDRT);                    <<02510>>26600000
            END;                                               <<02510>>26602000
         CASE FUNC OF                                          <<02510>>26604000
            BEGIN                                              <<02510>>26606000
            COLD'LOAD'MEDIA := READTAPE( BUF, WORDC);          <<02510>>26608000
            COLD'LOAD'MEDIA := TAPECTRL(%11); << REWIND UNLOAD <<02510>>26610000
            COLD'LOAD'MEDIA := TAPECTRL(%17); << FSF >>        <<02510>>26612000
            READYTAPE;                                         <<02510>>26614000
            END;                                               <<02510>>26616000
         END                                                   <<02510>>26618000
      ELSE                                                     <<02510>>26620000
$IF      << ******* RETURN TO COMMON CODE ********* >>         <<02510>>26622000
         BEGIN  << SERIES 33/44/55 >>                          <<02510>>26624000
HPIB'MTDVR:                                                    <<02510>>26626000
         COLD'LOAD'MEDIA := IF (SYSTAPESTYPE).(13:3) = 1 THEN  <<02561>>26628000
            MT7976( FUNC, BUF, WORDC)                          <<02561>>26630000
         ELSE                                                  <<02561>>26632000
            MTAPE( FUNC, BUF, WORDC);                          <<02561>>26634000
         END;                                                  <<02510>>26636000
   IF > THEN                                                   <<02510>>26638000
      CC := CCG                                                <<02510>>26640000
   ELSE                                                        <<02510>>26642000
      IF < THEN                                                <<02510>>26644000
         BEGIN                                                 <<02510>>26646000
         CC := CCL;                                            <<02510>>26648000
         IF NOT RTN THEN ERRMESSAGE(MSGNR); << DIE >>          <<02510>>26650000
         IF MSGNR = 7 OR MSGNR = 8 THEN                        <<02510>>26652000
            COLD'LOAD'MEDIA := 0                               <<02510>>26654000
         ELSE                                                  <<02510>>26656000
            BEGIN                                              <<02510>>26658000
            MESSAGE(MSGNR);                                    <<02510>>26660000
            COLD'LOAD'MEDIA := 1;                              <<02510>>26662000
            END;                                               <<02510>>26664000
         END;                                                  <<02510>>26666000
END;                                                           <<02510>>26668000
PROCEDURE NEXTREEL(BUF);                                       <<00071>>26670000
INTEGER ARRAY BUF;                                             <<00071>>26672000
BEGIN                                                          <<00071>>26674000
BYTE POINTER BBUF;                                             <<00071>>26676000
INTEGER LENGTH,WORDC;                                          <<00071>>26678000
LOGICAL FOUND;                                                 <<00071>>26680000
@BBUF:=@BUF&LSL(1);                                            <<00071>>26682000
WORDC:=COLD'LOAD'MEDIA(READ,BUF,1024);                         <<00678>>26684000
IF WORDC=40 AND BBUF=                                          <<00071>>26686000
"SYSDUMP/INITIAL DISC" THEN                                    <<00071>>26688000
   BEGIN <<GET NEXT FLOPPY DISC>>                              <<00071>>26690000
   IF SDISCREEL=0 THEN                                         <<00071>>26692000
      BEGIN                                                    <<00071>>26694000
      SDISCREEL:=BUF(10);                                      <<00071>>26696000
      SDISCDATE:=BUF(11);                                      <<00071>>26698000
      SDISCTIME1:=BUF(12);                                     <<00071>>26700000
      SDISCTIME2:=BUF(13);                                     <<00071>>26702000
      END;                                                     <<00071>>26704000
   SDISCREEL:=SDISCREEL+1;                                     <<00071>>26706000
   FOUND := FALSE;                                             <<03715>>26708000
   DO                                                          <<03715>>26710000
      BEGIN        << INSURE CORRECT FLOPPY MOUNTED >>         <<03715>>26712000
      COLD'LOAD'MEDIA(REWUNLOAD);                              <<03715>>26714000
      MESSAGE(M2331,SDISCREEL);   << MOUNT SERIAL DISC # N >>  <<03715>>26716000
                                                               <<03715>>26718000
      COLD'LOAD'MEDIA(TAPEREADY);                              <<03715>>26720000
      IF = THEN                   << SERIAL DISC READY AND >>  <<03715>>26722000
         BEGIN                    <<    VALID FORMAT       >>  <<03715>>26724000
         COLD'LOAD'MEDIA(READ,BUF,40);   << READ HEADER >>     <<03715>>26726000
         IF BBUF = "SYSDUMP/INITIAL DISC" AND                  <<03715>>26728000
            BUF(10) = SDISCREEL AND                            <<03715>>26730000
            BUF(11) = SDISCDATE AND                            <<03715>>26732000
            BUF(12) = SDISCTIME1 AND                           <<03715>>26734000
            BUF(13) = SDISCTIME2 THEN                          <<03715>>26736000
                                                               <<03715>>26738000
            FOUND := TRUE;                                     <<03715>>26740000
         END;                                                  <<03715>>26742000
      END                                                      <<03715>>26744000
   UNTIL FOUND;                                                <<03715>>26746000
   END'OF'TAPE:=FALSE; <<False>>                               <<03598>>26748000
   END;                                                        <<00071>>26750000
END;                                                           <<00071>>26752000
                                                               <<00071>>26754000
                                                                        26756000
          <<---------------------------                                 26758000
            READ FROM MULTI-REEL TAPE                                   26760000
          --------------------------->>                                 26762000
  PROCEDURE READTAPE' (WORDC);                                 <<01092>>26764000
    VALUE WORDC;                                               <<01092>>26766000
    INTEGER WORDC;                                                      26768000
    COMMENT:                                                   <<00.06>>26770000
                                                               <<KS.88>>26772000
************ WARNING ******************                        <<KS.88>>26774000
-----------------> THIS PROCEDURE SHOULD ONLY BE USED <------- <<KS.88>>26776000
                   BY THE FILE RESTORE PORTION OF INITIAL <----<<KS.88>>26778000
                                                               <<KS.88>>26780000
      READTAPE IS DESIGNED TO ABORT THE PROGRAM IF IT          <<00.06>>26782000
      DETECTS AN EOF-MARK WHERE NOT EXPECTED.  ONLY IF         <<03715>>26784000
      WORDC=0 WILL AN EOF-MARK BE EXPECTED.  EXCEPTION:        <<00.06>>26786000
      AN EOF-MARK DENOTING THE END-OF-TAPE IN THE              <<00.06>>26788000
      MIDDLE OF A MULTIPLE-REEL FILE WILL BE HANDLED           <<00.06>>26790000
      PROPERLY.  SECOND EXCEPTION: IF A DOUBLE EOF-            <<00.06>>26792000
      MARK IS DETECTED, MANUAL OVERRIDE OF THE ABORT           <<00.06>>26794000
      IS ALLOWED. (THIS SHOULD ONLY BE USED WHEN ABSOLUTELY    <<00.06>>26796000
      NECESSARY AS DOUBLE EOF DENOTES (1)TAPE FORMAT ERROR     <<00.06>>26798000
      OR (2)PARITY ERROR DURING READING OF TRAILER LABEL.)     <<00.06>>26800000
      STATUS RETURNED BY ROUTINE:                              <<00.06>>26802000
        CCL-TAPE TRANSFER ERROR                                <<01028>>26804000
        CCG-NO MORE TAPE SETS AVAILABLE                        <<00.06>>26806000
        CCE-RECORD READ OKAY                                   <<00.06>>26808000
;                                                              <<00.06>>26810000
      BEGIN                                                             26812000
DEFINE LBUF=RESTOREBUF#;<<MAKE THIS PROCEDURE USE RESTORE BUF>><<00678>>26814000
DEFINE BLBUF = BRESTOREBUF#;                                   <<03715>>26816000
INTEGER                                                        <<*LDT*>>26818000
    LDT'INDEX,                                                 <<*DVR*>>26820000
    LPDT'INDEX,                                                <<*DVR*>>26822000
    DVR'INDEX;                                                 <<*DVR*>>26824000
        DOUBLE DATE;                                           <<00678>>26826000
        INTEGER NEWREEL;                                       <<00678>>26828000
        INTEGER DATE1=DATE,DATE2=DATE1+1,SAVX;                 <<00678>>26830000
          BYTE POINTER ITMPB;                                  <<00678>>26832000
          @ITMPB:=@ITMP&LSL(1);<<CONVERT ADDRESS TO BYTES>>    <<00678>>26834000
          STAT.(6:2) := CCE;  <<NORMAL RETURN>>                <<00678>>26836000
  AGN:    IF WORDC <> 0 THEN                                   <<00678>>26838000
          IF DATAFLAG THEN                                     <<00678>>26840000
            BEGIN  <<DATA IN BUFFER>>                          <<00678>>26842000
              DATAFLAG := FALSE;                               <<00678>>26844000
              RETURN;                                          <<00678>>26846000
            END                                                <<00678>>26848000
          ELSE                                                 <<00678>>26850000
            BEGIN  <<READ ARECORD>>                            <<00678>>26852000
              LEN := COLD'LOAD'MEDIA(READ, LBUF, WORDC, TRUE); <<01092>>26854000
              IF > THEN GO CHECKFOREOT;  <<EOF>>               <<00678>>26856000
              IF < THEN GO TO ERR'EXIT;                        <<01092>>26858000
              RETURN;                                          <<00678>>26860000
            END;                                               <<00678>>26862000
          DATAFLAG := FALSE;  <<FORWARD SPACE FILE>>           <<00678>>26864000
          COLD'LOAD'MEDIA(FWDSPFILE,,,TRUE);                   <<01092>>26866000
          IF < THEN GO TO ERR'1'EXIT;                          <<01092>>26868000
  CHECKFOREOT:                                                 <<00678>>26870000
          LEN := COLD'LOAD'MEDIA(READ, LBUF, RECSIZE, TRUE);   <<01092>>26872000
          IF > THEN                                            <<00678>>26874000
            BEGIN  <<DOUBLE EOF MARKS>>                        <<00678>>26876000
            <<USUALLY INDICATES TAPE FORMAT ERROR WHICH>>      <<00678>>26878000
            <<IS IRRECOVERABLE, BUT MAY INDICATE A >>          <<00678>>26880000
            <<PARITY ERROR DURING READING OF THE TAPE>>        <<00678>>26882000
            <<TRAILER LABEL, WHICH IS NOT FATAL.>>             <<00678>>26884000
            MESSAGE(M2279);    <<**WARNING** DOUBLE EOF MARK.>><<01103>>26886000
            IF HEDLABP THEN GO TO ERR'1'EXIT;                  <<01092>>26888000
            NEWREEL:=REEL+1;<<USE REEL# FROM HEADER>>          <<01092>>26890000
            REEL:=REEL+1;<<KEEP UP THE COUNTING>>              <<01092>>26892000
NXTREEL:    COLD'LOAD'MEDIA(REWUNLOAD,,,TRUE);                 <<01092>>26894000
            IF < THEN GO TO ERR'1'EXIT;                        <<01092>>26896000
            GETYESNO(@NOMORESETS, M2284);                      <<01103>>26898000
            << IS THERE ANOTHER TAPE TO READ? >>               <<01092>>26900000
            MESSAGE(M2292,NEWREEL);                            <<*8392>>26902000
            COLD'LOAD'MEDIA(TAPEREADY,,,TRUE);                 <<01092>>26904000
            IF > THEN            << SERIAL DISC NOT READY >>   <<03715>>26906000
               GOTO NXTREEL;     <<    OR BAD FORMAT      >>   <<03715>>26908000
            IF < THEN GO TO ERR'1'EXIT;                        <<01092>>26910000
            LEN:=COLD'LOAD'MEDIA(READ,LBUF,50,TRUE);           <<01092>>26912000
            IF < THEN GO TO ERR'EXIT;                          <<01092>>26914000
            IF LEN <> 40 OR BLBUF <> LABELTEXT THEN            <<00678>>26916000
              BEGIN  <<BAD LABEL>>                             <<00678>>26918000
              MESSAGE(M376);  <<NOT A RELOAD TAPE>>            <<01103>>26920000
              GOTO NXTREEL;                                    <<00678>>26922000
              END;                                             <<00678>>26924000
            TOS:=@CHDATE&LSL(1);                               <<00678>>26926000
            IF * <> ITMPB,(3) THEN                             <<00678>>26928000
              BEGIN  <<TAPE NOT A MEMBER OF THIS SET>>         <<00678>>26930000
              MESSAGE(M377);                                   <<01103>>26932000
              GOTO NXTREEL;                                    <<00678>>26934000
              END;                                             <<00678>>26936000
            IF REELNUM <> NEWREEL THEN                         <<00678>>26938000
              BEGIN  <<WRONG REEL>>                            <<00678>>26940000
              MESSAGE(M379);  << WRONG REEL >>                 <<01103>>26942000
              GOTO NXTREEL;                                    <<00678>>26944000
              END;                                             <<00678>>26946000
            COLD'LOAD'MEDIA(FWDSPFILE,,,TRUE);                 <<01092>>26948000
            IF < THEN GO TO ERR'1'EXIT;                        <<01092>>26950000
            COLD'LOAD'MEDIA(FWDSPFILE,,,TRUE);                 <<01092>>26952000
            IF < THEN GO TO ERR'1'EXIT;                        <<01092>>26954000
      LEN:=COLD'LOAD'MEDIA(READ,LBUF,RECSIZE,TRUE); <<READ FIRST>>      26956000
            <<RECORD OF NEW FILE>>                             <<00678>>26958000
            IF < THEN GO TO ERR'EXIT;                          <<01092>>26960000
            DATAFLAG:=TRUE;                                    <<00678>>26962000
            RETURN;                                            <<00678>>26964000
            END;                                               <<00678>>26966000
          IF < THEN GO TO ERR'EXIT;                            <<01092>>26968000
          IF LEN<>40 THEN                                      <<00678>>26970000
            BEGIN  <<NOT END OF TAPE>>                         <<00678>>26972000
              IF WORDC<>0 THEN GO TO ERR'1'EXIT;               <<01092>>26974000
              DATAFLAG := TRUE;  <<DATA IN BUFFER>>            <<00678>>26976000
              RETURN;                                          <<00678>>26978000
            END;                                               <<00678>>26980000
          IF ZFIELD=1 THEN <<END OF TAPE SET>>                 <<00678>>26982000
          IF WORDC<>0 THEN GO TO ERR'1'EXIT                    <<01092>>26984000
          ELSE                                                 <<00678>>26986000
            BEGIN  <<REQUEST ANOTHER TAPE SET>>                <<00678>>26988000
              DATE1 := CHDATE;                                 <<00678>>26990000
              DATE2 := CHHHMM;  <<SAVE DATE>>                  <<00678>>26992000
NEXTSET:      COLD'LOAD'MEDIA(REWUNLOAD,,,TRUE);               <<01092>>26994000
              IF < THEN GO TO ERR'1'EXIT;                      <<01092>>26996000
              IF STARTTYPE = CBNEW THEN GO NOMORESETS;         <<*9006>>26998000
              GETYESNO(@NOMORESETS,M2276,NUSERFILES);          <<01103>>27000000
              <<FILES NOT FOUND;>>                             <<01062>>27002000
              <<ANOTHER TAPE SET AVAILABLE?>>                  <<00678>>27004000
              GETYESNO(@TREADY,M2330);                         <<01103>>27006000
              <<CHANGE INPUT DEVICE?>>                         <<00678>>27008000
              SD'ONLINE:=FALSE;  <<False>>                     <<03598>>27010000
              DO                                               <<00678>>27012000
                 BEGIN <<GET A VALID INPUT LDEV>>              <<00678>>27014000
                 SYSTAPELDEV:=GETVAL(M2011,2,HLDEV,1);         <<01103>>27016000
                 LDT'INDEX := SYSTAPELDEV * LDTSIZE;           <<*LDT*>>27018000
                 LPDT'INDEX := SYSTAPELDEV * LPDTSIZE;         <<*LPDT>>27020000
                 DVR'INDEX  := SYSTAPELDEV * DVRSIZE;          <<*DVR*>>27022000
                 SYSTAPETYPE := LDT'DEVICE'TYPE;               <<*LDT*>>27024000
                 SYSTAPESTYPE := LPDT'SUBTYPE;                 <<*LPDT>>27026000
                 SYSTAPEDRT := DVRDRTNUM;                      <<*DVR*>>27028000
                 SYSTAPEUNIT := DVRUNITNUM;                    <<*DVR*>>27030000
                 IF NON'DS'LDEV(SYSTAPELDEV) THEN              <<03550>>27032000
                   BEGIN  << HAVE A CONFIGURED DEVICE >>       <<03550>>27034000
                   INITDRT( SYSTAPEDRT);                       <<03550>>27036000
                   IF SYSTAPETYPE=TAPETYPE THEN                <<03550>>27038000
                     BEGIN    << WE HAVE A MAG TAPE >>         <<03550>>27040000
                     SERIALDISCLOAD := FALSE;                  <<03550>>27042000
                     SD'ONLINE := TRUE;  <<True>>              <<03598>>27044000
                     IF SYSTAPESTYPE.(13:3) = 1 THEN           <<03550>>27046000
                        << WE HAVE A 7976 TAPE DRIVE >>        <<03550>>27048000
                        MT7976(4,I,0); <<CLEAR PWR-ON STATUS>> <<03550>>27050000
                     END                                       <<03550>>27052000
                   ELSE IF SDISC'TYPE(SYSTAPETYPE,             <<03550>>27054000
                                      SYSTAPESTYPE) THEN       <<03550>>27056000
                     BEGIN   << VALID SERIAL DISC TYPE >>      <<03550>>27058000
                     SD'ONLINE := TRUE;  <<True>>              <<03598>>27060000
                     SERIALDISCLOAD := TRUE;                   <<03550>>27062000
                     END     << VALID SERIAL DISC TYPE >>      <<03550>>27064000
                   ELSE                                        <<03550>>27066000
                     MESSAGE( 2285);   << NOT A VALID COLD- >> <<03550>>27068000
                                       << LOAD DEVICE       >> <<03550>>27070000
                   END                                         <<03550>>27072000
                 ELSE                                          <<03550>>27074000
                   MESSAGE( 2285);  << NOT A VALID >>          <<03550>>27076000
                                    << DEVICE NO.  >>          <<03550>>27078000
                 END   <<GET A VALID INPUT LDEV>>              <<00678>>27080000
              UNTIL SD'ONLINE;                                 <<03715>>27082000
                                                               <<00678>>27084000
TREADY:                                                        <<00678>>27086000
                                                               <<00678>>27088000
              COLD'LOAD'MEDIA(TAPEREADY,,,TRUE);               <<01092>>27090000
              IF > THEN          << SERIAL DISC NOT READY >>   <<03715>>27092000
                 GOTO NEXTSET;   <<    OR BAD FORMAT      >>   <<03715>>27094000
              IF < THEN GO TO ERR'1'EXIT;                      <<01092>>27096000
              COLD'LOAD'MEDIA(FWDSPFILE,,,TRUE);               <<01092>>27098000
              IF < THEN GO TO ERR'1'EXIT;                      <<01092>>27100000
              COLD'LOAD'MEDIA(FWDSPFILE,,,TRUE);               <<01092>>27102000
              IF < THEN GO TO ERR'1'EXIT;                      <<01092>>27104000
              LEN:=COLD'LOAD'MEDIA(READ,LBUF,50,TRUE);         <<01092>>27106000
              IF < THEN GO TO ERR'EXIT;                        <<01092>>27108000
              IF LEN<>40 OR BLBUF<>LABELTEXT THEN              <<00678>>27110000
                BEGIN  <<BAD LABEL>>                           <<00678>>27112000
                  MESSAGE(M376);  <<NOT A RELOAD TAPE>>        <<01103>>27114000
                  GO NEXTSET;                                  <<00678>>27116000
                END;                                           <<00678>>27118000
              REEL:=REELNUM;<<SET REEL COUNT FROM HEADER>>     <<00678>>27120000
              <<LABEL TO BE USED IN CASE OF PARITY ERROR>>     <<00678>>27122000
              <<IN READING OF TRAILER LABEL>>                  <<00678>>27124000
              MOVE ITMP:=CHDATE,(3);<<SET CREATION DATE>>      <<00678>>27126000
              <<FOR SAME REASON>>                              <<00678>>27128000
              HEDLABP:=FALSE;<<NO HEADER LABEL PARITY ERR>>    <<00678>>27130000
              TOS := DATE;                                     <<00678>>27132000
              TOS := CHDATE;                                   <<00678>>27134000
              TOS := CHHHMM;                                   <<00678>>27136000
              ASSEMBLE(DCMP);                                  <<00678>>27138000
              IF < THEN                                        <<00678>>27140000
                BEGIN  <<WRONG ORDER>>                         <<00678>>27142000
                  MESSAGE(M378); << MUST HAVE EARILIER DATE >> <<01103>>27144000
                  <<WRONG SET-MUST BE EARLIER DATE>>           <<00678>>27146000
                  GO NEXTSET;                                  <<00678>>27148000
  NOMORESETS:     STAT.(6:2) := CCG;  <<NO MORE TAPE SETS AVAILABLE>>   27150000
                  RETURN;                                      <<00678>>27152000
                END;                                           <<00678>>27154000
              COLD'LOAD'MEDIA(FWDSPFILE,,,TRUE);               <<01092>>27156000
              IF < THEN GO TO ERR'1'EXIT;                      <<01092>>27158000
              READTAPE'(0);  <<SKIP DIRECTORY>>                <<00678>>27160000
              IF < THEN GO TO ERR'1'EXIT;                      <<01092>>27162000
              IF > THEN GO NOMORESETS;                         <<01092>>27164000
              RETURN;                                          <<00678>>27166000
            END;                                               <<00678>>27168000
          SAVX := XFIELD;  <<SAVE CONTINUATION FLAG>>          <<00678>>27170000
          NEWREEL := REELNUM+1;                                <<00678>>27172000
          REEL:=REEL+1;<<COUNT REELS AS THEY ARE READ IN>>     <<00678>>27174000
          <<CASE A PARITY ERROR OCCURS DURING READING OF>>     <<00678>>27176000
          <<THE TRAILER LABEL.  "REEL" WILL BE USED TO>>       <<00678>>27178000
          <<BE SURE THE PROPER REEL FOLLOWS THE ERROR>>        <<00678>>27180000
          MOVE ITMP := CHDATE,(3);  <<SAVE OLD DATE>>          <<00678>>27182000
  NEXTREEL:                                                    <<00678>>27184000
          COLD'LOAD'MEDIA(REWUNLOAD,,,TRUE);                   <<01092>>27186000
          IF < THEN GO TO ERR'1'EXIT;                          <<01092>>27188000
          MESSAGE(M2292,NEWREEL);                              <<*8392>>27190000
          COLD'LOAD'MEDIA(TAPEREADY,,,TRUE);                   <<01092>>27192000
          IF > THEN              << SERIAL DISC NOT READY >>   <<03715>>27194000
             GOTO NEXTREEL;      <<    OR BAD FORMAT      >>   <<03715>>27196000
          IF < THEN GO TO ERR'1'EXIT;                          <<01092>>27198000
          LEN:=COLD'LOAD'MEDIA(READ,LBUF,50,TRUE);             <<01092>>27200000
          IF < THEN GO TO ERR'EXIT;                            <<01092>>27202000
          IF LEN<>40 OR BLBUF<>LABELTEXT THEN                  <<00678>>27204000
            BEGIN  <<BAD LABEL>>                               <<00678>>27206000
              MESSAGE(M376);  <<NOT A RELOAD TAPE>>            <<01103>>27208000
              GOTO NEXTREEL;                                   <<00678>>27210000
            END;                                               <<00678>>27212000
          TOS := @CHDATE&LSL(1);                               <<00678>>27214000
          IF *<>ITMPB,(3) THEN                                 <<00678>>27216000
            BEGIN  <<TAPE NOT A MEMBER OF THIS SET>>           <<00678>>27218000
              MESSAGE(M377);                                   <<01103>>27220000
              GO NEXTREEL;                                     <<00678>>27222000
            END;                                               <<00678>>27224000
          IF REELNUM<>NEWREEL THEN                             <<00678>>27226000
            BEGIN                                              <<00678>>27228000
              MESSAGE(M379);  <<WRONG REEL>>                   <<01103>>27230000
              GO NEXTREEL;                                     <<00678>>27232000
            END;                                               <<00678>>27234000
          COLD'LOAD'MEDIA(FWDSPFILE,,,TRUE);                   <<01092>>27236000
          IF < THEN GO TO ERR'1'EXIT;                          <<01092>>27238000
          IF SAVX=0 THEN GO AGN  <<FILE CONTINUED ON NEXT TAPE>>        27240000
          ELSE IF WORDC<>0 THEN GO TO ERR'1'EXIT;              <<01092>>27242000
          RETURN;                                              <<01092>>27244000
ERR'1'EXIT:                                                    <<01092>>27246000
          LEN := 1;                                            <<01092>>27248000
                                                               <<01092>>27250000
                                                               <<01092>>27252000
ERR'EXIT:                                                      <<01092>>27254000
          CC := CCL;                                           <<01092>>27256000
          RETURN;                                              <<01092>>27258000
                                                               <<01092>>27260000
      END <<READTAPE'>> ;                                      <<00678>>27262000
                                                               <<04546>>27264000
$CONTROL SEGMENT=RESIDENT                                      <<04546>>27266000
   <<-------------------------->>                              <<04546>>27268000
   << UNLOCK THE CS80 DEVICES  >>                              <<04546>>27270000
   <<-------------------------->>                              <<04546>>27272000
PROCEDURE UNLOCK'CS80;                                         <<04546>>27274000
BEGIN                                                          <<04546>>27276000
COMMENT  UNLOCK THE CS80 DEVICES BEFORE EXITING INITIAL;       <<04546>>27278000
INTEGER                                                        <<*LDT*>>27280000
    LDT'INDEX;                                                 <<*LDT*>>27282000
   LDEV := 0;                                                  <<04546>>27284000
   WHILE (LDEV:=LDEV+1) <= HLDEV DO                            <<04546>>27286000
     BEGIN                                                     <<*LDT*>>27288000
     LDT'INDEX := LDEV * LDTSIZE;                              <<*LDT*>>27290000
     IF NON'DS'LDEV(LDEV) THEN                                 <<04546>>27292000
       IF LDT'DEVICE'TYPE = 3 << CS80 DEVICE >> THEN           <<*LDT*>>27294000
         DISC(UNLOCK'DEV,LDEV,0D,DTEMP,2);                     <<04546>>27296000
     END;                                                      <<*LDT*>>27298000
END; <<UNLOCK'CS80>>                                           <<04546>>27300000
INTEGER PROCEDURE BUILDSYSPTR( MEMORYADDR);                    <<32BND>>27302000
   VALUE MEMORYADDR;                                           <<32BND>>27304000
   DOUBLE MEMORYADDR;                                          <<32BND>>27306000
BEGIN                                                          <<32BND>>27308000
   INTEGER                                                     <<32BND>>27310000
      BANK     = MEMORYADDR,                                   <<32BND>>27312000
      ADDRESS  = MEMORYADDR+1;                                 <<32BND>>27314000
                                                               <<32BND>>27316000
   IF ADDRESS.(11:5) <> 0 THEN ERRMESSAGE(M374,3);             <<32BND>>27318000
   IF BANK > 31 THEN ERRMESSAGE(M374,4);                       <<32BND>>27320000
   ADDRESS := ADDRESS-SYSBASE; << MAKE SYSGLOBAL RELATIVE >>   <<32BND>>27322000
   ADDRESS.(11:5) := BANK;                                     <<32BND>>27324000
   BUILDSYSPTR := ADDRESS;                                     <<32BND>>27326000
   IF NOT LOGICALMAPPING AND BANK > 0 THEN ERRMESSAGE( M351);  <<BANK0>>27328000
END;                                                           <<32BND>>27330000
PROCEDURE MFDS( BUF, DSTN, OFFSET, COUNT);                     <<32BND>>27332000
   VALUE DSTN, OFFSET, COUNT;                                  <<32BND>>27334000
   ARRAY BUF;                                                  <<32BND>>27336000
   INTEGER DSTN, OFFSET, COUNT;                                <<32BND>>27338000
BEGIN                                                          <<32BND>>27340000
   TOS := @BUF;                                                <<32BND>>27342000
   TOS := DSTN;                                                <<32BND>>27344000
   TOS := OFFSET;                                              <<32BND>>27346000
   TOS := COUNT;                                               <<32BND>>27348000
   ASSEMBLE( MFDS );                                           <<32BND>>27350000
END;                                                           <<32BND>>27352000
PROCEDURE MTDS( DSTN, OFFSET, BUF, COUNT);                     <<32BND>>27354000
   VALUE DSTN, OFFSET, COUNT;                                  <<32BND>>27356000
   ARRAY BUF;                                                  <<32BND>>27358000
   INTEGER DSTN, OFFSET, COUNT;                                <<32BND>>27360000
BEGIN                                                          <<32BND>>27362000
   TOS := DSTN;                                                <<32BND>>27364000
   TOS := OFFSET;                                              <<32BND>>27366000
   TOS := @BUF;                                                <<32BND>>27368000
   TOS := COUNT;                                               <<32BND>>27370000
   ASSEMBLE( MTDS );                                           <<32BND>>27372000
END;                                                           <<32BND>>27374000
PROCEDURE MDS( TARGETDSTN,TOFFSET,SOURCEDSTN,SOFFSET,COUNT);   <<32BND>>27376000
   VALUE TARGETDSTN, TOFFSET, SOURCEDSTN, SOFFSET, COUNT;      <<32BND>>27378000
   INTEGER TARGETDSTN, TOFFSET, SOURCEDSTN, SOFFSET, COUNT;    <<32BND>>27380000
BEGIN                                                          <<32BND>>27382000
   TOS := TARGETDSTN;                                          <<32BND>>27384000
   TOS := TOFFSET;                                             <<32BND>>27386000
   TOS := SOURCEDSTN;                                          <<32BND>>27388000
   TOS := SOFFSET;                                             <<32BND>>27390000
   TOS := COUNT;                                               <<32BND>>27392000
   ASSEMBLE( MDS );                                            <<32BND>>27394000
END;                                                           <<32BND>>27396000
$CONTROL SEGMENT=FILEIO                                        <<03603>>27398000
PROCEDURE SSEA(DCOREADDR, VALUE');                             <<01384>>27400000
  VALUE DCOREADDR, VALUE';                                     <<01384>>27402000
  DOUBLE  DCOREADDR;                                           <<01384>>27404000
  INTEGER VALUE';                                              <<01384>>27406000
  BEGIN                                                        <<01384>>27408000
  TOS := DCOREADDR;                                            <<01384>>27410000
  TOS := VALUE';                                               <<01384>>27412000
  ASSEMBLE( SSEA );                                            <<02510>>27414000
  END;  << SSEA >>                                             <<01384>>27416000
PROCEDURE SDEA( DCOREADDR, DVALUE);                            <<32BND>>27418000
  VALUE DCOREADDR, DVALUE;                                     <<32BND>>27420000
  DOUBLE DCOREADDR, DVALUE;                                    <<32BND>>27422000
  BEGIN                                                        <<32BND>>27424000
  TOS:= DCOREADDR;                                             <<32BND>>27426000
  TOS:= DVALUE;                                                <<32BND>>27428000
  ASSEMBLE( SDEA );                                            <<32BND>>27430000
  END;  << SDEA >>                                             <<32BND>>27432000
LOGICAL PROCEDURE LSEA(DCOREADDR);                             <<01384>>27434000
  VALUE DCOREADDR;                                             <<01384>>27436000
  DOUBLE DCOREADDR;                                            <<01384>>27438000
  BEGIN                                                        <<01384>>27440000
  TOS := DCOREADDR;                                            <<01384>>27442000
  ASSEMBLE(LSEA);                                              <<01384>>27444000
  LSEA := TOS;                                                 <<01384>>27446000
  END;  << LSEA >>                                             <<01384>>27448000
INTEGER PROCEDURE ROUND(NUMBER);                               <<01384>>27450000
  VALUE NUMBER;                                                <<01384>>27452000
  LOGICAL NUMBER;                                              <<01384>>27454000
  COMMENT:  THIS PROCEDURE ROUNDS UP THE NUMBER(POSITIVE)      <<01384>>27456000
  PASSED TO IT TO MAKE IT DIVISIBLE BY 4;                      <<01384>>27458000
  BEGIN                                                        <<01384>>27460000
  ROUND := (NUMBER+3)&LSR(2)&LSL(2);                           <<01384>>27462000
  END;  << ROUND >>                                            <<01384>>27464000
logical procedure compare'words(addr1,addr2,count);            <<*DVR*>>27466000
                                                               <<*DVR*>>27468000
  comment                                                      <<*DVR*>>27470000
                                                               <<*DVR*>>27472000
      This procedure will compare the memory locations indicate<<*DVR*>>27474000
      by word pointers addr1 and addr2. If they are the same fo<<*DVR*>>27476000
      the count indicated a value of true is returned to the ca<<*DVR*>>27478000
      if not, a value of false is returned.                    <<*DVR*>>27480000
                                                               <<*DVR*>>27482000
  ;                                                            <<*DVR*>>27484000
    value addr1,addr2,count;                                   <<*DVR*>>27486000
    pointer addr1,addr2;                                       <<*DVR*>>27488000
    integer count;                                             <<*DVR*>>27490000
                                                               <<*DVR*>>27492000
  begin                                                        <<*DVR*>>27494000
                                                               <<*DVR*>>27496000
    integer i;                                                 <<*DVR*>>27498000
    compare'words := true;                                     <<*DVR*>>27500000
    i := -1;                                                   <<*DVR*>>27502000
    while (i:=i+1) < count do                                  <<*DVR*>>27504000
      if addr1(i) <> addr2(i) then compare'words := false;     <<*DVR*>>27506000
  end;  << compare'words >>                                    <<*DVR*>>27508000
PROCEDURE DLSIZE(WORDS);                                       <<MPEIV>>27510000
  VALUE WORDS;                                                 <<MPEIV>>27512000
  INTEGER WORDS;                                               <<MPEIV>>27514000
                                                               <<MPEIV>>27516000
  COMMENT:  THIS PROCEDURE EXPANDS AND CONTRACTS               <<MPEIV>>27518000
  INITIALS' DL AREA BY THE AMOUNT WORDS.  IF WORDS             <<MPEIV>>27520000
  IS A POSITIVE VALUE THE DL IS EXPANDED: A NEGATIVE           <<MPEIV>>27522000
  VALUE WILL CONTRACT THE DL AREA.                             <<MPEIV>>27524000
  ;                                                            <<MPEIV>>27526000
                                                               <<MPEIV>>27528000
  BEGIN                                                        <<MPEIV>>27530000
  DOUBLE  CUR'DL,      << CURRENT ABSOLUTE DL ADDRESS >>       <<MPEIV>>27532000
          NEW'DL;      <<   NEW      "     "      "   >>       <<MPEIV>>27534000
                                                               <<MPEIV>>27536000
  LOGICAL NEW'DL1      = NEW'DL,                               <<MPEIV>>27538000
          NEW'DL2      = NEW'DL+1;                             <<MPEIV>>27540000
                                                               <<MPEIV>>27542000
  LOGICAL L'WORDS      = WORDS;                                <<MPEIV>>27544000
                                                               <<MPEIV>>27546000
<< COMPUTE ABSOLUTE DL ADDRESS >>                              <<MPEIV>>27548000
  PUSH(DL,DB);                                                 <<MPEIV>>27550000
  ASSEMBLE(CAB, ADD);  << ABSOLUTE DL ADDRESS >>               <<MPEIV>>27552000
  CUR'DL := TOS;                                               <<MPEIV>>27554000
                                                               <<MPEIV>>27556000
  IF WORDS > 0 THEN                                            <<MPEIV>>27558000
    BEGIN  << EXPAND DL AREA >>                                <<MPEIV>>27560000
    NEW'DL := CUR'DL - DOUBLE(L'WORDS);                        <<MPEIV>>27562000
    PUSH (Z,DL);                                               <<04261>>27564000
    ASSEMBLE (SUB);  <<TOS HOLDS CURRENT SIZE OF STACK>>       <<04261>>27566000
    IF (TOS+L'WORDS > MAXSTACKSIZE) OR  <<EXCEED STK SIZE LMT>><<04261>>27568000
       (NEW'DL2 <= ADDRESS(NEW'DL1)) <<DL OVRLAPS IN USE MEM>> <<04261>>27570000
       THEN ERRMESSAGE(M350);  <<OUT OF MEMORY>>               <<04261>>27572000
                                                               <<04261>>27574000
  << CLEAR NEW DL AREA JUST TO BE NICE >>                      <<MPEIV>>27576000
    TOS := NEW'DL;                                             <<MPEIV>>27578000
    TOS := 0;                                                  <<MPEIV>>27580000
    ASSEMBLE(SSEA; INCA,DDUP; DECA);                           <<MPEIV>>27582000
    TOS := L'WORDS-1;                                          <<MPEIV>>27584000
    ASSEMBLE(MABS 5);                                          <<MPEIV>>27586000
    END  << EXPAND DL AREA >>                                  <<MPEIV>>27588000
                                                               <<MPEIV>>27590000
  ELSE  << * * * * * * * * * * * * * * * * * * * >>            <<MPEIV>>27592000
                                                               <<MPEIV>>27594000
    BEGIN  << CONTRACT DL AREA >>                              <<MPEIV>>27596000
    WORDS := (-WORDS);                                         <<MPEIV>>27598000
    NEW'DL := CUR'DL + DOUBLE(L'WORDS);                        <<MPEIV>>27600000
    END;  << CONTRACT DL AREA >>                               <<MPEIV>>27602000
                                                               <<MPEIV>>27604000
<< SET NEW DL VALUE >>                                         <<MPEIV>>27606000
  TOS := NEW'DL;                                               <<MPEIV>>27608000
  PUSH (DB);                                                   <<MPEIV>>27610000
  ASSEMBLE(DSUB, DELB);  << DB RELATIVE DL VALUE >>            <<MPEIV>>27612000
  SET(DL);                                                     <<MPEIV>>27614000
                                                               <<MPEIV>>27616000
  END;  << DLSIZE >>                                           <<MPEIV>>27618000
$CONTROL SEGMENT=MAINSEG4                                      <<03553>>27620000
$INCLUDE INCLPARL                                              <<*7648>>27622000
                                                               <<MPEIV>>27624000
                                                               <<MPEIV>>27626000
$CONTROL SEGMENT=MAINSEG4                                      <<03553>>27628000
PROCEDURE INITHEADERS(REGIONBASE,REGIONSIZE);                  <<MPEIV>>27630000
VALUE REGIONBASE,REGIONSIZE;                                   <<MPEIV>>27632000
DOUBLE REGIONBASE;                                             <<MPEIV>>27634000
INTEGER REGIONSIZE;                                            <<MPEIV>>27636000
                                                               <<MPEIV>>27638000
                                                               <<MPEIV>>27640000
COMMENT                                                        <<MPEIV>>27642000
THIS PROCEDURE FIXES UP THE REGION HEADERS AND TRAILERS        <<MPEIV>>27644000
FOR THE AVAILABLE SPACE AT GENERATION TIME                     <<MPEIV>>27646000
                                                               <<03553>>27648000
WARNING!  THIS PROCEDURE MUST STAY IN THE SAME SEGMENT AS      <<03553>>27650000
INITMEMORYLISTS.                                               <<03553>>27652000
;                                                              <<MPEIV>>27654000
BEGIN                                                          <<MPEIV>>27656000
<<ZERO OUT THE HEADER>>                                        <<MPEIV>>27658000
TOS:=REGIONBASE;                                               <<MPEIV>>27660000
TOS:=TOS-HEADERLENGTH;                                         <<MPEIV>>27662000
ASSEMBLE(ZERO;SSEA;INCA,DDUP;DECA);                            <<MPEIV>>27664000
TOS:=HEADERLENGTH-1;                                           <<MPEIV>>27666000
ASSEMBLE(MABS);                                                <<MPEIV>>27668000
TOS:=0;                                                        <<MPEIV>>27670000
TOS.REGAVAILABLEFLAG:=1;                                       <<MPEIV>>27672000
TOS.REGCLEAREDFLAG:=1;                                         <<MPEIV>>27674000
TOS:=REGIONSIZE;                                               <<MPEIV>>27676000
ASSEMBLE(DDUP,DDUP);                                           <<MPEIV>>27678000
TOS:=REGIONBASE;                                               <<MPEIV>>27680000
TOS:=TOS+RBTORASDISP;                                          <<MPEIV>>27682000
ASSEMBLE(DXCH;SDEA);                                           <<MPEIV>>27684000
TOS:=TOS+RASTOSSDISP;TOS:=REGIONSIZE;ASSEMBLE(SSEA);           <<MPEIV>>27686000
TOS:=0;                                                        <<MPEIV>>27688000
TOS:=REGIONSIZE;                                               <<MPEIV>>27690000
ASSEMBLE(DLSL PAGEPOWER);                                      <<MPEIV>>27692000
TOS:=0;                                                        <<MPEIV>>27694000
TOS:=SSTOPTRASDISP;                                            <<MPEIV>>27696000
ASSEMBLE(DADD,DELB;ADD);                                       <<MPEIV>>27698000
ASSEMBLE(DXCH;SDEA);                                           <<MPEIV>>27700000
TOS:=TOS+TRASTOTSSDISP;                                        <<MPEIV>>27702000
TOS:=REGIONSIZE;                                               <<MPEIV>>27704000
ASSEMBLE(SSEA);                                                <<MPEIV>>27706000
END  <<INITHEADERS>>;                                          <<MPEIV>>27708000
<<>>                                                           <<MPEIV>>27710000
<<INITIALIZE MEMORY LISTS>>                                    <<MPEIV>>27712000
<<>>                                                           <<MPEIV>>27714000
                                                               <<MPEIV>>27716000
$CONTROL SEGMENT=MAINSEG4                                      <<03553>>27718000
PROCEDURE INITMEMORYLISTS(OLDDB);                              <<MPEIV>>27720000
VALUE OLDDB;                                                   <<MPEIV>>27722000
DOUBLE OLDDB;  << VAALUE OF INITIALS' DB >>                    <<MPEIV>>27724000
                                                               <<MPEIV>>27726000
COMMENT                                                        <<MPEIV>>27728000
THIS PROCEDURE LINKS THE AVAILABLE SPACE IN EACH BANK          <<MPEIV>>27730000
INTO THE AVAILABLE REGION LISTS AND SET THE ASSIGNED AND       <<MPEIV>>27732000
AVAILABLE REGION HEADERS.                                      <<MPEIV>>27734000
                                                               <<03553>>27736000
WARNING!  THIS PROCEDURE MUST NOT DO ANY EXTERNAL PCAL'S,      <<03553>>27738000
BECAUSE IT CAN WIPE OUT INITIAL'S CST TABLE.  FOR THIS REASON  <<03553>>27740000
IT MUST ALSO OCCUPY THE SAME SEGMENT AS THE PROCEDURE WHICH    <<03553>>27742000
CALLS IT.                                                      <<03553>>27744000
;                                                              <<MPEIV>>27746000
BEGIN                                                          <<MPEIV>>27748000
DOUBLE  DCOREADDR;                                             <<MPEIV>>27750000
                                                               <<MPEIV>>27752000
LOGICAL RSIZE,         << AVAILABLE REGION SIZE >>             <<MPEIV>>27754000
        USEDRSIZE,     << ASSIGNED REGION SIZE >>              <<MPEIV>>27756000
        TEMP,          << USED FOR BUILDING WORDS >>           <<MPEIV>>27758000
        LASTFULLBANK,  << # OF LAST BANK OF 64K >>             <<MPEIV>>27760000
        BANK           = DCOREADDR,                            <<MPEIV>>27762000
        COREADDR       = DCOREADDR+1;                          <<MPEIV>>27764000
                                                               <<03553>>27766000
SUBROUTINE SSEA(DCOREADDR, VALUE');                            <<03553>>27768000
VALUE DCOREADDR, VALUE';                                       <<03553>>27770000
DOUBLE                                                         <<03553>>27772000
   DCOREADDR;   << ABSOLUTE CORE ADDRESS--BANK AND OFFSET >>   <<03553>>27774000
INTEGER                                                        <<03553>>27776000
   VALUE';                                                     <<03553>>27778000
COMMENT                                                        <<03553>>27780000
STORES A GIVEN INTEGER INTO A GIVEN EXTENDED CORE ADDRESS.     <<03553>>27782000
THIS IS A SUBROUTINE IN ORDER TO AVOID A PCAL.                 <<03553>>27784000
;                                                              <<03553>>27786000
BEGIN                                                          <<03553>>27788000
TOS := DCOREADDR;       << STACK DOUBLE-WORD ADDRESS >>        <<03553>>27790000
TOS := S3;              << STACK VALUE'--CANNOT USE IT BY >>   <<03553>>27792000
                        <<    NAME BECAUSE THERE ARE      >>   <<03553>>27794000
                        <<    THINGS ON THE STACK.        >>   <<03553>>27796000
ASSEMBLE( SSEA;DDEL);                                          <<03553>>27798000
END;   << SSEA >>                                              <<03553>>27800000
                                                               <<MPEIV>>27802000
                                                               <<MPEIV>>27804000
MEMORYPAGESIZE:=MMPAGESIZE;                                    <<MPEIV>>27806000
FIRSTMEMBASE := 0;                                             <<MPEIV>>27808000
IF LASTBASE = -1 THEN LASTFULLBANK := LASTBANK                 <<MPEIV>>27810000
ELSE LASTFULLBANK := LASTBANK-1;                               <<MPEIV>>27812000
                                                               <<MPEIV>>27814000
DCOREADDR := 0D;                                               <<MPEIV>>27816000
DO                                                             <<MPEIV>>27818000
   BEGIN                                                       <<MPEIV>>27820000
 << CAREFUL HERE - WE WILL LEAVE THE DOUBLE WORD DB ADDRESS  >><<MPEIV>>27822000
 << ON THE STACK.                                            >><<MPEIV>>27824000
   TOS := OLDDB;                                               <<MPEIV>>27826000
   ASSEMBLE(XCHD);  << RESET DB TO INITIALS' STK >>            <<MPEIV>>27828000
   USEDRSIZE := 0;                                             <<MEMGT>>27830000
   IF BANK <> 0 AND ADDRESS(BANK) = HEADERLENGTH THEN          <<MPEIV>>27832000
     << EMPTY BANK - FREE REGION STARTS AT ADDR 0 >>           <<MPEIV>>27834000
     COREADDR := 0                                             <<MPEIV>>27836000
   ELSE                                                        <<MPEIV>>27838000
     IF BANK <> 0 THEN  << BANK NOT EMPTY >>                   <<MPEIV>>27840000
       BEGIN  << FILL ASSIGNED REGION HEADER >>                <<MPEIV>>27842000
       COREADDR := 0;  <<START ADDR OF ASSIGNED REGION HEADER>><<MPEIV>>27844000
     << ZERO ASSIGNED REGION HEADER >>                         <<MPEIV>>27846000
       TOS := DCOREADDR;                                       <<MPEIV>>27848000
       TOS := 0;                                               <<MPEIV>>27850000
       ASSEMBLE(SSEA; INCA,DDUP; DECA);                        <<MPEIV>>27852000
       TOS := HEADERLENGTH-1;                                  <<MPEIV>>27854000
       ASSEMBLE(MABS 5);                                       <<MPEIV>>27856000
                                                               <<MPEIV>>27858000
       TEMP := 0;                                              <<MPEIV>>27860000
       TEMP.REGASSIGNEDFLAG := 1;  << ASSIGNED REGION >>       <<MPEIV>>27862000
       TEMP.REGFZFLAG := 1;  << FROZEN REGION >>               <<MPEIV>>27864000
       << ASSIGNED/FROZEN >>                                   <<RGHDR>>27866000
       SSEA( DCOREADDR+DOUBLE(HL+RBTORASDISP), TEMP);          <<RGHDR>>27868000
       USEDRSIZE := (ADDRESS(BANK) + 3 + MMPAGESIZE            <<03553>>27870000
                     - 1)&LSR(PAGEPOWER);                      <<03553>>27872000
         << PAGES IN USE PLUS 3 WORDS FOR TRAILLER >>          <<MPEIV>>27874000
       IF USEDRSIZE = 0 THEN USEDRSIZE := MAXHOLESIZE;         <<MEMGT>>27876000
       << REGION SIZE ROUNDED >>                               <<RGHDR>>27878000
       SSEA( DCOREADDR+DOUBLE(HL+RBTORSDISP), USEDRSIZE);      <<RGHDR>>27880000
       << SUB REGION SIZE >>                                   <<RGHDR>>27882000
       SSEA( DCOREADDR+DOUBLE(HL+RBTOSSDISP), USEDRSIZE);      <<RGHDR>>27884000
       COREADDR := USEDRSIZE&LSL(PAGEPOWER);  << ROUNDED >>    <<MPEIV>>27886000
       END                                                     <<MPEIV>>27888000
     ELSE                                                      <<MPEIV>>27890000
       BEGIN                                                   <<MPEIV>>27892000
       << BANK 0 - NO REGION HEADER IN LOW CORE JUST GET >>    <<MPEIV>>27894000
       << ADDRESS OF FREE REGION >>                            <<MPEIV>>27896000
       USEDRSIZE := (ADDRESS(BANK) + 3 + MMPAGESIZE            <<03553>>27898000
                     - 1)&LSR(PAGEPOWER);                      <<03553>>27900000
         << PAGES IN USE PLUS 3 WDS FOR TRAILER >>             <<MPEIV>>27902000
       IF USEDRSIZE = 0 THEN USEDRSIZE := MAXHOLESIZE;         <<MEMGT>>27904000
       COREADDR := USEDRSIZE&LSL(PAGEPOWER);  << ROUNDED >>    <<MPEIV>>27906000
       END;                                                    <<MPEIV>>27908000
   ASSEMBLE(XCHD; DDEL);  << DB BACK TO SYSGLOB >>             <<MPEIV>>27910000
                                                               <<MPEIV>>27912000
   << ROUND UP AVAILABLE REGION ADDR TO A PAGE BOUNDARY>>      <<MPEIV>>27914000
   IF COREADDR = 0 THEN                                        <<MEMGT>>27916000
      RSIZE := IF USEDRSIZE = 0 THEN MAXHOLESIZE ELSE 0        <<MEMGT>>27918000
   ELSE                                                        <<MEMGT>>27920000
      RSIZE := -COREADDR/MMPAGESIZE;                           <<MEMGT>>27922000
                         <<  ^ SAVE 3 WORDS FOR TRAILER >>     <<MPEIV>>27924000
                                                               <<MPEIV>>27926000
   <<IF AT LEAST A PAGE LONG, LINK IT INTO THE ARL>>           <<MPEIV>>27928000
   IF RSIZE <> 0 THEN                                          <<MPEIV>>27930000
     BEGIN                                                     <<MPEIV>>27932000
     IF COREADDR <> 0 THEN                                     <<MPEIV>>27934000
       BEGIN  << SOME USED, SOME UNUSED MEMORY - SET TRAILER >><<MPEIV>>27936000
       TEMP := 0;                                              <<MPEIV>>27938000
       TEMP.REGASSIGNEDFLAG := 1;  << ASSIGNED REGION >>       <<MPEIV>>27940000
       << REGION SIZE >>                                       <<RGHDR>>27942000
       SSEA( DCOREADDR+DOUBLE(HL+RBTOPTRSDISP), USEDRSIZE);    <<RGHDR>>27944000
       << ASSIGNED/FROZEN >>                                   <<RGHDR>>27946000
       SSEA( DCOREADDR+DOUBLE(HL+RBTOPTRASDISP), TEMP);        <<RGHDR>>27948000
       << SUBSIZE >>                                           <<RGHDR>>27950000
       SSEA( DCOREADDR+DOUBLE(HL+RBTOPTSSDISP), USEDRSIZE);    <<RGHDR>>27952000
       END;                                                    <<MPEIV>>27954000
     COREADDR := COREADDR + HEADERLENGTH;                      <<MPEIV>>27956000
     << POINT TO 1ST WORD OF AVAILABLE REGION >>               <<MPEIV>>27958000
     IF FIRSTMEMBASE = 0 THEN                                  <<MPEIV>>27960000
       BEGIN  << SAVE 1ST FREE REGION ADDRESS IN SYSGLOB >>    <<MPEIV>>27962000
       FIRSTMEMBANK := BANK;                                   <<MPEIV>>27964000
       FIRSTMEMBASE := COREADDR;                               <<MPEIV>>27966000
       END;                                                    <<MPEIV>>27968000
     INITHEADERS(DCOREADDR, RSIZE);                            <<MPEIV>>27970000
      PUTONARL(DCOREADDR,RSIZE,FALSE);                         <<jb.dc>>27972000
     END;                                                      <<MPEIV>>27974000
   END                                                         <<MPEIV>>27976000
UNTIL (BANK := BANK+1) > LASTFULLBANK;                         <<MPEIV>>27978000
                                                               <<MPEIV>>27980000
<<>>                                                           <<MPEIV>>27982000
<< LINK IN THE LAST PARTIAL BANK >>                            <<MPEIV>>27984000
<<>>                                                           <<MPEIV>>27986000
                                                               <<MPEIV>>27988000
IF LASTFULLBANK <> LOGICAL(LASTBANK) THEN                      <<MPEIV>>27990000
   BEGIN                                                       <<MPEIV>>27992000
   RSIZE := (LASTBASE+1)&LSR(PAGEPOWER);                       <<MPEIV>>27994000
   BANK := LASTBANK;                                           <<MPEIV>>27996000
   COREADDR := HEADERLENGTH;                                   <<MPEIV>>27998000
   INITHEADERS(DCOREADDR, RSIZE);                              <<MPEIV>>28000000
   PUTONARL(DCOREADDR,RSIZE,FALSE);                            <<jb.dc>>28002000
   END;                                                        <<MPEIV>>28004000
END;  <<INITMEMORYLISTS>>                                      <<MPEIV>>28006000
$CONTROL SEGMENT=FILEIO                                                 28008000
          <<-----------------------------------------                   28010000
            CHECK FOR SYSTEM-INITIAL MEMORY OVERLAP                     28012000
          ----------------------------------------->>                   28014000
  PROCEDURE CHECKMEM;                                                   28016000
    COMMENT                                                             28018000
      CHECKS THAT THE SYSTEM BEING BUILT IN LOW CORE DOES NOT OVERLAP   28020000
    WITH INITIAL'S STACK OR THE CST AND SIO PROGRAM BUFFER WHICH MAY    28022000
    BE AT THE UPPER END OF BANK 0;                                      28024000
      BEGIN                                                             28026000
          IF ADDRESS(0) = %177777 THEN ERRMESSAGE(M374,5);     <<32BND>>28028000
          PUSH(DL,DB);                                                  28030000
          ASSEMBLE(XCH);  <<DBBANK ON TOS>>                             28032000
          IF TOS<>0 THEN                                                28034000
            BEGIN  <<INITIAL'S STACK NOT IN BANK 0>>                    28036000
              DDEL;                                                     28038000
              TOS := HCLIMIT;                                  <<03603>>28040000
            END                                                         28042000
          ELSE ASSEMBLE(ADD);  <<ABSOLUTE DL VALUE>>                    28044000
          IF TOS < ADDRESS(0) THEN ERRMESSAGE(M351);           <<32BND>>28046000
                 <<OUT OF CORE RESIDENT MEMORY>>                        28048000
      END <<CHECKMEM>> ;                                                28050000
                                                               <<s8941>>28052000
$CONTROL SEGMENT=RESIDENT                                      <<s8941>>28054000
                                                               <<s8941>>28056000
         <<----------------------------->>                     <<32BND>>28058000
         <<   INSERT SEGMENT INTO DST   >>                     <<32BND>>28060000
         <<----------------------------->>                     <<32BND>>28062000
                                                               <<32BND>>28064000
PROCEDURE INSERTDST(MEMADR,DSTN,SEGSIZE,MAXSIZE);              <<32BND>>28066000
   VALUE MEMADR,DSTN,SEGSIZE,MAXSIZE;                          <<32BND>>28068000
   DOUBLE MEMADR;        << MEMORY ADDRESS >>                  <<32BND>>28070000
   INTEGER DSTN,         << DATA SEGMENT NUMBER >>             <<32BND>>28072000
           SEGSIZE,      << SEGMENT SIZE >>                    <<32BND>>28074000
           MAXSIZE;      << =0  -NOT IN LINKED MEMORY>>        <<32BND>>28076000
                         << =-1 -USE SEGSIZE FOR MAXIMUM SIZE>><<32BND>>28078000
                         << >0  -MAXIMUM SIZE OF SEGMENT>>     <<32BND>>28080000
    COMMENT                                                    <<32BND>>28082000
      INSERTS A DST DESCRIPTOR INTO THE DST TABLE. IF MAXSIZE  <<32BND>>28084000
    = 0 THEN DO NOT GET OVERLAY SPACE AND SET THE CORE RESIDENT<<32BND>>28086000
    BIT.  IF THE SEGMENT IS TO BE ABSENT, THE CORE RESIDENT BIT<<32BND>>28088000
    BE CLEARED BY PROCEDURE ABSENT.                            <<32BND>>28090000
;                                                              <<32BND>>28092000
BEGIN                                                          <<32BND>>28094000
   INTEGER                                                     <<32BND>>28096000
      BANK      = MEMADR,                                      <<32BND>>28098000
      ADDRESS   = MEMADR+1;                                    <<32BND>>28100000
                                                               <<32BND>>28102000
   DST(DSTN&LSL(2)) := (SEGSIZE+3)&LSR(2);                     <<32BND>>28104000
   TOS:=DST(X:=X+1);                                           <<32BND>>28106000
   TOS.SYSTEMFLAG:=1;                                          <<32BND>>28108000
   IF MAXSIZE=0 THEN TOS.SEGRESIDENTFLAG:=1;                   <<32BND>>28110000
   DST(X):=TOS;                                                <<32BND>>28112000
   DST(X:=X+1) := BANK;                                        <<32BND>>28114000
   DST(X:=X+1) := ADDRESS;                                     <<32BND>>28116000
END << INSERTDST >> ;                                          <<32BND>>28118000
                                                               <<s8941>>28120000
$CONTROL SEGMENT=FILEIO                                        <<s8941>>28122000
                                                               <<s8941>>28124000
   <<-------------------------------------->>                           28126000
   <<   INSERT ABSENT SEGMENT INTO DST     >>                           28128000
   <<-------------------------------------->>                           28130000
                                                                        28132000
PROCEDURE INSERT'ABSENT'DST(DISCADR,DSTN,SEGSIZE,MAXSIZE);              28134000
   VALUE DISCADR,DSTN,SEGSIZE,MAXSIZE;                                  28136000
   DOUBLE DISCADR;      <<DISC ADDRESS>>                                28138000
   INTEGER DSTN,        <<DST NUMBER>>                                  28140000
           SEGSIZE,     <<SEGMENT SIZE>>                                28142000
           MAXSIZE;     << = -1 USE SEGSIZE FOR MAXIMUM SIZE>>          28144000
                        << = >0 MAXIMUM SIZE OF SEGMENT >>              28146000
                                                                        28148000
COMMENT                                                                 28150000
   MAKES A DST ENTRY FOR A DATA SEGMENT IN VIRTUAL MEMORY.  THE         28152000
   DATA SEGMENT IS ASSUMED TO BE IN THE SYSTEM DISC'S VIRTUAL           28154000
   MEMORY;                                                              28156000
                                                                        28158000
BEGIN                                                                   28160000
   INTEGER WORDSPERVMPAGE;                                              28162000
   INTEGER DISCADR1 = DISCADR,                                          28164000
           DISCADR2 = DISCADR+1;                                        28166000
   DEFINE ABSENTFLAG = (0:1)#;                                          28168000
                                                                        28170000
   WORDSPERVMPAGE := VMPAGESIZE;                                        28172000
   DST(DSTN&LSL(2)) := (SEGSIZE+3)&LSR(2);                              28174000
   DST(X).ABSENTFLAG := 1;                                              28176000
   IF MAXSIZE = -1 THEN MAXSIZE := SEGSIZE;                             28178000
   TOS := (MAXSIZE-1)/WORDSPERVMPAGE + 1;   <<GET VM PAGES >>           28180000
   TOS.SYSTEMFLAG := 1;                                                 28182000
   TOS.DISCCOPYVALIDFLAG := 1;                                          28184000
   DST(X:=X+1) := TOS;                                                  28186000
   DST(X:=X+1) := DISCADR1 CAT SYSDISC(0:8:8);                          28188000
   DST(X+1) := DISCADR2;                                                28190000
END;  <<INSERT'ABSENT'DST>>                                             28192000
                                                               <<s8941>>28194000
$CONTROL SEGMENT=RESIDENT                                      <<s8941>>28196000
                                                               <<s8941>>28198000
DOUBLE PROCEDURE INITTABLE(NRENTRIES, ENTRYSIZE, WHERE, B32,   <<32BND>>28200000
                             DSTN, SYSIX);                     <<32BND>>28202000
   VALUE NRENTRIES,ENTRYSIZE,WHERE,B32,DSTN,SYSIX;             <<32BND>>28204000
   INTEGER NRENTRIES, ENTRYSIZE, WHERE, DSTN, SYSIX;           <<32BND>>28206000
   LOGICAL B32;                                                <<32BND>>28208000
   OPTION VARIABLE;                                            <<32BND>>28210000
BEGIN  COMMENT                                                 <<32BND>>28212000
                                                               <<32BND>>28214000
      WHERE                                                    <<32BND>>28216000
        0    - ANYWHERE                                        <<32BND>>28218000
        1    - BANK 0 ONLY                                     <<32BND>>28220000
        2    - BANK 0 ABOVE SYSGLOB                            <<32BND>>28222000
        3    - NOT BANK 0                                      <<32BND>>28224000
        4    - TEMPORARY STORAGE                               <<32BND>>28226000
      B32                                                      <<32BND>>28228000
        ALIGN ON A 32 WORD BOUNDARY                            <<32BND>>28230000
                                                               <<32BND>>28232000
COMMENT:  EACH CELL OF THE ARRAY ADDRESS POINTS TO THE FIRST   <<32BND>>28234000
AVAILABLE WORD IN ITS ASSOCIATED BANK.  THUS, THE MEMORY       <<32BND>>28236000
ADDRESSES THAT ARE LESS THAN ADDRESS(BANK#) ARE IN USE  AND    <<32BND>>28238000
THE HIGHER ONES ARE FREE.  NOTE THAT ADDRESS(BANK#) IS THE     <<32BND>>28240000
AMOUNT OF THE BANK IN USE WHILE -ADDRESS(BANK#) IS THE         <<32BND>>28242000
AMOUNT OF FREE SPACE IN THAT BANK.                             <<32BND>>28244000
;                                                              <<32BND>>28246000
                                                               <<32BND>>28248000
   DOUBLE  CUR'DL,                                             <<32BND>>28250000
           MEMADR = INITTABLE;                                 <<32BND>>28252000
   INTEGER LOWLIMIT,                                           <<32BND>>28254000
           HIGHLIMIT;                                          <<32BND>>28256000
   LOGICAL DONE,                                               <<32BND>>28258000
           I,                                                  <<32BND>>28260000
           CUR'DL1  = CUR'DL,                                  <<32BND>>28262000
           CUR'DL2  = CUR'DL+1,                                <<32BND>>28264000
           BANK     = INITTABLE,                               <<32BND>>28266000
           COREADDR = INITTABLE+1,                             <<32BND>>28268000
           LCLIMIT,                                            <<32BND>>28270000
           VAR  = Q-4;                                         <<32BND>>28272000
   DEFINE TEMPORARY = (WHERE=4)#;                              <<32BND>>28274000
                                                               <<32BND>>28276000
   IF VAR.(14:1) THEN  << DSTN SPECIFIED >>                    <<32BND>>28278000
      IF TESTBIT(BK1DSEG,DSTN) THEN WHERE := 3;                <<32BND>>28280000
                                                               <<32BND>>28282000
   TABSIZE := ((NRENTRIES*ENTRYSIZE+3)&LSR(2))&LSL(2);         <<32BND>>28284000
   LOWLIMIT := IF WHERE = 3 THEN 1 ELSE 0;                     <<32BND>>28286000
   HIGHLIMIT := IF WHERE = 1 OR WHERE = 2 THEN 1               <<32BND>>28288000
                                          ELSE NUM'BANKS;      <<32BND>>28290000
   LCLIMIT := IF STARFISH THEN %764 ELSE SYSBASE;              <<32BND>>28292000
                                                               <<32BND>>28294000
   DONE := FALSE;                                              <<32BND>>28296000
                                                               <<32BND>>28298000
   IF NOT ( 2 <= WHERE <= 3 ) THEN                             <<32BND>>28300000
      BEGIN  << SEARCH AREA BETWEEN 0 AND SYSBASE >>           <<32BND>>28302000
      BANK := 0;                                               <<32BND>>28304000
      COREADDR := IF B32 THEN (LCMEMLOC+31)/32*32 ELSE         <<32BND>>28306000
         LCMEMLOC;                                             <<32BND>>28308000
      IF COREADDR+TABSIZE <= LCLIMIT THEN                      <<32BND>>28310000
         BEGIN                                                 <<32BND>>28312000
         IF NOT TEMPORARY THEN                                 <<32BND>>28314000
            LCMEMLOC := COREADDR + TABSIZE;                    <<32BND>>28316000
         DONE := TRUE;                                         <<32BND>>28318000
         END;                                                  <<32BND>>28320000
      END;                                                     <<32BND>>28322000
                                                               <<32BND>>28324000
   I := LOWLIMIT;                                              <<32BND>>28326000
   WHILE (I <> LOGICAL(HIGHLIMIT)) AND NOT DONE DO             <<32BND>>28328000
      BEGIN                                                    <<32BND>>28330000
      BANK := I;                                               <<32BND>>28332000
      COREADDR := IF B32 THEN (ADDRESS(BANK)+31)/32*32         <<32BND>>28334000
         ELSE ADDRESS(BANK);                                   <<32BND>>28336000
      IF TABSIZE <= -(COREADDR+5) THEN                         <<LARGE>>28338000
         BEGIN                 <<^INSURE 3 WDS FOR TRAILER>>   <<32BND>>28340000
         << COMPUTE ABSOLUTE DL ADDRESS >>                     <<32BND>>28342000
         PUSH(DL,DB);                                          <<32BND>>28344000
         ASSEMBLE(CAB, ADD);  << ABSOLUTE DL ADDRESS >>        <<32BND>>28346000
         CUR'DL := TOS;                                        <<32BND>>28348000
         IF CUR'DL <= MEMADR+DOUBLE(TABSIZE) OR                <<s8941>>28350000
            INITIAL'MEMADR <= MEMADR+DOUBLE(TABSIZE) THEN      <<s8941>>28352000
            ERRMESSAGE(M350);  << OUT OF MEMORY >>             <<32BND>>28354000
         IF BANK=0 AND (COREADDR+TABSIZE < HCLIMIT) OR         <<32BND>>28356000
            BANK <> 0 THEN                                     <<32BND>>28358000
            BEGIN                                              <<32BND>>28360000
            DONE := TRUE;                                      <<32BND>>28362000
            IF NOT TEMPORARY THEN                              <<32BND>>28364000
               ADDRESS(BANK) := COREADDR + TABSIZE;            <<32BND>>28366000
            END;                                               <<32BND>>28368000
         END;                                                  <<32BND>>28370000
      I := I+1;                                                <<32BND>>28372000
      END;                                                     <<32BND>>28374000
                                                               <<32BND>>28376000
   IF NOT DONE THEN ERRMESSAGE(M350);  << OUT OF MEMORY >>     <<32BND>>28378000
                                                               <<32BND>>28380000
   << ZERO MEMORY SPACE >>                                     <<32BND>>28382000
   TOS := MEMADR;  << STARTING ADDRESS >>                      <<32BND>>28384000
   TOS := 0;                                                   <<32BND>>28386000
   ASSEMBLE(SSEA; INCA,DDUP; DECA);                            <<32BND>>28388000
   TOS := TABSIZE-1;                                           <<32BND>>28390000
   ASSEMBLE(MABS 5);                                           <<32BND>>28392000
                                                               <<32BND>>28394000
   IF VAR.(15:1) THEN ABS(SYSIX) := BUILDSYSPTR(MEMADR);       <<32BND>>28396000
   IF VAR.(14:1) THEN INSERTDST(MEMADR,DSTN,TABSIZE,0);        <<32BND>>28398000
   IF LOGICALMAPPING AND (WHERE=1 OR WHERE=2) THEN             <<depen>>28400000
      BEGIN                                                    <<depen>>28402000
      TOS := HCLIMIT;                                          <<depen>>28404000
      ASSEMBLE(NEG);                                           <<depen>>28406000
      BANK0 := ADDRESS(BANK) + TOS;                            <<depen>>28408000
      END                                                      <<depen>>28410000
   ELSE                                                        <<depen>>28412000
      IF (NOT LOGICALMAPPING) AND (WHERE=1 OR WHERE=2          <<depen>>28414000
         OR VAR.(15:1)) THEN                                   <<depen>>28416000
         BEGIN                                                 <<depen>>28418000
         TOS := HCLIMIT;                                       <<depen>>28420000
         ASSEMBLE(NEG);                                        <<depen>>28422000
         BANK0 := ADDRESS(BANK) + TOS;                         <<depen>>28424000
         END;                                                  <<depen>>28426000
END;  << INITTABLE >>                                          <<depen>>28428000
                                                               <<s8941>>28430000
$CONTROL SEGMENT=FILEIO                                        <<s8941>>28432000
                                                               <<s8941>>28434000
          <<-------------------------->>                       <<32BND>>28436000
          <<   INITIALIZE FREE LIST   >>                       <<32BND>>28438000
          <<-------------------------->>                       <<32BND>>28440000
                                                               <<32BND>>28442000
PROCEDURE INITFREELIST(MEMADR,NRENTRIES,ENTRYSIZE,FIRSTENTRY); <<32BND>>28444000
   VALUE MEMADR, NRENTRIES, ENTRYSIZE, FIRSTENTRY;             <<32BND>>28446000
   DOUBLE MEMADR;                                              <<32BND>>28448000
   INTEGER NRENTRIES, ENTRYSIZE, FIRSTENTRY;                   <<32BND>>28450000
   COMMENT                                                     <<32BND>>28452000
     INITIALIZE FREE LIST FOR TABLE BEGINNING                  <<32BND>>28454000
       AT ENTRY FIRSTENTRY;                                    <<32BND>>28456000
BEGIN                                                          <<32BND>>28458000
   INTEGER ARRAY TABLE(*)=DB+0;                                <<32BND>>28460000
   INTEGER PREVENTRYINX:=0;                                    <<32BND>>28462000
                                                               <<32BND>>28464000
   TOS := MEMADR;                                              <<32BND>>28466000
   ASSEMBLE(XCHD);  <<SET DB TO TABLE>>                        <<32BND>>28468000
   TABLE := NRENTRIES-1;                                       <<32BND>>28470000
   TABLE(1) := ENTRYSIZE;                                      <<32BND>>28472000
   TABLE(2) := NRENTRIES-FIRSTENTRY;                           <<32BND>>28474000
               <<# OF UNALLOCATED ENTRIES>>                    <<32BND>>28476000
   TABLE(3) := FIRSTENTRY*ENTRYSIZE; <<PTR TO FIRST AVAILABLE>><<32BND>>28478000
   IF ENTRYSIZE >= 5 THEN                                      <<32BND>>28480000
      TABLE(4) := (NRENTRIES-1)*ENTRYSIZE;                     <<32BND>>28482000
                                                               <<32BND>>28484000
   DO BEGIN  <<INITIALIZE FREE LIST>>                          <<32BND>>28486000
      TABLE(FIRSTENTRY*ENTRYSIZE) := %100000;                  <<32BND>>28488000
      TOS := X+ENTRYSIZE;                                      <<32BND>>28490000
      TABLE(X:=X+1) := TOS; <<PTR TO NEXT ENTRY>>              <<32BND>>28492000
      IF ENTRYSIZE >= 5 THEN                                   <<32BND>>28494000
         BEGIN                                                 <<32BND>>28496000
         TABLE(X:=X+1):=PREVENTRYINX;                          <<32BND>>28498000
         X:=X-1;                                               <<32BND>>28500000
         END;                                                  <<32BND>>28502000
      PREVENTRYINX := FIRSTENTRY*ENTRYSIZE;                    <<32BND>>28504000
      END                                                      <<32BND>>28506000
   UNTIL (FIRSTENTRY:=FIRSTENTRY+1)=NRENTRIES;                 <<32BND>>28508000
                                                               <<32BND>>28510000
   TABLE(X) := 0;   <<STOPPER>>                                <<32BND>>28512000
   SET( DB );  << RESET DB TO STACK >>                         <<32BND>>28514000
END;   << INITFREELIST >>                                      <<32BND>>28516000
INTEGER PROCEDURE GETENTRY( DSTNR );                           <<*SLL*>>28518000
   VALUE DSTNR;                                                <<*SLL*>>28520000
   INTEGER DSTNR;   << DATA SEGMENT # OF TABLE >>              <<*SLL*>>28522000
BEGIN                                                          <<*SLL*>>28524000
                                                               <<*SLL*>>28526000
   <<   Retriveves the next free entry from the specified   >> <<*SLL*>>28528000
   <<   table and returns its number.  If no free entries   >> <<*SLL*>>28530000
   <<   are left, prints an error message and halts.        >> <<*SLL*>>28532000
                                                               <<*SLL*>>28534000
   INTEGER RETURNVALUE=GETENTRY;                               <<*SLL*>>28536000
   INTEGER ARRAY MESSIX(1:3)=PB :=                             <<*SLL*>>28538000
       M300,M301,M302;                                         <<*SLL*>>28540000
   INTEGER                                                     <<*SLL*>>28542000
      NRENTRES     = DB+0,                                     <<*SLL*>>28544000
      ENTSIZE      = DB+1,                                     <<*SLL*>>28546000
      NRFREE       = DB+2,                                     <<*SLL*>>28548000
      FIRSTFREE    = DB+3;                                     <<*SLL*>>28550000
   INTEGER ARRAY                                               <<*SLL*>>28552000
      TABLE(*)     = DB+0;                                     <<*SLL*>>28554000
   INTEGER                                                     <<*SLL*>>28556000
      NEWHEAD;                                                 <<*SLL*>>28558000
                                                               <<*SLL*>>28560000
   EXCHANGEDB( DSTNR ); << XCH DB TO THE BASE OF TABLE >>      <<*SLL*>>28562000
                                                               <<*SLL*>>28564000
   IF NRFREE = 0 THEN                                          <<*SLL*>>28566000
      IF DSTNR = SWAPTABDSTN THEN                              <<*SLL*>>28568000
         ERRMESSAGE( M303 )                                    <<*SLL*>>28570000
      ELSE                                                     <<*SLL*>>28572000
         ERRMESSAGE( MESSIX(DSTNR) );                          <<*SLL*>>28574000
   NRFREE := NRFREE - 1;                                       <<*SLL*>>28576000
   GETENTRY := FIRSTFREE / ENTSIZE;                            <<*SLL*>>28578000
   NEWHEAD := TABLE(FIRSTFREE+1);                              <<*SLL*>>28580000
   TABLE(FIRSTFREE+0) := 0;                                    <<*SLL*>>28582000
   TABLE(X:=X+1) := 0;                                         <<*SLL*>>28584000
   IF DSTNR = PCBDSTN THEN                                     <<*SLL*>>28586000
      PCB(FIRSTFREE+PQPTRWORDNUM) := 0;                        <<*SLL*>>28588000
   IF ENTSIZE > 4 THEN TABLE(NEWHEAD+2) := 0;                  <<*SLL*>>28590000
   FIRSTFREE := NEWHEAD;                                       <<*SLL*>>28592000
                                                               <<*SLL*>>28594000
   EXCHANGEDB( 0 ); << XCH DB BACK TO STACK >>                 <<*SLL*>>28596000
END;                                                           <<*SLL*>>28598000
            <<----------------------------------->>            <<*SLL*>>28600000
            <<    RETURN ENTRY TO FREE LIST      >>            <<*SLL*>>28602000
            <<----------------------------------->>            <<*SLL*>>28604000
                                                               <<*SLL*>>28606000
PROCEDURE RETURNENTRY( DSTNR, ENTRYNUM);                       <<*SLL*>>28608000
   VALUE DSTNR, ENTRYNUM;                                      <<*SLL*>>28610000
   INTEGER DSTNR,   << DST # OF TABLE           >>             <<*SLL*>>28612000
          ENTRYNUM; << ENTRY NUMBER TO BE FREED >>             <<*SLL*>>28614000
BEGIN                                                          <<*SLL*>>28616000
                                                               <<*SLL*>>28618000
   <<   Returns an entry allocated by GETENTRY to its   >>     <<*SLL*>>28620000
   <<   free list.  The returned entry becomes first    >>     <<*SLL*>>28622000
   <<   on the free list.                               >>     <<*SLL*>>28624000
                                                               <<*SLL*>>28626000
   INTEGER                                                     <<*SLL*>>28628000
      NRENTRES     = DB+0,                                     <<*SLL*>>28630000
      ENTSIZE      = DB+1,                                     <<*SLL*>>28632000
      NRFREE       = DB+2,                                     <<*SLL*>>28634000
      FIRSTFREE    = DB+3,                                     <<*SLL*>>28636000
      LASTFREE     = DB+4;                                     <<*SLL*>>28638000
   INTEGER ARRAY                                               <<*SLL*>>28640000
      TABLE(*)     = DB+0;                                     <<*SLL*>>28642000
   INTEGER                                                     <<*SLL*>>28644000
      OLDHEAD,                                                 <<*SLL*>>28646000
      OLDTAIL,                                                 <<*SLL*>>28648000
      ENTRYINX;                                                <<*SLL*>>28650000
                                                               <<*SLL*>>28652000
   EXCHANGEDB( DSTNR ); << SET DB TO BASE OF THE TABLE >>      <<*SLL*>>28654000
                                                               <<*SLL*>>28656000
   NRFREE := NRFREE + 1;                                       <<*SLL*>>28658000
   ENTRYINX := ENTRYNUM * ENTSIZE;                             <<*SLL*>>28660000
   IF ENTSIZE <= 4 THEN                                        <<*SLL*>>28662000
      BEGIN                                                    <<*SLL*>>28664000
      OLDHEAD := FIRSTFREE;                                    <<*SLL*>>28666000
      FIRSTFREE := ENTRYINX;                                   <<*SLL*>>28668000
      TABLE( FIRSTFREE+1) := OLDHEAD;                          <<*SLL*>>28670000
      TABLE( FIRSTFREE) := %100000; << MARK FREE >>            <<*SLL*>>28672000
      END;                                                     <<*SLL*>>28674000
                                                               <<*SLL*>>28676000
   EXCHANGEDB( 0 );  << RETURN DB TO THE STACK >>              <<*SLL*>>28678000
END;  << RETURNENTRY >>                                        <<*SLL*>>28680000
                                                               <<03004>>28682000
          <<----------------------------------->>              <<03004>>28684000
          <<        RELEASE CST ENTRY          >>              <<03004>>28686000
          <<----------------------------------->>              <<03004>>28688000
  PROCEDURE DELETECST( CSTNUM);                                <<03004>>28690000
  COMMENT                                                      <<03004>>28692000
       RELEASE A PREVIOUSLY ALLOCATED CST ENTRY;               <<03004>>28694000
  VALUE CSTNUM;                                                <<03004>>28696000
  INTEGER CSTNUM;   << PHYSICAL CST ENTRY NUMBER >>            <<03004>>28698000
     BEGIN                                                     <<03004>>28700000
     POINTER PTR;                                              <<*MAP*>>28702000
                                                               <<*MAP*>>28704000
     RETURNENTRY( CSTDSTN, CSTNUM); << RETURN TO FREE LIST >>  <<*SLL*>>28706000
     @PTR := @SEGT(SEGT(SEG'HEAD+SLTYP)+21+CSTNUM*3);          <<*MAP*>>28708000
     PTR := %177400;   << XFORM >>                             <<*MAP*>>28710000
     PTR(1) := 0;      << REF   >>                             <<*MAP*>>28712000
     PTR(2) := 0;      << PHY # >>                             <<*MAP*>>28714000
END;  << DELETECST >>                                          <<*MAP*>>28716000
          <<-------------------------                                   28718000
            INSERT SEGMENT INTO CST                                     28720000
          ------------------------->>                                   28722000
  PROCEDURE INSERTCST(CSTN,DISCADR,SEGSIZE,LINKED,SYSTEM);     <<03603>>28724000
    VALUE CSTN,DISCADR,SEGSIZE,LINKED,SYSTEM;                  <<03603>>28726000
    INTEGER CSTN,         <<SEGMENT #>>                                 28728000
            SEGSIZE;      <<SEGMENT SIZE AND FLAGS>>                    28730000
    DOUBLE DISCADR;       <<LDEV , DISC ADDRESS>>              <<03603>>28732000
    LOGICAL LINKED,       <<0=CORE RESIDENT,1=LINKED MEM,2=ABSENT>>     28734000
            SYSTEM;       <<SEGMENT BELONGS TO SYSTEM>>                 28736000
    COMMENT                                                             28738000
      ADDS AN ENTRY TO THE CST TABLE.  IF THE SEGMENT IS IN             28740000
    LINKED MENORY, CALLS FIXLINK TO PUT INFORMATION IN LINK;   <<00652>>28742000
      BEGIN                                                             28744000
        INTEGER DISCADR1=DISCADR, DISCADR2=DISCADR+1;                   28746000
          TOS := SEGSIZE.(2:14)&LSR(2);                                 28748000
          IF SEGSIZE<0 THEN ASSEMBLE(TSBC 1);  <<PRIV MODE>>            28750000
          IF LINKED=2 THEN ASSEMBLE(TSBC 0); <<ABSENT>>        <<00652>>28752000
        IF CSTN.(2:1) <> 0 THEN                                <<00652>>28754000
          BEGIN                 <<CSTX ENTRY>>                 <<00652>>28756000
            X:=CSTBLK(CSTN.(3:7))+CSTN.(10:6)&LSL(2)           <<00652>>28758000
               -ABSOLUTE(DFC);                                 <<00652>>28760000
            CST(X):=TOS;                                       <<00652>>28762000
          END ELSE                                             <<00652>>28764000
          BEGIN                 <<SHARABLE CST ENTRY>>         <<00652>>28766000
            CST(CSTN&LSL(2)):=TOS;                             <<00652>>28768000
          END;                                                 <<00652>>28770000
          TOS:=0;                                              <<MPEIV>>28772000
          IF LINKED=0 THEN                                     <<MPEIV>>28774000
             BEGIN <<SEG IS CORE RESIDENT>>                    <<MPEIV>>28776000
             TOS.SEGRESIDENTFLAG:=1;                           <<MPEIV>>28778000
             END;                                              <<MPEIV>>28780000
          TOS.SYSTEMFLAG := SYSTEM;                            <<01862>>28782000
          CST(X:=X+1):=TOS;                                    <<MPEIV>>28784000
          CST(X:=X+1) := DISCADR1;                             <<03603>>28786000
                                                               <<MPEIV>>28788000
          CST(X:=X+1) := DISCADR2;                                      28790000
      END <<INSERTCST>> ;                                               28792000
$INCLUDE INCLVMC                                               <<MPEIV>>28794000
                                                               <<32BND>>28796000
          <<----------------------------------->>              <<32BND>>28798000
          <<   MAKE DATA SEGMENT NON-PRESENT   >>              <<32BND>>28800000
          <<----------------------------------->>              <<32BND>>28802000
                                                               <<32BND>>28804000
PROCEDURE ABSENT(DSTN, MAXSIZE, DISCADR);                      <<32BND>>28806000
   VALUE DSTN, MAXSIZE, DISCADR;                               <<32BND>>28808000
   INTEGER DSTN,      <<DST NUMBER>>                           <<32BND>>28810000
           MAXSIZE;   <<IF -1, USE SEGMENT SIZE, OTHERWISE >>  <<32BND>>28812000
   DOUBLE             << MAXIMUM SEGMENT SIZE>>                <<32BND>>28814000
      DISCADR;                                                 <<32BND>>28816000
   OPTION VARIABLE;                                            <<32BND>>28818000
   COMMENT                                                     <<32BND>>28820000
     WRITES THE SPECIFIED DATA SEGMENT TO VIRTUAL MEMORY       <<32BND>>28822000
     AND UPDATES THE DST TO REFLECT THIS;                      <<32BND>>28824000
BEGIN                                                          <<32BND>>28826000
   LOGICAL                                                     <<32BND>>28828000
      MASK = Q-4;                                              <<32BND>>28830000
   DOUBLE                                                      <<32BND>>28832000
      MEMADR;                                                  <<32BND>>28834000
   INTEGER                                                     <<32BND>>28836000
      MEMADR1       = MEMADR,                                  <<32BND>>28838000
      MEMADR2       = MEMADR+1,                                <<32BND>>28840000
      DISCADR1      = DISCADR,                                 <<32BND>>28842000
      DISCADR2      = DISCADR+1,                               <<32BND>>28844000
      SIZE,                                                    <<32BND>>28846000
      INX;                                                     <<32BND>>28848000
                                                               <<32BND>>28850000
   INX := DSTN * 4;                                            <<32BND>>28852000
   SIZE := (DST(INX).(3:13) +1) *4;                            <<ABSNT>>28854000
   IF NOT MASK THEN << DISCADR NOT SUPPLIED - GET SOME VM >>   <<32BND>>28856000
      DISCADR := GETSWAPREGION( DSTN, IF MAXSIZE = -1 THEN     <<32BND>>28858000
         SIZE ELSE MAXSIZE, SYSDISC);                          <<32BND>>28860000
   IF DISCADR = 0D THEN ERRMESSAGE( M330, SYSDISC);            <<32BND>>28862000
   << OUT OF VIRTUAL MEMORY ON LDEV #1 >>                      <<32BND>>28864000
   DST( INX).(0:3) := 4;     << SET ABSENT BIT >>              <<JMAT*>>28866000
   DST( INX+1).DISCCOPYVALIDFLAG := 1;                         <<32BND>>28868000
   DST( INX+1).SYSTEMFLAG := 1;                                <<32BND>>28870000
   DST( INX+1).SEGRESIDENTFLAG := 0; << SET IN INSERTDST >>    <<32BND>>28872000
   MEMADR1 := DST( INX+2);                                     <<32BND>>28874000
   MEMADR2 := DST( INX+3);                                     <<32BND>>28876000
   DST( INX+2) := DISCADR1 CAT SYSDISC (0:8:8);                <<32BND>>28878000
   DST( INX+3) := DISCADR2;                                    <<32BND>>28880000
   DISC'( WRITE, SYSDISC, DISCADR, MEMADR, SIZE);              <<32BND>>28882000
END;    << ABSENT >>                                           <<32BND>>28884000
          <<----------------------------->>                    <<*SLL*>>28886000
          <<   INITIALIZE SYSTEM TABLE   >>                    <<*SLL*>>28888000
          <<----------------------------->>                    <<*SLL*>>28890000
                                                               <<*SLL*>>28892000
PROCEDURE INITSYSTABLE(NRENTRIES,NRPRIMARY,ENTRYSIZE,DSTN,     <<*SLL*>>28894000
      SYSIX);                                                  <<*SLL*>>28896000
   VALUE NRENTRIES, NRPRIMARY, ENTRYSIZE, DSTN, SYSIX;         <<*SLL*>>28898000
   INTEGER NRENTRIES, NRPRIMARY, ENTRYSIZE, DSTN, SYSIX;       <<*SLL*>>28900000
BEGIN                                                          <<*SLL*>>28902000
   <<                                                 >>       <<*SLL*>>28904000
   <<   ALLOCATE MEMORY AND INITIALIZE SYSTEM TABLE   >>       <<*SLL*>>28906000
   <<                                                 >>       <<*SLL*>>28908000
   EQUATE SYSTABOVERHEAD = 15; << HEADER SIZE IN WORDS >>      <<*SLL*>>28910000
   INTEGER ARRAY TABLE(*)=DB+0;                                <<*SLL*>>28912000
   INTEGER PREVENTRYINX:=0;                                    <<*SLL*>>28914000
   INTEGER TOTENTRIES;                                         <<*SLL*>>28916000
   INTEGER FIRSTENTRY;                                         <<*SLL*>>28918000
   INTEGER INX;                                                <<*SLL*>>28920000
                                                               <<*SLL*>>28922000
   FIRSTENTRY := (SYSTABOVERHEAD+ENTRYSIZE-1)/ENTRYSIZE;       <<*SLL*>>28924000
   TOTENTRIES := NRENTRIES + FIRSTENTRY;                       <<*SLL*>>28926000
   INITTABLE(TOTENTRIES, ENTRYSIZE, ANYWHERE'TAB, TRUE,        <<*SLL*>>28928000
      DSTN, SYSIX);                                            <<*SLL*>>28930000
                                                               <<*SLL*>>28932000
   EXCHANGEDB( DSTN );  << XCH DB TO BASE OF THE TABLE >>      <<*SLL*>>28934000
   TABLE := TOTENTRIES;                                        <<SLLHR>>28936000
   TABLE(1) := ENTRYSIZE;                                      <<*SLL*>>28938000
   TABLE(2) := NRENTRIES; <<# OF UNALLOCATED ENTRIES>>         <<*SLL*>>28940000
   TABLE(3) := FIRSTENTRY * ENTRYSIZE; <<PTR TO FIRST AVAIL>>  <<*SLL*>>28942000
   TABLE(4) := (TOTENTRIES-1) * ENTRYSIZE;                     <<*SLL*>>28944000
   TABLE(6) := NRPRIMARY;                                      <<*SLL*>>28946000
                                                               <<*SLL*>>28948000
   DO BEGIN  <<INITIALIZE FREE LIST>>                          <<*SLL*>>28950000
      INX := FIRSTENTRY * ENTRYSIZE;                           <<*SLL*>>28952000
      TABLE(INX) := %100000;                                   <<*SLL*>>28954000
      TABLE(INX+1) := INX+ENTRYSIZE; <<PTR TO NEXT ENTRY>>     <<*SLL*>>28956000
      IF ENTRYSIZE >= 5 THEN                                   <<*SLL*>>28958000
         TABLE(INX+2) := PREVENTRYINX;                         <<*SLL*>>28960000
      IF DSTN = PCBDSTN THEN                                   <<*SLL*>>28962000
         TABLE(INX+PQPTRWORDNUM) := -1;                        <<*SLL*>>28964000
      PREVENTRYINX := INX;                                     <<*SLL*>>28966000
      END                                                      <<*SLL*>>28968000
   UNTIL (FIRSTENTRY:=FIRSTENTRY+1) = TOTENTRIES;              <<*SLL*>>28970000
                                                               <<*SLL*>>28972000
   TABLE(INX+1) := 0;   << STOPPER >>                          <<*SLL*>>28974000
                                                               <<*SLL*>>28976000
   EXCHANGEDB( 0 ); << RETURN DB TO THE STACK >>               <<*SLL*>>28978000
END;   << INITFREELIST >>                                      <<*SLL*>>28980000
          <<--------------------------------->>                <<PORTS>>28982000
          << INITIALIZE INCORE MESSAGE TABLE >>                <<PORTS>>28984000
          <<--------------------------------->>                <<PORTS>>28986000
                                                               <<PORTS>>28988000
<< *********** FIX FOR RUNNING OFF END OF DST. 10/17/83 ****>> <<P7831>>28990000
PROCEDURE INIT'MESSAGE'SYSTEM;                                 <<PORTS>>28992000
  BEGIN                                                        <<PORTS>>28994000
  INTEGER PRISIZE,                                             <<PORTS>>28996000
          MINPRISIZE,                                          <<PORTS>>28998000
          SECSIZE,                                             <<PORTS>>29000000
          MINSECSIZE,                                          <<PORTS>>29002000
          NUMPORTS,                                            <<PORTS>>29004000
          TOTALSIZE;                                           <<PORTS>>29006000
  INTEGER POINTER MSG;                                         <<PORTS>>29008000
  DOUBLE DADDR,                                                <<PORTS>>29010000
         SAVEDADDR;                                            <<PORTS>>29012000
  INTEGER BANK = DADDR,                                        <<PORTS>>29014000
          COREADDR = DADDR +1;                                 <<PORTS>>29016000
                                                               <<PORTS>>29018000
  EQUATE MSGHARBHEADERSIZE = 13,                               <<PORTS>>29020000
         MSGHARBORLENGTH = 16,  << FOUR SUBQUEUES >>           <<PORTS>>29022000
         MSGTABSIZE = 6;  << LINK, LENGTH, 4 WORDS DATA >>     <<PORTS>>29024000
                                                               <<PORTS>>29026000
  << PORT DST HEADER STRUCTURE >>                              <<PORTS>>29028000
  INTEGER PORTDSTNUM = DB +0;                                  <<PORTS>>29030000
  INTEGER PORTDSTSIZE = DB +1;                                 <<PORTS>>29032000
  INTEGER POINTER USERREGIONPOINTER = DB +2;                   <<PORTS>>29034000
  INTEGER PORTDSTNUMPORTS = DB +3;                             <<PORTS>>29036000
  INTEGER PORTDSTMAXMSGSIZE = DB +4;                           <<PORTS>>29038000
  INTEGER PORTDSTMAXCONTEXTSIZE = DB +5;                       <<PORTS>>29040000
  INTEGER POINTER MSGPOOLHEAD = DB +6,                         <<PORTS>>29042000
                  MSGPOOLTAIL = DB +7;                         <<PORTS>>29044000
  INTEGER POOLCNT = DB +8;                                     <<PORTS>>29046000
  INTEGER PROCHEAD = DB +9,                                    <<PORTS>>29048000
          PROCTAIL = DB +10;                                   <<PORTS>>29050000
  INTEGER POINTER TIMEHEAD = DB +11;                           <<PORTS>>29052000
  INTEGER TIMETRLX = DB +12;                                   <<PORTS>>29054000
  EQUATE PORTDSTHEADERSIZE = 13;                               <<PORTS>>29056000
                                                               <<PORTS>>29058000
  NUMPORTS := CTAB(PCBNUM) +1;  << DISPATCHER USES ONE >>      <<PORTS>>29060000
  PRISIZE := CTAB(PRIMARYMSGTABLE);                            <<PORTS>>29062000
  << MUST RESERVE AN ENTRY FOR 50% OF NUM PORTS >>             <<PORTS>>29064000
  MINPRISIZE := (NUMPORTS +1)&LSR(1);                          <<PORTS>>29066000
  IF PRISIZE < MINPRISIZE THEN                                 <<PORTS>>29068000
    PRISIZE := MINPRISIZE;                                     <<PORTS>>29070000
  IF PRISIZE > 1023 THEN                                       <<PORTS>>29072000
    PRISIZE := 1023;                                           <<PORTS>>29074000
                                                               <<PORTS>>29076000
  SECSIZE := CTAB(SECNDRYMSGTABLE);                            <<PORTS>>29078000
  << MUST HAVE AN ENRTY FOR 12% OF THE PINS >>                 <<PORTS>>29080000
  MINSECSIZE := (NUMPORTS +7)&LSR(3);                          <<PORTS>>29082000
  IF SECSIZE < MINSECSIZE THEN                                 <<PORTS>>29084000
    SECSIZE := MINSECSIZE;                                     <<PORTS>>29086000
  IF SECSIZE > 1023 THEN                                       <<PORTS>>29088000
    SECSIZE := 1023;                                           <<PORTS>>29090000
                                                               <<PORTS>>29092000
  TOTALSIZE := MSGHARBHEADERSIZE +  << FIXED OVERHEAD >>       <<PORTS>>29094000
               NUMPORTS*MSGHARBORLENGTH +                      <<PORTS>>29096000
               (PRISIZE + SECSIZE)*MSGTABSIZE;                 <<PORTS>>29098000
                                                               <<PORTS>>29100000
  DADDR := INITTABLE( TOTALSIZE, 1, 0<<ANYWHERE>>,             <<PORTS>>29102000
                       FALSE, MSGHARBORTABDSTN);               <<PORTS>>29104000
                                                               <<PORTS>>29106000
  TOS := DADDR;                                                <<PORTS>>29108000
  ASSEMBLE( XCHD );                                            <<PORTS>>29110000
  SAVEDADDR := TOS;                                            <<PORTS>>29112000
                                                               <<PORTS>>29114000
  << INIT. MESSAGE TABLE HEADER >>                             <<PORTS>>29116000
  PORTDSTNUM := MSGHARBORTABDSTN;                              <<PORTS>>29118000
  PORTDSTSIZE := TOTALSIZE;                                    <<PORTS>>29120000
  @USERREGIONPOINTER := TOTALSIZE;  <<CAUSE BNDS VIOL IF USED>><<PORTS>>29122000
  PORTDSTNUMPORTS := NUMPORTS;                                 <<PORTS>>29124000
  PORTDSTMAXMSGSIZE := MSGTABSIZE;                             <<PORTS>>29126000
  PORTDSTMAXCONTEXTSIZE := 0;                                  <<PORTS>>29128000
                                                               <<PORTS>>29130000
  @MSGPOOLHEAD := @MSGPOOLTAIL := 0;                           <<PORTS>>29132000
  POOLCNT := PRISIZE;                                          <<PORTS>>29134000
  PROCHEAD := PROCTAIL := 0;                                   <<PORTS>>29136000
                                                               <<PORTS>>29138000
  << INIT MSG FREE POOL >>                                     <<PORTS>>29140000
  @MSG := NUMPORTS*MSGHARBORLENGTH + MSGHARBHEADERSIZE;        <<PORTS>>29142000
  @MSGPOOLHEAD := @MSG;                                        <<PORTS>>29144000
  WHILE @MSG < PORTDSTSIZE - 2*MSGTABSIZE DO                   <<P7831>>29146000
    @MSG := MSG := @MSG + MSGTABSIZE;                          <<PORTS>>29148000
  @MSGPOOLTAIL := @MSG;                                        <<PORTS>>29150000
  MSG := 0;        << TERMINATE THE LIST >>                    <<P7831>>29152000
                                                               <<PORTS>>29154000
  << RESTORE DB >>                                             <<PORTS>>29156000
  TOS := SAVEDADDR;                                            <<PORTS>>29158000
  ASSEMBLE( XCHD;  DDEL );                                     <<PORTS>>29160000
                                                               <<PORTS>>29162000
  END;  << INIT'MESSAGE'SYSTEM >>                              <<PORTS>>29164000
                                                               <<PORTS>>29166000
          <<-------------------------->>                       <<PORTS>>29168000
          << IOWAIT PORT VECTOR TABLE >>                       <<PORTS>>29170000
          <<-------------------------->>                       <<PORTS>>29172000
                                                               <<PORTS>>29174000
PROCEDURE INIT'IOWAIT'VECTOR'TABLE;                            <<PORTS>>29176000
  BEGIN                                                        <<PORTS>>29178000
  DOUBLE DADDR;                                                <<PORTS>>29180000
  INTEGER BANK = DADDR,                                        <<PORTS>>29182000
          COREADDR = DADDR +1;                                 <<PORTS>>29184000
  INTEGER I;                                                   <<PORTS>>29186000
                                                               <<PORTS>>29188000
  EQUATE INITPORTVECTORSIZE=1024,                              <<PORTS>>29190000
         ENTRYSIZE = 2,                                        <<P7831>>29192000
         MAXPORTVECTORSIZE=4096;                               <<PORTS>>29194000
                                                               <<PORTS>>29196000
  DADDR := INITTABLE( INITPORTVECTORSIZE, 1, 0,<< ANYWHERE >>  <<PORTS>>29198000
                      FALSE, PORTVECTORDSTN );                 <<PORTS>>29200000
                                                               <<PORTS>>29202000
  SSEA(DADDR+1D,MAXPORTVECTORSIZE);  <<MAXSIZE>>               <<PORTS>>29204000
  << INIT FREE ENTRY LINKED LIST >>                            <<PORTS>>29206000
  SSEA(DADDR+2D,8);   <<@HEADPTR>>                             <<PORTS>>29208000
  I := 6;        << RESERVE AN EIGHT WORD DST OVERHEAD AREA >> <<PORTS>>29210000
  WHILE (I := I+ENTRYSIZE) < INITPORTVECTORSIZE-2*ENTRYSIZE DO <<P7831>>29212000
    SSEA(DADDR+DOUBLE(I),I+ENTRYSIZE);                         <<P7831>>29214000
  SSEA(DADDR+DOUBLE(I),0);  <<TERMINATE LIST>>                 <<PORTS>>29216000
  SSEA(DADDR+3D,I);    <<@TAILPTR>>                            <<PORTS>>29218000
  SSEA(DADDR+0D, I + ENTRYSIZE);     <<CURRENT SIZE>>          <<P7831>>29220000
  ABSENT(PORTVECTORDSTN,MAXPORTVECTORSIZE);                    <<PORTS>>29222000
                                                               <<PORTS>>29224000
  END;  << INIT'IOWAIT'VECTOR'TABLE >>                         <<PORTS>>29226000
                                                               <<PORTS>>29228000
          <<--------------------------------->>                <<PORTS>>29230000
          << PORT PROCEDURE DICTIONARY TABLE >>                <<PORTS>>29232000
          <<--------------------------------->>                <<PORTS>>29234000
                                                               <<PORTS>>29236000
PROCEDURE INIT'PORT'DICT'TABLE;                                <<PORTS>>29238000
  BEGIN                                                        <<PORTS>>29240000
  DOUBLE DADDR,                                                <<PORTS>>29242000
         SAVEDADDR;                                            <<PORTS>>29244000
  INTEGER BANK = DADDR,                                        <<PORTS>>29246000
          COREADDR = DADDR +1;                                 <<PORTS>>29248000
  INTEGER I;                                                   <<PORTS>>29250000
  INTEGER POINTER DICT'PTR;                                    <<PORTS>>29252000
                                                               <<PORTS>>29254000
  EQUATE INITIAL'DICT'SIZE = 4096,                             <<PORTS>>29256000
         MAX'DICT'SIZE = 16384;                                <<PORTS>>29258000
                                                               <<PORTS>>29260000
  EQUATE DICT'HEADERSIZE = 8,                                  <<PORTS>>29262000
         NUMHASH'BUCKETS = 95,  << SAME HASH FUNCTION AS USL >><<PORTS>>29264000
         DICT'ENTRY'SIZE = 16;                                 <<PORTS>>29266000
                                                               <<PORTS>>29268000
  INTEGER CURRENT'SIZE = DB +0,                                <<PORTS>>29270000
          MAX'DST'SIZE = DB +1;                                <<PORTS>>29272000
  INTEGER POINTER DICT'POOLHEAD = DB +2,                       <<PORTS>>29274000
                  DICT'POOLTAIL = DB +3;                       <<PORTS>>29276000
                                                               <<PORTS>>29278000
  DADDR := INITTABLE( INITIAL'DICT'SIZE, 1, 0, << ANYWHERE >>  <<PORTS>>29280000
                      FALSE, PORT'DICT'DSTN );                 <<PORTS>>29282000
                                                               <<PORTS>>29284000
  TOS := DADDR;                                                <<PORTS>>29286000
  ASSEMBLE( XCHD );                                            <<PORTS>>29288000
  SAVEDADDR := TOS;                                            <<PORTS>>29290000
                                                               <<PORTS>>29292000
  << INIT. DICT. TABLE HEADER >>                               <<PORTS>>29294000
  MAX'DST'SIZE := MAX'DICT'SIZE;                               <<PORTS>>29296000
                                                               <<PORTS>>29298000
  << INIT DICT'ENTRY FREE POOL >>                              <<PORTS>>29300000
  @DICT'PTR := NUMHASH'BUCKETS + DICT'HEADERSIZE;              <<PORTS>>29302000
  @DICT'POOLHEAD := @DICT'PTR;                                 <<PORTS>>29304000
  WHILE @DICT'PTR < INITIAL'DICT'SIZE - 2*DICT'ENTRY'SIZE DO   <<P7831>>29306000
    @DICT'PTR := DICT'PTR := @DICT'PTR + DICT'ENTRY'SIZE;      <<PORTS>>29308000
  @DICT'POOLTAIL := @DICT'PTR;                                 <<PORTS>>29310000
  DICT'PTR := 0;  << TERMINATE LIST >>                         <<P7831>>29312000
  CURRENT'SIZE := @DICT'PTR + DICT'ENTRY'SIZE;                 <<P7831>>29314000
                                                               <<PORTS>>29316000
  << RESTORE DB >>                                             <<PORTS>>29318000
  TOS := SAVEDADDR;                                            <<PORTS>>29320000
  ASSEMBLE( XCHD;  DDEL );                                     <<PORTS>>29322000
                                                               <<PORTS>>29324000
  ABSENT(PORT'DICT'DSTN,MAX'DICT'SIZE);                        <<PORTS>>29326000
                                                               <<PORTS>>29328000
  END;  << INIT'PORT'DICT'TABLE >>                             <<PORTS>>29330000
         <<-------------------------->>                        <<32BND>>29332000
         <<   INITIALIZE I/O TABLE   >>                        <<32BND>>29334000
         <<-------------------------->>                        <<32BND>>29336000
                                                               <<32BND>>29338000
PROCEDURE INITIOTABLE(NRENTRIES,SECONDPART,ENTRYSIZE,          <<IOTAB>>29340000
                         DSTN, SYSIX);                         <<32BND>>29342000
   VALUE NRENTRIES,SECONDPART,ENTRYSIZE,DSTN,SYSIX;            <<32BND>>29344000
   INTEGER NRENTRIES,SECONDPART,ENTRYSIZE,DSTN,SYSIX;          <<32BND>>29346000
   COMMENT                                                     <<32BND>>29348000
      INITIALIZE FREE LIST AND HEADER INFO FOR ONE OF THE      <<32BND>>29350000
    I/O TABLES. 1/SECONDPART GIVES THE PORTION OF ENTRIES TO BE<<32BND>>29352000
    PUT IN THE SECONDARY PART OF THE TABLE;                    <<32BND>>29354000
BEGIN                                                          <<32BND>>29356000
   INTEGER ARRAY TABLE(*)=DB+0;                                <<32BND>>29358000
   INTEGER NEXT;                                               <<32BND>>29360000
   INTEGER I;                                                  <<32BND>>29362000
   INTEGER HEADSIZE;                                           <<32BND>>29364000
   INTEGER PRIMARYPART;                                        <<32BND>>29366000
   DOUBLE MEMADR;                                              <<32BND>>29368000
                                                               <<32BND>>29370000
   HEADSIZE := IF DSTN = DISCREQTABDSTN THEN ENTRYSIZE         <<32BND>>29372000
      ELSE IOHEADSIZE;                                         <<32BND>>29374000
   MEMADR := INITTABLE(NRENTRIES*ENTRYSIZE+HEADSIZE, 1,        <<IOTAB>>29376000
                          ANYWHERE'TAB, TRUE, DSTN, SYSIX);    <<IOTAB>>29378000
   PRIMARYPART := IF SYSIX = SYSTBUF THEN                      <<32BND>>29380000
       NRENTRIES - (NRENTRIES / SECONDPART)                    <<IOTAB>>29382000
    <<COMPUTE # OF PRIMARY ELEMENTS>>                          <<IOTAB>>29384000
   ELSE                                                        <<32BND>>29386000
      NRENTRIES - SECONDPART; << # OF PRIMANY ELEMENTS >>      <<32BND>>29388000
                                                               <<32BND>>29390000
   TOS := MEMADR;                                              <<32BND>>29392000
   ASSEMBLE( XCHD ); << EXCHANGE DB TO TABLE >>                <<32BND>>29394000
   TABLE := NRENTRIES;                                         <<32BND>>29396000
   TABLE(1) := ENTRYSIZE;                                      <<32BND>>29398000
   TABLE(2) := PRIMARYPART;                                    <<32BND>>29400000
   TABLE(4) := IF SYSIX = SYSSBUF THEN HEADSIZE+1              <<32BND>>29402000
      ELSE HEADSIZE;                                           <<32BND>>29404000
   << INITIALIZE FREE LIST >>                                  <<32BND>>29406000
   NEXT := TABLE(4);                                           <<32BND>>29408000
   X := IF SYSIX = SYSSBUF THEN                                <<32BND>>29410000
           NEXT-1                                              <<32BND>>29412000
        ELSE                                                   <<32BND>>29414000
           IF DSTN=DISCREQTABDSTN OR SYSIX=SYSIOQ THEN         <<32BND>>29416000
              NEXT+1                                           <<32BND>>29418000
           ELSE                                                <<32BND>>29420000
              NEXT;                                            <<32BND>>29422000
   I := 0;                                                     <<32BND>>29424000
   WHILE (I:=I+1) < NRENTRIES DO                               <<32BND>>29426000
      BEGIN                                                    <<32BND>>29428000
      NEXT := NEXT + ENTRYSIZE;                                <<32BND>>29430000
      TABLE(X) := NEXT;                                        <<32BND>>29432000
      X := X + ENTRYSIZE;                                      <<IOTAB>>29434000
      END;                                                     <<32BND>>29436000
   TABLE(5) := NEXT;  << TAIL INDEX >>                         <<32BND>>29438000
                                                               <<SYPTR>>29440000
   IF DSTN=DISCREQTABDSTN OR SYSIX=SYSIOQ THEN                 <<SYPTR>>29442000
      BEGIN                                                    <<SYPTR>>29444000
      NEXT := TABLE(4);                                        <<SYPTR>>29446000
      I := 0;                                                  <<SYPTR>>29448000
      WHILE (I:=I+1) <= NRENTRIES DO                           <<SYPTR>>29450000
         BEGIN                                                 <<SYPTR>>29452000
         TABLE(NEXT+11) := %100000;                            <<SYPTR>>29454000
         NEXT := NEXT+ENTRYSIZE;                               <<SYPTR>>29456000
         END;                                                  <<SYPTR>>29458000
      END;                                                     <<SYPTR>>29460000
                                                               <<SYPTR>>29462000
   SET( DB ); << RESET DB TO STACK >>                          <<32BND>>29464000
END;  << INITIOTABLE >>                                        <<32BND>>29466000
          <<----------------------                                      29468000
            GET I/O PROCESS NAME                                        29470000
          ---------------------->>                                      29472000
  PROCEDURE GETIOPROCNAME;                                              29474000
    COMMENT                                                             29476000
      RETRIEVES THE I/O PROCESS NAME FROM THE EXTERNAL LIST OF          29478000
    THE DRIVER PROGRAM FILE;                                            29480000
      BEGIN                                                             29482000
        INTEGER EXTINDEX:=0,I,N,EXTRECORD,IOPROCSTT;                    29484000
          IF (IOPROCSTT:=OBINFO(INDEX+3).(8:8))=0 THEN                  29486000
            BEGIN  <<DEFAULT IS SYSTEM I/O PROCESS>>                    29488000
              MOVE IOPROCNAME := SYSIOPROC,(16);                        29490000
              RETURN;                                                   29492000
            END;                                                        29494000
          EXTRECORD := REC0(13);  <<EXTERNAL LIST RECORD #>>            29496000
          FREAD(DVRFNUM,D'L(EXTRECORD)),DVREXT,256);                    29498000
  NEXT:   TOS := DVREXT(EXTINDEX).(4:4);  <<# OF CHARS>>                29500000
          X := TOS&LSR(1)+EXTINDEX+1;                                   29502000
          I := 0;                                                       29504000
          N := DVREXT(X);  <<# OF EXTERNAL REFERENCES>>                 29506000
          WHILE (I:=I+1) <= N DO                                        29508000
          IF DVREXT(X:=X+1).(0:8)=IOPROCSTT THEN                        29510000
            BEGIN  <<FOUND IT>>                                         29512000
              IOPROCNAME := " ";                                        29514000
              MOVE IOPROCNAME(1) := IOPROCNAME,(15);                    29516000
              TOS := @IOPROCNAME;                                       29518000
              TOS := @DVREXT(EXTINDEX)&LSL(1);                 <<04306>>29520000
              TOS := BPS0.(12:4)+1;  <<CHARACTER COUNT>>                29522000
              ASSEMBLE(MVB);                                            29524000
              RETURN;                                                   29526000
            END;                                                        29528000
          I := DVREXT(X:=X+1).(0:2);                                    29530000
          TOS := (IF = THEN 1 ELSE IF I=3 THEN DVREXT(X).(2:6)+2 ELSE 2)29532000
            +X;                                                         29534000
          IF S0>127 THEN                                                29536000
            BEGIN  <<MUST READ ANOTHER RECORD>>                         29538000
              MOVE DVREXT := DVREXT(128),(128);                         29540000
              TOS := TOS-X;                                             29542000
              FREAD(DVRFNUM,D'L(EXTRECORD:=EXTRECORD+1)),DVREXT(128),   29544000
                128);                                                   29546000
            END;                                                        29548000
          EXTINDEX := TOS;                                              29550000
          GOTO NEXT;                                                    29552000
      END <<GETIOPROCNAME>> ;                                           29554000
                                                                        29556000
          <<-------------------------------                             29558000
            ADD ENTRY TO I/O PROCESS LIST                               29560000
          ------------------------------->>                             29562000
  PROCEDURE ADDIOPROC;                                                  29564000
    COMMENT                                                             29566000
      ADDS AN ENTRY TO THE I/O PROCESS LIST, INCLUDING PROCESS NAME,    29568000
    DRIVER TYPE, CORE RESIDENT FLAG, RELATIVE PRIORITY, AND             29570000
    RESOURCE QUEUE NUMBER;                                              29572000
      BEGIN                                                             29574000
          DLT'(DLTINDEX).QNUMB := NIOPROC;  <<PTR TO ENTRY>>            29576000
          TOS := @IOPROC(NIOPROC*IOPROCSIZE)&LSL(1);           <<04306>>29578000
          MOVE * := IOPROCNAME,(16);  <<MOVE IN NAME>>                  29580000
          IOPROC(X:=X+8).DRVRTYPE := DVRTYPE;                           29582000
          IOPROC(X).CORERES := RESIDENT;                                29584000
          IOPROC(X).NOCREATE := DBINFO.NOCREATE;               <<06067>>29586000
          IF DVRTYPE=2 THEN                                             29588000
            BEGIN  <<ASSIGN RESOURCE QUEUE NUMBER>>                     29590000
              TOS := NPROCQ+1;                                          29592000
              NPROCQ := S0;                                             29594000
              TOS := TOS+1;                                             29596000
              IOPROC(X).QNUMB := TOS;                                   29598000
            END                                                         29600000
          << HAS OWN PROCESS >>                                <<32BND>>29602000
          ELSE MTDS( DITDSTN, DPCBN, NIOPROC, 1);              <<32BND>>29604000
          IF IOPROCNAME=SYSIOPROC,(16) THEN TOS := 0                    29606000
          ELSE TOS := DBINFO(1).(8:8);  <<RELATIVE PRIORITY>>           29608000
          IOPROC(NIOPROC*IOPROCSIZE+9) := TOS;                          29610000
          NIOPROC := NIOPROC+1;                                         29612000
      END <<ADDIOPROC>> ;                                               29614000
$PAGE "DISC FREE SPACE PROCEDURES"                                      29616000
$CONTROL SEGMENT=DISCSPACE                                              29618000
$PAGE "LDEVTOTYPE"                                                      29620000
INTEGER PROCEDURE Ldevtotype (ldev);                           <<03551>>29622000
   VALUE ldev;                                                          29624000
   INTEGER ldev;                                                        29626000
                                                                        29628000
<<==============================================================        29630000
                                                                        29632000
      This procedure returns the type of a device, given its            29634000
   ldev.                                                                29636000
                                                                        29638000
   Parameters:                                                          29640000
      ldev - logical device number of the device.                       29642000
                                                                        29644000
   Returns:                                                             29646000
      type (an integer code) of the device.                             29648000
                                                                        29650000
   Assumptions on entry:                                                29652000
      DB is at the stack.                                               29654000
                                                                        29656000
   Exit conditions:                                                     29658000
      DB is unchanged.                                                  29660000
                                                                        29662000
   Globals:                                                             29664000
                                                                        29666000
      Input:                                                            29668000
         ldt                                                            29670000
                                                                        29672000
      Equates:                                                          29674000
         ldtsize                                                        29676000
         ldt2                                                           29678000
                                                                        29680000
      Defines:                                                          29682000
         typ                                                            29684000
                                                                        29686000
   Externals:                                                           29688000
      None.                                                             29690000
                                                                        29692000
   Intrinsics:                                                          29694000
      None.                                                             29696000
                                                                        29698000
   Callers:                                                             29700000
      Get'Disc'Info                                                     29702000
                                                                        29704000
   Fix ID:                                                              29706000
         This procedure was added as part of the new disc free          29708000
      space map changes.  The fix number on the procedure header        29710000
      applies to the whole procedure.                                   29712000
                                                                        29714000
   Changes:                                                             29716000
                                                                        29718000
                                                                        29720000
==============================================================>>        29722000
                                                                        29724000
BEGIN                                                                   29726000
                                                                        29728000
   INTEGER return'value = Ldevtotype,                          <<*LDT*>>29730000
           LDT'INDEX;                                          <<*LDT*>>29732000
                                                                        29734000
   << - - - - - - - - - - >>                                            29736000
                                                                        29738000
   LDT'INDEX := LDEV * LDTSIZE;                                <<*LDT*>>29740000
   return'value := LDT'DEVICE'TYPE;                            <<*LDT*>>29742000
                                                                        29744000
END;   << Ldevtotype >>                                                 29746000
$PAGE "LDEVTOSUBTYPE"                                                   29748000
INTEGER PROCEDURE Ldevtosubtype (ldev);                        <<03551>>29750000
   VALUE ldev;                                                          29752000
   INTEGER ldev;                                                        29754000
                                                                        29756000
<<==============================================================        29758000
                                                                        29760000
      This procedure returns the subtype of a device, given             29762000
   its ldev.                                                            29764000
                                                                        29766000
   Parameters:                                                          29768000
      ldev - logical device number of the device.                       29770000
                                                                        29772000
   Returns:                                                             29774000
      subtype (an integer code) of the device.                          29776000
                                                                        29778000
   Assumptions on entry:                                                29780000
      DB is at the stack.                                               29782000
                                                                        29784000
   Exit conditions:                                                     29786000
      DB is unchanged.                                                  29788000
                                                                        29790000
   Globals:                                                             29792000
                                                                        29794000
      Input:                                                            29796000
         lpdt                                                           29798000
                                                                        29800000
      Equates:                                                          29802000
         lpdtsize                                                       29804000
         lpdt1                                                          29806000
                                                                        29808000
      Defines:                                                          29810000
         subtype                                                        29812000
                                                                        29814000
   Externals:                                                           29816000
      None.                                                             29818000
                                                                        29820000
   Intrinsics:                                                          29822000
      None.                                                             29824000
                                                                        29826000
   Callers:                                                             29828000
      Get'Disc'Info                                                     29830000
                                                                        29832000
   Fix ID:                                                              29834000
         This procedure was added as part of the new disc free          29836000
      space map changes.  The fix number on the procedure header        29838000
      applies to the whole procedure.                                   29840000
                                                                        29842000
   Changes:                                                             29844000
                                                                        29846000
                                                                        29848000
==============================================================>>        29850000
                                                                        29852000
BEGIN                                                                   29854000
                                                                        29856000
   INTEGER return'value = Ldevtosubtype;                                29858000
   INTEGER LPDT'INDEX;                                         <<*LPDT>>29860000
                                                                        29862000
   << - - - - - - - - - - >>                                            29864000
                                                                        29866000
   LPDT'INDEX := LDEV * LPDTSIZE;                              <<*LPDT>>29868000
   return'value := lpdt'subtype;                               <<*LPDT>>29870000
                                                                        29872000
END;   << Ldevtosubtype >>                                              29874000
$PAGE "GET'DISC'INFO"                                                   29876000
PROCEDURE Get'Disc'Info (ldev, disc'label, read'label, dtt,    <<03551>>29878000
                         type, sub'type, disc'size,                     29880000
                         bit'map'address, bit'map'size'pages,           29882000
                         dt'address, dt'size'words, dt'dirty'flag,      29884000
                         dt'check'sum, sectors'per'track,               29886000
                         default'logical'pack'size,                     29888000
                         max'logical'pack'size, tracks'per'cylinder,    29890000
                         starting'head'number, track'multiplier);       29892000
                                                                        29894000
                                                                        29896000
   VALUE ldev, read'label;                                              29898000
   INTEGER ldev;                                                        29900000
   ARRAY disc'label;                                                    29902000
   LOGICAL read'label;                                                  29904000
   INTEGER ARRAY dtt;                                                   29906000
   INTEGER type;                                                        29908000
   INTEGER sub'type;                                                    29910000
   DOUBLE disc'size;                                                    29912000
   DOUBLE bit'map'address;                                              29914000
   INTEGER bit'map'size'pages;                                          29916000
   DOUBLE dt'address;                                                   29918000
   INTEGER dt'size'words;                                               29920000
   LOGICAL dt'dirty'flag;                                               29922000
   LOGICAL dt'check'sum;                                                29924000
   INTEGER sectors'per'track;                                           29926000
   INTEGER default'logical'pack'size;                                   29928000
   INTEGER max'logical'pack'size;                                       29930000
   INTEGER tracks'per'cylinder;                                         29932000
   INTEGER starting'head'number;                                        29934000
   INTEGER track'multiplier;                                            29936000
   OPTION VARIABLE,PRIVILEGED,UNCALLABLE;                               29938000
                                                                        29940000
<<==============================================================        29942000
                                                                        29944000
      This procedure returns all sorts of information about a           29946000
   particular disc ldev.  The information returned is de-               29948000
   scribed below, but a few notes are necessary about the               29950000
   "disc'label", "read'label", and "dtt" parameters.  If                29952000
   "disc'label" is passed and "read'label" is FALSE or omit-            29954000
   ted, then "disc'label" is assumed to be a valid copy of              29956000
   the "disc'label" for the ldev. If "read'label" is TRUE,              29958000
   then the disc label is read into the buffer.  If                     29960000
   "disc'label" is not passed and a copy of the disc label is           29962000
   needed to return other info that was requested, then a               29964000
   local buffer is allocated and the disc label is read into            29966000
   it.  The "dtt" buffer is used for returning the defective            29968000
   tracks table only. If it is not passed, and the DTT is               29970000
   needed, a local buffer is allocated and the DTT read into            29972000
   it.                                                                  29974000
                                                                        29976000
      Note: The only return values that are supported for               29978000
   floppy discs are disc'label, dtt, type, sub'type,                    29980000
   bit'map'address, bit'map'size'pages, dt'address,                     29982000
   dt'size'words, dt'dirty'flag and dt'check'sum. All other             29984000
   attempts to get values for floppies will result in a nasty           29986000
   message and a HALT.                                                  29988000
                                                                        29990000
   Parameters:                                                          29992000
      ldev - Logical device number of disc drive.                       29994000
      disc'label - (optional) - buffer for disc label or                29996000
                   containing disc label, see above comment.            29998000
      read'label - (optional) - TRUE = read in disc label,              30000000
                   FALSE don't read label, see above comment.           30002000
      dtt - (optional) - buffer for returning defective                 30004000
            tracks table, (NOT for defective sectors devices).          30006000
      type - (optional) - for return of device type code.               30008000
      subtype - (optional) - For return of subtype code.                30010000
      disc'size - (optional) - For return of logical size of            30012000
                  disc in sectors.                                      30014000
      bit'map'address - (optional) - For return of disc                 30016000
                        addreess of disc free space bit map.            30018000
      bit'map'size'pages - (optional) - For return of the               30020000
                           size of the bit map (in pages).              30022000
      dt'address - (optional) - For return of the disc                  30024000
                   address of the disc free space descriptor            30026000
                   table.                                               30028000
      dt'size'words - (optional) - For return  of the size of           30030000
                      the descriptor table (in words).                  30032000
      dt'dirty'flag - (optional) - For return of the value of           30034000
                      the descriptor table dirty flag from              30036000
                      the disc label.                                   30038000
      dt'check'sum - (optional) - For return of the                     30040000
                     descriptor table checksum from the disc            30042000
                     label.                                             30044000
      sectors'per'track - (optional) - For return of the the            30046000
                          number of sectors per track.                  30048000
      default'logical'pack'size - (optional) - For return of            30050000
                                  default logical pack size.            30052000
      max'logical'pack'size - (optional) - For return of                30054000
                              maximum logical pack size.                30056000
      tracks'per'cylinder - (optional) - For return of number           30058000
                            of tracks per cylinder.                     30060000
      starting'head'number - (optional) - For return of                 30062000
                             starting head number.                      30064000
      track'multiplier - (optional) - For return of the track multipli  30066000
                         multiplier.  This value is to convert a        30068000
                         track number to a cylinder & head number.  It  30070000
                         is only needed for the 7900 disc.  For all     30072000
                         other discs it has a value of 1.               30074000
                                                                        30076000
   Assumptions on entry:                                                30078000
      DB is at the stack.                                               30080000
                                                                        30082000
   Exit conditions:                                                     30084000
      DB is unchanged.                                                  30086000
                                                                        30088000
   Globals:                                                             30090000
                                                                        30092000
      Others:                                                           30094000
         mh'tracks'per'cylinder {INCDISC2}                              30096000
         mh'sectors'per'track {INCDISC2}                                30098000
         mh'default'logical'pack'size {INCDISC2}                        30100000
         fh'log'pack'size {INCDISC2}                                    30102000
         mh'max'log'pack'size {INCDISC2}                                30104000
         mh'tracks'per'cylinder {INCDISC2}                              30106000
         mh'starting'head'number {INCDISC2}                             30108000
                                                                        30110000
      Equates:                                                          30112000
         sector'size                                                    30114000
         mh'disc'type {INCDISC1}                                        30116000
         fh'disc'type {INCDISC1}                                        30118000
         floppy'disc'type {INCDISC1}                                    30120000
         cs'80'type {INCDISC1}                                          30122000
         dtt'logical'pack'size {INCDISC1}                               30124000
         fh'sectors'per'track {INCDISC2}                                30126000
         bits'per'page                                                  30128000
         disc'lab'map'high {INCDISC1}                                   30130000
         disc'lab'map'low {INCDISC1}                                    30132000
         disc'lab'dt'high {INCDISC1}                                    30134000
         disc'lab'dt'low {INCDISC1}                                     30136000
         dt'entry'size                                                  30138000
         disc'lab'dirty'dt'flag {INCDISC1}                              30140000
         disc'lab'dt'check'sum {INCDISC1}                               30142000
         fh'tracks'per'cylinder {INCDISC2}                              30144000
         fh'starting'head'number {INCDISC2}                             30146000
         mh'track'multiplier {INCDISC2}                                 30148000
         fh'track'multiplier {INCDISC2}                                 30150000
         m401                                                           30152000
                                                                        30154000
      Defines:                                                          30156000
         disc'label'address {INCDISC1}                                  30158000
         dtt'disc'address {INCDISC1}                                    30160000
         DBL                                                            30162000
                                                                        30164000
   Externals:                                                           30166000
      Disc                                                              30168000
      Ldevtotype                                                        30170000
      Ldevtosubtype                                                     30172000
      Errmessage                                                        30174000
                                                                        30176000
   Intrinsics:                                                          30178000
      None.                                                             30180000
                                                                        30182000
   Callers:                                                             30184000
      Access'Dfs'Map                                                    30186000
      Get'Disc'Defect'Entry                                             30188000
      Init'Disc'Free'Space'Map                                          30190000
                                                                        30192000
   Fix ID:                                                              30194000
         This procedure was added as part of the new disc               30196000
      free space map changes.  The fix number on the                    30198000
      procedure header applies to the whole procedure.                  30200000
                                                                        30202000
   Changes:                                                             30204000
                                                                        30206000
                                                                        30208000
==============================================================>>        30210000
                                                                        30212000
BEGIN                                                                   30214000
                                                                        30216000
   << Parameter map definitions >>                                      30218000
                                                                        30220000
   LOGICAL pmap0 = Q-5,                                                 30222000
           pmap1 = Q-4;                                                 30224000
                                                                        30226000
   DEFINE                                                               30228000
      passed'ldev = pmap0.(13:1)#,                                      30230000
      passed'disc'label = pmap0.(14:1)#,                                30232000
      passed'read'label = pmap0.(15:1)#,                                30234000
      passed'dtt = pmap1.(0:1)#,                                        30236000
      passed'type = pmap1.(1:1)#,                                       30238000
      passed'sub'type = pmap1.(2:1)#,                                   30240000
      passed'disc'size = pmap1.(3:1)#,                                  30242000
      passed'b'm'address = pmap1.(4:1)#,                                30244000
      passed'b'm'size'pages = pmap1.(5:1)#,                             30246000
      passed'dt'address = pmap1.(6:1)#,                                 30248000
      passed'dt'size'words = pmap1.(7:1)#,                              30250000
      passed'dt'dirty'flag = pmap1.(8:1)#,                              30252000
      passed'dt'check'sum = pmap1.(9:1)#,                               30254000
      passed'sectors'per'track = pmap1.(10:1)#,                         30256000
      passed'default'logical'pack'size = pmap1.(11:1)#,                 30258000
      passed'max'logical'pack'size = pmap1.(12:1)#,                     30260000
      passed'tracks'per'cylinder = pmap1.(13:1)#,                       30262000
      passed'starting'head'number = pmap1.(14:1)#,                      30264000
      passed'track'multiplier = pmap1.(15:1)#;                          30266000
                                                                        30268000
   << Local vars to hold values that are needed to generate             30270000
      info that is to be returned.                          >>          30272000
                                                                        30274000
   INTEGER local'type;                                                  30276000
   INTEGER local'sub'type;                                              30278000
   DOUBLE local'disc'size;                                              30280000
   INTEGER local'bit'map'size'pages;                                    30282000
   ARRAY buf'disc'size (0:1);                                           30284000
   DOUBLE ARRAY d'buf'disc'size (*) = buf'disc'size;                    30286000
                                                                        30288000
$INCLUDE INCDISC1                                                       30290000
                                                                        30292000
$SET X7=ON                                                              30294000
$INCLUDE INCDISC2                                                       30296000
                                                                        30298000
                                                                        30300000
   << - - - - - - - - - - >>                                            30302000
                                                                        30304000
   << Check and see if we need to allocate a buffer for the             30306000
      disc label, but only if we really need it.             >>         30308000
                                                                        30310000
   IF (passed'b'm'address OR passed'dt'address OR passed'dt'dirty)      30312000
   AND NOT passed'disc'label THEN                                       30314000
      BEGIN  << Allocate disc label buffer >>                           30316000
                                                                        30318000
         PUSH (S);                                                      30320000
         @disc'label := TOS + 1;  << ptr to buffer >>                   30322000
         TOS := sector'size + 1;  << size of buffer >>                  30324000
         ASSEMBLE (ADDS 0);                                             30326000
                                                                        30328000
         << Remember to read the label >>                               30330000
                                                                        30332000
         read'label := TRUE;                                            30334000
                                                                        30336000
      END    << Allocate disc label buffer >>                           30338000
   ELSE                                                                 30340000
      IF NOT passed'read'label THEN                                     30342000
         read'label := FALSE;                                           30344000
                                                                        30346000
   << Read disc label if needed >>                                      30348000
                                                                        30350000
   IF read'label THEN                                                   30352000
      Disc (0, ldev, disc'label'address, disc'label, sector'size);      30354000
                                                                        30356000
                                                                        30358000
   << Read in defective tracks table, if we will need it. >>            30360000
                                                                        30362000
   IF passed'dtt OR (passed'disc'size LAND                              30364000
   NOT (local'type = cs'80'type)) OR                                    30366000
   passed'b'm'size'pages OR passed'dt'size'words THEN                   30368000
      BEGIN  << Read in DTT >>                                          30370000
                                                                        30372000
         << Allocate buffer for DTT if not passsed >>                   30374000
                                                                        30376000
         IF NOT passed'dtt THEN                                         30378000
            BEGIN  << Allocate DTT buffer >>                            30380000
                                                                        30382000
               PUSH (S);                                                30384000
               @dtt := TOS + 1;                                         30386000
               TOS := sector'size + 1;                                  30388000
               ASSEMBLE (ADDS 0);                                       30390000
                                                                        30392000
            END;   << Allocate DTT buffer >>                            30394000
                                                                        30396000
         Disc (0, ldev, dtt'disc'address, dtt, sector'size);            30398000
                                                                        30400000
      END;   << Read in DTT >>                                          30402000
                                                                        30404000
   << Get type and sub'type >>                                          30406000
                                                                        30408000
   local'type := Ldevtotype (ldev);                                     30410000
   local'sub'type := Ldevtosubtype (ldev);                              30412000
                                                                        30414000
   IF NOT((local'type = mh'disc'type) LOR                               30416000
   (local'type = fh'disc'type) LOR                                      30418000
   (local'type = floppy'disc'type) LOR                                  30420000
   (local'type = cs'80'type)) THEN                                      30422000
      Errmessage (m401);                                                30424000
                                                                        30426000
   << Determine size of disc and size of bit map. >>                    30428000
                                                                        30430000
   IF passed'disc'size OR passed'b'm'size'pages OR                      30432000
   passed'dt'size'words THEN                                            30434000
      BEGIN  << Calculate size of disc >>                               30436000
                                                                        30438000
         IF local'type = mh'disc'type THEN                              30440000
            local'disc'size := DBL(dtt(dtt'logical'pack'size)) *        30442000
                  DBL(mh'tracks'per'cylinder (local'sub'type)) *        30444000
                  DBL(mh'sectors'per'track (local'sub'type))            30446000
                                                                        30448000
         ELSE                                                           30450000
         IF local'type = fh'disc'type THEN                              30452000
            local'disc'size := DBL(dtt(dtt'logical'pack'size)) *        30454000
                  DBL(fh'sectors'per'track)                             30456000
         ELSE                                                           30458000
         IF local'type = floppy'disc'type THEN                          30460000
            Errmessage (m401)                                           30462000
         ELSE                                                           30464000
         IF local'type = cs'80'type THEN                                30466000
            BEGIN << Command set 80 disc >>                             30468000
                                                                        30470000
               Disc (13, ldev, 0D, buf'disc'size, 2);                   30472000
                                                                        30474000
               local'disc'size := d'buf'disc'size (0) + 1D;             30476000
                                                                        30478000
            END   << Command set 80 disc >>                             30480000
         ELSE ;                                                         30482000
                                                                        30484000
         local'bit'map'size'pages := local'disc'size // bits'per'page;  30486000
         IF (local'disc'size MODD bits'per'page) <> 0 THEN              30488000
            local'bit'map'size'pages := local'bit'map'size'pages + 1;   30490000
                                                                        30492000
      END;   << Calculate size of disc >>                               30494000
                                                                        30496000
                                                                        30498000
   << Return values for passed parameters. >>                           30500000
                                                                        30502000
   IF passed'type THEN                                                  30504000
      type := local'type;                                               30506000
                                                                        30508000
                                                                        30510000
   IF passed'sub'type THEN                                              30512000
      sub'type := local'sub'type;                                       30514000
                                                                        30516000
                                                                        30518000
   IF passed'disc'size THEN                                             30520000
      disc'size := local'disc'size;                                     30522000
                                                                        30524000
                                                                        30526000
   IF passed'b'm'address THEN                                           30528000
      BEGIN  << return bit map address >>                               30530000
                                                                        30532000
         TOS := disc'label (disc'lab'map'high);                         30534000
         TOS := disc'label (disc'lab'map'low);                          30536000
         bit'map'address := TOS;                                        30538000
                                                                        30540000
      END;   << Return bit map address >>                               30542000
                                                                        30544000
                                                                        30546000
   IF passed'b'm'size'pages THEN                                        30548000
      bit'map'size'pages := local'bit'map'size'pages;                   30550000
                                                                        30552000
                                                                        30554000
   IF passed'dt'address THEN                                            30556000
      BEGIN  << Descriptor table address >>                             30558000
                                                                        30560000
         TOS := disc'label (disc'lab'dt'high);                          30562000
         TOS := disc'label (disc'lab'dt'low);                           30564000
         dt'address := TOS;                                             30566000
                                                                        30568000
      END;   << descriptor table address >>                             30570000
                                                                        30572000
                                                                        30574000
   IF passed'dt'size'words THEN                                         30576000
      BEGIN  << Return size of descriptor table >>                      30578000
                                                                        30580000
         dt'size'words := local'bit'map'size'pages * dt'entry'size;     30582000
                                                                        30584000
         << Increment size if it is odd, thus making it even. This      30586000
            is necessary so "Make'Check'Sum" will have an even          30588000
            number of words to work with.  This will mean that a        30590000
            word may be wasted. Big shit.                         >>    30592000
                                                                        30594000
         IF dt'size'words.(15:1) = 1 THEN                               30596000
            dt'size'words := dt'size'words + 1;                         30598000
                                                                        30600000
      END;   << Return size of descriptor table >>                      30602000
                                                                        30604000
                                                                        30606000
   IF passed'dt'dirty'flag THEN                                         30608000
      dt'dirty'flag := disc'label (disc'lab'dirty'dt'flag);             30610000
                                                                        30612000
                                                                        30614000
   IF passed'dt'check'sum THEN                                          30616000
         dt'check'sum := disc'label (disc'lab'dt'check'sum);            30618000
                                                                        30620000
                                                                        30622000
   IF passed'sectors'per'track THEN                                     30624000
      BEGIN   << Return sectors per track >>                            30626000
                                                                        30628000
         IF local'type = mh'disc'type THEN                              30630000
            sectors'per'track := mh'sectors'per'track (local'sub'type)  30632000
                                                                        30634000
         ELSE                                                           30636000
         IF local'type = fh'disc'type THEN                              30638000
            sectors'per'track := fh'sectors'per'track                   30640000
                                                                        30642000
         ELSE                                                           30644000
         IF local'type = floppy'disc'type THEN                          30646000
            Errmessage (m401)                                           30648000
                                                                        30650000
         ELSE                                                           30652000
         IF local'type = cs'80'type THEN                                30654000
            sectors'per'track := 0   << Not valid for cs'80 >>          30656000
                                                                        30658000
         ELSE ;                                                         30660000
                                                                        30662000
      END;    << Return sectors per track >>                            30664000
                                                                        30666000
                                                                        30668000
   IF passed'default'logical'pack'size THEN                             30670000
      BEGIN  << Return default logical pack size >>                     30672000
                                                                        30674000
         IF local'type = mh'disc'type THEN                              30676000
            default'logical'pack'size :=                                30678000
                  mh'default'log'pack'size (local'sub'type)             30680000
                                                                        30682000
         ELSE                                                           30684000
         IF local'type = fh'disc'type THEN                              30686000
            default'logical'pack'size :=                                30688000
                  fh'log'pack'size (local'sub'type)                     30690000
                                                                        30692000
         ELSE                                                           30694000
         IF local'type = floppy'disc'type THEN                          30696000
            Errmessage (m401)                                           30698000
                                                                        30700000
         ELSE                                                           30702000
         IF local'type = cs'80'type THEN                                30704000
            default'logical'pack'size := 0  << Not valid for cs 80 >>   30706000
                                                                        30708000
         ELSE;                                                          30710000
                                                                        30712000
      END;   << Return default logical pack size >>                     30714000
                                                                        30716000
                                                                        30718000
   IF passed'max'logical'pack'size THEN                                 30720000
      BEGIN  << Return max logical pack size >>                         30722000
                                                                        30724000
         IF local'type = mh'disc'type THEN                              30726000
            max'logical'pack'size :=                                    30728000
                  mh'max'log'pack'size (local'sub'type)                 30730000
                                                                        30732000
         ELSE                                                           30734000
         IF local'type = fh'disc'type THEN                              30736000
            max'logical'pack'size :=                                    30738000
                  fh'log'pack'size (local'sub'type)                     30740000
                                                                        30742000
         ELSE                                                           30744000
         IF local'type = floppy'disc'type THEN                          30746000
            Errmessage (m401)                                           30748000
                                                                        30750000
         ELSE                                                           30752000
         IF local'type = cs'80'type THEN                                30754000
            max'logical'pack'size := 0   << Not calid for cs 80 >>      30756000
                                                                        30758000
         ELSE;                                                          30760000
                                                                        30762000
      END;   << Return max logical pack size >>                         30764000
                                                                        30766000
                                                                        30768000
   IF passed'tracks'per'cylinder THEN                                   30770000
      BEGIN  << Return tracks per cylinder >>                           30772000
                                                                        30774000
         IF local'type = mh'disc'type THEN                              30776000
            tracks'per'cylinder :=                                      30778000
                  mh'tracks'per'cylinder (local'sub'type)               30780000
                                                                        30782000
         ELSE                                                           30784000
         IF local'type = fh'disc'type THEN                              30786000
               tracks'per'cylinder := fh'tracks'per'cylinder            30788000
                                                                        30790000
         ELSE                                                           30792000
         IF local'type = floppy'disc'type THEN                          30794000
            Errmessage (m401)                                           30796000
                                                                        30798000
         ELSE                                                           30800000
         IF local'type = cs'80'type THEN                                30802000
            tracks'per'cylinder := 0  << Not valid for cs 80 dev >>     30804000
                                                                        30806000
         ELSE;                                                          30808000
                                                                        30810000
     END;   << Return tracks per cylinder >>                            30812000
                                                                        30814000
                                                                        30816000
   IF passed'starting'head'number THEN                                  30818000
      BEGIN  << Return starting head number >>                          30820000
                                                                        30822000
         IF local'type = mh'disc'type THEN                              30824000
            starting'head'number :=                                     30826000
                  mh'starting'head'number (local'sub'type)              30828000
                                                                        30830000
         ELSE                                                           30832000
         IF local'type = fh'disc'type THEN                              30834000
            starting'head'number := fh'starting'head'number             30836000
                                                                        30838000
         ELSE                                                           30840000
         IF local'type = floppy'disc'type THEN                          30842000
            Errmessage (m401)                                           30844000
                                                                        30846000
         ELSE                                                           30848000
         IF local'type = cs'80'type THEN                                30850000
            starting'head'number := 0   << Not valid for cs'80 dev >>   30852000
                                                                        30854000
         ELSE                                                           30856000
                                                                        30858000
      END;  << Return starting head number >>                           30860000
                                                                        30862000
   IF passed'track'multiplier THEN                                      30864000
      BEGIN  << Return track multiplier >>                              30866000
                                                                        30868000
         IF local'type = mh'disc'type THEN                              30870000
            track'multiplier :=                                         30872000
                  mh'track'multiplier (local'sub'type)                  30874000
                                                                        30876000
         ELSE                                                           30878000
         IF local'type = fh'disc'type THEN                              30880000
            track'multiplier := fh'track'multiplier                     30882000
                                                                        30884000
         ELSE                                                           30886000
         IF local'type = floppy'disc'type THEN                          30888000
            Errmessage (m401)                                           30890000
                                                                        30892000
         ELSE                                                           30894000
         IF local'type = cs'80'type THEN                                30896000
            track'multiplier := 1  << Not valid for cs'80 dev >>        30898000
                                                                        30900000
         ELSE                                                           30902000
                                                                        30904000
      END;   << Return track multiplier >>                              30906000
                                                                        30908000
END;   << Get'Disc'Info >>                                              30910000
$PAGE "INDLDFSC - DISC FREE SPACE COMMON CODE INCLUDE FILE"             30912000
$INCLUDE INCLDFSC                                                       30914000
$PAGE "WRITE'PAGE"                                                      30916000
PROCEDURE Write'Page;                                          <<03551>>30918000
                                                                        30920000
<<==============================================================        30922000
                                                                        30924000
      This procedure re-calculates the check sum and writes             30926000
   the page of the bit map currently in the global buffer               30928000
   back to disc.                                                        30930000
                                                                        30932000
   Assumptions on entry:                                                30934000
      DB is at the stack.                                               30936000
                                                                        30938000
   Exit conditions:                                                     30940000
      DB is unchanged.                                                  30942000
                                                                        30944000
   Globals:                                                             30946000
                                                                        30948000
      Input:                                                            30950000
         ldev'of'map'in'buffer - ldev of disc from which the            30952000
                                 page came.                             30954000
         add'of'map'page'in'buffer - disc address of page in            30956000
                                     the buffer.                        30958000
         bit'map'buffer - buffer containing page of map.                30960000
                                                                        30962000
      Equates:                                                          30964000
         check'sum'word                                                 30966000
         actual'words'per'page                                          30968000
                                                                        30970000
   Externals:                                                           30972000
      Make'Check'Sum                                                    30974000
      Disc                                                              30976000
                                                                        30978000
   Intrinsics:                                                          30980000
      None.                                                             30982000
                                                                        30984000
   Callers:                                                             30986000
      Set'Reset'Bit'Map                                                 30988000
                                                                        30990000
   Fix ID:                                                              30992000
         This procedure was added as part of the new disc               30994000
      free space map changes.  The fix number on the                    30996000
      procedure header applies to the whole procedure.                  30998000
                                                                        31000000
   Changes:                                                             31002000
                                                                        31004000
                                                                        31006000
==============================================================>>        31008000
                                                                        31010000
BEGIN                                                                   31012000
                                                                        31014000
   << Generate new check sum >>                                         31016000
                                                                        31018000
   bit'map'buffer (check'sum'word) := 0;                                31020000
   bit'map'buffer (check'sum'word) :=                                   31022000
      Make'Check'Sum (bit'map'buffer, actual'words'per'page);           31024000
                                                                        31026000
   << Write to disc >>                                                  31028000
                                                                        31030000
   Disc (1, ldev'of'map'in'buffer, add'of'map'page'in'buffer,           31032000
         bit'map'buffer, actual'words'per'page);                        31034000
                                                                        31036000
          << COUNT DISC ACCESSES >>                            <<D9089>>31038000
          TOS := FREEDA; << LOAD ADDR  >>                      <<D9089>>31040000
          ASMB( LDEA );  << LOAD COUNT >>                      <<D9089>>31042000
          TOS := TOS+1D; << INC COUNT  >>                      <<D9089>>31044000
          ASMB( SDEA );  << STOR COUNT >>                      <<D9089>>31046000
          DDEL;          << DEL ADDRESS>>                      <<D9089>>31048000
END; << Write'Page >>                                                   31050000
$PAGE "CHECK'DT'ENTRY"                                                  31052000
LOGICAL PROCEDURE Check'Dt'Entry (ldev'index, page);           <<03551>>31054000
   VALUE ldev'index, page;                                              31056000
   INTEGER ldev'index;                                                  31058000
   INTEGER page;                                                        31060000
                                                                        31062000
<<==============================================================        31064000
                                                                        31066000
      This procedure checks the descriptor table entry for a            31068000
   page of a disc free space map to see if the page has been            31070000
   flaged as bad.  It first calculates which sector of the              31072000
   descriptor table (which is on disc) is needed and the                31074000
   offset into the sector. If the sector is                             31076000
   already in the global buffer, then it is used, otherwise             31078000
   the sector must be read from disc.  Only the first word of           31080000
   the entry is check, although all are marked, as it                   31082000
   simplfies the case when an entry crosses sector boundries.           31084000
                                                                        31086000
   Parameters:                                                          31088000
      ldev'index - index from ldev to check. (see                       31090000
                   ldev'index'to'ldev array)                            31092000
      page - The page to check the descriptor entry for.                31094000
                                                                        31096000
   Returns:                                                             31098000
      TRUE if the page is o.k.,                                         31100000
      FALSE if the page has been marked as bad.                         31102000
                                                                        31104000
   Assumptions on entry:                                                31106000
      DB is at the stack.                                               31108000
                                                                        31110000
   Exit conditions:                                                     31112000
      DB is unchanged.                                                  31114000
                                                                        31116000
   Globals:                                                             31118000
                                                                        31120000
      Input:                                                            31122000
         ldev'of'dt'page'in'buffer - may be changed.                    31124000
         add'of'dt'page'in'buffer - may be changed.                     31126000
         dt'buffer - may be changed.                                    31128000
                                                                        31130000
      Others:                                                           31132000
         dt'disc'address                                                31134000
         ldev'index'to'ldev                                             31136000
                                                                        31138000
      Equates:                                                          31140000
         dt'entry'size                                                  31142000
         sector'size                                                    31144000
         bad'page                                                       31146000
                                                                        31148000
   Externals:                                                           31150000
      Disc                                                              31152000
                                                                        31154000
   Intrinsics:                                                          31156000
      None.                                                             31158000
                                                                        31160000
   Callers:                                                             31162000
      Access'Dfs'Map                                                    31164000
      Get'Page                                                          31166000
                                                                        31168000
   Fix ID:                                                              31170000
         This procedure was added as part of the new disc               31172000
      free space map changes.  The fix number on the                    31174000
      procedure header applies to the whole procedure.                  31176000
                                                                        31178000
   Changes:                                                             31180000
                                                                        31182000
                                                                        31184000
==============================================================>>        31186000
                                                                        31188000
BEGIN                                                                   31190000
                                                                        31192000
   DOUBLE sector'address;                                               31194000
   INTEGER offset;                                                      31196000
                                                                        31198000
   LOGICAL return'value = Check'Dt'Entry;                               31200000
                                                                        31202000
   << - - - - - - - - - - >>                                            31204000
                                                                        31206000
   << Calculate disc address of sector containing entry for the         31208000
      page, and the offset into that sector of the entry.       >>      31210000
                                                                        31212000
   sector'address := DOUBLE((page*dt'entry'size) / sector'size) +       31214000
                     dt'disc'address (ldev'index);                      31216000
   offset := (page * dt'entry'size) MOD sector'size;                    31218000
   IF offset <> 0 THEN                                                  31220000
      sector'address := sector'address + 1D;                            31222000
                                                                        31224000
   << See if page of DT is already in buffer, if not, read it in. >>    31226000
                                                                        31228000
   IF NOT ((ldev'index'to'ldev(ldev'index) = ldev'of'dt'page'in'buffer) 31230000
   LAND (sector'address = add'of'dt'page'in'buffer)) THEN               31232000
      BEGIN  << Must read page >>                                       31234000
                                                                        31236000
         Disc (0, ldev'index'to'ldev (ldev'index), sector'address,      31238000
               dt'buffer, sector'size);                                 31240000
                                                                        31242000
         << If any errors have occured, INITIAL has been halted >>      31244000
                                                                        31246000
      END;   << Must read page >>                                       31248000
                                                                        31250000
   << Check if page has been flaged as bad. >>                          31252000
                                                                        31254000
   IF dt'buffer (offset) = bad'page THEN                                31256000
      return'value := FALSE                                             31258000
   ELSE                                                                 31260000
      return'value := TRUE;                                             31262000
                                                                        31264000
END;  << Check'Dt'Entry >>                                              31266000
$PAGE "GET'PAGE"                                                        31268000
PROCEDURE Get'Page (ldev'index, page);                         <<03551>>31270000
   VALUE ldev'index, page;                                              31272000
   INTEGER ldev'index;                                                  31274000
   INTEGER page;                                                        31276000
                                                                        31278000
<<==============================================================        31280000
                                                                        31282000
      This procedure reads the specified page of a bit map              31284000
   into the global buffer.  First a check is made to see if             31286000
   the page is already there, if so, we just return.  If it             31288000
   is not and "dfs'map'problems" indicates there are some bad           31290000
   pages in the map, then it checks the descriptor table to             31292000
   see if the page has been flaged bad. If it is bad it                 31294000
   exits, returning error status.  If the page is o.k., then            31296000
   it is read into the buffer and the checksum is verfied.              31298000
   If the checksum is bad, then it returns error status,                31300000
   otherwise ok status.                                                 31302000
                                                                        31304000
   Parameters:                                                          31306000
      ldev'index - index refering to ldev of disc.                      31308000
      page - page to read into buffer.                                  31310000
                                                                        31312000
   Returns:                                                             31314000
      condition code = CCE - got it.                                    31316000
                       CCL - can't get, either page is flaged           31318000
                             as bad or checksum error.                  31320000
                                                                        31322000
   Assumptions on entry:                                                31324000
      DB is at the stack.                                               31326000
                                                                        31328000
   Exit conditions:                                                     31330000
      DB is unchanged.                                                  31332000
                                                                        31334000
   Globals:                                                             31336000
                                                                        31338000
      Input:                                                            31340000
         dfs'map'problems                                               31342000
         ldev'to'ldev'index                                             31344000
         bit'map'disc'address                                           31346000
                                                                        31348000
      Output:                                                           31350000
         ldev'of'map'in'buffer                                          31352000
         page'of'map'in'buffer                                          31354000
         add'of'map'in'buffer                                           31356000
         bit'map'buffer                                                 31358000
                                                                        31360000
      Others:                                                           31362000
         last'page'of'map                                               31364000
                                                                        31366000
      Equates:                                                          31368000
         cce                                                            31370000
         ccl                                                            31372000
         actual'words'per'page                                          31374000
         check'sum'word                                                 31376000
                                                                        31378000
      Defines:                                                          31380000
         cc                                                             31382000
                                                                        31384000
   Externals:                                                           31386000
      Disc                                                              31388000
      Check'Dt'Entry                                                    31390000
      Make'Check'Sum                                                    31392000
                                                                        31394000
   Intrinsics:                                                          31396000
      None.                                                             31398000
                                                                        31400000
   Callers:                                                             31402000
      Set'Reset'Bit'Map                                                 31404000
      Get'Disc'Space                                                    31406000
      Get'Specific'Disc'Space                                           31408000
                                                                        31410000
   Fix ID:                                                              31412000
         This procedure was added as part of the new disc               31414000
      free space map changes.  The fix number on the                    31416000
      procedure header applies to the whole procedure.                  31418000
                                                                        31420000
   Changes:                                                             31422000
                                                                        31424000
                                                                        31426000
==============================================================>>        31428000
                                                                        31430000
BEGIN                                                                   31432000
                                                                        31434000
   LOGICAL check'sum;                                                   31436000
                                                                        31438000
   << - - - - - - - - - - >>                                            31440000
                                                                        31442000
   IF NOT(0 <= page <= last'page'of'map (ldev'index)) THEN              31444000
      ERRMESSAGE (M325,1);                                     <<03632>>31446000
                                                                        31448000
   cc := cce;   << Preset OK status >>                                  31450000
                                                                        31452000
   << Check to see if it is already in a buffer. >>                     31454000
                                                                        31456000
   IF (ldev'index'to'ldev (ldev'index) = ldev'of'map'in'buffer) AND     31458000
   (page = page'of'map'in'buffer) THEN                                  31460000
                                                                        31462000
      RETURN;  << Already there >>                                      31464000
                                                                        31466000
   << If it is not in the buffer, we must read it in, but first,        31468000
      if it is known that there are any bad pages, then we must         31470000
      check the descriptor table to see if the page is bad.    >>       31472000
                                                                        31474000
   IF dfs'map'problems (ldev'index) > 0 THEN                            31476000
      IF NOT Check'Dt'Entry (ldev'index , page)                         31478000
      THEN                                                              31480000
         BEGIN   << Page is bad >>                                      31482000
                                                                        31484000
            cc := ccl;                                                  31486000
            RETURN;                                                     31488000
                                                                        31490000
         END;    << Page is bad >>                                      31492000
                                                                        31494000
   add'of'map'page'in'buffer := DOUBLE(page) +                          31496000
         bit'map'disc'address (ldev'index);                             31498000
                                                                        31500000
   Disc (0, ldev'index'to'ldev(ldev'index), add'of'map'page'in'buffer,  31502000
         bit'map'buffer, actual'words'per'page);                        31504000
                                                                        31506000
   << Verfiy checksum, if its bad, return nasty status >>               31508000
                                                                        31510000
   check'sum := bit'map'buffer (check'sum'word);                        31512000
   bit'map'buffer (check'sum'word) := 0;                                31514000
                                                                        31516000
   IF Make'Check'Sum (bit'map'buffer, actual'words'per'page) <>         31518000
   check'sum THEN                                                       31520000
      BEGIN   << Checksum is bad >>                                     31522000
                                                                        31524000
         << Mark buffer as empty >>                                     31526000
                                                                        31528000
         ldev'of'map'in'buffer := -1;                                   31530000
                                                                        31532000
         cc := ccl;  << Return status >>                                31534000
         RETURN;                                                        31536000
                                                                        31538000
      END;    << Checksum is bad >>                                     31540000
                                                                        31542000
   << Remember which page is in the buffer >>                           31544000
                                                                        31546000
   ldev'of'map'in'buffer := ldev'index'to'ldev (ldev'index);            31548000
   page'of'map'in'buffer := page;                                       31550000
                                                                        31552000
          << COUNT DISC ACCESSES >>                            <<D9089>>31554000
          TOS := FREEDA; << LOAD ADDR  >>                      <<D9089>>31556000
          ASMB( LDEA );  << LOAD COUNT >>                      <<D9089>>31558000
          TOS := TOS+1D; << INC COUNT  >>                      <<D9089>>31560000
          ASMB( SDEA );  << STOR COUNT >>                      <<D9089>>31562000
          DDEL;          << DEL ADDRESS>>                      <<D9089>>31564000
END;   << Get'Page >>                                                   31566000
$PAGE "SET'RESET'BIT'MAP"                                               31568000
PROCEDURE Set'Reset'Bit'Map (ldev'index, page'number,          <<03551>>31570000
                             word'number, bit'number,                   31572000
                             number'of'bits, set'bits);                 31574000
   VALUE ldev'index, page'number, word'number, bit'number,              31576000
         number'of'bits, set'bits;                                      31578000
   INTEGER ldev'index;                                                  31580000
   INTEGER page'number;                                                 31582000
   INTEGER word'number;                                                 31584000
   INTEGER bit'number;                                                  31586000
   DOUBLE number'of'bits;                                               31588000
   LOGICAL set'bits;                                                    31590000
   OPTION PRIVILEGED,UNCALLABLE;                                        31592000
                                                                        31594000
<<==============================================================        31596000
                                                                        31598000
      This procedure turns on or off a continuous set of bits           31600000
   in the map.  The block of bits starts at  the  page,  word           31602000
   and  bit  number  passed  to the procedure.  The pages are           31604000
   always written out after we have  processed  them.   If  a           31606000
   Get'Page  error occures while returning space, the page is           31608000
   just skiped.  If a Get'Page error  occures  while  getting           31610000
   space, the procedure is exited, returning a nasty status.            31612000
                                                                        31614000
   Parameters:                                                          31616000
      ldev'index - index for ldev of disc. (see                         31618000
                   ldev'index'to'ldev array)                            31620000
      page'number - number of page where block of bits                  31622000
                    starts.                                             31624000
      word'number - number of word in page where block of               31626000
                    bits starts.                                        31628000
      bit'number - number of bit in word where block starts.            31630000
      number'of'bits - number of bits to set/reset.                     31632000
      set'bits - TRUE to set bits,(i.e. returning space),               31634000
                 FALSE to reset bits, (i.e. getting space).             31636000
                                                                        31638000
   Returns:                                                             31640000
      condition code = CCE if alls o.k.                                 31642000
                       CCL if error from Get'Page.                      31644000
                                                                        31646000
   Assumptions on entry:                                                31648000
      DB must be at the stack.                                          31650000
                                                                        31652000
   Exit conditions:                                                     31654000
      DB is unchanged.                                                  31656000
                                                                        31658000
   Globals:                                                             31660000
                                                                        31662000
      Others:                                                           31664000
         last'page'of'map                                               31666000
         ds'page'ptr                                                    31668000
                                                                        31670000
      Equates:                                                          31672000
         max'disc'drives                                                31674000
         m325                                                           31676000
         words'per'page                                                 31678000
         bits'per'word                                                  31680000
         ccl                                                            31682000
         cce                                                            31684000
                                                                        31686000
      Defines:                                                          31688000
         DBL                                                            31690000
         cc                                                             31692000
                                                                        31694000
   Externals:                                                           31696000
      Errmessage                                                        31698000
      Get'Page                                                          31700000
      Write'Page                                                        31702000
                                                                        31704000
   Intrinsics:                                                          31706000
      None.                                                             31708000
                                                                        31710000
   Callers:                                                             31712000
      Get'Disc'Space                                                    31714000
      Return'Disc'Space                                                 31716000
      Get'Specific'Disc'Space                                           31718000
                                                                        31720000
   Fix ID:                                                              31722000
         This procedure was added as part of the new disc               31724000
      free space map changes.  The fix number on the                    31726000
      procedure header applies to the whole procedure.                  31728000
                                                                        31730000
   Changes:                                                             31732000
                                                                        31734000
                                                                        31736000
==============================================================>>        31738000
                                                                        31740000
BEGIN                                                                   31742000
                                                                        31744000
   LOGICAL set'pattern;   << a whole word of the value to  >>           31746000
                          << set the bits to. i.e. all     >>           31748000
                          << ones if set'bits = TRUE else  >>           31750000
                          << all zeros if set'bits = FALSE >>           31752000
                                                                        31754000
   LOGICAL test'pattern;  << inverse of set'pattern, used  >>           31756000
                          << to test if the bits are in    >>           31758000
                          << the correct state before      >>           31760000
                          << changing.                     >>           31762000
                                                                        31764000
   LOGICAL current'word;                                                31766000
   LOGICAL mask;          << for masking out partial words >>           31768000
   INTEGER bits'in'word;  << bits to set/reset in current word >>       31770000
                                                                        31772000
   << - - - - - - - - - - >>                                            31774000
                                                                        31776000
   << Do some error checking >>                                         31778000
                                                                        31780000
   IF NOT(0 <= ldev'index <= max'disc'drives - 1) THEN                  31782000
      ERRMESSAGE (M325,2);                                     <<03632>>31784000
   IF NOT(0 <= page'number <= last'page'of'map (ldev'index)) THEN       31786000
      ERRMESSAGE (M325,3);                                     <<03632>>31788000
   IF NOT(0 <= word'number <= words'per'page - 1) THEN                  31790000
      ERRMESSAGE (M325,4);                                     <<03632>>31792000
   IF NOT(0 <= bit'number <= bits'per'word - 1) THEN                    31794000
      ERRMESSAGE (M325,5);                                     <<03632>>31796000
                                                                        31798000
                                                                        31800000
   cc := cce;   << Preset o.k. status >>                                31802000
                                                                        31804000
                                                                        31806000
   << Assign patterns for test and changing bits according to           31808000
      whether this a a call to allocate or deallocate space.  >>        31810000
                                                                        31812000
   IF number'of'bits <= 0D THEN RETURN;                        <<RETSP>>31814000
   set'pattern := IF set'bits THEN %177777 ELSE 0;                      31816000
   test'pattern := NOT set'pattern;                                     31818000
                                                                        31820000
                                                                        31822000
   << scan through map, until all bits have been set/reset >>           31824000
                                                                        31826000
   WHILE page'number <= last'page'of'map (ldev'index) DO                31828000
      BEGIN  << scan map >>                                             31830000
                                                                        31832000
         << Read page into buffer >>                                    31834000
                                                                        31836000
         Get'Page (ldev'index, page'number);                            31838000
                                                                        31840000
         IF <> THEN                                                     31842000
            BEGIN  << error getting page >>                             31844000
                                                                        31846000
               << If we are returning space, then the error             31848000
                  doesn't matter, we can just skip this page.           31850000
                  IF getting space, the we must exit the procedure      31852000
                  and allow calling routines to handle the error >>     31854000
                                                                        31856000
               IF set'bits THEN                                         31858000
                  BEGIN  << returning space >>                          31860000
                                                                        31862000
                     number'of'bits := number'of'bits -                 31864000
                           DBL(bits'per'page);                          31866000
                     IF number'of'bits <= 0D THEN                       31868000
                         RETURN;                                        31870000
                                                                        31872000
                  END    << returning space >>                          31874000
               ELSE                                                     31876000
                                                                        31878000
                  BEGIN  << Getting space >>                            31880000
                                                                        31882000
                     cc := ccl;  << Return error status >>              31884000
                     RETURN;                                            31886000
                                                                        31888000
                  END    << Getting space >>                            31890000
                                                                        31892000
            END    << error getting page >>                             31894000
         ELSE                                                           31896000
            BEGIN  << No error >>                                       31898000
                                                                        31900000
               WHILE word'number < words'per'page DO                    31902000
                  BEGIN << scan page >>                                 31904000
                                                                        31906000
                     current'word := ds'page'ptr (word'number);         31908000
                                                                        31910000
                     << build mask for current word >>                  31912000
                                                                        31914000
                     mask := %100000;                                   31916000
                                                                        31918000
                     IF number'of'bits < DBL(16 - bit'number) THEN      31920000
                                                                        31922000
                        << all bits needed are in current word >>       31924000
                                                                        31926000
                        bits'in'word := INTEGER(number'of'bits) - 1     31928000
                                                                        31930000
                     ELSE                                               31932000
                                                                        31934000
                        << All bits not in current word >>              31936000
                                                                        31938000
                        bits'in'word := 15 - bit'number;                31940000
                                                                        31942000
                                                                        31944000
                     << Build mask for this word. >>                    31946000
                                                                        31948000
                     TOS := mask&ASR(bits'in'word);                     31950000
                     mask := TOS&LSR(bit'number);                       31952000
                                                                        31954000
                                                                        31956000
                     << Test if bits are currently in expected          31958000
                        state.                                 >>       31960000
                                                                        31962000
                     IF NOT ((current'word LAND mask) =                 31964000
                     (test'pattern LAND mask)) THEN                     31966000
                        BEGIN  << Bits not in correct state >>          31968000
                                                                        31970000
                           IF (set'bits LAND                   <<04841>>31972000
                               NOT ((current'word LAND mask)   <<04841>>31974000
                                   = (set'pattern LAND mask))) <<04841>>31976000
                           OR NOT set'bits THEN                <<04841>>31978000
                                                               <<04841>>31980000
                           << if releasing space that was   >> <<04841>>31982000
                           << already PARTIALLY released,   >> <<04841>>31984000
                           << or if getting space that has  >> <<04841>>31986000
                           << already been taken, then HALT >> <<04841>>31988000
                                                               <<04841>>31990000
                              ERRMESSAGE (M325,6);             <<04841>>31992000
                                                                        31994000
                                                                        31996000
                        END;   << Bits not in correct state >>          31998000
                                                                        32000000
                     << if we are returning space that was   >><<04841>>32002000
                     << already COMPLETELY released (ie. a   >><<04841>>32004000
                     << contiguous block), we ignore this    >><<04841>>32006000
                     << situation above and proceed normally >><<04841>>32008000
                                                                        32010000
                     << Set or reset bits in the word. >>               32012000
                                                                        32014000
                     ds'page'ptr(word'number) :=                        32016000
                           (set'pattern LAND mask) LOR                  32018000
                           (current'word LAND NOT mask);                32020000
                                                                        32022000
                     number'of'bits := number'of'bits -                 32024000
                           DBL(bits'in'word + 1);                       32026000
                                                                        32028000
                     << Exit procedure if all bits are set/reset. >>    32030000
                                                                        32032000
                     IF number'of'bits < 0D THEN   << Error check >>    32034000
                        ERRMESSAGE (M325,7);                   <<03632>>32036000
                                                                        32038000
                     IF number'of'bits = 0D THEN                        32040000
                        BEGIN << All done >>                            32042000
                                                                        32044000
                           Write'Page;                                  32046000
                                                                        32048000
                           RETURN;                                      32050000
                                                                        32052000
                        END;   << All done >>                           32054000
                                                                        32056000
                     word'number := word'number + 1;                    32058000
                     bit'number := 0;                                   32060000
                                                                        32062000
                  END;  << scan page >>                                 32064000
                                                                        32066000
                                                                        32068000
               << Write out page >>                                     32070000
                                                                        32072000
               Write'Page;                                              32074000
                                                                        32076000
               page'number := page'number + 1;                          32078000
                                                                        32080000
               word'number := 0;                                        32082000
               bit'number := 0;                                         32084000
                                                                        32086000
            END;   << not I/O error >>                                  32088000
                                                                        32090000
      END;  << scan map >>                                              32092000
                                                                        32094000
                                                                        32096000
   << We should never make it here >>                                   32098000
                                                                        32100000
   ERRMESSAGE (M325,8);                                        <<03632>>32102000
                                                                        32104000
END;  << Set'Reset'Bit'Map >>                                           32106000
$PAGE "ACCESS'DFS'MAP"                                                  32108000
INTEGER PROCEDURE Access'Dfs'Map (ldev);                       <<03551>>32110000
   VALUE ldev;                                                          32112000
   INTEGER ldev;                                                        32114000
                                                                        32116000
<<==============================================================        32118000
                                                                        32120000
      This procedure is use to gain access to the free space            32122000
   map for a particular disc ldev.  It will return an                   32124000
   "ldev-index" , which is use to get the entrys from the               32126000
   various arrays for this ldev. First the                              32128000
   "ldev'index'to'ldev" table is scaned to see if the ldev's            32130000
   free space map has previously been accessed, if the ldev             32132000
   is found, then "dfs'map'problems" is checked to see if the           32134000
   map is o.k. If it is alright, the index is returned and              32136000
   the condition code is set to CCE, if it has been damaged,            32138000
   a condition coide of CCL is returned.                                32140000
                                                                        32142000
      If the map for this ldev has not been previously ac-              32144000
   cessed, then an entry is made in the "ldev'index'to'ldev"            32146000
   table and the disc label is gotten.  The various array               32148000
   entries associated with the map are initialized. A check             32150000
   is made to see if this is a old free space map format                32152000
   pack, if it is, a message is sent to the console and                 32154000
   INITIAL is halted.  The disc label is also checked to see            32156000
   if the map has been flaged as damaged, if it has a non-              32158000
   fatal message is sent to the operator, "dfs'map'problems"            32160000
   entry for the ldev is marked  and the procedure returns a            32162000
   condition code of CCL. The descriptor table is flaged as             32164000
   dirty in the disc label, so that the descriptor table will           32166000
   be rebuilt when the system comes up.    If the map was ok,           32168000
   then the descriptor table is scanned to see if there are             32170000
   any bad pages.  If there are, then "dfs'map'problems" is             32172000
   set to indicate the fact that the descriptor table will              32174000
   have to be checked each time a page is read.  The pro-               32176000
   cedure then returns the index for the ldev and a condition           32178000
   code of CCE.                                                         32180000
                                                                        32182000
                                                                        32184000
   Parameters:                                                          32186000
      ldev - logical device number of disc drive.                       32188000
                                                                        32190000
   Returns:                                                             32192000
         Index for the ldev, this is used to access the entry           32194000
      for this ldev in the various arrays associated with               32196000
      disc free space management.                                       32198000
                                                                        32200000
      condition code = CCE if alls ok,                                  32202000
                       CCL if the bit map has been flaged as            32204000
                       damaged and space can not be                     32206000
                       allocated.                                       32208000
                                                                        32210000
   Assumptions on entry:                                                32212000
      DB must be at the stack.                                          32214000
                                                                        32216000
   Exit conditions:                                                     32218000
      DB is unchanged.                                                  32220000
                                                                        32222000
   Globals:                                                             32224000
                                                                        32226000
      Input:                                                            32228000
         ldev'index'to'ldev - an entry may be added.                    32230000
                                                                        32232000
      Output:                                                           32234000
         dfs'map'problems                                               32236000
         bit'map'disc'address                                           32238000
         disc'size                                                      32240000
         last'page'of'map                                               32242000
         dt'disc'address                                                32244000
         first'page'with'space                                          32246000
         size'of'last'allocation                                        32248000
                                                                        32250000
      Others:                                                           32252000
         dtt                                                            32254000
         lpdt                                                           32256000
                                                                        32258000
      Equates:                                                          32260000
         max'disc'drives                                                32262000
         m331                                                           32264000
         m332                                                           32266000
         m325                                                           32268000
         lpdtsize                                                       32270000
         lpdt1                                                          32272000
         sector'size                                                    32274000
         disc'lab'dfs'map'ok {INCDISC1}                                 32276000
         disc'lab'dirty'dt'flag {INCDISC1}                              32278000
                                                                        32280000
     Defines:                                                           32282000
        nsdv                                                            32284000
        disc'label'address {INCDISC1}                                   32286000
                                                                        32288000
   Externals:                                                           32290000
      Get'Disc'Info                                                     32292000
      Errmessage                                                        32294000
      Message                                                           32296000
      Disc                                                              32298000
      Check'Dt'Entry                                                    32300000
                                                                        32302000
   Intrinsics:                                                          32304000
      None.                                                             32306000
                                                                        32308000
   Callers:                                                             32310000
      Get'Disc'Space                                                    32312000
      Return'Disc'Space                                                 32314000
      Get'Specific'Disc'Space                                           32316000
      Init'Disc'Free'Space'Map                                          32318000
                                                                        32320000
   Fix ID:                                                              32322000
         This procedure was added as part of the new disc               32324000
      free space map changes.  The fix number on the                    32326000
      procedure header applies to the whole procedure.                  32328000
                                                                        32330000
   Changes:                                                             32332000
                                                                        32334000
                                                                        32336000
==============================================================>>        32338000
                                                                        32340000
BEGIN                                                                   32342000
                                                                        32344000
   INTEGER index;                                                       32346000
   INTEGER empty'entry;                                                 32348000
   INTEGER page;                                                        32350000
   INTEGER LPDT'INDEX;                                         <<*LPDT>>32352000
   LOGICAL found;                                                       32354000
                                                                        32356000
   ARRAY disc'label (0:sector'size-1);                                  32358000
                                                                        32360000
   INTEGER return'value = Access'Dfs'Map;                               32362000
                                                                        32364000
$INCLUDE INCDISC1                                                       32366000
                                                                        32368000
   << - - - - - - - - - - >>                                            32370000
                                                                        32372000
   << Make sure that the disc is in the system domain, if it is         32374000
      not, HALT with a nasty message.                            >>     32376000
                                                                        32378000
   LPDT'INDEX := LDEV * LPDTSIZE;                              <<*LPDT>>32380000
   IF LOGICAL(LPDT'NON'SYS'DOMAIN) THEN                        <<*LPDT>>32382000
      ERRMESSAGE (M325,9);                                     <<03632>>32384000
                                                                        32386000
   << Scan "ldev'index'to'ldev" table to see if the free space map      32388000
      has already been accessed.                                  >>    32390000
                                                                        32392000
   index := 0;                                                          32394000
   empty'entry := -1;                                                   32396000
   found := FALSE;                                                      32398000
                                                                        32400000
   WHILE (index < max'disc'drives) AND NOT found DO                     32402000
      BEGIN  << Scan for ldev >>                                        32404000
                                                                        32406000
         IF ldev'index'to'ldev (index) = ldev THEN                      32408000
            found := TRUE                                               32410000
         ELSE                                                           32412000
            BEGIN  << Not the ldev we are looking for >>                32414000
                                                                        32416000
               IF ldev'index'to'ldev (index) < 0 AND                    32418000
               empty'entry < 0 THEN                                     32420000
                  empty'entry := index;                                 32422000
                                                                        32424000
               index := index + 1;                                      32426000
                                                                        32428000
            END;   << Not the ldev we are looking for >>                32430000
                                                                        32432000
                                                                        32434000
      END;   << Scan for ldev >>                                        32436000
                                                                        32438000
   << If found is TRUE then the ldev is in the table and index is       32440000
      the dfs'index for the ldev, otherwise index is the index of       32442000
      the next empty entry.                                        >>   32444000
                                                                        32446000
    IF found THEN                                                       32448000
       BEGIN  << Has been previously accessed >>                        32450000
                                                                        32452000
          << Check to see that the map was ok >>                        32454000
                                                                        32456000
           IF dfs'map'problems (index) >= 0 THEN                        32458000
              BEGIN  << Map ok >>                                       32460000
                                                                        32462000
                 return'value := index;                                 32464000
                 cc := cce;                                             32466000
                                                                        32468000
              END    << Map ok >>                                       32470000
          ELSE                                                          32472000
                                                                        32474000
             << Map is not ok >>                                        32476000
                                                                        32478000
             cc := ccl;                                                 32480000
                                                                        32482000
       END    << Has been previously accessed >>                        32484000
    ELSE                                                                32486000
       BEGIN  << First access >>                                        32488000
                                                                        32490000
          index := empty'entry;                                         32492000
          ldev'index'to'ldev (index) := ldev;                           32494000
                                                                        32496000
          << Retrieve a whole shitload of info about the disc,          32498000
             including the disc label.                         >>       32500000
                                                                        32502000
          Get'Disc'Info (ldev, disc'label, TRUE, dtt,  ,  ,             32504000
                disc'size (index), bit'map'disc'address (index),        32506000
                last'page'of'map (index), dt'disc'address (index));     32508000
                                                                        32510000
          last'page'of'map (index) := last'page'of'map (index) - 1;     32512000
                                                                        32514000
                                                                        32516000
          << Check to see if this is an old format system disc,         32518000
             if so, halt with nasty message.                    >>      32520000
                                                                        32522000
          IF bit'map'disc'address (index) = 0D OR                       32524000
          dt'disc'address (index) = 0D THEN                             32526000
             Errmessage (m331, ldev);                                   32528000
                                                                        32530000
          << Check if bit map has been flaged as bad, if it has         32532000
             remember it and return, if its ok remember that            32534000
             fact.                                               >>     32536000
                                                                        32538000
          IF NOT disc'label (disc'lab'dfs'map'ok) THEN                  32540000
             BEGIN  << Map is damaged >>                                32542000
                                                                        32544000
                Message (m332, ldev);                                   32546000
                                                                        32548000
                dfs'map'problems (index) := -1;                         32550000
                                                                        32552000
                cc := ccl;                                              32554000
                RETURN;                                                 32556000
                                                                        32558000
             END    << Map is damaged >>                                32560000
                                                                        32562000
          ELSE                                                          32564000
                                                                        32566000
             << Map ok >>                                               32568000
                                                                        32570000
             dfs'map'problems (index) := 0;                             32572000
                                                                        32574000
          << Flag descriptor table as dirty >>                          32576000
                                                                        32578000
          disc'label (disc'lab'dirty'dt'flag) := TRUE;                  32580000
                                                                        32582000
          Disc (1, ldev, disc'label'address, disc'label, sector'size);  32584000
                                                                        32586000
                                                                        32588000
         << Scan descriptor table to see if there are any               32590000
            bad pages.  If they are, we will have to look               32592000
            at the descriptor table every time we get a page. >>        32594000
                                                                        32596000
         dfs'map'problems (index) := 0;                                 32598000
         page := 0;                                                     32600000
                                                                        32602000
         WHILE (page <= last'page'of'map) AND                           32604000
         dfs'map'problems (index) = 0 DO                                32606000
            BEGIN  << Check for any bad pages >>                        32608000
                                                                        32610000
               IF NOT Check'Dt'Entry (index, page) THEN                 32612000
                  dfs'map'problems (index) := 1;                        32614000
                                                                        32616000
               page := page + 1;                                        32618000
                                                                        32620000
            END;   << Check for any bad pages >>                        32622000
                                                                        32624000
                                                                        32626000
                                                                        32628000
          << Init indicators that are used help find space >>           32630000
                                                                        32632000
          first'page'with'space (index) := -1;  << Only for reload >>   32634000
          size'of'last'allocation (index) := disc'size (index);         32636000
                                                                        32638000
          cc := cce;                                                    32640000
          return'value := index;                                        32642000
                                                                        32644000
       END;   << First access >>                                        32646000
                                                                        32648000
END;  << Access'Dfs'Map >>                                              32650000
$PAGE "GET'DISC'SPACE"                                                  32652000
INTEGER PROCEDURE Get'Disc'Space (ldev, number'of'sectors,     <<03551>>32654000
                                  disc'address);                        32656000
   VALUE ldev, number'of'sectors;                                       32658000
   INTEGER ldev;                                                        32660000
   DOUBLE number'of'sectors;                                            32662000
   DOUBLE disc'address;                                                 32664000
   OPTION PRIVILEGED;                                                   32666000
                                                                        32668000
COMMENT =======================================================<<03765>>32670000
                                                                        32672000
      This procedure allocates space on a system disc.  First           32674000
   the free space map for that disc is "accessed" via                   32676000
   Access'Dfs'Map. The map is then scanned until the re-                32678000
   quested space is found or the end of the map is reached.             32680000
   The page of the map to start the scan with is decided on             32682000
   by a couple of indicators.  If the size being requested     <<03765>>32684000
   is greater than the size of the last space                  <<03765>>32686000
   allocated or returned on this disc, then the search is      <<03765>>32688000
   started on the last page we allocated space from.  Otherwise<<03765>>32690000
   if "first'page'with'space" is greater or equal to 0, then it<<03765>>32692000
   indicates the first page which has any space on it. (This   <<03765>>32694000
   indicator is only used for reloads, and is only good if     <<03765>>32696000
   space has not been allocated in a specific place.)  If      <<03765>>32698000
   neither of these indicators                                 <<03765>>32700000
   prove usefull, then the search starts at page zero.  If              32702000
   space is found, then "Set'Reset'Bit'Map" is called to re-            32704000
   move it from the map.                                                32706000
                                                                        32708000
   Parameters:                                                          32710000
      ldev - logical device number of disc drive.                       32712000
      number'of'sectors - number of sectors to allocate.                32714000
      disc'address - for the return of disc sector address if           32716000
                     space is found.                                    32718000
                                                                        32720000
   Returns:                                                             32722000
      0 = o.k., space allocated.                                        32724000
      1 = No space available.                                           32726000
      2 = Error from Set'Reset'Bit'Map.                                 32728000
      3 = Free space map can not be accessed.                           32730000
                                                                        32732000
   Assumptions on entry:                                                32734000
      DB is at the free space data segment for the ldev and             32736000
      the data segment is locked.                                       32738000
                                                                        32740000
   Exit conditions:                                                     32742000
      DB is unchanged.                                                  32744000
                                                                        32746000
   Globals:                                                             32748000
                                                                        32750000
      Input:                                                            32752000
         first'page'with'space - may be altered.                        32754000
         size'of'last'allocation - may be altered.                      32756000
         last'page'allocated'from - may be altered.                     32758000
                                                                        32760000
      Others:                                                           32762000
         ds'word'number - changed.                                      32764000
         ds'bit'number - changed.                                       32766000
         ds'starting'word'number - changed.                             32768000
         ds'starting'bit'number - changed.                              32770000
         ds'bit'count - changed.                                        32772000
         last'page'of'map                                               32774000
                                                                        32776000
   Externals:                                                           32778000
      Access'Dfs'Map                                                    32780000
      Get'Page                                                          32782000
      Scan'Page                                                         32784000
      Set'Reset'Bit'Map                                                 32786000
      Convert'Map'To'Address                                            32788000
                                                                        32790000
   Intrinsics:                                                          32792000
      None.                                                             32794000
                                                                        32796000
   Callers:                                                             32798000
      Getdiscspace                                                      32800000
      Superdiscspace                                                    32802000
                                                                        32804000
   Fix ID:                                                              32806000
         This procedure was added as part of the new disc               32808000
      free space map changes.  The fix number on the                    32810000
      procedure header applies to the whole procedure.                  32812000
                                                                        32814000
   Changes:                                                             32816000
      Change made to alogorithm that decides which page to     <<03765>>32818000
   start looking for space on.  Very slow reloads prompted     <<03765>>32820000
   this change.  The real cause of slow reloads was that the   <<03765>>32822000
   index into the array first'page'with'space was accidently   <<03765>>32824000
   omitted  when resetting the indicators at the end of this   <<03765>>32826000
   procedure.                                                  <<03765>>32828000
                                                                        32830000
==============================================================;<<03765>>32832000
                                                                        32834000
BEGIN                                                                   32836000
                                                                        32838000
   DOUBLE continuous'space;                                             32840000
   LOGICAL found;                                                       32842000
   LOGICAL end'of'page;                                                 32844000
   INTEGER starting'page'number;                                        32846000
   INTEGER starting'word'number;                                        32848000
   INTEGER starting'bit'number;                                         32850000
   INTEGER ldev'index;                                                  32852000
                                                                        32854000
   INTEGER return'value = Get'Disc'Space;                               32856000
                                                                        32858000
   << - - - - - - - - - - >>                                            32860000
                                                                        32862000
                                                                        32864000
   << First access map, setting all important globals >>                32866000
                                                                        32868000
   ldev'index := Access'Dfs'Map (ldev);                                 32870000
                                                                        32872000
   IF <> THEN                                                           32874000
      BEGIN  << Can not access this map >>                              32876000
                                                                        32878000
         return'value := 3;                                             32880000
         RETURN;                                                        32882000
                                                                        32884000
      END;   << Can not access this map >>                              32886000
                                                                        32888000
COMMENT:                                                       <<03765>>32890000
      Decide which page to start looking for space on.  Use    <<03765>>32892000
      last'page'allocated'from if number'of'sectors >=         <<03765>>32894000
      size'of'last'allocation, otherwise use                   <<03765>>32896000
      first'page'with'space if it is >= 0, otherwise start at  <<03765>>32898000
      first page of map.                                       <<03765>>32900000
      ;                                                        <<03765>>32902000
                                                                        32904000
   ds'word'number := 0;                                                 32906000
   ds'bit'number := 0;                                                  32908000
                                                                        32910000
   IF number'of'sectors >= size'of'last'allocation (ldev'index)<<03765>>32912000
   THEN                                                        <<03765>>32914000
      ds'page'number := last'page'allocated'from (ldev'index)  <<03765>>32916000
   ELSE                                                        <<03765>>32918000
      IF first'page'with'space (ldev'index) >= 0               <<03765>>32920000
      THEN                                                     <<03765>>32922000
         ds'page'number := first'page'with'space (ldev'index)  <<03765>>32924000
      ELSE                                                     <<03765>>32926000
         ds'page'number := 0;                                  <<03765>>32928000
                                                                        32930000
   << Look for space >>                                                 32932000
                                                                        32934000
   continuous'space := 0D;                                              32936000
   found := FALSE;                                                      32938000
                                                                        32940000
   WHILE ds'page'number <= last'page'of'map (ldev'index) AND            32942000
   NOT found DO                                                         32944000
      BEGIN  << Scan map >>                                             32946000
                                                                        32948000
         Get'Page (ldev'index, ds'page'number);                         32950000
                                                                        32952000
         IF <> THEN                                                     32954000
                                                                        32956000
            << Can't get page, reset counter >>                         32958000
                                                                        32960000
            continuous'space := 0D                                      32962000
                                                                        32964000
         ELSE                                                           32966000
            BEGIN   << Got page >>                                      32968000
                                                                        32970000
               << Scan the page >>                                      32972000
                                                                        32974000
               DO                                                       32976000
                  BEGIN  << Scan page >>                                32978000
                                                                        32980000
                     end'of'page := Scan'Page;                          32982000
                                                                        32984000
                     IF continuous'space = 0D OR               <<04396>>32986000
                        ds'starting'word'number > 0 OR         <<04396>>32988000
                        ds'starting'bit'number > 0  THEN       <<04396>>32990000
                        BEGIN  << Start of a block >>                   32992000
                                                                        32994000
                           starting'page'number := ds'page'number;      32996000
                           starting'word'number :=                      32998000
                                 ds'starting'word'number;               33000000
                           starting'bit'number :=                       33002000
                                 ds'starting'bit'number;                33004000
                           continuous'space := 0D;             <<04396>>33006000
                                                                        33008000
                        END;   << Start of a block >>                   33010000
                                                                        33012000
                     continuous'space := continuous'space +             33014000
                           DOUBLE(ds'bit'count);                        33016000
                                                                        33018000
                     IF continuous'space >= number'of'sectors THEN      33020000
                        found := TRUE                                   33022000
                     ELSE                                               33024000
                        IF NOT end'of'page OR (end'of'page LAND         33026000
                        ds'bit'count = 0) THEN                          33028000
                                                                        33030000
                           << End of a block >>                         33032000
                                                                        33034000
                           continuous'space := 0D;                      33036000
                                                                        33038000
                  END   << Scan page >>                                 33040000
                                                                        33042000
               UNTIL found OR end'of'page;                              33044000
                                                                        33046000
            END;    << Got page >>                                      33048000
                                                                        33050000
         << Go on to next page >>                                       33052000
                                                                        33054000
         ds'page'number := ds'page'number + 1;                          33056000
         ds'word'number := 0;                                           33058000
         ds'bit'number := 0;                                            33060000
                                                                        33062000
      END;   << Scan map >>                                             33064000
                                                                        33066000
                                                                        33068000
   << At this point, if found is TRUE we have space >>                  33070000
                                                                        33072000
   IF NOT found THEN                                                    33074000
      return'value := 1  << No space available >>                       33076000
                                                                        33078000
   ELSE                                                                 33080000
      BEGIN  << Found space >>                                          33082000
                                                                        33084000
         << Mark in bit map >>                                          33086000
                                                                        33088000
         Set'Reset'Bit'Map (ldev'index, starting'page'number,           33090000
               starting'word'number, starting'bit'number,               33092000
               number'of'sectors, FALSE);                               33094000
                                                                        33096000
         IF <> THEN                                                     33098000
            << Error >>                                                 33100000
            return'value := 2                                           33102000
         ELSE                                                           33104000
            BEGIN  << ok >>                                             33106000
                                                                        33108000
               << Convert bit map address to sector address and         33110000
                  return to caller.                             >>      33112000
                                                                        33114000
               ds'page'number := starting'page'number;                  33116000
               ds'word'number := starting'word'number;                  33118000
               ds'bit'number := starting'bit'number;                    33120000
                                                                        33122000
               disc'address := Convert'Map'To'Address;                  33124000
                                                                        33126000
                                                                        33128000
               << Reset indicators >>                                   33130000
                                                                        33132000
               IF first'page'with'space (ldev'index) >= 0 THEN          33134000
FIRST'PAGE'WITH'SPACE(LDEV'INDEX):=DS'PAGE'NUMBER;             <<03765>>33136000
                                                                        33138000
               last'page'allocated'from (ldev'index) :=                 33140000
                     ds'page'number;                                    33142000
               size'of'last'allocation (ldev'index) :=                  33144000
                     number'of'sectors;                                 33146000
                                                                        33148000
               << Return got-it status >>                               33150000
                                                                        33152000
               return'value := 0;                                       33154000
                                                                        33156000
            END;   << ok >>                                             33158000
                                                                        33160000
      END;   << Found space >>                                          33162000
                                                                        33164000
END;  << Get'Disc'Space >>                                              33166000
$PAGE "RETURN'DISC'SPACE"                                               33168000
PROCEDURE Return'Disc'Space (ldev, disc'address,               <<03551>>33170000
                             number'of'sectors);                        33172000
   VALUE ldev, disc'address, number'of'sectors;                         33174000
   INTEGER ldev;                                                        33176000
   DOUBLE disc'address, number'of'sectors;                              33178000
                                                                        33180000
COMMENT =======================================================<<03776>>33182000
                                                                        33184000
      This procedure deallocates disc space and returnes it             33186000
   to the free space pool.  If any error occures, or the map            33188000
   can not be accessed, then the procedure just returns,                33190000
   looking as if it work.  The indicators used to help find             33192000
   space, "size'of'last'allocation" & "first'page'with'space"           33194000
   are ajusted if necessary and "Set'Reset'Bit'Map" is called           33196000
   to mark the space as free.                                           33198000
                                                                        33200000
   Parameters:                                                          33202000
      ldev - Logical device number of disc drive.                       33204000
      disc'address - First sector address of space to return.           33206000
      number'of'sectors - Number of sectors to return.                  33208000
                                                                        33210000
   Assumptions on entry:                                                33212000
      DB must be at the stack.                                          33214000
                                                                        33216000
   Exit conditions:                                                     33218000
      DB is unchanged.                                                  33220000
                                                                        33222000
                                                                        33224000
   Globals:                                                             33226000
                                                                        33228000
      Output:                                                           33230000
         size'of'last'allocation                                        33232000
         last'page'allocated'from                                       33234000
         first'page'with'space                                          33236000
                                                                        33238000
      Others:                                                           33240000
         ds'disc'address - altered.                                     33242000
         ds'page'number - altered.                                      33244000
         ds'word'number - altered.                                      33246000
         ds'bit'number - altered.                                       33248000
                                                                        33250000
   Externals:                                                           33252000
      Access'Dfs'Map                                                    33254000
      Convert'Address'To'Map                                            33256000
      Set'Reset'Bit'Map                                                 33258000
                                                                        33260000
   Intrinsics:                                                          33262000
      None.                                                             33264000
                                                                        33266000
   Callers:                                                             33268000
      Init'Disc'Free'Space'Map                                          33270000
      Retdiscspace                                                      33272000
      Vdevreplaced                                                      33274000
      Deletevdev                                                        33276000
      Mainseg2                                                          33278000
      Mainseg4                                                          33280000
                                                                        33282000
   Fix ID:                                                              33284000
         This procedure was added as part of the new disc               33286000
      free space map changes.  The fix number on the                    33288000
      procedure header applies to the whole procedure.                  33290000
                                                                        33292000
   Changes:                                                             33294000
         Made a fix so that the disc address used in "Convert' <<03776>>33296000
      Address'to'Map does not contain the vol number when      <<03776>>33298000
      calculating bit map addresses. (SR #28947)               <<03776>>33300000
==============================================================;<<03776>>33302000
                                                                        33304000
BEGIN                                                                   33306000
                                                                        33308000
   INTEGER ldev'index;                                                  33310000
   BYTE voln = disc'address;<<upper 8 bits contain vol num >>  <<03776>>33312000
                                                                        33314000
   << - - - - - - - - - - >>                                            33316000
                                                                        33318000
   ldev'index := Access'Dfs'Map (ldev);                                 33320000
   voln := 0; <<zero out vol num to correctly calc addresses>> <<03776>>33322000
                                                                        33324000
   IF <> THEN                                                           33326000
                                                                        33328000
      << Can't access, just return >>                                   33330000
                                                                        33332000
      RETURN;                                                           33334000
                                                                        33336000
   ds'disc'address := disc'address;                                     33338000
                                                                        33340000
   Convert'Address'To'Map;                                              33342000
                                                                        33344000
   << Before returning space, we must reset size of last allocation     33346000
      indicator and first page with space.                         >>   33348000
                                                                        33350000
   IF (number'of'sectors >= size'of'last'allocation (ldev'index)) AND   33352000
   (ds'page'number < last'page'allocated'from (ldev'index)) THEN        33354000
      BEGIN  << Reset last allocation indicator >>                      33356000
                                                                        33358000
         size'of'last'allocation (ldev'index) := number'of'sectors;     33360000
         last'page'allocated'from (ldev'index) := ds'page'number;       33362000
                                                                        33364000
      END;   << Reset last allocation indicator >>                      33366000
                                                                        33368000
   IF first'page'with'space (ldev'index) >= 0 AND                       33370000
   first'page'with'space (ldev'index) > ds'page'number THEN             33372000
      first'page'with'space (ldev'index) := ds'page'number;             33374000
                                                                        33376000
                                                                        33378000
   << Mark as free >>                                                   33380000
                                                                        33382000
   Set'Reset'Bit'Map (ldev'index, ds'page'number, ds'word'number,       33384000
       ds'bit'number, number'of'sectors, TRUE);                         33386000
                                                                        33388000
END;   << Return'Disc'Space >>                                          33390000
$PAGE "GET'SPECIFIC'DISC'SPACE"                                         33392000
INTEGER PROCEDURE Get'Specific'Disc'Space (ldev, disc'address, <<03551>>33394000
                                           number'of'sectors);          33396000
   VALUE ldev, disc'address, number'of'sectors;                         33398000
   INTEGER ldev;                                                        33400000
   DOUBLE disc'address, number'of'sectors;                              33402000
                                                                        33404000
<<==============================================================        33406000
                                                                        33408000
      This procedure allocates disc space in a specific place           33410000
   on a given ldev. After accessing the map, the specified              33412000
   area of the map is checked to see if the space is really             33414000
   free, if it is the space is then deleted from the map.               33416000
   The indicators "size'of'last'allcoation" and                         33418000
   "first'page'with'space" are reset, as they are nolonger              33420000
   meaningful after this allocation.                                    33422000
                                                                        33424000
   Parameters:                                                          33426000
      ldev - Logical device number of the disc drive.                   33428000
      disc'address - First sector address of the space                  33430000
                     desired.                                           33432000
      number'of'sectors - Number of sectors desired.                    33434000
                                                                        33436000
   Returns:                                                             33438000
      0 - Got the space.                                                33440000
      1 - Space not available.                                          33442000
      2 - Error from "Get'Page" or "Set'Reset'Bit'Map"                  33444000
      3 - Can't access map.                                             33446000
                                                                        33448000
   Assumptions on entry:                                                33450000
      DB is at the stack.                                               33452000
                                                                        33454000
   Exit conditions:                                                     33456000
      DB is unchanged.                                                  33458000
                                                                        33460000
   Globals:                                                             33462000
                                                                        33464000
      Output:                                                           33466000
         size'of'last'allcoation                                        33468000
         first'page'with'space                                          33470000
                                                                        33472000
      Others:                                                           33474000
         ds'disc'address - altered.                                     33476000
         ds'page'number - altered.                                      33478000
         ds'word'number - altered.                                      33480000
         ds'bit'number - altered.                                       33482000
         ds'bit'count - altered.                                        33484000
         ds'starting'word'number - altered.                             33486000
         ds'starting'bit'number - altered.                              33488000
         disc'size                                                      33490000
                                                                        33492000
   Externals:                                                           33494000
      Access'Dfs'Map                                                    33496000
      Convert'Address'To'Map                                            33498000
      Get'Page                                                          33500000
      Scan'Page                                                         33502000
      Set'Reset'Bit'Map                                                 33504000
                                                                        33506000
   Intrinsics:                                                          33508000
      None.                                                             33510000
                                                                        33512000
   Callers:                                                             33514000
      Init'Disc'Free'Space'Map                                          33516000
      Remdiscspace                                                      33518000
      Vdevreplace                                                       33520000
      Mainseg4                                                          33522000
                                                                        33524000
   Fix ID:                                                              33526000
         This procedure was added as part of the new disc               33528000
      free space map changes.  The fix number on the                    33530000
      procedure header applies to the whole procedure.                  33532000
                                                                        33534000
   Changes:                                                             33536000
                                                                        33538000
                                                                        33540000
==============================================================>>        33542000
                                                                        33544000
BEGIN                                                                   33546000
                                                                        33548000
   LOGICAL done;                                                        33550000
   LOGICAL end'of'page;                                                 33552000
   INTEGER ldev'index;                                                  33554000
   DOUBLE sector'count;                                                 33556000
                                                                        33558000
   INTEGER starting'page'number;                                        33560000
   INTEGER starting'word'number;                                        33562000
   INTEGER starting'bit'number;                                         33564000
                                                                        33566000
   INTEGER return'value = Get'Specific'Disc'Space;                      33568000
                                                                        33570000
   << - - - - - - - - - - >>                                            33572000
                                                                        33574000
   ldev'index := Access'Dfs'map (ldev);                                 33576000
                                                                        33578000
   IF <> THEN                                                           33580000
      BEGIN  << Free space disabled >>                                  33582000
                                                                        33584000
         return'value := 3;                                             33586000
         RETURN;                                                        33588000
                                                                        33590000
      END;   << Free space disabled >>                                  33592000
                                                                        33594000
                                                                        33596000
   sector'count := 0D;  << Used for counting available sectors >>       33598000
                                                                        33600000
   << Convert sector address to map address >>                          33602000
                                                                        33604000
   ds'disc'address := disc'address;                                     33606000
                                                                        33608000
   Convert'Address'To'Map;                                              33610000
                                                                        33612000
   << Remember where space starts >>                                    33614000
                                                                        33616000
   starting'page'number := ds'page'number;                              33618000
   starting'word'number := ds'word'number;                              33620000
   starting'bit'number := ds'bit'number;                                33622000
                                                                        33624000
   done := FALSE;   << Flag to indicate no more searching >>            33626000
                                                                        33628000
                                                                        33630000
   << Scan to see if space is all free >>                               33632000
                                                                        33634000
   WHILE NOT done DO                                                    33636000
      BEGIN  << Scan for space >>                                       33638000
                                                                        33640000
         << Get page into a buffer >>                                   33642000
                                                                        33644000
         Get'Page (ldev'index, ds'page'number);                         33646000
                                                                        33648000
         IF <> THEN                                                     33650000
            BEGIN  << Can't get page >>                                 33652000
                                                                        33654000
               return'value := 2;                                       33656000
               RETURN;                                                  33658000
                                                                        33660000
            END;   << Can't get page >>                                 33662000
                                                                        33664000
            << Scan the page. If enough space was found the search      33666000
               will end.  If no space was found, or the end of the      33668000
               page was not reached, then the search will end, as       33670000
               we have found a block of allocated space.  If space      33672000
               is found and it is the first page, we will make          33674000
               sure that the space really starts in the right spot,     33676000
               as Scan'Page would have skiped over any allocated        33678000
               space at the beginning of the block we are looking       33680000
               for.                                              >>     33682000
                                                                        33684000
            end'of'page := Scan'Page;                                   33686000
                                                                        33688000
            << Count space that was found >>                            33690000
                                                                        33692000
            sector'count := sector'count + DBL(ds'bit'count);           33694000
                                                                        33696000
            << If this is the first page of the block, make             33698000
               damn sure that the block really starts at the            33700000
               specified address.                          >>           33702000
                                                                        33704000
            IF (starting'page'number = ds'page'number) AND              33706000
            ((starting'word'number <> ds'starting'word'number)          33708000
            OR (starting'bit'number <> ds'starting'bit'number))         33710000
            THEN                                                        33712000
               BEGIN  << Not the space we are looking for >>            33714000
                                                                        33716000
                  done := TRUE;                                         33718000
                  sector'count := 0D;                                   33720000
                                                                        33722000
               END;   << Not the space we are looking for >>            33724000
                                                                        33726000
                                                                        33728000
            << If we have found enough space or found no space          33730000
               or did not reach the end of the page, then we            33732000
               are done scanning pages.                        >>       33734000
                                                                        33736000
            IF sector'count >= number'of'sectors OR                     33738000
            ds'bit'count = 0 OR NOT end'of'page THEN                    33740000
               done := TRUE;                                            33742000
                                                                        33744000
         <<DB MUST BE POINTING AT DFSDSTN                             >>33746000
                                                                        33748000
            ds'page'number := ds'page'number + 1;                       33750000
            ds'word'number := 0;                                        33752000
            ds'bit'number := 0;                                         33754000
                                                                        33756000
      END;   << Scan for space >>                                       33758000
                                                                        33760000
                                                                        33762000
   << If the space was not found return the appropriate status,         33764000
      otherwise, if its there, delete the space from the map   >>       33766000
                                                                        33768000
   IF sector'count < number'of'sectors THEN                             33770000
      return'value := 1                                                 33772000
                                                                        33774000
   ELSE                                                                 33776000
      BEGIN  << Delete space from map >>                                33778000
                                                                        33780000
         << Reset map address, as it was changed by the scan >>         33782000
                                                                        33784000
         Convert'Address'To'Map;                                        33786000
                                                                        33788000
         Set'Reset'Bit'Map (ldev'index, ds'page'number, ds'word'number  33790000
               , ds'bit'number, number'of'sectors, FALSE);              33792000
                                                                        33794000
         IF = THEN                                                      33796000
            return'value := 0   << Got the space >>                     33798000
                                                                        33800000
         ELSE                                                           33802000
            return'value := 2;  << Did not get it because an            33804000
                                      error occured.            >>      33806000
                                                                        33808000
      END;   << Delete space from map >>                                33810000
                                                                        33812000
                                                                        33814000
   << reset size of last allocation first page with space indicators    33816000
      as they are no longer meaningful.                             >>  33818000
                                                                        33820000
   size'of'last'allocation (ldev'index) := disc'size (ldev'index);      33822000
   first'page'with'space (ldev'index) := -1;                            33824000
                                                                        33826000
END;  << Get'Specific'Disc'Space >>                                     33828000
$PAGE "GET'DISC'DEFECT'ENTRY"                                           33830000
LOGICAL PROCEDURE Get'Disc'Defect'Entry (ldev, entry'counter,  <<03551>>33832000
                        starting'sector'address, length, entry'code);   33834000
   VALUE ldev;                                                          33836000
   INTEGER ldev;                                                        33838000
   INTEGER entry'counter;                                               33840000
   DOUBLE starting'sector'address;                                      33842000
   DOUBLE length;                                                       33844000
   INTEGER entry'code;                                                  33846000
                                                                        33848000
<<==============================================================        33850000
                                                                        33852000
      This procedure returns a entry from the defective                 33854000
   tracks or defective sectors tables for a disc.  Each call            33856000
   returns the next entry, so several calls will be needed to           33858000
   look at the entire table. A counter is passed to the pro-            33860000
   cedure which indicates how many entries have been re-                33862000
   turned.  The counter must be initialized to zero for the             33864000
   first in a series of calls for a particular ldev.  It is             33866000
   incremented for each call, and the series of calls must              33868000
   not be interupted by a call for another ldev.                        33870000
                                                                        33872000
   NOTE: Defective sectors have not been implemnted yet.....            33874000
                                                                        33876000
                                                                        33878000
   Parameters:                                                          33880000
      ldev - Logical device number of disc drive.                       33882000
      entry'counter - Counter of entries returned.  Must be             33884000
                      zero for the first call, and will be              33886000
                      incrementer by THIS procedure.                    33888000
      starting'sector'address - For return of first sector of           33890000
                                defective area.                         33892000
      length - For return of length, in sectors, of defective           33894000
               area.                                                    33896000
      Code - Integer code indicating the type of entry.                 33898000
             0 = Suspect                                                33900000
             1 = Suspect alternate                                      33902000
             2 = Deleted                                                33904000
             3 = Reassigned                                             33906000
             4 = Deleted alternate (this is a kludge that was added     33908000
                 so we don't try to take deleted alternates out of      33910000
                 the free space map.  There should be a entry in the    33912000
                 DTT to tell about such things, but we must test our    33914000
                 selves.)                                               33916000
                                                                        33918000
   Returns:                                                             33920000
      TRUE if an entry was returned.                                    33922000
      FALSE if no entry was return returned and there are no            33924000
            more entries.                                               33926000
                                                                        33928000
   Assumptions on entry:                                                33930000
      DB is at the stack.                                               33932000
                                                                        33934000
   Exit conditions:                                                     33936000
      DB is unchanged.                                                  33938000
                                                                        33940000
   Globals:                                                             33942000
                                                                        33944000
      Input:                                                            33946000
         dtt - This is initialized on the first call in a               33948000
         series of calls for a specific ldev, and must not be           33950000
         changed during the series.                                     33952000
                                                                        33954000
      Equates:                                                          33956000
         sector'size                                                    33958000
         dtt'number'of'entries {INCDISC1}                               33960000
         dtt'first'entry {INCDISC1}                                     33962000
                                                                        33964000
      Defines:                                                          33966000
         DBL                                                            33968000
         dtt'disc'address {INCDISC1}                                    33970000
         dtt'track'number {INCDISC1}                                    33972000
         dtt'track'code {INCDISC1}                                      33974000
                                                                        33976000
   Externals:                                                           33978000
      Get'Disc'Info                                                     33980000
      Disc                                                              33982000
                                                                        33984000
   Intrinsics:                                                          33986000
      None.                                                             33988000
                                                                        33990000
   Callers:                                                             33992000
      Check'If'On'Defect                                                33994000
      Init'Disc'Free'Space'Map                                          33996000
                                                                        33998000
   Fix ID:                                                              34000000
         This procedure was added as part of the new disc               34002000
      free space map changes.  The fix number on the                    34004000
      procedure header applies to the whole procedure.                  34006000
                                                                        34008000
   Changes:                                                             34010000
                                                                        34012000
                                                                        34014000
==============================================================>>        34016000
                                                                        34018000
BEGIN                                                                   34020000
                                                                        34022000
   INTEGER sectors'per'track;                                           34024000
                                                                        34026000
   DOUBLE logical'disc'size;                                            34028000
                                                                        34030000
   LOGICAL return'value = Get'Disc'Defect'Entry;                        34032000
                                                                        34034000
$INCLUDE INCDISC1                                                       34036000
                                                                        34038000
                                                                        34040000
   << - - - - - - - - - - >>                                            34042000
                                                                        34044000
   << Get logical disc size (sectors) & sectors'per'track >>            34046000
                                                                        34048000
   Get'Disc'Info (ldev,  ,  ,  ,  ,  , logical'disc'size,  ,  ,  ,  ,   34050000
                  ,  , sectors'per'track);                              34052000
                                                                        34054000
   << If this is the first call for this ldev, (i.e. entry'counter =    34056000
      zero), then read the DTT into a global buffer.                >>  34058000
                                                                        34060000
   IF entry'counter = 0 THEN                                            34062000
      Disc (0, ldev, dtt'disc'address, dtt, sector'size);               34064000
                                                                        34066000
                                                                        34068000
   << Compare entry'counter to the number of entries.  If               34070000
      none are left, set return status and exit.          >>            34072000
                                                                        34074000
   IF entry'counter = dtt (dtt'number'of'entries) THEN                  34076000
      BEGIN  << No more entries >>                                      34078000
                                                                        34080000
         return'value := FALSE;                                         34082000
         RETURN;                                                        34084000
                                                                        34086000
      END;   << No more entries >>                                      34088000
                                                                        34090000
   << Get info to return. >>                                            34092000
                                                                        34094000
   starting'sector'address := DBL(sectors'per'track) *                  34096000
      DBL(dtt (dtt'first'entry + entry'counter).dtt'track'number);      34098000
                                                                        34100000
   entry'code := dtt (dtt'first'entry + entry'counter).dtt'track'code;  34102000
                                                                        34104000
   << Check to see if this is a deleted alternate >>                    34106000
                                                                        34108000
   IF entry'code = dtt'deleted AND                                      34110000
   starting'sector'address >= logical'disc'size THEN                    34112000
      entry'code := 4;                                                  34114000
                                                                        34116000
                                                                        34118000
   length := DBL (sectors'per'track);                                   34120000
                                                                        34122000
                                                                        34124000
   << Increment counter and return got-it status >>                     34126000
                                                                        34128000
   entry'counter := entry'counter + 1;                                  34130000
   return'value := TRUE;                                                34132000
                                                                        34134000
END;  << Get'Disc'Defect'Entry >>                                       34136000
$PAGE "CHECK'IF'ON'DEFECT"                                              34138000
LOGICAL PROCEDURE Check'If'On'Defect (ldev, starting'address,  <<03551>>34140000
                                      length, reassigned'ok,            34142000
                                      next'possible'address);           34144000
   VALUE ldev, starting'address, length, reassigned'ok;                 34146000
   INTEGER ldev;                                                        34148000
   LOGICAL reassigned'ok;                                               34150000
   DOUBLE starting'address, length, next'possible'address;              34152000
   OPTION VARIABLE;                                                     34154000
                                                                        34156000
<<==============================================================        34158000
                                                                        34160000
      This procedure checks a specified continuous block of             34162000
   disc space to see if it is on any sort of defective area             34164000
   of the disc.  If it is on a defect, then the address fol-            34166000
   lowing the first defect that overlaps is returned.  This             34168000
   does not mean that the area could start at the returned              34170000
   address and not be on a defect.  Another call to this rou-           34172000
   tine is required to see if it is ok at the address.                  34174000
   For now, this routine does not check is an area on a cs'80           34176000
   disc is on a spared track, it just says ok.  Note, there             34178000
   can be no defective tracks on a cs'80 device.                        34180000
                                                                        34182000
                                                                        34184000
   Parameters:                                                          34186000
      ldev - Logical device number of disc drive.                       34188000
      starting'address - First sector address of block to               34190000
                         check.                                         34192000
      length - Length of block in sectors.                              34194000
      reassigned'ok - (optional) - If it is TRUE, then                  34196000
                      reassigned areas are considered o.k.,             34198000
                      if FALSE or omited, the reassigned                34200000
                      areas are considered defective and the            34202000
                      block will not be aproved if it over-             34204000
                      laps a reassigned area.                           34206000
      next'possible'address - First sector address of area              34208000
                              following the first overlaping            34210000
                              defect.                                   34212000
                                                                        34214000
   Returns:                                                             34216000
      TRUE - Area is nopt on a defect.                                  34218000
      FALSE - Area is on a defect.                                      34220000
                                                                        34222000
   Assumptions on entry:                                                34224000
      DB is at the stack.                                               34226000
                                                                        34228000
   Exit conditions:                                                     34230000
      DB is unchanged.                                                  34232000
                                                                        34234000
   Globals:                                                             34236000
                                                                        34238000
      Equates:                                                          34240000
         dtt'reassigned   {INCDISC1}                                    34242000
         cs'80'type  {INCDISC1}                                         34244000
                                                                        34246000
   Externals:                                                           34248000
      Ldevtotype                                                        34250000
                                                                        34252000
   Intrinsics:                                                          34254000
      Get'Disc'Defect'Entry                                             34256000
                                                                        34258000
   Callers:                                                             34260000
      Init'Disc'Free'Space'Map                                          34262000
                                                                        34264000
   Fix ID:                                                              34266000
         This procedure was added as part of the new disc               34268000
      free space map changes.  The fix number on the                    34270000
      procedure header applies to the whole procedure.                  34272000
                                                                        34274000
   Changes:                                                             34276000
                                                                        34278000
                                                                        34280000
==============================================================>>        34282000
                                                                        34284000
BEGIN                                                                   34286000
                                                                        34288000
   DOUBLE ending'address;                                               34290000
                                                                        34292000
   INTEGER defect'entry'counter;                                        34294000
   LOGICAL end'of'defect'table;                                         34296000
                                                                        34298000
   DOUBLE defect'starting'address;                                      34300000
   DOUBLE defect'ending'address;                                        34302000
   DOUBLE defect'length;                                                34304000
   INTEGER defect'code;                                                 34306000
                                                                        34308000
   LOGICAL pmap = Q-4;                                                  34310000
   DEFINE passed'reassigned'ok = pmap.(14:1)#,                          34312000
          passed'next'possible'address = pmap.(15:1)#;                  34314000
                                                                        34316000
   LOGICAL return'value = Check'If'On'Defect;                           34318000
                                                                        34320000
$INCLUDE INCDISC1                                                       34322000
                                                                        34324000
   << - - - - - - - - - - >>                                            34326000
                                                                        34328000
   IF Ldevtotype (ldev) = cs'80'type THEN                               34330000
      BEGIN  << cs'80'type >>                                           34332000
                                                                        34334000
         return'value := TRUE;                                          34336000
         RETURN;                                                        34338000
                                                                        34340000
      END;   << cs'80'type >>                                           34342000
                                                                        34344000
   IF NOT passed'reassigned'ok THEN                                     34346000
      reassigned'ok := FALSE;  << Default >>                            34348000
                                                                        34350000
                                                                        34352000
   << Calculate ending address of area to check >>                      34354000
                                                                        34356000
   ending'address := starting'address + length - 1D;                    34358000
                                                                        34360000
   return'value := TRUE;  << Preset to ok status >>                     34362000
                                                                        34364000
   << Set up counter of defective entries >>                            34366000
                                                                        34368000
   defect'entry'counter := 0;                                           34370000
                                                                        34372000
   DO                                                                   34374000
      BEGIN  << Scan defect table >>                                    34376000
                                                                        34378000
         end'of'defect'table :=                                         34380000
               NOT Get'Disc'Defect'Entry (ldev, defect'entry'counter,   34382000
                     defect'starting'address, defect'length,            34384000
                     defect'code);                                      34386000
                                                                        34388000
         IF (NOT end'of'defect'table) AND                               34390000
         ((NOT reassigned'ok LAND defect'code = dtt'reassigned) LOR     34392000
         (defect'code <> dtt'reassigned)) THEN                          34394000
            BEGIN  << Got a defect entry >>                             34396000
                                                                        34398000
               << Test if they overlap >>                               34400000
                                                                        34402000
               defect'ending'address := defect'starting'address +       34404000
                                        defect'length;                  34406000
                                                                        34408000
               IF                                                       34410000
               ((defect'ending'address >= starting'address) LAND        34412000
               (defect'starting'address <= ending'address)) OR          34414000
               ((defect'starting'address <= starting'address) LAND      34416000
               (defect'ending'address >= ending'address))               34418000
               THEN                                                     34420000
                  return'value := FALSE;   << Overlap >>                34422000
                                                                        34424000
                                                                        34426000
            END;   << Got a defect entry >>                             34428000
                                                                        34430000
      END    << Scan defect table >>                                    34432000
   UNTIL end'of'defect'table OR NOT return'value;                       34434000
                                                                        34436000
                                                                        34438000
   << If the space overlaps a defective area, then give back            34440000
      a address just past the end of the defective area.    >>          34442000
                                                                        34444000
   IF NOT return'value AND passed'next'possible'address THEN            34446000
      next'possible'address := defect'ending'address + 1D;              34448000
                                                                        34450000
END;  << Check'If'On'Defect >>                                          34452000
$PAGE "INIT'DISC'FREE'SPACE'MAP"                                        34454000
PROCEDURE Init'Disc'Free'Space'Map (ldev, use'old'map);        <<03551>>34456000
   VALUE ldev, use'old'map;                                             34458000
   INTEGER ldev;                                                        34460000
   LOGICAL use'old'map;                                                 34462000
   OPTION VARIABLE;                                                     34464000
                                                                        34466000
<<==============================================================        34468000
                                                                        34470000
      This procedure initialize the descriptor table to the             34472000
   all free state.  The parameter use'old'map deteremines               34474000
   where the map is to be placed.  This parameter is provided           34476000
   for a recover lost disc space. If it is present and TRUE,            34478000
   the old space for the map is used, provided there are no             34480000
   deleted tracks overlaping the free space map or descriptor           34482000
   table, reassigned is o.k.  If it overlaps a deleted track,           34484000
   INITIAL is HALTed with a nasty message.  If use'old'map if           34486000
   FALSE on omitted, then it is assumed to be a reload and              34488000
   space is searched for that is not on a defective or re-              34490000
   assigned track.  Once we have decided where the map is               34492000
   going to go, the descriptor table is initialized to zeros.           34494000
   The bit map is initialized and the system reserve area,              34496000
   the descriptor table, bit map and all deleted tracks are             34498000
   removed from the free space map.                                     34500000
                                                                        34502000
   Parameters:                                                          34504000
      ldev - Logical device number of disc drive.                       34506000
      use'old'map - (optional) - If TRUE, then the space form           34508000
                                 the old map will be used. If           34510000
                                 FALSE or omitted, then we              34512000
                                 will not necessarly use the            34514000
                                 old space.                             34516000
   Assumptions on entry:                                                34518000
      DB must be at the stack.                                          34520000
                                                                        34522000
   Exit conditions:                                                     34524000
      DB is unchanged.                                                  34526000
                                                                        34528000
   Globals:                                                             34530000
                                                                        34532000
      Output:                                                           34534000
         first'page'with'space                                          34536000
         ldev'index'to'ldev - entry will be initialized.                34538000
                                                                        34540000
      Others:                                                           34542000
         ldev'of'dt'page'in'buffer - altered.                           34544000
         add'of'dt'page'in'buffer - altered.                            34546000
         dt'buffer - altered.                                           34548000
         ldev'of'map'in'buffer - altered.                               34550000
         bit'map'buffer - altered.                                      34552000
                                                                        34554000
      Equates:                                                          34556000
         sector'size                                                    34558000
         m333                                                           34560000
         check'sum'word                                                 34562000
         actual'words'per'page                                          34564000
         m325                                                           34566000
         ldev'1'reserved'area'size                                      34568000
         other'disc'reserved'area'size                                  34570000
         disc'lab'dt'low {INCDISC1}                                     34572000
         disc'lab'dt'high {INCDISC1}                                    34574000
         disc'lab'map'low {INCDISC1}                                    34576000
         disc'lab'map'high {INCDISC1}                                   34578000
         disc'lab'dirty'dt'flag {INCDISC1}                              34580000
         cs'80'type {INCDISC1}                                          34582000
         disc'lab'dfs'map'ok {INCDISC1}                                 34584000
                                                                        34586000
      Defines:                                                          34588000
         DBL                                                            34590000
         disc'label'map'address {INCDISC1}                              34592000
                                                                        34594000
   Externals:                                                           34596000
      Get'Disc'Info                                                     34598000
      Check'If'On'Defect                                                34600000
      Errmessage                                                        34602000
      Disc                                                              34604000
      Make'Check'Sum                                                    34606000
      Return'Disc'Space                                                 34608000
      Get'Disc'Defect'Entry                                             34610000
      Get'Specific'Disc'Space                                           34612000
      Access'Dfs'Map                                                    34614000
                                                                        34616000
   Intrinsics:                                                          34618000
      None.                                                             34620000
                                                                        34622000
   Callers:                                                             34624000
      Mainseg1                                                          34626000
                                                                        34628000
   Fix ID:                                                              34630000
         This procedure was added as part of the new disc               34632000
      free space map changes.  The fix number on the                    34634000
      procedure header applies to the whole procedure.                  34636000
                                                                        34638000
   Changes:                                                             34640000
                                                                        34642000
                                                                        34644000
==============================================================>>        34646000
                                                                        34648000
BEGIN                                                                   34650000
                                                                        34652000
   ARRAY disc'label (0:sector'size-1);                                  34654000
   DOUBLE disc'size;                                                    34656000
   DOUBLE bit'map'disc'address;                                         34658000
   INTEGER bit'map'size'pages;                                          34660000
   DOUBLE dt'disc'address;                                              34662000
   INTEGER dt'size'words;                                               34664000
   INTEGER dt'size'sectors;                                             34666000
   DOUBLE reserved'area'size;                                           34668000
                                                                        34670000
   LOGICAL found;                                                       34672000
   INTEGER count;                                                       34674000
                                                                        34676000
   INTEGER defect'entry'counter;                                        34678000
   INTEGER entry'code;                                                  34680000
   LOGICAL end'of'defect'table;                                         34682000
   DOUBLE sector'address;                                               34684000
   DOUBLE length;                                                       34686000
   INTEGER index;                                                       34688000
                                                                        34690000
$INCLUDE INCDISC1                                                       34692000
                                                                        34694000
   INTEGER type;                                                        34696000
                                                                        34698000
   LOGICAL pmap = Q-4;                                                  34700000
   DEFINE passed'use'old'map = pmap.(15:1)#;                            34702000
                                                                        34704000
   << - - - - - - - - - - >>                                            34706000
                                                                        34708000
   << Set size of reserved area at the start of the disc >>             34710000
                                                                        34712000
   IF ldev = 1 THEN                                                     34714000
      reserved'area'size := DBL (ldev'1'reserved'area'size)             34716000
   ELSE                                                                 34718000
      reserved'area'size := DBL (other'disc'reserved'arae'size);        34720000
                                                                        34722000
                                                                        34724000
   Get'Disc'Info (ldev, disc'label, TRUE,  ,type ,  , disc'size,        34726000
                  bit'map'disc'address, bit'map'size'pages,             34728000
                  dt'disc'address, dt'size'words);                      34730000
                                                                        34732000
   dt'size'sectors := dt'size'words / sector'size;                      34734000
   IF (dt'size'words MOD sector'size) <> 0 THEN                         34736000
      dt'size'sectors := dt'size'sectors + 1;                           34738000
                                                                        34740000
   IF passed'use'old'map AND use'old'map THEN                           34742000
      BEGIN  << Re-initialize current map >>                            34744000
                                                                        34746000
         found := Check'If'On'Defect (ldev, dt'disc'address,            34748000
                     DBL(dt'size'sectors), TRUE);                       34750000
                                                                        34752000
         IF found THEN                                                  34754000
            found := Check'If'On'Defect (ldev, bit'map'disc'address,    34756000
                     DBL(bit'map'size'pages * page'size), TRUE);        34758000
                                                                        34760000
         IF NOT found THEN                                              34762000
                                                                        34764000
               << Tellop about the problem and die >>                   34766000
                                                                        34768000
               Errmessage (m333, ldev);                                 34770000
                                                                        34772000
      END    << Re-initialize current map >>                            34774000
   ELSE                                                                 34776000
      BEGIN  << Find a place for the map >>                             34778000
                                                                        34780000
         << Find a place for the descriptor table and map that is not   34782000
            on a defective or reassigned track.                       >>34784000
                                                                        34786000
         dt'disc'address := reserved'area'size;                         34788000
         found := FALSE;                                                34790000
                                                                        34792000
         WHILE NOT found DO                                             34794000
            found := Check'If'On'Defect (ldev, dt'disc'address,         34796000
                     DBL(dt'size'words +                                34798000
                     (bit'map'size'pages/page'size)), FALSE,            34800000
                     dt'disc'address);                                  34802000
                                                                        34804000
         bit'map'disc'address := dt'disc'address + DBL(dt'size'sectors);34806000
                                                                        34808000
         << Set stuff in disc label >>                                  34810000
                                                                        34812000
         TOS := dt'disc'address;                                        34814000
         disc'label (disc'lab'dt'low) := TOS;                           34816000
         disc'label (disc'lab'dt'high) := TOS;                          34818000
                                                                        34820000
         TOS := bit'map'disc'address;                                   34822000
         disc'label (disc'lab'map'low) := TOS;                          34824000
         disc'label (disc'lab'map'high) := TOS;                         34826000
                                                                        34828000
      END;   << Find a place for the map >>                             34830000
                                                                        34832000
      << Update disc label >>                                           34834000
                                                                        34836000
      disc'label (disc'lab'dirty'dt'flag) := TRUE;                      34838000
      disc'label (disc'lab'dfs'map'ok) := TRUE;                         34840000
                                                                        34842000
      Disc (1, ldev, disc'label'address, disc'label, sector'size);      34844000
                                                                        34846000
   << Delete entry in "ldev'index'to'ldev" table for this               34848000
      ldev.  This will force "Access'Dfs'map" to re-init                34850000
      the info for this ldev.                             >>            34852000
                                                                        34854000
   index := 0;                                                          34856000
                                                                        34858000
   WHILE index < max'disc'drives DO                                     34860000
      IF ldev'index'to'ldev (index) = ldev THEN                         34862000
         BEGIN  << Found entry >>                                       34864000
                                                                        34866000
            ldev'index'to'ldev (index) := -1;                           34868000
            index := max'disc'drives;                                   34870000
                                                                        34872000
         END    << Found entry >>                                       34874000
      ELSE                                                              34876000
         index := index + 1;                                            34878000
                                                                        34880000
   << Zero out descriptor table >>                                      34882000
                                                                        34884000
   ldev'of'dt'page'in'buffer := -1;                                     34886000
   add'of'dt'page'in'buffer := -1D;                                     34888000
                                                                        34890000
   dt'buffer (0) := 0;                                                  34892000
   MOVE dt'buffer (1) := dt'buffer (0), (sector'size-1);                34894000
                                                                        34896000
   FOR count := 0 UNTIL dt'size'sectors-1 DO                            34898000
      Disc (1, ldev, dt'disc'address + DBL(count), dt'buffer,           34900000
            sector'size);                                               34902000
                                                                        34904000
   << Initialize bit map to no free space state. >>                     34906000
                                                                        34908000
   ldev'of'map'in'buffer := -1;                                         34910000
                                                                        34912000
   bit'map'buffer (0) := 0;                                             34914000
   MOVE bit'map'buffer (1) := bit'map'buffer (0),                       34916000
                                 (actual'words'per'page-1);             34918000
                                                                        34920000
   bit'map'buffer (check'sum'word) := Make'Check'Sum (bit'map'buffer,   34922000
                                         actual'words'per'page);        34924000
                                                                        34926000
   FOR count := 0 UNTIL bit'map'size'pages-1 DO                         34928000
      Disc (1, ldev, bit'map'disc'address + DBL(count), bit'map'buffer, 34930000
            actual'words'per'page);                                     34932000
                                                                        34934000
   << Set all space as available except reserved area >>                34936000
                                                                        34938000
   Return'Disc'Space (ldev, reserved'area'size,                         34940000
                      disc'size - reserved'area'size);                  34942000
                                                                        34944000
                                                                        34946000
   << Remove all defective tracks from free space map, if it            34948000
      is not a CS'80 disc.                                    >>        34950000
                                                                        34952000
   IF type <> cs'80'type THEN                                           34954000
      BEGIN  << Take out defective tracks >>                            34956000
                                                                        34958000
         defect'entry'counter := 0;                                     34960000
                                                                        34962000
         DO                                                             34964000
            BEGIN  << Remove defective areas >>                         34966000
                                                                        34968000
               end'of'defect'table := NOT Get'Disc'Defect'entry (ldev,  34970000
                    defect'entry'counter, sector'address, length,       34972000
                    entry'code);                                        34974000
                                                                        34976000
               IF NOT end'of'defect'table AND                           34978000
               entry'code = dtt'deleted THEN                            34980000
                  BEGIN  << Delete area >>                              34982000
                                                                        34984000
                     TOS := Get'Specific'Disc'Space (ldev,              34986000
                                          sector'address, length);      34988000
                     IF TOS <> 0 THEN ERRMESSAGE (M325,10);    <<03632>>34990000
                                                                        34992000
                  END;   << delete area >>                              34994000
                                                                        34996000
            END    << Remove defective areas >>                         34998000
         UNTIL end'of'defect'table;                                     35000000
                                                                        35002000
      END;  << Take out defective tracks >>                             35004000
                                                                        35006000
                                                                        35008000
   << Remove space occupied by free space descriptor table and          35010000
      bit map from free space.                                 >>       35012000
                                                                        35014000
   TOS := Get'Specific'Disc'Space (ldev, dt'disc'address,               35016000
                                   DBL(dt'size'sectors));               35018000
   IF TOS <> 0 THEN ERRMESSAGE (M325,11);                      <<03632>>35020000
                                                                        35022000
   TOS := Get'Specific'Disc'Space (ldev, bit'map'disc'address,          35024000
                DBL(bit'map'size'pages * page'size));                   35026000
   IF TOS <> 0 THEN  ERRMESSAGE (M325,12);                     <<03632>>35028000
                                                                        35030000
                                                                        35032000
   index := Access'Dfs'Map (ldev);                                      35034000
   first'page'with'space (index) := 0; << First page >>                 35036000
                                                                        35038000
END;   << Init'Disc'Free'Space'Map >>                                   35040000
$PAGE "CHECK'IF'OVERLAPS'DFS'DATA'STRUCTURES"                  <<03613>>35042000
LOGICAL PROCEDURE Check'If'Overlaps'Dfs'Data'Structures (ldev, <<03613>>35044000
                     first'sector'address, last'sector'address);        35046000
   VALUE ldev, first'sector'address, last'sector'address;               35048000
   INTEGER ldev;                                                        35050000
   DOUBLE first'sector'address, last'sector'address;                    35052000
                                                                        35054000
<<==============================================================        35056000
                                                                        35058000
      This procedure checks to see if the specified area of             35060000
   the disc overlaps the descriptor table or bitmap of the              35062000
   ldev. This is used to see if the disc free space map disc            35064000
   resident data structure overlap a defective area on the              35066000
   disc.                                                                35068000
                                                                        35070000
   Parameters:                                                          35072000
      ldev - ldev number of the disc.                                   35074000
      first'sector'address - address of the first sector of             35076000
                             the area to check.                         35078000
      last'sector'address - address of the last sector of the           35080000
                            area to check.                              35082000
                                                                        35084000
   Returns:                                                             35086000
      TRUE - if there is some overlap.                                  35088000
      FALSE - if there is no overlap.                                   35090000
                                                                        35092000
   Assumptions on entry:                                                35094000
      DB is at the stack.                                               35096000
                                                                        35098000
   Exit conditions:                                                     35100000
      DB is unchanged.                                                  35102000
                                                                        35104000
   Globals:                                                             35106000
                                                                        35108000
      Equates:                                                          35110000
         sector'size                                                    35112000
         page'size                                                      35114000
                                                                        35116000
   Externals:                                                           35118000
      Get'Disc'Info                                                     35120000
                                                                        35122000
   Intrinsics:                                                          35124000
      None.                                                             35126000
                                                                        35128000
   Callers:                                                             35130000
      Mainseg1                                                          35132000
                                                                        35134000
   Fix ID:                                                              35136000
         This procedure was added as part of the new disc               35138000
      free space map changes.  The fix number on the                    35140000
      procedure header applies to the whole procedure.                  35142000
                                                                        35144000
   Changes:                                                             35146000
                                                                        35148000
                                                                        35150000
==============================================================>>        35152000
                                                                        35154000
BEGIN                                                                   35156000
                                                                        35158000
   DOUBLE bit'map'address;                                              35160000
   INTEGER bit'map'size'pages;                                          35162000
   DOUBLE ending'bit'map'address;                                       35164000
                                                                        35166000
   DOUBLE dt'address;                                                   35168000
   INTEGER dt'size'words;                                               35170000
   DOUBLE ending'dt'address;                                            35172000
                                                                        35174000
   LOGICAL return'value = Check'If'Overlaps'Dfs'Data'Structures;        35176000
                                                                        35178000
   << - - - - - - - - - - >>                                            35180000
                                                                        35182000
   << Get starting addresses and sizes of descriptor table              35184000
      and bitmap.                                           >>          35186000
                                                                        35188000
   Get'Disc'Info (ldev,  ,  ,  ,  ,  ,  , bit'map'address,              35190000
                  bit'map'size'pages, dt'address, dt'size'words);       35192000
                                                                        35194000
   << Calculate ending address of DT and bitmap >>                      35196000
                                                                        35198000
   ending'bit'map'address := bit'map'address + DBL (bit'map'size'pages *35200000
                             sector'size * page'size) - 1D;             35202000
                                                                        35204000
   ending'dt'address := dt'address + DBL (dt'size'words / sector'size)  35206000
                        -1D;                                            35208000
                                                                        35210000
   << Round up DT ending address if necessary >>                        35212000
                                                                        35214000
   IF (dt'size'words MOD sector'size) <> 0 THEN                         35216000
      ending'dt'address := ending'dt'address + 1D;                      35218000
                                                                        35220000
   << Check is there is any overlap >>                                  35222000
                                                                        35224000
   IF                                                                   35226000
   ((bit'map'address <= first'sector'address)                           35228000
                    LAND                                                35230000
    (ending'bit'map'address >= first'sector'address))                   35232000
                     OR                                                 35234000
   ((bit'map'address <= last'sector'address)                            35236000
                    LAND                                                35238000
    (ending'bit'map'address >= last'sector'address))                    35240000
                     OR                                                 35242000
   ((bit'map'address <= first'sector'address)                           35244000
                    LAND                                                35246000
    (ending'bit'map'address >= last'sector'address))                    35248000
                     OR                                                 35250000
   ((dt'address <= first'sector'address)                                35252000
                    LAND                                                35254000
    (ending'dt'address >= first'sector'address))                        35256000
                     OR                                                 35258000
   ((dt'address <= last'sector'address)                                 35260000
                    LAND                                                35262000
    (ending'dt'address >= last'sector'address))                         35264000
                     OR                                                 35266000
   ((dt'address <= first'sector'address)                                35268000
                    LAND                                                35270000
    (ending'dt'address >= last'sector'address))                         35272000
   THEN                                                                 35274000
      return'value := TRUE                                              35276000
   ELSE                                                                 35278000
      return'value := FALSE;                                            35280000
                                                                        35282000
END;  << Check'If'Overlaps'Dfs'Data'Structures >>                       35284000
$PAGE "MISC. DISCSPACE ROUTINES"                               <<03613>>35286000
  DOUBLE PROCEDURE GETDISCSPACE(LDEV,NSECT);                            35288000
    VALUE LDEV,NSECT;                                                   35290000
    INTEGER LDEV;                                                       35292000
    DOUBLE NSECT;                                                       35294000
      BEGIN                                                             35296000
      DOUBLE return'value = Getdiscspace;                      <<03551>>35298000
         TOS := Get'Disc'Space (ldev, nsect, return'value);    <<03551>>35300000
          IF TOS <> 0 THEN TOS := CCL ELSE TOS := CCE;                  35302000
          CC := TOS;                                                    35304000
      END <<GETDISCSPACE>> ;                                            35306000
  PROCEDURE RETDISCSPACE(LDEV,NSECT,DADDR);                             35308000
    VALUE LDEV,NSECT,DADDR;                                             35310000
    INTEGER LDEV;                                                       35312000
    DOUBLE NSECT,DADDR;                                                 35314000
      BEGIN                                                             35316000
         Return'Disc'Space (ldev, daddr, nsect);               <<03551>>35318000
         cc := cce;                                            <<03551>>35320000
      END <<RETDISCSPACE>> ;                                            35322000
  PROCEDURE REMDISCSPACE(LDEV,NSECT,DADDR);                             35324000
    VALUE LDEV,NSECT,DADDR;                                             35326000
    INTEGER LDEV;                                                       35328000
    DOUBLE NSECT,DADDR;                                                 35330000
      BEGIN                                                             35332000
                                                               <<03551>>35334000
         << Test to see if DADDR is neg, aside from the >>     <<03551>>35336000
         << first 8 bits. This is because the allocation>>     <<03551>>35338000
         << of LOADMAP on RELOAD - RESTORE is strange.  >>     <<03551>>35340000
                                                               <<03551>>35342000
         IF daddr = [16/%377,16/%177777]D OR daddr < 0D THEN   <<03551>>35344000
            BEGIN  << Negative >>                              <<03551>>35346000
               cc := ccl;                                      <<03551>>35348000
               RETURN;                                         <<03551>>35350000
            END;   << Negative >>                              <<03551>>35352000
                                                               <<03551>>35354000
         TOS := Get'Specific'Disc'Space (ldev, daddr, nsect);  <<03551>>35356000
         IF TOS <> 0 THEN TOS := ccl ELSE TOS := cce;          <<03551>>35358000
          CC := TOS;                                                    35360000
      END <<REMDISCSPACE>> ;                                            35362000
INTEGER PROCEDURE GETVOL(LDEV);                                <<MPEIV>>35364000
  VALUE LDEV;                                                  <<MPEIV>>35366000
  INTEGER LDEV;                                                <<MPEIV>>35368000
  COMMENT: CONVERT LDEV TO SYSTEM DOMAIN VOLUME NUMBER.        <<MPEIV>>35370000
  ;                                                            <<MPEIV>>35372000
  BEGIN                                                        <<MPEIV>>35374000
  INTEGER I := 0;                                              <<MPEIV>>35376000
  CC := CCE;                                                   <<MPEIV>>35378000
  IF LDEV > 0 THEN                                             <<MPEIV>>35380000
    WHILE (I:=I+1) <= HVOL DO                                  <<MPEIV>>35382000
      IF VTAB(I*VTABSIZE+VTAB12).VTABLDEV=LDEV THEN            <<MPEIV>>35384000
        BEGIN  << FOUND IT >>                                  <<MPEIV>>35386000
        GETVOL := I;                                           <<MPEIV>>35388000
        RETURN;                                                <<MPEIV>>35390000
        END;                                                   <<MPEIV>>35392000
  CC := CCL;                                                   <<MPEIV>>35394000
  END; << GETVOL >>                                            <<MPEIV>>35396000
INTEGER PROCEDURE GETLDEV(VOLUME);                             <<MPEIV>>35398000
  VALUE VOLUME;                                                <<MPEIV>>35400000
  INTEGER VOLUME;                                              <<MPEIV>>35402000
  BEGIN                                                        <<MPEIV>>35404000
  COMMENT: CONVERT VOLUME NUMBER TO LDEV.                      <<MPEIV>>35406000
  ;                                                            <<MPEIV>>35408000
  INTEGER LDEV = GETLDEV;                                      <<03603>>35410000
  IF VOLUME <= HVOL THEN                                       <<MPEIV>>35412000
    BEGIN                                                      <<MPEIV>>35414000
    GETLDEV := VTAB(VOLUME*VTABSIZE+VTAB12).VTABLDEV;          <<MPEIV>>35416000
    CC := IF 1 <= LDEV <= HLDEV THEN CCE ELSE CCG;             <<03603>>35418000
    END                                                        <<MPEIV>>35420000
  ELSE                                                         <<MPEIV>>35422000
    CC := CCL;                                                 <<MPEIV>>35424000
  END;  << GETLDEV >>                                          <<MPEIV>>35426000
          <<--------------------------------------                      35428000
            GET DISC SPACE IN ANY NUMBER OF WAYS                        35430000
          -------------------------------------->>                      35432000
  INTEGER PROCEDURE SUPERDISCSPACE(LDEV,NUMBLOCKS,TYPEWORD,BLOCKSIZES,  35434000
    BLOCKADDRS);                                                        35436000
    VALUE LDEV,NUMBLOCKS,TYPEWORD;                                      35438000
    INTEGER LDEV,NUMBLOCKS,TYPEWORD;                                    35440000
    DOUBLE ARRAY BLOCKSIZES,BLOCKADDRS;                                 35442000
    COMMENT                                                             35444000
      GETS DISC SPACE ACCORDING TO WHAT TYPE OF COLD LOAD THIS IS AND   35446000
    THE VALUE OF LDEV. SPECIFICALLY, IF LDEV<0 THEN -LDEV IS THE ONLY   35448000
    DEVICE ON WHICH SPACE CAN BE GOTTEN, IF LDEV>0, THEN ANY DEVICE IS  35450000
    OK, BUT LDEV SHOULD BE TRIED FIRST, AND IF LDEV=0 ANY DEVICE IS OK. 35452000
    FOR RESTORES, FIRST WE TRY TO GET BACK THE SAME SPACE AS BEFORE. IF 35454000
    THIS FAILS, WE ATTEMPT TO GET ANY SPACE ON THE SAME DEVICE AS       35456000
    BEFORE. IF THIS FAILS, WE TRY TO GET SPACE ACCORDING TO THE         35458000
    SPREAD METHOD. FOR COMPACTS, WE ATTEMPT TO GET SPACE IN THE SAME    35460000
    BLOCK AS BEFORE (BLOCKS ARE DEFINED TO BE THE AREAS CREATED WHEN    35462000
    SPACE IS REMOVED FOR DEFECTIVE TRACKS). IF THIS FAILS, WE AGAIN     35464000
    DEFAULT TO SPREAD. FOR SPREAD, WE FIRST ATTEMPT TO GET SPACE        35466000
    IN THE CLASS SPECIFIED IN THE FILE LABEL(SEARCH=0).IF THIS FAILS,   35468000
    WE ATTEMP TO GET SPACE ON A DEVICE WITH SAME TYPE AND SUBTYPE       35470000
    (SEARCH=1). IF THIS FAILS,WE TRY FOR SPACE ON A DEVICE WITH         35472000
    SAME TYPE (SEARCH=2). IF THIS FAILS, WE TRY FOR SPACE IN            35474000
    CLASS DISC. IF THIS FAILS, WE RERURN CCL,SINCE NO SPACE IS          35476000
    AVAILABLE. IN ANY CASE WHERE SPACE WAS FOUND,SUPERDISCSPACE         35478000
    RETURNS THE LOGICAL DEVICE NUMBER OF THE DISC ON WHICH THE          35480000
    FIRST EXTENT RESIDES.                                               35482000
     ** NOTE **  SUPERDISCSPACE ASSUMES THAT ALL REQUESTS               35484000
     FOR SPACE OTHER THAN FILES,E.G. MESSAGE CATALOGUE AND              35486000
     INITIAL SEGMENTS, ARE MADE WITH LDEV<0;                            35488000
    << NOTE: This routine no longers trys to get space >>      <<03551>>35490000
    <<       between blocks.                           >>      <<03551>>35492000
      BEGIN                                                             35494000
        INTEGER TYPE,SUBTYP,SEARCH:=-1,I,J,VOLUME,INDEX;                35496000
        INTEGER K,EXTLDEV,NCHAR,DVCX;                                   35498000
        DOUBLE DTEMP;                                                   35500000
        INTEGER POINTER STARTVOL;                                       35502000
        LOGICAL ONLYLDEV,CLASSUSED:=FALSE;                              35504000
        INTEGER                                                <<*LDT*>>35506000
            LDT'INDEX,                                         <<*LPDT>>35508000
            LPDT'INDEX;                                        <<*LPDT>>35510000
        INTEGER POINTER                                        <<dctab>>35512000
            DCT;                                               <<dctab>>35514000
        BYTE POINTER                                           <<dctab>>35516000
            DCT'B;                                             <<dctab>>35518000
  SUBROUTINE RETURNSPACE;                                               35520000
    BEGIN                                                               35522000
    K := -1;                                                            35524000
    WHILE (K:=K+1)<I DO                                                 35526000
      IF BLOCKSIZES(K)<>0D THEN                                         35528000
        BEGIN                                                           35530000
        TOS := BLOCKADDRS(K);                                  <<00071>>35532000
        TOS := S1.(0:8);                                                35534000
        TOS := TOS*VTABSIZE+VTAB12;                                     35536000
        X := TOS;                                                       35538000
        EXTLDEV := VTAB(X).VTABLDEV;                                    35540000
        S1.(0:8) := 0;  <<ZERO VOLUME NUMBER>>                          35542000
        DTEMP := TOS;                                                   35544000
        RETDISCSPACE(EXTLDEV,BLOCKSIZES(K),DTEMP);                      35546000
        IF <> THEN MESSAGE(M328);  << RETURNING SPACE >>       <<01442>>35548000
        END;                                                            35550000
    I := 0;                                                             35552000
    END  <<RETURNSPACE>>;                                               35554000
                                                                        35556000
          ONLYLDEV := LDEV.(0:1);                                       35558000
          IF <> THEN LDEV := -LDEV;                                     35560000
          I :=  0;                                                      35562000
          IF RESTORING THEN                                             35564000
            BEGIN <<TRY TO GET SOME SPECIFIC SPACE>>                    35566000
            IF LDEV=0 THEN GOTO ANYWHERE;                               35568000
            DO                                                          35570000
              IF BLOCKSIZES(I)<>0D THEN                                 35572000
                IF ONLYLDEV THEN                                        35574000
                  BEGIN                                                 35576000
                  EXTLDEV := LDEV;                                      35578000
                  DTEMP := BLOCKADDRS(I)&DLSL(8)&DLSR(8);               35580000
                  GOTO OPTIONREST;                                      35582000
                  END                                                   35584000
                ELSE                                                    35586000
                BEGIN                                                   35588000
                TOS := BLOCKADDRS(I);                                   35590000
                TOS := S1.(0:8)*VTABSIZE;                               35592000
                X := TOS;                                               35594000
                TOS := @VNAME;                                          35596000
                TOS := @OLDVTAB(X)&LSL(1);                     <<04306>>35598000
                MOVE *:=*,(8);                                          35600000
                K := 0;                                                 35602000
                WHILE (K:=K+1) <= HVOL DO                      <<03550>>35604000
                  BEGIN                                                 35606000
                  TOS := @VTAB(K*VTABSIZE)&LSL(1);             <<04306>>35608000
                  IF *=VNAME,(8)  THEN                                  35610000
                    BEGIN  <<FOUND IT>>                                 35612000
                    TOS := VTAB(X+VTAB12).VTABLDEV;                     35614000
                    GOTO GOTIT;                                         35616000
                    END;                                                35618000
                  END;                                                  35620000
                TOS := 0;                                               35622000
  GOTIT:        IF S0=0 THEN                                            35624000
                  BEGIN <<VOLUME NO LONGER EXIST>>                      35626000
                  DEL;                                                  35628000
                  GOTO ANYWHERE;                                        35630000
                  END                                                   35632000
                ELSE EXTLDEV := TOS;                                    35634000
                S1.(0:8) := 0;                                          35636000
                DTEMP := TOS;                                           35638000
  OPTIONREST:   IF OPT=REST THEN                                        35640000
                  BEGIN                                                 35642000
                  REMDISCSPACE(EXTLDEV,BLOCKSIZES(I),DTEMP);            35644000
                  IF <> THEN GOTO ANYTHIS;                              35646000
                  END                                                   35648000
                ELSE                                                    35650000
                  BEGIN <<TRY TO GET SPACE IN SAME BLOCK>>              35652000
                  TOS := Get'Disc'Space (extldev,              <<03551>>35654000
                                   blocksizes(i), dtemp);      <<03551>>35656000
                  IF TOS<>0 THEN                                        35658000
                    BEGIN  <<UNABLE TO GET IT>>                         35660000
  ANYTHIS:          TOS :=GETDISCSPACE(EXTLDEV,BLOCKSIZES(I));          35662000
                    IF <> THEN                                          35664000
                      IF ONLYLDEV THEN                                  35666000
                        BEGIN                                           35668000
                        DDEL;                                           35670000
                        RETURNSPACE;                                    35672000
                        GOTO ERROR;                                     35674000
                        END                                             35676000
                      ELSE GOTO ANYWHERE;                               35678000
                    DTEMP := TOS;                                       35680000
                    END;                                                35682000
                  END;                                                  35684000
                IF I=0 THEN SUPERDISCSPACE:=EXTLDEV;                    35686000
                TOS := DTEMP;                                           35688000
                TOS := GETVOL(EXTLDEV);                                 35690000
                S2.(0:8) := TOS;                                        35692000
                BLOCKADDRS(I) := TOS;                                   35694000
                END                                                     35696000
              UNTIL (I:=I+1)=NUMBLOCKS;                                 35698000
            GOTO FOUND;                                                 35700000
            END                                                         35702000
          ELSE IF ONLYLDEV THEN GOTO TRY <<THIS DEVICE ONLY>>           35704000
          ELSE                                                          35706000
            BEGIN  <<GET SPACE ANYWHERE>>                               35708000
  ANYWHERE: SEARCH := 0;                                                35710000
            IF NOT(FLCLASSB=NUMERIC) THEN                      <<03631>>35712000
              BEGIN  <<NOT NUMERIC>>                                    35714000
              NCHAR := MOVEAN(FLCLASSB,FLCLASSB, 8);           <<s8110>>35716000
              @DCT := @DCT'HEAD + DCTH'DCT'BASE;               <<dctab>>35718000
              @DCT'B := @DCT & LSL(1);                         <<dctab>>35720000
              J := 0;                                          <<dctab>>35722000
              WHILE (J:=J+1) <= DCTH'NUM'DCT'ENTRIES DO        <<dctab>>35724000
                IF FLCLASSB=DCTB'CLASS'NAME,(NCHAR) THEN       <<s8110>>35726000
                   IF NCHAR = 8 OR                             <<s8110>>35728000
                      DCT'B(NCHAR) = " " THEN                  <<s8110>>35730000
                    GOTO GOTCLASS                                       35732000
                   ELSE                                        <<s8110>>35734000
                    BEGIN                                               35736000
  NEXTCLASS:        @DCT := @DCT + DCT'NEXT'ENTRY;             <<s8110>>35738000
                    @DCT'B := @DCT & LSL(1);                   <<dctab>>35740000
                    END                                        <<s8110>>35742000
                ELSE GOTO NEXTCLASS;                           <<s8110>>35744000
              GOTO TRYTYPE;                                             35746000
  GOTCLASS:   J := -1;                                         <<dctab>>35748000
              INDEX := DCT'CYCLICAL'PTR;                       <<*8712>>35750000
              IF INDEX >= DCT'NUM'DEVICES THEN INDEX := 0;     <<*8712>>35752000
              CLASSUSED := TRUE;                                        35754000
              WHILE(J:=J+1) <= DCT'NUM'DEVICES DO              <<dctab>>35756000
                BEGIN                                                   35758000
                LDEV := DCT(DCT'FIRST'LDEV + INDEX );          <<dctab>>35760000
                LDT'INDEX := LDEV * LDTSIZE;                   <<*LDT*>>35762000
                LPDT'INDEX := LDEV * LPDTSIZE;                 <<*LPDT>>35764000
                IF LOGICAL(LPDT'NON'SYS'DOMAIN) OR NOT         <<*LPDT>>35766000
                  SYSDISC'TYPE( LDT'DEVICE'TYPE,               <<*LDT*>>35768000
                       LPDT'SUBTYPE) THEN                      <<*LPDT>>35770000
                  GOTO NEXTLDEV;                               <<03631>>35772000
                DO IF BLOCKSIZES(I)<>0D THEN                            35774000
                  BEGIN                                                 35776000
                  TOS := GETDISCSPACE(LDEV,BLOCKSIZES(I));              35778000
                  IF <> THEN                                            35780000
                    BEGIN                                               35782000
                    DDEL;                                               35784000
                    GOTO NEXTLDEV;                                      35786000
                    END;                                                35788000
                  IF I=0 THEN SUPERDISCSPACE:=LDEV;                     35790000
                  TOS := GETVOL(LDEV);                                  35792000
                  S2.(0:8) := TOS;                                      35794000
                  BLOCKADDRS(I) := TOS;                                 35796000
                  END                                                   35798000
                UNTIL (I:=I+1)=NUMBLOCKS;                               35800000
                GOTO FOUND;                                             35802000
  NEXTLDEV:    INDEX:= (INDEX+1) MOD DCT'NUM'DEVICES;          <<dctab>>35804000
              END;                                                      35806000
            RETURNSPACE;                                                35808000
            END                                                         35810000
          ELSE                                                          35812000
            BEGIN                                                       35814000
            TOS := @FLCLASSB; <<CLASS IS LOGICAL DEVICE #>>             35816000
            DUPLICATE;DUPLICATE;                                        35818000
            MOVE *:=* WHILE N,1;                                        35820000
            ASSEMBLE(XCH,SUB);                                          35822000
            NCHAR := TOS;                                               35824000
            J := 0;                                                     35826000
            LDEV := 0;                                                  35828000
            TOS := @FLCLASSB;                                           35830000
            DO                                                          35832000
              BEGIN <<CONVERT FROM ASCII>>                              35834000
              TOS := LDEV*10;                                           35836000
              TOS := TOS+INTEGER(BPS1)-%60;                             35838000
              LDEV := TOS;                                              35840000
              END                                                       35842000
            UNTIL (J:=J+1)=NCHAR;                                       35844000
            LDT'INDEX := LDEV * LDTSIZE;                       <<*LDT*>>35846000
            LPDT'INDEX := LDEV * LPDTSIZE;                     <<*LPDT>>35848000
            IF NON'DS'LDEV(LDEV) AND                           <<03549>>35850000
               SYSDISC'TYPE( LDT'DEVICE'TYPE, LPDT'SUBTYPE)    <<*LPDT>>35852000
               AND NOT LOGICAL( LPDT'NON'SYS'DOMAIN ) THEN     <<*LPDT>>35854000
               GOTO TRY;                                       <<03549>>35856000
            END;                                                        35858000
  TRYTYPE:TYPE := TYPEWORD.(8:6);                                       35860000
          SUBTYP := TYPEWORD.(4:4);                                     35862000
          SEARCH := 1;                                                  35864000
          IF TYPE=MHDISCTYPE THEN                              <<03550>>35866000
             @STARTVOL := @MHVOLS                              <<03550>>35868000
          ELSE IF TYPE = 3 << CS80 DEVICE >> THEN              <<*LDT*>>35870000
             @STARTVOL := @CS80VOLS                            <<03550>>35872000
          ELSE                                                 <<03550>>35874000
             @STARTVOL := @FHVOLS;                             <<03550>>35876000
          VOLUME := STARTVOL(INDEX:=SUBTYP);                            35878000
  SEARCH1'2:                                                            35880000
          LDEV:= GETLDEV(VOLUME);                              <<03631>>35882000
          IF <> THEN GOTO NEXT;                                <<03631>>35884000
          LDT'INDEX := LDEV * LDTSIZE;                         <<*LDT*>>35886000
          LPDT'INDEX := LDEV * LPDTSIZE;                       <<*LPDT>>35888000
          IF LDT'DEVICE'TYPE = TYPE THEN                       <<*LDT*>>35890000
          IF LPDT'SUBTYPE=SUBTYP THEN                          <<*LPDT>>35892000
          IF SEARCH=2 THEN GOTO NEXT <<ALREADY TRIED>> ELSE GOTO TRY    35894000
          ELSE IF SEARCH=1 THEN GOTO NEXT <<WRONG SUBTYPE>>             35896000
          ELSE <<SEARCH=2,TYPE MATCHES,SUBTYPE DOESN'T>>                35898000
            BEGIN  <<TRY THIS DEVICE>>                                  35900000
  TRY:      DO IF BLOCKSIZES(I)<>0D THEN                                35902000
              BEGIN                                                     35904000
              TOS := GETDISCSPACE(LDEV,BLOCKSIZES(I));                  35906000
              IF <> THEN                                                35908000
                BEGIN <<NOT ENOUGH SPACE ON THIS DEVICE>>               35910000
                DDEL;                                                   35912000
                IF SEARCH=1 OR SEARCH=2 THEN RETURNSPACE;               35914000
                IF SEARCH=0 THEN GO TRYTYPE ELSE GOTO NEXT;             35916000
                END;                                                    35918000
              IF I=0 THEN SUPERDISCSPACE:=LDEV;                         35920000
              TOS := GETVOL(LDEV);                                      35922000
              S2.(0:8) := TOS;                                          35924000
              BLOCKADDRS(I) := TOS;                                     35926000
              END                                                       35928000
            UNTIL (I:=I+1)=NUMBLOCKS;                                   35930000
            GOTO FOUND;                                                 35932000
            END                                                         35934000
          ELSE GOTO NEXT;    <<DIFFERENT TYPE>>                         35936000
          END;   <<MATCHES THAT UNNEEDED BEGIN>>                        35938000
  NEXT:  IF SEARCH=3 THEN                                               35940000
           BEGIN <<DEVICE CLASS DISC SEARCH>>                           35942000
           DO                                                  <<03631>>35944000
             BEGIN                                             <<03631>>35946000
             INDEX:= (INDEX+1) MOD NDISCDEV;                   <<03631>>35948000
             IF INDEX=DISCLDEV THEN GOTO ERROR;                <<03631>>35950000
             LDEV := DCTAB(DISCLASS'X+DCT'FIRST'LDEV+INDEX);   <<DCLAS>>35952000
             LPDT'INDEX := LDEV * LPDTSIZE;                    <<*LPDT>>35954000
             END                                               <<03631>>35956000
           UNTIL NOT LOGICAL( LPDT'NON'SYS'DOMAIN );           <<*LPDT>>35958000
           GOTO TRY;                                                    35960000
           END;                                                         35962000
         IF ONLYLDEV THEN GOTO ERROR; <<CAN'T TRY ANY OTHER>>           35964000
         IF (VOLUME:=VOLUME+1) > HVOL THEN VOLUME := 1;        <<03550>>35966000
         IF VOLUME=STARTVOL(INDEX) THEN                                 35968000
         IF (SEARCH:=SEARCH+1)=3 THEN                                   35970000
           BEGIN  <<TRY DEVICE CLASS DISC>>                             35972000
           IF NDISCDEV=0 THEN GOTO ERROR;  <<NOTHING IN DISC>>          35974000
           INDEX:= DISCLDEV-1;                                 <<03631>>35976000
           J:= 0;                                              <<03631>>35978000
           WHILE (J:= J+1)<=NDISCDEV DO                        <<03631>>35980000
             BEGIN                                             <<03631>>35982000
             INDEX:= (INDEX+1) MOD NDISCDEV;                   <<03631>>35984000
             LDEV := DCTAB(DISCLASS'X+DCT'FIRST'LDEV+INDEX);   <<DCLAS>>35986000
             LPDT'INDEX := LDEV * LPDTSIZE;                    <<*LPDT>>35988000
             IF NOT LOGICAL( LPDT'NON'SYS'DOMAIN ) THEN        <<*LPDT>>35990000
               GOTO TRY;                                       <<03631>>35992000
             END;                                              <<03631>>35994000
           GOTO ERROR;                                         <<03631>>35996000
           END                                                          35998000
         ELSE VOLUME := STARTVOL(INDEX:=-1); <<TYPESEARCH ONLY>>        36000000
         GOTO SEARCH1'2;                                                36002000
  FOUND:  CASE *(SEARCH+1) OF                                           36004000
          BEGIN                                                         36006000
          ;                                                             36008000
              IF CLASSUSED THEN                                         36010000
                BEGIN <<UPDATE  CYCLICAL POINTER FOR THIS CLASS>>       36012000
                IF (INDEX:=INDEX+1) = DCT'NUM'DEVICES          <<dctab>>36014000
                  THEN INDEX:=0;                               <<dctab>>36016000
                DCT'CYCLICAL'PTR := INDEX;                     <<dctab>>36018000
                END;                                                    36020000
              GOTO TYPE1;                                               36022000
  TYPE1:      BEGIN  <<UPDATE CYCLICAL PTR FOR TYPE OR SUBTYPE SEARCH>> 36024000
                IF (VOLUME:=VOLUME+1)>HVOL THEN VOLUME:=1;              36026000
                STARTVOL(INDEX) := VOLUME;                              36028000
              END;                                                      36030000
              BEGIN  <<UPDATE CYCLICAL PTR FOR DEVICE CLASS DISC>>      36032000
                IF (INDEX:=INDEX+1)=NDISCDEV THEN INDEX:=0;             36034000
                DISCLDEV := INDEX;                                      36036000
              END;                                                      36038000
            END;                                                        36040000
          TOS := CCE;                                                   36042000
          GOTO EXIT;                                                    36044000
  ERROR:  TOS := CCL;                                                   36046000
          RETURNSPACE;   <<IN CASE SEARCH=3>>                           36048000
  EXIT:   STAT.(6:2) := TOS;                                            36050000
      END <<SUPERDISCSPACE>> ;                                          36052000
          <<-----------------------------                               36054000
            REMOVE OR RETURN DISC SPACE                                 36056000
          ----------------------------->>                               36058000
  PROCEDURE REMRETDSPACE(NSECT,DADDR);                                  36060000
    VALUE NSECT,DADDR;                                                  36062000
    LOGICAL NSECT;                                                      36064000
    DOUBLE DADDR;                                                       36066000
    COMMENT                                                             36068000
      RETURN (FOR COLD LOAD FROM TAPE) OR REMOVE (FOR COLD LOAD FROM    36070000
    DISC) THE DISC SPACE OF LENGTH LEN STARTING AT ADDRESS DADDR;       36072000
      BEGIN                                                             36074000
          IF DADDR = 0D THEN RETURN;                           <<06067>>36076000
          TOS := SYSDISC;                                               36078000
          TOS := 0;                                                     36080000
          TOS := NSECT;                                                 36082000
          TOS := DADDR;                                                 36084000
          IF LOADFROMTAPE THEN TOS := @RETDISCSPACE <<RETURN IT>>       36086000
          ELSE TOS := @REMDISCSPACE;  <<REMOVE IT>>                     36088000
          ASSEMBLE(PCAL 0);                                             36090000
          IF <> THEN ERRMESSAGE(M325,13);<<DISC SPACE ERROR>>  <<03632>>36092000
      END <<REMRETDSPACE>> ;                                            36094000
$PAGE "DIRECTORY ROUTINES"                                              36096000
$CONTROL SEGMENT=SETUP                                                  36098000
          <<-----------------                                           36100000
            DIRECTORY ERROR                                             36102000
          ----------------->>                                           36104000
  PROCEDURE DIRERROR(REGISTERS,FNAME);                                  36106000
    VALUE REGISTERS;                                                    36108000
    DOUBLE REGISTERS;                                                   36110000
    BYTE ARRAY FNAME;                                                   36112000
      BEGIN                                                             36114000
        INTEGER A=REGISTERS+1,    <<S-0 AFTER DIRECTORY CALL>>          36116000
                B=REGISTERS;      <<S-1 AFTER DIRECTORY CALL>> <<01103>>36118000
          IF A=2 AND B=0 THEN                                           36120000
            BEGIN  <<FILE NOT FOUND>>                                   36122000
              MOVE BLINE := "FILE ",2;                         <<01103>>36124000
              TOS := TOS+MOVEAN(BPS0,FNAME,8);                 <<01103>>36126000
              MOVE * := ".PUB.SYS NOT ON DISC",2;                       36128000
              PRINTLINE;                                       <<01103>>36130000
              ERRMESSAGE(M0);  <<DIE>>                         <<01103>>36132000
            END;                                                        36134000
          ERRMESSAGE(M277,A,B);                                <<01103>>36136000
      END <<DIRERROR>> ;                                                36138000
$CONTROL SEGMENT=DIRECTORY2                                    <<03668>>36140000
            <<--------------------------------->>              <<03668>>36142000
            <<      COMPACT A FILE NAME        >>              <<03668>>36144000
            <<--------------------------------->>              <<03668>>36146000
INTEGER PROCEDURE MOVE'FNAME( STRING, FNAME, GUNAME, ANAME);   <<03714>>36148000
BYTE ARRAY                                                     <<03668>>36150000
   STRING;      << STRING FOR RESULT >>                        <<03668>>36152000
ARRAY                                                          <<03668>>36154000
   FNAME,       << 4-WORD ARRAY HOLDING FILE NAME >>           <<03714>>36156000
   GUNAME,      << 4-WORD ARRAY HOLDING GROUP NAME >>          <<03714>>36158000
   ANAME;       << 4-WORD ARRAY HOLDING ACCOUNT NAME >>        <<03714>>36160000
                                                               <<03714>>36162000
                                                               <<03668>>36164000
COMMENT                                                        <<03668>>36166000
COMPACTS A FILE NAME BY REMOVING ALL OF THE BLANKS AND         <<03668>>36168000
PUTS PERIODS BETWEEN THE FILE AND GROUP NAME, AND THE          <<03668>>36170000
GROUP AND ACCOUNT NAMES.  IT PUTS THE RESULT INTO              <<03668>>36172000
'STRING' AND RETURNS THE LENGTH OF THE STRING IN BYTES.        <<03668>>36174000
;                                                              <<03668>>36176000
BEGIN                                                          <<03668>>36178000
BYTE ARRAY                                                     <<03668>>36180000
   BFNAME(*) = FNAME,                                          <<03714>>36182000
   BGUNAME(*) = GUNAME,                                        <<03714>>36184000
   BANAME(*) = ANAME;                                          <<03714>>36186000
BYTE                                                           <<03668>>36188000
   BDOT := ".";          << A PERIOD >>                        <<03668>>36190000
INTEGER                                                        <<03668>>36192000
   BYTES;      << TEMP. FOR NO. OF BYTES MOVED >>              <<03668>>36194000
                                                               <<03668>>36196000
BYTES := MOVEAN( STRING,               << MOVE FILE NAME >>    <<03668>>36198000
                 BFNAME, 8);                                   <<03668>>36200000
STRING(BYTES) := BDOT;                 << MOVE "." >>          <<03668>>36202000
BYTES := BYTES + 1;                                            <<03668>>36204000
BYTES := MOVEAN( STRING(BYTES),        << MOVE GROUP NAME >>   <<03668>>36206000
                 BGUNAME,8) + BYTES;                           <<03714>>36208000
STRING(BYTES) := BDOT;                 << MOVE "." >>          <<03668>>36210000
BYTES := BYTES + 1;                                            <<03668>>36212000
BYTES := MOVEAN( STRING(BYTES),        << MOVE ACCOUNT NAME >> <<03668>>36214000
                 BANAME,8) + BYTES;                            <<03714>>36216000
MOVE'FNAME := BYTES;   << RETURN NO. OF BYTES IN STRING >>     <<03668>>36218000
END;   << MOVE'FNAME >>                                        <<03668>>36220000
$CONTROL SEGMENT=SETUP                                         <<03668>>36222000
          <<-----------------                                           36224000
            PRINT FILE NAME                                             36226000
          ----------------->>                                           36228000
  PROCEDURE PRINTFNAME(NAME);                                           36230000
    ARRAY NAME;                                                         36232000
      BEGIN                                                             36234000
          MOVE LINE := NAME,(4);                               <<01103>>36236000
          LINE(4) := " .";                                     <<01103>>36238000
          MOVE LINE(5) := NAME(4),(4);                         <<01103>>36240000
          LINE(9) := " .";                                     <<01103>>36242000
          MOVE LINE(10) := NAME(8),(4);                        <<01103>>36244000
          PRINTLINE;                                           <<01103>>36246000
      END <<PRINTFNAME>> ;                                              36248000
                                                                        36250000
                                                                        36252000
          <<--------------------------                                  36254000
            PRINT FILE NAME/REASON                                      36256000
          -------------------------->>                                  36258000
PROCEDURE PRINTFNR( NAME, REASON);                             <<01103>>36260000
   VALUE REASON;                                               <<01103>>36262000
   BYTE ARRAY NAME;                                            <<01103>>36264000
   INTEGER REASON;                                             <<01103>>36266000
BEGIN                                                          <<01103>>36268000
   BYTE ARRAY HEADING(*) = PB :=                               <<01103>>36270000
      "FILE NAME",19(" "),"REASON";                            <<01103>>36272000
   BYTE ARRAY MESS(*) = PB :=                                  <<01103>>36274000
      "INSUFFICIENT DISC SPACE",                               <<01103>>36276000
      "TAPE PARITY ERROR",                                     <<01103>>36278000
      "TAPE FORMAT ERROR",                                     <<01442>>36280000
      "FILE LABEL CHECKSUM ERROR",                             <<01442>>36282000
      "SPECIFIED SPACE NOT IN DISC FREE SPACE MAP",            <<03668>>36284000
      "ON DELETED OR NEWLY REASSIGNED DISC AREA",              <<03668>>36286000
      "DEFECTIVE FILE LABEL";                                  <<03668>>36288000
   INTEGER ARRAY MSGSTART(1:8) = PB := 0,23,40,57,82,          <<03668>>36290000
                                       124,164,184;            <<03668>>36292000
                                                               <<01103>>36294000
   IF NOT HEADING'PRINTED THEN                                 <<01103>>36296000
      BEGIN                                                    <<01103>>36298000
      MOVE BLINE := HEADING,(34);                              <<01103>>36300000
      PRINTLINE;                                               <<01103>>36302000
      BLANKLINE;                                               <<01103>>36304000
      HEADING'PRINTED := TRUE;                                 <<01103>>36306000
      END;                                                     <<01103>>36308000
   MOVE BLINE := NAME,(8);                                     <<01103>>36310000
   BLINE(8) := ".";                                            <<01103>>36312000
   MOVE BLINE(9) := NAME(8),(8);                               <<01103>>36314000
   BLINE(17) := ".";                                           <<01103>>36316000
   MOVE BLINE(18) := NAME(16),(8);                             <<01103>>36318000
   IF 1 <= REASON <= 7 THEN   << VALID REASON? >>              <<03668>>36320000
      MOVE BLINE(28) := MESS(MSGSTART(REASON)),                <<01103>>36322000
           (MSGSTART(REASON+1)-MSGSTART(REASON));              <<01103>>36324000
   PRINTLINE;                                                  <<01103>>36326000
END;  << PRINTFNR >>                                           <<01103>>36328000
                                                                        36330000
                                                                        36332000
$PAGE                                                                   36334000
$CONTROL SEGMENT=DIRECTORY1                                             36336000
                                                                        36338000
          <<-------------                                               36340000
            EXCHANGE DB                                                 36342000
          ------------->>                                               36344000
  PROCEDURE EXCHANGEDB(DSTN);                                           36346000
    VALUE DSTN;                                                         36348000
    INTEGER DSTN;                                                       36350000
    COMMENT                                                             36352000
      SETS DB TO THE DATA SEGMENT REQUESTED, OR TO THE STACK IF DSTN=0; 36354000
      BEGIN                                                             36356000
          IF DSTN=0 THEN                                                36358000
            BEGIN  <<STACK>>                                            36360000
              TOS := ABSOLUTE(DBBANK);                                  36362000
              TOS := ABSOLUTE(DB);                                      36364000
            END                                                         36366000
          ELSE                                                          36368000
            BEGIN  <<DATA SEGMENT>>                                     36370000
              TOS := DST(DSTN&LSL(2)+2).(8:8);<<HI ORDER ADDR>><<01756>>36372000
              TOS := DST(X:=X+1);                                       36374000
            END;                                                        36376000
          ASSEMBLE(XCHD 0);   <<SET DB TO NEW VALUE>>                   36378000
      END <<EXCHANGEDB>> ;                                              36380000
                                                                        36382000
  PROCEDURE DIRDISC(WRITE,ADDR,BUF,WORDS);                              36384000
    VALUE WRITE,ADDR,WORDS;                                             36386000
    INTEGER WRITE,WORDS;                                                36388000
    DOUBLE ADDR;                                                        36390000
    ARRAY BUF;                                                          36392000
    COMMENT                                                             36394000
      PERFORM A DISC TRANSFER TO/FROM ONE OF THE DIRECTORY DATA         36396000
    SEGMENTS;                                                           36398000
      BEGIN                                                             36400000
          TOS := ABSOLUTE(DBBANK);                                      36402000
          TOS := ABSOLUTE(DB);                                          36404000
          ASSEMBLE(XCHD);  <<SET DB TO STACK>>                          36406000
          TOS := WRITE;                                                 36408000
          TOS := SYSDISC;                                               36410000
          TOS := ADDR;                                                  36412000
          TOS := DS5;  <<OLD DB VALUE>>                                 36414000
          TOS := TOS+@BUF;  <<ABSOLUTE BUFFER ADDRESS>>                 36416000
          DISC'(*,*,*,*,WORDS);                                         36418000
          ASSEMBLE(XCHD 0);                                             36420000
          << COUNT DISC ACCESSES >>                            <<D9089>>36422000
          TOS := DIRCDA; << LOAD ADDR  >>                      <<D9089>>36424000
          ASMB( LDEA );  << LOAD COUNT >>                      <<D9089>>36426000
          TOS := TOS+1D; << INC COUNT  >>                      <<D9089>>36428000
          ASMB( SDEA );  << STOR COUNT >>                      <<D9089>>36430000
          DDEL;          << DEL ADDRESS>>                      <<D9089>>36432000
      END <<DIRDISC>> ;                                                 36434000
$CONTROL SEGMENT=DIRECTORY2                                             36436000
          <<-------------------------                                   36438000
            WRITE FROM TAPE TO DISC                                     36440000
          ------------------------->>                                   36442000
INTEGER PROCEDURE WRITEDISC( DISCADR);                         <<03603>>36444000
   VALUE DISCADR;                                              <<03603>>36446000
   DOUBLE DISCADR;                                             <<03603>>36448000
BEGIN                                                          <<03603>>36450000
   INTEGER                                                     <<03603>>36452000
      LEN;                                                     <<03603>>36454000
   LOGICAL                                                     <<03603>>36456000
      NRSECTORS;                                               <<03603>>36458000
   DOUBLE                                                      <<03603>>36460000
      NRWORDS;                                                 <<03603>>36462000
                                                               <<03603>>36464000
   WRITEDISC := TAPEBUF(2); << NR. SECTORS >>                  <<03603>>36466000
   NRSECTORS := TAPEBUF(2);                                    <<03603>>36468000
   NRWORDS := NRSECTORS**128;                                  <<03603>>36470000
   WHILE NRWORDS <> 0D DO                                      <<03603>>36472000
      BEGIN                                                    <<03603>>36474000
      LEN := IF NRWORDS > DOUBLE(TAPERECSIZE) THEN             <<03603>>36476000
         TAPERECSIZE ELSE LOGICAL(NRWORDS);                    <<03603>>36478000
      COLD'LOAD'MEDIA( READ,TAPEBUF,LEN);                      <<03603>>36480000
      WHILE END'OF'TAPE DO                                     <<03603>>36482000
         BEGIN                                                 <<03603>>36484000
         NEXTREEL(TAPEBUF);                                    <<03603>>36486000
         COLD'LOAD'MEDIA(READ,TAPEBUF,LEN);                    <<03603>>36488000
         END;                                                  <<03603>>36490000
      DISC(WRITE,SYSDISC,DISCADR,TAPEBUF,LEN);                 <<03603>>36492000
      DISCADR := DISCADR+DOUBLE(TAPERECSIZE/128);              <<03603>>36494000
      NRWORDS := NRWORDS-DOUBLE(LEN);                          <<03603>>36496000
      END;                                                     <<03603>>36498000
END;                                                           <<03603>>36500000
$PAGE "FILE PROCEDURES"                                                 36502000
$CONTROL SEGMENT=FILEIO                                                 36504000
          <<-------------------                                         36506000
            GET EXTENT LENGTH                                           36508000
          ------------------->>                                         36510000
  LOGICAL PROCEDURE GETEXTLEN(EXTENT);                                  36512000
    VALUE EXTENT;                                                       36514000
    INTEGER EXTENT;                                                     36516000
    COMMENT                                                             36518000
      RETURNS THEN LENGTH OF THE SPECIFIED EXTENT FOR THE FILE WHOSE    36520000
    LABEL IS IN FLAB;                                                   36522000
      BEGIN                                                             36524000
          IF EXTENT<>FLNUMEXTS THEN GOTO NOTLAST                        36526000
          ELSE                                                          36528000
            BEGIN                                                       36530000
              TOS := FLFLIM;                                            36532000
              TOS := FLBLKSIZE;                                         36534000
              TOS := FLRECSIZE;                                         36536000
              IF = THEN TOS := TOS+128                                  36538000
              ELSE IF < THEN TOS := (-TOS+1)&LSR(1);                    36540000
              ASSEMBLE(DIV,DEL);                                        36542000
              X := TOS;   <<BLOCKING FACTOR>>                           36544000
              <<COMPUTE FILE LIMIT IN BLOCKS>>                          36546000
              ASSEMBLE(ZERO,CAB; LDXA,LDIV; CAB,LDXA; LDIV);            36548000
              IF TOS <> 0 THEN TOS := TOS+1D;                           36550000
              X := (FLBLKSIZE+127)&LSR(7);                              36552000
              ASSEMBLE(LDXA,LMPY; CAB,LDXA; MPY,ZERO;DADD,ZERO);        36554000
              TOS := FLSECTOFF;                                         36556000
              ASSEMBLE(DADD);                                           36558000
              TOS := FLEXTSIZE;                                         36560000
              ASSEMBLE(LDIV,TEST);                                      36562000
              IF = THEN                                                 36564000
  NOTLAST:      TOS := FLEXTSIZE;                                       36566000
            END;                                                        36568000
          GETEXTLEN := TOS;                                             36570000
      END <<GETEXTLEN>> ;                                               36572000
DOUBLE PROCEDURE RELEASE'FILE'SPACE;                           <<03603>>36574000
BEGIN                                                          <<03603>>36576000
   INTEGER                                                     <<03603>>36578000
      I := 0,                                                  <<03603>>36580000
      LDEV;                                                    <<03603>>36582000
   DOUBLE                                                      <<03603>>36584000
      EXTADR,                                                  <<03603>>36586000
      DUM1;                                                    <<03603>>36588000
   BYTE                                                        <<03603>>36590000
      EXTVOL = EXTADR;                                         <<03603>>36592000
   DOUBLE                                                      <<03603>>36594000
      SECTORS = RELEASE'FILE'SPACE;                            <<03603>>36596000
                                                               <<03603>>36598000
   WHILE I <= FLNUMEXTS DO                                     <<03603>>36600000
      BEGIN                                                    <<03603>>36602000
      EXTADR := FLABDBL(EXT0+I);                               <<03603>>36604000
      IF <> THEN                                               <<03603>>36606000
         BEGIN                                                 <<03603>>36608000
         LDEV := GETLDEV(EXTVOL);                              <<03603>>36610000
         IF <> THEN ERRMESSAGE( M452);                         <<03603>>36612000
         EXTVOL := 0;                                          <<03603>>36614000
         DUM1 := D'L(GETEXTLEN(I)));                           <<03603>>36616000
         RETDISCSPACE(LDEV,DUM1,EXTADR);                       <<03603>>36618000
         IF = THEN                                             <<03603>>36620000
            SECTORS := SECTORS+DUM1                            <<03603>>36622000
         ELSE                                                  <<03603>>36624000
            MESSAGE( M328); << RETURNING SPACE >>              <<03603>>36626000
         END;                                                  <<03603>>36628000
      I := I+1;  << NEXT EXTENT >>                             <<03603>>36630000
      END;                                                     <<03603>>36632000
END;                                                           <<03603>>36634000
$CONTROL SEGMENT=DIRECTORY2                                    <<03668>>36636000
       <<--------------------------------->>                   <<03668>>36638000
       <<          PURGE A FILE           >>                   <<03668>>36640000
       <<--------------------------------->>                   <<03668>>36642000
INTEGER PROCEDURE FPURGE(FNAME, GUNAME, ANAME);                <<03668>>36644000
ARRAY                                                          <<03668>>36646000
   FNAME,       << 4-WORD ARRAY HOLDING FILE NAME >>           <<03668>>36648000
   GUNAME,      << 4-WORD ARRAY HOLDING GROUP NAME >>          <<03668>>36650000
   ANAME;       << 4-WORD ARRAY HOLDING ACCOUNT NAME >>        <<03668>>36652000
                                                               <<03668>>36654000
COMMENT                                                        <<03668>>36656000
PURGES A FILE.  FPURGE RELEASES THE SPACE HELD BY THE          <<03668>>36658000
GIVEN FILE AND REMOVES THE DIRECTORY ENTRY.   IF THE           <<03668>>36660000
FILE WAS NOT FOUND IN THE DIRECTORY, IT RETURNS WITH           <<03668>>36662000
AN ERROR NUMBER.  THE RETURNS ARE:                             <<03668>>36664000
                                                               <<03668>>36666000
             0   FILE PURGED OK                                <<03668>>36668000
             2   FILE NOT FOUND                                <<03668>>36670000
             4   FILE PURGED BUT UNABLE TO RELEASE SPACE       <<03668>>36672000
                 DUE TO FILE LABEL CHECKSUM ERROR              <<03668>>36674000
                                                               <<03668>>36676000
;                                                              <<03668>>36678000
BEGIN                                                          <<03668>>36680000
DOUBLE                                                         <<03668>>36682000
   DUM1,        << THESE THREE DOUBLES ARE USED FOR A     >>   <<03668>>36684000
   DUM2,        << CALL TO DIRECFIND.  DO NOT TOUCH THIS  >>   <<03668>>36686000
   FILEADR;     << DECLARATION.  FILEADR IS THE VOLUME    >>   <<03668>>36688000
                << AND ADDRESS OF THE FILE LABEL.         >>   <<03668>>36690000
ARRAY                                                          <<03668>>36692000
   FILENT(*) = DUM1;     << ARRAY FOR DIRECTORY ENTRY >>       <<03668>>36694000
INTEGER                                                        <<03668>>36696000
   FILEADR1 = FILEADR,    << HIGH ORDER WORD OF FILEADR >>     <<03668>>36698000
   FILEADR2 = FILEADR+1,  << LOW ORDER WORD OF FILEADR  >>     <<03668>>36700000
   LDEV;                  << LOGICAL DEVICE NO. OF LABEL >>    <<03668>>36702000
BYTE                                                           <<03668>>36704000
   VOLUME = FILEADR;      << VOLUME NO. OF FILE LABEL >>       <<03668>>36706000
DOUBLE                                                         <<03668>>36708000
   DTEMP,      << DOUBLE WORD TEMP. >>                         <<03668>>36710000
   SECTORS;    << NO. OF SECTORS IN FILE >>                    <<03668>>36712000
INTEGER                                                        <<03668>>36714000
   SECTORS1 = SECTORS,    << HIGH ORDER WORD OF SECTORS >>     <<03668>>36716000
   SECTORS2 = SECTORS+1,  << LOW ORDER WORD OF SECTORS >>      <<03668>>36718000
   DTEMP2 = DTEMP+1;      << LOW ORDER WORD OF DTEMP >>        <<03668>>36720000
                                                               <<03668>>36722000
FPURGE := 0;     << INITIALIZE RETURN >>                       <<03668>>36724000
                                                               <<03668>>36726000
<< GET THE DIRECTORY ENTRY FOR THE FILE >>                     <<03668>>36728000
                                                               <<03668>>36730000
DTEMP := DIRECFIND(FILETYPE,0,ANAME,GUNAME,FNAME,FILENT);      <<03668>>36732000
IF < THEN                                                      <<03668>>36734000
   DIRERROR( DTEMP, BBUF);    << DIRECTORY ERROR >>            <<03668>>36736000
IF > THEN                                                      <<03668>>36738000
   IF DTEMP2 <> 2 THEN         << ERROR OTHER THAN  >>         <<03668>>36740000
      DIRERROR(DTEMP, BBUF)    <<   FILE NOT FOUND  >>         <<03668>>36742000
                                                               <<03668>>36744000
   ELSE                                                        <<03668>>36746000
      BEGIN                                                    <<03668>>36748000
      FPURGE := 2;     << RETURN FILE NOT FOUND >>             <<03668>>36750000
      RETURN;                                                  <<03668>>36752000
      END;                                                     <<03668>>36754000
                                                               <<03668>>36756000
LDEV := GETLDEV(VOLUME);                                       <<03668>>36758000
IF <> THEN ERRMESSAGE( M452);    << INVALID VOLUME NO. >>      <<03668>>36760000
                                                               <<03668>>36762000
FILEADR1 := FILEADR1.(9:7);   << GET RID OF THE VOLUME PART >> <<03668>>36764000
DISC(READ,LDEV,FILEADR,FLAB,128);    << READ THE FILE LABEL >> <<03668>>36766000
                                                               <<03668>>36768000
SECTORS := 0D;     << INITIALIZE NO. SECTORS RELEASED >>       <<03668>>36770000
                                                               <<03668>>36772000
CHECKSUM;          << TAKE FILE LABEL CHECKSUM >>              <<03668>>36774000
IF TOS = FLCHECKSUM THEN              << IF GOOD CHECKSUM,  >> <<03668>>36776000
   SECTORS := -RELEASE'FILE'SPACE     <<    RELEASE SPACE   >> <<03668>>36778000
ELSE                                                           <<03668>>36780000
   BEGIN                                                       <<03668>>36782000
   MESSAGE( M450);        << DON'T TRY RELEASING SPACE >>      <<03668>>36784000
   FPURGE := 4;                                                <<03668>>36786000
   END;                                                        <<03668>>36788000
                                                               <<03668>>36790000
<< REMOVE THE FILE DIRECTORY ENTRY >>                          <<03668>>36792000
                                                               <<03668>>36794000
DTEMP := DIRECPURGEFILE(SECTORS1,SECTORS2,ANAME,GUNAME,FNAME); <<03668>>36796000
IF <> THEN                                                     <<03668>>36798000
   DIRERROR(DTEMP,BBUF);    << DIRECTORY ERROR >>              <<03668>>36800000
                                                               <<03668>>36802000
END;   << FPURGE >>                                            <<03668>>36804000
$CONTROL SEGMENT=DIRECTORY2                                    <<03715>>36806000
     <<--------------------------------------------->>         <<03715>>36808000
     << ADD A FILE TO LIST OF FILES WHICH LOST DATA >>         <<03715>>36810000
     <<--------------------------------------------->>         <<03715>>36812000
LOGICAL PROCEDURE ADD'BADFILE(FNAME);                          <<03715>>36814000
ARRAY                                                          <<03715>>36816000
   FNAME;    << 12-WORD ARRAY CONTAINING FILE NAME >>          <<03715>>36818000
                                                               <<03715>>36820000
COMMENT                                                        <<03715>>36822000
THIS PROCEDURE ADDS A FILE NAME TO AN ARRAY CONTAINING A       <<03715>>36824000
LIST OF FILES WHICH LOST DATA DURING SPARING AND WHICH         <<03715>>36826000
THE USER WILL BE GIVEN THE OPPORTUNITY TO SAVE.  IF THERE      <<03715>>36828000
IS NO ROOM IN THE TABLE, IT RETURNS FALSE.                     <<03715>>36830000
;                                                              <<03715>>36832000
BEGIN                                                          <<03715>>36834000
EQUATE                                                         <<03715>>36836000
   ENT'SIZE = 12,      << SIZE OF FILE ENTRY IN WORDS >>       <<03715>>36838000
   NUM'ENTRIES = 0,    << NUMBER OF FILE ENTRIES IN TABLE >>   <<03715>>36840000
   EMPTY = 0;          << SIGNIFIES EMPTY ENTRY >>             <<03715>>36842000
INTEGER                                                        <<03715>>36844000
   INDEX;             << CURRENT INDEX INTO TABLE >>           <<03715>>36846000
                                                               <<03715>>36848000
                                                               <<03715>>36850000
<< FIND FIRST EMPTY ENTRY >>                                   <<03715>>36852000
                                                               <<03715>>36854000
ADD'BADFILE := FALSE;     << INITIALIZE RETURN >>              <<03715>>36856000
INDEX := 0;                                                    <<03715>>36858000
                                                               <<03715>>36860000
WHILE (INDEX := INDEX + ENT'SIZE)         << SEARCH UNTIL   >> <<03715>>36862000
       <= (LDMAP'SIZE - ENT'SIZE) DO      <<   END OF TABLE >> <<03715>>36864000
                                                               <<03715>>36866000
   IF LDMAPBUF(INDEX) = EMPTY THEN                             <<03715>>36868000
      BEGIN                            << FOUND EMPTY ENTRY >> <<03715>>36870000
                                       << SAVE FILE NAME    >> <<03715>>36872000
      MOVE LDMAPBUF(INDEX) := FNAME,(ENT'SIZE);                <<03715>>36874000
                                    << INCREMENT FILE COUNT >> <<03715>>36876000
      LDMAPBUF(NUM'ENTRIES) := LDMAPBUF(NUM'ENTRIES) + 1;      <<03715>>36878000
      ADD'BADFILE := TRUE;                                     <<03715>>36880000
      RETURN;                          << SUCCESSFUL RETURN >> <<03715>>36882000
      END;                                                     <<03715>>36884000
                                                               <<03715>>36886000
END;   << ADD'BADFILE >>                                       <<03715>>36888000
$CONTROL SEGMENT=DIRECTORY2                                    <<03668>>36890000
     <<------------------------------------------------>>      <<03668>>36892000
     << REMOVE FILE FROM LIST OF FILES WHICH LOST DATA >>      <<03668>>36894000
     <<------------------------------------------------>>      <<03668>>36896000
PROCEDURE REMOVE'BADFILE(FNAME);                               <<03668>>36898000
ARRAY                                                          <<03668>>36900000
   FNAME;      << 12-WORD ARRAY CONTAINING FILE NAME >>        <<03668>>36902000
                                                               <<03668>>36904000
COMMENT                                                        <<03668>>36906000
REMOVES THE GIVEN FILE NAME FROM THE TABLE OF FILES            <<03668>>36908000
WHICH LOST DATA.                                               <<03668>>36910000
;                                                              <<03668>>36912000
BEGIN                                                          <<03668>>36914000
EQUATE                                                         <<03668>>36916000
   ENT'SIZE = 12,     << SIZE OF ENTRY IN TABLE >>             <<03668>>36918000
   NUM'ENTRIES = 0,   << NUMBER OF FILE ENTRIES IN TABLE >>    <<03668>>36920000
   EMPTY = 0;         << SIGNIFIES EMPTY ENTRY >>              <<03668>>36922000
INTEGER                                                        <<03668>>36924000
   INDEX;             << CURRENT INDEX INTO TABLE >>           <<03668>>36926000
BYTE ARRAY                                                     <<03668>>36928000
   BLDMAPBUF(*)=LDMAPBUF,     << BYTE POINTER TO TABLE >>      <<03668>>36930000
   BFNAME(*)=FNAME;   << BYTE POINTER TO FILE NAME >>          <<03668>>36932000
                                                               <<03668>>36934000
                                                               <<03668>>36936000
INDEX := 0;                                                    <<03668>>36938000
                                                               <<03668>>36940000
WHILE (INDEX := INDEX + ENT'SIZE)      << SEARCH ALL TABLE >>  <<03715>>36942000
       <= (LDMAP'SIZE - ENT'SIZE) DO                           <<03715>>36944000
   BEGIN                                                       <<03668>>36946000
                                                               <<03668>>36948000
   IF LDMAPBUF(INDEX) <> EMPTY THEN                            <<03668>>36950000
                                                               <<03668>>36952000
      << IF WE FIND THE FILE NAME WE'RE LOOKING FOR, >>        <<03668>>36954000
      << REMOVE IT FROM THE LIST.                    >>        <<03668>>36956000
                                                               <<03668>>36958000
      IF BFNAME = BLDMAPBUF(INDEX*2),(ENT'SIZE*2) THEN         <<03668>>36960000
         BEGIN                                                 <<03668>>36962000
         LDMAPBUF(NUM'ENTRIES) := LDMAPBUF(NUM'ENTRIES) - 1;   <<03668>>36964000
         LDMAPBUF(INDEX) := EMPTY;                             <<03668>>36966000
         END;                                                  <<03668>>36968000
                                                               <<03668>>36970000
   END;                                                        <<03715>>36972000
                                                               <<03668>>36974000
END;   << REMOVE'BADFILE >>                                    <<03668>>36976000
$CONTROL SEGMENT=DIRECTORY2                                    <<03668>>36978000
      <<------------------------------------------->>          <<03668>>36980000
      <<  ASK IF USER WANTS TO SAVE DAMAGED FILES  >>          <<03668>>36982000
      <<------------------------------------------->>          <<03668>>36984000
PROCEDURE FILE'DAMAGE;                                         <<03668>>36986000
                                                               <<03668>>36988000
COMMENT                                                        <<03668>>36990000
THIS PROCEDURE LETS THE USER DECIDE WHAT TO DO WITH FILES      <<03668>>36992000
WHICH LOST DATA DURING SPARING (REASSIGNING).  THE USER        <<03668>>36994000
IS GIVEN THE OPTION OF PURGING ALL FILES WHICH LOST DATA,      <<03668>>36996000
OR SAVING ANY SELECTED FILE.                                   <<03668>>36998000
                                                               <<03668>>37000000
                                                               <<03668>>37002000
                                                               <<03668>>37004000
;                                                              <<03668>>37006000
BEGIN                                                          <<03668>>37008000
EQUATE                                                         <<03668>>37010000
   ENT'SIZE = 12,    << SIZE OF FILE ENTRY IN TABLE >>         <<03668>>37012000
   NUM'ENTRIES = 0,  << NUMBER OF FILE ENTRIES IN TABLE >>     <<03668>>37014000
   EMPTY = 0;        << SIGNIFIES AN EMPTY ENTRY >>            <<03668>>37016000
INTEGER                                                        <<03668>>37018000
   INDEX,            << INDEX INTO TABLE >>                    <<03668>>37020000
   BYTES;            << TEMP. FOR NO. OF BYTES IN A STRING >>  <<03668>>37022000
BYTE ARRAY                                                     <<03668>>37024000
   STRING(0:27);     << STRING TO HOLD FILE NAME >>            <<03668>>37026000
                                                               <<03668>>37028000
IF LDMAPBUF(NUM'ENTRIES) = 0 THEN     << IF NO BAD FILES,  >>  <<03668>>37030000
   RETURN;                            <<    JUST RETURN    >>  <<03668>>37032000
                                                               <<03668>>37034000
BLANKLINE;                                                     <<03668>>37036000
MESSAGE(M2286);       << FOLLOWING FILES LOST DATA >>          <<03668>>37038000
                                                               <<03668>>37040000
INDEX := 0;                                                    <<03668>>37042000
WHILE (INDEX := INDEX + ENT'SIZE)       << PRINT ALL FILES >>  <<03715>>37044000
       <= (LDMAP'SIZE - ENT'SIZE) DO    << WHICH LOST DATA >>  <<03715>>37046000
                                                               <<03668>>37048000
   IF LDMAPBUF(INDEX) <> EMPTY THEN                            <<03668>>37050000
      BEGIN                                                    <<03668>>37052000
      BYTES := MOVE'FNAME( BINBUF, LDMAPBUF(INDEX),            <<03714>>37054000
                                   LDMAPBUF(INDEX+4),          <<03714>>37056000
                                   LDMAPBUF(INDEX+8));         <<03714>>37058000
      PRINT( INBUF, -BYTES, 0);                                <<03668>>37060000
      END;                                                     <<03668>>37062000
                                                               <<03668>>37064000
                                                               <<03715>>37066000
BLANKLINE;                                                     <<03668>>37068000
                                                               <<03668>>37070000
IF LGETYESNO(M2287) THEN       << PURGE ALL FILES WHICH >>     <<03668>>37072000
   BEGIN                       <<    LOST DATA          >>     <<03668>>37074000
                                                               <<03668>>37076000
   BLANKLINE;                                                  <<03668>>37078000
   INDEX := 0;                                                 <<03668>>37080000
                                                               <<03668>>37082000
   WHILE (INDEX := INDEX + ENT'SIZE)    << SEARCH ALL TABLE >> <<03715>>37084000
          <= (LDMAP'SIZE - ENT'SIZE) DO                        <<03715>>37086000
                                                               <<03668>>37088000
      IF LDMAPBUF(INDEX) <> EMPTY THEN    << A REAL ENTRY >>   <<03668>>37090000
         BEGIN                                                 <<03668>>37092000
         BYTES := MOVE'FNAME( BINBUF, LDMAPBUF(INDEX),         <<03714>>37094000
                                      LDMAPBUF(INDEX+4),       <<03714>>37096000
                                      LDMAPBUF(INDEX+8));      <<03714>>37098000
         MOVE BINBUF(BYTES) := " PURGED";                      <<03668>>37100000
         PRINT( INBUF, -BYTES-7, 0);                           <<03668>>37102000
         FPURGE(LDMAPBUF(INDEX),LDMAPBUF(INDEX+4),             <<03668>>37104000
                                LDMAPBUF(INDEX+8));            <<03668>>37106000
                                                               <<03668>>37108000
         END;                                                  <<03668>>37110000
                                                               <<03668>>37112000
   END                                                         <<03668>>37114000
                                                               <<03668>>37116000
ELSE                                                           <<03668>>37118000
   BEGIN       << ASK USER WHETHER TO SAVE EACH FILE >>        <<03668>>37120000
                                                               <<03668>>37122000
   BLANKLINE;                                                  <<03668>>37124000
                                                               <<03668>>37126000
   INDEX := 0;                                                 <<03668>>37128000
                                                               <<03668>>37130000
   WHILE (INDEX := INDEX + ENT'SIZE)    << SEARCH ALL TABLE >> <<03715>>37132000
          <= (LDMAP'SIZE - ENT'SIZE) DO                        <<03715>>37134000
                                                               <<03668>>37136000
      IF LDMAPBUF(INDEX) <> EMPTY THEN                         <<03668>>37138000
         BEGIN                                                 <<03668>>37140000
                                                               <<03668>>37142000
         STRING(0) := MOVE'FNAME( STRING(1), LDMAPBUF(INDEX),  <<03714>>37144000
                                          LDMAPBUF(INDEX+4),   <<03714>>37146000
                                          LDMAPBUF(INDEX+8));  <<03714>>37148000
                                                               <<03668>>37150000
         IF NOT LGETYESNO(M2288,,,,,STRING) THEN   << SAVE? >> <<03668>>37152000
            BEGIN                                              <<03668>>37154000
            BYTES := MOVE'FNAME( BINBUF, LDMAPBUF(INDEX),      <<03714>>37156000
                                         LDMAPBUF(INDEX+4),    <<03714>>37158000
                                         LDMAPBUF(INDEX+8));   <<03714>>37160000
            MOVE BINBUF(BYTES) := " PURGED";                   <<03668>>37162000
            PRINT( INBUF, -BYTES-7, 0);                        <<03668>>37164000
                                                               <<03668>>37166000
            FPURGE( LDMAPBUF(INDEX), LDMAPBUF(INDEX+4),        <<03668>>37168000
                                     LDMAPBUF(INDEX+8));       <<03668>>37170000
                                                               <<03668>>37172000
            END;                                               <<03668>>37174000
         END;                                                  <<03668>>37176000
                                                               <<03668>>37178000
   END;                                                        <<03668>>37180000
END;   << FILE'DAMAGE >>                                       <<03668>>37182000
                                                               <<03668>>37184000
$CONTROL SEGMENT=FILEIO                                        <<03668>>37186000
          <<--------------                                              37188000
            REPLACE FILE                                                37190000
          -------------->>                                              37192000
  PROCEDURE FREPLACE(DONOTREAD);                                        37194000
    VALUE DONOTREAD;                                                    37196000
    LOGICAL DONOTREAD; <<TRUE IF DON'T READ NEW FILE FROM TAPE>>        37198000
    OPTION VARIABLE;                                                    37200000
    COMMENT                                                             37202000
      DELETES THE FILE WHOSE FIRST 1024 WORDS ARE IN LBUF FROM THE      37204000
    DIRECTORY, RETURNS ITS SPACE AND INSERTS A NEW COPY READ FROM TAPE; 37206000
      BEGIN                                                             37208000
        LOGICAL VAR=Q-4;                                                37210000
        DOUBLE DUM1,DUM2,FILEADR;                                       37212000
        ARRAY FILENT(*)=DUM1;                                           37214000
        INTEGER I,LEN,FILEADR1=FILEADR,                        <<03603>>37216000
          FILEADR2=FILEADR1+1,LDEV;                                     37218000
        BYTE VOLUME = FILEADR;                                 <<03603>>37220000
        DOUBLE SECTORS;                                                 37222000
        INTEGER SECTORS1=SECTORS,SECTORS2=SECTORS+1;                    37224000
        DOUBLE DTEMP, DISCADR, WORDS;                          <<03603>>37226000
        LOGICAL FIRSTTIME; << THE FIRST REC. OF TAPE HAS >>    <<03603>>37228000
                           << ALREADY BEEN READ BEFORE   >>    <<03603>>37230000
                           << ENTERING FREPLACE          >>    <<03603>>37232000
        DOUBLE ARRAY SIZES(0:31);                              <<03603>>37234000
                                                               <<03603>>37236000
          MOVE FLAB := TAPEBUF,(128);                          <<03603>>37238000
          CHECKSUM;                                            <<03603>>37240000
          IF TOS <> FLCHECKSUM THEN                            <<03603>>37242000
             ERRMESSAGE( M451);                                <<03603>>37244000
          TOS := DIRECFIND(FILETYPE,0,TAPEBUF(8),TAPEBUF(4),   <<03603>>37246000
             TAPEBUF,FILENT);                                  <<03603>>37248000
          IF < THEN DIRERROR(*,BLBUF);                                  37250000
          IF > THEN IF S0<>2 THEN DIRERROR(*,BLBUF)                     37252000
          ELSE GOTO READNEW;                                            37254000
          DDEL;                                                         37256000
          SECTORS := 0D;                                                37258000
          IF RELOAD THEN NUSERFILES:=NUSERFILES-1                       37260000
          ELSE                                                          37262000
           BEGIN                                                        37264000
            LDEV := GETLDEV(VOLUME);                           <<03603>>37266000
            IF <> THEN ERRMESSAGE( M452);                      <<03603>>37268000
            FILEADR1 := FILEADR1.(9:7);                                 37270000
            DISC(READ,LDEV,FILEADR,FLAB,128);                           37272000
            CHECKSUM;                                          <<03603>>37274000
            IF TOS = FLCHECKSUM THEN                           <<03603>>37276000
               SECTORS := -RELEASE'FILE'SPACE                  <<03603>>37278000
            ELSE                                               <<03603>>37280000
               MESSAGE( M450);                                 <<03603>>37282000
           END;                                                         37284000
          TOS := DIRECPURGEFILE(SECTORS1,SECTORS2,TAPEBUF(8),  <<03603>>37286000
             TAPEBUF(4),TAPEBUF);                              <<03603>>37288000
          IF <> THEN DIRERROR(*,BLBUF);                                 37290000
  READNEW:DDEL;                                                         37292000
          MOVE FLAB := TAPEBUF,(128);                          <<03603>>37294000
          I := 0;                                                       37296000
          SECTORS := 0D;                                                37298000
          DO IF FLABDBL(EXT0+I)=0D THEN SIZES(I):=0D                    37300000
          ELSE                                                          37302000
            BEGIN  <<CALCULATE EXTENT SIZE>>                            37304000
              TOS := 0;                                                 37306000
              TOS := GETEXTLEN(I);                                      37308000
              ASSEMBLE(DDUP);                                           37310000
              SECTORS := TOS+SECTORS;                                   37312000
              SIZES(I) := TOS;                                          37314000
            END                                                         37316000
          UNTIL (I:=I+1) > FLNUMEXTS;                                   37318000
          SUPERDISCSPACE(-SYSDISC,FLNUMEXTS+1,0,SIZES,FLEXT0);          37320000
          IF <> THEN ERRMESSAGE(M326, SYSDISC); <<OUT OF DISC>><<MPEIV>>37322000
          FILEADR := FLABDBL(EXT0);                                     37324000
          VOLUME := SYSVOL;                                    <<03603>>37326000
          FLCLASS := "1 ";                                              37328000
          IF VAR AND DONOTREAD THEN GO WRITELAB;                        37330000
          FIRSTTIME := TRUE; << FIRST REC. ALREADY READ >>     <<03603>>37332000
          I := 0;                                                       37334000
          DO                                                            37336000
            BEGIN  <<READ FILE FROM TAPE>>                     <<03603>>37338000
            DISCADR := FLABDBL(EXT0+I);                        <<03603>>37340000
            IF <> THEN                                         <<03603>>37342000
               BEGIN                                           <<03603>>37344000
               TOS := FLABDBL(X);                              <<03603>>37346000
               BS1 := SYSVOL; << INSERT SYSTEM VOL NR. >>      <<03603>>37348000
               FLABDBL(X) := TOS;                              <<03603>>37350000
               END;                                            <<03603>>37352000
            WORDS := SIZES(I) * 128D;                          <<03603>>37354000
            WHILE WORDS <> 0D DO                               <<03603>>37356000
               BEGIN                                           <<03603>>37358000
               LEN := IF WORDS > DOUBLE(TAPERECSIZE) THEN      <<03603>>37360000
                  TAPERECSIZE ELSE LOGICAL(WORDS);             <<03603>>37362000
               IF NOT FIRSTTIME THEN                           <<03603>>37364000
                  BEGIN  << MUST READ REC. FROM TAPE >>        <<03603>>37366000
                  COLD'LOAD'MEDIA( READ, TAPEBUF, LEN);        <<03603>>37368000
                  WHILE END'OF'TAPE DO                         <<03603>>37370000
                     BEGIN                                     <<03603>>37372000
                     NEXTREEL( TAPEBUF);                       <<03603>>37374000
                     COLD'LOAD'MEDIA( READ, TAPEBUF, LEN);     <<03603>>37376000
                     END;                                      <<03603>>37378000
                  END;                                         <<03603>>37380000
               FIRSTTIME := FALSE;                             <<03603>>37382000
               DISC(WRITE,SYSDISC,DISCADR,TAPEBUF,LEN);        <<03603>>37384000
               DISCADR := DISCADR+DOUBLE(LEN/128);             <<03603>>37386000
               WORDS := WORDS-DOUBLE(LEN);                     <<03603>>37388000
               END;                                            <<03603>>37390000
          END UNTIL (I:=I+1) > FLNUMEXTS;                      <<03603>>37392000
  WRITELAB:FLCLID := COLDLOADID;                                        37394000
          FLFCBVECT := 0D;                                     <<*FLAB>>37396000
          TOS := 0;                                                     37398000
          I := 0;                                                       37400000
          DO IF BFLAB=PROTECTED(I*8),(8) THEN TOS.(15:1):=1             37402000
          UNTIL (I:=I+1)=NPROTECTED;                                    37404000
          TOS.(4:4) := SYSDISCSUBTYPE;                                  37406000
          TOS.(8:6) := SYSDISCTYPE;                                     37408000
          FLAB(28) := TOS;                                              37410000
          TOS := DIRECINSERTFILE(SECTORS,FLAB(8),FLAB(4),FLAB,FILEADR); 37412000
          IF <> THEN DIRERROR(*,BFLAB);                                 37414000
          DDEL;                                                         37416000
          VOLUME := 0;                                         <<03603>>37418000
          FLPVINFO:=0; <<IN CASE SYSTEM PROG CAME FROM PV>>    <<00678>>37420000
          CHECKSUM;           <<NEW CHECKSUM ON TOS>>                   37422000
          FLCHECKSUM := TOS;  <<UPDATE FLAB>>                           37424000
          DISC(WRITE,SYSDISC,FILEADR,FLAB,128);                         37426000
      END <<FREPLACE>> ;                                                37428000
$PAGE                                                                   37430000
$CONTROL SEGMENT=FILEIO                                                 37432000
                                                                        37434000
                                                                        37436000
          <<-----------                                                 37438000
            OPEN FILE                                                   37440000
          ----------->>                                                 37442000
  INTEGER PROCEDURE FOPEN(NAME);                                        37444000
    BYTE ARRAY NAME;                                                    37446000
    COMMENT                                                             37448000
      READS THEN FILELABEL FOR THE REQUESTED FILE AND MOVES THE INFO    37450000
    INTO THE FCB;                                                       37452000
      BEGIN                                                             37454000
        DOUBLE DUM1,DUM2,FILEADR;                                       37456000
        INTEGER FILEADR1=FILEADR;                                       37458000
        POINTER FILENAME;                                      <<04306>>37460000
        ARRAY FILENTRY(*)=DUM1;                                <<04306>>37462000
        BYTE VOLUME = FILEADR;                                 <<03603>>37464000
        INTEGER FCBNDX;                                                 37466000
        INTEGER I, LDEV;                                       <<03603>>37468000
          @FILENAME := WORDADDRESS(NAME);                      <<04306>>37470000
          TOS := DIRECFIND(FILETYPE+2,XPPUBFILES,SYSACCT,      <<S9090>>37472000
             PUBGRP,FILENAME,FILENTRY);                        <<S9090>>37474000
          IF <> THEN DIRERROR(*,NAME);                                  37476000
          DDEL;                                                         37478000
          LDEV := GETLDEV(VOLUME);                             <<03603>>37480000
          IF <> THEN ERRMESSAGE( M452);                        <<03603>>37482000
          VOLUME := 0;                                         <<03603>>37484000
          DISC(READ,LDEV,FILEADR,FLAB,128);                    <<03716>>37486000
          CHECKSUM;                                            <<03603>>37488000
          IF TOS <> FLCHECKSUM THEN                            <<03603>>37490000
             ERRMESSAGE( M450);                                <<03603>>37492000
          TOS := FCBHD;                                                 37494000
          ASSEMBLE(DUP,DUP; STAX);                                      37496000
          FCBNDX := TOS;                                                37498000
          TOS := FCBSIZE;                                               37500000
          ASSEMBLE(DIV,DEL);                                            37502000
          FOPEN := TOS;                                                 37504000
          FCBHD := FCB(X);                                              37506000
          MOVE FCB(FCBNDX+FCBEXTMAP) := FLEXTMAP,(64);                  37508000
          I := 0;                                                       37510000
          WHILE I <= FLNUMEXTS DO                              <<03603>>37512000
             BEGIN                                             <<03603>>37514000
             TOS := FCB(FCBNDX+FCBEXTMAP+I&LSL(1));            <<03603>>37516000
             IF <> THEN                                        <<03603>>37518000
                BEGIN                                          <<03603>>37520000
                BS0 := GETLDEV(BS0);                           <<03603>>37522000
                IF <> THEN ERRMESSAGE( M452);                  <<03603>>37524000
                FCB(X) := TOS;                                 <<03603>>37526000
                END                                            <<03603>>37528000
             ELSE                                              <<03603>>37530000
                DEL;                                           <<03603>>37532000
             I := I+1; << NEXT EXTENT >>                       <<03603>>37534000
             END;                                              <<03603>>37536000
          FCB(FCBNDX+FCBLDEV) := LDEV;                         <<03603>>37538000
          FCB(FCBNDX+FCBEXTSIZE) := FLEXTSIZE;                          37540000
          FCB(FCBNDX+FCBNEXTWORD) := FLNEXTWORD;                        37542000
          FCBDBL(FCBNDX&LSR(1)+FCBEOF) := FLEOF;                        37544000
          FCBDBL(FCBNDX&LSR(1)+FCBFILESIZE) := FLFLIM;                  37546000
      END <<FOPEN>> ;                                                   37548000
          <<------------                                                37550000
            CLOSE FILE                                                  37552000
          ------------>>                                                37554000
  PROCEDURE FCLOSE(FILENUM);                                            37556000
    VALUE FILENUM;                                                      37558000
    INTEGER FILENUM;                                                    37560000
      BEGIN                                                             37562000
          FCB(FILENUM*FCBSIZE) := FCBHD;                                37564000
          FCBHD := X;                                                   37566000
      END <<FCLOSE>> ;                                                  37568000
                                                                        37570000
          <<---------------------                                       37572000
            FILE WRITE AND READ                                         37574000
          --------------------->>                                       37576000
  PROCEDURE FWRITE'(FILENUM,RECORD,COREADR,WORDS);                      37578000
    VALUE FILENUM,RECORD,COREADR,WORDS;                                 37580000
    INTEGER FILENUM,WORDS;                                              37582000
    DOUBLE RECORD,COREADR;                                              37584000
      BEGIN                                                             37586000
        ENTRY FREAD';                                                   37588000
        LOGICAL WRITE:=1;                                               37590000
        INTEGER FCBNDX,FCBDNDX;                                         37592000
        INTEGER WORD1,NREC;                                    <<03603>>37594000
        DOUBLE DISCADR;                                        <<03603>>37596000
        BYTE LDEV = DISCADR;                                   <<03603>>37598000
          GO AROUND;                                                    37600000
  FREAD': WRITE := 0;                                                   37602000
  AROUND:                                                               37604000
          << COUNT DISC ACCESSES >>                            <<D9089>>37606000
          TOS := FRFWDA; << LOAD ADDR  >>                      <<D9089>>37608000
          ASMB( LDEA );  << LOAD COUNT >>                      <<D9089>>37610000
          TOS := TOS+1D; << INC COUNT  >>                      <<D9089>>37612000
          ASMB( SDEA );  << STOR COUNT >>                      <<D9089>>37614000
          DDEL;          << DEL ADDRESS>>                      <<D9089>>37616000
          TOS := FILENUM*FCBSIZE;                                       37618000
          DUPLICATE;                                                    37620000
          FCBDNDX := TOS&LSR(1);                                        37622000
          FCBNDX := TOS;                                                37624000
          TOS := 0;                                                     37626000
          TOS := WORDS;                                                 37628000
          IF = THEN RETURN;                                             37630000
          WORD1 := S0;                                                  37632000
          TOS := (TOS+127)&LSR(7);                                      37634000
          NREC := S0;                                                   37636000
          TOS := TOS+RECORD;                                            37638000
          TOS := IF WRITE THEN FCBDBL(FCBFILESIZE+FCBDNDX)              37640000
          ELSE FCBDBL(FCBDNDX+FCBEOF)+1D;                               37642000
          ASSEMBLE(DCMP);                                               37644000
IF >THEN IF WRITE THEN ERRMESSAGE(M28) ELSE ERRMESSAGE(M2455); <<01103>>37646000
AGAIN:                                                         <<03603>>37648000
          TOS := RECORD+DOUBLE(FCB(FCBNDX+FCBSECTOFF));                 37650000
          TOS := FCB(FCBNDX+FCBEXTSIZE);                                37652000
          ASSEMBLE(LDIV);                                               37654000
          TOS := FCB(FCBNDX+FCBEXTSIZE)-S0;  <<# OF RECS LEFT>>         37656000
          IF S0<NREC THEN                                               37658000
            BEGIN                                                       37660000
              ASSEMBLE(DUP,DUP);                                        37662000
              NREC := -TOS+NREC;                                        37664000
              ASSEMBLE(ZERO,XCH);                                       37666000
              RECORD := TOS+RECORD;                                     37668000
              WORD1 := TOS&LSL(7);                                      37670000
            END                                                         37672000
          ELSE                                                          37674000
            BEGIN                                                       37676000
              DEL;                                                      37678000
              WORD1 := WORDS;                                           37680000
            END;                                                        37682000
          ASSEMBLE(STBX,DELB;ZERO,XCH);   <<EXTENT # IN X>>             37684000
          X := X+FCBEXTMAP+FCBDNDX;                                     37686000
          DISCADR := TOS+FCBDBL(X); <<DISC ADDRESS>>           <<03603>>37688000
          DISC'(WRITE,LDEV,DISCADR,COREADR,WORD1);             <<03603>>37690000
          WORDS := WORDS-WORD1;                                         37692000
          IF <= THEN RETURN;                                            37694000
          COREADR := COREADR+DOUBLE(WORD1);                    <<03603>>37696000
          GO AGAIN;                                                     37698000
      END <<FWRITE' AND FREAD'>> ;                                      37700000
  PROCEDURE FWRITE(FILENUM,RECORD,BUF,WORDS);                           37702000
    VALUE FILENUM,RECORD,WORDS;                                         37704000
    INTEGER FILENUM,WORDS;                                              37706000
    DOUBLE RECORD;                                                      37708000
    ARRAY BUF;                                                          37710000
      BEGIN                                                             37712000
        ENTRY FREAD;                                                    37714000
        LOGICAL WRITE := 1;                                             37716000
          GO AROUND;                                                    37718000
  FREAD:  WRITE := 0;                                                   37720000
  AROUND:                                                               37722000
          TOS := FILENUM;                                               37724000
          TOS := RECORD;                                                37726000
          PUSH(DB);                                                     37728000
          TOS := TOS+@BUF;                                              37730000
          TOS := WORDS;                                                 37732000
          IF WRITE THEN TOS:=@FWRITE' ELSE TOS:=@FREAD';                37734000
          ASSEMBLE(PCAL 0);                                             37736000
      END <<FWRITE AND FREAD>> ;                                        37738000
$PAGE "SL AND PROGRAM FILE PROCEDURES"                                  37740000
$CONTROL SEGMENT=SL'PROGRAM                                             37742000
          <<----------------------------------->>              <<00.DL>>37744000
          <<ENTER PROGRAM NAME IN LOADMAP ARRAY>>              <<00.DL>>37746000
          <<----------------------------------->>              <<00.DL>>37748000
  PROCEDURE LDMAP( LOWCST, NSEG, NAME);                        <<03004>>37750000
    VALUE LOWCST, NSEG;                                        <<03004>>37752000
    INTEGER LOWCST,  << FIRST PHYS. CODE SEGMENT USED >>       <<03004>>37754000
            NSEG;    << NO. OF CODE SEGMENTS USED >>           <<03004>>37756000
    BYTE ARRAY NAME;                                                    37758000
    BEGIN                                                      <<03004>>37760000
    BYTE POINTER BLDMAPBUF;                                    <<03004>>37762000
    INTEGER LMBX,   << INDEX TO BLDMAPBUF >>                   <<03004>>37764000
            CSTN;   << CURRENT CST NO.  >>                     <<03004>>37766000
      CSTN := LOWCST - 1;                                      <<03004>>37768000
      WHILE ( CSTN := CSTN+1) < LOWCST+NSEG DO                 <<03004>>37770000
        BEGIN    << PRINT ALL CODE SEGMENTS FOR FILE >>        <<03004>>37772000
        @BLDMAPBUF := BYTEADDRESS(LDMAPBUF);                   <<04306>>37774000
        LMBX:=CSTN MOD 50 * 128 + CSTN / 50 * 32 ;             <<00.DL>>37776000
          NTOA(CSTN,8,BLDMAPBUF(LMBX+2));                      <<01103>>37778000
          MOVE BLDMAPBUF(X:=X+2) := NAME,(8);                  <<00.DL>>37780000
          IF LOADMAP THEN PRINT(LDMAPBUF(LMBX&LSR(1)),-14,0);  <<01103>>37782000
        END;                                                   <<03004>>37784000
    END     << LDMAP >>;                                       <<03004>>37786000
                                                                        37788000
          <<-----------------------------                               37790000
            READ SEGMENT TRANSFER TABLE                                 37792000
          ----------------------------->>                               37794000
  PROCEDURE READSTT(CSTN);                                              37796000
    VALUE CSTN;                                                         37798000
    INTEGER CSTN;    <<PHYSICAL CST NUMBER>>                            37800000
    COMMENT                                                             37802000
      READS THE SEGMENT TRANSFER TABLE OF SEGMENT CSTN INTO BUFFER STT  37804000
    AND SETS STTINDEX TO POINT AT THE LAST WORD;                        37806000
      BEGIN                                                             37808000
          TOS := CST(CSTN&LSL(2)+2);                                    37810000
          STTLDEV := S0.(0:8);  <<LOGICAL DEVICE #>>                    37812000
          TOS:=TOS.(8:8);                                      <<MPEIV>>37814000
          TOS := CST(X:=X+1);                                           37816000
          STTADR := TOS;                                                37818000
          TOS := CST(X:=X-3).(4:12)&LSL(2)-1; <<SEG LENGTH-1>>          37820000
          TOS := 128;                                                   37822000
          ASSEMBLE(DIV);                                                37824000
          STTINDEX := TOS+256;   <<POINTER TO PL>>                      37826000
          ASSEMBLE(DUP,ZERO; XCH);                                      37828000
          TOS := TOS-2D;                                                37830000
          STTADR := TOS+STTADR;  <<ADDRESS OF LAST 3 SECTORS>>          37832000
          DISC(READ,STTLDEV,STTADR,STT,384); <<READ STT>>               37834000
      END <<READSTT>> ;                                                 37836000
         <<----------------------------------->>               <<03004>>37838000
         << GET STT OF CST OR PROGRAM SEGMENT >>               <<03004>>37840000
         <<----------------------------------->>               <<03004>>37842000
  PROCEDURE UPDATESTT( CSTN, DNAME);                           <<03004>>37844000
  COMMENT                                                      <<03004>>37846000
     THIS PROCEDURE PUTS THE STT OF A SEGMENT                  <<03004>>37848000
     IN THE ARRAY 'STT', WITH 'STTINDEX' SET TO INDEX TO       <<03004>>37850000
     THE BEGINNING OF THE STT.  IF 'CSTN' < 0 ON ENTRY,        <<03004>>37852000
     -CSTN-1 IS THE LOGICAL SEGMENT WHOSE STT WE WANT, AND     <<03004>>37854000
     'DNAME' GIVES THE FILE NAME OF THE PROGRAM.               <<03004>>37856000
     IF 'CSTN' >= 0, THEN IT GIVES                             <<03004>>37858000
     THE PHYSICAL CST # OF THE SEGMENT AND WE GET TO THE       <<03004>>37860000
     STT VIA THE CST ENTRY, WHETHER THE SEGMENT IS CORE        <<03004>>37862000
     RESIDENT OR ABSENT;                                       <<03004>>37864000
  VALUE CSTN;                                                  <<03004>>37866000
  INTEGER CSTN;      << PHYSICAL CST# IF >= 0,           >>    <<03004>>37868000
                     << IF < 0, -CSTN-1 IS LOGICAL CST # >>    <<03004>>37870000
  BYTE ARRAY DNAME;  << FILE NAME IF CSTN < 0 >>               <<03004>>37872000
  OPTION VARIABLE;                                             <<03004>>37874000
     BEGIN                                                     <<03004>>37876000
     INTEGER PROGFNUM,   << FILE NUMBER >>                     <<03004>>37878000
             NSEG,       << NO. OF SEGMENTS IN PROGRAM FILE >> <<03004>>37880000
             K,I,                                              <<03004>>37882000
             CSTP,       << INDEX TO CURRENT CST ENTRY >>      <<03004>>37884000
             SEGSIZE;    << SEGMENT SIZE (WORDS) >>            <<03004>>37886000
     LOGICAL SBANK,      << SOURCE BANK FOR MABS >>            <<03004>>37888000
             SADDR,      << SOURCE ADDR  "    "  >>            <<03004>>37890000
             DBANK,      << DEST.  BANK  "    "  >>            <<03004>>37892000
             DADDR;      << DEST.  ADDR  "    "  >>            <<03004>>37894000
                                                               <<03004>>37896000
                                                               <<03004>>37898000
     CSTP := CSTN&LSL(2);  << POINTER TO 1ST WORD OF CST    >> <<03004>>37900000
                           <<ENTRY, USED FOR PHYS. CST ONLY >> <<03004>>37902000
     IF CSTN < 0 THEN                                          <<03004>>37904000
        BEGIN             << GET STT FROM FILE >>              <<03004>>37906000
        PROGFNUM := FOPEN( DNAME);  << OPEN FILE >>            <<03004>>37908000
        FREAD( PROGFNUM, 0D, PREC0, 128);  << READ RECORD 0>>  <<03004>>37910000
        NSEG := PREC0(1);   << NO. OF SEGMENTS IN FILE >>      <<03004>>37912000
        K := 28 + (NSEG+1)&LSR(1);                             <<03004>>37914000
        STTADR := FCBDBL( PROGFNUM*FCBDSIZE) + D'L(FCB(        <<03004>>37916000
                  PROGFNUM*FCBSIZE + FCBSECTOFF) +             <<03004>>37918000
                  PREC0(4)  ));  <<ADDRESS OF 1ST SEGMENT>>    <<03004>>37920000
        I := -1;                                               <<03004>>37922000
        CSTN := -CSTN - 1;  <<LOGICAL CST# OF SEGMENT>>        <<03004>>37924000
        WHILE (I:=I+1) < CSTN DO                               <<03004>>37926000
           BEGIN                                               <<03004>>37928000
           SEGSIZE := PREC0(K+I).(2:14);                       <<03004>>37930000
           STTADR := STTADR + DOUBLE((SEGSIZE+127)&LSR(7));    <<03004>>37932000
           END;                                                <<03004>>37934000
                                                               <<03004>>37936000
        SEGSIZE := PREC0(K+I).(2:14) - 1;  <<SEG. SIZE - 1>>   <<03004>>37938000
        << SET FINAL DISC ADDRESS >>                           <<03004>>37940000
        STTADR := STTADR + DOUBLE( SEGSIZE/128) - 2D;          <<03004>>37942000
        STTINDEX := 256 + (SEGSIZE MOD 128);                   <<03004>>37944000
                                                               <<03004>>37946000
        STTLDEV := FCB(PROGFNUM*FCBSIZE+FCBLDEV);<<FILE LDEV>> <<03004>>37948000
        DISC( READ,STTLDEV,STTADR,STT,384);                    <<03004>>37950000
        FCLOSE( PROGFNUM);                                     <<03004>>37952000
        END                                                    <<03004>>37954000
                                                               <<03004>>37956000
     ELSE IF CST(CSTP) < 0 THEN                                <<03004>>37958000
        BEGIN              << ABSENT SEGMENT >>                <<03004>>37960000
        READSTT(CSTN);                                         <<03004>>37962000
        END                                                    <<03004>>37964000
                                                               <<03004>>37966000
     ELSE                                                      <<03004>>37968000
        BEGIN              << CORE RESIDENT SEGMENT >>         <<03004>>37970000
        SEGSIZE := CST(CSTP).(4:12)&LSL(2);                    <<03004>>37972000
        SBANK := CST(CSTP+2);   << BANK OF SEGMENT >>          <<03004>>37974000
        SADDR := CST(CSTP+3)+SEGSIZE-1;  << BANK OFFSET OF  >> <<03004>>37976000
                                         <<LAST WORD OF SEG.>> <<03004>>37978000
        PUSH(DB);                                              <<03004>>37980000
        DADDR := TOS + @STT(383);  << GET BANK AND BANK     >> <<03004>>37982000
        DBANK := TOS;              << OFFSET OF THE LAST    >> <<03004>>37984000
                                   << WORD OF 'STT'         >> <<03004>>37986000
        MABS( DBANK,DADDR,SBANK,SADDR,-384);  << MOVE STT >>   <<03004>>37988000
        STTINDEX := 383;  << POINTER TO START OF STT >>        <<03004>>37990000
        END;                                                   <<03004>>37992000
     END;    << UPDATESTT >>                                   <<03004>>37994000
                                                                        37996000
          <<-------------------------------------                       37998000
            CONVERT LOGICAL CST TO PHYSICAL CST                         38000000
          ------------------------------------->>                       38002000
  INTEGER PROCEDURE PHYSCST(LCST);                                      38004000
    VALUE LCST;                                                         38006000
    INTEGER LCST;                                                       38008000
      BEGIN                                                             38010000
        INTEGER I;                                                      38012000
          I := FREECSTN-1;                                              38014000
  LOOP:   IF SEGXFORM(I:=I+1)&LSR(8)=LCST THEN                          38016000
            BEGIN                                                       38018000
              PHYSCST := I;                                             38020000
              RETURN;                                                   38022000
            END;                                                        38024000
          GOTO LOOP;                                                    38026000
      END <<PHYSCST>> ;                                                 38028000
       <<----------------------------------->>                 <<L7988>>38030000
       <<   FIX-UP SEGMENT TRANSFER TABLE   >>                 <<L7988>>38032000
       <<----------------------------------->>                 <<L7988>>38034000
                                                               <<L7988>>38036000
PROCEDURE FIXSTT( CSTN );                                      <<L7988>>38038000
   VALUE CSTN;                                                 <<L7988>>38040000
   INTEGER CSTN;                                               <<L7988>>38042000
BEGIN  COMMENT                                                 <<L7988>>38044000
                                                               <<L7988>>38046000
   CONVERTS ALL LOGICAL CST REFERENCES IN THE STT OF           <<L7988>>38048000
   SEGMENT CSTN TO PHYSICAL REFERENCES;                        <<L7988>>38050000
                                                               <<L7988>>38052000
   INTEGER I;                                                  <<L7988>>38054000
                                                               <<L7988>>38056000
   READSTT( CSTN );  << READ IN STT >>                         <<L7988>>38058000
                                                               <<L7988>>38060000
   IF LOGICALMAPPING THEN                                      <<L7988>>38062000
      BEGIN                                                    <<L7988>>38064000
      FOR I:=STT(STTINDEX).(0:8)+1 UNTIL STT(STTINDEX).(8:8) DO<<L7988>>38066000
         BEGIN                                                 <<L7988>>38068000
         STT(STTINDEX-I).(8:8) := IF STT(X).(8:8) = %377 THEN  <<L7988>>38070000
            %104001 << UNSATISFIED EXTERNAL - LINK TO ININ >>  <<L7988>>38072000
         ELSE                                                  <<L7988>>38074000
            PHYSCST(STT(X).(8:8));                             <<L7988>>38076000
         STT(X).(0:1) := 1; << PHYSICALLY MAPPED >>            <<L7988>>38078000
         END;                                                  <<L7988>>38080000
      END                                                      <<L7988>>38082000
   ELSE                                                        <<L7988>>38084000
      BEGIN                                                    <<L7988>>38086000
      FOR I := 1 UNTIL STT(STTINDEX).(8:8) DO                  <<L7988>>38088000
         BEGIN                                                 <<L7988>>38090000
         IF STT(STTINDEX-I) < 0 THEN                           <<L7988>>38092000
            BEGIN << EXTERNAL LABEL >>                         <<L7988>>38094000
            STT(X).(8:8) := IF STT(X).(8:8) = %377 THEN        <<L7988>>38096000
               %104001<< UNSATISFIED EXTERNAL - LINK TO ININ >><<L7988>>38098000
            ELSE                                               <<L7988>>38100000
               PHYSCST(STT(X).(8:8));                          <<L7988>>38102000
            END;                                               <<L7988>>38104000
         END;                                                  <<L7988>>38106000
      END;                                                     <<L7988>>38108000
                                                               <<L7988>>38110000
   DISC( WRITE, STTLDEV, STTADR, STT, 384);                    <<L7988>>38112000
END; << FIXSTT >>                                              <<L7988>>38114000
                                                                        38116000
          <<-------------------                                         38118000
            READ CODE SEGMENT                                           38120000
          ------------------->>                                         38122000
PROCEDURE READCODE(CSTN, LINKED);                              <<01384>>38124000
  VALUE CSTN, LINKED;                                          <<01384>>38126000
  INTEGER CSTN;    << CST NUMBER >>                            <<01384>>38128000
  LOGICAL LINKED;  <<0=CORE RESIDENT,1=LINKED MEM,2=ABSENT>>   <<01384>>38130000
  BEGIN                                                        <<01384>>38132000
    DOUBLE  DISCADDR,                                          <<01384>>38134000
            DCOREADDR;                                         <<01384>>38136000
    LOGICAL MEMSEG,                                            <<01384>>38138000
            LDEV,                                              <<01384>>38140000
            BANK     = DCOREADDR,                              <<MPEIV>>38142000
            COREADDR = DCOREADDR+1;                            <<MPEIV>>38144000
    LOGICAL CSTINDX;  << INDEX TO CST ENTRY >>                 <<01384>>38146000
                                                               <<MPEIV>>38148000
  << COMPUTE CST ENTRY INDEX >>                                <<01384>>38150000
    IF CSTN.(2:1) = 1 THEN  << CSTX ENTRY >>                   <<01384>>38152000
      CSTINDX := CSTBLK(CSTN.(3:7)) + CSTN.(10:6)&LSL(2) -     <<01384>>38154000
                 ABSOLUTE(DFC)                                 <<01384>>38156000
    ELSE                                                       <<01384>>38158000
      CSTINDX := CSTN&LSL(2);                                  <<01384>>38160000
                                                               <<01384>>38162000
    MEMSEG := CST(CSTN*4).(4:12) * 4;  << SEGMENT LENGTH >>    <<MPEIV>>38164000
    LDEV := CST(X:=X+2).(0:8);                                 <<MPEIV>>38166000
    TOS := CST(X).(8:8);  << HODA >>                           <<MPEIV>>38168000
    TOS := CST(X:=X+1);  << LODA >>                            <<MPEIV>>38170000
    DISCADDR := TOS;                                           <<MPEIV>>38172000
  DCOREADDR:= INITTABLE(MEMSEG, 1, ANYWHERE'TAB, FALSE);       <<32BND>>38174000
    DISC'(READ,LDEV,DISCADDR,DCOREADDR,MEMSEG);                <<01384>>38176000
                                                               <<01384>>38178000
  << UPDATE CST >>                                             <<01384>>38180000
    TOS := 0;  << NO BITS SET >>                               <<MPEIV>>38182000
    TOS.SYSTEMFLAG := 1;                                       <<MPEIV>>38184000
    IF NOT LINKED THEN TOS.SEGRESIDENTFLAG := 1;               <<MPEIV>>38186000
    CST(CSTINDX + 1) := TOS;  << CST WORD 1 >>                 <<MPEIV>>38188000
    CST(X:=X+1) := BANK;  << CST WORD 2 >>                     <<MPEIV>>38190000
    CST(X:=X+1) := COREADDR;  << CST WORD 3 >>                 <<MPEIV>>38192000
  END;  << READCODE >>                                         <<01384>>38194000
                                                               <<03004>>38196000
         <<-------------------------------------->>            <<03004>>38198000
         <<  SEE IF DRIVER NEEDS CST ENTRY       >>            <<03004>>38200000
         <<-------------------------------------->>            <<03004>>38202000
  LOGICAL PROCEDURE DUMMYDRIVER( DLT, INTRINDEX, FIRSTCST,     <<32BND>>38204000
                          LASTCST, ONEINHNDLR);                <<03004>>38206000
  COMMENT                                                      <<03004>>38208000
      THIS PROCEDURE CHECKS TO SEE IF ANY OF THE DRIVER        <<03004>>38210000
      ENTRY POINTS ARE INTERNAL TO A DRIVER SEGMENT.  IF       <<03004>>38212000
      NOT, THE DRIVER IS A DUMMY DRIVER AND NEED NOT           <<03004>>38214000
      BE ALLOCATED A CST ENTRY.  THIS PROCEDURE USES THE       <<03004>>38216000
      GLOBALS DLT ( POINTER TO CURRENT DLT ENTRY), INTR        <<03004>>38218000
      (POINTER TO TABLE CONTAINING INT. HANDLER PLABELS),      <<03004>>38220000
      STT (ARRAY CONTAINING STT FOR DRIVER OUTER BLOCK),       <<03630>>38222000
      AND STTINDEX (INDEX TO LAST WORD OF STT).                <<03630>>38224000
      THIS PROCEDURE RETURNS TRUE IF IT'S A DUMMY DRIVER,      <<03004>>38226000
      FALSE OTHERWISE;                                         <<03004>>38228000
  VALUE INTRINDEX, FIRSTCST, LASTCST, ONEINHNDLR;              <<03004>>38230000
  INTEGER ARRAY DLT;                                           <<32BND>>38232000
  INTEGER INTRINDEX, << INDEX INTO TEMP TABLE CONTAINING >>    <<03004>>38234000
                     << ALL STT NO.'S FOR INTERRUPT      >>    <<03004>>38236000
                     << HANDLERS                         >>    <<03004>>38238000
          FIRSTCST,  << 1ST PHYS CST ALLOCATED TO DRIVER >>    <<03004>>38240000
          LASTCST;   << LAST PHYS CST FOR DRIVER         >>    <<03004>>38242000
  LOGICAL ONEINHNDLR;<< TRUE IF GUARANTEED ONLY 1 INT.   >>    <<03004>>38244000
                     << HANDLER FOR DRIVER, AND NOT TO   >>    <<03004>>38246000
                     << USE TEMP INTR TABLE              >>    <<03004>>38248000
     BEGIN                                                     <<03004>>38250000
     EQUATE NUMPLABELS = 6; <<NO. OF DLT ENTRIES TO CHECK>>    <<03004>>38252000
                                                               <<03004>>38254000
     << DLTENTRY CONTAINS INDICES TO DLT WORDS WHICH >>        <<03004>>38256000
     << CONTAIN PLABELS                              >>        <<03004>>38258000
     INTEGER ARRAY DLTENTRY(0:NUMPLABELS-1)=PB:=               <<03004>>38260000
              1,2,3,6,7,4;                                     <<03004>>38262000
     INTEGER STTNUM, << TEMP FOR STT NUMBER >>                 <<03004>>38264000
             TEMP, MAX, I, J;                                  <<03004>>38266000
                                                               <<03004>>38268000
     DUMMYDRIVER := TRUE;                                      <<03004>>38270000
                                                               <<03004>>38272000
     << IF ONLY ONE INTERRUPT HANDLER, USE DLT ENTRY 4   >>    <<03004>>38274000
     << TO CHECK INTERRUPT HANDLER PLABEL                >>    <<03004>>38276000
     MAX := IF ONEINHNDLR THEN NUMPLABELS                      <<03004>>38278000
                          ELSE NUMPLABELS-1;                   <<03004>>38280000
     I := 0;                                                   <<03004>>38282000
     WHILE I<MAX DO   << CHECK DLT ENTRIES TO SEE IF ANY >>    <<03004>>38284000
        BEGIN         << DRIVER ENTRY POINTS ARE INTERNAL>>    <<03004>>38286000
        J := DLTENTRY(I);                                      <<03004>>38288000
        IF FIRSTCST <= DLT(J).(8:8) <= LASTCST THEN            <<03004>>38290000
               DUMMYDRIVER := FALSE;                           <<03004>>38292000
        I := I+1;                                              <<03004>>38294000
        END;                                                   <<03004>>38296000
                                                               <<03004>>38298000
     IF ONEINHNDLR THEN RETURN;                                <<03004>>38300000
                                                               <<03004>>38302000
     << DRIVER MAY HAVE MORE THAN 1 INTERRUPT HANDLER--  >>    <<03004>>38304000
     << CHECK ALL OF THEM TO SEE IF THEY ARE INTERNAL    >>    <<03004>>38306000
                                                               <<03004>>38308000
     MAX := INTEGER( INTR( INTRINDEX));                        <<03004>>38310000
     I := 1;                                                   <<03004>>38312000
     WHILE I <= MAX DO                                         <<03004>>38314000
        BEGIN                                                  <<03004>>38316000
        STTNUM := INTEGER( INTR( INTRINDEX+I));                <<03004>>38318000
        IF STTNUM > 0 THEN                                     <<03004>>38320000
           BEGIN                                               <<03004>>38322000
           TEMP := STT( STTINDEX-STTNUM);                      <<03004>>38324000
           IF TEMP.(0:1) = 0 OR    << IF IN SAME SEGMENT OR >> <<03630>>38326000
              TEMP.(0:1) = 1 AND   <<   SOME DRIVER SEGMENT >> <<03630>>38328000
              (FIRSTCST <= TEMP.(8:8) <= LASTCST) THEN         <<03630>>38330000
                  DUMMYDRIVER := FALSE;                        <<03004>>38332000
           END;                                                <<03004>>38334000
        I := I+1;                                              <<03004>>38336000
        END                                                    <<03004>>38338000
     END;    << DUMMYDRIVER >>                                 <<03004>>38340000
          <<---------------------------------                           38342000
            ALLOCATE SYSTEM LIBRARY SEGMENT                             38344000
          --------------------------------->>                           38346000
                                                                        38348000
  INTEGER PROCEDURE ALLOCATE(LCST,TOG);                                 38350000
    VALUE LCST,TOG;                                                     38352000
    INTEGER LCST;    <<LOGICAL CST NUMBER>>                             38354000
    INTEGER TOG;                                                        38356000
    COMMENT                                                             38358000
      ALLOCATE THE SYSTEM LIBRARY SEGMENT SPECIFIED BY LCST IF TOG IS   38360000
    TRUE OR THE ALLOCATE BIT IS SET.  FIXES UP THE STT OF THE SEGMENT   38362000
    WITH THE CORRECT LOGICAL CST NUMBERS. SETS CONDITION CODE TO EQUAL  38364000
    IF SEGMENT IS ALLOCATED;                                            38366000
      BEGIN                                                             38368000
      EQUATE S=6,P=4;                                                   38370000
        DEFINE ALLOC     =    (4:1)#,                                   38372000
               SYSSEG     =   (6:1)#,                                   38374000
               CRRES   =    (5:1)#,                                     38376000
               SATISFIED =    (0:2)#;                                   38378000
        INTEGER EXTINDEX,EXTREC,FLAGS,I,                                38380000
                NRINTS,                                        <<L7988>>38382000
                OLDSLRTNUM,                                    <<S9090>>38384000
                EXTSIZE,                                       <<S9090>>38386000
                SEGTYPE=ALLOCATE,                                       38388000
                SEGLEN,SEGADR,NC,CONCODE:=CCG;                          38390000
        BYTE POINTER BLDMAPBUF;                                         38392000
        INTEGER POINTER EXTLIST;                               <<S9090>>38394000
        INTEGER LMBX := 0; <<INDEX TO BLDMAPBUF>>                       38396000
        SUBROUTINE LCSTTOSTT;                                           38398000
        BEGIN                                                           38400000
              EXTSIZE := (REFTAB(INDEX+2)-SEGLEN/128-1)*128;   <<S9090>>38402000
              DLSIZE( EXTSIZE );                               <<S9090>>38404000
              PUSH( DL );                                      <<S9090>>38406000
              @EXTLIST := TOS;                                 <<S9090>>38408000
              TOS := SEGLEN;                                            38410000
              TOS := 128;                                               38412000
              ASSEMBLE(DIV);                                            38414000
              EXTINDEX := TOS;        <<FIRST EXTERNAL INDEX>>          38416000
              EXTREC := TOS+SEGADR+1;<<ADDR OF EXTERNAL LIST>>          38418000
              FREAD(SLFNUM,DOUBLE(EXTREC),EXTLIST,EXTSIZE);    <<S9090>>38420000
  NEXTEXT:    TOS := EXTLIST(EXTINDEX);                                 38422000
              NC := S0.(4:4);                                           38424000
              IF = THEN                                                 38426000
                BEGIN                                                   38428000
                  DEL;                                                  38430000
                  DLSIZE( -EXTSIZE );                          <<S9090>>38432000
                  RETURN;                                               38434000
                END;                                                    38436000
              EXTINDEX := X+1+NC&LSR(1);                                38438000
              IF TOS.SATISFIED=0 THEN                                   38440000
                BEGIN      <<PRINT UNSATISFIED MESSAGE>>                38442000
                  TOS := @EXTLIST(X)&LSL(1);                   <<04306>>38444000
                  MOVE BINBUF := * ,(16);                      <<01103>>38446000
                  INBUF.(0:4) := 0;                            <<01103>>38448000
                  TOS := @BINBUF(17);                          <<01103>>38450000
                  TOS := @REFTAB(INDEX+8)&LSL(1);              <<04306>>38452000
MOVENAME':        MOVE * := * WHILE AN,0;                      <<01103>>38454000
                  IF BPS0 = "'" THEN                           <<01103>>38456000
                     BEGIN                                     <<01103>>38458000
                     MOVE * := *,(1),1;                        <<01103>>38460000
                     GO MOVENAME';                             <<01103>>38462000
                     END;                                      <<01103>>38464000
                  DEL;                                         <<01103>>38466000
                  BINBUF(16) := TOS-@BINBUF(17);               <<01103>>38468000
                  MESSAGE(M2457,,,,,BINBUF,BINBUF(16));        <<01103>>38470000
                  X := STTINDEX-EXTLIST(EXTINDEX).(0:8);       <<*7653>>38472000
                  STT(X) := %100377;                                    38474000
                END                                                     38476000
              ELSE                                                      38478000
                BEGIN                                                   38480000
                  TOS := EXTLIST(EXTINDEX);                             38482000
                  X := -(S0&LSR(8))+STTINDEX;                           38484000
                  TOS := TOS LAND %377;                                 38486000
                  STT(X).(8:8) := TOS;   <<FIX UP SIT ENTRY>>           38488000
                END;                                                    38490000
              I := EXTLIST(EXTINDEX+1).(0:2);                           38492000
              TOS := (IF = THEN 1 ELSE IF I=3 THEN EXTLIST(X).(2:6)+2   38494000
                      ELSE 2)+X;                                        38496000
              EXTINDEX := TOS;                                          38498000
              GOTO NEXTEXT;                                             38500000
        END <<LCSTTOSTT>> ;                                             38502000
          @BLDMAPBUF := @LDMAPBUF&LSL(1);                      <<04306>>38504000
          I:= FREECSTN;                                        <<02.EB>>38506000
          DO IF SEGXFORM(I)&LSR(8) = LCST THEN GOTO NOALLOC    <<02.EB>>38508000
          UNTIL (I:=I+1)=HCST;                                 <<02.EB>>38510000
          OLDSLRTNUM := SLRTNUM;                               <<S9090>>38512000
          TOS := LCST;                                                  38514000
          TOS := 4;                                                     38516000
          ASSEMBLE(DIV);                                                38518000
          INDEX := TOS&LSL(5);<<INDEX INTO REF TABLE RECORD>>           38520000
          SLRTNUM := SLREC1(TOS);      <<REF TAB REC NUM>>     <<S9090>>38522000
          IF SLRTNUM <> OLDSLRTNUM THEN                        <<S9090>>38524000
             FREAD(SLFNUM,DOUBLE(SLRTNUM),REFTAB,128);         <<S9090>>38526000
          IF (FLAGS:=REFTAB(INDEX+3)) < 0 THEN GOTO NOALLOC; <<UNUSED>> 38528000
          IF LOGICAL(FLAGS.SYSSEG) THEN                                 38530000
            BEGIN   <<SYSTEM SEGMENT>>                                  38532000
              ALLOCATE := S;                                            38534000
              GOTO ALLOCATEIT;                                          38536000
            END;                                                        38538000
          IF TOG <> 0 THEN GO PALLOC;                          <<03.EB>>38540000
          IF NOT LOGICAL(FLAGS.ALLOC) THEN GOTO NOALLOC                 38542000
          ELSE                                                          38544000
            BEGIN   <<ALLOCATE SEGMENT>>                                38546000
  PALLOC:     ALLOCATE := P;                                            38548000
  ALLOCATEIT:                                                           38550000
              CONCODE := CCE;                                           38552000
              CSTN := GETENTRY( CSTDSTN);                      <<*SLL*>>38554000
            SEGXFORM(CSTN):=LCST&LSL(8)+(FLAGS.(4:3)&LSL(1));  <<*MAP*>>38556000
        SEGXFORM(CSTN).(15:1):=1;<<SET PHYSICALLY MAPPED FLAG>><<*MAP*>>38558000
              LMBX:=CSTN MOD 50*128+CSTN/50*32;                <<00.DL>>38560000
                  NTOA(CSTN,8,BLDMAPBUF(LMBX+2));              <<01103>>38562000
                  TOS := @LDMAPBUF(LMBX&LSR(1));  <<FOR PRINT>>         38564000
                  TOS := @BLDMAPBUF(LMBX);                              38566000
                  TOS := S0+4;                                          38568000
                  TOS := @REFTAB(INDEX+8)&LSL(1);              <<04306>>38570000
  MOVENAME:       MOVE * := * WHILE AN,0;  <<SEG NAME>>                 38572000
                  IF BPS0="'" THEN                                      38574000
                    BEGIN                                               38576000
                      MOVE * := *,(1),1;                                38578000
                      GOTO MOVENAME;                                    38580000
                    END;                                                38582000
                  DEL;                                                  38584000
                  MOVE * := " (",2;                            <<01103>>38586000
                  TOS := TOS + LNTOA(LCST,8,BPS0);             <<01103>>38588000
                  BPS0 := ")";                                 <<01103>>38590000
                  ASSEMBLE(INCA,SUB);  <<CHARACTER COUNT>>              38592000
                  IF LOADMAP THEN PRINT(*,*,0) ELSE DDEL;      <<00.DL>>38594000
              TOS := CSTN;    <<SEGMENT NUMBER>>                        38596000
              SEGLEN := REFTAB(INDEX).(2:14);                           38598000
              TOS := 0;   <<FOR DISC ADDRESS>>                          38600000
              TOS := REFTAB(X:=X+1);   <<STARTING RECORD #>>            38602000
              SEGADR := S0;                                             38604000
              TOS := TOS+FCB(SLFNUM*FCBSIZE+FCBSECTOFF);  <<OFFSET>>    38606000
              TOS := FCB(SLFNUM*FCBSIZE+FCBEXTSIZE);  <<EXTENT SIZE>>   38608000
              ASSEMBLE(DIV,XCH);                                        38610000
              X := TOS+SLFNUM*FCBDSIZE;                                 38612000
              TOS := FCBDBL(X);                                         38614000
              ASSEMBLE(DADD);  <<SEGMENT DISC ADDRESS>>                 38616000
              TOS := REFTAB(INDEX);  <<SEGMENT LENGTH AND FLAGS>>       38618000
              TOS := 0;  <<CORE RESIDENT SEGMENT>>                      38620000
              IF NOT LOGICAL(FLAGS).CRRES THEN TOS:=TOS+2;  <<ABSENT>>  38622000
              TOS := 0;                                                 38624000
              IF SEGTYPE=S THEN TOS := TOS+1;<<SYSTEM>>                 38626000
              INSERTCST(*,*,*,*,*);                            <<03603>>38628000
              READSTT(CSTN);                                            38630000
              LCSTTOSTT;                                                38632000
              IF LOGICALMAPPING THEN                           <<L7988>>38634000
                 BEGIN                                         <<L7988>>38636000
                 IF REFTAB(INDEX).(1:1) = 0 THEN               <<L7988>>38638000
                    BEGIN  << STT - NON CST EXPANSION >>       <<L7988>>38640000
                    NRINTS := 0; << # OF INTERNALS >>          <<L7988>>38642000
                    FOR I := 1 UNTIL STT(STTINDEX).(8:8) DO    <<L7988>>38644000
                       IF STT(STTINDEX-I) >= 0 THEN            <<L7988>>38646000
                          NRINTS := NRINTS+1;                  <<L7988>>38648000
                    STT(STTINDEX).(0:8) := NRINTS;             <<L7988>>38650000
                    REFTAB(INDEX).(1:1) := 1;                  <<L7988>>38652000
                    FWRITE(SLFNUM,DOUBLE(SLRTNUM),REFTAB,128); <<S9090>>38654000
                    END;                                       <<L7988>>38656000
                 END                                           <<L7988>>38658000
              ELSE                                             <<L7988>>38660000
                 BEGIN                                         <<L7988>>38662000
                 IF REFTAB(INDEX).(1:1) = 1 THEN               <<L7988>>38664000
                    BEGIN  << STT - CST EXPANSION FORMAT >>    <<L7988>>38666000
                    NRINTS := STT(STTINDEX).(0:8);             <<L7988>>38668000
                    FOR I := NRINTS+1 UNTIL STT(STTINDEX).(8:8)<<L7988>>38670000
                       DO STT(STTINDEX-I).(0:1) := 1;          <<L7988>>38672000
                    STT(STTINDEX).(0:8) := %100; <<UNCALLABLE>><<L7988>>38674000
                    REFTAB(INDEX).(1:1) := 0;                  <<L7988>>38676000
                    FWRITE(SLFNUM,DOUBLE(SLRTNUM),REFTAB,128); <<S9090>>38678000
                    END;                                       <<L7988>>38680000
                 END;                                          <<L7988>>38682000
                                                               <<L7988>>38684000
              DISC(WRITE,STTLDEV,STTADR,STT,384);              <<L7988>>38686000
            END;                                                        38688000
  NOALLOC:STAT.(6:2) := CONCODE;                                        38690000
      END <<ALLOCATE>> ;                                                38692000
                                                                        38694000
          <<-------------------------------------------------           38696000
            ALLOCATE SL SEGMENT AND ALL THOSE IT REFERENCES             38698000
          ------------------------------------------------->>           38700000
  PROCEDURE ALLOCATEALL(LCST,TOG);                                      38702000
    VALUE LCST,TOG;                                                     38704000
    INTEGER LCST;    <<LOGICAL CST NUMBER>>                             38706000
    LOGICAL TOG;     <<ALWAYS ALLOCATE IF TRUE>>                        38708000
    COMMENT                                                             38710000
      CALL ALLOCATE TO ALLOCATE SEGMENT LCST. IF ALLOCATED, SCANS       38712000
    REFERENCED SEGMENT LIST AND ALLOCATES ALL REFERENCED SEGMENTS NOT   38714000
    PREVIOUSLY ALLOCATED;                                               38716000
      BEGIN                                                             38718000
        INTEGER I,J;                                                    38720000
        INTEGER ARRAY REFSEG(0:15);                            <<c8392>>38722000
          J := ALLOCATE(LCST,TOG);                                      38724000
          IF <> THEN RETURN;                                            38726000
          MOVE REFSEG := REFTAB(INDEX+16),(16);                         38728000
          I := -1;                                                      38730000
          DO                                                            38732000
            BEGIN                                                       38734000
              I := I+1;                                                 38736000
              IF LOGICAL(REFSEG(I.(0:12))&CSL(I.(12:4)+1)) THEN         38738000
                ALLOCATE(I,J);                                          38740000
            END                                                         38742000
          UNTIL I=255;                                                  38744000
      END <<ALLOCATEALL>> ;                                             38746000
                                                                        38748000
          <<--------------------                                        38750000
            GET EXTERNAL LABEL                                          38752000
          -------------------->>                                        38754000
  INTEGER PROCEDURE EXTLABEL(NAME);                                     38756000
    BYTE ARRAY NAME;   <<NAME OF EXTERNAL (AND CHAR COUNT)>>            38758000
    COMMENT                                                             38760000
      RETURNS THE LOGICAL EXTERNAL LABEL OF AN EXTERNAL PROCEDURE       38762000
    NAME IN BYTE ARRAY NAME (ZERO IF NOT FOUND);                        38764000
      BEGIN                                                             38766000
        INTEGER NC,I,J,LINK;                                            38768000
          TOS := NAME&CSL(8)+NAME(1);                                   38770000
          TOS := S0.(4:4);                                              38772000
          X := S0-1;                                                    38774000
          NC := TOS;                                                    38776000
          TOS := TOS.(4:12);  <<STRIP LEADING BITS>>                    38778000
          TOS := NAME(X)&CSL(8);    <<CHARACTER NC-1>>                  38780000
          TOS := NAME(X:=X+1);                                          38782000
          ASSEMBLE(ADD,DECX);                                           38784000
          IF = THEN TOS:=TOS.(4:12);  <<ONLY ONE CHARACTER IN NAME>>    38786000
          TOS := 95;                                                    38788000
          ASSEMBLE(LDIV,DELB);   <<HASH>>                               38790000
          LINK := SLREC0(TOS+33);                                       38792000
  NEXTREC:IF = THEN RETURN;  <<NO MORE RECORDS--NOT FOUND>>             38794000
          FREAD(SLFNUM,DOUBLE(LINK),EXTLIST,128);                       38796000
          I := 4;                                                       38798000
  NEXTENT:TOS := BEXTLIST(I).(12:4);   <<NUMBER OF CHARS>>              38800000
          IF S0<>NC THEN GOTO NEXT;                                     38802000
          IF BEXTLIST(X:=X+1)<>NAME(1),(NC) THEN                        38804000
            BEGIN                                                       38806000
  NEXT:       IF NOT LOGICAL(S0) THEN TOS:=TOS+1;  <<FILL CHARACTER>>   38808000
              X := TOS+I+3;                                             38810000
              J := BEXTLIST(X).(8:2);  <<P FLAG>>                       38812000
              TOS :=(IF = THEN 2 ELSE IF J=3 THEN 2*BEXTLIST(X).(10:6)+438814000
                      ELSE 4)+X;                                        38816000
              IF S0>=2*EXTLIST(1) THEN                                  38818000
                BEGIN   <<RECORD EXHAUSTED>>                            38820000
                  LINK := EXTLIST;                                      38822000
                  GOTO NEXTREC;                                         38824000
                END;                                                    38826000
              I := TOS;                                                 38828000
              GOTO NEXTENT;                                             38830000
            END;                                                        38832000
          X := I+NC+1;                                                  38834000
          IF NOT LOGICAL(NC) THEN X:=X+1;                               38836000
          TOS := BEXTLIST(X)&LSL(8);                                    38838000
          TOS := TOS+BEXTLIST(X:=X+1);                                  38840000
          ASSEMBLE(TSBC 0);                                             38842000
          EXTLABEL := TOS;   <<EXTERNAL LABEL>>                         38844000
      END <<EXTLABEL>> ;                                                38846000
                                                                        38848000
          <<-----------------------------                               38850000
            GET PHYSICAL EXTERNAL LABEL                                 38852000
          ----------------------------->>                               38854000
  INTEGER PROCEDURE PLABEL(NAME);                                       38856000
    BYTE ARRAY NAME;    <<NAME OF EXTERNAL>>                            38858000
    COMMENT                                                             38860000
      RETURNS THE PHYSICAL EXTERNAL LABEL OF AN EXTERNAL PROCEDURE      38862000
    REFERENCE;                                                          38864000
      BEGIN                                                             38866000
          TOS := EXTLABEL(NAME);    <<GET LOGICAL EXTERNAL LABEL>>      38868000
          IF S0=0 THEN RETURN;                                          38870000
          X := LOGICAL(S0) LAND %377;                                   38872000
          PLABEL := (TOS LAND %177400)+LOGICAL(PHYSCST(X));             38874000
      END <<PLABEL>> ;                                                  38876000
                                                                        38878000
          <<--------------------                                        38880000
            GET INTERNAL LABEL                                          38882000
          -------------------->>                                        38884000
  INTEGER PROCEDURE INTLABEL(EXTLAB);                                   38886000
    VALUE EXTLAB;                                                       38888000
    INTEGER EXTLAB;  <<EXTERNAL LABEL>>                                 38890000
    COMMENT                                                             38892000
      RETURNS THE INTERNAL LABEL FOR THE PROCEDURE WITH THE EXTERNAL    38894000
    LABEL EXTLAB;                                                       38896000
      BEGIN                                                             38898000
      DOUBLE  DCOREADDR;                                       <<01384>>38900000
      LOGICAL BANK     = DCOREADDR,                            <<01384>>38902000
              COREADDR = DCOREADDR+1;                          <<01384>>38904000
          TOS := EXTLAB;                                                38906000
          IF = THEN RETURN;                                             38908000
          X := TOS.(8:8)&LSL(2);                                        38910000
          TOS := CST(X);                                                38912000
          IF < THEN                                                     38914000
            BEGIN   <<ABSENT>>                                          38916000
              READSTT(EXTLAB.(8:8));                                    38918000
              TOS := STT(STTINDEX-EXTLAB.(1:7));                        38920000
            END                                                         38922000
          ELSE                                                          38924000
            BEGIN  <<IN CORE>>                                          38926000
              BANK := CST(X:=X+2).(8:8);                       <<MPEIV>>38928000
              TOS := TOS.(4:12)&LSL(2)+CST(X:=X+1)-1;          <<01384>>38930000
              COREADDR := TOS-EXTLAB.(1:7);                    <<01384>>38932000
              TOS := LSEA(DCOREADDR);                          <<01384>>38934000
            END;                                                        38936000
          ASSEMBLE(TRBC 1);   <<UNCALLABLE BIT>>                        38938000
          IF LOGICALMAPPING THEN                               <<*MAP*>>38940000
             TOS.MAPFLAG := EXTLAB.(0:1);                      <<*MAP*>>38942000
          INTLABEL := TOS;                                              38944000
      END <<INTLABEL>> ;                                                38946000
                                                                        38948000
          <<--------------------                                        38950000
            GET LABEL FROM STT                                          38952000
          -------------------->>                                        38954000
  INTEGER PROCEDURE STTLABEL(STTX);                                     38956000
    VALUE STTX;                                                         38958000
    INTEGER STTX;                                                       38960000
      BEGIN                                                             38962000
          TOS := STT(STTINDEX-STTX);                                    38964000
          IF >= THEN                                                    38966000
            BEGIN  <<INTERNAL - CONVERT TO EXTERNAL>>                   38968000
              TOS := STTX&LSL(8)+CSTINDEX;                              38970000
              TOS.(0:1) := 1;                                           38972000
            END;                                                        38974000
          STTLABEL := TOS;                                              38976000
      END <<STTLABEL>> ;                                                38978000
                                                                        38980000
          <<------------------------------------                        38982000
            MAKE SEGMENT TABLE DIRECTORY ENTRY                          38984000
          ------------------------------------>>                        38986000
  PROCEDURE SEGDIRENT(FID,ENTTYPE,FIRSTCST,LASTCST);                    38988000
    VALUE ENTTYPE,FIRSTCST,LASTCST,FID;                                 38990000
    DOUBLE FID;                                                         38992000
    INTEGER ENTTYPE,      <<ENTRY TYPE>>                                38994000
            FIRSTCST,     <<FIRST CST IN LIST>>                         38996000
            LASTCST;      <<LAST CST IN LIST>>                          38998000
    COMMENT                                                             39000000
      SEARCHES THE SEGMENT TABLE DIRECTORY FOR A MATCHING ENTRY.  IF    39002000
    FOUND, ADDS THE CST'S IN THE LIST TO THE ENTRY.  OTHERWISE MAKES A  39004000
    NEW ENTRY INCLUDING THE FILE ID, ENTRY TYPE AND BITMAP              39006000
    OF USED CST'S;                                                      39008000
      BEGIN                                                             39010000
        INTEGER LINK,I,NWG,NCST;                                        39012000
        INTEGER LOGSEGNR,SEGLISTPTR,PHYCST;                    <<*MAP*>>39014000
SUBROUTINE SETBIT(LOGSEG,CSTMAP);                              <<*MAP*>>39016000
  VALUE LOGSEG;                                                <<*MAP*>>39018000
  INTEGER LOGSEG;      <<LOG SEG #>>                           <<*MAP*>>39020000
  ARRAY CSTMAP;        <<BITMAP OF ALLOCATED SEGS>>            <<*MAP*>>39022000
  BEGIN                                                        <<*MAP*>>39024000
    TOS:=CSTMAP(LOGSEG.(0:12));  <<GET PROPER WORD>>           <<*MAP*>>39026000
    X:=S3.(12:4);             <<PROPER BIT >>                  <<*MAP*>>39028000
    ASSEMBLE(TSBC 0,X);       <<SET BIT    >>                  <<*MAP*>>39030000
    X:=S3.(0:12);             <<PROPER WORD>>                  <<*MAP*>>39032000
    ASSEMBLE(STOR S2,I,X);    <<RESTORE WORD>>                 <<*MAP*>>39034000
  END; <<SETBIT>>                                              <<*MAP*>>39036000
   TOS:=SEGT(SEG'HEAD+ENTTYPE); << GET HEAD PTR FOR TYPE >>    <<*MAP*>>39038000
NEXT:                                                          <<*MAP*>>39040000
   IF S0 = 0 THEN GO TO NOTFOUND;                              <<*MAP*>>39042000
   @SEGDIR:=TOS+@SEGT;           <<LOCAL PTR>>                 <<*MAP*>>39044000
   TOS:=FID;                     <<DESIRED KEY >>              <<*MAP*>>39046000
   TOS:=SEGDIR(1);               <<KEY IN ENTRY>>              <<*MAP*>>39048000
   TOS:=SEGDIR(2);                                             <<*MAP*>>39050000
   ASSEMBLE(DCMP);                                             <<*MAP*>>39052000
   IF = THEN                                                   <<*MAP*>>39054000
      BEGIN                       <<KEYS MATCH>>               <<*MAP*>>39056000
      SEGLISTPTR:=21;   <<PTR TO SEGLIST>>                     <<*MAP*>>39058000
      PHYCST:=FIRSTCST;                                        <<*MAP*>>39060000
      DO BEGIN                                                 <<*MAP*>>39062000
         LOGSEGNR:=SEGXFORM(PHYCST).(0:8); <<LOG SEG NR>>      <<*MAP*>>39064000
         <<SET ALLOCATED FLAG IN SEG ARRAY>>                   <<*MAP*>>39066000
         SETBIT(LOGSEGNR,SEGDIR(5));                           <<*MAP*>>39068000
         <<INC COUNT OF ALLOCATED SEGS>>                       <<*MAP*>>39070000
         SEGDIR(4).(0:8):=SEGDIR(4).(0:8)+1;                   <<*MAP*>>39072000
         <<BUILD SEGLIST ENTRY OUT OF FREE ENTRY>>             <<*MAP*>>39074000
         WHILE SEGDIR(SEGLISTPTR).(0:8) <> 255                 <<*MAP*>>39076000
           DO SEGLISTPTR:=SEGLISTPTR+3;                        <<*MAP*>>39078000
         <<FOUND FREE ENTRY>>                                  <<*MAP*>>39080000
         SEGDIR(SEGLISTPTR):=SEGXFORM(PHYCST); <<FLAGS>>       <<*MAP*>>39082000
         SEGDIR(SEGLISTPTR+1):=1;              <<REF CNT>>     <<*MAP*>>39084000
         SEGDIR(SEGLISTPTR+2):=PHYCST;         <<CST #>>       <<*MAP*>>39086000
         SEGLISTPTR:=SEGLISTPTR+3;                             <<*MAP*>>39088000
         PHYCST:=PHYCST+1; <<NEXT CST>>                        <<*MAP*>>39090000
         END UNTIL PHYCST > LASTCST;                           <<*MAP*>>39092000
      RETURN;                                                  <<*MAP*>>39094000
      END                                                      <<*MAP*>>39096000
   ELSE                                                        <<*MAP*>>39098000
      BEGIN                     <<KEYS DO NOT MATCH>>          <<*MAP*>>39100000
      TOS:=SEGDIR(-3);          <<GET FORWARD LINK>>           <<*MAP*>>39102000
      GO TO NEXT;                                              <<*MAP*>>39104000
      END;                                                     <<*MAP*>>39106000
                                                               <<*MAP*>>39108000
NOTFOUND:                                                      <<*MAP*>>39110000
                                                               <<*MAP*>>39112000
   <<ENTRY NOT FOUND -- BUILD ONE FROM A GARBAGE ENTRY>>       <<*MAP*>>39114000
                                                               <<*MAP*>>39116000
   @SEGDIR:=SEGT(SEG'HEAD)+@SEGT;     <<LOCAL PTR>>            <<*MAP*>>39118000
   NWG:=SEGDIR(-1);                   <<LENGTH>>               <<*MAP*>>39120000
   NCST:=LASTCST-FIRSTCST+1;          <<# CST>>                <<*MAP*>>39122000
   SEGDIR:=ENTTYPE;                   <<TYPE>>                 <<*MAP*>>39124000
   TOS:=FID;                          <<KEY>>                  <<*MAP*>>39126000
   SEGDIR(2):=TOS;                                             <<*MAP*>>39128000
   SEGDIR(1):=TOS;                                             <<*MAP*>>39130000
   SEGDIR(3):=0;                      <<PVINFO>>               <<*MAP*>>39132000
   SEGDIR(X:=X+1) :=0;      << # ALLOCATED SEGS>>              <<*MAP*>>39134000
   SEGDIR(X:=X+1):=0;       << SEG ARRAY       >>              <<*MAP*>>39136000
   MOVE SEGDIR(X:=X+1):=SEGDIR(X:=X-1),(15);                   <<*MAP*>>39138000
                                                               <<*MAP*>>39140000
   <<BUILD SEG ARRAY AND SEG LIST>>                            <<*MAP*>>39142000
                                                               <<*MAP*>>39144000
   SEGLISTPTR:=21;          <<PTR INTO SEGLIST>>               <<*MAP*>>39146000
   PHYCST:=FIRSTCST;        <<PHYSICAL CST #>>                 <<*MAP*>>39148000
   DO BEGIN                                                    <<*MAP*>>39150000
      LOGSEGNR:=SEGXFORM(PHYCST).(0:8);                        <<*MAP*>>39152000
      <<SET ALLOCATED BIT IN SEG ARRAY>>                       <<*MAP*>>39154000
      SETBIT(LOGSEGNR,SEGDIR(SAGL+5));                         <<*MAP*>>39156000
      <<INC COUNT OF ALLOCATED SEGS>>                          <<*MAP*>>39158000
      SEGDIR(4).(0:8):=SEGDIR(4).(0:8)+1;                      <<*MAP*>>39160000
      <<BUILD SEGLIST ENTRY>>                                  <<*MAP*>>39162000
      SEGDIR(SEGLISTPTR):=SEGXFORM(PHYCST); <<FLAGS>>          <<*MAP*>>39164000
      SEGDIR(SEGLISTPTR+1):=1;              <<REF COUNT>>      <<*MAP*>>39166000
      SEGDIR(SEGLISTPTR+2):=PHYCST;         <<CST # >>         <<*MAP*>>39168000
      SEGLISTPTR:=SEGLISTPTR+3;                                <<*MAP*>>39170000
      PHYCST:=PHYCST+1;  <<NEXT CST>>                          <<*MAP*>>39172000
      END UNTIL PHYCST > LASTCST;                              <<*MAP*>>39174000
                                                               <<*MAP*>>39176000
   <<BUILD TOTAL OF 200 SEGLIST ENTRIES>>                      <<*MAP*>>39178000
                                                               <<*MAP*>>39180000
   I:=200-NCST;                                                <<*MAP*>>39182000
   WHILE (I:=I-1) >= 0 DO                                      <<*MAP*>>39184000
      BEGIN                                                    <<*MAP*>>39186000
      SEGDIR(SEGLISTPTR):=%177400;       <<FREE>>              <<*MAP*>>39188000
      SEGDIR(X:=X+1):=0;                 <<REFCNT>>            <<*MAP*>>39190000
      SEGDIR(X:=X+1):=0;                 <<CST #>>             <<*MAP*>>39192000
      SEGLISTPTR:=SEGLISTPTR+3;                                <<*MAP*>>39194000
      END;                                                     <<*MAP*>>39196000
   SEGDIR(4).(8:8):=200;                 <<# SEGLIST ENTRIES>> <<*MAP*>>39198000
                                                               <<*MAP*>>39200000
   <<LINK ENTRY INTO CHAIN>>                                   <<*MAP*>>39202000
                                                               <<*MAP*>>39204000
   SEGDIR(-3):=SEGT(SEG'HEAD+ENTTYPE);    <<FWDLINK>>          <<*MAP*>>39206000
   SEGDIR(-2):=0;                   <<BKWDLINK>>               <<*MAP*>>39208000
   SEGDIR(-1):=SEGLISTPTR+3;        <<LENGTH>>                 <<*MAP*>>39210000
   SEGT(SEG'HEAD+ENTTYPE) := @SEGDIR-@SEGT; << HEAD LINK >>    <<*MAP*>>39212000
   IF SEGT(SEG'TAIL+ENTTYPE) = 0 THEN << FIRST ON LIST? >>     <<*MAP*>>39214000
      SEGT(SEG'TAIL+ENTTYPE) := SEGT(SEG'HEAD+ENTTYPE)         <<*MAP*>>39216000
   ELSE                                                        <<*MAP*>>39218000
      SEGT(SEGDIR(-3)-2) := SEGT(SEG'HEAD+ENTTYPE);            <<*MAP*>>39220000
                                                               <<*MAP*>>39222000
   <<BUILD NEW GARBAGE ENTRY>>                                 <<*MAP*>>39224000
                                                               <<*MAP*>>39226000
   SEGDIR(SEGLISTPTR):=0;           <<FWDLINK>>                <<*MAP*>>39228000
   SEGDIR(X:=X+1):=0;               <<BKWDLINK>>               <<*MAP*>>39230000
   SEGDIR(X:=X+1):=NWG-SEGLISTPTR-3;  <<LENGTH>>               <<*MAP*>>39232000
   SEGDIR(X:=X+1):=0;               <<TYPE>>                   <<*MAP*>>39234000
   SEGT(SEG'HEAD):=@SEGDIR+SEGLISTPTR+3-@SEGT; <<HEAD LINK>>   <<*MAP*>>39236000
   SEGT(SEG'TAIL):=SEGT(SEG'HEAD);         <<TAIL LINK>>       <<*MAP*>>39238000
      END <<SEGDIRENT>> ;                                               39240000
$PAGE                                                                   39242000
$CONTROL SEGMENT=PROCESS                                                39244000
INTEGER PROCEDURE ALCSTBLOCK(N);                               <<MPEIV>>39246000
   VALUE      N;                                               <<MPEIV>>39248000
   INTEGER    N;                                               <<MPEIV>>39250000
   OPTION     UNCALLABLE,PRIVILEGED;                           <<MPEIV>>39252000
   BEGIN                                                       <<MPEIV>>39254000
     INTEGER  EIX=ALCSTBLOCK,CSTX,MAX;                         <<MPEIV>>39256000
         EIX _ 0;                                              <<MPEIV>>39258000
         X _ (CSTX:=ABSOLUTE(DFS))+2;                          <<MPEIV>>39260000
         N:=N+2;                                               <<MPEIV>>39262000
         DST(X) _ DST(X)-N;        <<DEC FREE COUNT>>          <<MPEIV>>39264000
         CSTX _ CSTX+DST(X_X+1);     <<INDEX TO NEXT FREE>>    <<MPEIV>>39266000
         CSTX:=CSTX+4; <<FIRST ENTRY FOR BITMAP>>              <<MPEIV>>39268000
         DST(X) _ DST(X)+N&LSL(2); <<NEW NEXT FREE>>           <<MPEIV>>39270000
         MAX _ CSTBLK(0);             <<TABLE SIZE>>           <<MPEIV>>39272000
         WHILE (EIX_EIX+1) <= MAX DO                           <<MPEIV>>39274000
          IF CSTBLK(EIX) = -1 THEN                             <<MPEIV>>39276000
           GOTO FOUNDL;                <<ALLOCATE ENTRY>>      <<MPEIV>>39278000
         ERRMESSAGE(M304);           << OUT OF CSTBLK >>       <<MPEIV>>39280000
FOUNDL : CSTBLK(X) _ CSTX;            <<SAVE INDEX>>           <<MPEIV>>39282000
         <<ZERO OUT THE BITMAP>>                               <<MPEIV>>39284000
         DST(X:=CSTX-4):=0;                                    <<MPEIV>>39286000
         DST(X:=X+1):=0;                                       <<MPEIV>>39288000
         DST(X:=X+1):=0;                                       <<MPEIV>>39290000
         DST(X:=X+1):=0;                                       <<MPEIV>>39292000
         DST(CSTX):=(N:=N-2);                                  <<MPEIV>>39294000
         DST(X_X+1) _ %125252;       <<CHECK WORD>>            <<MPEIV>>39296000
         DST(X_X+1) _ 0;             <<# SHARING BLOCK>>       <<MPEIV>>39298000
         DST(X_X+1) _ 0;                                       <<MPEIV>>39300000
         WHILE (N_N-1) >= 0 DO                                 <<MPEIV>>39302000
          BEGIN                        <<CLEAR ENTRIES>>       <<MPEIV>>39304000
           DST(X_X+1) _ %100000;                               <<MPEIV>>39306000
           DST(X_X+1) _ 0;                                     <<MPEIV>>39308000
           DST(X_X+1) _ 0;                                     <<MPEIV>>39310000
           DST(X_X+1) _ 0;                                     <<MPEIV>>39312000
          END;                                                 <<MPEIV>>39314000
   END <<ALCSTBLOCK>> ;                                        <<MPEIV>>39316000
          <<---------------------                                       39318000
            PROGRAM FILE LOADER                                         39320000
          --------------------->>                                       39322000
PROCEDURE LOAD(NAME,CSTSEG,DSTSTACK,STACKSIZE,GLOBSIZE,        <<00652>>39324000
      START,LINKED,LOAD'IN'CSTX,CSTBLKINDEX,FIRSTCST,NSEG);    <<03004>>39326000
  VALUE LOAD'IN'CSTX;                                          <<00652>>39328000
    VALUE STACKSIZE,LINKED;                                             39330000
    BYTE ARRAY NAME;      <<PROGRAM FILE NAME>>                         39332000
    INTEGER CSTSEG,       <<PHYSICAL CST OF O.B. SEG>>         <<03004>>39334000
            DSTSTACK,     <<DST OF DATA SEGMENT>>                       39336000
            STACKSIZE,    <<SIZE OF STACK (=0 IF NONE)>>                39338000
            GLOBSIZE,     <<SIZE OF DB AREA>>                           39340000
            START;        <<ENTRY POINT>>                               39342000
  INTEGER CSTBLKINDEX,     << PROGRAM CST BLOCK INDEX >>       <<03004>>39344000
          FIRSTCST,        << FIRST PHYSICAL CST FOR PROGRAM>> <<03004>>39346000
          NSEG;            << NO. OF CODE SEGMENTS IN FILE >>  <<03004>>39348000
  LOGICAL LOAD'IN'CSTX;    <<TRUE IF PGM TO BE LOADED IN CSTX>><<00652>>39350000
    LOGICAL LINKED;       <<TRUE IF PROGRAM IN LINKED MEMORY>>          39352000
    COMMENT                                                             39354000
      LOADS THE PROGRAM FILE NAME, GETTING A CST AND A DST AND FIXING   39356000
    UP ALL EXTERNAL REFERENCES;                                         39358000
      BEGIN                                                             39360000
        INTEGER PROGFNUM,          <<PROGRAM FILE NUMBER>>              39362000
                GLOBRECORD,       <<DATA SEG STARTING REC #>>           39364000
                CODERECORD,       <<CODE SEG STARTING REC #>>           39366000
                EXTRECORD,        <<EXTERNAL  LIST STARTING REC #>>     39368000
                DATASIZE,         <<SIZE OF DATA SEGMENT>>              39370000
                SEGSIZE,          <<SEGMENT SIZE>>                      39372000
                CURCST,           <<CURRENT CST #>>                     39374000
                OLDCST,           <<OLD CST IN STT ENTRY>>              39376000
                OLDCSTN,          <<SAVE CSTN >>               <<*MAP*>>39378000
                INDEX,            <<EXTERNAL LIST INDEX>>               39380000
                NC,               <<NUMBER OF CHARACTERS>>              39382000
                NR,               <<NUMBER OF REFERENCES>>              39384000
                I,J,K,L,M,N,      <<TEMPS>>                             39386000
                COUNTINT,    <<COUNT OF INTERNAL STT ENTRIES>> <<*MAP*>>39388000
                NEXTS := 0,       <<NUMBER OF SATISFIED EXTERNALS>>     39390000
                LINKSIZE := 0;    <<SIZE OF MEM LINK>>                  39392000
          INTEGER CLABEL;  <<SPECIAL FORM FOR CSTX ENTRY>>     <<00652>>39394000
          DOUBLE  DCOREADDR;  << ADDRESS OF MEMORY SECTION >>  <<01384>>39396000
          LOGICAL BANK     = DCOREADDR,                        <<01384>>39398000
                  COREADDR = DCOREADDR+1;                      <<01384>>39400000
        INTEGER POINTER EXTP;     <<POINTER TO SATISFIED EXTS TABLE>>   39402000
        DOUBLE DISCADR;           <<SEGMENT DISC ADDRESS>>              39404000
          IF LINKED THEN LINKSIZE := 8;                                 39406000
          PROGFNUM := FOPEN(NAME);                                      39408000
          TOS := FLAB(28);                                              39410000
          TOS.(14:2) := 0;  << RESET READ BIT >>                        39412000
          TOS.(0:4) := 2;   << SET LOAD BIT,CLEAR S,R,X BITS>>          39414000
          FLAB(X) := TOS;                                               39416000
         FLCLID := ABSOLUTE(COLD'LOAD'ID);                              39418000
         FLFCBVECT := 0D;                                      <<*FLAB>>39420000
          CHECKSUM;          <<NEW CHECKSUM>>                           39422000
          FLCHECKSUM := TOS; <<UPDATE LABEL>>                           39424000
          DISC(WRITE,SYSDISC,FLEXT0,FLAB,128);                          39426000
          FREAD(PROGFNUM,0D,PREC0,128);  <<PROG FILE RECORD 0>>         39428000
          NSEG := PREC0(1);   <<# OF SEGMENTS>>                         39430000
          START := PREC0(10);   <<ENTRY POINT>>                         39432000
          GLOBSIZE := PREC0(2);   <<GLOBAL AREA SIZE>>                  39434000
          GLOBRECORD := PREC0(3);   <<GLOBAL AREA STARTING RECORD>>     39436000
          CODERECORD := PREC0(4);   <<CODE STARTING RECORD>>            39438000
          EXTRECORD := PREC0(13);     <<EXTERNAL STARTING RECORD>>      39440000
          MAXD := PREC0(7);  <<MAXDATA>>                                39442000
          DLVALUE := IF PREC0(6)=-1 THEN 0 ELSE PREC0(X);               39444000
          IF NAME="ININ    " THEN FIRSTCST:=ININCSTN                    39446000
          ELSE                                                          39448000
            BEGIN                                                       39450000
            IF LOAD'IN'CSTX THEN                               <<00652>>39452000
              BEGIN         <<PGM LOADED IN CSTX>>             <<00652>>39454000
                FIRSTCST := IF LOGICALMAPPING THEN 1           <<*MAP*>>39456000
                                              ELSE %301;       <<*MAP*>>39458000
                CSTBLKINDEX:=ALCSTBLOCK(NSEG);<<PGM BLOCK INDEX<<00652>>39460000
              END ELSE                                         <<00652>>39462000
              BEGIN         <<PGM LOADED IN SHARABLE CST>>     <<00652>>39464000
                FIRSTCST := GETENTRY( CSTDSTN);                <<*SLL*>>39466000
                I:=0;                                          <<00652>>39468000
                WHILE (I:=I+1) < NSEG DO GETENTRY( CSTDSTN);   <<*SLL*>>39470000
                CSTBLKINDEX:=0;                                <<00652>>39472000
              END;                                             <<00652>>39474000
            END;                                                        39476000
          CSTSEG := FIRSTCST+PREC0(9);   <<MAIN SEG>>                   39478000
          IF EXTRECORD=0 THEN GOTO LOADSEGS;                            39480000
          @EXTP := @EXTSAT;  <<POINTER TO SATISFIED EXTERNAL TABLE>>    39482000
          INDEX := 0;                                                   39484000
          OLDCSTN := CSTN;  << SAVE OLD VALUE OF CSTN >>       <<*MAP*>>39486000
          FREAD(PROGFNUM,DOUBLE(EXTRECORD),EXTBUF,256);                 39488000
          EXTRECORD := EXTRECORD+1;                                     39490000
  NEXTEXT:NC := EXTBUF(INDEX).(4:4);  <<# OF CHARS IN EXTERNAL>>        39492000
          IF = THEN GOTO FIXSL;  <<NONE LEFT>>                          39494000
          TOS := EXTLABEL(EXTBUF(INDEX));  <<GET EXTERNAL LABEL>>       39496000
          IF S0=0 THEN                                                  39498000
            BEGIN  <<NOT FOUND>>                                        39500000
              BINBUF := MOVEAN(BINBUF(1),NAME,8);              <<01103>>39502000
              EXTBUF(INDEX).(0:4) := 0;                        <<01103>>39504000
              MESSAGE(M2456,,,,,EXTBUF(INDEX),BINBUF);         <<01103>>39506000
              I := EXTBUF(INDEX+NC&LSR(1)+1)+1;                         39508000
              GOTO INCINX;                                              39510000
            END;                                                        39512000
          TOS := LOGICAL(S0) LAND %377;  <<LOGICAL CST #>>              39514000
          DUPLICATE;                                                    39516000
          ALLOCATEALL(*,6);  <<ALLOCATE ALL REFERENCES>>                39518000
          ASSEMBLE(ZERO,XCH);                                           39520000
          TOS := PHYSCST(*);  <<CONVERT TO PHYSICAL CST>>               39522000
          TOS.(8:8) := TOS;                                             39524000
          MOVE EXTP := EXTBUF(INDEX+NC&LSR(1)+1),(I:=EXTBUF(X)+1);      39526000
          NEXTS := NEXTS+1;                                             39528000
          EXTP(I) := TOS;                                               39530000
          @EXTP := @EXTP+I+1;  <<BUMP TABLE POINTER>>                   39532000
  INCINX: X := INDEX+NC&LSR(1)+I+1;                                     39534000
          NC := EXTBUF(X).(0:2);   <<P FLAG>>                           39536000
          TOS:=(IF = THEN 1 ELSE IF NC=3 THEN EXTBUF(X).(2:6)+2 ELSE 2) 39538000
                +X; <<PTR TO NEXT EXTERNAL ENTRY>>                      39540000
          IF S0>127 THEN                                                39542000
            BEGIN   <<OVERFLOWS RECORD>>                                39544000
              MOVE EXTBUF := EXTBUF(128),(X);                           39546000
              TOS := TOS-X;                                             39548000
              FREAD(PROGFNUM,DOUBLE(EXTRECORD:=EXTRECORD+1),BUF(128),X);39550000
            END;                                                        39552000
          INDEX := TOS;   <<NEW EXTBUF PTR>>                            39554000
          GOTO NEXTEXT;                                                 39556000
  FIXSL:  IF CSTN > OLDCSTN AND NAME<>"ININ    " THEN          <<*MAP*>>39558000
            BEGIN   <<SOME SL SEGS ALLOCATED>>                          39560000
              I := OLDCSTN;                                    <<fix03>>39562000
              DO FIXSTT(I:=I+1) UNTIL I>=CSTN;                          39564000
              TOS := ABSOLUTE(SLDISCADR1);                              39566000
              TOS := ABSOLUTE(X:=X+1);                                  39568000
              SEGDIRENT(*,SLTYP,FIRSTCST+NSEG,                          39570000
                  CSTN);                                                39572000
            END;                                                        39574000
  LOADSEGS:                                                             39576000
          K := 28+(NSEG+1)&LSR(1);  <<FIRST SEGMENT INDEX>>             39578000
          DISCADR := FCBDBL(PROGFNUM*FCBDSIZE)+D'L(FCB(PROGFNUM*        39580000
              FCBSIZE+FCBSECTOFF)+CODERECORD));                         39582000
          I := 0;                                                       39584000
          DO                                                            39586000
            BEGIN                                                       39588000
              IF LOAD'IN'CSTX THEN                             <<00652>>39590000
                BEGIN         <<PGM LOADED IN CSTX>>           <<00652>>39592000
                  CURCST:=(CSTBLK(CSTBLKINDEX)+4               <<00652>>39594000
                           -ABSOLUTE(DFC))/4 + I;              <<00652>>39596000
                  CLABEL:=%20000;                              <<00652>>39598000
                  CLABEL.(3:7):=CSTBLKINDEX;                   <<00652>>39600000
                  CLABEL.(10:6):=I+1;                          <<00652>>39602000
                END ELSE                                       <<00652>>39604000
                BEGIN         <<PGM LOADED IN SHARABLE CST>>   <<00652>>39606000
                  CURCST:=FIRSTCST+I;                          <<00652>>39608000
                  CLABEL:=CURCST;                              <<00652>>39610000
                END;                                           <<00652>>39612000
              INSERTCST(CLABEL,DISCADR,SEGSIZE:=PREC0(K+I),    <<03603>>39614000
                  LINKED,1);                                   <<03603>>39616000
              READSTT(CURCST);                                          39618000
              N := -(STT(STTINDEX).(8:8));                              39620000
              IF PREC0(K+I).(1:1) = 1 THEN                     <<L7655>>39622000
                 BEGIN                                         <<L7655>>39624000
                 COUNTINT := STT(STTINDEX).(0:8);              <<L7655>>39626000
                 J := -COUNTINT;                               <<L7655>>39628000
                 END                                           <<L7655>>39630000
              ELSE                                             <<L7655>>39632000
                 COUNTINT := J := 0;                           <<L7655>>39634000
              WHILE (J:=J-1) >= N DO                                    39636000
                BEGIN                                                   39638000
                  IF PREC0(K+I).(1:1) = 0 THEN                 <<L7655>>39640000
                     BEGIN                                     <<L7655>>39642000
                     IF STT(STTINDEX+J) >= 0 THEN              <<L7988>>39644000
                        BEGIN                                  <<L7988>>39646000
                        COUNTINT := COUNTINT+1;                <<L7988>>39648000
                        GO NEXTLAB;                            <<L7988>>39650000
                        END;                                   <<L7988>>39652000
                     END;                                      <<L7988>>39654000
                                                               <<L7988>>39656000
                  TOS := (-J)&LSL(8)+I;                                 39658000
                  @EXTP := @EXTSAT;                                     39660000
                  L := -1;                                              39662000
                  WHILE (L:=L+1) < NEXTS DO                             39664000
                    BEGIN  <<SEARCH SATISFIED EXTERNALS>>               39666000
                      NR := EXTP;   <<NUMBER OF REFERENCES>>            39668000
                      M := 1;                                           39670000
                      DO IF S0=EXTP(M) THEN                             39672000
                        BEGIN  <<FOUND IT>>                             39674000
                          DEL;                                          39676000
                          TOS := EXTP(NR+1);                            39678000
                          GOTO SETLAB;                                  39680000
                        END                                             39682000
                      UNTIL (M:=M+1) > NR;                              39684000
                      @EXTP := @EXTP+NR+2;  <<POINT TO NEXT ENTRY>>     39686000
                    END;                                                39688000
                  DEL;                                                  39690000
                                                               <<L7988>>39692000
                  TOS := STT(STTINDEX+J); << GET LABEL >>      <<L7988>>39694000
                  OLDCST := S0.(8:8);                          <<L7988>>39696000
                  L := 0;                                      <<L7988>>39698000
                  DO                                           <<L7988>>39700000
                     IF INTEGER(BPREC0(56+L)) = OLDCST THEN    <<L7988>>39702000
                        BEGIN  <<INTRA-PROGRAM REFERENCE>>     <<L7988>>39704000
                        TOS.(8:8) := L + FIRSTCST;             <<L7988>>39706000
                        TOS.(0:1) := IF LOAD'IN'CSTX AND       <<L7988>>39708000
                           LOGICALMAPPING THEN 0 ELSE 1;       <<L7988>>39710000
                        GO SETLAB;                             <<L7988>>39712000
                        END                                    <<L7988>>39714000
                  UNTIL (L:=L+1) = NSEG;                       <<L7988>>39716000
                  DEL;                                         <<L7988>>39718000
                                                               <<L7988>>39720000
                  TOS := %104001;   <<NOT FOUND>>                       39722000
  SETLAB:         STT(STTINDEX+J) := TOS;                               39724000
  NEXTLAB:      END;                                                    39726000
              <<UPDATE STT HEAD TO NEW/OLD FORMAT>>            <<L7655>>39728000
              IF LOGICALMAPPING THEN                           <<L7655>>39730000
                 BEGIN                                         <<L7655>>39732000
                 STT(STTINDEX).(0:8) := COUNTINT;              <<L7655>>39734000
                 PREC0(K+I).(1:1) := 1;                        <<L7655>>39736000
                 END                                           <<L7655>>39738000
              ELSE                                             <<L7655>>39740000
                 BEGIN                                         <<L7655>>39742000
                 STT(STTINDEX).(0:8) := %100;                  <<L7655>>39744000
                 PREC0(K+I).(1:1) := 0;                        <<L7655>>39746000
                 END;                                          <<L7655>>39748000
              DISC(WRITE,STTLDEV,STTADR,STT,384);              <<L7655>>39750000
              IF LINKED<>2 THEN                                         39752000
                READCODE(CLABEL, LINKED);                      <<01384>>39754000
              DISCADR := DISCADR+DOUBLE((SEGSIZE.(2:14)+127)&LSR(7));   39756000
            END                                                         39758000
          UNTIL (I:=I+1)=NSEG;                                          39760000
          I := 0;   <<RESET CST REMAP ARRAY>>                           39762000
          DO BPREC0(56+I) := FIRSTCST+I UNTIL (I:=I+1)=NSEG;            39764000
          FWRITE(PROGFNUM,0D,PREC0,128);                                39766000
          IF STACKSIZE=0 THEN GOTO CLOSEFILE;  <<NO STACK>>             39768000
          I := IF LINKED=0 THEN PCBXCRSIZE ELSE PCBXLKSIZE;    <<01384>>39770000
          DATASIZE := ((I+GLOBSIZE+DLVALUE+STACKSIZE+3+        <<01384>>39772000
            (IF LINKED<>0 THEN 128 ELSE 0))&LSR(2))&LSL(2);    <<01384>>39774000
          DSTSTACK := GETENTRY( DSTDSTN);                      <<*SLL*>>39776000
         DST(DSTSTACK&LSL(2)+1).STKFLAG:=1;                    <<MPEIV>>39778000
         DST(X).DISCCOPYVALIDFLAG:=1;                          <<MPEIV>>39780000
          IF LINKED <> ABSENT' THEN                            <<01384>>39782000
            DCOREADDR:= INITTABLE(DATASIZE, 1,                 <<32BND>>39784000
                                   ANYWHERE'TAB, FALSE)        <<32BND>>39786000
          ELSE                                                 <<01384>>39788000
            DCOREADDR:= INITTABLE(DATASIZE, 1,                 <<32BND>>39790000
                                   TEMPORARY'TAB, FALSE);      <<32BND>>39792000
          TOS := PROGFNUM;                                              39794000
          TOS := 0;                                                     39796000
          TOS := GLOBRECORD;                                            39798000
          TOS := DCOREADDR;  << S-1 = BANK; S-0 = COREADDR >>  <<01384>>39800000
          TOS := TOS+DLVALUE+I;                                <<01384>>39802000
          FREAD'(*,*,*,GLOBSIZE);  <<READ DB AREA>>                     39804000
          IF MAXD=-1 THEN MAXD:=DATASIZE;                               39806000
          INSERTDST(DCOREADDR,DSTSTACK,DATASIZE,               <<32BND>>39808000
            IF LINKED=1 THEN DATASIZE+1540 ELSE 0);            <<32BND>>39810000
  CLOSEFILE:                                                            39812000
          FCLOSE(PROGFNUM);                                             39814000
      END <<LOAD>> ;                                                    39816000
$PAGE "SYSTEM PROCESS PROCEDURES"                                       39818000
PROCEDURE BROTHER(PCBPT);                                      <<*pcb*>>39820000
VALUE PCBPT;                                                   <<*pcb*>>39822000
INTEGER PCBPT;                                                 <<*pcb*>>39824000
BEGIN                                                          <<*pcb*>>39826000
Comment                                                        <<*pcb*>>39828000
   This procedure will make PCBPT the son of PROGEN and the    <<*pcb*>>39830000
   brother of the all other PROGEN's sons.                     <<*pcb*>>39832000
;                                                              <<*pcb*>>39834000
INTEGER                                                        <<*pcb*>>39836000
   SAVE'PCBPT;                                                 <<*pcb*>>39838000
FATHERINFO := PROGPCBN * PCBSIZE;                              <<*pcb*>>39840000
SAVE'PCBPT := PCBPT;                                           <<*pcb*>>39842000
PCBPT := PROGPCBN * PCBSIZE;                                   <<*pcb*>>39844000
IF SONINFO = 0 THEN                                            <<*pcb*>>39846000
   SONINFO := SAVE'PCBPT                                       <<*pcb*>>39848000
ELSE                                                           <<*pcb*>>39850000
   BEGIN                                                       <<*pcb*>>39852000
   PCBPT := SONINFO;                                           <<*pcb*>>39854000
   DO                                                          <<*pcb*>>39856000
      PCBPT := BROTHERINFO                                     <<*pcb*>>39858000
   UNTIL BROTHERINFO = 0;                                      <<*pcb*>>39860000
   BROTHERINFO := SAVE'PCBPT;                                  <<*pcb*>>39862000
   END;                                                        <<*pcb*>>39864000
                                                               <<*pcb*>>39866000
END; << procedure brother >>                                   <<*pcb*>>39868000
                                                                        39870000
          <<----------------                                            39872000
            CREATE PROCESS                                              39874000
          ---------------->>                                            39876000
<<CREATED PROCESSES ARE LOADED INTO THE CSTX AREA.  EACH>>     <<00652>>39878000
<<PROCESS HAS ITS OWN PRIVATE WORKING SET.  PROCREATED  >>     <<00652>>39880000
<<PROCESSES ARE LOADED IN THE SHARABLE CST AREA.  EACH  >>     <<00652>>39882000
<<PROCESS SHARES THE SYSTEM PROCESS WORKING SET.        >>     <<00652>>39884000
  INTEGER PROCEDURE CREATE(NAME,LOGPCBN,PRIORITY,STACKSIZE,             39886000
              STATBIT,PROCTYPE,RESABSDB,SON,LINKED,XINIT);              39888000
    VALUE LOGPCBN,PRIORITY,STACKSIZE,STATBIT,PROCTYPE,SON,              39890000
              RESABSDB,LINKED,XINIT;                                    39892000
    BYTE ARRAY NAME;          <<NAME OF PROGRAM FILE>>                  39894000
    INTEGER LOGPCBN,          <<LOGICAL PCB NUMBER>>                    39896000
            PRIORITY,         <<PROCESS PRIORITY>>                      39898000
            STACKSIZE,        <<INITIAL STACKSIZE>>                     39900000
            STATBIT,          <<BIT IN PCB STATUS WORD>>                39902000
            PROCTYPE,         <<PROCESS TYPE>>                          39904000
            XINIT;            <<INITIAL VALUE FOR X>>                   39906000
    LOGICAL SON,              <<TRUE IF SON OF PROGENITOR>>             39908000
            RESABSDB,         <<BIT 0=1 MEANS RESIDENT,                 39910000
                                BIT 15=1 MEANS ABSOLUTE DB>>            39912000
            LINKED;          <<0 IF CORE RESIDENT,2 IF LINKED>><<MPEIV>>39914000
                                                               <<MPEIV>>39916000
      BEGIN                                                             39918000
<< Offsets into SLL Header entry >>                            <<c8392>>39920000
                                                               <<c8392>>39922000
DEFINE                                                         <<c8392>>39924000
   SCHEDTOIOMSG      =  SLLHEADINX#,                           <<c8392>>39926000
   FIRSTINX          =  SLLHEADINX + 1#,                       <<c8392>>39928000
   MEMREQINX         =  SLLHEADINX + 3#,                       <<c8392>>39930000
   SEGCOUNT          =  SLLHEADINX + 4#,                       <<c8392>>39932000
<< NEXTIMPPIN        =  SLLINX#,              >>               <<c8392>>39934000
<< NEXTINX           =  SLLINX + 1#,          >>               <<c8392>>39936000
<< PREVINX           =  SLLINX + 2#,          >>               <<c8392>>39938000
   SLL'OBJDESC       =  SLLINX + 3#,                           <<c8392>>39940000
   SLL'OBJNUM        =  SLLINX + 4#,                           <<c8392>>39942000
   SLL'FLAGS         =  SLLINX + 5#;                           <<c8392>>39944000
                                                               <<c8392>>39946000
DEFINE                                                         <<c8392>>39948000
   << SCHEDTOIOMSG field definitions >>                        <<c8392>>39950000
                                                               <<c8392>>39952000
   SLLSWAPREQFLAG       =  (1:1)#,                             <<c8392>>39954000
<< SLLHASMEMFLAG        =  (2:1)#,            >>               <<c8392>>39956000
<< SLLLOCINITFLAG       =  (3:1)#,            >>               <<c8392>>39958000
<< SLLPARTIALSWAPDONEFLAG= (4:1)#,            >>               <<c8392>>39960000
<< SLLSTARTOVERFLAG     =  (5:1)#,            >>               <<c8392>>39962000
<< SLLSWAPIPFLAG        =  (6:1)#,            >>               <<c8392>>39964000
<< SLLIOCOMPTOAWAKECNT  =  (8:8)#,            >>               <<c8392>>39966000
                                                               <<c8392>>39968000
   << SLL'FLAGS field definitions    >>                        <<c8392>>39970000
                                                               <<c8392>>39972000
   SLLSTKENTRYFLAG      =  (1:1)#;                             <<c8392>>39974000
<< SLLMAPSEGFLAG        =  (0:1)#,            >>               <<c8392>>39976000
<< SLLDISCIOSEGFLAG     =  (2:1)#,            >>               <<c8392>>39978000
<< SLLLOCKEDFLAG        =  (3:1)#,            >>               <<c8392>>39980000
<< SLLBLKLOCKREQFLAG    =  (4:1)#,            >>               <<c8392>>39982000
<< SLLFZFLAG            =  (5:1)#,            >>               <<c8392>>39984000
<< SLLIMIFLAG           =  (6:1)#,            >>               <<c8392>>39986000
<< SLLTOSSENTRYFLAG     =  (7:1)#,            >>               <<c8392>>39988000
<< SLLFZREQFLAG         =  (8:1)#,            >>               <<c8392>>39990000
<< SLLLKREQFLAG         =  (9:1)#,            >>               <<c8392>>39992000
<< SLLDECCNTFLAG        = (10:1)#,            >>               <<c8392>>39994000
<< SLLPREFETCHCOUNT     = (11:5)#,            >>               <<c8392>>39996000
<< DEFINE SEGIDENTCODEFLAG=(0:1)#,          >>                 <<c8392>>39998000
   <<  SEGIDENTBLKFLAG=(1:1)#;              >>                 <<c8392>>40000000
        INTEGER PCBXSIZE,     <<SIZE OF PCBX>>                          40002000
                PXFIXSIZE,                                              40004000
                GLOB,         <<SIZE OF GLOBAL AREA>>                   40006000
                DSTN,         <<STACK DST>>                             40008000
                N,                                                      40010000
                NSEG,         <<NO. OF CODE SEGMENTS>>         <<03004>>40012000
                FIRSTCST,     <<PHYS. CST OF 1ST SEGMENT>>     <<03004>>40014000
                SLLHEADINX,   << Index to SLL header entry >>  <<*SLL*>>40016000
                SLLINX,       << Index to SLL regular entry >> <<*SLL*>>40018000
                TEMP,                                          <<01384>>40020000
               PCBPT,                                          <<*pcb*>>40022000
                PCBN=CREATE;  <<PCB NUMBER>>                   <<01384>>40024000
        DOUBLE  MARKER,       <<PTR TO STACK MARKER>>          <<01384>>40026000
                PCBX;         <<PTR TO PCBX>>                  <<01384>>40028000
        LOGICAL MARKER1 = MARKER,                              <<01384>>40030000
                MARKER2 = MARKER+1,                            <<01384>>40032000
                PCBX1   = PCBX,                                <<01384>>40034000
                PCBX2   = PCBX+1;                              <<01384>>40036000
        INTEGER CSTBLKINDEX;  <<PGM CSTBLK INDEX>>             <<00652>>40038000
        LOGICAL CREATEFLAG:=TRUE;                              <<00652>>40040000
        DOUBLE  DCOREADDR;                                     <<01384>>40042000
        INTEGER BANK     = DCOREADDR,                          <<01384>>40044000
                COREADDR = DCOREADDR+1;                        <<01384>>40046000
        ENTRY PROCREATE;                                                40048000
          IF STACKSIZE <> 0 THEN STACKSIZE:=STACKSIZE+256;     <<MPEIV>>40050000
          LOAD(NAME,CSTINDEX,DSTN,STACKSIZE,GLOB,PROCSTART,             40052000
          LINKED,TRUE,CSTBLKINDEX,FIRSTCST,NSEG); <<LOAD PROG>><<03004>>40054000
                                                               <<03004>>40056000
          GO AROUND;                                                    40058000
  PROCREATE:                                                            40060000
          CREATEFLAG:=FALSE;    <<NOT A CREATE>>               <<00652>>40062000
          IF STACKSIZE <> 0 THEN STACKSIZE:=STACKSIZE+256;     <<MPEIV>>40064000
          TOS := 0;                                                     40066000
          TOS := PLABEL(NAME);                                          40068000
          CSTINDEX := S0.(8:8);                                         40070000
          PROCSTART := INTLABEL(*);                                     40072000
          CSTBLKINDEX:=0;       <<NOT IN CSTX>>                <<00652>>40074000
          TOS := 0;                                                     40076000
          TOS := IF LINKED=0 THEN PCBXCRSIZE ELSE PCBXLKSIZE;           40078000
          TOS:=TOS+STACKSIZE+(IF LINKED=0 THEN 0 ELSE 128);    <<00277>>40080000
                    <<SIZE OF DATA SEGMENT>>                   <<00277>>40082000
          MAXD := ((S0+3)&LSR(2))&LSL(2);                      <<00277>>40084000
          MEMSEG := ROUND(*);                                  <<01384>>40086000
          DSTN := GETENTRY( DSTDSTN);                          <<*SLL*>>40088000
          IF LINKED <> ABSENT' THEN  << GET STACK SPACE >>     <<01384>>40090000
            DCOREADDR:= INITTABLE(MEMSEG, 1,                   <<32BND>>40092000
                                   ANYWHERE'TAB, FALSE)        <<32BND>>40094000
          ELSE                                                 <<01384>>40096000
            DCOREADDR:= INITTABLE(MEMSEG, 1,                   <<32BND>>40098000
                                   TEMPORARY'TAB, FALSE);      <<32BND>>40100000
          GLOB := 0;                                                    40102000
          DLVALUE := 0;                                                 40104000
          INSERTDST(DCOREADDR,DSTN,MEMSEG,IF LINKED=0 THEN 0   <<32BND>>40106000
            ELSE MAXD+1540);                                   <<32BND>>40108000
        DST(DSTN&LSL(2)+1).DISCCOPYVALIDFLAG:=1;               <<MPEIV>>40110000
        DST(X).STKFLAG:=1;                                     <<MPEIV>>40112000
                                                               <<01384>>40114000
  AROUND:                                                               40116000
          PCBN := IF SON THEN GETENTRY( PCBDSTN)               <<*SLL*>>40118000
             ELSE PROGPCBN;                                    <<*SLL*>>40120000
           PCBPT := PCBN * PCBSIZE;                            <<*pcb*>>40122000
          IF LOGPCBN >= 0                                               40124000
            THEN ABSOLUTE(LPROCTAB+LOGPCBN) := PCBN*PCBSIZE;            40126000
          IF LINKED=0 THEN                                              40128000
            BEGIN  <<CORE RESIDENT STACK>>                              40130000
              TOS := PCBXCRSIZE;                                        40132000
              TOS := PXFIXCRSIZE;                                       40134000
            END                                                         40136000
          ELSE                                                          40138000
            BEGIN  <<LINKED MEMORY STACK>>                              40140000
            TOS := PCBXLKSIZE;                                          40142000
              TOS := PXFIXLKSIZE;                                       40144000
            END;                                                        40146000
          PXFIXSIZE := TOS;                                             40148000
          PCBXSIZE := TOS;                                              40150000
                                                               <<01384>>40152000
          BANK := DST(DSTN&LSL(2)+2).(8:8);                    <<01756>>40154000
          COREADDR := DST(X:=X+1);                             <<01384>>40156000
          DBVALUE := COREADDR+PCBXSIZE+DLVALUE;                <<01384>>40158000
          ZVALUE := GLOB+STACKSIZE-17;                                  40160000
                                                               <<01384>>40162000
        << SET UP MARKER >>                                    <<01384>>40164000
          MARKER1 := BANK;                                     <<01384>>40166000
          MARKER2 := DBVALUE + GLOB;                           <<01384>>40168000
          SSEA(MARKER+0D, 0);  << PARM FOR TERMINATE >>        <<01384>>40170000
          SSEA(MARKER+1D, 0);  << TERMINATE MARKER >>          <<01384>>40172000
          SSEA(MARKER+2D, ABSOLUTE(TERMINTLAB));               <<01384>>40174000
          TEMP := ABSOLUTE(TERMEXTLAB).(8:8);                  <<01384>>40176000
          TEMP.(0:2) := 3;                                     <<01384>>40178000
          SSEA(MARKER+3D, TEMP);                               <<01384>>40180000
          SSEA(MARKER+4D, 4);                                  <<01384>>40182000
          SSEA(MARKER+5D, XINIT);  << START UP MARKER >>       <<01384>>40184000
          TEMP := PROCSTART;                                   <<*MAP*>>40186000
          IF LOGICALMAPPING AND CSTBLKINDEX = 0 THEN           <<*MAP*>>40188000
             TEMP.MAPFLAG := 1; << SET PHYSICAL BIT >>         <<*MAP*>>40190000
          SSEA(MARKER+6D, TEMP);                               <<*MAP*>>40192000
          SSEA(MARKER+7D, %140000+CSTINDEX);                   <<01384>>40194000
          SSEA(MARKER+8D, 4);                                  <<01384>>40196000
          IF RESABSDB THEN  << VALUE FOR DB >>                 <<01384>>40198000
            BEGIN                                              <<01384>>40200000
            SSEA(MARKER+9D, 0);                                <<01384>>40202000
            SSEA(MARKER+10D, SYSBASE);                         <<01384>>40204000
            END                                                <<01384>>40206000
          ELSE                                                 <<01384>>40208000
            BEGIN                                              <<01384>>40210000
            SSEA(MARKER+9D, BANK);                             <<01384>>40212000
            SSEA(MARKER+10D, DBVALUE);                         <<01384>>40214000
            END;                                               <<01384>>40216000
          SVALUE := GLOB+10;                                   <<01384>>40218000
                                                               <<01384>>40220000
        << SET UP PXGLOB AREA >>                               <<01384>>40222000
          PCBX := DCOREADDR;                                   <<01384>>40224000
          SSEA(PCBX+0D, PCBXSIZE);        << OFFSET TO DL >>   <<01384>>40226000
          SSEA(PCBX+1D, PCBXSIZE+DLVALUE);<< OFFSET TO DB >>   <<01384>>40228000
          SSEA(PCBX+2D, -1);              << ATTRIBUTES >>     <<01384>>40230000
          SSEA(PCBX+4D, -1);              << JPCNT >>          <<PCBXG>>40232000
          SSEA(PCBX+6D, %6000);           << INTR,DUPL >>      <<PCBXG>>40234000
          SSEA(PCBX+8D, CONSOLELDEV);     << JOB INPUT LDEV >> <<PCBXG>>40236000
          SSEA(PCBX+9D, CONSOLELDEV);     << JOB OUTPUT LDEV>> <<PCBXG>>40238000
          IF LINKED<>0 THEN                                    <<01384>>40240000
            BEGIN                                              <<01384>>40242000
            SSEA(PCBX+10D, SJDTDSTN);      << JDT DST >>       <<PCBXG>>40244000
            SSEA(PCBX+11D, SJITDSTN);      << JIT DST >>       <<PCBXG>>40246000
            END;                                               <<01384>>40248000
                                                               <<01384>>40250000
        << SET UP PXFIXED AREA >>                              <<01384>>40252000
          PCBX2 := PCBX2 + PXGLOB;                             <<01384>>40254000
          SSEA(PCBX+0D, PXFIXSIZE);<< LENGTH OF FILE AREA >>   <<01384>>40256000
          SSEA(PCBX+1D, SVALUE);   << S-DB >>                  <<01384>>40258000
          SSEA(PCBX+2D, ZVALUE);   << Z-DB >>                  <<01384>>40260000
          SSEA(PCBX+3D, GLOB);     << Q-DB >>                  <<01384>>40262000
          SSEA(PCBX+4D, DLVALUE);  << DB-DL >>                 <<01384>>40264000
          SSEA(PCBX+5D, -1);       << GENERAL RESOURCE CAP. >> <<01384>>40266000
          IF LINKED<>0 THEN                                             40268000
            BEGIN  <<STACK IN LINKED MEMORY>>                           40270000
            SSEA(PCBX+13D, MAXD);  << MAXIMUM DL TO Z >>       <<01384>>40272000
            N := MAXD + 1536;                                  <<MPEIV>>40274000
            TEMP:=((N+NWORDPAGE-1)/NWORDPAGE)*NWORDPAGE;       <<01384>>40276000
            SSEA(PCBX+34D, TEMP);  << USED VIRTUAL DISC SPACE>><<PCBXG>>40278000
            SSEA(PCBX+23D, STACKSIZE);<<CURRENT MAXSTACK SIZE>><<01964>>40280000
            END;                                                        40282000
          PCBX2 := PCBX2 + LOGICAL(PXFIXSIZE);                 <<01384>>40284000
          IF LINKED<>0 THEN                                             40286000
            BEGIN                                                       40288000
            SSEA(PCBX+0D, PXFILE);  << LENGTH OF FILE AREA >>  <<01384>>40290000
            PCBX2 := PCBX2 + PXFILE;                           <<01384>>40292000
            END;                                                        40294000
          SSEA(PCBX+0D, 0);  << EXTRA PCBX PTR >>              <<01384>>40296000
          SSEA(PCBX+1D, PCBXSIZE-PXGLOB-PXFIXSIZE);<<FILEAREA>><<01384>>40298000
          SSEA(PCBX+2D, PCBXSIZE-PXGLOB);  << FIXED AREA PTR >><<01384>>40300000
          SSEA(PCBX+3D, PCBXSIZE);  << PTR TO GLOBAL AREA >>   <<01384>>40302000
                                                               <<01384>>40304000
          IF LINKED=2 THEN ABSENT(DSTN,N);  <<WRITE OUT STACK>><<01384>>40306000
                                                               <<MPEIV>>40308000
                                                               <<MPEIV>>40310000
TOS:=0;                                                        <<MPEIV>>40312000
TOS:=SYSBASE;                                                  <<MPEIV>>40314000
ASSEMBLE(XCHD);                                                <<MPEIV>>40316000
IF SON THEN                                                    <<*pcb*>>40318000
   BROTHER(PCBPT);                                             <<*pcb*>>40320000
IF INTEGER(RESABSDB) < 0 THEN QUEUEINGINFO.PROCRESIDENTFLAG:=1 <<MPEIV>>40322000
ELSE                                                           <<MPEIV>>40324000
   BEGIN  <<NOT A CORE RESIDENT PROCESS>>                      <<MPEIV>>40326000
   PIINFO.PSIMFIELD := 7;                                      <<*pcb*>>40328000
   TOS:=RESABORTINFO;                                          <<MPEIV>>40330000
   TOS.SARFLAG:=1;                                             <<MPEIV>>40332000
   RESABORTINFO:=TOS;                                          <<MPEIV>>40334000
   WAKEMASK.MEMWAITFLAG:=1;                                    <<MPEIV>>40336000
   TOS := GETENTRY( SWAPTABDSTN); << ENTRY NUMBER >>           <<*SLL*>>40338000
   TOS := SYSBASE D;                                           <<*SLL*>>40340000
   SET( DB );  << GETENTRY RETURNS DB TO STACK !!! >>          <<*SLL*>>40342000
   TOS:=TOS*SWAPTABSIZE;                                       <<MPEIV>>40344000
   SLLPTR:=S0;                                                 <<MPEIV>>40346000
   SLLHEADINX := TOS; << Fix SLL entry so stk gets swapped in>><<*SLL*>>40348000
   TOS:=0;                                                     <<MPEIV>>40350000
   TOS.SLLSWAPREQFLAG:=1;                                      <<MPEIV>>40352000
   SLL(SCHEDTOIOMSG) := TOS;                                   <<*SLL*>>40354000
   TOS := GETENTRY( SWAPTABDSTN);                              <<*SLL*>>40356000
   TOS := SYSBASE D;                                           <<*SLL*>>40358000
   SET( DB );  << GETENTRY RETURNS DB TO STACK !!! >>          <<*SLL*>>40360000
   TOS:=TOS*SWAPTABSIZE;                                       <<MPEIV>>40362000
   SLL(FIRSTINX) := S0;                                        <<*SLL*>>40364000
   SLL(MEMREQINX) := S0;                                       <<*SLL*>>40366000
   SLL(SEGCOUNT) := 1;                                         <<*SLL*>>40368000
   SLLINX := TOS;    << Fill in SLL entry for the stack >>     <<*SLL*>>40370000
   SLL(SLL'OBJNUM) := DSTN;                                    <<*sll5>>40372000
   SLL(SLL'OBJDESC) := 0;                                      <<*sll5>>40374000
                                                               <<*sll5>>40376000
   SLL(SLL'FLAGS).SLLSTKENTRYFLAG := 1;                        <<*SLL*>>40378000
                                                               <<MPEIV>>40380000
   END;                                                        <<MPEIV>>40382000
IF RESABSDB THEN DBXDSINFO.ABSDBFLAG:=1;                       <<MPEIV>>40384000
STKINFO.STACKFIELD:=DSTN;                                      <<MPEIV>>40386000
                                                               <<MPEIV>>40388000
TOS:=WAKEMASK;                                                 <<MPEIV>>40390000
X:=STATBIT;                                                    <<MPEIV>>40392000
IF <> THEN ASSEMBLE(TSBC 0,X);                                 <<MPEIV>>40394000
WAKEMASK:=TOS;                                                 <<MPEIV>>40396000
PBX := CSTBLKINDEX;                                            <<*pcb*>>40398000
MAPDST := 0;                                                   <<*MAP*>>40400000
QUEUEINGINFO.PRIFIELD:=PRIORITY;                               <<MPEIV>>40402000
QUEUEINGINFO.LQFLAG:=1;                                        <<MPEIV>>40404000
TOS:=PROCSTATE;                                                <<MPEIV>>40406000
TOS.LIVFLAG:=1;                                                <<MPEIV>>40408000
TOS.PROCESSTYPEFIELD:=PROCTYPE;                                <<MPEIV>>40410000
PROCSTATE:=TOS;                                                <<MPEIV>>40412000
ASSEMBLE(XCHD);                                                <<MPEIV>>40414000
END <<CREATE>> ;                                               <<MPEIV>>40416000
                                                                        40418000
$PAGE         "DEVICE TABLES MANIPULATION PROCEDURES"                   40420000
$CONTROL SEGMENT=MAINSEG1                                               40422000
          <<--------------------------                                  40424000
            CONVERT ASCII AND EBCDIC                                    40426000
          -------------------------->>                                  40428000
PROCEDURE CONVERT(CODE,INSTRING,OUTSTRING,STRINGLENGTH);                40430000
VALUE CODE,STRINGLENGTH;                                                40432000
INTEGER CODE,STRINGLENGTH;                                              40434000
BYTE ARRAY INSTRING,OUTSTRING;                                          40436000
BEGIN                                                                   40438000
     INTEGER I := -1;                                                   40440000
     ARRAY ASCI(0:255)=PB:=                                             40442000
                                                                        40444000
          << EBCDIC TO ASCII CONVERSION TABLE >>                        40446000
                                                                        40448000
          %000, %001, %002, %003, %000, %011, %000, %177,               40450000
          %000, %000, %000, %013, %014, %015, %016, %017,               40452000
          %020, %021, %022, %023, %000, %000, %010, %000,               40454000
          %030, %031, %000, %000, %034, %035, %036, %037,               40456000
          %000, %000, %000, %000, %000, %012, %027, %033,               40458000
          %000, %000, %000, %000, %000, %005, %006, %007,               40460000
          %000, %000, %026, %000, %000, %000, %000, %004,               40462000
          %000, %000, %000, %000, %024, %025, %000, %032,               40464000
          %040, %000, %000, %000, %000, %000, %000, %000,               40466000
          %000, %000, %133, %056, %074, %050, %053, %041,               40468000
          %046, %000, %000, %000, %000, %000, %000, %000,               40470000
          %000, %000, %135, %044, %052, %051, %073, %136,               40472000
          %055, %057, %000, %000, %000, %000, %000, %000,               40474000
          %000, %000, %174, %054, %045, %137, %076, %077,               40476000
          %000, %000, %000, %000, %000, %000, %000, %000,               40478000
          %000, %140, %072, %043, %100, %047, %075, %042,               40480000
          %000, %141, %142, %143, %144, %145, %146, %147,               40482000
          %150, %151, %000, %000, %000, %000, %000, %000,               40484000
          %000, %152, %153, %154, %155, %156, %157, %160,               40486000
          %161, %162, %000, %000, %000, %000, %000, %000,               40488000
          %000, %176, %163, %164, %165, %166, %167, %170,               40490000
          %171, %172, %000, %000, %000, %000, %000, %000,               40492000
          %000, %000, %000, %000, %000, %000, %000, %000,               40494000
          %000, %000, %000, %000, %000, %000, %000, %000,               40496000
          %173, %101, %102, %103, %104, %105, %106, %107,               40498000
          %110, %111, %000, %000, %000, %000, %000, %000,               40500000
          %175, %112, %113, %114, %115, %116, %117, %120,               40502000
          %121, %122, %000, %000, %000, %000, %000, %000,               40504000
          %134, %000, %123, %124, %125, %126, %127, %130,               40506000
          %131, %132, %000, %000, %000, %000, %000, %000,               40508000
          %060, %061, %062, %063, %064, %065, %066, %067,               40510000
          %070, %071, %000, %000, %000, %000, %000, %000;               40512000
                                                                        40514000
     ARRAY EBCDIC(0:255)=PB:=                                           40516000
                                                                        40518000
          << ASCII TO EBCDIC CONVERSION TABLE >>                        40520000
                                                                        40522000
          %000, %001, %002, %003, %067, %055, %056, %057,               40524000
          %026, %005, %045, %013, %014, %015, %016, %017,               40526000
          %020, %021, %022, %023, %074, %075, %062, %046,               40528000
          %030, %031, %077, %047, %034, %035, %036, %037,               40530000
          %100, %117, %177, %173, %133, %154, %120, %175,               40532000
          %115, %135, %134, %116, %153, %140, %113, %141,               40534000
          %360, %361, %362, %363, %364, %365, %366, %367,               40536000
          %370, %371, %172, %136, %114, %176, %156, %157,               40538000
          %174, %301, %302, %303, %304, %305, %306, %307,               40540000
          %310, %311, %321, %322, %323, %324, %325, %326,               40542000
          %327, %330, %331, %342, %343, %344, %345, %346,               40544000
          %347, %350, %351, %112, %340, %132, %137, %155,               40546000
          %171, %201, %202, %203, %204, %205, %206, %207,               40548000
          %210, %211, %221, %222, %223, %224, %225, %226,               40550000
          %227, %230, %231, %242, %243, %244, %245, %246,               40552000
          %247, %250, %251, %300, %152, %320, %241, %007,               40554000
          %000, %000, %000, %000, %000, %000, %000, %000,               40556000
          %000, %000, %000, %000, %000, %000, %000, %000,               40558000
          %000, %000, %000, %000, %000, %000, %000, %000,               40560000
          %000, %000, %000, %000, %000, %000, %000, %000,               40562000
          %000, %000, %000, %000, %000, %000, %000, %000,               40564000
          %000, %000, %000, %000, %000, %000, %000, %000,               40566000
          %000, %000, %000, %000, %000, %000, %000, %000,               40568000
          %000, %000, %000, %000, %000, %000, %000, %000,               40570000
          %000, %000, %000, %000, %000, %000, %000, %000,               40572000
          %000, %000, %000, %000, %000, %000, %000, %000,               40574000
          %000, %000, %000, %000, %000, %000, %000, %000,               40576000
          %000, %000, %000, %000, %000, %000, %000, %000,               40578000
          %000, %000, %000, %000, %000, %000, %000, %000,               40580000
          %000, %000, %000, %000, %000, %000, %000, %000,               40582000
          %000, %000, %000, %000, %000, %000, %000, %000,               40584000
          %000, %000, %000, %000, %000, %000, %000, %000;               40586000
                                                                        40588000
     CASE * CODE OF                                                     40590000
     BEGIN                                                              40592000
          WHILE(I:=I+1)<STRINGLENGTH DO                                 40594000
          BEGIN     <<CASE 0, CONVERT EBCDIC TO ASCII>>                 40596000
               X := INSTRING(I);                                        40598000
               TOS := ASCI(X);                                          40600000
               OUTSTRING(I) := TOS;                                     40602000
          END;                                                          40604000
          WHILE(I:=I+1)<STRINGLENGTH DO                                 40606000
          BEGIN     <<CASE 1, CONVERT ASCII TO EBCDIC>>                 40608000
               X := INSTRING(I);                                        40610000
               TOS := EBCDIC(X);                                        40612000
               OUTSTRING(I) := TOS;                                     40614000
          END;                                                          40616000
     END;                                                               40618000
END <<CONVERT>>;                                                        40620000
                                                                        40622000
$CONTROL SEGMENT=CONFIGURE                                              40624000
         <<------------------------------------>>              <<03550>>40626000
         << CHECK FOR SYSTEM-DISC TYPE DEVICES >>              <<03550>>40628000
         <<------------------------------------>>              <<03550>>40630000
LOGICAL PROCEDURE SYSDISC'TYPE( TYPE, SUBTYP);                 <<03550>>40632000
VALUE TYPE, SUBTYP;                                            <<03550>>40634000
INTEGER TYPE,     << DEVICE TYPE >>                            <<03550>>40636000
        SUBTYP;   << DEVICE SUBTYPE >>                         <<03550>>40638000
COMMENT                                                        <<03550>>40640000
THIS PROCEDURE RETURNS TRUE IF THE DEVICE WITH                 <<03550>>40642000
THE GIVEN TYPE AND SUBTYPE IS A VALID SYSTEM-                  <<03550>>40644000
DOMAIN DISC.  IT RETURNS FALSE OTHERWISE.                      <<03550>>40646000
;                                                              <<03550>>40648000
BEGIN                                                          <<03550>>40650000
IF TYPE = 0 << MH DISC >> OR                                   <<*LDT*>>40652000
   TYPE = 1 << FH DISC >> OR                                   <<*LDT*>>40654000
   TYPE = 3 << CS80 DEVICE >> AND                              <<*8392>>40656000
   SUBTYP <> LINUS AND SUBTYP <> BUFFALO THEN                  <<L8871>>40658000
   SYSDISC'TYPE := TRUE                                        <<03550>>40660000
ELSE                                                           <<03550>>40662000
   SYSDISC'TYPE := FALSE;                                      <<03550>>40664000
END;  << SYSDISC'TYPE >>                                       <<03550>>40666000
          <<----------------------------------->>              <<03550>>40668000
          << CHECK FOR SERIAL-DISC TYPE DEVICE >>              <<03550>>40670000
          <<----------------------------------->>              <<03550>>40672000
LOGICAL PROCEDURE SDISC'TYPE( TYPE, SUBTYP);                   <<03550>>40674000
VALUE TYPE, SUBTYP;                                            <<03550>>40676000
INTEGER TYPE,     << DEVICE TYPE >>                            <<03550>>40678000
        SUBTYP;   << DEVICE SUBTYPE >>                         <<03550>>40680000
COMMENT                                                        <<03550>>40682000
THIS PROCEDURE RETURNS TRUE IF THE DEVICE WITH                 <<03550>>40684000
THE GIVEN TYPE AND SUBTYPE CAN BE A SERIAL DISC.               <<03550>>40686000
IT RETURNS FALSE OTHERWISE.  ALL REMOVABLE DISCS               <<03550>>40688000
EXCEPT THE 7900 CAN BE SERIAL DISCS.                           <<03550>>40690000
;                                                              <<03550>>40692000
BEGIN                                                          <<03550>>40694000
IF TYPE=0 << MH DISC >> AND (SUBTYP=UH7905 OR SUBTYP=UH7906    <<*LDT*>>40696000
                OR SUBTYP=S7920  OR SUBTYP=S7925 ) OR          <<03550>>40698000
   TYPE = 2 << FLOPPY DISC >> OR                               <<*LDT*>>40700000
   TYPE = 3 << CS80 DEVICE >> THEN                             <<*LDT*>>40702000
                                                               <<03550>>40704000
   SDISC'TYPE := TRUE    << IT CAN BE A SERIAL DISC >>         <<03550>>40706000
ELSE                                                           <<03550>>40708000
   SDISC'TYPE := FALSE;  << IT CAN'T BE SERIAL >>              <<03550>>40710000
END;  << SDISC'TYPE >>                                         <<03550>>40712000
         <<----------------------------->>                     <<03550>>40714000
         <<   IDENTIFY HPIB DEVICE      >>                     <<03550>>40716000
         <<----------------------------->>                     <<03550>>40718000
INTEGER PROCEDURE IDENTIFY( DRT);                              <<03550>>40720000
VALUE DRT;                                                     <<03550>>40722000
INTEGER DRT;   << DRT # OF DEVICE TO IDENTIFY >>               <<03550>>40724000
COMMENT                                                        <<03550>>40726000
THIS PROCEDURE RETURNS THE HPIB DEVICE IDENTIFICATION          <<03550>>40728000
CODE OF THE DEVICE ON THE GIVEN DRT.  IT WORKS ALSO            <<03550>>40730000
FOR HPIB DEVICES CONNECTED TO STARFISH ON THE                  <<03550>>40732000
SERIES II/III.  IF NO DEVICE EXISTS ON THE GIVEN DRT           <<03550>>40734000
OR IF THE DEVICE IS NOT AN HPIB DEVICE THE PROCEDURE           <<03550>>40736000
RETURNS 0.  NOTE:  THE DRT MUST BE INITIALIZED BEFORE          <<03550>>40738000
CALLING THIS PROCEDURE ( I.E., CPVA POINTER SET).              <<03550>>40740000
;                                                              <<03550>>40742000
BEGIN                                                          <<03550>>40744000
DEFINE ERRCODE = (0:3)#;                                       <<03550>>40746000
EQUATE IDENTCODE = 1,    << INDEX TO ID RETURN WORD >>         <<03550>>40748000
       IDENTSIZE = 4;    << CHANNEL PROGRAM SIZE    >>         <<03550>>40750000
ARRAY IDENTPGM(0:IDENTSIZE-1)=PB := << CHANNEL PROGRAM >>      <<03550>>40752000
      %3000,      << DEVICE IDENTIFY >>                        <<03550>>40754000
          0,      << ID RETURN BYTES >>                        <<03550>>40756000
                                                               <<03550>>40758000
       %600,      << INTERRUPT/HALT  >>                        <<03550>>40760000
          0;                                                   <<03550>>40762000
ARRAY BUF(0:IDENTSIZE-1);  << TO BUILD CHAN. PROG. >>          <<03550>>40764000
INTEGER SBANK,             << BANK OF 'BUF' >>                 <<03550>>40766000
        SADDRESS,          << ADDRESS OF 'BUF' >>              <<03550>>40768000
        CPADR;             << ABS. ADDR. OF CHAN PROG >>       <<03550>>40770000
                                                               <<03550>>40772000
<< GET ADDRESS OF CHANNEL PROGRAM AREA >>                      <<03550>>40774000
CPADR := ABS( CHANPROG);                                       <<03550>>40776000
<< MOVE CHANNEL PROGRAM INTO LOCAL BUFFER >>                   <<03550>>40778000
MOVE BUF := IDENTPGM,(IDENTSIZE);                              <<03550>>40780000
<< COMPUTE ABSOLUTE ADDRESS OF 'BUF' >>                        <<03550>>40782000
PUSH(DB);                                                      <<03550>>40784000
SADDRESS := TOS + @BUF;                                        <<03550>>40786000
SBANK := TOS;                                                  <<03550>>40788000
                                                               <<03550>>40790000
IF SERIESII'III THEN     << ON SERIES II/III  >>               <<03550>>40792000
   IF STARFISH THEN      << SYSTEM HAS A STARFISH >>           <<03550>>40794000
     BEGIN                                                     <<03550>>40796000
     TOS := DRT;       << IF TIO 0 RETURNS CCE, A      >>      <<03550>>40798000
     ASSEMBLE( TIO 0); << SERIES II/III DEVICE IS ON   >>      <<03550>>40800000
     IF = THEN GO NO'DEVICE'EXIT; << THAT DRT, SO QUIT >>      <<03550>>40802000
     END                                                       <<03550>>40804000
   ELSE      << NO STARFISH ON THIS SYSTEM >>                  <<03550>>40806000
     GO NO'DEVICE'EXIT;   << RETURN NO DEVICE >>               <<03550>>40808000
                                                               <<03550>>40810000
<< MOVE CHANNEL PROGRAM TO BANK 0 >>                           <<03550>>40812000
MABS(0,CPADR,SBANK,SADDRESS,IDENTSIZE);                        <<03550>>40814000
ZEROABS(GETDRT(DRT,DBI),7);   <<CLEAR THE CPVA AREA>>          <<03550>>40816000
INIT( DRT);        << INITIALIZE THE CHANNEL >>                <<03550>>40818000
IF <> THEN GO NO'DEVICE'EXIT;                                  <<03550>>40820000
SIOP( DRT, CPADR); << START THE CHANNEL PROGRAM >>             <<03550>>40822000
IF <> THEN GO NO'DEVICE'EXIT;                                  <<03550>>40824000
                                                               <<03550>>40826000
<< WAIT FOR CHANNEL PROGRAM COMPLETION >>                      <<03550>>40828000
WHILE GETDRT(DRT,CHANSTAT).(0:2) <> 0 DO;                      <<03550>>40830000
                                                               <<03550>>40832000
IF ABS(GETDRT(DRT,DBI)).ERRCODE = 4 THEN                       <<03550>>40834000
   << GOOD RETURN--A DEVICE RESPONDED >>                       <<03550>>40836000
   IDENTIFY := ABS( CPADR+IDENTCODE)                           <<03550>>40838000
ELSE                                                           <<03550>>40840000
                                                               <<03550>>40842000
NO'DEVICE'EXIT:  << NO RETURN--NO DEVICE ON DRT >>             <<03550>>40844000
                                                               <<03550>>40846000
   IDENTIFY := 0;                                              <<03550>>40848000
END;    << IDENTIFY >>                                         <<03550>>40850000
          <<-------------------------                                   40852000
            FORMAT CS DRIVER ENTRY                                      40854000
          ------------------------>>                                    40856000
  INTEGER PROCEDURE FORMATCSDVRENTRY(DVRBNAME);                <<*DVR*>>40858000
    BYTE ARRAY DVRBNAME;                                       <<*DVR*>>40860000
    <<FORMATS EACH DRIVER ENTRY IN THE CS DATA SEGMENT>>       <<00.06>>40862000
    <<PARAMETER PASSED:                               >>       <<00.06>>40864000
    <<     DVRBNAME   -   NAME OF DRIVER              >>       <<*DVR*>>40866000
    <<                                                >>       <<00.06>>40868000
    <<RETURN:                                         >>       <<00.06>>40870000
    <<     FORMATCSDVRENTRY - STT # OF DRIVER         >>       <<00.06>>40872000
    <<                        INITIALIZATION ROUTINE  >>       <<00.06>>40874000
      BEGIN                                                             40876000
        EQUATE CAPSECTSTDSIZE=12;                                       40878000
                                                                        40880000
        DEFINE                                                          40882000
           DRENTRYSIZE        = DRIVERENTRY        #,                   40884000
           DRSLCPLABEL        = DRIVERENTRY(6)     #,                   40886000
           DRPHYSDVRPLABEL    = DRIVERENTRY(7)     #,                   40888000
           DREDITORPLABEL     = DRIVERENTRY(8)     #,                   40890000
           DRIHPLABEL         = DRIVERENTRY(9)     #,                   40892000
           DRRETRIES'FLAGS    = DRIVERENTRY(11)    #;                   40894000
                                                                        40896000
        INTEGER DVRFNUM,                                                40898000
                CAPSECTSIZE,                                            40900000
                INDEX,                                                  40902000
                 L,                                                     40904000
                DVRENTSIZE,                                             40906000
                BINDEX:=0,                                              40908000
                DBRECX:=0;                                              40910000
        INTEGER ARRAY DBAREA(*)=LBUF(128),                              40912000
                      PBAREA(*)=LBUF(128);                              40914000
        BYTE ARRAY DBAREAB(*)=DBAREA;                                   40916000
        SUBROUTINE READDBREC(BYTEX);                                    40918000
        VALUE BYTEX;                                                    40920000
        LOGICAL BYTEX;                                                  40922000
          BEGIN                                                         40924000
  AGAIN:  IF BYTEX AND BINDEX>=DBRECX&LSL(8) OR NOT BYTEX AND INDEX>=   40926000
            DBRECX&LSL(7) THEN                                          40928000
            BEGIN  <<READ NEXT RECORD>>                                 40930000
              FREAD(DVRFNUM,DOUBLE(DBRECX+REC0(3)),DBAREA(DBRECX&LSL(7))40932000
                ,128);                                                  40934000
              DBRECX := DBRECX+1;                                       40936000
              GO AGAIN;                                                 40938000
            END;                                                        40940000
          END <<READDBREC>> ;                                           40942000
                                                                        40944000
          DVRFNUM := FOPEN(DVRBNAME);                          <<*DVR*>>40946000
          FREAD(DVRFNUM,0D,REC0,128);                                   40948000
          READDBREC(1);  <<READ FIRST DB AREA RECORD>>                  40950000
          BINDEX := CAPSECTSTDSIZE;                                     40952000
          BINDEX := INTEGER(DBAREAB(BINDEX))+X+1;  <<MODE SIZE>>        40954000
          READDBREC(1);                                                 40956000
          BINDEX := INTEGER(DBAREAB(BINDEX))+X+1;  <<PROTOCOL SIZE>>    40958000
          READDBREC(1);                                                 40960000
          BINDEX := INTEGER(DBAREAB(BINDEX))+X+1; <<TRANSCODE SIZE>>    40962000
          READDBREC(1);                                                 40964000
          INDEX := (BINDEX+1)&LSR(1);  <<SIZE IN WORDS>>                40966000
          CAPSECTSIZE := INDEX;                                         40968000
          INDEX := DBAREA(INDEX)+X+1;  <<LCM SIZE>>                     40970000
          READDBREC(0);                                                 40972000
          INDEX := DBAREA(INDEX)+X+1;  <<EDITOR SIZE>>                  40974000
          READDBREC(0);                                                 40976000
          INDEX := DBAREA(INDEX)+X+1;  <<PHYS DRIVER SIZE>>             40978000
          READDBREC(0);                                                 40980000
          INDEX := DBAREA(INDEX)+X+1; <<SIO PROGRAM SIZE>>              40982000
          READDBREC(0);                                                 40984000
          DVRENTSIZE := INDEX+DRINFOSIZE;  <<SIZE OF DRIVER ENTRY>>     40986000
          TOS := @CSDVRAREA-DVRENTSIZE;                                 40988000
          ASSEMBLE(DUP,DUP);                                            40990000
          SET(DL);  <<EXPAND DRIVER WORK AREA>>                         40992000
          CHECKMEM;                                                     40994000
          TOS := @CSDVRAREA;                                            40996000
          TOS := CSDVRAREASIZE;                                         40998000
          ASSEMBLE(MOVE 3);                                             41000000
          @CSDVRAREA := TOS;  <<NEW POINTER TO DRIVER WORK AREA>>       41002000
          @DRIVERENTRY := @CSDVRAREA(CSDVRAREASIZE);                    41004000
          CSDVRAREASIZE := X+DVRENTSIZE;                                41006000
        <<FORMAT DRIVER ENTRY>>                                         41008000
          DRENTRYSIZE := DVRENTSIZE;                                    41010000
          TOS := @DRNAME&LSL(1);                               <<04306>>41012000
          MOVE * := DVRBNAME,(8);                              <<*DVR*>>41014000
          DRCAPSECTSIZE := CAPSECTSIZE;  <<SIZE OF CAPABILITY SECTION>> 41016000
          MOVE DRRETRIES'FLAGS := DBAREA,(INDEX);                       41018000
          CSTAB(X) := CSTAB(DRIVERENTNUM)+1;                            41020000
          TOS := REC0(10);                                              41022000
          TOS := 128;                                                   41024000
          ASSEMBLE(DIV);                                                41026000
          INDEX := TOS;                                                 41028000
          L := TOS;                                                     41030000
          FREAD(DVRFNUM,DOUBLE(L+REC0(4)),PBAREA,256);                  41032000
          DRLCMPLABEL := PBAREA(INDEX).(8:8);                           41034000
          DRSLCPLABEL := PBAREA(INDEX+1).(8:8);                         41036000
          DRPHYSDVRPLABEL := PBAREA(INDEX+2).(8:8);                     41038000
          DREDITORPLABEL := PBAREA(INDEX+3).(8:8);                      41040000
          FORMATCSDVRENTRY := PBAREA(INDEX+4).(8:8);           <<00.06>>41042000
          DRIHPLABEL := PBAREA(INDEX+6).(8:8);                          41044000
          FCLOSE(DVRFNUM);                                              41046000
      END <<FORMATCSDVRENTRY>> ;                                        41048000
$CONTROL SEGMENT=CONFIGURE                                              41050000
                                                               <<d9067>>41052000
                                                               <<d9067>>41054000
logical procedure rs232'printer(type, subtyp);                <<driv2>> 41056000
    value type, subtyp;                                       <<driv2>> 41058000
    integer type, subtyp;                                     <<driv2>> 41060000
                                                               <<d9067>>41062000
    begin                                                      <<d9067>>41064000
                                                               <<d9067>>41066000
    if type = 32 and                                           <<d9067>>41068000
       (subtyp = 14 or subtyp = 15)                          <<driv2>>  41070000
       then rs232'printer := true                              <<d9067>>41072000
    else rs232'printer := false;                               <<d9067>>41074000
                                                               <<d9067>>41076000
    end; << rs232'printer >>                                   <<d9067>>41078000
                                                               <<d9067>>41080000
          <<-----------------                                           41082000
            GET CLASS INDEX                                             41084000
          ----------------->>                                           41086000
  INTEGER PROCEDURE CLINDEX(CLNAME);                           <<dctab>>41088000
    BYTE ARRAY CLNAME;                                         <<dctab>>41090000
    OPTION PRIVILEGED,UNCALLABLE;                              <<dctab>>41092000
      BEGIN                                                    <<dctab>>41094000
        INTEGER POINTER                                        <<dctab>>41096000
            DCT;                                               <<dctab>>41098000
        BYTE POINTER                                           <<dctab>>41100000
            DCT'B;                                             <<dctab>>41102000
        INTEGER I:=0;                                          <<dctab>>41104000
        @DCT := @DCT'HEAD + DCTH'DCT'BASE;                     <<dctab>>41106000
        @DCT'B := @DCT & LSL(1);                               <<dctab>>41108000
          WHILE (I:=I+1) <= DCTH'NUM'DCT'ENTRIES DO            <<dctab>>41110000
          IF DCTB'CLASS'NAME = CLNAME,(8) THEN                 <<dctab>>41112000
            BEGIN   <<FOUND IT>>                               <<dctab>>41114000
              CLINDEX := I;                                    <<dctab>>41116000
              RETURN;                                          <<dctab>>41118000
            END                                                <<dctab>>41120000
          ELSE                                                 <<dctab>>41122000
            BEGIN   <<BUMP INDEX>>                             <<dctab>>41124000
              @DCT := @DCT + DCT'NEXT'ENTRY;                   <<dctab>>41126000
              @DCT'B := @DCT & LSL(1);                         <<dctab>>41128000
            END;                                               <<dctab>>41130000
      END <<CLINDEX>> ;                                        <<dctab>>41132000
  logical procedure name'found(dev'name);                      <<t8392>>41134000
  byte array dev'name;                                         <<t8392>>41136000
  begin                                                        <<t8392>>41138000
     logical found = name'found;                               <<t8392>>41140000
     integer                                                   <<t8392>>41142000
             i;                                                <<t8392>>41144000
                                                               <<t8392>>41146000
     @tl'ent := @tl'buf;                                       <<t8392>>41148000
     @tl'entb := @tl'ent & lsl(1);                             <<t8392>>41150000
     found := false;                                           <<t8392>>41152000
     i := 0;                                                   <<t8392>>41154000
     while (i := i + 1) <= tlnumentries and not found do       <<t8392>>41156000
        if tl'dev'name = dev'name,(16)                         <<t8392>>41158000
           then found := true                                  <<t8392>>41160000
        else                                                   <<t8392>>41162000
           begin                                               <<t8392>>41164000
           @tl'ent := @tl'ent + tl'ent'size;                   <<t8392>>41166000
           @tl'entb := @tl'ent &lsl(1);                        <<t8392>>41168000
           end;                                                <<t8392>>41170000
  end;                                                         <<t8392>>41172000
                                                                        41174000
$CONTROL SEGMENT=MAINSEG1                                               41176000
          <<------------------                                          41178000
            GET PHONE NUMBER                                            41180000
          ------------------>>                                          41182000
  INTEGER PROCEDURE GETPHNB(ERRLABEL,ADDR,SPEC);                        41184000
    VALUE ERRLABEL,SPEC;                                                41186000
    INTEGER ERRLABEL,SPEC;                                              41188000
    BYTE ARRAY ADDR;                                                    41190000
      BEGIN                                                             41192000
        EQUATE BLANK=%6440;                                             41194000
        EQUATE SPACE=%40;                                      <<04256>>41196000
        EQUATE DELETE=%177;                                    <<04256>>41198000
        INTEGER CONCODE:=CCG;                                           41200000
          TOS := @ADDR;                                                 41202000
          SCAN BPINBUF WHILE BLANK,1;                                   41204000
          IF CARRY THEN CONCODE:=CCE;                                   41206000
          ASSEMBLE(DUP,DDUP);                                           41208000
  MOVEUPS:MOVE *:=* WHILE ANS,0;  <<UPSHIFT LOWER CASE>>       <<04256>>41210000
          IF INTEGER(BPS0) >= SPACE AND INTEGER(BPS0) < DELETE <<04256>>41212000
            THEN                                               <<04256>>41214000
            BEGIN                                                       41216000
            ASSEMBLE(INCA,INCB);                                        41218000
            GO MOVEUPS;                                                 41220000
            END;                                                        41222000
          SCAN * WHILE BLANK;                                           41224000
          IF NOCARRY  THEN                                              41226000
  ERROR:    BEGIN                                                       41228000
            MESSAGE(M2453);                                    <<01103>>41230000
            RETURNP:=ERRLABEL;                                          41232000
            ASSEMBLE(EXIT 4);                                           41234000
            END;                                                        41236000
          ASSEMBLE(XCH,SUB);  <<CALCULATE LENGTH>>                      41238000
          IF S0>30 THEN GO ERROR;                              <<04256>>41240000
          GETPHNB := S0;                                                41242000
          ASSEMBLE(MVB 3);                                              41244000
          STAT.(6:2):=CONCODE;                                          41246000
      END  <<GETPHNB>>;                                                 41248000
                                                                        41250000
          <<----------------------------                                41252000
            LIST ADDIIIONAL CS DRIVERS                                  41254000
          ---------------------------->>                                41256000
                                                                        41258000
  PROCEDURE LISTDVRS;                                                   41260000
    BEGIN                                                               41262000
        ARRAY HED(0:10)=PB:="ADDITIONAL CS DRIVERS";                    41264000
        INTEGER I:=-1,J:=0,K,L;                                         41266000
          MOVE LINE(12) := HED,(11);                           <<00888>>41268000
          PRINTLINE;                                           <<00888>>41270000
                                                                        41272000
          L := COMM(NUMADVRS);                                 <<CONFD>>41274000
          WHILE I<L DO                                                  41276000
            BEGIN                                                       41278000
            K:=-1;                                                      41280000
            WHILE (K:=K+1)<=5 AND (I:=I+1)<L DO                         41282000
              MOVE LINE(K*6):=CSDVR(I*4),(4);                  <<00888>>41284000
            PRINTLINE;                                         <<00888>>41286000
            END;                                                        41288000
    END  <<LISTDVRS>>;                                                  41290000
                                                                        41292000
$CONTROL SEGMENT=CONFIGURE                                              41294000
          <<----------------                                            41296000
            GET CLASS NAME                                              41298000
          ---------------->>                                            41300000
  PROCEDURE CLNAME(CLINDEX,NAME);                              <<dctab>>41302000
    VALUE CLINDEX;                                             <<dctab>>41304000
    INTEGER CLINDEX;                                           <<dctab>>41306000
    BYTE ARRAY NAME;                                           <<dctab>>41308000
    OPTION PRIVILEGED,UNCALLABLE;                              <<dctab>>41310000
      BEGIN                                                    <<dctab>>41312000
        INTEGER POINTER                                        <<dctab>>41314000
            DCT;                                               <<dctab>>41316000
        BYTE POINTER                                           <<dctab>>41318000
            DCT'B;                                             <<dctab>>41320000
        INTEGER I:=0;                                          <<dctab>>41322000
          @DCT := @DCT'HEAD + DCTH'DCT'BASE;                   <<dctab>>41324000
          WHILE (I:=I+1) < CLINDEX DO                          <<dctab>>41326000
            @DCT := @DCT + DCT'NEXT'ENTRY;                     <<dctab>>41328000
          @DCT'B := @DCT & LSL(1);                             <<dctab>>41330000
          MOVE NAME := DCTB'CLASS'NAME,(8);                    <<dctab>>41332000
      END <<CLNAME>> ;                                         <<dctab>>41334000
                                                               <<03004>>41336000
$CONTROL SEGMENT=SETUP                                         <<03004>>41338000
          <<------------------------------------>>             <<03004>>41340000
          <<  COUNT NO. OF TERMINALS CONFIGURED >>             <<03004>>41342000
          <<------------------------------------>>             <<03004>>41344000
  INTEGER PROCEDURE TERMCOUNT( NONLYNX);                       <<03004>>41346000
  COMMENT                                                      <<03004>>41348000
     TERMCOUNT RETURNS THE NO. OF LOGICAL DEVICES CONFIGURED   <<03004>>41350000
     WHICH ARE TERMINALS.  IF THE PARAMETER NONLYNX IS         <<03004>>41352000
     TRUE, THEN IT COUNTS ADCC- OR ATC-CONNECTED TERMINALS     <<03004>>41354000
     ONLY;                                                     <<03004>>41356000
  VALUE NONLYNX;                                               <<03004>>41358000
  LOGICAL NONLYNX;    << TRUE IF COUNT OF ADCC- OR ATC-    >>  <<03004>>41360000
                      << CONNECTED TERMINALS ONLY IS       >>  <<03004>>41362000
                      << REQUESTED.                        >>  <<03004>>41364000
     BEGIN                                                     <<03004>>41366000
     INTEGER LDEV,    << CURRENT LDEV  >>                      <<03004>>41368000
             COUNT,   << CURRENT COUNT >>                      <<03004>>41370000
             SUBTYP,  << DEVICE SUBTYPE>>                      <<03004>>41372000
             DEVTYP,  << DEVICE TYPE   >>                      <<*LDT*>>41374000
             LDT'INDEX,                                        <<*DVR*>>41376000
             LPDT'INDEX,                                       <<*LDTX>>41378000
             LDTX'INDEX,                                       <<*DVR*>>41380000
             DVR'INDEX;                                        <<*DVR*>>41382000
     COUNT := 0;                                               <<03004>>41384000
     LDEV := 1;                                                <<03004>>41386000
     DO              << CHECK ALL LDEV'S >>                    <<03004>>41388000
        BEGIN                                                  <<03004>>41390000
        LDT'INDEX := LDEV * LDTSIZE;                           <<*LDT*>>41392000
        LPDT'INDEX := LDEV * LPDTSIZE;                         <<*LPDT>>41394000
               LDTX'INDEX := LDEV * LDTXSIZE;                  <<*LDTX>>41396000
        DVR'INDEX := LDEV * DVRSIZE;                           <<*DVR*>>41398000
                                           <<DVR. TAB. ENTRY>> <<03004>>41400000
        DEVTYP  := LDT'DEVICE'TYPE;                            <<*LDT*>>41402000
        SUBTYP  := LPDT'SUBTYPE;                               <<*LPDT>>41404000
                                                               <<03004>>41406000
        << CONSIDER ONLY TERMINAL DEVICES >>                   <<03004>>41408000
        IF DEVTYP = 16 << TERMINAL >> OR                       <<*LDT*>>41410000
           DEVTYP = 32 << PRINTER >> AND                       <<*LDT*>>41412000
          (SUBTYP=14 OR SUBTYP=15) THEN                        <<03004>>41414000
                                                               <<03004>>41416000
           << COUNT AS A TERMINAL ONLY IF NOT A DS DEVICE  >>  <<03004>>41418000
           << AND THE DRT IS NON-ZERO (DEVICE EXISTS)      >>  <<03004>>41420000
           IF DVRDSBIT = 0 AND DVRDRTNUM <> 0 THEN             <<*DVR*>>41422000
               BEGIN                                           <<03004>>41424000
               COUNT := COUNT + 1;    << BUMP COUNTER >>       <<03004>>41426000
               <<IF REQUESTED, DO NOT COUNT LYNX TERMINALS>>   <<03004>>41428000
               IF NONLYNX THEN                                 <<03004>>41430000
                  IF ((LDTX'TERMID = LYNX'BOARD) OR            <<08392>>41432000
                  (LDTX'TERMID = TIC'BOARD)) THEN              <<08392>>41434000
                     COUNT := COUNT - 1;                       <<03004>>41436000
               END;                                            <<03004>>41438000
        LDEV := LDEV + 1;                                      <<03004>>41440000
        END                                                    <<03004>>41442000
     UNTIL LDEV > HLDEV;  << DO UNTIL CHECKED ALL LDEV'S >>    <<03004>>41444000
     TERMCOUNT := COUNT;  << RETURN TOTAL >>                   <<03004>>41446000
     END;   << TERMCOUNT >>                                    <<03004>>41448000
$CONTROL SEGMENT=SETUP                                         <<03708>>41450000
          <<------------------------------->>                  <<03708>>41452000
          <<  CHECK INPUT TERMINAL SPEED   >>                  <<03708>>41454000
          <<------------------------------->>                  <<03708>>41456000
LOGICAL PROCEDURE CHECKSPEED( TSPEED, SPEEDCDE );              <<03708>>41458000
INTEGER                                                        <<03708>>41460000
   TSPEED,       << SPEED (CHARS/SEC), PASSED OR RETURNED >>   <<03708>>41462000
   SPEEDCDE;     << BAUDRATE CODE, PASSED OR RETURNED >>       <<03708>>41464000
COMMENT                                                        <<03708>>41466000
THIS PROCEDURE CONVERTS THE TERMINAL SPEED (CHARS/SEC)         <<03708>>41468000
TO ITS INTERNAL BAUD RATE CODE AND VICE-VERSA.                 <<03708>>41470000
IF 'TSPEED' IS NEGATIVE, WE CONVERT 'SPEEDCDE' TO              <<03708>>41472000
CHARS/SEC, RETURNING THE RESULT IN 'TSPEED'.  IF               <<03708>>41474000
'TSPEED' IS POSITIVE, WE CONVERT IT TO THE BAUDRATE            <<03708>>41476000
CODE, RETURNING THE RESULT IN 'SPEEDCDE'.  IN EITHER           <<03708>>41478000
CASE, THE PROCEDURE RETURNS TRUE IF THE CONVERSION WAS         <<03708>>41480000
VALID, FALSE OTHERWISE.                                        <<03708>>41482000
;                                                              <<03708>>41484000
BEGIN                                                          <<03708>>41486000
EQUATE                                                         <<03708>>41488000
   UNUSED  = 32000;    << INDICATES UNUSED SPEED CODE >>       <<03708>>41490000
EQUATE                                                         <<03708>>41492000
   START'III = 0,    << STARTING ARRAY INDEX >>                <<03708>>41494000
   HIGH'III  = 7;    << ENDING ARRAY INDEX   >>                <<03708>>41496000
INTEGER ARRAY                        << ALLOWED SPEEDS FOR >>  <<03708>>41498000
   SPEEDS'III(START'III:HIGH'III) = PB :=                      <<03708>>41500000
   0,240,120,60,30,15,10,14;         << ATC IN CHARS/SEC   >>  <<03708>>41502000
EQUATE                                                         <<03708>>41504000
   START'33 = 6,    << STARTING ARRAY INDEX >>                 <<03708>>41506000
   HIGH'33  = 18;   << ENDING ARRAY INDEX FOR ATP >>           <<03708>>41508000
INTEGER ARRAY                       << ALLOWED SPEEDS FOR  >>  <<03708>>41510000
   SPEEDS'33(START'33:HIGH'33) = PB :=                         <<03708>>41512000
   60,240,960,480,UNUSED,120,       << ADCC, ATP.   (CODES >>  <<03708>>41514000
   UNUSED,30,15,10,1920,3840,180;   << 10,12 ARE NOT USED) >>  <<03708>>41516000
INTEGER                                                        <<03708>>41518000
   I,             << INDEX VAR. >>                             <<03708>>41520000
   STARTSPEED,    << INDEX OF FIRST SPEED >>                   <<03708>>41522000
   HIGHSPEED;     << INDEX OF LAST SPEED  >>                   <<03708>>41524000
INTEGER ARRAY                                                  <<03708>>41526000
   SPEEDS(0:HIGH'33);     << LOCAL ARRAY FOR SPEEDS >>         <<03708>>41528000
                                                               <<03708>>41530000
CHECKSPEED := FALSE;                                           <<03708>>41532000
                                                               <<03708>>41534000
IF SERIESII'III THEN                                           <<03708>>41536000
   BEGIN              << SET UP PARAMETERS FOR ATC SPEEDS >>   <<03708>>41538000
   STARTSPEED := START'III;                                    <<03708>>41540000
   HIGHSPEED := HIGH'III;                                      <<03708>>41542000
   MOVE SPEEDS(START'III) :=                                   <<03708>>41544000
        SPEEDS'III(START'III),(HIGH'III - START'III + 1);      <<03708>>41546000
   END                                                         <<03708>>41548000
                                                               <<03708>>41550000
ELSE                                                           <<03708>>41552000
   BEGIN         << SET UP PARAMETERS FOR ADCC, ATP SPEEDS >>  <<03708>>41554000
   STARTSPEED := START'33;                                     <<03708>>41556000
   HIGHSPEED := HIGH'33;                                       <<03708>>41558000
   MOVE SPEEDS(START'33) :=                                    <<03708>>41560000
        SPEEDS'33(START'33),(HIGH'33 - START'33 + 1);          <<03708>>41562000
   END;                                                        <<03708>>41564000
                                                               <<03708>>41566000
IF TSPEED < 0 THEN                                             <<03708>>41568000
   BEGIN   << CONVERT FROM BAUDRATE CODE TO CHARS/SEC >>       <<03708>>41570000
   IF STARTSPEED <= SPEEDCDE <= HIGHSPEED THEN                 <<03708>>41572000
      BEGIN                                                    <<03708>>41574000
      TSPEED := SPEEDS(SPEEDCDE);                              <<03708>>41576000
      IF TSPEED < UNUSED THEN                                  <<03708>>41578000
         CHECKSPEED := TRUE;                                   <<03708>>41580000
      END;                                                     <<03708>>41582000
   END                                                         <<03708>>41584000
                                                               <<03708>>41586000
ELSE                                                           <<03708>>41588000
   BEGIN   << CONVERT FROM CHARS/SEC TO BAUDRATE CODE >>       <<03708>>41590000
   I := STARTSPEED - 1;                                        <<03708>>41592000
   WHILE (I:=I+1) <= HIGHSPEED DO    << COMPARE AGAINST >>     <<03708>>41594000
      IF SPEEDS(I) = TSPEED THEN     <<    ALL SPEEDS   >>     <<03708>>41596000
         BEGIN      << VALID SPEED >>                          <<03708>>41598000
         SPEEDCDE  := I;                                       <<03708>>41600000
         CHECKSPEED := TRUE;                                   <<03708>>41602000
         END;                                                  <<03708>>41604000
   END;                                                        <<03708>>41606000
END;   << CHECKSPEED >>                                        <<03708>>41608000
$CONTROL SEGMENT=MAINSEG1                                               41610000
          <<--------------------------------                            41612000
            GET ID AND COMPONENT SEQUENCES                              41614000
          -------------------------------->>                            41616000
                                                                        41618000
  INTEGER PROCEDURE GETSEQ(ERRLABEL,ADDR);                              41620000
    VALUE ERRLABEL;                                                     41622000
    INTEGER ERRLABEL;                                                   41624000
    BYTE ARRAY ADDR;                                                    41626000
      <<GETSEQ                                               >>         41628000
      <<                                                     >>         41630000
      BEGIN                                                             41632000
        INTEGER TYPE,LEN,I,J,INDEX;                                     41634000
        LOGICAL TEMP,FINISHED;                                          41636000
        EQUATE QUOT=%42,<<">>                                           41638000
               CR  =%15,<<CARRIAGE RETURN>>                             41640000
               MAXSEQLEN=16,<<MAX LENGTH IN BYTES>>                     41642000
               ATYP=0,  <<INPUT TYPE ASCII >>                           41644000
               ETYP=1,  <<INPUT TYPE EBCDIC>>                           41646000
               OTYP=2,  <<INPUT TYPE OCTAL >>                           41648000
               HTYP=3;  <<INPUT TYPE HEX   >>                           41650000
        BYTE POINTER PNTR;                                              41652000
          SCAN BPINBUF WHILE BLANK,1;                                   41654000
          IF CARRY THEN RETURN; <<NO INPUT>>                            41656000
          IF BPS0="A" OR BPS0=QUOT THEN TYPE:=ATYP                      41658000
          ELSE IF BPS0="E" THEN TYPE:=ETYP                              41660000
               ELSE IF BPS0="O" THEN TYPE:=OTYP                         41662000
                    ELSE IF BPS0="H" THEN TYPE:=HTYP                    41664000
                         ELSE BEGIN                                     41666000
  ERROR:                      MESSAGE(M2453);                  <<01103>>41668000
                              RETURNP := ERRLABEL;                      41670000
                              ASSEMBLE(EXIT 3);                         41672000
                              END;                                      41674000
          IF TYPE=ATYP OR TYPE=ETYP THEN                                41676000
            BEGIN  <<STRING ASCII OR EBCDIC>>                           41678000
            IF BPS0="A" OR BPS0="E" THEN TOS:=TOS+1;                    41680000
            IF BPS0<>QUOT THEN GOTO ERROR;                              41682000
            @PNTR := TOS+1;  <<POINT TO FIRST CHARACTER>>               41684000
            LEN := -1;  <<INDEX TO ADR(ALSO COUNTER>>                   41686000
  GETCHAR:  FINISHED := FALSE;                                          41688000
            WHILE NOT FINISHED DO                                       41690000
              BEGIN <<GET A CHARACTER>>                                 41692000
              IF PNTR=CR THEN GOTO ERROR;                               41694000
              IF PNTR=QUOT THEN FINISHED:=TRUE;                         41696000
              LEN := LEN+1;                                             41698000
              ADDR(LEN) := PNTR;                                        41700000
              @PNTR := @PNTR+1;                                         41702000
              END;                                                      41704000
            IF LEN>MAXSEQLEN THEN GOTO ERROR;                           41706000
            IF PNTR=QUOT THEN                                           41708000
              BEGIN <<DOUBLE QUOTES>>                                   41710000
              @PNTR := @PNTR+1; <<A QUOT IS IN SEQUENCE>>               41712000
              GOTO GETCHAR;                                             41714000
              END;                                                      41716000
            SCAN PNTR WHILE BLANK;                                      41718000
            IF NOCARRY THEN GOTO ERROR;                                 41720000
            I := -1;                                                    41722000
            WHILE(I:=I+1)<LEN DO                                        41724000
              IF NOT(%40<=INTEGER(ADDR(I))<=%176) THEN                  41726000
                  TYPE := OTYP;                                         41728000
            IF TYPE=ETYP THEN CONVERT(1,ADDR,ADDR,LEN);                 41730000
            END                                                         41732000
          ELSE                                                          41734000
            BEGIN  <<OCTAL OR HEX>>                                     41736000
            FINISHED := FALSE;                                          41738000
            TOS := TOS+1;                                               41740000
            IF BPS0<>"(" THEN GOTO ERROR;                               41742000
            TOS := TOS+1;                                               41744000
            LEN := 0;                                                   41746000
  NEXTNUM:  SCAN * WHILE BLANK,1;<<FIND FIRST DIGIT>>                   41748000
            IF CARRY THEN GOTO ERROR;                                   41750000
            IF BPS0=SPECIAL THEN GOTO ERROR;                            41752000
            ASSEMBLE(DUP,DDUP);                                         41754000
            MOVE *:=* WHILE AN,0;                                       41756000
            SCAN * WHILE BLANK,1;                                       41758000
            IF BPS0<>"," THEN FINISHED:=TRUE;                           41760000
            TEMP := TOS+1;                                              41762000
            ASSEMBLE(XCH,SUB);<<COMPUTE LENGTH>>                        41764000
            IF TYPE=OTYP AND S0>3 OR TYPE=HTYP AND S0>2                 41766000
               THEN GOTO ERROR; <<TOO MANY DIGITS>>                     41768000
            J := TOS;   <<# OF DIGITS>>                                 41770000
            @PNTR := TOS;<<START FIRST DIGIT IN THIS NUM>>              41772000
            IF TYPE=OTYP THEN                                           41774000
              BEGIN <<OCTAL>>                                           41776000
              I := -1;                                                  41778000
              WHILE(I:=I+1)<J DO                                        41780000
                IF PNTR(I)>%67 THEN GOTO ERROR;<<NOT OCTAL>>            41782000
              ADDR(LEN) := BINARY(PNTR,J);                              41784000
              END                                                       41786000
            ELSE                                                        41788000
              BEGIN <<HEX>>                                             41790000
              I := J;                                                   41792000
              WHILE(I:=I-1)>=0 DO                                       41794000
                BEGIN                                                   41796000
                X := PNTR(I);                                           41798000
                IF ("0"<=X<="9") THEN TOS:=X-%60                        41800000
                ELSE IF ("A"<=X<="F") THEN TOS:=X-%67                   41802000
                     ELSE GOTO ERROR;                                   41804000
                END;                                                    41806000
              IF J=2 THEN                                               41808000
                BEGIN <<TWO DIGITS IN THIS NUMBER>>                     41810000
                TOS := TOS*%20;                                         41812000
                TOS := TOS+TOS; <<ADD TOP TWO WORDS>>                   41814000
                END;                                                    41816000
              ADDR(LEN):=TOS;                                           41818000
              END;                                                      41820000
            LEN := LEN+1;                                               41822000
            IF NOT FINISHED THEN                                        41824000
              BEGIN                                                     41826000
              TOS := TEMP;                                              41828000
              GOTO NEXTNUM;                                             41830000
              END;                                                      41832000
            IF LEN>MAXSEQLEN THEN GOTO ERROR;                           41834000
            TOS := TEMP-1;                                              41836000
            IF BPS0<>")" THEN GOTO ERROR;                               41838000
            TOS := TOS+1;                                               41840000
            SCAN * WHILE BLANK;                                         41842000
            IF NOCARRY THEN GOTO ERROR;                                 41844000
            END;                                                        41846000
        GETSEQ := TYPE&LSL(6)+LEN;                                      41848000
        END <<GETSEQ>>;                                                 41850000
                                                                        41852000
$CONTROL SEGMENT=CONFIGURE                                              41854000
              <<--------------------------                              41856000
                   LIST DEFAULTS                                        41858000
              --------------------------->>                             41860000
                                                                        41862000
procedure list'defaults;                                       <<t8392>>41864000
   option privileged,uncallable;                               <<t8392>>41866000
   comment                                                     <<t8392>>41868000
      prints a listing of the default devices supported on the <<t8392>>41870000
      device;                                                  <<t8392>>41872000
   begin                                                       <<t8392>>41874000
   integer array head1(0:39)=pb:=                              <<t8392>>41876000
     "DEVICE          ID    C T  SUB          REC OUTPUT   ",  <<s8967>>41878000
     "       DRIVER   DEVICE    ";                             <<t8392>>41880000
   integer array head2(0:39)=pb:=                              <<t8392>>41882000
     "NAME           CODE   H Y  TYPE        WIDTH DEV      ", <<t8392>>41884000
     "MODE     NAME    CLASSES   ";                            <<s8967>>41886000
   integer array head3(0:8)=pb:=                               <<t8392>>41888000
       "A P      TERMINAL ";                                   <<t8392>>41890000
   integer array head4(0:8)=pb:=                               <<t8392>>41892000
       "N E     TYPE SPEED";                                   <<t8392>>41894000
   integer                                                     <<t8392>>41896000
       i,                                                      <<t8392>>41898000
       j,                                                      <<t8392>>41900000
       speedcde,                                               <<t8392>>41902000
       tspeed;                                                 <<t8392>>41904000
   logical                                                     <<t8392>>41906000
       firstclass;                                             <<t8392>>41908000
   double                                                      <<D8822>>41910000
       dblptr;                                                 <<D8822>>41912000
   integer                                                     <<t8392>>41914000
       name'ptr;                                               <<t8392>>41916000
   move inbuf := head1,(40);                                   <<t8392>>41918000
   print(inbuf,-78,0);                                         <<t8392>>41920000
   move inbuf := head2,(40);                                   <<t8392>>41922000
   print(inbuf,-78,0);                                         <<t8392>>41924000
   fill'(binbuf,80," ");                                       <<t8392>>41926000
   move inbuf(11) := head3,(9);                                <<t8392>>41928000
   print(inbuf,-78,0);                                         <<t8392>>41930000
   fill'(binbuf,80," ");                                       <<t8392>>41932000
   move inbuf(11) := head4,(9);                                <<t8392>>41934000
   print(inbuf,-78,0);                                         <<t8392>>41936000
   @tl'ent := @tl'buf ;                                        <<t8392>>41938000
   @tl'entb := @tl'ent & lsl(1);                               <<t8392>>41940000
   j := 0;                                                     <<t8392>>41942000
   while (j := j + 1) <= tlnumentries do                       <<t8392>>41944000
      begin                                                    <<t8392>>41946000
      fill'(binbuf,80," ");                                    <<t8392>>41948000
      move binbuf := tl'dev'name,(12);                         <<D8822>>41950000
      tos := 0; tos := tl'id'code; dblptr := ds0;              <<D8822>>41952000
      move binbuf(14) := "!";                                  <<D8822>>41954000
      hexout(dblptr,binbuf(15), 4);                            <<D8822>>41956000
      ascii(tl'chan'num,10,binbuf(22));<<channel#>>            <<t8392>>41958000
      ascii(tl'dev'type,10,binbuf(24));<<type>>                <<t8392>>41960000
      ascii(tl'dev'subtype,10,binbuf(27));<<subtype>>          <<t8392>>41962000
      i := tl'dev'subtype;  <<dev. subtype>>                   <<t8392>>41964000
      if tl'dev'type = 16 or                                   <<t8392>>41966000
         tl'dev'type = 32 and                                  <<t8392>>41968000
         ( i=14 or i=15) then                                  <<t8392>>41970000
         begin <<terminal>>                                    <<t8392>>41972000
         if tl'term'type=%37 then                              <<t8392>>41974000
            move binbuf(32) := "??"                            <<t8392>>41976000
         else ascii(tl'term'type,10,binbuf(32));               <<t8392>>41978000
         if tl'ttdf'ptr <>  0 then                             <<t8392>>41980000
            binbuf(34) := "*";   <<there is a ttdf ref>>       <<t8392>>41982000
          speedcde := tl'term'speed;                           <<t8392>>41984000
          tspeed := -1;                                        <<t8392>>41986000
          checkspeed(tspeed,speedcde);                         <<t8392>>41988000
          if speedcde = 0 then                                 <<t8392>>41990000
             move binbuf(36) := "??"                           <<t8392>>41992000
          else ascii(tspeed,10,binbuf(36));                    <<T8766>>41994000
         end;                                                  <<t8392>>41996000
      ascii(tl'rec'width,10,binbuf(40));                       <<t8392>>41998000
      if logical(tl'def'out'class) then                        <<t8392>>42000000
         begin    <<output device is class index>>             <<t8392>>42002000
         name'ptr := tl'def'out'dev & lsl(1);                  <<t8392>>42004000
         move binbuf(44) := tl'entb(name'ptr),(8);             <<t8392>>42006000
         end                                                   <<t8392>>42008000
      else if tl'def'out'dev = -1                              <<t8392>>42010000
           then buf(46) := "&"                                 <<t8392>>42012000
      else ascii(tl'def'out'dev,10,binbuf(46));                <<t8392>>42014000
      if logical(tl'job'accept) then binbuf(53):="J";          <<s8967>>42016000
              <<accept jobs/sessions>>                         <<t8392>>42018000
      if logical(tl'data'accept) then binbuf(54):="A";         <<s8967>>42020000
               <<accept data>>                                 <<t8392>>42022000
      if logical(tl'interactive) then binbuf(55):="I";         <<s8967>>42024000
                  <<interactive>>                              <<t8392>>42026000
      if logical(tl'duplicative) then binbuf(56):="D";         <<s8967>>42028000
                  <<duplicative>>                              <<t8392>>42030000
      if tl'spool'state<>0 then binbuf(57) := "S";             <<s8967>>42032000
      if logical(tl'auto'reply) then binbuf(58) := "R";        <<s8967>>42034000
      if logical(tl'core'res) then binbuf(60):="*";            <<t8392>>42036000
                  <<core resident driver>>                     <<t8392>>42038000
      move binbuf(61) := tl'driver'name,(8); <<driver name>>   <<t8392>>42040000
      firstclass := true;                                      <<t8392>>42042000
      name'ptr := tl'dev'class'ptr & lsl(1);                   <<t8392>>42044000
      i := 0;                                                  <<t8392>>42046000
      while (i:=i+1) <= tl'num'dev'class do                    <<t8392>>42048000
         begin                                                 <<t8392>>42050000
         if firstclass then firstclass := false                <<t8392>>42052000
         else                                                  <<t8392>>42054000
            begin                                              <<t8392>>42056000
            print(inbuf,-78,0);                                <<t8392>>42058000
            fill'(binbuf,80," ");                              <<t8392>>42060000
            end;                                               <<t8392>>42062000
         move binbuf(70) := tl'entb(name'ptr),(8);             <<t8392>>42064000
                <<move device class to buffer>>                <<t8392>>42066000
         name'ptr := name'ptr + 8;                             <<t8392>>42068000
         end;                                                  <<t8392>>42070000
      print(inbuf,-78,0);                                      <<t8392>>42072000
      @tl'ent := @tl'ent + tl'ent'size;                        <<t8392>>42074000
      @tl'entb := @tl'ent & lsl(1);                            <<t8392>>42076000
   end;  << while >>                                           <<t8392>>42078000
   print(inbuf,0,%61);                                         <<t8392>>42080000
   end <<list'defaults>>;                                      <<t8392>>42082000
                                                               <<t8392>>42084000
           <<------------------                                         42086000
             LIST I/O DEVICES                                           42088000
           ------------------>>                                         42090000
  PROCEDURE LISTIODEV;                                         <<dctab>>42092000
    OPTION PRIVILEGED,UNCALLABLE;                              <<dctab>>42094000
    COMMENT                                                    <<dctab>>42096000
      PRINTS A LISTING OF THE I/O DEVICE CONFIGURATION ON THE  <<dctab>>42098000
    JOB LIST DEVICE;                                           <<dctab>>42100000
      BEGIN                                                    <<dctab>>42102000
        INTEGER                                                <<dctab>>42104000
            LDT'INDEX,                                         <<dctab>>42106000
            LPDT'INDEX,                                        <<dctab>>42108000
            LDTX'INDEX,                                        <<dctab>>42110000
            DVR'INDEX;                                         <<dctab>>42112000
        INTEGER POINTER                                        <<dctab>>42114000
            DCT;                                               <<dctab>>42116000
        BYTE POINTER                                           <<dctab>>42118000
            DCT'B;                                             <<dctab>>42120000
        INTEGER ARRAY HEAD1(0:34)=PB:=                         <<dctab>>42122000
         "LOG DRT U  C T SUB              REC   OUTPUT ",      <<dctab>>42124000
         "MODE    DRIVER   DEVICE ";                           <<s8967>>42126000
        INTEGER ARRAY HEAD2(0:35)=PB:=                         <<dctab>>42128000
         "DEV  #  N  H Y TYPE  TERMINAL   WIDTH  DEV ",        <<dctab>>42130000
         "           NAME    CLASSES ";                        <<dctab>>42132000
        INTEGER ARRAY HEAD3(0:15)=PB:=                         <<dctab>>42134000
         " #      I  A P      TYPE SPEED  ";                   <<dctab>>42136000
        INTEGER ARRAY HEAD4(0:6)=PB:=                          <<dctab>>42138000
         "        T  N E";                                     <<dctab>>42140000
        INTEGER TSPEED,                                        <<dctab>>42142000
                SPEEDCDE;                                      <<dctab>>42144000
        LOGICAL FIRSTCLASS;                                    <<dctab>>42146000
        MOVE LINE := HEAD1,(35);                               <<dctab>>42148000
        PRINTLINE;                                             <<dctab>>42150000
        MOVE LINE := HEAD2,(35);                               <<dctab>>42152000
        PRINTLINE;                                             <<dctab>>42154000
        MOVE LINE := HEAD3,(16);                               <<dctab>>42156000
        PRINTLINE;                                             <<dctab>>42158000
        MOVE LINE := HEAD4,(7);                                <<dctab>>42160000
        PRINTLINE;                                             <<dctab>>42162000
        LDEV:=0;                                               <<dctab>>42164000
        WHILE (LDEV:=LDEV+1) <= HLDEV DO                       <<dctab>>42166000
          BEGIN                                                <<dctab>>42168000
          DVR'INDEX := LDEV * DVRSIZE;                         <<dctab>>42170000
          IF DVRDRTNUM<>0 OR DVRDSBIT=1 THEN                   <<dctab>>42172000
            BEGIN                                              <<dctab>>42174000
            LDT'INDEX  := LDEV * LDTSIZE;                      <<dctab>>42176000
            LDTX'INDEX := LDEV * LDTXSIZE;                     <<dctab>>42178000
            LPDT'INDEX := LDEV * LPDTSIZE;                     <<dctab>>42180000
            ASCII(LDEV, 10, BLINE);  <<LOGICAL DEVICE #>>      <<*8392>>42182000
            IF DVRDSBIT=1  THEN                                <<dctab>>42184000
              BEGIN  <<DS DEVICE>>                             <<dctab>>42186000
              BLINE(3) := "#";                                 <<dctab>>42188000
              ASCII(DVRMASTERLDEV, 10,BLINE(4));               <<*8392>>42190000
              END                                              <<dctab>>42192000
            ELSE ASCII(DVRDRTNUM, 10,BLINE(4));                <<*8392>>42194000
            ASCII(DVRUNITNUM, 10,BLINE(8));       <<UNIT #>>   <<*8392>>42196000
            ASCII(DVRCHANNUM, 10,BLINE(11));    <<CHANNEL#>>   <<*8392>>42198000
            ASCII(LDT'DEVICE'TYPE, 10,BLINE(13));   <<TYPE>>   <<*8392>>42200000
            ASCII(LPDT'SUBTYPE, 10,BLINE(16));   <<SUBTYPE>>   <<*8392>>42202000
            I := LPDT'SUBTYPE;  <<DEV. SUBTYPE>>               <<dctab>>42204000
            IF LDT'DEVICE'TYPE = TERMDEVTYPE OR                <<dctab>>42206000
               LDT'DEVICE'TYPE = 32 AND                        <<dctab>>42208000
               ( I=14 OR I=15) THEN                            <<dctab>>42210000
              BEGIN <<TERMINAL>>                               <<dctab>>42212000
              IF LDT'DFLT'TERM'TYPE=%37 THEN                   <<dctab>>42214000
                MOVE BLINE(21) := "??"                         <<dctab>>42216000
              ELSE ASCII(LDT'DFLT'TERM'TYPE, 10,BLINE(21));    <<*8392>>42218000
              IF LDTX'TDT'OFFSET <> -1 THEN                    <<dctab>>42220000
                BLINE(23) := "*";      <<THERE IS A TTDF REF>> <<dctab>>42222000
              SPEEDCDE := LDTX'BAUD'RATE'CODE;  <<SPEED CODE>> <<dctab>>42224000
              TSPEED := -1;            << SET PARAMETER FOR >> <<dctab>>42226000
                                       <<    CHECKSPEED     >> <<dctab>>42228000
              CHECKSPEED(TSPEED,SPEEDCDE);    <<CONVERT CODE>> <<dctab>>42230000
                                              <<   TO SPEED >> <<dctab>>42232000
              IF SPEEDCDE = 0 THEN                             <<dctab>>42234000
                 MOVE BLINE(26) := "??"                        <<dctab>>42236000
              ELSE                             << CONVERT TO>> <<dctab>>42238000
                 ASCII(TSPEED, 10,BLINE(26));    <<  ASCII  >> <<*8392>>42240000
                                                               <<dctab>>42242000
              END;                                             <<dctab>>42244000
            ASCII(LDT'RECORD'WIDTH, 10,BLINE(33));             <<*8392>>42246000
            IF LOGICAL(LDT'CLASS'INDEX) THEN                   <<dctab>>42248000
              BEGIN           <<OUTPUT DEVICE IS CLASS INDEX>> <<dctab>>42250000
              TOS := LDT'DFLT'OUT'DEV;                         <<dctab>>42252000
              IF = THEN DEL                                    <<dctab>>42254000
              ELSE CLNAME(*,BLINE(38));                        <<dctab>>42256000
              END                                              <<dctab>>42258000
            ELSE ASCII(LDT'DFLT'OUT'DEV, 10,BLINE(40));        <<*8392>>42260000
              IF LOGICAL(LDTX'SEEK'AHEAD) THEN BLINE(45):="E"; <<s8967>>42262000
              IF LOGICAL(LPDT'JOB'ACCEPT) THEN BLINE(46):="J"; <<s8967>>42264000
            IF LOGICAL(LPDT'DATA'ACCEPT) THEN BLINE(47):="A";  <<s8967>>42266000
            IF LOGICAL(LPDT'INTERACTIVE) THEN BLINE(48):="I";  <<s8967>>42268000
            IF LOGICAL(LPDT'DUPLICATIVE)                       <<dctab>>42270000
                THEN BLINE(49):="D";                           <<s8967>>42272000
              IF LDT'SPOOL'STATE<>0 THEN BLINE(50) := "S";     <<s8967>>42274000
              IF LOGICAL(LPDT'AUTO'ALLOC) THEN BLINE(51):="R"; <<s8967>>42276000
            IF LOGICAL(DVRCORERES) THEN BLINE(53):="*";        <<dctab>>42278000
            MOVE LINE(27) := DVRNAME,(4);                      <<dctab>>42280000
            FIRSTCLASS := TRUE;                                <<dctab>>42282000
            I := 0;                                            <<dctab>>42284000
            @DCT := @DCT'HEAD+DCTH'DCT'BASE;                   <<dctab>>42286000
            @DCT'B := @DCT & LSL(1);                           <<dctab>>42288000
            WHILE (I:=I+1) <= DCTH'NUM'DCT'ENTRIES DO          <<dctab>>42290000
              BEGIN   <<SCAN DEVICE CLASSES>>                  <<dctab>>42292000
              J := -1;                                         <<dctab>>42294000
              WHILE (J:=J+1) < DCT'NUM'DEVICES DO              <<dctab>>42296000
                IF DCT(DCT'FIRST'LDEV + J) = LDEV THEN         <<dctab>>42298000
                  BEGIN    <<DEVICE IS IN THIS CLASS>>         <<dctab>>42300000
                  IF FIRSTCLASS THEN FIRSTCLASS := FALSE       <<dctab>>42302000
                  ELSE                                         <<dctab>>42304000
                    PRINTLINE;                                 <<dctab>>42306000
                  MOVE BLINE(63) := DCTB'CLASS'NAME,(8);       <<dctab>>42308000
                  END;                                         <<dctab>>42310000
              @DCT := @DCT + DCT'NEXT'ENTRY;                   <<dctab>>42312000
              @DCT'B := @DCT & LSL(1);                         <<dctab>>42314000
              END;                                             <<dctab>>42316000
            PRINTLINE;                                         <<dctab>>42318000
            END;                                               <<dctab>>42320000
          END;  << WHILE >>                                    <<dctab>>42322000
      END <<LISTIODEV>>;                                       <<dctab>>42324000
procedure clean'tclasses;                                      <<tclas>>42326000
   begin                                                       <<tclas>>42328000
   comment                                                     <<tclas>>42330000
     Tempclass is a integer array which contains in word zero, <<tclas>>42332000
   the number of undefined classes used as output devices and, <<tclas>>42334000
   in word 1, the size of tempclass( in words ).  The remainder<<tclas>>42336000
   of tempclass in similar to the Device Class Table except    <<tclas>>42338000
   the cyclical pointer and the access type are not included in<<tclas>>42340000
   Tempclass.  The name is followed by the number of devices   <<tclas>>42342000
   and the device number's that require this class as an output<<tclas>>42344000
   device                                                      <<tclas>>42346000
   ;                                                           <<tclas>>42348000
                                                               <<tclas>>42350000
   << Tempclass declarations >>                                <<tclas>>42352000
                                                               <<tclas>>42354000
   equate                                                      <<tclas>>42356000
      temp'first'ldev = 5;                                     <<tclas>>42358000
                                                               <<tclas>>42360000
   define                                                      <<tclas>>42362000
      num'temp'entries    = tempclass'h(0)#,                   <<tclas>>42364000
      temp'table'size     = tempclass'h(1)#,                   <<tclas>>42366000
      temp'class'name     = tempclass'b(0)#,                   <<tclas>>42368000
      num'temp'devices    = tempclass'w(4)#,                   <<tclas>>42370000
      next'temp'entry     = num'temp'devices + 5#;             <<tclas>>42372000
                                                               <<tclas>>42374000
   comment                                                     <<tclas>>42376000
     We use tempclass'h to point to the header portion of      <<tclas>>42378000
   tempclass and to access those variables associated with     <<tclas>>42380000
   the header.  Tempclass'w is used to access the current      <<tclas>>42382000
   entry and Tempclass'b to access the current class name.     <<tclas>>42384000
   ;                                                           <<tclas>>42386000
                                                               <<tclas>>42388000
   integer pointer                                             <<tclas>>42390000
      tempclass'h,                                             <<tclas>>42392000
      tempclass'w;                                             <<tclas>>42394000
                                                               <<tclas>>42396000
   byte pointer                                                <<tclas>>42398000
      tempclass'b;                                             <<tclas>>42400000
                                                               <<tclas>>42402000
   integer                                                     <<tclas>>42404000
      i,                                                       <<tclas>>42406000
      j,                                                       <<tclas>>42408000
      l,                                                       <<tclas>>42410000
      m;                                                       <<tclas>>42412000
                                                               <<tclas>>42414000
   byte array e1(0:15)=pb:="UNDEFINED CLASS ";                 <<tclas>>42416000
   byte array e2(0:41)=pb:="USED AS OUTPUT DEVICE BY ",        <<tclas>>42418000
                           "FOLLOWING DEVICES";                <<tclas>>42420000
                                                               <<tclas>>42422000
   @tempclass'h := @tclass;                                    <<tclas>>42424000
   @tempclass'w := @tempclass'h + 2;                           <<tclas>>42426000
   @tempclass'b := @tempclass'w & lsl(1);                      <<tclas>>42428000
   i := 0;                                                     <<tclas>>42430000
   while (i := i + 1 ) <= num'temp'entries do                  <<tclas>>42432000
      begin                                                    <<tclas>>42434000
      move binbuf:=e1,(16),2;                                  <<tclas>>42436000
      move * := temp'class'name,(8),2;                         <<tclas>>42438000
      move * := e2,(44);                                       <<tclas>>42440000
      print(inbuf,-67,0);                                      <<tclas>>42442000
      j :=-1;                                                  <<tclas>>42444000
      m:=l:=0;                                                 <<tclas>>42446000
      while (j := j + 1 ) < num'temp'devices do                <<tclas>>42448000
         begin                                                 <<tclas>>42450000
         l := ascii(tempclass'w(temp'first'ldev+j),            <<tclas>>42452000
                       10,binbuf(m));                          <<*8392>>42454000
         x := m + l;                                           <<tclas>>42456000
         binbuf(x) := ",";                                     <<tclas>>42458000
         m := x + 1;                                           <<tclas>>42460000
         if m > 69 and j < num'temp'devices then               <<tclas>>42462000
            begin                                              <<tclas>>42464000
            print(inbuf,-m+1,0);                               <<tclas>>42466000
            m := 0;                                            <<tclas>>42468000
            end;                                               <<tclas>>42470000
         end;                                                  <<tclas>>42472000
      @tempclass'w := @tempclass'w + next'temp'entry;          <<tclas>>42474000
      @tempclass'b := @tempclass'w & lsl(1);                   <<tclas>>42476000
      print(inbuf,-m+1,0);                                     <<tclas>>42478000
      end;                                                     <<tclas>>42480000
   tclassincr := -(temp'table'size);                           <<tclas>>42482000
   movedltables;                                               <<tclas>>42484000
   end;  << clean tempclass >>                                 <<tclas>>42486000
                                                               <<tclas>>42488000
                                                               <<tclas>>42490000
                                                               <<tclas>>42492000
                                                               <<tclas>>42494000
procedure cktempclass(devclass);                               <<tclas>>42496000
   byte array devclass;                                        <<tclas>>42498000
   begin                                                       <<tclas>>42500000
   comment                                                     <<tclas>>42502000
     Tempclass is a integer array which contains in word zero, <<tclas>>42504000
   the number of undefined classes used as output devices and, <<tclas>>42506000
   in word 1, the size of tempclass( in words ).  The remainder<<tclas>>42508000
   of tempclass in similar to the Device Class Table except    <<tclas>>42510000
   the cyclical pointer and the access type are not included in<<tclas>>42512000
   Tempclass.  The name is followed by the number of devices   <<tclas>>42514000
   and the device number's that require this class as an output<<tclas>>42516000
   device                                                      <<tclas>>42518000
   ;                                                           <<tclas>>42520000
                                                               <<tclas>>42522000
   << Tempclass declarations >>                                <<tclas>>42524000
                                                               <<tclas>>42526000
   equate                                                      <<tclas>>42528000
      temp'first'ldev = 5;                                     <<tclas>>42530000
                                                               <<tclas>>42532000
   define                                                      <<tclas>>42534000
      num'temp'entries    = tempclass'h(0)#,                   <<tclas>>42536000
      temp'table'size     = tempclass'h(1)#,                   <<tclas>>42538000
      temp'class'name     = tempclass'b(0)#,                   <<tclas>>42540000
      num'temp'devices    = tempclass'w(4)#,                   <<tclas>>42542000
      next'temp'entry     = num'temp'devices + 5#;             <<tclas>>42544000
                                                               <<tclas>>42546000
   comment                                                     <<tclas>>42548000
     We use tempclass'h to point to the header portion of      <<tclas>>42550000
   tempclass and to access those variables associated with     <<tclas>>42552000
   the header.  Tempclass'w is used to access the current      <<tclas>>42554000
   entry and Tempclass'b to access the current class name.     <<tclas>>42556000
   ;                                                           <<tclas>>42558000
                                                               <<tclas>>42560000
   integer pointer                                             <<tclas>>42562000
      tempclass'h,                                             <<tclas>>42564000
      tempclass'w;                                             <<tclas>>42566000
                                                               <<tclas>>42568000
   byte pointer                                                <<tclas>>42570000
      tempclass'b;                                             <<tclas>>42572000
                                                               <<tclas>>42574000
   integer                                                     <<tclas>>42576000
      i,                                                       <<tclas>>42578000
      class'counter,                                           <<tclas>>42580000
      dev'counter,                                             <<tclas>>42582000
      classindex,                                              <<tclas>>42584000
      ldev,                                                    <<tclas>>42586000
      count,                                                   <<tclas>>42588000
      dvr'index,                                               <<tclas>>42590000
      ldt'index;                                               <<tclas>>42592000
                                                               <<tclas>>42594000
   comment                                                     <<tclas>>42596000
      cktempclass is called each time a new device class is    <<tclas>>42598000
   defined. if the newly defined device class was present in   <<tclas>>42600000
   tempclass, the class index field in the ldt entry for this  <<tclas>>42602000
   device is updated appropriatly and the entry is removed     <<tclas>>42604000
   from tempclass. If the newly defined class is not present   <<tclas>>42606000
   then no action is taken.                                    <<tclas>>42608000
   ;                                                           <<tclas>>42610000
                                                               <<tclas>>42612000
                                                               <<tclas>>42614000
   @tempclass'h := @tclass;                                    <<tclas>>42616000
   @tempclass'w := @tempclass'h + 2;                           <<tclas>>42618000
   @tempclass'b := @tempclass'w & lsl(1);                      <<tclas>>42620000
   class'counter := 0;                                         <<tclas>>42622000
   while (class'counter := class'counter + 1 )                 <<tclas>>42624000
                                      <= num'temp'entries do   <<tclas>>42626000
      if devclass = temp'class'name,(8) then                   <<tclas>>42628000
         begin                                                 <<tclas>>42630000
                                                               <<tclas>>42632000
         << update ldt entry for each device in class >>       <<tclas>>42634000
                                                               <<tclas>>42636000
         classindex := clindex(devclass);                      <<tclas>>42638000
         dev'counter := -1;                                    <<tclas>>42640000
         while ( dev'counter := dev'counter + 1 )              <<tclas>>42642000
                                     < num'temp'devices do     <<tclas>>42644000
            begin                                              <<tclas>>42646000
            ldev := tempclass'w(temp'first'ldev+dev'counter);  <<tclas>>42648000
            dvr'index := ldev * dvrsize;                       <<tclas>>42650000
            ldt'index := ldev * ldtsize;                       <<tclas>>42652000
            if dvrdrtnum <> 0 then                             <<tclas>>42654000
               ldt'dflt'out'dev := classindex;                 <<tclas>>42656000
            end;                                               <<tclas>>42658000
                                                               <<tclas>>42660000
         << remove this tempclass entry               >>       <<tclas>>42662000
                                                               <<tclas>>42664000
         tclassincr := -(temp'first'ldev + num'temp'devices);  <<tclas>>42666000
                                                               <<tclas>>42668000
         << move the rest of tempclass over this entry >>      <<tclas>>42670000
                                                               <<tclas>>42672000
         count := (@tclass + temp'table'size + 1) -            <<tclas>>42674000
                        (@tempclass'w + next'temp'entry);      <<tclas>>42676000
         move tempclass'w := tempclass'w(next'temp'entry),     <<tclas>>42678000
                             (count);                          <<tclas>>42680000
         temp'table'size := temp'table'size + tclassincr;      <<tclas>>42682000
         num'temp'entries := num'temp'entries - 1;             <<tclas>>42684000
         class'counter := num'temp'entries;                    <<tclas>>42686000
         end                                                   <<tclas>>42688000
      else                                                     <<tclas>>42690000
         begin                                                 <<tclas>>42692000
         @tempclass'w := @tempclass'w + next'temp'entry;       <<tclas>>42694000
         @tempclass'b := @tempclass'w & lsl(1);                <<tclas>>42696000
         end;                                                  <<tclas>>42698000
   movedltables;                                               <<tclas>>42700000
   end;  << cktempclass >>                                     <<tclas>>42702000
                                                               <<tclas>>42704000
procedure putintempclass(devclass,ldev);                       <<tclas>>42706000
   value ldev;                                                 <<tclas>>42708000
   integer ldev;                                               <<tclas>>42710000
   byte array devclass;                                        <<tclas>>42712000
   begin                                                       <<tclas>>42714000
   comment                                                     <<tclas>>42716000
     Tempclass is a integer array which contains in word zero, <<tclas>>42718000
   the number of undefined classes used as output devices and, <<tclas>>42720000
   in word 1, the size of tempclass( in words ).  The remainder<<tclas>>42722000
   of tempclass in similar to the Device Class Table except    <<tclas>>42724000
   the cyclical pointer and the access type are not included in<<tclas>>42726000
   Tempclass.  The name is followed by the number of devices   <<tclas>>42728000
   and the device number's that require this class as an output<<tclas>>42730000
   device                                                      <<tclas>>42732000
   ;                                                           <<tclas>>42734000
                                                               <<tclas>>42736000
   << Tempclass declarations >>                                <<tclas>>42738000
                                                               <<tclas>>42740000
   equate                                                      <<tclas>>42742000
      temp'first'ldev = 5;                                     <<tclas>>42744000
                                                               <<tclas>>42746000
   define                                                      <<tclas>>42748000
      num'temp'entries    = tempclass'h(0)#,                   <<tclas>>42750000
      temp'table'size     = tempclass'h(1)#,                   <<tclas>>42752000
      temp'class'name     = tempclass'b(0)#,                   <<tclas>>42754000
      num'temp'devices    = tempclass'w(4)#,                   <<tclas>>42756000
      next'temp'entry     = num'temp'devices + 5#;             <<tclas>>42758000
                                                               <<tclas>>42760000
   comment                                                     <<tclas>>42762000
     We use tempclass'h to point to the header portion of      <<tclas>>42764000
   tempclass and to access those variables associated with     <<tclas>>42766000
   the header.  Tempclass'w is used to access the current      <<tclas>>42768000
   entry and Tempclass'b to access the current class name.     <<tclas>>42770000
   ;                                                           <<tclas>>42772000
                                                               <<tclas>>42774000
   integer pointer                                             <<tclas>>42776000
      tempclass'h,                                             <<tclas>>42778000
      tempclass'w,                                             <<tclas>>42780000
      dest,                                                    <<tclas>>42782000
      source;                                                  <<tclas>>42784000
                                                               <<tclas>>42786000
   byte pointer                                                <<tclas>>42788000
      tempclass'b;                                             <<tclas>>42790000
                                                               <<tclas>>42792000
   logical found;                                              <<tclas>>42794000
                                                               <<tclas>>42796000
   integer                                                     <<tclas>>42798000
      i,                                                       <<tclas>>42800000
      count;                                                   <<tclas>>42802000
                                                               <<tclas>>42804000
   @tempclass'h := @tclass;                                    <<tclas>>42806000
   @tempclass'w := @tempclass'h + 2;                           <<tclas>>42808000
   @tempclass'b := @tempclass'w & lsl(1);                      <<tclas>>42810000
   found := false;                                             <<tclas>>42812000
   i := 0;                                                     <<tclas>>42814000
   while (i := i + 1 ) <= num'temp'entries and not found do    <<tclas>>42816000
      if temp'class'name = devclass,(8)                        <<tclas>>42818000
         then found := true                                    <<tclas>>42820000
      else                                                     <<tclas>>42822000
         begin                                                 <<tclas>>42824000
         @tempclass'w := @tempclass'w + next'temp'entry;       <<tclas>>42826000
         @tempclass'b := @tempclass'w & lsl(1);                <<tclas>>42828000
         end;                                                  <<tclas>>42830000
                                                               <<tclas>>42832000
   if found then                                               <<tclas>>42834000
      begin                                                    <<tclas>>42836000
                                                               <<tclas>>42838000
      << must make room to insert new ldev  >>                 <<tclas>>42840000
                                                               <<tclas>>42842000
      tclassincr := 1;                                         <<tclas>>42844000
      movedltables;                                            <<tclas>>42846000
      @tempclass'h := @tclass;                                 <<tclas>>42848000
      @tempclass'w := @tempclass'w - 1;                        <<tclas>>42850000
      @tempclass'b := @tempclass'w & lsl(1);                   <<tclas>>42852000
                                                               <<tclas>>42854000
      << insert new ldev in tempclass       >>                 <<tclas>>42856000
                                                               <<tclas>>42858000
      @dest := @tclass + temp'table'size;                      <<tclas>>42860000
      @source := @dest - 1;                                    <<tclas>>42862000
      count := @dest - @ tempclass'w(next'temp'entry);         <<tclas>>42864000
      move dest := source,(-count);                            <<tclas>>42866000
      tempclass'w(next'temp'entry) := ldev;                    <<tclas>>42868000
      temp'table'size := temp'table'size + 1;                  <<tclas>>42870000
      num'temp'devices := num'temp'devices +1;                 <<tclas>>42872000
      end                                                      <<tclas>>42874000
   else                                                        <<tclas>>42876000
                                                               <<tclas>>42878000
      << new tempclass entry to be built    >>                 <<tclas>>42880000
                                                               <<tclas>>42882000
      begin                                                    <<tclas>>42884000
      tclassincr := 6;                                         <<tclas>>42886000
      movedltables;                                            <<tclas>>42888000
      @tempclass'w := @tempclass'w - 6;                        <<tclas>>42890000
      @tempclass'b := @tempclass'w & lsl(1);                   <<tclas>>42892000
      @tempclass'h := @tclass;                                 <<tclas>>42894000
      move temp'class'name := devclass,(8);                    <<tclas>>42896000
      num'temp'devices := 1;                                   <<tclas>>42898000
      tempclass'w( temp'first'ldev ) := ldev;                  <<tclas>>42900000
      num'temp'entries := num'temp'entries + 1;                <<tclas>>42902000
      temp'table'size := temp'table'size + 6;                  <<tclas>>42904000
      end;                                                     <<tclas>>42906000
   end;  << procedure putintempclass >>                        <<tclas>>42908000
                                                               <<tclas>>42910000
                                                               <<tclas>>42912000
                                                               <<tclas>>42914000
procedure remtempclass(ldev);                                  <<tclas>>42916000
   value ldev;                                                 <<tclas>>42918000
   integer ldev;                                               <<tclas>>42920000
   begin                                                       <<tclas>>42922000
   comment                                                     <<tclas>>42924000
     Tempclass is a integer array which contains in word zero, <<tclas>>42926000
   the number of undefined classes used as output devices and, <<tclas>>42928000
   in word 1, the size of tempclass( in words ).  The remainder<<tclas>>42930000
   of tempclass in similar to the Device Class Table except    <<tclas>>42932000
   the cyclical pointer and the access type are not included in<<tclas>>42934000
   Tempclass.  The name is followed by the number of devices   <<tclas>>42936000
   and the device number's that require this class as an output<<tclas>>42938000
   device                                                      <<tclas>>42940000
   ;                                                           <<tclas>>42942000
                                                               <<tclas>>42944000
   << Tempclass declarations >>                                <<tclas>>42946000
                                                               <<tclas>>42948000
   equate                                                      <<tclas>>42950000
      temp'first'ldev = 5;                                     <<tclas>>42952000
                                                               <<tclas>>42954000
   define                                                      <<tclas>>42956000
      num'temp'entries    = tempclass'h(0)#,                   <<tclas>>42958000
      temp'table'size     = tempclass'h(1)#,                   <<tclas>>42960000
      temp'class'name     = tempclass'b(0)#,                   <<tclas>>42962000
      num'temp'devices    = tempclass'w(4)#,                   <<tclas>>42964000
      next'temp'entry     = num'temp'devices + 5#;             <<tclas>>42966000
                                                               <<tclas>>42968000
   comment                                                     <<tclas>>42970000
     We use tempclass'h to point to the header portion of      <<tclas>>42972000
   tempclass and to access those variables associated with     <<tclas>>42974000
   the header.  Tempclass'w is used to access the current      <<tclas>>42976000
   entry and Tempclass'b to access the current class name.     <<tclas>>42978000
   ;                                                           <<tclas>>42980000
                                                               <<tclas>>42982000
   integer pointer                                             <<tclas>>42984000
      tempclass'h,                                             <<tclas>>42986000
      tempclass'w;                                             <<tclas>>42988000
                                                               <<tclas>>42990000
   byte pointer                                                <<tclas>>42992000
      tempclass'b;                                             <<tclas>>42994000
                                                               <<tclas>>42996000
   integer                                                     <<tclas>>42998000
      i,                                                       <<tclas>>43000000
      j,                                                       <<tclas>>43002000
      count;                                                   <<tclas>>43004000
                                                               <<tclas>>43006000
   logical                                                     <<tclas>>43008000
      found;                                                   <<tclas>>43010000
                                                               <<tclas>>43012000
   found := false;                                             <<tclas>>43014000
   @tempclass'h := @tclass;                                    <<tclas>>43016000
   @tempclass'w := @tempclass'h + 2;                           <<tclas>>43018000
   @tempclass'b := @tempclass'w & lsl(1);                      <<tclas>>43020000
   i := 0;                                                     <<tclas>>43022000
   while (i := i + 1 ) <= num'temp'entries and not found do    <<tclas>>43024000
      begin                                                    <<tclas>>43026000
      j :=-1;                                                  <<tclas>>43028000
      while (j := j + 1 ) < num'temp'devices and not found do  <<tclas>>43030000
         if ldev = tempclass'w(temp'first'ldev + j) then       <<tclas>>43032000
                                                               <<tclas>>43034000
            << found appropriate entry, remove it   >>         <<tclas>>43036000
                                                               <<tclas>>43038000
            if num'temp'devices = 1 then                       <<tclas>>43040000
               begin                                           <<tclas>>43042000
               << must remove entire class  >>                 <<tclas>>43044000
               << move the rest of tempclass over this entry >><<tclas>>43046000
                                                               <<tclas>>43048000
               count := (@tclass + temp'table'size) -          <<tclas>>43050000
                        (@tempclass'w + next'temp'entry);      <<tclas>>43052000
               move tempclass'w := tempclass'w(next'temp'entry)<<tclas>>43054000
                                    ,(count);                  <<tclas>>43056000
               found := true;                                  <<tclas>>43058000
               tclassincr := -6;                               <<tclas>>43060000
               temp'table'size := temp'table'size - 6;         <<tclas>>43062000
               num'temp'entries := num'temp'entries - 1;       <<tclas>>43064000
               movedltables;                                   <<tclas>>43066000
               end                                             <<tclas>>43068000
            else                                               <<tclas>>43070000
               begin                                           <<tclas>>43072000
               count := num'temp'devices - (j+1);              <<tclas>>43074000
               move tempclass'w(temp'first'ldev + j) :=        <<tclas>>43076000
                    tempclass'w(temp'first'ldev + j + 1),      <<tclas>>43078000
                    (count);                                   <<tclas>>43080000
               count := (@tclass + temp'table'size) -          <<tclas>>43082000
                        (@tempclass'w + next'temp'entry);      <<tclas>>43084000
               move tempclass'w(next'temp'entry - 1) :=        <<tclas>>43086000
                    tempclass'w(next'temp'entry),(count);      <<tclas>>43088000
               temp'table'size := temp'table'size - 1;         <<tclas>>43090000
               num'temp'devices := num'temp'devices - 1;       <<tclas>>43092000
               tclassincr := tclassincr - 1;                   <<tclas>>43094000
               found := true;                                  <<tclas>>43096000
               movedltables;                                   <<tclas>>43098000
               end;                                            <<tclas>>43100000
      @tempclass'w := @tempclass'w + next'temp'entry;          <<tclas>>43102000
      @tempclass'b := @tempclass'w & lsl(1);                   <<tclas>>43104000
      end;                                                     <<tclas>>43106000
   end; << remtempclassrefs >>                                 <<tclas>>43108000
  <<------------------------------------>>                     <<*7777>>43110000
  << LIST THE TERMTYPE DESCRIPTOR FILES >>                     <<*7777>>43112000
  <<------------------------------------>>                     <<*7777>>43114000
                                                               <<*7777>>43116000
PROCEDURE LIST'TTDT;                                           <<*7777>>43118000
                                                               <<*7777>>43120000
COMMENT                                                        <<*7777>>43122000
  LISTS THE TERMTYPE DESCRIPTOR FILES FOLLOWED BY A LIST OF    <<*7777>>43124000
  LDEVS THAT USE THAT FILE;                                    <<*7777>>43126000
                                                               <<*7777>>43128000
  BEGIN                                                        <<*7777>>43130000
  INTEGER ARRAY HED1(0:17)=PB:=                                <<*7777>>43132000
    "  FILE                       LOGICAL";                    <<*7777>>43134000
  INTEGER ARRAY HED2(0:17)=PB:=                                <<*7777>>43136000
    "  NAME                       DEVICES";                    <<*7777>>43138000
  INTEGER                                                      <<*7777>>43140000
    I,                                                         <<*7777>>43142000
    K;                                                         <<*7777>>43144000
  INTEGER  BINDX := 29;                                        <<*7777>>43146000
  FILL'(BLINE,80," ");                                         <<*7777>>43148000
  MOVE LINE := HED1,(18);                                      <<*7777>>43150000
  PRINTLINE;                                                   <<*7777>>43152000
  MOVE LINE := HED2,(18);                                      <<*7777>>43154000
  PRINTLINE;                                                   <<*7777>>43156000
  I := 0;                                                      <<*7777>>43158000
  @TDT := @DCT'HEAD + DCTH'TDT'BASE;                           <<*7777>>43160000
  @TDT'B := @TDT & LSL(1);                                     <<*7777>>43162000
  WHILE (I:=I+1) <= DCTH'NUM'TDT'ENTRIES DO                    <<*7777>>43164000
    BEGIN                                                      <<*7777>>43166000
    FILL'(BLINE,80," ");                                       <<*7777>>43168000
    MOVE BLINE := TDTB'FILE'NAME,(8);                          <<*7777>>43170000
    MOVE BLINE(8) := ".";                                      <<*7777>>43172000
    MOVE BLINE(9) := TDTB'GROUP'NAME,(8);                      <<*7777>>43174000
    MOVE BLINE(17) := ".";                                     <<*7777>>43176000
    MOVE BLINE(18) := TDTB'ACCT'NAME,(8);                      <<*7777>>43178000
    K := 0;                                                    <<*7777>>43180000
    WHILE (K:=K+1) <= TDT'NUM'DEVICES DO                       <<*7777>>43182000
      BEGIN                                                    <<*7777>>43184000
      LDEV := TDT(TDT'FIRST'LDEV + K);                         <<*7777>>43186000
      IF (LDEV>99) AND (BINDX>69) OR                           <<*7777>>43188000
         (LDEV>9)  AND (BINDX>70) OR                           <<*7777>>43190000
         (BINDX>71) THEN                                       <<*7777>>43192000
        BEGIN  <<WON'T FIT ON THIS LINE>>                      <<*7777>>43194000
        PRINTLINE;                                             <<*7777>>43196000
        BINDX := 29;                                           <<*7777>>43198000
        FILL'(BLINE,80," ");                                   <<*7777>>43200000
        END;                                                   <<*7777>>43202000
      M := ASCII(LDEV,10,BLINE(BINDX));                        <<*8392>>43204000
      BINDX := BINDX + M;                                      <<*7777>>43206000
      IF K < TDT'NUM'DEVICES THEN                              <<*7777>>43208000
        BEGIN                                                  <<*7777>>43210000
        BLINE(BINDX) := ",";                                   <<*7777>>43212000
        BINDX := BINDX + 1;                                    <<*7777>>43214000
        END;                                                   <<*7777>>43216000
      END;                                                     <<*7777>>43218000
    PRINTLINE;                                                 <<*7777>>43220000
    @TDT := @TDT + TDT'NEXT'ENTRY;                             <<*7777>>43222000
    @TDT'B := @TDT & LSL(1);                                   <<*7777>>43224000
    BINDX := 29;                                               <<*7777>>43226000
    END;                                                       <<*7777>>43228000
  PRINTLINE;                                                   <<*7777>>43230000
END; <<LIST'TTDT>>                                             <<*7777>>43232000
<<------------------------------------------------------->>    <<*7777>>43234000
<<CALCULATE THE OFFSET INTO THE TERMTYPE DESCRIPTOR TABLE>>    <<*7777>>43236000
<<------------------------------------------------------->>    <<*7777>>43238000
                                                               <<*7777>>43240000
PROCEDURE CALC'TTF'OFFSET;                                     <<*7777>>43242000
                                                               <<*7777>>43244000
COMMENT                                                        <<*7777>>43246000
  CALCULATES THE OFFSET INTO THE TERMTYPE DESCRIPTOR TABLE     <<*7777>>43248000
  AND PUTS IT INTO THE LDTX WORD 1.                            <<*7777>>43250000
  CALLED FROM IO'CONFIG'CHANGE, REMOVETTDTREFS, AND WHEN       <<*7777>>43252000
  ADDING AND DELETING FILENAMES;                               <<*7777>>43254000
                                                               <<*7777>>43256000
  BEGIN                                                        <<*7777>>43258000
  INTEGER                                                      <<*7777>>43260000
    I,                                                         <<*7777>>43262000
    INDEX := 0,       << INDEX FROM BEGINING OF TABLE TO >>    <<*7777>>43264000
                      << CURRENT ENTRY                   >>    <<*7777>>43266000
    J     :=0,        <<POINTS TO THE LIST OF LDEVS>>          <<*7777>>43268000
    LDEV  :=0,        <<LOCAL COPY OF LDEV>>                   <<*7777>>43270000
    LDTX'INDEX;       << INDEX INTO LDTX  >>                   <<*7777>>43272000
  @TDT := @DCT'HEAD + DCTH'TDT'BASE;                           <<*7777>>43274000
  @TDT'B := @TDT & LSL(1);                                     <<*7777>>43276000
  I := -1;                                                     <<*7777>>43278000
  WHILE (I:=I+1) < DCTH'NUM'TDT'ENTRIES DO                     <<*7777>>43280000
    BEGIN                                                      <<*7777>>43282000
    <<GO THRU EACH ENTRY>>                                     <<*7777>>43284000
    INDEX := @TDT - (@DCT'HEAD + DCTH'TDT'BASE);               <<*7777>>43286000
    J := 0;                                                    <<*7777>>43288000
    WHILE (J:=J+1) <= TDT'NUM'DEVICES DO                       <<*7777>>43290000
      BEGIN                                                    <<*7777>>43292000
      <<CALCULATE OFFSET FOR EACH LDEV IN ENTRY>>              <<*7777>>43294000
      LDEV := TDT(TDT'FIRST'LDEV + J);                         <<*7777>>43296000
      LDTX'INDEX := LDEV * LDTXSIZE;                           <<*7777>>43298000
      LDTX'TDT'OFFSET := INDEX;                                <<*7777>>43300000
      END;                                                     <<*7777>>43302000
    << BUMP TDT SO ITS POINTS AT BEGINNING OF NEXT ENTRY >>    <<*7777>>43304000
    @TDT := @TDT + TDT'NEXT'ENTRY;                             <<*7777>>43306000
    @TDT'B := @TDT & LSL(1);                                   <<*7777>>43308000
    END;                                                       <<*7777>>43310000
  END; <<CALC'TTF'OFFSET>>                                     <<*7777>>43312000
  <<--------------------------------------------->>            <<*7777>>43314000
  << REMOVE TERM TYPE DESCRIPTOR FILE REFERENCES >>            <<*7777>>43316000
  <<--------------------------------------------->>            <<*7777>>43318000
   PROCEDURE REMOVETTDTREFS(LDEV);                             <<*7777>>43320000
     VALUE LDEV;                                               <<*7777>>43322000
     INTEGER LDEV;                                             <<*7777>>43324000
     COMMENT                                                   <<*7777>>43326000
       REMOVE REFERENCES TO LDEV FROM THE TTDT.                <<*7777>>43328000
       CALLED FROM IO'CONFIG'CH WHEN A TERM IS DELETED OR      <<*7777>>43330000
       REPLACED, AND WHEN A TERMTYPE DESCR FILE IS ADDED TO    <<*7777>>43332000
       AN LDEV THAT PREVIOUSLY HAD ONE ALREADY.                <<*7777>>43334000
       THIS PROC CALLS CALC'TTF'OFFSET AND MOVEDLTABLES;       <<*7777>>43336000
       BEGIN                                                   <<*7777>>43338000
       INTEGER                                                 <<*7777>>43340000
               J        :=0,  <<POINTS TO NEXT LDEV IN ENT >>  <<*7777>>43342000
               CNT:=0,        <<# OF WORDS TO MOVE>>           <<*7777>>43344000
               LDTX'INDEX,    << INDEX INTO LDTX  >>           <<*7777>>43346000
               OFFSET:=0;     <<FROM LDTX WORD 1>>             <<*7777>>43348000
       LDTX'INDEX := LDEV * LDTXSIZE;                          <<*7777>>43350000
       OFFSET := LDTX'TDT'OFFSET;                              <<*7777>>43352000
       IF OFFSET = -1 THEN                                     <<*7777>>43354000
         RETURN; <<THIS LDEV DOESN'T HAVE A TERMTYPE DESCR>>   <<*7777>>43356000
       @TDT := @DCT'HEAD + DCTH'TDT'BASE + LDTX'TDT'OFFSET;    <<*7777>>43358000
       @TDT'B := @TDT & LSL(1);                                <<*7777>>43360000
       IF TDT'NUM'DEVICES = 1 THEN                             <<*7777>>43362000
         BEGIN  <<FILENAME ENTRY MUST BE DELETED>>             <<*7777>>43364000
         << MOVE THE REST OF THE TABLE WITH A POSITIVE COUNT>> <<*7777>>43366000
         CNT := (DCTH'SEGMENT'SIZE - DCTH'TDT'BASE)            <<*7777>>43368000
                    - (LDTX'TDT'OFFSET +14);                   <<*7777>>43370000
         MOVE TDT := TDT(14),(CNT);                            <<*7777>>43372000
         LDTX'TDT'OFFSET := -1;   <<REMOVED>>                  <<*7777>>43374000
         TDTABINCR := -14;           << 14=SIZE OF ENTRY WITH ><<*7777>>43376000
         DCTH'NUM'TDT'ENTRIES := DCTH'NUM'TDT'ENTRIES - 1;     <<*7777>>43378000
         DCTH'SEGMENT'SIZE := DCTH'SEGMENT'SIZE - 14;          <<*7777>>43380000
         END                                                   <<*7777>>43382000
       ELSE                                                    <<*7777>>43384000
         BEGIN  <<DELETE ONE LDEV OUT OF ENTRY>>               <<*7777>>43386000
         J := 0;                                               <<*7777>>43388000
         DO J := J + 1                                         <<*7777>>43390000
           UNTIL TDT(TDT'FIRST'LDEV + J ) = LDEV;              <<*7777>>43392000
                                                               <<*7777>>43394000
         << MOVE THE REST OF THE ENTRY WITH A POSITIVE COUNT >><<*7777>>43396000
         CNT := TDT'NUM'DEVICES - J;                           <<*7777>>43398000
         MOVE TDT(TDT'FIRST'LDEV + J) :=                       <<*7777>>43400000
                 TDT(TDT'FIRST'LDEV + J + 1),(CNT);            <<*7777>>43402000
                                                               <<*7777>>43404000
         << MOVE THE REST OF THE TABLE WITH A POSITIVE COUNT >><<*7777>>43406000
         CNT := (@DCT'HEAD + DCTH'SEGMENT'SIZE) -              <<*7777>>43408000
                 (@TDT + TDT'NEXT'ENTRY);                      <<*7777>>43410000
         MOVE TDT(TDT'NEXT'ENTRY - 1) :=                       <<*7777>>43412000
                TDT(TDT'NEXT'ENTRY),(CNT);                     <<*7777>>43414000
                                                               <<*7777>>43416000
         LDTX'TDT'OFFSET := -1;   <<REMOVED>>                  <<*7777>>43418000
         TDT'NUM'DEVICES := TDT'NUM'DEVICES - 1;               <<*7777>>43420000
         TDTABINCR := -1;                                      <<*7777>>43422000
         DCTH'SEGMENT'SIZE := DCTH'SEGMENT'SIZE - 1;           <<*7777>>43424000
         END;                                                  <<*7777>>43426000
       MOVEDLTABLES;                                           <<*7777>>43428000
       CALC'TTF'OFFSET;                                        <<*7777>>43430000
       END <<REMOVETTDTREFS>> ;                                <<*7777>>43432000
   <<------------------------------->>                         <<*7777>>43434000
   <<DELETE TERMTYPE DESCRIPTOR FILE>>                         <<*7777>>43436000
   <<------------------------------->>                         <<*7777>>43438000
   PROCEDURE LISTCLASSES;                                      <<dctab>>43440000
   <<LISTS DEVICE CLASSES FOLLOWED CLASS TYPE  >>              <<dctab>>43442000
   << AND LOGICAL DEV. NUMBERS                 >>              <<dctab>>43444000
     BEGIN                                                     <<dctab>>43446000
       INTEGER ARRAY HED1(0:13)=PB:=                           <<dctab>>43448000
           "  CLASS     ACCESS  LOGICAL ";                     <<dctab>>43450000
       INTEGER ARRAY HED2(0:13)=PB:=                           <<dctab>>43452000
           "  NAME      TYPE    DEVICES ";                     <<dctab>>43454000
       INTEGER BINDX:=20;                                      <<dctab>>43456000
       INTEGER POINTER                                         <<dctab>>43458000
           DCT;                                                <<dctab>>43460000
       BYTE POINTER                                            <<dctab>>43462000
           DCT'B;                                              <<dctab>>43464000
          @DCT := @DCT'HEAD + DCTH'DCT'BASE;                   <<dctab>>43466000
          @DCT'B := @DCT & LSL(1);                             <<dctab>>43468000
          MOVE LINE := HED1,(14);                              <<dctab>>43470000
          PRINTLINE;                                           <<dctab>>43472000
          MOVE LINE := HED2,(14);                              <<dctab>>43474000
          PRINTLINE;                                           <<dctab>>43476000
          I := -1;                                             <<dctab>>43478000
          WHILE (I:=I+1) < DCTH'NUM'DCT'ENTRIES DO             <<dctab>>43480000
            BEGIN                                              <<dctab>>43482000
            LINE := "  ";                                      <<dctab>>43484000
            MOVE LINE(1) := LINE,(35);                         <<dctab>>43486000
            MOVE BLINE := DCTB'CLASS'NAME,(8);                 <<dctab>>43488000
            TOS := DCT'CLASS'ACC'TYPE;                         <<dctab>>43490000
            TOS := TOS LAND 7;                                 <<dctab>>43492000
            IF TOS <> 0 THEN                                   <<dctab>>43494000
              BEGIN <<ALL DEVICES ARE DISCS OF SOME KIND >>    <<dctab>>43496000
              IF DCT'CLASS'ACC'TYPE = 31 <<SERIAL DISC >> THEN <<dctab>>43498000
                 MOVE BLINE(12):="SD"                          <<dctab>>43500000
              ELSE                                             <<dctab>>43502000
              IF DCT'CLASS'ACC'TYPE=7 << FOREIGN DISC >> THEN  <<dctab>>43504000
                 MOVE BLINE(12):="FD"                          <<dctab>>43506000
              ELSE                                             <<dctab>>43508000
                 ASCII(DCT'CLASS'ACC'TYPE, 10,BLINE(12))       <<*8392>>43510000
              END                                              <<dctab>>43512000
            ELSE                                               <<dctab>>43514000
              CASE DCT'ACCESS'TYPE OF                          <<dctab>>43516000
                BEGIN                                          <<dctab>>43518000
                MOVE BLINE(12):="DA";                          <<dctab>>43520000
                MOVE BLINE(12):="IN";                          <<dctab>>43522000
                MOVE BLINE(12):="I/O,C";                       <<dctab>>43524000
                MOVE BLINE(12):="I/O,NC";                      <<dctab>>43526000
                MOVE BLINE(12):="OUT";                         <<dctab>>43528000
                END;                                           <<dctab>>43530000
            IF DCT'NUM'DEVICES <> 0 THEN                       <<dctab>>43532000
              BEGIN                                            <<dctab>>43534000
              K := -1;                                         <<dctab>>43536000
              WHILE (K:=K+1) < DCT'NUM'DEVICES DO              <<dctab>>43538000
                BEGIN                                          <<dctab>>43540000
                LDEV := DCT(DCT'FIRST'LDEV + K);               <<dctab>>43542000
                IF (LDEV>99) AND (BINDX>69) OR                 <<dctab>>43544000
                   (LDEV>9) AND (BINDX>70) OR (BINDX>71)       <<dctab>>43546000
                THEN                                           <<dctab>>43548000
                  BEGIN <<WON'T FIT ON THIS LINE>>             <<dctab>>43550000
                  PRINTLINE;                                   <<dctab>>43552000
                  BINDX := 20;                                 <<dctab>>43554000
                  END;                                         <<dctab>>43556000
                M := ASCII(LDEV,10,BLINE(BINDX));              <<*8392>>43558000
                BINDX := BINDX + M;                            <<dctab>>43560000
                IF K < (DCT'NUM'DEVICES-1) THEN                <<dctab>>43562000
                  BEGIN                                        <<dctab>>43564000
                  BLINE(BINDX) := ",";                         <<dctab>>43566000
                  BINDX :=BINDX+1;                             <<dctab>>43568000
                  END;                                         <<dctab>>43570000
                END;                                           <<dctab>>43572000
              PRINTLINE;                                       <<dctab>>43574000
              END;                                             <<dctab>>43576000
            @DCT := @DCT + DCT'NEXT'ENTRY;                     <<dctab>>43578000
            @DCT'B := @DCT & LSL(1);                           <<dctab>>43580000
            BINDX := 20;                                       <<dctab>>43582000
            END;                                               <<dctab>>43584000
     END  <<LISTCLASSES>>;                                     <<dctab>>43586000
                                                               <<*7777>>43588000
PROCEDURE DELETE'TTDT;                                         <<*7777>>43590000
  OPTION PRIVILEGED,UNCALLABLE;                                <<*7777>>43592000
                                                               <<*7777>>43594000
COMMENT                                                        <<*7777>>43596000
  REMOVES REFERENCES TO THE FILENAME SPECIFIED.  THE ENTIRE    <<*7777>>43598000
  ENTRY IS REMOVED, AND THE OFFSETS KEPT IN THE LDTX WD 1      <<*7777>>43600000
  ARE SET TO -1.                                               <<*7777>>43602000
  CALLED FROM IO'CONFIG'CH WHEN DELETING CLASSES.              <<*7777>>43604000
  CALLS CALC'TTDT'OFFSET, AND MOVEDLTABLES                     <<*7777>>43606000
     ASSUMES THAT THE POINTERS TDT AND TDT'B ARE SET           <<*7777>>43608000
  TO THE ENTRY BEING REMOVED PRIOR TO CALLING THIS             <<*7777>>43610000
  PROCEDURE;                                                   <<*7777>>43612000
                                                               <<*7777>>43614000
  BEGIN                                                        <<*7777>>43616000
  INTEGER LDEV,             <<POINTS TO #LDEVS IN ENT>>        <<*7777>>43618000
          CNT:=0,           <<# OF WORDS TO MOVE>>             <<*7777>>43620000
          LDTX'INDEX,       << INDEX INTO LDTX  >>             <<*7777>>43622000
          OFFSET,           <<FROM LDTX WORD 1>>               <<*7777>>43624000
          NLDEVS,           <<NUMBER OF LDEVS IN ENT>>         <<*7777>>43626000
          I:=0;                                                <<*7777>>43628000
  DO                                                           <<*7777>>43630000
     BEGIN                                                     <<*7777>>43632000
     I:=I+1;                                                   <<*7777>>43634000
     LDEV := TDT(TDT'FIRST'LDEV + I);                          <<*7777>>43636000
     LDTX'INDEX := LDEV * LDTXSIZE;                            <<*7777>>43638000
     LDTX'TDT'OFFSET := -1;  <<REMOVED>>                       <<*7777>>43640000
     END                                                       <<*7777>>43642000
  UNTIL (I = TDT'NUM'DEVICES);                                 <<*7777>>43644000
  TDTABINCR := -(TDT'NEXT'ENTRY);                              <<*7777>>43646000
  CNT := (@DCT'HEAD + DCTH'SEGMENT'SIZE)                       <<*7777>>43648000
         - (@TDT + TDT'NEXT'ENTRY);                            <<*7777>>43650000
  MOVE TDT := TDT(TDT'NEXT'ENTRY),(CNT);                       <<*7777>>43652000
  DCTH'NUM'TDT'ENTRIES := DCTH'NUM'TDT'ENTRIES - 1;            <<*7777>>43654000
  DCTH'SEGMENT'SIZE := DCTH'SEGMENT'SIZE + TDTABINCR;          <<*7777>>43656000
            BEGIN                                                       43658000
  MOVEDLTABLES;                                                <<*7777>>43660000
  CALC'TTF'OFFSETS;                                            <<*7777>>43662000
  END;  <<DELETE'TTDT>>                                        <<*7777>>43664000
     END  <<LISTCLASSES>>;                                              43666000
                                                                        43668000
          <<-------------------------------->>                 <<dctab>>43670000
          << REMOVE DEVICE CLASS REFERENCES >>                 <<dctab>>43672000
          <<-------------------------------->>                 <<dctab>>43674000
  PROCEDURE REMOVECLASSREFS;                                   <<dctab>>43676000
    OPTION PRIVILEGED,UNCALLABLE;                              <<dctab>>43678000
    COMMENT                                                    <<dctab>>43680000
      REMOVE REFERENCES TO LOGICAL DEVICE LDEV                 <<dctab>>43682000
      FROM DEVICE CLASS TABLE;                                 <<dctab>>43684000
      BEGIN                                                    <<dctab>>43686000
        INTEGER I:=0,        <<DEVICE CLASS NUMBER>>           <<dctab>>43688000
                J,                   <<INDEX WITHIN CLASS>>    <<dctab>>43690000
                K,           <<LOGICAL DEVICE NUMBER INDEX>>   <<dctab>>43692000
                COUNT,       <<NUMBER OF WORDS TO BE MOVED>>   <<dctab>>43694000
                LDT'INDEX;                                     <<dctab>>43696000
        INTEGER POINTER                                        <<dctab>>43698000
            DCT;                                               <<dctab>>43700000
        BYTE POINTER                                           <<dctab>>43702000
            DCT'B;                                             <<dctab>>43704000
          @DCT := @DCT'HEAD + DCTH'DCT'BASE;                   <<dctab>>43706000
          @DCT'B := @DCT & LSL(1);                             <<dctab>>43708000
          WHILE(I:=I+1) <= DCTH'NUM'DCT'ENTRIES DO             <<dctab>>43710000
            BEGIN                                              <<dctab>>43712000
              J := -1;                                         <<dctab>>43714000
              WHILE (J:=J+1) < DCT'NUM'DEVICES DO              <<dctab>>43716000
              IF DCT(DCT'FIRST'LDEV + J) = LDEV THEN           <<dctab>>43718000
                BEGIN   <<IN THIS CLASS>>                      <<dctab>>43720000
                  IF DCT'NUM'DEVICES = 1 THEN                  <<dctab>>43722000
                    BEGIN  <<CLASS MUST BE REMOVED>>           <<dctab>>43724000
                      MOVE DEVCLASS:=DCTB'CLASS'NAME,(8);      <<dctab>>43726000
                                                               <<dctab>>43728000
                      << MOVE THE REST OF THE TABLE >>         <<*7778>>43730000
                      << ON TOP OF THIS ENTRY       >>         <<*7778>>43732000
                                                               <<*7778>>43734000
                      COUNT := (@DCT'HEAD + DCTH'TDT'BASE)     <<*7778>>43736000
                                     - (@DCT + DCT'NEXT'ENTRY);<<*7778>>43738000
                                                               <<*7778>>43740000
                      MOVE DCT := DCT(DCT'NEXT'ENTRY),(COUNT); <<*7778>>43742000
                      DCTABINCR := DCTABINCR - 7;              <<dctab>>43744000
                      DCTH'SEGMENT'SIZE    :=                  <<dctab>>43746000
                           DCTH'SEGMENT'SIZE - 7;              <<dctab>>43748000
                      DCTH'NUM'DCT'ENTRIES :=                  <<dctab>>43750000
                           DCTH'NUM'DCT'ENTRIES - 1;           <<dctab>>43752000
                      DCTH'TDT'BASE :=                         <<dctab>>43754000
                           DCTH'TDT'BASE - 7;                  <<dctab>>43756000
                                                               <<dctab>>43758000
                                                               <<dctab>>43760000
                      MOVEDLTABLES;                            <<tclas>>43762000
                      @DCT := @DCT + 7;                        <<tclas>>43764000
                      @DCT'B := @DCT & LSL(1);                 <<tclas>>43766000
                      << SEARCH LDT FOR CLASS   >>             <<dctab>>43768000
                                                               <<dctab>>43770000
                      K := 0;                                  <<dctab>>43772000
                      WHILE (K:=K+1)<=HLDEV DO                 <<dctab>>43774000
                        BEGIN                                  <<dctab>>43776000
                        LDT'INDEX := K * LDTSIZE;              <<dctab>>43778000
                        IF LOGICAL(LDT'CLASS'INDEX) THEN       <<dctab>>43780000
                          BEGIN <<OUTPUT DEVICE IS CLASS>>     <<dctab>>43782000
                          TOS := LDT'DFLT'OUT'DEV;    <<INDEX>><<dctab>>43784000
                          IF S0=I THEN                         <<dctab>>43786000
                            BEGIN <<OUTPT DEV IS DELETD CLAS>> <<dctab>>43788000
                            LDT'DFLT'OUT'DEV := 0;             <<dctab>>43790000
                            PUTINTEMPCLASS(DEVCLASS,K);        <<tclas>>43792000
                            END                                <<dctab>>43794000
                          ELSE IF S0>I                         <<dctab>>43796000
                            THEN LDT'DFLT'OUT'DEV := S0-1;     <<dctab>>43798000
                          DEL;                                 <<dctab>>43800000
                          END;                                 <<dctab>>43802000
                      END;                                     <<dctab>>43804000
                      I := I-1;  <<ONE LESS CLASS>>            <<dctab>>43806000
                      GOTO NEXTCL;                             <<dctab>>43808000
                    END                                        <<dctab>>43810000
                  ELSE                                         <<dctab>>43812000
                    BEGIN                                      <<dctab>>43814000
                                                               <<dctab>>43816000
                    << REMOVE LDEV FROM CLASS               >> <<dctab>>43818000
                    << BY MOVING REST OF THIS CLASS OVER IT >> <<dctab>>43820000
                                                               <<dctab>>43822000
                    COUNT := DCT'NUM'DEVICES - (J + 1);        <<dctab>>43824000
                                                               <<dctab>>43826000
                      MOVE DCT(DCT'FIRST'LDEV + J) :=          <<dctab>>43828000
                           DCT(DCT'FIRST'LDEV + J + 1),        <<dctab>>43830000
                           (COUNT);                            <<dctab>>43832000
                                                               <<dctab>>43834000
                    << NOW MOVE THE REST OF THE TABLE >>       <<dctab>>43836000
                                                               <<dctab>>43838000
                      COUNT := (@DCT'HEAD + DCTH'TDT'BASE)     <<*7777>>43840000
                                     - (@DCT + DCT'NEXT'ENTRY);<<*7777>>43842000
                      MOVE DCT(DCT'NEXT'ENTRY - 1) :=          <<dctab>>43844000
                           DCT(DCT'NEXT'ENTRY),(COUNT);        <<dctab>>43846000
                                                               <<dctab>>43848000
                      DCT'CYCLICAL'PTR := 1;                   <<dctab>>43850000
                      DCTABINCR := DCTABINCR - 1;              <<dctab>>43852000
                      DCT'NUM'DEVICES := DCT'NUM'DEVICES - 1;  <<dctab>>43854000
                      DCTH'SEGMENT'SIZE :=                     <<dctab>>43856000
                                 DCTH'SEGMENT'SIZE -1;         <<dctab>>43858000
                      DCTH'TDT'BASE := DCTH'TDT'BASE - 1;      <<dctab>>43860000
                      MOVEDLTABLES;                            <<tclas>>43862000
                      @DCT := @DCT + 1;                        <<tclas>>43864000
                      @DCT'B := @DCT & LSL(1);                 <<tclas>>43866000
                      J := J-1;                                <<dctab>>43868000
                    END;                                       <<dctab>>43870000
                END;                                           <<dctab>>43872000
              @DCT := @DCT + DCT'NEXT'ENTRY;                   <<dctab>>43874000
              @DCT'B := @DCT & LSL(1);                         <<dctab>>43876000
  NEXTCL:   END;                                               <<dctab>>43878000
      END <<REMOVECLASSREFS>> ;                                <<dctab>>43880000
   <<--------------                                                     43882000
     DELETE CLASS                                              <C0.00   43884000
   -------------->>                                                     43886000
   INTEGER PROCEDURE DELETECLASS(ERRLABEL);                             43888000
       VALUE ERRLABEL;                                                  43890000
       INTEGER ERRLABEL;                                                43892000
       BEGIN                                                            43894000
        INTEGER ARRAY ERR(0:13);                                        43896000
        BYTE ARRAY BERR(*)=ERR;                                         43898000
  INTEGER I, ENTRY'SIZE, COUNT;                                <<dctab>>43900000
                                                               <<dctab>>43902000
  LOGICAL FOUND;                                               <<dctab>>43904000
  INTEGER POINTER                                              <<dctab>>43906000
      DCT;                                                     <<dctab>>43908000
  BYTE POINTER                                                 <<dctab>>43910000
      DCT'B;                                                   <<dctab>>43912000
                                                               <<dctab>>43914000
  I := 0;                                                      <<dctab>>43916000
  FOUND := FALSE;                                              <<dctab>>43918000
  @DCT := @DCT'HEAD + DCTH'DCT'BASE;                           <<dctab>>43920000
  @DCT'B := @DCT & LSL(1);                                     <<dctab>>43922000
  WHILE (I:=I+1) <= DCTH'NUM'DCT'ENTRIES AND NOT FOUND DO      <<dctab>>43924000
    IF DCTB'CLASS'NAME = DEVCLASS,(8) THEN                     <<dctab>>43926000
      BEGIN                                                    <<dctab>>43928000
      FOUND := TRUE;                                           <<dctab>>43930000
      DELETECLASS := I;                                        <<dctab>>43932000
      END                                                      <<dctab>>43934000
    ELSE                                                       <<dctab>>43936000
      BEGIN                                                    <<dctab>>43938000
      @DCT := @DCT + DCT'NEXT'ENTRY;                           <<dctab>>43940000
      @DCT'B := @DCT & LSL(1);                                 <<dctab>>43942000
      END;                                                     <<dctab>>43944000
  IF FOUND THEN                                                <<dctab>>43946000
    BEGIN                                                      <<dctab>>43948000
    << MUST COMPACT TABLE >>                                   <<dctab>>43950000
    ENTRY'SIZE := DCT'NEXT'ENTRY;                              <<dctab>>43952000
    COUNT := (@DCT'HEAD + DCTH'TDT'BASE)                       <<*7777>>43954000
             - (@DCT + DCT'NEXT'ENTRY);                        <<dctab>>43956000
    MOVE DCT := DCT(DCT'NEXT'ENTRY),(COUNT);                   <<dctab>>43958000
    DCTH'SEGMENT'SIZE := DCTH'SEGMENT'SIZE - ENTRY'SIZE;       <<dctab>>43960000
    DCTH'NUM'DCT'ENTRIES := DCTH'NUM'DCT'ENTRIES - 1;          <<dctab>>43962000
    DCTH'TDT'BASE := DCTH'TDT'BASE - ENTRY'SIZE;               <<dctab>>43964000
    DCTABINCR := -ENTRY'SIZE;                                  <<dctab>>43966000
    MOVEDLTABLES;                                              <<dctab>>43968000
    END                                                        <<dctab>>43970000
  ELSE                                                         <<dctab>>43972000
    BEGIN                                                      <<dctab>>43974000
    << NOT FOUND >>                                            <<dctab>>43976000
    MOVE BERR := "CLASS ",2;                                   <<dctab>>43978000
    MOVE *    := DEVCLASS,(8),2;                               <<dctab>>43980000
    MOVE *    := " DOESN'T EXIST";                             <<dctab>>43982000
    PRINT( ERR, -28, 0);                                       <<dctab>>43984000
    RETURNP := ERRLABEL;                                       <<dctab>>43986000
    ASSEMBLE( EXIT 2);                                         <<dctab>>43988000
    END;                                                       <<dctab>>43990000
  END;  << DELETECLASS >>                                      <<dctab>>43992000
                                                               <<dctab>>43994000
                                                                        43996000
   <<--------------------                                               43998000
     DETERMINE CLASS TYPE                                      <C0.00   44000000
   -------------------->>                                               44002000
                                                                        44004000
   PROCEDURE DETERMCTYP(ERRLABEL,DCT,ASKIO);                   <<dctab>>44006000
     VALUE ERRLABEL,DCT,ASKIO;                                 <<dctab>>44008000
     INTEGER ERRLABEL;                                         <<dctab>>44010000
     INTEGER POINTER DCT;                                      <<dctab>>44012000
     LOGICAL ASKIO;                                            <<dctab>>44014000
        BEGIN                                                  <<dctab>>44016000
        <<THIS PROCEDURE DETERMINES THE TYPE OF THE CLASS >>   <<dctab>>44018000
        <<TO WHICH DCT POINTS TO IN DCTAB.  DCT  POINTS  >>    <<dctab>>44020000
        << TO THE CLASS NAME.                              >>  <<dctab>>44022000
       SWITCH SW:=CER,DAC,SIP,CER,CIO,CER,SIP,CER,NCIO,CER,SIP,<<dctab>>44024000
                  CER,NCIO,CER,SIP,CER,SOU,CER,CER,CER,SOU,CER,<<dctab>>44026000
                  CER,CER,SOU,CER,CER,CER,SOU,CER,CER,CER,CER; <<dctab>>44028000
        INTEGER I,J,L,N,TEMP,DTYP,DRANGE,TYPE,SUBTYP,          <<dctab>>44030000
                CURRENT'CLASS'ACCESS'TYPE,                     <<dctab>>44032000
                LDT'INDEX,                                     <<dctab>>44034000
                LPDT'INDEX;                                    <<dctab>>44036000
        BYTE POINTER                                           <<dctab>>44038000
            DCT'B;                                             <<dctab>>44040000
        BYTE ARRAY MESSAGE'BUFFER(0:8);                        <<dctab>>44042000
        LOGICAL ALLSAME:=TRUE;                                 <<dctab>>44044000
        LOGICAL ALL'SAME'RANGE:= TRUE;                         <<dctab>>44046000
        LOGICAL CANBESERIAL:=TRUE;                             <<dctab>>44048000
          N := DCT'NUM'DEVICES;                                <<dctab>>44050000
          I := -1;                                             <<dctab>>44052000
          TEMP := 0;                                           <<dctab>>44054000
          CURRENT'CLASS'ACCESS'TYPE:= DCT'CLASS'ACC'TYPE;      <<dctab>>44056000
          LDT'INDEX := DCT(DCT'FIRST'LDEV) * LDTSIZE;          <<dctab>>44058000
          DTYP := LDT'DEVICE'TYPE;<<TYPE OF FIRST DEVICE>>     <<dctab>>44060000
          DRANGE :=LDT'ACCESS'TYPE;                            <<dctab>>44062000
          WHILE (I:=I+1) < DCT'NUM'DEVICES DO                  <<dctab>>44064000
            BEGIN                                              <<dctab>>44066000
            LDT'INDEX := DCT(DCT'FIRST'LDEV + I) * LDTSIZE;    <<dctab>>44068000
            LPDT'INDEX := DCT(DCT'FIRST'LDEV + I) * LPDTSIZE;  <<dctab>>44070000
            TYPE := LDT'DEVICE'TYPE;                           <<dctab>>44072000
            SUBTYP := LPDT'SUBTYPE;                            <<dctab>>44074000
            IF DTYP <> LDT'DEVICE'TYPE                         <<dctab>>44076000
              THEN ALLSAME := FALSE;                           <<dctab>>44078000
            IF DRANGE <> LDT'ACCESS'TYPE                       <<dctab>>44080000
              THEN ALL'SAME'RANGE:= FALSE;                     <<dctab>>44082000
            CASE LDT'ACCESS'TYPE OF                            <<dctab>>44084000
             BEGIN                                             <<dctab>>44086000
             BEGIN                                             <<dctab>>44088000
             TEMP.DIRACC:=1;                                   <<dctab>>44090000
             IF NOT SDISC'TYPE(TYPE,SUBTYP) THEN               <<dctab>>44092000
                CANBESERIAL:=FALSE;                            <<dctab>>44094000
             END;                                              <<dctab>>44096000
             TEMP.SERINP:=1;                                   <<dctab>>44098000
             TEMP.CONIO :=1;                                   <<dctab>>44100000
             TEMP.NCONIO:=1;                                   <<dctab>>44102000
             TEMP.SEROUT:=1;                                   <<dctab>>44104000
             END;                                              <<dctab>>44106000
            END;                                               <<dctab>>44108000
          GO SW(TEMP);                                         <<dctab>>44110000
   DAC:   IF CURRENT'CLASS'ACCESS'TYPE<>31 << SDISC >> AND     <<dctab>>44112000
             CURRENT'CLASS'ACCESS'TYPE<>7 << FDISC >> THEN     <<dctab>>44114000
          IF ALLSAME THEN DCT'CLASS'ACC'TYPE := DTYP           <<dctab>>44116000
          ELSE DCT'CLASS'ACC'TYPE := 0;  << DIRECT ACCESS >>   <<dctab>>44118000
          IF CANBESERIAL AND ASKIO THEN                        <<dctab>>44120000
            IF LGETYESNO(M2327) THEN   <<SERIAL DISC CLASS>>   <<dctab>>44122000
              DCT'CLASS'ACC'TYPE := 31 << SERIAL DISC >>       <<dctab>>44124000
            ELSE IF LGETYESNO(M2334) THEN<<FOREIGN DISC CLASS>><<dctab>>44126000
              DCT'CLASS'ACC'TYPE := 7; << FOREIGN DISC >>      <<dctab>>44128000
          RETURN;                                              <<dctab>>44130000
   SIP:   IF ALLSAME THEN DCT'CLASS'ACC'TYPE:=DTYP             <<dctab>>44132000
          ELSE IF ALL'SAME'RANGE OR ASKIO THEN                 <<dctab>>44134000
                 DCT'CLASS'ACC'TYPE:=1 << SERIAL'IN >> &LSL(3);<<dctab>>44136000
          RETURN;                                              <<dctab>>44138000
   CIO:   IF ASKIO THEN                                        <<dctab>>44140000
            BEGIN                                              <<dctab>>44142000
            DCT'CLASS'ACC'TYPE:= 2 << IO'CONCURRENT >> &LSL(3);<<dctab>>44144000
            GO PROMPT;                                         <<dctab>>44146000
            END;                                               <<dctab>>44148000
          IF CURRENT'CLASS'ACCESS'TYPE.(13:3)<>0 THEN          <<dctab>>44150000
            DCT'CLASS'ACC'TYPE:=2 << IO'CONCURRENT >> &LSL(3); <<dctab>>44152000
          RETURN;                                              <<dctab>>44154000
   NCIO:  DCT'CLASS'ACC'TYPE := 3 << IO'NONCONCUR >> &LSL(3);  <<dctab>>44156000
          IF ASKIO THEN GO PROMPT ELSE RETURN;                 <<dctab>>44158000
   SOU:   IF ALLSAME THEN DCT'CLASS'ACC'TYPE:=DTYP             <<dctab>>44160000
          ELSE IF ALL'SAME'RANGE OR ASKIO THEN                 <<dctab>>44162000
                 DCT'CLASS'ACC'TYPE:=4 <<SERIAL'OUT>> &LSL(3); <<dctab>>44164000
          RETURN;                                              <<dctab>>44166000
   CER:                                                        <<dctab>>44168000
          IF ALLSAME THEN                                      <<dctab>>44170000
             DCT'CLASS'ACC'TYPE := DTYP                        <<dctab>>44172000
          ELSE IF ASKIO THEN                                   <<dctab>>44174000
             BEGIN                                             <<dctab>>44176000
             MESSAGE'BUFFER(0) := " ";                         <<dctab>>44178000
             MOVE MESSAGE'BUFFER(1) := MESSAGE'BUFFER,(9);     <<dctab>>44180000
             MESSAGE'BUFFER :=                                 <<dctab>>44182000
                MOVEAN(MESSAGE'BUFFER(1),DEVCLASS,8);          <<dctab>>44184000
             MESSAGE(M123,,,,,MESSAGE'BUFFER);                 <<dctab>>44186000
             RETURNP := ERRLABEL;                              <<dctab>>44188000
             END;                                              <<dctab>>44190000
          RETURN;                                              <<dctab>>44192000
   PROMPT:MESSAGE(-M2350);                                     <<dctab>>44194000
          READINPUT;                                           <<dctab>>44196000
          M := GETSTR(BTYP,@PROMPT,1,6,"/");                   <<dctab>>44198000
          IF BTYP="IN    "                                     <<dctab>>44200000
            THEN DCT'CLASS'ACC'TYPE:=1 << SERIAL'IN >> &LSL(3) <<dctab>>44202000
          ELSE IF BTYP="OUT   "                                <<dctab>>44204000
            THEN DCT'CLASS'ACC'TYPE:=4 << SERIAL'OUT >> &LSL(3)<<dctab>>44206000
               ELSE IF BTYP<>"IN/OUT" AND BTYP<>"IO    " THEN  <<dctab>>44208000
                      BEGIN                                    <<dctab>>44210000
                      MESSAGE(M2453);                          <<dctab>>44212000
                      GO PROMPT;                               <<dctab>>44214000
                      END;                                     <<dctab>>44216000
          IF DCT'ACCESS'TYPE = 2 << IO'CONCURRENT >> THEN      <<dctab>>44218000
            BEGIN                                              <<dctab>>44220000
   NORNC:   MESSAGE(-M2351);                                   <<dctab>>44222000
            READINPUT;                                         <<dctab>>44224000
            GETSTR(BTYP,@NORNC,1,2);                           <<dctab>>44226000
            IF BTYP="NC"                                       <<dctab>>44228000
              THEN DCT'CLASS'ACC'TYPE:=3 <<NONCONCUR>> &LSL(3) <<dctab>>44230000
            ELSE IF BTYP<>"C " AND BTYP<>"CO" THEN             <<dctab>>44232000
                   BEGIN                                       <<dctab>>44234000
                   MESSAGE(M2453);                             <<dctab>>44236000
                   GO NORNC;                                   <<dctab>>44238000
                   END;                                        <<dctab>>44240000
            END;                                               <<dctab>>44242000
          END  <<DETERMCTYP>>;                                 <<dctab>>44244000
$CONTROL SEGMENT=MAINSEG1                                               44246000
                                                                        44248000
          <<--------------------------                                  44250000
            CHECK DEVICE CONSISTENCY                           <C0.00   44252000
          -------------------------->>                                  44254000
  PROCEDURE CHECKDEV(ERRLABEL);                                         44256000
    VALUE ERRLABEL;                                                     44258000
    INTEGER ERRLABEL;   <<ERROR RETURN>>                                44260000
    COMMENT                                                             44262000
      CHECK DEVICE TABLES FOR NON-EXISTENT OUTPUT DEVICES, DUPLICATELY  44264000
    DEFINED DRT-UNIT COMBINATIONS, AND DEVICE CLASSES WITH BOTH SHARABLE44266000
    AND NON-SHARABLE DEVICES. IF ANY OF THESE CONDITIONS ARE FOUND,     44268000
    PRINT A MESSAGE AND EXIT TO ERRLABEL;                               44270000
      BEGIN                                                             44272000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>44274000
        EQUATE CONSOLEDRT  = 7,                                <<*DVR*>>44276000
               CONSOLEUNIT = 0;                                <<*DVR*>>44278000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>44280000
        EQUATE CONSOLEDRT  = 8,                                <<*DVR*>>44282000
               CONSOLEUNIT = 0;                                <<*DVR*>>44284000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>44286000
        EQUATE SDISC=31;<<CLASS ACCESS TYPE FOR SERIAL DISCS>> <<SD.00>>44288000
        EQUATE TERMDEVTYPE = 16; << TERMINAL DEVICE TYPE >>             44290000
        EQUATE FDISC=7;<<FOREIGN DISC CLASS ACCESS TYPE>>      <<01115>>44292000
        INTEGER LDEVRANGE,DTYP,TYPE,TYPE2,SUBTYP,BOARD,       <<driv2>> 44294000
                SUBTYP2;                                                44296000
        LOGICAL TERMERROR;                                     <<03004>>44298000
        LOGICAL ALLSAME;                                                44300000
        INTEGER I,J,K,N,INDEX,LDEV:=0;                         <<I8884>>44302000
       BYTE ARRAY CLASSNAME(0:9);                              <<01103>>44304000
        LOGICAL ERRORS:=FALSE,TOOBIGDRT:=FALSE;                         44306000
        LOGICAL OLDBIGDRT := FALSE;  <<DRT > CPU SUPPORTS>>    <<03002>>44308000
        LOGICAL BIGUSERMAXDRT := FALSE; <<USER MAX > CPU>>     <<03002>>44310000
        LOGICAL DISCFOUND := FALSE;                                     44312000
        LOGICAL VALIDDRIVERS := FALSE;                         <<d9067>>44314000
        LOGICAL ROCL;  << RETURN FROM STARFISH ROLL CALL >>    <<02707>>44316000
        INTEGER LEN1,LEN2;                                     <<*DVR*>>44318000
        INTEGER UNITN;                                         <<actyp>>44320000
        INTEGER                                                <<*LDT*>>44322000
            LDT'INDEX,                                         <<*DVR*>>44324000
            LPDT'INDEX,                                        <<*LDTX>>44326000
            LDTX'INDEX,                                        <<*DVR*>>44328000
            DVR'INDEX;                                         <<*DVR*>>44330000
        INTEGER POINTER                                        <<dctab>>44332000
            DCT;                                               <<dctab>>44334000
        BYTE POINTER                                           <<dctab>>44336000
            DCT'B;                                             <<dctab>>44338000
                                                               <<d9020>>44340000
        INTEGER ARRAY DVR'NAME(0:3);                           <<d9020>>44342000
                                                               <<01103>>44344000
      SUBROUTINE MOVECLASS;                                    <<01103>>44346000
      BEGIN                                                    <<01103>>44348000
      CLASSNAME := MOVEAN(CLASSNAME(1),DCTB'CLASS'NAME,8);     <<dctab>>44350000
      END;                                                     <<01103>>44352000
                                                               <<01103>>44354000
          NDISCDEV := 0;                                                44356000
          COLDLOADLDEV := 0;                                   <<I8884>>44358000
          CONSOLELDEV := 0;                                             44360000
          WHILE (LDEV:=LDEV+1) <= HLDEV DO                              44362000
           BEGIN                                                        44364000
           DVR'INDEX := LDEV * DVRSIZE;                        <<*DVR*>>44366000
           IF DVRDRTNUM <> 0 AND                               <<*DVR*>>44368000
              DVRDSBIT = 0 THEN                                <<*DVR*>>44370000
             BEGIN <<NON-DS DEVICE>>                                    44372000
              IF DVRDRTNUM > COMM(DRTNUM)                      <<CONFD>>44374000
              THEN TOOBIGDRT:=TRUE;                            <<03002>>44376000
              IF DVRDRTNUM > MAXDRT  <<CANT SUPPORT>>          <<*DVR*>>44378000
              THEN OLDBIGDRT := TRUE;                          <<03002>>44380000
              IF COMM(DRTNUM) > MAXDRT  <<USER CHOSEN MAX>>    <<CONFD>>44382000
              THEN BIGUSERMAXDRT := TRUE;<<IS > CPU MAX>>      <<03002>>44384000
                                                               <<02707>>44386000
              << IF THERE'S A STARFISH ON THE SYSTEM, DON'T >> <<02707>>44388000
              << ALLOW DRTS 125-127.  THESE ARE USED FOR    >> <<02707>>44390000
              << STARFISH'S MAILBOX.                        >> <<02707>>44392000
              IF STARFISH THEN                                 <<02707>>44394000
                 IF 125 <= DVRDRTNUM <= 127 THEN               <<*DVR*>>44396000
                    BEGIN                                      <<02707>>44398000
                    MESSAGE( M135, LDEV);                      <<02707>>44400000
                    ERRORS := TRUE;                            <<02707>>44402000
                    END;                                       <<02707>>44404000
                                                               <<02707>>44406000
              LDT'INDEX := LDEV * LDTSIZE;                     <<*LDT*>>44408000
              LPDT'INDEX := LDEV * LPDTSIZE;                   <<depen>>44410000
              TYPE := LDT'DEVICE'TYPE;                         <<*LDT*>>44412000
              SUBTYP := LPDT'SUBTYPE;                          <<*LPDT>>44414000
              DRTN := DVRDRTNUM;                               <<*DVR*>>44416000
              UNITN := DVRUNITNUM;                             <<*DVR*>>44418000
              MOVE DVR'NAME := DVRNAME, (4);                   <<d9020>>44420000
              I := LDT'DFLT'OUT'DEV;     <<OUTPUT DEVICE>>     <<*LDT*>>44422000
                                                               <<01103>>44424000
              IF LDEV > 255 AND 0 <= TYPE <= 7 THEN            <<LIMIT>>44426000
                 BEGIN                                         <<LIMIT>>44428000
                 MESSAGE( M137, 255);                          <<LIMIT>>44430000
                 ERRORS := TRUE;                               <<LIMIT>>44432000
                 END;                                          <<LIMIT>>44434000
                                                               <<LIMIT>>44436000
              IF DRTN = CONSOLEDRT AND UNITN = CONSOLEUNIT     <<*DVR*>>44438000
                AND TYPE = 16 << TERMINAL >>                   <<*DVR*>>44440000
                THEN CONSOLELDEV := LDEV;                               44442000
              IF DRTN = SYSTAPEDRT AND UNITN = SYSTAPEUNIT     <<*DVR*>>44444000
              AND (SDISC'TYPE(TYPE,SUBTYP) LOR                 <<*DVR*>>44446000
               TYPE = 24 << MAG TAPE >>) THEN                  <<*LDT*>>44448000
                 COLDLOADLDEV:=LDEV;                           <<00888>>44450000
              IF LOGICAL(LPDT'JOB'ACCEPT) AND I=0 THEN         <<*LPDT>>44452000
                 << NO OUTPUT DEVICE FOR LOGICAL DEVICE n >>   <<01103>>44454000
                 BEGIN                                         <<01103>>44456000
                 MESSAGE( M116, LDEV);                         <<01103>>44458000
                 ERRORS := TRUE;                               <<01103>>44460000
                 END;                                          <<01103>>44462000
              IF LOGICAL(LDT'CLASS'INDEX) THEN                 <<*LDT*>>44464000
                BEGIN   <<OUTPUT DEVICE IS CLASS INDEX>>                44466000
                  IF I=0 THEN                                           44468000
                     << OUTPUT CLASS FOR DEVICE n NO LONGER EXITS >>    44470000
                     BEGIN                                     <<01103>>44472000
                     MESSAGE( M117, LDEV);                     <<01103>>44474000
                     ERRORS := TRUE;                           <<01103>>44476000
                     END                                       <<01103>>44478000
                  ELSE                                                  44480000
                  BEGIN                                                 44482000
                   @DCT := @DCT'HEAD + DCTH'DCT'BASE;          <<dctab>>44484000
                   J := 0;                                     <<dctab>>44486000
                   WHILE (J:=J+1)<I DO                                  44488000
                     @DCT := @DCT + DCT'NEXT'ENTRY;            <<dctab>>44490000
                  LDT'INDEX :=                                 <<*LDT*>>44492000
                    DCT(DCT'FIRST'LDEV) * LDTSIZE;             <<dctab>>44494000
                  I := LDT'DEVICE'TYPE;                        <<*LDT*>>44496000
                  IF (0<=I<=15) OR (24<=I<=31) THEN                     44498000
                     << DEVICE CLASS xxxxxxxx CAN NOT BE >>    <<01103>>44500000
                     << OUTPUT DEVICE                   >>     <<01103>>44502000
                     BEGIN                                     <<01103>>44504000
                     MOVECLASS;                                <<01103>>44506000
                     MESSAGE( M118,,,,,CLASSNAME);             <<01103>>44508000
                     ERRORS := TRUE;                           <<01103>>44510000
                     END;                                      <<01103>>44512000
                 END;                                                   44514000
                END                                                     44516000
              ELSE IF I <> 0 THEN                                       44518000
                BEGIN                                          <<*DVR*>>44520000
                DVR'INDEX := I * DVRSIZE;                      <<*DVR*>>44522000
                IF DVRDRTNUM = 0 THEN                          <<*DVR*>>44524000
                  << LOGICAL DEVICE n DOES NOT EXIST >>        <<01103>>44526000
                  BEGIN                                        <<01103>>44528000
                  MESSAGE( M120, I);                           <<01103>>44530000
                  ERRORS := TRUE;                              <<01103>>44532000
                  END                                          <<01103>>44534000
                ELSE                                           <<*DVR*>>44536000
                  BEGIN                                        <<*DVR*>>44538000
                  LDT'INDEX := I * LDTSIZE;                    <<*DVR*>>44540000
                  INDEX := LDT'DEVICE'TYPE;                    <<*DVR*>>44542000
                  IF (0<=INDEX<=15) OR (24<=INDEX<=31) THEN    <<*DVR*>>44544000
                  << LOGICAL DEVICE n CAN NOT BE OUTPUT DEVICE >>       44546000
                    BEGIN                                      <<*DVR*>>44548000
                    MESSAGE( M119, I);                         <<*DVR*>>44550000
                    ERRORS := TRUE;                            <<*DVR*>>44552000
                    END;                                       <<*DVR*>>44554000
                  END;                                         <<*DVR*>>44556000
                END;                                           <<*DVR*>>44558000
              INDEX := LDEV;                                            44560000
              WHILE (INDEX:=INDEX+1) <= HLDEV DO                        44562000
              BEGIN                                            <<*LDT*>>44564000
              LDT'INDEX := INDEX * LDTSIZE;                    <<*LDT*>>44566000
              DVR'INDEX := INDEX * DVRSIZE;                    <<*DVR*>>44568000
              LPDT'INDEX := INDEX * LPDTSIZE;                           44570000
              IF DVRDRTNUM = DRTN AND DVRUNITNUM = UNITN THEN  <<*DVR*>>44572000
                BEGIN   << TWO DEVICES ON SAME DRT,UNIT >>     <<03004>>44574000
                TYPE2 := LDT'DEVICE'TYPE;                      <<*LDT*>>44576000
                                                               <<03004>>44578000
                       << NOT BOTH CS DEVICES >>               <<03004>>44580000
                IF NOT ( CSDEV17<= TYPE <= CSDEV19 LAND        <<03004>>44582000
                         CSDEV17<= TYPE2<= CSDEV19)            <<03004>>44584000
                                                               <<03004>>44586000
$IF X1=ON  << ********** SERIES 33,44,55 UNIQUE *********** >> <<03004>>44588000
                   AND                                         <<03004>>44590000
                       << NOT BOTH TERMINALS >>                <<03004>>44592000
                   NOT ( TYPE = 16 << TERMINAL >> LAND         <<*LDT*>>44594000
                         TYPE2 = 16 << TERMINAL >>)            <<*LDT*>>44596000
                                                               <<03004>>44598000
$IF        << ********* RETURNING TO COMMON CODE ********** >> <<03004>>44600000
                   AND                                         <<03004>>44602000
                       << NOT BOTH DISCS >>                    <<03004>>44604000
                   NOT( TYPE&LSR(3)   = DIRACCESS LAND         <<03004>>44606000
                        TYPE2&LSR(3)  = DIRACCESS )            <<03004>>44608000
                                                               <<03004>>44610000
                   THEN                                        <<03004>>44612000
                   BEGIN                                       <<03004>>44614000
                   << ERROR: MORE THAN 1 DEVICE ON  >>         <<03004>>44616000
                   << THE SAME DRT AND UNIT         >>         <<03004>>44618000
                   MESSAGE( M121, LDEV, INDEX);                <<03004>>44620000
                   ERRORS := TRUE;                             <<03004>>44622000
                   END;                                        <<03004>>44624000
                END;                                           <<03004>>44626000
              IF DVRDRTNUM = DRTN AND                          <<d9020>>44628000
                 NOT COMPARE'WORDS(DVRNAME, DVR'NAME, 4)       <<d9020>>44630000
                 THEN BEGIN                                    <<d9020>>44632000
                 TYPE2 := LDT'DEVICE'TYPE;                     <<d9020>>44634000
                                                               <<d9020>>44636000
                      << NOT BOTH CS DEVICES >>                <<d9020>>44638000
                                                               <<d9020>>44640000
                 SUBTYP2 := LPDT'SUBTYPE;                      <<d9067>>44642000
                                                               <<d9020>>44644000
                 IF  CSDEV17<= TYPE <= CSDEV19  AND            <<d9067>>44646000
                     CSDEV17<= TYPE2<= CSDEV19                 <<d9067>>44648000
                     THEN VALIDDRIVERS := TRUE                 <<d9067>>44650000
                                                               <<d9067>>44652000
                 ELSE IF TYPE = TERMDEVTYPE THEN               <<d9067>>44654000
                      BEGIN                                    <<d9067>>44656000
                      IF TYPE2 = TERMDEVTYPE  OR               <<d9067>>44658000
                         RS232'PRINTER(TYPE2,SUBTYP2)          <<d9067>>44660000
                                                               <<d9067>>44662000
                         THEN VALIDDRIVERS := TRUE;            <<d9067>>44664000
                      END                                      <<d9067>>44666000
                 ELSE IF RS232'PRINTER(TYPE,SUBTYP) THEN       <<d9067>>44668000
                      BEGIN                                    <<d9067>>44670000
                      IF TYPE2 = TERMDEVTYPE OR                <<d9067>>44672000
                         RS232'PRINTER(TYPE2, SUBTYP2)         <<d9067>>44674000
                         THEN VALIDDRIVERS := TRUE;            <<d9067>>44676000
                      END                                      <<d9067>>44678000
                 ELSE BEGIN                                    <<d9067>>44680000
                    <<--------------------------------->>      <<d9020>>44682000
                    << ERROR: MORE THAN 1 DEVICE WITH  >>      <<d9020>>44684000
                    << DIFFERENT DRIVERS ON SAME DRT#  >>      <<d9020>>44686000
                    <<--------------------------------->>      <<d9020>>44688000
                    MESSAGE(M127, DRTN);                       <<d9020>>44690000
                    ERRORS := TRUE;                            <<d9020>>44692000
                    END;                                       <<d9020>>44694000
                  END;                                         <<d9020>>44696000
             END;                                              <<*LDT*>>44698000
$IF X1=ON  << ********** SERIES 33,44,55 UNIQUE *********** >> <<03004>>44700000
              << DO CHECKS FOR ALL TERMINAL DEVICES ( BUT >>   <<03004>>44702000
              << NOT MULTI-POINT )                        >>   <<03004>>44704000
              IF TYPE = 16 << TERMINAL >> OR                   <<*LDT*>>44706000
                 TYPE = 32 << PRINTER >> AND                   <<*LDT*>>44708000
                 (SUBTYP=14 OR SUBTYP=15) THEN                 <<*LDT*>>44710000
                 BEGIN   << CHECK TERMINALS >>                 <<03004>>44712000
                 LDTX'INDEX := LDEV * LDTXSIZE;                <<*LDTX>>44714000
                 << GET THE BOARD TYPE FOR THIS TERMINAL >>    <<03004>>44716000
                 BOARD := GETBOARDTYPE( DRTN);                 <<*DVR*>>44718000
                 LDTX(LDTX'INDEX+2) := BOARD;                  <<LYNX.>>44720000
                 IF BOARD = LYNX'BOARD OR BOARD = ADCC'MAIN OR <<SYPTR>>44722000
                    BOARD = ADCC'EXT OR BOARD = TIC'BOARD THEN <<08392>>44724000
                 ELSE IF BOARD < 0 THEN                        <<03004>>44726000
                    BEGIN   << BOARD DOES NOT RESPOND >>       <<03004>>44728000
                    MESSAGE(M132, LDEV, DRTN);                 <<*DVR*>>44730000
                    ERRORS := TRUE;                            <<03004>>44732000
                    END                                        <<03004>>44734000
                 ELSE                                          <<03004>>44736000
                    BEGIN  << WRONG BOARD FOR TERMINAL >>      <<03004>>44738000
                    MESSAGE(M133, LDEV, DRTN);                 <<*DVR*>>44740000
                    ERRORS := TRUE;                            <<03004>>44742000
                    END;                                       <<03004>>44744000
                 IF BOARD = ADCC'MAIN OR                       <<SYPTR>>44746000
                    BOARD = ADCC'EXT THEN                      <<SYPTR>>44748000
                    BEGIN   << DO CHECKS FOR ADCC TERMS.  >>   <<03004>>44750000
                    LDTX'TERMID := BOARD;                      <<SYPTR>>44752000
                    IF LDTX'BAUD'RATE'CODE > 15 THEN           <<*LDTX>>44754000
                       BEGIN  <<SPEED NOT SUPPORTED BY ADCC>>  <<03004>>44756000
                       MESSAGE( M131, LDEV);                   <<03004>>44758000
                       ERRORS := TRUE;                         <<03004>>44760000
                       END;                                    <<03004>>44762000
                    IF UNITN <> 0 THEN                         <<*DVR*>>44764000
                       BEGIN <<ADCC TERMS. MUST BE UNIT 0>>    <<03004>>44766000
                       MESSAGE( M112, LDEV);                   <<03004>>44768000
                       ERRORS := TRUE;                         <<03004>>44770000
                       END;                                    <<03004>>44772000
                    INDEX := 0;                                <<03004>>44774000
                    TERMERROR := FALSE;                        <<03004>>44776000
                    WHILE (INDEX := INDEX+1) <= HLDEV DO       <<03004>>44778000
                      BEGIN                                    <<*DVR*>>44780000
                      DVR'INDEX := INDEX * DVRSIZE;            <<*DVR*>>44782000
                      IF DVRDRTNUM = DRTN                      <<*DVR*>>44784000
                        AND INDEX <> LDEV THEN                 <<*DVR*>>44786000
                        BEGIN  << 2 TERMS. ON SAME DRT >>      <<03004>>44788000
                        TERMERROR := TRUE;                     <<03004>>44790000
                        ERRORS := TRUE;                        <<03004>>44792000
                        END;                                   <<03004>>44794000
                      END;                                     <<*DVR*>>44796000
                    << TERMINAL DRT MUST BE UNIQUE >>          <<03004>>44798000
                    IF TERMERROR THEN MESSAGE( M113, LDEV);    <<03004>>44800000
                    END;                                       <<03004>>44802000
                 IF BOARD = LYNX'BOARD OR                      <<08392>>44804000
                    BOARD = TIC'BOARD THEN                     <<08392>>44806000
                    BEGIN   << LYNX TERMS. MUST BE ON >>       <<03004>>44808000
                            << DEVICE 0               >>       <<03004>>44810000
                    LDTX'TERMID := BOARD;                      <<SYPTR>>44812000
                    IF (LOGICAL(DRTN) LAND %7)                 <<*DVR*>>44814000
                       <> 0 THEN                               <<03004>>44816000
                       BEGIN                                   <<03004>>44818000
                       MESSAGE( M134, LDEV,                    <<03004>>44820000
                        (LOGICAL(DRTN) LAND %770));            <<*DVR*>>44822000
                       ERRORS := TRUE;                         <<03004>>44824000
                       END;                                    <<03004>>44826000
                    END;                                       <<03004>>44828000
                 END;                                          <<03004>>44830000
$IF        << ********** RETURNING TO COMMON CODE ********* >> <<03004>>44832000
            END;                                                        44834000
           END;                                                         44836000
          @DCT := @DCT'HEAD + DCTH'DCT'BASE;                   <<dctab>>44838000
          @DCT'B := @DCT &LSL(1);                              <<dctab>>44840000
          I := 0;                                                       44842000
          WHILE (I:=I+1) <= DCTH'NUM'DCT'ENTRIES DO            <<dctab>>44844000
            BEGIN    <<SEARCH DEVICE CLASS TABLE>>                      44846000
              IF DCTB'CLASS'NAME = "DISC    " THEN             <<dctab>>44848000
                BEGIN                                                   44850000
                  NDISCDEV := DCT'NUM'DEVICES;                 <<dctab>>44852000
                  DISCLASS'X := @DCT - @DCTAB;                 <<DCLAS>>44854000
                  DISCFOUND := TRUE;                                    44856000
                END;                                                    44858000
              DCT'SPOOL'QUEUES := 0;                           <<dctab>>44860000
              DCT'TERM'CLASS := 0;                             <<dctab>>44862000
              IF DCT'CLASS'ACC'TYPE = 31 << SERIAL DISC >>     <<dctab>>44864000
              THEN K := 0                                      <<dctab>>44866000
              ELSE K := DCT'ACCESS'TYPE;                       <<dctab>>44868000
              ALLSAME := TRUE;                                          44870000
              LDT'INDEX := DCT(DCT'FIRST'LDEV) * LDTSIZE;      <<dctab>>44872000
              DTYP :=LDT'DEVICE'TYPE;                          <<*LDT*>>44874000
              J := -1;                                         <<dctab>>44876000
              IF K = 0 << DIRECT ACCESS >> OR                  <<*LDT*>>44878000
                 K = 2 << IO'CONCURRENT >> THEN                <<*LDT*>>44880000
                BEGIN                                                   44882000
                WHILE (J:=J+1) < DCT'NUM'DEVICES DO            <<dctab>>44884000
                  BEGIN                                        <<*LDT*>>44886000
                  LDT'INDEX :=                                 <<*LDT*>>44888000
                    DCT(DCT'FIRST'LDEV + J) * LDTSIZE;         <<dctab>>44890000
                  LPDT'INDEX :=                                <<*LPDT>>44892000
                    DCT(DCT'FIRST'LDEV + J) * LPDTSIZE;        <<dctab>>44894000
                  IF LDT'ACCESS'TYPE <> K THEN                 <<*LDT*>>44896000
                    BEGIN  <<TYPE RANGES DIFFERENT>>           <<*LDT*>>44898000
                << DEVICES OF DIFFERENT TYPE RANGES IN CLASS xxxx >>    44900000
                    MOVECLASS;                                 <<*LDT*>>44902000
                    MESSAGE( M122,,,,,CLASSNAME);              <<*LDT*>>44904000
                    ERRORS := TRUE;                            <<*LDT*>>44906000
                    GOTO NEXTINDEX;                            <<*LDT*>>44908000
                    END                                        <<*LDT*>>44910000
                  ELSE                                         <<*LDT*>>44912000
                    BEGIN                                      <<*LDT*>>44914000
                    IF DTYP <> LDT'DEVICE'TYPE THEN            <<*LDT*>>44916000
                      ALLSAME:=FALSE;                          <<*LDT*>>44918000
                    IF DCT'CLASS'ACC'TYPE=SDISC OR             <<actyp>>44920000
                       DCT'CLASS'ACC'TYPE=FDISC THEN           <<actyp>>44922000
                      BEGIN                                    <<*LDT*>>44924000
                      TYPE := LDT'DEVICE'TYPE;                 <<*LDT*>>44926000
                      SUBTYP := LPDT'SUBTYPE;                  <<*LPDT>>44928000
                      IF NOT SDISC'TYPE(TYPE,SUBTYP) THEN      <<*LDT*>>44930000
                        GOTO CLCOMER;                          <<*LDT*>>44932000
                      END;                                     <<*LDT*>>44934000
                    END;                                       <<*LDT*>>44936000
                  END;                                         <<*LDT*>>44938000
                END                                                     44940000
              ELSE                                                      44942000
                WHILE (J:=J+1) < DCT'NUM'DEVICES DO            <<dctab>>44944000
                  BEGIN                                                 44946000
                  LDT'INDEX :=                                 <<*LDT*>>44948000
                    DCT(DCT'FIRST'LDEV + J) * LDTSIZE;         <<dctab>>44950000
                  LDEVRANGE:=LDT'ACCESS'TYPE;                  <<*LDT*>>44952000
                  IF LDEVRANGE = 0 << DIRECT'ACCESS >> THEN    <<*LDT*>>44954000
   CLCOMER:         BEGIN   <<TYPE COMBINATION ERROR IN CLASS>>         44956000
                    << ILLEGAL TYPE COMBINATIONS IN CLASS xxxx >>       44958000
                    MOVECLASS;                                 <<01103>>44960000
                    MESSAGE( M123,,,,,CLASSNAME);              <<01103>>44962000
                    ERRORS := TRUE;                                     44964000
                    GO NEXTINDEX;                                       44966000
                    END;                                                44968000
                  IF (K = 1) << SERIAL'IN >>                   <<*LDT*>>44970000
                     AND (LDEVRANGE = 4)  << SERIAL'OUT >>     <<*LDT*>>44972000
                     OR (K = 4) << SERIAL'OUT >>               <<*LDT*>>44974000
                     AND ( LDEVRANGE = 1 ) << SERIAL'IN >>     <<*LDT*>>44976000
                     OR (K = 3) << IO'NONCONCURENT >>          <<*LDT*>>44978000
                     AND (LDEVRANGE <> 3) << IO'NONCONCUR >>   <<*LDT*>>44980000
                     AND (LDEVRANGE <> 2) << IO'CONCURRENT >>  <<*LDT*>>44982000
                  THEN GO CLCOMER;                                      44984000
                  IF DTYP <> LDT'DEVICE'TYPE THEN              <<*LDT*>>44986000
                    ALLSAME:=FALSE;                            <<*LDT*>>44988000
                  END;                                                  44990000
                IF DCT'CLASS'ACC'TYPE <> K&LSL(3) AND          <<dctab>>44992000
                    NOT ALLSAME AND                            <<00071>>44994000
                    DCT'CLASS'ACC'TYPE <> SDISC AND            <<actyp>>44996000
                    DCT'CLASS'ACC'TYPE <> FDISC THEN           <<actyp>>44998000
                    GOTO CLCOMER;                              <<00071>>45000000
                IF DCT'CLASS'ACC'TYPE = 16  <<TERMINAL>>       <<dctab>>45002000
                   AND ALLSAME THEN                            <<dctab>>45004000
                     DCT'TERM'CLASS := 1;                      <<dctab>>45006000
  NEXTINDEX:                                                   <<dctab>>45008000
              @DCT := @DCT + DCT'NEXT'ENTRY;                   <<dctab>>45010000
              @DCT'B := @DCT & LSL(1);                         <<dctab>>45012000
            END;                                                        45014000
          IF TOOBIGDRT OR BIGUSERMAXDRT                        <<03002>>45016000
          THEN BEGIN                                           <<03002>>45018000
             MESSAGE(M102,COMM(DRTNUM));                       <<CONFD>>45020000
             <<"USER SPECIFIED DRT MAX IS -DRT- ">>            <<03002>>45022000
             ERRORS := TRUE;                                   <<03002>>45024000
            END;                                               <<03002>>45026000
                                                               <<03002>>45028000
          IF OLDBIGDRT OR BIGUSERMAXDRT                        <<03002>>45030000
          THEN BEGIN                                           <<03002>>45032000
             MESSAGE(M128,MAXDRT);                             <<03002>>45034000
             <<"HIGEST DRT SUPPORTED BY THIS CPU IS -DRT">>    <<03002>>45036000
             ERRORS := TRUE;                                   <<03002>>45038000
          END;                                                 <<03002>>45040000
                                                               <<03002>>45042000
          IF OLDBIGDRT OR TOOBIGDRT                            <<03002>>45044000
          THEN BEGIN                                           <<03002>>45046000
                   <<AT LEAST ONE LDEV-DRT PAIR IS BAD>>       <<03002>>45048000
             MESSAGE (M129);  <<"FOLLOWING DRTS TO BE FIXED>>  <<03002>>45050000
             LDEV:= 0;                                         <<03002>>45052000
             WHILE (LDEV:=LDEV+1) <= HLDEV DO                  <<03002>>45054000
             BEGIN    <<FIND OFFENDERS>>                       <<03002>>45056000
                DVR'INDEX := LDEV * DVRSIZE;                   <<*DVR*>>45058000
                DRTN := DVRDRTNUM;                             <<*DVR*>>45060000
                IF DRTN <> 0 AND DVRDSBIT = 0                  <<*DVR*>>45062000
                THEN IF DVRDRTNUM > COMM(DRTNUM)               <<CONFD>>45064000
                     OR DRTN > MAXDRT                          <<*DVR*>>45066000
                     THEN MESSAGE(M2411,LDEV,DRTN);            <<*DVR*>>45068000
             END;  <<WHILE LDEV<HLDEV>>                        <<03002>>45070000
          END;  <<IF TOOBIGDRT OR OLDBIGDRT >>                 <<03002>>45072000
                                                               <<03002>>45074000
          IF COLDLOADLDEV=0 AND OPT>COOL THEN                  <<00888>>45076000
             BEGIN                                             <<00888>>45078000
             MESSAGE(M108); <<CLD LOAD DEV MUST BE CONFIG>>    <<01103>>45080000
             ERRORS:=TRUE;                                     <<00888>>45082000
             END;                                              <<00888>>45084000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>45086000
          IF CONSOLELDEV=0 THEN                                         45088000
            BEGIN                                                       45090000
              MESSAGE(M109);<<SYSTEM CONSOLE MUST BE DRT 7>>   <<01103>>45092000
              ERRORS := TRUE;                                           45094000
            END;                                                        45096000
                                                               <<02707>>45098000
          << GIC CHANNELS ON STARFISH MUST NOT BE SET TO    >> <<02707>>45100000
          << 0, 1 OR 15, BECAUSE SYSTEM WILL NOT COME UP.   >> <<02707>>45102000
          << THIS IS TRUE WHETHER OR NOT DEVICE ARE CONFIG- >> <<02707>>45104000
          << URED ON THESE CHANNELS.  RESETSTARFISH ZEROES  >> <<02707>>45106000
          << THE LAST WORD OF EVERY DRT ON THE GIC CHANNEL. >> <<02707>>45108000
                                                               <<02707>>45110000
          IF STARFISH THEN                                     <<02707>>45112000
            BEGIN     << THERE'S A STARFISH ON THE SYSTEM >>   <<02707>>45114000
            ROCL := RIOC( 0, ROLLCALL);                        <<02707>>45116000
            IF <> THEN ERRMESSAGE( M29);  <<STARFISH ERROR>>   <<02707>>45118000
            IF ROCL.(15:1) OR ROCL.(1:1) OR ROCL.(0:1) THEN    <<02707>>45120000
               BEGIN                                           <<02707>>45122000
               MESSAGE( M136);  << MUST SWITCH GIC CHANNEL >>  <<02707>>45124000
               ERRORS := TRUE;  << THUMBWHEEL ON STARFISH  >>  <<02707>>45126000
               END;                                            <<02707>>45128000
            END;    << IF STARFISH >>                          <<02707>>45130000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>45132000
          LDTX'INDEX := CONSOLELDEV * LDTXSIZE;                <<*LDTX>>45134000
          IF CONSOLELDEV=0 THEN                                <<00888>>45136000
            BEGIN                                              <<00888>>45138000
              MESSAGE(M110);<<SYSTEM CONSOLE MUST BE DRT 8>>   <<01103>>45140000
              ERRORS := TRUE;                                  <<00888>>45142000
            END                                                <<00888>>45144000
          ELSE IF LDTX'BAUD'RATE'CODE = 0 THEN                 <<*LDTX>>45146000
            BEGIN <<SPEED FOR SYSTEM CONSOLE MUST BE NON ZERO>><<00888>>45148000
            MESSAGE(M111); << IMPROPER SPEED FOR CONSOLE >>    <<01103>>45150000
            ERRORS := TRUE;                                    <<00888>>45152000
            END;                                               <<00888>>45154000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>45156000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>45158000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>45160000
          LDT'INDEX := SYSDISC * LDTSIZE;                      <<*LDT*>>45162000
          LPDT'INDEX := SYSDISC * LPDTSIZE;                    <<*LPDT>>45164000
          IF NOT NON'DS'LDEV(SYSDISC) OR                       <<03550>>45166000
            NOT SYSDISC'TYPE(LDT'DEVICE'TYPE,                  <<*LDT*>>45168000
                LPDT'SUBTYPE) OR                               <<*LPDT>>45170000
            HLDEV=0 THEN                                       <<03550>>45172000
            BEGIN    << LDEV #1 IS NOT SYSTEM DISC >>          <<03550>>45174000
              MESSAGE(M105); <<SYSTEM DISC MUST BE LDEV 1>>    <<01103>>45176000
              ERRORS := TRUE;                                           45178000
            END;                                                        45180000
          DVR'INDEX := DVRSIZE;  << POINT TO LDEV 1 >>         <<*DVR*>>45182000
          IF DVRUNITNUM <> 0 THEN                              <<*DVR*>>45184000
            BEGIN                                                       45186000
              MESSAGE(M103);<<SYSTEM DISC MUST BE UNIT 0>>     <<01103>>45188000
              ERRORS := TRUE;                                           45190000
            END;                                                        45192000
          IF NOT DISCFOUND THEN                                         45194000
            BEGIN  <<NO DEVICE IN CLASS DISC>>                          45196000
              MESSAGE(M107);                                   <<01103>>45198000
              ERRORS := TRUE;                                           45200000
            END;                                                        45202000
          IF ERRORS THEN RETURNP := ERRLABEL;                           45204000
      END <<CHECKDEV>> ;                                                45206000
$CONTROL SEGMENT=CONFIGURE                                              45208000
          <<------------------------                                    45210000
            MOVE TABLES IN DL AREA                                      45212000
          ------------------------>>                                    45214000
  PROCEDURE MOVEDLTABLES;                                               45216000
    OPTION PRIVILEGED,UNCALLABLE;                                       45218000
    COMMENT                                                             45220000
      EXPANDS AND CONTRACTS TABLES IN THE DL AREA, USING FOLLOWING      45222000
    GLOBALS:                                                            45224000
        TABLEPTRS - ARRAY OF POINTERS TO THE TABLES                     45226000
        TABLEINCRS - ARRAY CONTAINING NUMBER OF WORDS EACH TABLE IS TO  45228000
                     BE INCREMENTED OR DECREMENTED;                     45230000
      BEGIN                                                             45232000
        INTEGER ARRAY OFFSETS(0:EXPTABLES-1)=Q;    <<OFFSET FOR EACH    45234000
                                                     EXPANDABLE TABLE>> 45236000
        INTEGER I,J,       <<LOOP CONTROL>>                             45238000
                NWORDS,    <<NUMBER OF WORDS FOR CURRENT OFFSET>>       45240000
                LASTMOVED; <<INDEX OF LAST TABLE MOVED>>                45242000
        SUBROUTINE EXPAND;                                              45244000
        COMMENT                                                         45246000
          EXPANDS A PORTION OF THE DL AREA BY NWORDS WORDS AND ZEROES   45248000
        THE RESULTING HOLE. UPDATES POINTERS TO THOSE TABLES MOVED;     45250000
        BEGIN                                                           45252000
          IF NWORDS=0 THEN RETURN;                                      45254000
          TOS := TABLEPTRS(J:=LASTMOVED+1);                             45256000
          TOS := S0-NWORDS;   <<DESTINATION FOR MOVE>>                  45258000
          ASSEMBLE(XCH,DUP);                                            45260000
          TOS := TABLEPTRS(I);                                          45262000
          ASSEMBLE(SUB,NEG; MOVE 2); <<MOVE PORTION OF TABLE>>          45264000
          PS0 := 0;                                                     45266000
          ASSEMBLE(DUP,INCB);                                           45268000
          TOS := NWORDS-1;                                              45270000
          ASSEMBLE(MOVE 3);  <<ZERO EXPANDED AREA>>                     45272000
        <<UPDATE POINTERS TO MOVED TABLES>>                             45274000
          DO TABLEPTRS(X) := TABLEPTRS(J)-NWORDS UNTIL (J:=J+1)=I;      45276000
        END <<EXPAND>> ;                                                45278000
        SUBROUTINE CONTRACT;                                            45280000
        COMMENT                                                         45282000
          CONTRACTS A PORTION OF THE DL AREA BY -NWORDS WORDS. POINTERS 45284000
        TO THOSE TABLES MOVED ARE UPDATED;                              45286000
        BEGIN                                                           45288000
          IF NWORDS=0 THEN RETURN;                                      45290000
          TOS := TABLEPTRS(LASTMOVED)-1;  <<DESTINATION PTR>>           45292000
          TOS := S0+NWORDS;  <<SOURCE FOR MOVE>>                        45294000
          TOS := -S0+TABLEPTRS(I+1)-1;  <<NEGATIVE WORD COUNT>>         45296000
          ASSEMBLE (MOVE 3);  <<MOVE TABLES>>                           45298000
          DO TABLEPTRS(X) := TABLEPTRS(X)-NWORDS                        45300000
          UNTIL (X:=X+1)=LASTMOVED;  <<UPDATE PTRS TO MOVED TABLES>>    45302000
        END <<CONTRACT>> ;                                              45304000
          OFFSETS := 0;                                                 45306000
          MOVE OFFSETS(1) := OFFSETS,(EXPTABLES-1);                     45308000
          I := 0;                                                       45310000
          DO IF (NWORDS:=TABLEINCRS(I)) <> 0 THEN                       45312000
            BEGIN                                                       45314000
              X := 0;                                                   45316000
              DO OFFSETS(X) := OFFSETS(X)+NWORDS UNTIL (X:=X+1)>I;      45318000
              TABLEINCRS(I) := 0;                                       45320000
            END                                                         45322000
          UNTIL (I:=I+1) = EXPTABLES;                                   45324000
          NWORDS := OFFSETS;                                            45326000
          IF < THEN                                                     45328000
            BEGIN <<CONTRACTING TABLE>>                                 45330000
              LASTMOVED := EXPTABLES;                                   45332000
              NWORDS := OFFSETS(EXPTABLES-1);                           45334000
              I := X-1;                                                 45336000
              DO IF OFFSETS(I) <> NWORDS THEN                           45338000
                BEGIN <<NEXT PORTION OF TABLE TO BE CONTRACTED MORE,    45340000
                        SO MOVE EVERYTHING UP TO THIS POINT WHICH HASN'T45342000
                        BEEN MOVED YET>>                                45344000
                  CONTRACT;                                             45346000
                  LASTMOVED := I+1;                                     45348000
                  NWORDS := OFFSETS(I);                                 45350000
                END                                                     45352000
              UNTIL (I:=I-1)<0;                                         45354000
              CONTRACT;   <<FINISH MOVING REST OF TABLES>>              45356000
            END                                                         45358000
          ELSE                                                          45360000
            BEGIN  <<EXPANDING TABLE>>                                  45362000
              LASTMOVED := -1; <<INDEX TO LAST TABLE MOVED>>            45364000
              I := 1;                                                   45366000
              DO IF OFFSETS(I) <> NWORDS THEN                           45368000
                BEGIN <<NEXT PORTION TO BE MOVED A DIFFERENT AMOUNT, SO 45370000
                        MOVE EVERYTHING UP TO THIS POINT WHICH HASN'T   45372000
                        BEEN MOVED YET>>                                45374000
                  EXPAND;                                               45376000
                  LASTMOVED := I-1;                                     45378000
                  NWORDS := OFFSETS(I);                                 45380000
                END                                                     45382000
              UNTIL (I:=I+1)=EXPTABLES;                                 45384000
              EXPAND; <<FINISH MOVING REST OF TABLES>>                  45386000
            END;                                                        45388000
          TOS := TABLEPTRS;                                             45390000
          SET(DL);  <<NEW VALUE FOR DL>>                                45392000
          CHECKMEM;  <<CHECK FOR MEMORY OVERLAP>>                       45394000
      END <<MOVEDLTABLES>> ;                                            45396000
         <<------------------------->>                         <<dctab>>45398000
         << SET POINTERS TO TABLES  >>                         <<dctab>>45400000
         <<------------------------->>                         <<dctab>>45402000
  PROCEDURE SETPOINTERS(CURRENTDL);                            <<dctab>>45404000
    VALUE CURRENTDL;                                           <<dctab>>45406000
    INTEGER CURRENTDL;   <<CURRENT UPPER LIMIT ON TABLES>>     <<dctab>>45408000
    COMMENT                                                    <<dctab>>45410000
      SETS POINTERS TO THE DEVICE TABLES BASED ON THEIR SIZES  <<dctab>>45412000
    AS FOUND IN THE CTAB0 TABLE;                               <<dctab>>45414000
      BEGIN                                                    <<dctab>>45416000
          TOS := CURRENTDL;                                    <<dctab>>45418000
          NVOL := COMM(HVOL');  << MVOL/HVOL >>                <<CONFD>>45420000
                                                               <<dctab>>45422000
          << MVOL MAY BE ZERO WHEN COMING FROM NON-PV SYSTEM>> <<dctab>>45424000
                                                               <<dctab>>45426000
          IF MVOL = 0 THEN MVOL := HVOL ELSE                   <<dctab>>45428000
          IF HVOL > MVOL THEN HVOL := MVOL;                    <<dctab>>45430000
          TOS := (MVOL+1) * VTABSIZE;                          <<dctab>>45432000
          ASSEMBLE(SUB,DUP);                                   <<dctab>>45434000
          @VTAB     := TOS;  <<PTR TO VOLUME TABLE>>           <<dctab>>45436000
        TOS := TOS - COMM(TLBUFSIZE);                          <<t8392>>45438000
        @TL'BUF := S0;    <<TABLE LOOKUP POINTER>>             <<t8392>>45440000
          TOS       := TOS - COMM( TTDTSIZE');                 <<*7777>>45442000
          @TDTAB   := S0;                                      <<*7777>>45444000
          TOS       := TOS - COMM(DVCLSIZE');                  <<*7777>>45446000
          @DCTAB    := S0;                                     <<dctab>>45448000
          TOS       := TOS - DCTHSIZE;                         <<DEVCO>>45450000
          @DCT'HEAD := S0;                                     <<dctab>>45452000
          @TCLASS   := S0;  << INITIALLY LENGTH ZERO >>        <<tclas>>45454000
          TOS       := TOS - COMM(CSTABSIZE);                  <<CONFD>>45456000
          @CSTAB := S0;                                        <<zrela>>45458000
          SET(DL);                                             <<zrela>>45460000
          PUSH(Z);                                             <<zrela>>45462000
          TOS := TOS + %15;                                    <<zrela>>45464000
          @DVRTAB := S0;                                       <<zrela>>45466000
          TOS := TOS + (MAXLDEV+1) * DVRSIZE;                  <<zrela>>45468000
          @LPDT := S0;                                         <<zrela>>45470000
          TOS := TOS + (MAXLDEV+1) * LPDTSIZE;                 <<zrela>>45472000
          @LDT := S0;                                          <<zrela>>45474000
          TOS := TOS + (MAXLDEV+1) * LDTSIZE;                  <<zrela>>45476000
          @LDTX := TOS;                                        <<zrela>>45478000
      END <<SETPOINTERS>>;                                     <<dctab>>45480000
                                                                        45482000
$CONTROL SEGMENT=MAINSEG1                                               45484000
          <<-----------------                                           45486000
            LIST CS DEVICES                                             45488000
          ----------------->>                                           45490000
                                                                        45492000
  PROCEDURE LISTCSDEV;                                                  45494000
    BEGIN                                                               45496000
     ARRAY GENHED1(0:35)=PB:=                                           45498000
      "LDN PM PRT LCL TC  RCV   LCL   CON  MODE   TRANSMIT ",           45500000
      " TM BUFFER D DRIVER ";                                           45502000
     ARRAY GENHED2(0:35)=PB:=                                           45504000
      "           MOD    TMOUT TMOUT TMOUT          SPEED    ",         45506000
      "   SIZE  C OPTIONS";                                             45508000
     ARRAY SWHED1(0:23)=PB:=                                            45510000
      "LDN CTRL  PHONE NUMBER LIST    LOCAL ID SEQUENCE";               45512000
     ARRAY SWHED2(0:26)=PB:=                                            45514000
      "     LEN                          REMOTE ID SEQUENCES ";         45516000
     ARRAY NSWHED1(0:25)=PB:=                                           45518000
      "LDN INCOM POLL   CIR  C/S NUM C P COMPONENT SEQUENCE";           45520000
     ARRAY NSWHED2(0:16)=PB:=                                           45522000
      "    DELAY REPET DELAY     COM T L ";                             45524000
     ARRAY HEX(*) = PB :=                                      <<03557>>45526000
            " 0 1 2 3 4 5 6 7 8 9 A B C D E F";                <<03557>>45528000
     LOGICAL SWTCHED:=FALSE,NONSWTCHED:=FALSE,REMOTE:=FALSE;            45530000
     ARRAY BUFR(0:35);                                                  45532000
     BYTE POINTER PHONE,IDLIST,CNTRLSEQ=PHONE;                          45534000
     INTEGER I,J,N,TEMP,PHINX,IDINX,LEN,CINX=PHINX;                     45536000
     INTEGER K,START,TYPE,LEN1,NUMS,NUMP;                               45538000
     EQUATE  QUOT   = %42,                                              45540000
             ETYP   = 1,                                                45542000
             OTYP   = 2,                                                45544000
             HTYP   = 3;                                                45546000
     BYTE ARRAY OUTTEMP(0:71);                                          45548000
     INTEGER POINTER CONTROL;                                           45550000
     INTEGER                                                   <<*LDT*>>45552000
         LDT'INDEX,                                            <<*LPDT>>45554000
         LPDT'INDEX;                                           <<*LPDT>>45556000
     DOUBLE POINTER                                            <<csdec>>45558000
         DBLPTR;                                               <<csdec>>45560000
                                                                        45562000
  SUBROUTINE OCTTOASCI(INSTRING,OUTSTRING,LENGTH);                      45564000
     INTEGER LENGTH;                                                    45566000
     BYTE ARRAY INSTRING,OUTSTRING;                                     45568000
       BEGIN                                                            45570000
       MOVE OUTSTRING := "O(";                                          45572000
       I := -1;                                                         45574000
       J := 2;                                                          45576000
       WHILE(I:=I+1)<LENGTH DO                                          45578000
         BEGIN                                                          45580000
         TOS := LNTOA(INSTRING(I),8,OUTSTRING(J));             <<00935>>45582000
         TOS := TOS+J;                                                  45584000
         J := S0+1;                                                     45586000
         X := TOS;                                                      45588000
         OUTSTRING(X) := ",";                                           45590000
         END;                                                           45592000
       OUTSTRING(X) := ")";                                             45594000
       LENGTH := J;                                                     45596000
       END;  <<OCTTOASCI>>                                              45598000
                                                                        45600000
  SUBROUTINE HEXTOASCI(INSTRING,OUTSTRING,LENGTH);                      45602000
    INTEGER LENGTH;                                                     45604000
    BYTE ARRAY INSTRING,OUTSTRING;                                      45606000
      BEGIN                                                             45608000
      MOVE OUTSTRING := "H(";                                           45610000
      I := -1;                                                          45612000
      J := 2;                                                           45614000
      WHILE(I:=I+1)<LENGTH DO                                           45616000
        BEGIN                                                           45618000
        TOS := INSTRING(I);                                             45620000
        TOS := %20;                                                     45622000
        ASSEMBLE(DIV);                                                  45624000
        IF S1=0 THEN                                                    45626000
          BEGIN  <<ONE HEX DIGIT>>                                      45628000
          X := TOS;                                                     45630000
          DEL;                                                          45632000
          OUTSTRING(J) := HEX(X);                                       45634000
          J := J+1;                                                     45636000
          END                                                           45638000
        ELSE                                                            45640000
          BEGIN                                                         45642000
          ASSEMBLE(XCH);                                                45644000
          X := TOS;                                                     45646000
          K := TOS;                                                     45648000
          OUTSTRING(J) := HEX(X);                                       45650000
          J := J+1;                                                     45652000
          OUTSTRING(J) := HEX(K);                                       45654000
          J := J+1;                                                     45656000
          END;                                                          45658000
        OUTSTRING(J) := ",";                                            45660000
        J := J+1;                                                       45662000
        END;                                                            45664000
      OUTSTRING(X) := ")";                                              45666000
      LENGTH := J;                                                      45668000
      END;   <<HEXTOASCI>>                                              45670000
                                                                        45672000
          MOVE LINE := GENHED1,(36);                           <<00888>>45674000
          PRINTLINE;                                           <<00888>>45676000
          MOVE LINE := GENHED2,(36);                           <<00888>>45678000
          PRINTLINE;                                           <<00888>>45680000
          LDEV:=0;                                                      45682000
          WHILE(LDEV:=LDEV+1)<=HLDEV DO                                 45684000
            BEGIN                                                       45686000
            LDT'INDEX := LDEV * LDTSIZE;                       <<*LDT*>>45688000
            IF CSDEVICE THEN                                            45690000
              BEGIN  <<CS DEVICE>>                                      45692000
              LPDT'INDEX := LDEV * LPDTSIZE;                   <<*LPDT>>45694000
              INBUF := "  ";                                            45696000
              MOVE INBUF(1):=INBUF,(35);  <<BLANK BUFFER>>              45698000
              ASCII(LDEV,10,BINBUF);<<LOGICAL DEVICE #>>       <<*8392>>45700000
              N := CSDEF(LDEV);                                         45702000
              @CSLDTX := @CSTAB+CSXSTART;                               45704000
              I:=-1;                                                    45706000
              WHILE(I:=I+1)<N DO  <<FIND CSLDTX ENTRY>>                 45708000
                @CSLDTX := @CSLDTX+CSLDTX;                              45710000
              ASCII(CSLDTXHSI'CHAN,10,BINBUF(4));              <<*8392>>45712000
              IF LDT'DEVICE'TYPE = CSDEV17 THEN                <<*LDT*>>45714000
                BEGIN                                          <<01165>>45716000
                BINBUF(7):="X"; BINBUF(12):="X";               <<01165>>45718000
                BINBUF(15):="X";                               <<01165>>45720000
                END                                            <<01165>>45722000
              ELSE                                             <<01165>>45724000
                BEGIN                                          <<01165>>45726000
              ASCII(CSLDTXPROTOCOL,10,BINBUF(7));              <<*8392>>45728000
              ASCII(CSLDTXMODE,10,BINBUF(12));                 <<*8392>>45730000
              ASCII(CSLDTXCODE,10,BINBUF(15));                 <<*8392>>45732000
                END;                                           <<01165>>45734000
              ASCII(CSLDTXRECV'TIMEOUT,10,BINBUF(18));         <<*8392>>45736000
                                 <<RECEIVE TIMEOUT>>                    45738000
              ASCII(CSLDTXLOCAL'TIMEOUT,10,BINBUF(24));        <<*8392>>45740000
                                 <<LOCAL TIMEOUT>>                      45742000
              ASCII(CSLDTXCONCT'TIMEOUT,10,BINBUF(30));        <<*8392>>45744000
                                 <<CONNECT TIMEOUT>>                    45746000
              IF LOGICAL(CSLDTXDIAL) THEN BINBUF(36):="O";              45748000
              IF 1<=CSLDTXANSWER<=2 THEN BINBUF(37):="I";               45750000
              IF CSLDTXANSWER=AUTOANSWER THEN BINBUF(38):="A";          45752000
              IF LOGICAL(CSLDTXDUAL'SPEED) THEN                         45754000
                BEGIN                                                   45756000
                BINBUF(39) := "D";                                      45758000
                IF LOGICAL(CSLDTXHALF'SPEED) THEN BINBUF(40):="H";      45760000
                END;                                                    45762000
              IF LOGICAL(CSLDTXSPEEDCHNGBLE) THEN BINBUF(41):="C";      45764000
              @DBLPTR := @CSLDTXINSPEED;                       <<csdec>>45766000
              LDNTOA(DBLPTR,10,BINBUF(43));                    <<csdec>>45768000
              ASCII(CSLDTXXMSN'MODE,10,BINBUF(54));            <<*8392>>45770000
              ASCII(CSLDTXPBUFFSIZE,10,BINBUF(57));            <<*8392>>45772000
              IF LOGICAL(CSLDTXDRCHANGEABLE) THEN BINBUF(63):="Y"       45774000
                ELSE BINBUF(63):="N";                                   45776000
              ASCII(CSLDTXDOPTIONS,10,BINBUF(66));             <<*8392>>45778000
              PRINT(INBUF,-72,0);                                       45780000
              LPDT'INDEX := LDEV * LPDTSIZE;                   <<*LPDT>>45782000
              IF (LPDT'SUBTYPE MOD 4) = 0     << SWITCHED ? >> <<*LPDT>>45784000
                THEN SWTCHED:=TRUE                             <<*LPDT>>45786000
              ELSE IF 1 <= (LPDT'SUBTYPE MOD 4) <= 4           <<*LPDT>>45788000
                           << NON-SWITCHED >>                  <<*LPDT>>45790000
               AND SUPERVISED                                  <<*LPDT>>45792000
                     THEN NONSWTCHED:=TRUE;                             45794000
              END;                                                      45796000
            END;                                                        45798000
          IF SWTCHED THEN                                      <<*LPDT>>45800000
            BEGIN  <<SWITCHED DEVICES PRESENT>>                         45802000
            MOVE INBUF:=SWHED1,(24);                                    45804000
            PRINT(INBUF,-48,0);                                         45806000
            MOVE INBUF:=SWHED2,(26);                                    45808000
            PRINT(INBUF,-52,0);                                         45810000
            LDEV := 0;                                                  45812000
            WHILE(LDEV:=LDEV+1)<=HLDEV DO                               45814000
              BEGIN                                            <<*LDT*>>45816000
              LDT'INDEX := LDEV * LDTSIZE;                     <<*LDT*>>45818000
              LPDT'INDEX := LDEV * LPDTSIZE;                   <<*LPDT>>45820000
              IF CSDEV17 <= LDT'DEVICE'TYPE <=CSDEV19 THEN     <<*LDT*>>45822000
                IF LPDT'SUBTYPE=0 THEN                         <<*LPDT>>45824000
                  BEGIN   <<SWITCHED DEVICE>>                           45826000
                  INBUF := "  ";                                        45828000
                  MOVE INBUF(1):=INBUF,(35);                            45830000
                  ASCII(LDEV,10,BINBUF);                       <<*8392>>45832000
                  @CSLDTX := @CSTAB+CSXSTART;                           45834000
                  I:=-1;                                                45836000
                  WHILE(I:=I+1)<CSDEF(LDEV) DO                          45838000
                    @CSLDTX := @CSLDTX+CSLDTX;                          45840000
                  ASCII(0,10,BINBUF(4));                       <<*8392>>45842000
                  IF CSLDTXPHLISTPTR<>0 THEN                            45844000
                    BEGIN <<POINT TO PHONE LIST>>                       45846000
                    @PHONE:=(@CSLDTX+CSLDTXPHLISTPTR)&LSL(1);  <<04306>>45848000
                                    <<BYTE POINTER TO PHONE LIST>>      45850000
                    NUMP := PHONE(NUMSEQ);  <<# OF PHONE SEQUENCES>>    45852000
                    END                                                 45854000
                  ELSE NUMP:=0;                                         45856000
                  IF CSLDTXIDLISTPTR<>0 THEN                            45858000
                    BEGIN                                               45860000
                    @IDLIST :=(@CSLDTX+CSLDTXIDLISTPTR)&LSL(1);<<04306>>45862000
                              <<BYTE POINTER TO ID LIST>>               45864000
                    NUMS := IDLIST(NUMSEQ);   <<# OF ID SEQUENCES>>     45866000
                    END                                                 45868000
                  ELSE NUMS:=0;                                         45870000
                  TEMP := 0;                                            45872000
                  PHINX:=IDINX:=3;                                      45874000
                  WHILE((NUMP>0) OR (NUMS>0)) DO                        45876000
                    BEGIN  <<MORE SEQUENCES OR A CONTINUATION>>         45878000
                    IF NUMP>0 THEN                                      45880000
                      BEGIN      <<MORE PHONE SEQUENCES>>               45882000
                      MOVE BINBUF(10):=PHONE(PHINX+1),(PHONE(PHINX));   45884000
                      PHINX:=PHINX+INTEGER(PHONE(PHINX))+1;             45886000
                      NUMP := NUMP-1;                                   45888000
                      END;                                              45890000
                    IF NUMS>0 OR TEMP>0 THEN                            45892000
                      BEGIN      <<MORE ID SEQUENCES>>                  45894000
                      IF TEMP>0 THEN                                    45896000
                        BEGIN <<CONTINUATION OF SEQUENCE>>              45898000
                        N:=(IF REMOTE THEN 35 ELSE 32);                 45900000
                        START := LEN;                                   45902000
                        LEN := TEMP;                                    45904000
                        TEMP := 0;                                      45906000
                        NUMS := NUMS-1;                                 45908000
                        REMOTE := TRUE;                                 45910000
                        END                                             45912000
                      ELSE                                              45914000
                        BEGIN <<NEW SEQUENCES>>                         45916000
                        START := 0;                                     45918000
                        TOS := IDLIST(IDINX);                           45920000
                        DUPLICATE;                                      45922000
                        TOS := TOS LAND %77;                            45924000
                        LEN := S0;                                      45926000
                        LEN1 := TOS;                                    45928000
                        TYPE := TOS&LSR(6);                             45930000
                        IF TYPE=OTYP THEN OCTTOASCI                     45932000
                           (IDLIST(IDINX+1),OUTTEMP,LEN)                45934000
                        ELSE IF TYPE=HTYP THEN HEXTOASCI                45936000
                                (IDLIST(IDINX+1),OUTTEMP,LEN)           45938000
                             ELSE                                       45940000
                               BEGIN                                    45942000
                               IF TYPE=ETYP THEN                        45944000
                                 BEGIN                                  45946000
                                 OUTTEMP := "E";                        45948000
                                 CONVERT(0,IDLIST(IDINX+1),             45950000
                                         OUTTEMP(2),LEN);               45952000
                                 END                                    45954000
                               ELSE                                     45956000
                                 BEGIN                                  45958000
                                 OUTTEMP := "A";                        45960000
                                 MOVE OUTTEMP(2):=IDLIST                45962000
                                      (IDINX+1),(LEN);                  45964000
                                 END;                                   45966000
                               OUTTEMP(1):=OUTTEMP(LEN+2):=QUOT;        45968000
                               LEN := LEN+3;                            45970000
                               END;                                     45972000
                        IDINX := IDINX+LEN1+1;                          45974000
                        IF REMOTE THEN                                  45976000
                          BEGIN                                         45978000
                          N := 34;                                      45980000
                          IF LEN>38 THEN                                45982000
                            BEGIN                                       45984000
                            TEMP := LEN-38;                             45986000
                            LEN := 38;                                  45988000
                            END                                         45990000
                          ELSE NUMS:=NUMS-1;                            45992000
                          END                                           45994000
                        ELSE                                            45996000
                          BEGIN <<LOCAL>>                               45998000
                          N := 31;                                      46000000
                          IF LEN>41 THEN                                46002000
                            BEGIN                                       46004000
                            TEMP := LEN-41;                             46006000
                            LEN := 41;                                  46008000
                            END                                         46010000
                          ELSE                                          46012000
                            BEGIN                                       46014000
                            NUMS := NUMS-1;                             46016000
                            REMOTE := TRUE;                             46018000
                            END;                                        46020000
                          END;                                          46022000
                        END; <<NEW SEQUENCES>>                          46024000
                      MOVE BINBUF(N):=OUTTEMP(START),(LEN);             46026000
                      END;<<MORE ID SEQUENCE>>                          46028000
                    PRINT(INBUF,-72,0);                                 46030000
                    INBUF := "  ";                                      46032000
                    MOVE INBUF(1) := INBUF,(35);                        46034000
                    END;<<MORE SEQUENCES OR A CONTIUATION>>             46036000
                  REMOTE := FALSE; <<FINISHED WITH DEVICE>>             46038000
                  IF CSLDTXPHLISTPTR=CSLDTXIDLISTPTR THEN               46040000
                    PRINT(INBUF,-72,0);<<NO PHONE #'S OR ID SEQUENCES>> 46042000
                  END; <<SWITCHED DEVICE>>                              46044000
              END;                                             <<*LDT*>>46046000
            END; <<SWITCHED DEVICES PRESENT>>                           46048000
          IF NONSWTCHED THEN                                            46050000
            BEGIN <<NOSWITCHED SUPERVISED DEVICES EXIST>>               46052000
            MOVE  INBUF:=NSWHED1,(26);                                  46054000
            PRINT(INBUF,-52,0);                                         46056000
            MOVE INBUF:=NSWHED2,(17);                                   46058000
            PRINT(INBUF,-33,0);                                         46060000
            INBUF := "  ";                                              46062000
            MOVE INBUF(1):=INBUF,(35);                                  46064000
            LDEV := 0;                                                  46066000
            WHILE(LDEV:=LDEV+1)<=HLDEV DO                               46068000
              BEGIN                                            <<*LDT*>>46070000
              LDT'INDEX := LDEV * LDTSIZE;                     <<*LDT*>>46072000
              LPDT'INDEX := LDEV * LPDTSIZE;                   <<*LPDT>>46074000
              IF CSDEV17 <= LDT'DEVICE'TYPE <= CSDEV19 THEN    <<*LDT*>>46076000
                IF LPDT'SUBTYPE <> 0 THEN                      <<*LPDT>>46078000
                  BEGIN <<NONSWITCHED DEVICE>>                          46080000
                  @CSLDTX := @CSTAB+CSXSTART;                           46082000
                  I:=-1;                                                46084000
                  WHILE(I:=I+1)<CSDEF(LDEV) DO                          46086000
                    @CSLDTX := @CSLDTX+CSLDTX;                          46088000
                  IF NOT(SUPERVISED) THEN GOTO NEXTNSW;                 46090000
                  TOS := @CSLDTX+CSLDTXCONTPTR;                         46092000
                  @CONTROL  := S0;                                      46094000
                  IF CONTROLST THEN                            <<04306>>46096000
                    @CNTRLSEQ := (TOS+CONSEQSTART)&LSL(1)      <<04306>>46098000
                  ELSE @CNTRLSEQ:=(TOS+1)&LSL(1); <<TRIBUTARY>><<04306>>46100000
                  CINX := 0;                                            46102000
                  ASCII(LDEV,10,BINBUF);                       <<*8392>>46104000
                  IF TRIBUTARY THEN                                     46106000
                    BEGIN                                               46108000
                    ASCII(N:=CONTROL.(8:8),10,BINBUF(26));     <<*8392>>46110000
                    GO AROUND;                                          46112000
                    END;                                                46114000
                  ASCII(CONTROL(INTCOMDELAY),10,BINBUF(4));    <<*8392>>46116000
                  ASCII(CONTROL,10,BINBUF(10));                <<*8392>>46118000
                  ASCII(CONTROL(CIRPDELAY),10,BINBUF(16));     <<*8392>>46120000
                  TOS := 0;                                             46122000
                  TOS:=(CONTROL(NUMCOMP)+CONTROL(REMOSTAT)-1)/          46124000
                        CONTROL(REMOSTAT);                              46126000
                  ASCII(*,10,BINBUF(22));                      <<*8392>>46128000
                  ASCII((N:=CONTROL(NUMCOMP)),10,BINBUF(26));  <<*8392>>46130000
  AROUND:         NUMS := 0;                                            46132000
                  WHILE(NUMS:=NUMS+1)<=N DO                             46134000
                    BEGIN                                               46136000
                    TOS:=0;                                             46138000
                    TOS := CNTRLSEQ(CINX); <<SEQUENCE TYPE>>            46140000
                    TOS := TOS LAND 3;                                  46142000
                    ASCII(*,10,BINBUF(30));                    <<*8392>>46144000
                    TOS := CNTRLSEQ(CINX);                              46146000
                    TOS:=TOS&LSR(2);                                    46148000
                    IF TOS>0 THEN BINBUF(32):="Y"                       46150000
                      ELSE BINBUF(32):="N";                             46152000
                    TOS := CNTRLSEQ(CINX+1);                            46154000
                    DUPLICATE;                                          46156000
                    TYPE := TOS&LSR(6);                                 46158000
                    TOS := TOS LAND %77;                                46160000
                    LEN1 := LEN := TOS;                                 46162000
                    IF TYPE=OTYP THEN OCTTOASCI                         46164000
                       (CNTRLSEQ(CINX+2),BINBUF(34),LEN)                46166000
                    ELSE IF TYPE=HTYP THEN HEXTOASCI                    46168000
                            (CNTRLSEQ(CINX+2),BINBUF(34),LEN)           46170000
                         ELSE                                           46172000
                           BEGIN                                        46174000
                           IF TYPE=ETYP THEN                            46176000
                             BEGIN                                      46178000
                             BINBUF(34) := "E";                         46180000
                             CONVERT(0,CNTRLSEQ(CINX+2),                46182000
                                     BINBUF(36),LEN);                   46184000
                             END                                        46186000
                           ELSE                                         46188000
                             BEGIN                                      46190000
                             BINBUF(34) := "A";                         46192000
                             MOVE BINBUF(36):=                          46194000
                                  CNTRLSEQ(CINX+2),(LEN);               46196000
                             END;                                       46198000
                           BINBUF(35):=BINBUF(LEN+36):=QUOT;            46200000
                           END;                                         46202000
                    CINX:=CINX+LEN1+2;                                  46204000
                    PRINT(INBUF,-72,0);                                 46206000
                    INBUF:="  ";                                        46208000
                    MOVE INBUF(1):=INBUF,(35);                          46210000
                    END;                                                46212000
  NEXTNSW:        END;                                                  46214000
                END;                                           <<*LDT*>>46216000
            END;                                                        46218000
          END <<LISTCSDEV>>;                                            46220000
$PAGE "MAINSEG1 -- I/O CONFIGURATION CHANGES"                  <<MPEIV>>46222000
$PAGE"                  ALLOC'DEV AND DEALLOC'DEV"             << 8392>>46224000
PROCEDURE ALLOC'DEV(DRT,UNIT);                                 << 8392>>46226000
VALUE DRT,UNIT;                                                << 8392>>46228000
LOGICAL DRT,UNIT;                                              << 8392>>46230000
<< *********************************************************>> << 8392>>46232000
<< PROCEDURE ALLOC'DEV/DEALLOC'DEV                          >> << 8392>>46234000
<< LAST MODIFICATION:           01/23/84                    >> << 8392>>46236000
<<                                                          >> << 8392>>46238000
<< *USES GLOBAL ARRAY IDINFO*                               >> << 8392>>46240000
<<                                                          >> << 8392>>46242000
<< THIS PROCEDURE IS CALLED WHEN A DEVICE IS ALLOCATED OR   >> << 8392>>46244000
<< DEALLOCATED DURING I/O CONFIGURATION CHANGES.  IT        >> << 8392>>46246000
<< SEARCHES THROUGH THE ENTRIES IN GLOBAL ARRAY IDINFO AND  >> << 8392>>46248000
<< SETS OR RESETS THE ALLOCATED BIT IF A MATCH IS FOUND.    >> << 8392>>46250000
<<**********************************************************>> << 8392>>46252000
BEGIN                                                          << 8392>>46254000
  INTEGER ENTRYNUM;                                            << 8392>>46256000
  LOGICAL FOUND;                                               << 8392>>46258000
  LOGICAL ALLOCATE;                                            << 8392>>46260000
  ENTRY DEALLOC'DEV;                                           << 8392>>46262000
  DEFINE                                                       << 8392>>46264000
    IODRT   = IDINFO(ENTRYNUM)#,                               << 8392>>46266000
    IOUNIT  = IDINFO(ENTRYNUM+1).(1:15)#,                      << 8392>>46268000
    IOALLOC = IDINFO(ENTRYNUM+1).(0:1)#,                       << 8392>>46270000
    IOCID   = IDINFO(ENTRYNUM+2)#;                             << 8392>>46272000
                                                               << 8392>>46274000
<< ALLOCATE ENTRYNUM POINT >>                                  << 8392>>46276000
  ALLOCATE := TRUE;                                            << 8392>>46278000
  GO TO START;                                                 << 8392>>46280000
                                                               << 8392>>46282000
<< DEALLOCATE ENTRYNUM POINT >>                                << 8392>>46284000
  DEALLOC'DEV:                                                 << 8392>>46286000
  ALLOCATE := FALSE;                                           << 8392>>46288000
                                                               << 8392>>46290000
START:                                                         << 8392>>46292000
                                                               << 8392>>46294000
  ENTRYNUM := 0;                                               << 8392>>46296000
  FOUND := FALSE;                                              << 8392>>46298000
  WHILE (NOT FOUND) AND (IODRT <> 0) DO                        << 8392>>46300000
  BEGIN                                                        << 8392>>46302000
    IF (IODRT = DRT) AND (IOUNIT = UNIT) THEN                  << 8392>>46304000
    BEGIN                                                      << 8392>>46306000
      FOUND := TRUE;                                           << 8392>>46308000
      IOALLOC := ALLOCATE;                                     << 8392>>46310000
    END                                                        << 8392>>46312000
    ELSE ENTRYNUM := ENTRYNUM + 3;                             << 8392>>46314000
  END;                                                         << 8392>>46316000
END; << ALLOC'DEV >>                                           << 8392>>46318000
                                                               << 8392>>46320000
$PAGE"                  PROCEDURE FIND'ENTRY"                  << 8392>>46322000
PROCEDURE FIND'ENTRY(DRT,UNIT,CID);                            << 8392>>46324000
VALUE CID;                                                     << 8392>>46326000
LOGICAL DRT,UNIT,CID;                                          << 8392>>46328000
<< *********************************************************>> << 8392>>46330000
<< PROCEDURE FIND'ENTRY                                     >> << 8392>>46332000
<< LAST MODIFICATION:           01/23/84                    >> << 8392>>46334000
<<                                                          >> << 8392>>46336000
<< *USES GLOBAL ARRAY IDINFO*                               >> << 8392>>46338000
<<                                                          >> << 8392>>46340000
<< THIS PROCEDURE IS CALLED TO FIND A DEVICE THAT IS NOT    >> << 8392>>46342000
<< CONFIGURED, BUT PHYSICALLY EXISTS ON THE SYSTEM.  IT     >> << 8392>>46344000
<< SEARCHES THROUGH THE ENTRIES IN GLOBAL ARRAY IDINFO AND  >> << 8392>>46346000
<< RETURNS THE DRT AND UNIT # IN THE FIRST FREE ENTRY THAT  >> << 8392>>46348000
<< HAS A MATCHING CONTROLLER ID.  NOTE: THE DEVICE IS NOT   >> << 8392>>46350000
<< ALLOCATED AT THIS POINT, BECAUSE THE USER MAY ELECT NOT  >> << 8392>>46352000
<< TO TAKE THE DEFAULT.  WHEN THE DEVICE IS COMPLETELY      >> << 8392>>46354000
<< CONFIGURED, ONLY THEN SHOULD IT BE SET TO ALLOCATED.     >> << 8392>>46356000
<<**********************************************************>> << 8392>>46358000
BEGIN                                                          << 8392>>46360000
  INTEGER ENTRYNUM;                                            << 8392>>46362000
  LOGICAL FOUND;                                               << 8392>>46364000
  DEFINE                                                       << 8392>>46366000
    IODRT   = IDINFO(ENTRYNUM)#,                               << 8392>>46368000
    IOUNIT  = IDINFO(ENTRYNUM+1).(1:15)#,                      << 8392>>46370000
    IOALLOC = IDINFO(ENTRYNUM+1).(0:1)#,                       << 8392>>46372000
    IOCID   = IDINFO(ENTRYNUM+2)#;                             << 8392>>46374000
                                                               << 8392>>46376000
  DRT := 0;                                                    << 8392>>46378000
  UNIT := 0;                                                   << 8392>>46380000
  ENTRYNUM := 0;                                               << 8392>>46382000
  FOUND := FALSE;                                              << 8392>>46384000
  WHILE (NOT FOUND) AND (IODRT <> 0) DO                        << 8392>>46386000
  BEGIN                                                        << 8392>>46388000
    IF IOCID = CID AND NOT IOALLOC THEN                        << 8392>>46390000
    BEGIN                                                      << 8392>>46392000
      DRT := IODRT;                                            << 8392>>46394000
      UNIT := IOUNIT;                                          << 8392>>46396000
      FOUND := TRUE;                                           << 8392>>46398000
    END                                                        << 8392>>46400000
    ELSE ENTRYNUM := ENTRYNUM + 3;                             << 8392>>46402000
  END;                                                         << 8392>>46404000
END;  << FIND'ENTRY >>                                         << 8392>>46406000
                                                               << 8392>>46408000
$PAGE"                  PROCEDURE INITIDINFO"                  << 8392>>46410000
PROCEDURE INITIDINFO;                                          << 8392>>46412000
<< *********************************************************>> << 8392>>46414000
<< PROCEDURE INITIOMAP                                      >> << 8392>>46416000
<< LAST MODIFICATION:           01/23/84                    >> << 8392>>46418000
<<                                                          >> << 8392>>46420000
<< *USES GLOBAL ARRAY IDINFO                                >> << 8392>>46422000
<<                                                          >> << 8392>>46424000
<<**********************************************************>> << 8392>>46426000
BEGIN                                                          << 8392>>46428000
  INTEGER DVR'INDEX;                                           << 8392>>46430000
  INTEGER LIMIT;                                               << 8392>>46432000
                                                               << 8392>>46434000
  DVR'INDEX := DVRSIZE;                                        << 8392>>46436000
  LIMIT := HLDEV * DVRSIZE;                                    << 8392>>46438000
  WHILE DVR'INDEX <= LIMIT DO                                  << 8392>>46440000
  BEGIN                                                        << 8392>>46442000
    IF DVRDRTNUM <> 0                                          << 8392>>46444000
       THEN ALLOC'DEV(DVRDRTNUM,DVRUNITNUM);                   << 8392>>46446000
    DVR'INDEX := DVR'INDEX + DVRSIZE;                          << 8392>>46448000
  END;                                                         << 8392>>46450000
END;  << INITIDINFO >>                                         << 8392>>46452000
$PAGE "  MAINSEG1 -- I/O CONFIGURATION CHANGES"                << 8392>>46454000
PROCEDURE IOCHANGE;                                            <<MPEIV>>46456000
BEGIN                                                          <<MPEIV>>46458000
        INTEGER TYPE,UNIT,IDINX,PHINX,CSINDX,LASTPOLLENT,      <<MPEIV>>46460000
                NEW'LDEV,BINDX=PHINX;                          <<03611>>46462000
        BYTE POINTER PHONE,IDLIST,BCSLDTX=PHONE;               <<MPEIV>>46464000
        EQUATE SDISC=31, FDISC=7, MAGTAPETYPE = 24;            <<s8967>>46466000
          LOGICAL DSDEVICE;                                    <<MPEIV>>46468000
        INTEGER SPEEDCDE ;  << OCTAL CODE FOR TERM. SPEED >>   <<03004>>46470000
         INTEGER TSPEED;                                       <<T8766>>46472000
        INTEGER  TINDEX;     <<TEMPORARY CLASS INDEX>>         <<MPEIV>>46474000
        INTEGER TEMP;                                          <<MPEIV>>46476000
        INTEGER SUBTYP;  << DEVICE SUBTYPE >>                  <<03550>>46478000
        INTEGER OLDDRT;  << LDEV'S OLD DRT NUMBER >>           <<03557>>46480000
        LOGICAL ERROR := FALSE,LAST=ERROR;                     <<MPEIV>>46482000
        LOGICAL DEFDRT;  << TRUE WHEN USING DEFAULT DRT >>     << 8392>>46484000
        LOGICAL DRTDONE;                                       << 8392>>46486000
        LOGICAL IOMAPDONE := FALSE;                            << 8392>>46488000
        INTEGER ARRAY IBTEMP(0:40);                            <<03635>>46490000
        BYTE ARRAY BTEMP(*) = IBTEMP;                          <<03635>>46492000
        LOGICAL ARRAY                                          <<*DVR*>>46494000
           DRIVW'NAME(0:3) = Q;                                <<*DVR*>>46496000
        BYTE ARRAY                                             <<*DVR*>>46498000
           DRIVB'NAME(*)   = DRIVW'NAME;                       <<*DVR*>>46500000
                                                               <<*LDT*>>46502000
        DEFINE TERMTYP      = (0:7)#;                          <<*LDT*>>46504000
                                                               <<*LDT*>>46506000
                                                               <<06067>>46508000
        BYTE ARRAY FILE (0:7),     <<FILENAME>>                <<06067>>46510000
                   GROUP(0:7),     <<GROUP NAME>>              <<06067>>46512000
                   ACCT (0:7);     <<ACCOUNT NAME>>            <<06067>>46514000
        BYTE ARRAY DEV'NAME(0:15);                             <<t8392>>46516000
                                                               <<06067>>46518000
        LOGICAL WARN,                                          <<t8392>>46520000
                TERM'DEFAULTS := FALSE,                        <<D8822>>46522000
                DEFAULT'CHOSEN;                                <<D8822>>46524000
        INTEGER BINDEX,     <<POINTS TO # LDEVS IN ENT>>       <<06067>>46526000
                VAL,                                           <<t8392>>46528000
                INITSPOOL,                                              46530000
                BTTDTSIZE:=0,<<SIZE IN BYTES>>                 <<06067>>46532000
                CNT:=0,     <<# WORDS TO MOVE>>                <<06067>>46534000
                FQFNSIZE:=0,<<FULLY QUALIFIED FILENAME SIZE>>  <<06067>>46536000
                FSIZE:=0,   <<FILE PART OF FILENAME>>          <<06067>>46538000
                GSIZE:=0,   <<GROUP PART OF FILENAME>>         <<06067>>46540000
                ASIZE:=0,   <<ACCT PART OF FILENAME>>          <<06067>>46542000
                LEN,                                           <<06067>>46544000
                INSIZE,                                        <<06067>>46546000
                TERMCNTL,   <<TERMINATING CONTROL>>            <<06067>>46548000
                TERMTYPE,                                      <<*LDT*>>46550000
                LDT'INDEX,                                     <<*DVR*>>46552000
                LPDT'INDEX,                                    <<*LDTX>>46554000
                LDTX'INDEX,                                    <<*DVR*>>46556000
                DVR'INDEX;                                     <<*DVR*>>46558000
                                                               <<06067>>46560000
        INTEGER POINTER                                        <<dctab>>46562000
            DCT;                                               <<dctab>>46564000
        DOUBLE POINTER                                         <<csdec>>46566000
            DBLPTR;                                            <<csdec>>46568000
        INTEGER POINTER                                        <<dctab>>46570000
            DEST,                 << DESTINATION OF MOVE     >><<dctab>>46572000
            SOURCE;               << SOURCE OF MOVE          >><<dctab>>46574000
                                                               <<dctab>>46576000
        INTEGER                                                <<dctab>>46578000
            COUNT;                << NUMBER OF WORDS TO MOVE >><<dctab>>46580000
BYTE POINTER                                                   <<t8392>>46582000
     POUT,                                                     <<t8392>>46584000
     DCT'B;                                                    <<t8392>>46586000
INTEGER NAME'PTR;                                              <<t8392>>46588000
        SUBROUTINE ZEROLDTX;  <<ZEROES THE LDTX ENTRY>>        <<04328>>46590000
          BEGIN                   <<FOR A GIVEN LDEV>>         <<04328>>46592000
          TOS := @LDTX(LDEV * LDTXSIZE);                       <<04328>>46594000
          PS0 := 0;                                            <<04328>>46596000
          ASSEMBLE (DUP,INCB);                                 <<04328>>46598000
          TOS := LDTXSIZE-1;                                   <<04328>>46600000
          ASSEMBLE (MOVE 3);                                   <<04328>>46602000
          END;                                                 <<04328>>46604000
                                                               <<06067>>46606000
        << SUBROUTINE TO FULLY QUALIFY A FILENAME >>           <<06067>>46608000
                                                               <<06067>>46610000
        LOGICAL SUBROUTINE FULLY'QUALIFY;                      <<06067>>46612000
          BEGIN                                                <<06067>>46614000
          <<RETURNS TRUE IF A VALID FILENAME WAS INPUT.>>      <<06067>>46616000
          <<FILE, GROUP, AND ACCT CONTAIN THE FULLY    >>      <<06067>>46618000
          <<FULLY QUALIFIED FILENAME UPON EXITING.     >>      <<06067>>46620000
          MOVE FILE  := "        ";                            <<06067>>46622000
          MOVE GROUP := "        ";                            <<06067>>46624000
          MOVE ACCT  := "        ";                            <<06067>>46626000
          FQFNAME := " ";                                      <<06067>>46628000
          MOVE FQFNAME(1):=FQFNAME,(25);  <<BLANK>>            <<06067>>46630000
          IF BPINBUF = ALPHA THEN                              <<06067>>46632000
            BEGIN                                              <<06067>>46634000
            IF INSIZE > 26 THEN                                <<06067>>46636000
              GOTO TTFERRS;                                    <<06067>>46638000
            FULLY'QUALIFY := TRUE;                             <<06067>>46640000
            FQFNSIZE:=GETSTR(FQFNAME,@DONE,TERMCNTL,INSIZE,    <<06067>>46642000
                                              ".");            <<06067>>46644000
            IF < THEN                                          <<06067>>46646000
              IF TERMCNTL=1 THEN                               <<06067>>46648000
                GOTO TTFERRS;  <<COMMA FOLLOWS INPUT>>         <<06067>>46650000
            MOVE FILE := FQFNAME WHILE ANS,1;                  <<06067>>46652000
            FSIZE := TOS-@FILE; <<SIZE OF NAME IN FILE>>       <<06067>>46654000
            IF NOT (1 <= FSIZE <= 8) THEN GOTO TTFERRS;        <<06067>>46656000
            BINDEX := FSIZE; <<INTERMEDIATE SIZE>>             <<06067>>46658000
            IF BINDEX < FQFNSIZE THEN GOTO GNAME               <<06067>>46660000
            ELSE                                               <<06067>>46662000
              BEGIN                                            <<06067>>46664000
              MOVE GROUP := "PUB     ";                        <<06067>>46666000
              MOVE ACCT  := "SYS     ";                        <<06067>>46668000
              RETURN; <<DONE>>                                 <<06067>>46670000
              END;                                             <<06067>>46672000
GNAME:      BINDEX := BINDEX + 1;   <<SKIP THE ".">>           <<06067>>46674000
            IF FQFNAME(BINDEX) <> ALPHA THEN                   <<06067>>46676000
              GOTO TTFERRS;                                    <<06067>>46678000
            MOVE GROUP  := FQFNAME(BINDEX) WHILE ANS,1;        <<06067>>46680000
            GSIZE := TOS - @GROUP;                             <<06067>>46682000
            IF NOT (1 <= GSIZE <= 8) THEN GOTO TTFERR;         <<06067>>46684000
            BINDEX := BINDEX + GSIZE;                          <<06067>>46686000
            IF BINDEX < FQFNSIZE THEN GOTO ANAME               <<06067>>46688000
            ELSE                                               <<06067>>46690000
              BEGIN                                            <<06067>>46692000
              MOVE ACCT := "SYS     ";                         <<06067>>46694000
              RETURN;                                          <<06067>>46696000
              END;                                             <<06067>>46698000
ANAME:            BINDEX := BINDEX + 1;   <<SKIP THE ".">>     <<06067>>46700000
            IF FQFNAME(BINDEX) <> ALPHA THEN                   <<06067>>46702000
              GOTO TTFERRS;                                    <<06067>>46704000
            MOVE ACCT := FQFNAME(BINDEX) WHILE ANS,1;          <<06067>>46706000
            ASIZE := TOS - @ACCT;                              <<06067>>46708000
            IF (FSIZE+GSIZE+ASIZE+2) <> FQFNSIZE THEN          <<06067>>46710000
              GOTO TTFERRS;                                    <<06067>>46712000
            IF NOT (1 <= ASIZE <= 8) THEN GOTO TTFERRS;        <<06067>>46714000
            << PAD WITH BLANKS >>                              <<06067>>46716000
            WHILE FSIZE < 8 DO                                 <<06067>>46718000
              BEGIN                                            <<06067>>46720000
              FILE(FSIZE) := " ";                              <<06067>>46722000
              FSIZE := FSIZE + 1;                              <<06067>>46724000
              END;                                             <<06067>>46726000
            WHILE GSIZE < 8 DO                                 <<06067>>46728000
              BEGIN                                            <<06067>>46730000
              GROUP(GSIZE) := " ";                             <<06067>>46732000
              GSIZE := GSIZE + 1;                              <<06067>>46734000
              END;                                             <<06067>>46736000
            WHILE ASIZE < 8 DO                                 <<06067>>46738000
              BEGIN                                            <<06067>>46740000
              ACCT(ASIZE) := " ";                              <<06067>>46742000
              ASIZE := ASIZE + 1;                              <<06067>>46744000
              END;                                             <<06067>>46746000
            END  <<ALPHA>>                                     <<06067>>46748000
          ELSE   <<NOT ALPHA>>                                 <<06067>>46750000
            BEGIN                                              <<06067>>46752000
TTFERRS:    MESSAGE(M2453);  <<ILLEGAL INPUT>>                 <<06067>>46754000
DONE:       FULLY'QUALIFY := FALSE;                            <<06067>>46756000
            END;                                               <<06067>>46758000
          END;  <<SUBROUTINE FULLY'QUALIFY>>                   <<06067>>46760000
                                                               <<s8967>>46762000
     SUBROUTINE INOUTSPOOL;                                    <<s8967>>46764000
        BEGIN                                                  <<s8967>>46766000
                                                               <<s8967>>46768000
        IF 8<=LDT'DEVICE'TYPE<=15 THEN                         <<s8967>>46770000
   INONLY:  LDT'SPOOL'STATE := 1                               <<s8967>>46772000
          ELSE IF 32<=LDT'DEVICE'TYPE<=39 THEN                 <<s8967>>46774000
                 BEGIN                                         <<s8967>>46776000
   OUTONLY:      LDT'SPOOL'STATE := 2;                         <<s8967>>46778000
                 LDT'SPOOL'QUEUES := 1;                        <<s8967>>46780000
                 END                                           <<s8967>>46782000
               ELSE IF 16<=LDT'DEVICE'TYPE<=31 THEN            <<s8967>>46784000
                      BEGIN                                    <<s8967>>46786000
   ASKAGAIN:          MESSAGE(-M2308);<<SPOOL IN OR OUT>>      <<s8967>>46788000
                      READINPUT;                               <<s8967>>46790000
                      GETSTR(BBUF,@ASKAGAIN,1,3);              <<s8967>>46792000
                      IF BBUF="IN" THEN GO INONLY              <<s8967>>46794000
                        ELSE IF BBUF="OUT" THEN GO OUTONLY;    <<s8967>>46796000
                      MESSAGE(M2453);                          <<s8967>>46798000
                      GO ASKAGAIN;                             <<s8967>>46800000
                      END;                                     <<s8967>>46802000
       END;  << SUBROUTINE INOUTSPOOL >>                       <<s8967>>46804000
                                                               <<s8967>>46806000
        IF LGETYESNO(M2040) THEN                               << 8392>>46808000
         BEGIN                                                 << 8392>>46810000
           IOMAP;                                              << 8392>>46812000
           IOMAPDONE := TRUE;                                  << 8392>>46814000
           INITIDINFO;                                         << 8392>>46816000
         END;                                                  << 8392>>46818000
          TCLASSINCR := 2;  << MAKE ROOM FOR HEADER  >>        <<tclas>>46820000
          MOVEDLTABLES;                                        <<tclas>>46822000
          TCLASS  := 0;      <<NO ENTRIES IN TEMPCLASS>>       <<MPEIV>>46824000
          TCLASS(1)    := 2;  <<TEMPCASS LENGTH IS TWO WORDS >><<tclas>>46826000
  REQOLIO:IF LGETYESNO(M2009) THEN   <<LIST I/O DEVICES>>      <<MPEIV>>46828000
            LISTIODEV;                                         <<MPEIV>>46830000
          IF CSPRESENT AND LGETYESNO(M2100) THEN LISTCSDEV;    <<MPEIV>>46832000
          IF LGETYESNO(M2043) THEN LIST'DEFAULTS;              <<t8392>>46834000
          GETNEWVAL(M2010,COMM(DRTNUM),LOWESTDRT,MAXDRT);      <<CONFD>>46836000
  REQLDEV:LDEV := GETVAL(M2011,0,999,2);  <<LOGICAL DEVICE #?>><<LIMIT>>46838000
          IF LDEV=0 THEN GOTO REQOSP;                          <<MPEIV>>46840000
          DEV'DEFAULTS := FALSE;                               <<t8392>>46842000
          TERM'DEFAULTS := FALSE;                              <<t8392>>46844000
  REQNAME:MESSAGE(-M2041); << DEFAULT DEVICE NAME >>           <<t8392>>46846000
          READINPUT;                                           <<t8392>>46848000
          TOS := GETSTR(DEV'NAME,@REQNAME,3,16,0);             <<t8392>>46850000
          IF TOS > 0 THEN                                      <<t8392>>46852000
           IF NAME'FOUND(DEV'NAME) THEN                        << 8392>>46854000
           BEGIN                                               << 8392>>46856000
             DEV'DEFAULTS := TRUE;                             << 8392>>46858000
             IF NOT IOMAPDONE THEN                             << 8392>>46860000
             BEGIN                                             << 8392>>46862000
               LIST := FALSE;                                  << 8392>>46864000
               IOMAP;                                          << 8392>>46866000
               LIST := TRUE;                                   << 8392>>46868000
               INITIDINFO;                                     << 8392>>46870000
               IOMAPDONE := TRUE;                              << 8392>>46872000
             END;                                              << 8392>>46874000
           END                                                 << 8392>>46876000
           ELSE                                                << 8392>>46878000
           BEGIN                                               << 8392>>46880000
             MESSAGE(M2052);                                   << 8392>>46882000
             GO REQNAME;                                       << 8392>>46884000
           END;                                                << 8392>>46886000
                                                               << 8392>>46888000
  REQDRTN:DSDEVICE := FALSE;                                   <<MPEIV>>46890000
          DEFDRT := FALSE;                                     << 8392>>46892000
          DRTDONE := FALSE;                                    << 8392>>46894000
          IF DEV'DEFAULTS THEN                                 << 8392>>46896000
          BEGIN                                                << 8392>>46898000
            DRTN := 0;                                         << 8392>>46900000
            FIND'ENTRY(DRTN,UNIT,TL'ID'CODE);                  << 8392>>46902000
            IF DRTN <> 0 THEN  << FOUND A FREE DRT >>          << 8392>>46904000
            BEGIN                                              << 8392>>46906000
              DRTDONE := TRUE;                                 << 8392>>46908000
              TOS := DRTN;                                     << 8392>>46910000
              VERIFY'VALUES(M2012,DRTN,0,MAXDRT,1);            << 8392>>46912000
              IF (DRTN <> 0) AND (DRTN < LOWESTDRT) THEN       << 8392>>46914000
              BEGIN                                            << 8392>>46916000
                DEL;                                           << 8392>>46918000
                MESSAGE(M2453);                                << 8392>>46920000
                GO REQDRTN;                                    << 8392>>46922000
              END;                                             << 8392>>46924000
              IF DRTN = TOS  << HE TOOK THE BAIT >>            << 8392>>46926000
                 THEN DEFDRT := TRUE;                          << 8392>>46928000
            END; << FREE DRT FOUND >>                          << 8392>>46930000
          END;                                                 << 8392>>46932000
          IF NOT DRTDONE THEN                                  << 8392>>46934000
          BEGIN  << TREAT IT JUST LIKE ALWAYS >>               << 8392>>46936000
          MESSAGE(-M2012);   <<DRTN?>>                         <<MPEIV>>46938000
          READINPUT;                                           <<MPEIV>>46940000
          SCAN BPINBUF WHILE BLANK,1; <<DELETE LEADING BLANKS>><<MPEIV>>46942000
          IF BPS0="#" THEN                                     <<MPEIV>>46944000
            BEGIN  <<DS DEVICE>>                               <<MPEIV>>46946000
            DSDEVICE := TRUE;                                  <<MPEIV>>46948000
            @BPINBUF := TOS+1;                                 <<MPEIV>>46950000
            DRTN := INVAL(@REQDRTN);                           <<MPEIV>>46952000
            IF <= THEN                                         <<MPEIV>>46954000
              BEGIN <<NOT FOLLOWED BY CR>>                     <<MPEIV>>46956000
              MESSAGE(M2453);                                  <<MPEIV>>46958000
              GO REQDRTN;                                      <<MPEIV>>46960000
              END;                                             <<MPEIV>>46962000
            IF NOT NON'DS'LDEV(DRTN) THEN                      <<03599>>46964000
              BEGIN <<DS DEV LINKED TO DS OR NON EXISTING DEV>><<MPEIV>>46966000
              MESSAGE(M114); << ILLEGAL MASTER DEVICE >>       <<MPEIV>>46968000
              GO REQDRTN;                                      <<MPEIV>>46970000
              END;                                             <<MPEIV>>46972000
            END                                                <<MPEIV>>46974000
          ELSE                                                 <<MPEIV>>46976000
            BEGIN <<REAL DEVICE>>                              <<MPEIV>>46978000
            DRTN := INVAL(@REQDRTN);                           <<MPEIV>>46980000
            IF <= OR 1<=DRTN<=LOWESTDRT-1 OR                   <<MPEIV>>46982000
        DRTN<0 OR DRTN > MAXDRT THEN                           <<03002>>46984000
              BEGIN                                            <<MPEIV>>46986000
              MESSAGE(M2453);                                  <<MPEIV>>46988000
              GO REQDRTN;                                      <<MPEIV>>46990000
              END;                                             <<MPEIV>>46992000
            END;                                               <<MPEIV>>46994000
          END;                                                 << 8392>>46996000
                                                               <<03599>>46998000
          IF LDEV'EXISTS(LDEV) THEN                            <<03599>>47000000
            BEGIN  << OLD LDEV IS REAL OR CS DEVICE >>         <<03599>>47002000
              << REMOVE TTDT ENTRY IF LDEV IS A TERMINAL >>    <<06067>>47004000
              LDT'INDEX := LDEV * LDTSIZE;                     <<*LDT*>>47006000
              LPDT'INDEX := LDEV * LPDTSIZE;                   <<*LPDT>>47008000
              DVR'INDEX := LDEV * DVRSIZE;                     <<misc*>>47010000
              LDTX'INDEX := LDEV * LDTXSIZE;                   <<misc*>>47012000
              IF LDT'DEVICE'TYPE = 16 << TERMINAL >> OR        <<*LDT*>>47014000
                 LDT'DEVICE'TYPE = 32 << PRINTER >> AND        <<*LDT*>>47016000
                 (LPDT'SUBTYPE = 14 OR                         <<*LPDT>>47018000
                 LPDT'SUBTYPE = 15) THEN                       <<*LPDT>>47020000
                 REMOVETTDTREFS(LDEV);                         <<*7777>>47022000
              IF DRTN=0 AND LDEV=HLDEV THEN                    <<03599>>47024000
                  DO UNTIL LDEV'EXISTS(HLDEV:=HLDEV-1)         <<03599>>47026000
                           OR HLDEV=0;                         <<03599>>47028000
              IF DRTN = 0 THEN                                 << 8392>>47030000
              BEGIN                                            << 8392>>47032000
                TOS := DVRDRTNUM;  << DRT >>                   << 8392>>47034000
                TOS := DVRUNITNUM;  << UNIT >>                 << 8392>>47036000
               IF IOMAPDONE THEN DEALLOC'DEV(*,*);             << 8392>>47038000
              END;                                             << 8392>>47040000
              TYPE := LDT'DEVICE'TYPE;                         <<misc*>>47042000
              DVRTAB(DVR'INDEX) := 0;                          <<misc*>>47044000
              MOVE DVRTAB(DVR'INDEX + 1) :=                    <<misc*>>47046000
                   DVRTAB(DVR'INDEX),(DVRSIZE-1);              <<misc*>>47048000
              LPDT( LPDT'INDEX ) := 0;                         <<misc*>>47050000
              MOVE LPDT(LPDT'INDEX + 1) :=                     <<misc*>>47052000
                   LPDT(LPDT'INDEX),(LPDTSIZE-1);              <<misc*>>47054000
                                                               <<*LPDT>>47056000
              LDT(LDT'INDEX) := 0;                             <<misc*>>47058000
              MOVE LDT(LDT'INDEX + 1) :=                       <<misc*>>47060000
                   LDT(LDT'INDEX),(LDTSIZE - 1);               <<misc*>>47062000
              LDTX(LDTX'INDEX) := 0;                           <<misc*>>47064000
              MOVE LDTX(LDTX'INDEX + 1) :=                     <<misc*>>47066000
                   LDTX(LDTX'INDEX),(LDTXSIZE - 1);            <<misc*>>47068000
              IF CSDEV17<=TYPE<=CSDEV19 THEN                   <<misc*>>47070000
               BEGIN <<DELETE CSLDIX ENTRY>>                   <<MPEIV>>47072000
               CSTAB(X) := CSTAB(CSLDTXENTNUM)-1;              <<MPEIV>>47074000
               TOS := CSDEF(LDEV);                             <<MPEIV>>47076000
               CSDEF(X) := 0;                                  <<MPEIV>>47078000
               X := 0;                                         <<MPEIV>>47080000
               DO                                              <<MPEIV>>47082000
                 IF S0<=CSDEF(X) THEN                          <<MPEIV>>47084000
                   CSDEF(X):=CSDEF(X)-1                        <<MPEIV>>47086000
               UNTIL (X:=X+1)=CSDEFSIZE;                       <<MPEIV>>47088000
               TEMP := TOS;                                    <<MPEIV>>47090000
               @CSLDTX := @CSTAB+CSXSTART;                     <<MPEIV>>47092000
               I := -1;                                        <<MPEIV>>47094000
               WHILE (I:=I+1) < TEMP DO                        <<MPEIV>>47096000
                 @CSLDTX := CSLDTX+@CSLDTX;                    <<MPEIV>>47098000
               TEMP := CSLDTX;   <<CONTRACT CSLDTX>>           <<MPEIV>>47100000
               TOS := @CSLDTX;                                 <<MPEIV>>47102000
               TOS := S0+TEMP;                                 <<MPEIV>>47104000
               TOS := -S0+CSTAB+@CSTAB;                        <<MPEIV>>47106000
               ASSEMBLE(MOVE 3);                               <<MPEIV>>47108000
               TOS := CSTAB-TEMP;                              <<MPEIV>>47110000
               CSTAB := S0;                                    <<MPEIV>>47112000
               CSTAB(DRIVERENTPTR) := S0;                      <<MPEIV>>47114000
               CSTAB(4) := TOS;                                <<MPEIV>>47116000
               CSTABINCR := -TEMP; <<DECREASE TABLE>>          <<MPEIV>>47118000
               MOVEDLTABLES;                                   <<MPEIV>>47120000
               END;                                            <<MPEIV>>47122000
              REMOVECLASSREFS;<<REMOVE REFERENCES TO THIS DEV>><<MPEIV>>47124000
              REMTEMPCLASS(LDEV);                              <<tclas>>47126000
  CLASSESCLEAN:                                                <<MPEIV>>47128000
              IF DRTN=0 THEN GO REQLDEV;                       <<MPEIV>>47130000
            END                                                <<MPEIV>>47132000
          ELSE IF DRTN=0 THEN                                  <<MPEIV>>47134000
            BEGIN                                              <<MPEIV>>47136000
              MESSAGE(M2410);  <<NO SUCH DEVICE>>              <<MPEIV>>47138000
              GO REQLDEV;                                      <<MPEIV>>47140000
            END                                                <<MPEIV>>47142000
          ELSE IF LDEV>HLDEV THEN                              <<MPEIV>>47144000
              HLDEV := LDEV                                    <<zrela>>47146000
           ELSE <<ADDING AN LDEV THAT DIDNT PREVIOUSLY EXIST>> <<04328>>47148000
          BEGIN                                                <<misc*>>47150000
            LPDT'INDEX := LDEV * LPDTSIZE;                     <<misc*>>47152000
            LPDT(LPDT'INDEX) := 0;                             <<misc*>>47154000
            MOVE LPDT(LPDT'INDEX + 1) :=                       <<misc*>>47156000
                 LPDT(LPDT'INDEX),(LPDTSIZE - 1);              <<misc*>>47158000
          END;                                                 <<misc*>>47160000
          DVR'INDEX := LDEV * DVRSIZE;                         <<*DVR*>>47162000
          LDT'INDEX := LDEV * LDTSIZE;                         <<*LDT*>>47164000
          LDTX'INDEX := LDEV * LDTXSIZE;                       <<*LDTX>>47166000
          LPDT'INDEX := LDEV * LPDTSIZE;                       <<*LPDT>>47168000
 REQUNIT: IF DEFDRT                                            << 8392>>47170000
             THEN VERIFY'VALUES(M2013,UNIT,0,MAXUNIT,1)        << 8392>>47172000
             ELSE UNIT := GETVAL(M2013,0,MAXUNIT,1);           << 8392>>47174000
          IF IOMAPDONE THEN ALLOC'DEV(DRTN,UNIT);              << 8392>>47176000
          IF DSDEVICE THEN                                     <<MPEIV>>47178000
            BEGIN                                              <<MPEIV>>47180000
            DVRDSBIT := 1;                                     <<*DVR*>>47182000
            DVRMASTERLDEV := DRTN;                             <<*DVR*>>47184000
            END                                                <<MPEIV>>47186000
          ELSE DVRDRTNUM := DRTN;                              <<*DVR*>>47188000
          DVRUNITNUM := UNIT;                                  <<*DVR*>>47190000
          VAL := TL'CHAN'NUM;                                  <<t8392>>47192000
          VERIFY'VALUES(M2014,VAL,0,4,1);                      <<t8392>>47194000
          DVRCHANNUM := VAL;                                   <<t8392>>47196000
          LDT'AVAIL'TO'SYS := 1; <<BELONGS TO FILE SYSTEM>>    <<*LDT*>>47198000
  REQTYPE:                                                     <<t8392>>47200000
          VAL := TL'DEV'TYPE;                                  <<t8392>>47202000
          VERIFY'VALUES(M2015,VAL,0,63,1);                     <<t8392>>47204000
          TYPE := VAL;                                         <<t8392>>47206000
          IF CSDEV AND UNIT<>0 OR TYPE=SDISC                   <<03550>>47208000
          OR TYPE=FDISC THEN                                   <<03550>>47210000
            BEGIN                                              <<03550>>47212000
            MESSAGE(M2140);   << ILLEGAL TYPE OR UNIT >>       <<03550>>47214000
            GO REQUNIT;                                        <<03550>>47216000
            END;                                               <<03550>>47218000
          LDT'DEVICE'TYPE := TYPE;  << PUT TYPE IN LDT >>      <<*LDT*>>47220000
          IF CSDEV THEN                                        <<MPEIV>>47222000
            BEGIN     <<CS DEVICE>>                            <<MPEIV>>47224000
            LDT'CS'DEVICE := 1;                                <<*LDT*>>47226000
            CSTAB(X) := CSTAB(CSLDTXENTNUM)+1;                 <<MPEIV>>47228000
            @CSLDTX := @LBUF(512);                             <<MPEIV>>47230000
            CSLDTX := 0;                                       <<MPEIV>>47232000
            MOVE CSLDTX(1) := CSLDTX,(500);                    <<MPEIV>>47234000
            CSINDX := CONTRSTART;                              <<MPEIV>>47236000
            CSLDTXEXP:=1;  <<SET TABLE EXPANDED BIT>>          <<MPEIV>>47238000
            IF TYPE=CSDEV17 THEN CSLDTXMAX'DUMPS:=20;          <<MPEIV>>47240000
            END;                                               <<MPEIV>>47242000
REQSTYP:                                                       <<t8392>>47244000
          VAL := TL'DEV'SUBTYPE;                               <<t8392>>47246000
          VERIFY'VALUES(M2016,VAL,0,15,1);                     <<t8392>>47248000
          SUBTYP := VAL;                << SUBTYPE? >>         <<t8392>>47250000
          IF (TYPE=CSDEV17 OR TYPE=CSDEV18) AND                <<03550>>47252000
          SUBTYP<>0 AND SUBTYP<>1 AND                          <<03550>>47254000
            SUBTYP<>3 AND SUBTYP<>7 AND                        <<L8570>>47256000
            SUBTYP<>9 OR                                       <<L8570>>47258000
          TYPE=CSDEV19 AND SUBTYP<>0 AND SUBTYP<>3 THEN        <<03550>>47260000
            BEGIN                                              <<03550>>47262000
            MESSAGE(M2141);  << ILLEGAL TYPE OR SUBTYPE >>     <<03550>>47264000
            GO REQSTYP;                                        <<03550>>47266000
            END;                                               <<03550>>47268000
          LPDT'SUBTYPE := SUBTYP;                              <<*LPDT>>47270000
                                                               <<06067>>47272000
      <<---------------------------------------------------->> <<T8754>>47274000
      << BEGIN TERMINAL TYPE/DESCRIPTOR FILENAME CHANGES FOR>> <<T8754>>47276000
      << LYNXII.                                            >> <<T8754>>47278000
      <<---------------------------------------------------->> <<T8754>>47280000
                                                               <<T8754>>47282000
          IF TYPE= 16 << TERMINAL >> OR                        <<*LDT*>>47284000
            TYPE = 32 << PRINTER >> AND                        <<*LDT*>>47286000
          (SUBTYP=14 OR SUBTYP=15) THEN                        <<03550>>47288000
            BEGIN                                              <<MPEIV>>47290000
REQTERMT:                                                      <<t8392>>47292000
            TERMTYPE := %37; <<DEFAULT TERMTYPE>>              <<t8392>>47294000
            LDTX'TDT'OFFSET := -1;  <<OFFSET INTO TTDT>>       <<t8392>>47296000
            MOVE BTEMP:=("ENTER [TERM TYPE #],[DESCRIPTOR ",   <<t8392>>47298000
                         "FILENAME] "), 2;                     <<t8392>>47300000
            IF DEV'DEFAULTS THEN                               <<t8392>>47302000
               BEGIN                                           <<t8392>>47304000
               MOVE BPS0 := "= ( ",2;                          <<t8392>>47306000
               IF TL'TERM'TYPE <> 0  THEN                      <<t8392>>47308000
                  BEGIN                                        <<t8392>>47310000
                  TERMTYPE := TL'TERM'TYPE;                    <<t8392>>47312000
                  TOS := TOS + ASCII(TERMTYPE,10,BPS0);        <<t8392>>47314000
                  TERM'DEFAULTS := TRUE;                       <<t8392>>47316000
                  END;                                         <<t8392>>47318000
               IF TL'TTDF'PTR <> 0  THEN                       <<t8392>>47320000
                  BEGIN                                        <<t8392>>47322000
                  NAME'PTR := TL'TTDF'PTR & LSL (1);           <<t8392>>47324000
               MOVE * := " , ", 2;                             <<t8392>>47326000
                  MOVE * := TL'ENTB(NAME'PTR), (8), 2;         <<t8392>>47328000
                  MOVE * := ".", 2;                            <<t8392>>47330000
                  MOVE * := TL'ENTB(NAME'PTR + 8), (8), 2;     <<t8392>>47332000
                  MOVE * := ".", 2;                            <<t8392>>47334000
                  MOVE * := TL'ENTB(NAME'PTR + 16) , (8), 2;   <<t8392>>47336000
                  TERM'DEFAULTS := TRUE;                       <<t8392>>47338000
                  END;                                         <<t8392>>47340000
               MOVE * := " )", 2;                              <<t8392>>47342000
               END;                                            <<t8392>>47344000
            MOVE * := " ?",2;                                  <<t8392>>47346000
            @POUT:=TOS;                                        <<t8392>>47348000
            PRINT (IBTEMP , @BTEMP-@POUT, %320);               <<t8392>>47350000
            READINPUT;                                         <<t8392>>47352000
            SCAN BINBUF WHILE BLANK, 1;                        <<t8392>>47354000
            IF TERM'DEFAULTS AND CARRY THEN                    <<t8392>>47356000
               BEGIN  <<DEFAULTS USED>>                        <<t8392>>47358000
               MOVE BPINBUF:=BTEMP(46),(@POUT-@BTEMP(46)-4),2; <<T8754>>47360000
               MOVE * := %15; <<CARRIAGE RETURN>>              <<t8392>>47362000
               END;                                            <<t8392>>47364000
            IF NOCARRY OR TERM'DEFAULTS THEN                   <<t8392>>47366000
              BEGIN                                            <<*7777>>47368000
              @BPINBUF := TOS;                                 <<*7777>>47370000
              <<IF 1ST BYTE= #, A TERMTYPE # WAS INPUT>>       <<*7777>>47372000
              IF BPINBUF = NUMERIC THEN                        <<*7777>>47374000
                BEGIN                                          <<*7777>>47376000
                TERMTYPE := INVAL(@TTFERR);                    <<*7777>>47378000
                IF < THEN   <<COMMA DELIMITER>>                <<*7777>>47380000
                  IF NOT (0 <= TERMTYPE <= %36) THEN           <<*7777>>47382000
                    GOTO TTFERR                                <<*7777>>47384000
                  ELSE                                         <<*7777>>47386000
                    GOTO FNAME;  <<BPINBUF POINTING TO NAME>>  <<*7777>>47388000
                IF NOT (0 <= TERMTYPE <= %36) THEN             <<*7777>>47390000
                  GOTO TTFERR;                                 <<*7777>>47392000
                GOTO TTDONE;  << ONLY A # WAS INPUT >>         <<*7777>>47394000
                END                                            <<*7777>>47396000
              ELSE                                             <<*7777>>47398000
                BEGIN                                          <<*7777>>47400000
FNAME:          INSIZE := 26;  <<MAX LEN>>                     <<*7777>>47402000
                TERMCNTL := 1; <<CR DELIMINATOR>>              <<*7777>>47404000
                IF NOT FULLY'QUALIFY THEN                      <<*7777>>47406000
                  GOTO REQTERMT;                               <<*7777>>47408000
                END;                                           <<*7777>>47410000
              END  <<NOT A CARRIAGE RETURN INPUT>>             <<*7777>>47412000
            ELSE <<CARRIAGE RETURN INPUT, DEFAULT USED>>       <<*7777>>47414000
              GOTO TTDONE;                                     <<*7777>>47416000
GOODINPUT: << "#,FILENAME", OR "FILENAME" HAS BEEN INPUT >>    <<*7777>>47418000
            @TDT := @TDTAB;                                    <<*7777>>47420000
            @TDT'B := @TDT & LSL(1);                           <<*7777>>47422000
            I := 0;                                            <<*7777>>47424000
            WHILE (I:=I+1) <= DCTH'NUM'TDT'ENTRIES DO          <<*7777>>47426000
              BEGIN                                            <<*7777>>47428000
              IF (TDTB'FILE'NAME = FILE,(8)) AND               <<*7777>>47430000
                 (TDTB'GROUP'NAME = GROUP,(8)) AND             <<*7777>>47432000
                 (TDTB'ACCT'NAME = ACCT,(8)) THEN              <<*7777>>47434000
                   GOTO FILNEXST;                              <<*7777>>47436000
              @TDT := @TDT + TDT'NEXT'ENTRY;                   <<*7777>>47438000
              @TDT'B := @TDT & LSL(1);                         <<*7777>>47440000
              END;                                             <<*7777>>47442000
            <<MAKE ROOM FOR NEW ENTRY>>                        <<*7777>>47444000
            TDTABINCR := 14;                                   <<*7777>>47446000
            MOVEDLTABLES;                                      <<*7777>>47448000
            @TDT := @TDT - 14; << TABLE HAS MOVED DOWN >>      <<*7777>>47450000
            @TDT'B := @TDT & LSL(1);                           <<*7777>>47452000
            MOVE TDTB'FILE'NAME := FILE,(8);                   <<*7777>>47454000
            MOVE TDTB'GROUP'NAME := GROUP,(8);                 <<*7777>>47456000
            MOVE TDTB'ACCT'NAME := ACCT,(8);                   <<*7777>>47458000
            TDT'NUM'DEVICES := 1;                              <<*7777>>47460000
            TDT(TDT'FIRST'LDEV+1) := LDEV;                     <<*7777>>47462000
            DCTH'SEGMENT'SIZE := DCTH'SEGMENT'SIZE + 14;       <<*7777>>47464000
            DCTH'NUM'TDT'ENTRIES := DCTH'NUM'TDT'ENTRIES + 1;  <<*7777>>47466000
            GOTO TTFOFFSET;                                    <<*7777>>47468000
FILNEXST:   << ADD TO AN ALREADY EXISTING ENTRY >>             <<*7777>>47470000
            TDTABINCR := 1;                                    <<*7777>>47472000
            MOVEDLTABLES;                                      <<*7777>>47474000
            @TDT := @TDT - 1;                                  <<*7777>>47476000
            @DEST := @DCT'HEAD + DCTH'SEGMENT'SIZE;            <<*7777>>47478000
            @SOURCE := @DEST - 1;                              <<*7777>>47480000
            COUNT := (@SOURCE - @TDT(TDT'NEXT'ENTRY)) + 1;     <<*7777>>47482000
            MOVE DEST := SOURCE,(-COUNT);                      <<*7777>>47484000
            TDT(TDT'NEXT'ENTRY) := LDEV;                       <<*7777>>47486000
            TDT'NUM'DEVICES := TDT'NUM'DEVICES + 1;            <<*7777>>47488000
            DCTH'SEGMENT'SIZE := DCTH'SEGMENT'SIZE + 1;        <<*7777>>47490000
            GOTO TTFOFFSET;                                    <<*7777>>47492000
TTFERR:     MESSAGE(M2453);   <<ILLEGAL INPUT>>                <<*7777>>47494000
            GOTO REQTERMT;                                     <<*7777>>47496000
TTFOFFSET:                                                     <<*7777>>47498000
            CALC'TTF'OFFSET;                                   <<*7777>>47500000
TTDONE:     <<RECALCULATE ENTS BECAUSE OF CALL TO MOVEDLTABS>> <<06067>>47502000
            DVR'INDEX := LDEV * DVRSIZE;                       <<*DVR*>>47504000
            LDT'INDEX := LDEV * LDTSIZE;                       <<*LDT*>>47506000
            LDTX'INDEX := LDEV * LDTXSIZE;                     <<*LDTX>>47508000
            LPDT'INDEX := LDEV * LPDTSIZE;                     <<*LPDT>>47510000
            LDT'DFLT'TERM'TYPE := TERMTYPE;                    <<*LDT*>>47512000
REQSPEED:                                                      <<t8392>>47514000
            IF DEV'DEFAULTS THEN                               <<T8766>>47516000
               BEGIN                                           <<T8766>>47518000
               SPEEDCDE := TL'TERM'SPEED;                      <<T8766>>47520000
               TSPEED   := -1;                                 <<T8766>>47522000
               CHECKSPEED(TSPEED, SPEEDCDE);                   <<T8766>>47524000
               VAL := TSPEED;                                  <<T8766>>47526000
               END;                                            <<T8766>>47528000
                                                               <<T8766>>47530000
            VERIFY'VALUES(M2018,VAL,0,3840,2);                 <<t8392>>47532000
            I := VAL;                      << TERM SPEED >>    <<t8392>>47534000
$IF X1=ON  << ********** SERIES 33,44,55 UNIQUE ********** >>  <<03004>>47536000
            IF I = 0 THEN I := 240;  << DEFAULT TO 240 >>      <<03004>>47538000
$IF        << ******** RETURNING TO COMMON CODE ********** >>  <<03004>>47540000
                                                               <<03708>>47542000
            << CALL CHECKSPEED TO CHECK TERM. SPEED REPLY >>   <<03004>>47544000
            IF CHECKSPEED( I, SPEEDCDE ) THEN                  <<03004>>47546000
                                                               <<03708>>47548000
              << SUBTYPES > 3 ARE TERMINALS WHICH ARE NON- >>  <<03708>>47550000
              << SPEEDSENSING, THEREFORE A VALID SPEED     >>  <<03708>>47552000
              << MUST BE ENTERED.                          >>  <<03708>>47554000
                                                               <<03708>>47556000
              IF NOT (SPEEDCDE = 0 LAND SUBTYP > 3) THEN       <<03708>>47558000
                 GOTO SPEEDOK;                                 <<03708>>47560000
                                                               <<03004>>47562000
            MESSAGE( M130);  << NOT A SUPPORTED SPEED    >>    <<03004>>47564000
            GO REQSPEED;     << REQUEST TERM SPEED AGAIN >>    <<03004>>47566000
  SPEEDOK:  LDTX'BAUD'RATE'CODE := SPEEDCDE ;                  <<*LDTX>>47568000
              END;      << TERMINAL SPECIFIC PROMPTS >>        <<03708>>47570000
          IF CSDEVICE THEN                                     <<01587>>47572000
            BEGIN                                              <<01587>>47574000
            IF TYPE=CSDEV19 THEN                               <<MPEIV>>47576000
              CSLDTXHSI'CHAN:=GETVAL(M2101,1,15,1);<<PORT MSK>><<MPEIV>>47578000
            IF TYPE<>CSDEV17 THEN                              <<MPEIV>>47580000
            BEGIN                                              <<MPEIV>>47582000
            CSLDTXPROTOCOL:=GETVAL(M2102,1,255,1);<<PROTOCOL>> <<MPEIV>>47584000
            CSLDTXMODE:= GETVAL(M2103,1,15,1);<<LOCAL MODE>>   <<MPEIV>>47586000
            CSLDTXCODE :=GETVAL(M2104,1,63,1);<<XMISSION CODE>><<MPEIV>>47588000
            END;                                               <<MPEIV>>47590000
            <<SKIP ALL CS-RELATED DIALOGUE FOR THE LANIC>>     <<L8570>>47592000
            <<DRIVER : TYPE = 17; SUBTYPE = 9           >>     <<L8570>>47594000
            IF TYPE=CSDEV17 AND SUBTYP  = 9 THEN               <<L8570>>47596000
               GO REQDVR;                                      <<L8570>>47598000
            TOS := GETVAL(M2105,0,32767,2); <<RECEIVE TIMEOUT>><<MPEIV>>47600000
            IF = THEN                                          <<MPEIV>>47602000
              BEGIN  <<CARRIAGE RETURN>>                       <<MPEIV>>47604000
              DEL;                                             <<MPEIV>>47606000
              TOS := 20;                                       <<MPEIV>>47608000
              END;                                             <<MPEIV>>47610000
            CSLDTXRECV'TIMEOUT := TOS;                         <<MPEIV>>47612000
            TOS := GETVAL(M2106,0,32767,2);  <<LOCAL TIMEOUT>> <<MPEIV>>47614000
            IF = THEN                                          <<MPEIV>>47616000
              BEGIN  <<CARRIAGE RETURN>>                       <<MPEIV>>47618000
              DEL;                                             <<MPEIV>>47620000
              TOS := 60;                                       <<MPEIV>>47622000
              END;                                             <<MPEIV>>47624000
            CSLDTXLOCAL'TIMEOUT := TOS;                        <<MPEIV>>47626000
            TOS := GETVAL(M2107,0,32767,2);                    <<MPEIV>>47628000
            IF = THEN                                          <<MPEIV>>47630000
              BEGIN  <<CR>>                                    <<MPEIV>>47632000
              DEL;                                             <<MPEIV>>47634000
              TOS := 900;                                      <<MPEIV>>47636000
              END;                                             <<MPEIV>>47638000
            CSLDTXCONCT'TIMEOUT := TOS;                        <<MPEIV>>47640000
            LPDT'INDEX := LDEV * LPDTSIZE;                     <<*LPDT>>47642000
            IF 3 <= (LPDT'SUBTYPE MOD 4) <= 4 THEN GO SPEEDCH; <<*LPDT>>47644000
                   << HARDWIRED >>                             <<*LPDT>>47646000
            IF NOT(0 <= (LPDT'SUBTYPE MOD 4) <= 2) << MODEM >> <<*LPDT>>47648000
              OR (LPDT'SUBTYPE MOD 4) = 0 THEN << OR SWITCHED>><<*LPDT>>47650000
              BEGIN                                            <<MPEIV>>47652000
  REQDIAL:    MESSAGE(-M2108);  <<DIAL FACILITY?>>             <<MPEIV>>47654000
              READINPUT;                                       <<MPEIV>>47656000
              SCAN BINBUF WHILE BLANK,1;                       <<MPEIV>>47658000
              ASSEMBLE(DUP,DUP);                               <<MPEIV>>47660000
              MOVE * := * WHILE ANS;                           <<MPEIV>>47662000
              IF NOCARRY AND (BPS0<>"N") THEN                  <<MPEIV>>47664000
                 IF BPS0 = "Y" THEN                            <<MPEIV>>47666000
                    BEGIN                                      <<MPEIV>>47668000
                    CSLDTXDIAL := 1;                           <<MPEIV>>47670000
                    END                                        <<MPEIV>>47672000
                 ELSE                                          <<MPEIV>>47674000
                    BEGIN                                      <<MPEIV>>47676000
                    @BPINBUF := @BINBUF;                       <<MPEIV>>47678000
                    TOS:=INVAL(@DIALERR);                      <<MPEIV>>47680000
                    IF <= THEN                                 <<MPEIV>>47682000
                       BEGIN                                   <<MPEIV>>47684000
                       DEL;                                    <<MPEIV>>47686000
                       GO DIALERR;                             <<MPEIV>>47688000
                       END;                                    <<MPEIV>>47690000
                    IF 0<=S0<=255 THEN                         <<MPEIV>>47692000
                       BEGIN                                   <<MPEIV>>47694000
                       CSLDTXDIAL := 1;                        <<MPEIV>>47696000
                       CSLDTXAUTO'DIAL'LDN := TOS;             <<MPEIV>>47698000
                       END;                                    <<MPEIV>>47700000
                    END;                                       <<MPEIV>>47702000
              DEL; GO REQANSW;                                 <<MPEIV>>47704000
  DIALERR:    DEL;                                             <<MPEIV>>47706000
              MESSAGE(1);                                      <<MPEIV>>47708000
              GO REQDIAL;                                      <<MPEIV>>47710000
  REQANSW:    GETYESNO(@REQDUSP,M2109);  <<ANSWER FACILITY?>>  <<MPEIV>>47712000
              GETYESNO(@MANUAL,M2110);   <<AUTOMATIC ANSWER?>> <<MPEIV>>47714000
              CSLDTXANSWER := AUTOANSWER;                      <<MPEIV>>47716000
              GO REQDUSP;                                      <<MPEIV>>47718000
  MANUAL:     CSLDTXANSWER := MANLANSWER;                      <<MPEIV>>47720000
              END;                                             <<MPEIV>>47722000
  REQDUSP:  GETYESNO(@SPEEDCH,M2111); <<DUAL SPEED?>>          <<MPEIV>>47724000
            CSLDTXDUAL'SPEED := 1;                             <<MPEIV>>47726000
            GETYESNO(@REQTRSP,M2112); <<HALF SPEED?>>          <<MPEIV>>47728000
            CSLDTXHALF'SPEED := 1 ;                            <<MPEIV>>47730000
            GO REQTRSP;                                        <<MPEIV>>47732000
  SPEEDCH:  GETYESNO(@REQTRSP,M2113); <<SPEED CHANGEABLE?>>    <<MPEIV>>47734000
            CSLDTXSPEEDCHNGBLE:= 1;                            <<MPEIV>>47736000
  REQTRSP:  MESSAGE(-M2114);  <<TRANSMISSION SPEED?>>          <<MPEIV>>47738000
            READINPUT;                                         <<MPEIV>>47740000
            TOS := 0D;                                         <<MPEIV>>47742000
            TOS := @TRANSER;                                   <<MPEIV>>47744000
            TOS := DINVAL(*);                                  <<MPEIV>>47746000
            IF <= THEN                                         <<MPEIV>>47748000
  TRANSER:    BEGIN                                            <<MPEIV>>47750000
              MESSAGE(M2453);                                  <<MPEIV>>47752000
              GO REQTRSP;                                      <<MPEIV>>47754000
              END;                                             <<MPEIV>>47756000
            ASSEMBLE(DDUP);                                    <<MPEIV>>47758000
            @DBLPTR := @CSLDTXINSPEED;                         <<csdec>>47760000
            DBLPTR := DS1;                                     <<csdec>>47762000
            @DBLPTR := @CSLDTXOUTSPEED;                        <<csdec>>47764000
            DBLPTR := TOS;                                     <<csdec>>47766000
            CSLDTXXMSN'MODE:=GETVAL(M2115,0,3,1);<<XMISSION>>  <<MPEIV>>47768000
            CSLDTXPBUFFSIZE:=GETVAL(M2116,1,4095,1);<<PREFER >><<04255>>47770000
            GETYESNO(@REQDOP,M2117); <<DRIVER CHANGEABLE?>>    <<MPEIV>>47772000
            CSLDTXDRCHANGEABLE := 1;                           <<MPEIV>>47774000
  REQDOP:   CSLDTXDOPTIONS:=GETVAL(M2118,0,32767,1);<<DVR OPT>><<MPEIV>>47776000
            GO REQDVR;                                         <<MPEIV>>47778000
            END;                                               <<MPEIV>>47780000
          VAL := TL'REC'WIDTH;                                 <<t8392>>47782000
          VERIFY'VALUES(M2019,VAL,1,255,1);                    <<t8392>>47784000
          LDT'RECORD'WIDTH := VAL;                             <<t8392>>47786000
  REQODEV:                                                     <<t8392>>47788000
          IF DEV'DEFAULTS THEN                                 <<t8392>>47790000
             IF LOGICAL(TL'DEF'OUT'CLASS) THEN                 <<t8392>>47792000
                BEGIN                                          <<t8392>>47794000
                BINBUF(0) :=%10;<<COUNT FOR GENMESSAGE STR>>   <<t8392>>47796000
                NAME'PTR := TL'DEF'OUT'DEV & LSL(1);           <<t8392>>47798000
                MOVE BINBUF(1) := TL'ENTB(NAME'PTR),(8);       <<t8392>>47800000
                MESSAGE(-M2044,,,,,BINBUF);                    <<t8392>>47802000
                END                                            <<t8392>>47804000
             ELSE                                              <<t8392>>47806000
                BEGIN                                          <<t8392>>47808000
                IF TL'DEF'OUT'DEV < 0 THEN                     <<t8392>>47810000
                   MESSAGE(-M2045,LDEV)                        <<t8392>>47812000
                ELSE                                           <<t8392>>47814000
                   MESSAGE(-M2045,TL'DEF'OUT'DEV);             <<t8392>>47816000
                END                                            <<t8392>>47818000
          ELSE                                                 <<t8392>>47820000
             MESSAGE(-M2020);   <<OUTPUT DEVICE?>>             <<t8392>>47822000
          READINPUT;                                           <<MPEIV>>47824000
          TOS := INVAL(@TRYSTR);                               <<MPEIV>>47826000
          IF < THEN GOTO ODEVERR;                              <<t8392>>47828000
          IF = THEN                                            <<t8392>>47830000
             IF DEV'DEFAULTS THEN                              <<t8392>>47832000
                IF LOGICAL(TL'DEF'OUT'CLASS) THEN              <<t8392>>47834000
                   BEGIN                                       <<t8392>>47836000
                   NAME'PTR := TL'DEF'OUT'DEV & LSL(1);        <<t8392>>47838000
                   FILL'(BINBUF, 80, " ");                     <<t8392>>47840000
                   MOVE BINBUF := TL'ENTB(NAME'PTR),(8),2;     <<t8392>>47842000
                   MOVE * := %15;  <<CR>>                      <<t8392>>47844000
                   GOTO TRYSTR;                                <<t8392>>47846000
                   END                                         <<t8392>>47848000
                ELSE                                           <<t8392>>47850000
                   BEGIN                                       <<t8392>>47852000
                   IF TL'DEF'OUT'DEV < 0 THEN                  <<t8392>>47854000
                      S0 := LDEV                               <<t8392>>47856000
                   ELSE                                        <<t8392>>47858000
                      S0 := TL'DEF'OUT'DEV;                    <<t8392>>47860000
                   END                                         <<t8392>>47862000
             ELSE                                              <<t8392>>47864000
                GOTO ODEVERR;                                  <<t8392>>47866000
          IF 0 <= S0 <= 999 THEN GO SETODEV;                   <<LIMIT>>47868000
  ODEVERR:DEL;                                                 <<MPEIV>>47870000
  ODEVERR1:MESSAGE(M2453);                                     <<MPEIV>>47872000
          GO REQODEV;                                          <<MPEIV>>47874000
  TRYSTR: @BPINBUF := @BINBUF;                                 <<MPEIV>>47876000
          GETSTR(DEVCLASS,@ODEVERR1,1,8);                      <<MPEIV>>47878000
          TOS := CLINDEX(DEVCLASS);   <<GET CLASS INDEX>>      <<MPEIV>>47880000
          IF S0=0 THEN     <<NO SUCH CLASS>>                   <<tclas>>47882000
             PUTINTEMPCLASS(DEVCLASS,LDEV);                    <<tclas>>47884000
          LDT'CLASS'INDEX := 1;                                <<*LDT*>>47886000
  SETODEV:LDT'DFLT'OUT'DEV := TOS;                             <<*LDT*>>47888000
REQMODES: IF DEV'DEFAULTS THEN                                 <<t8392>>47890000
             BEGIN                                             <<t8392>>47892000
             LPDT'JOB'ACCEPT := DEFYESANSWER(TL'JOB'ACCEPT,             47894000
                                             M2046);                    47896000
             LPDT'DATA'ACCEPT:= DEFYESANSWER(TL'DATA'ACCEPT,            47898000
                                             M2047);                    47900000
             LPDT'INTERACTIVE:= DEFYESANSWER(TL'INTERACTIVE,            47902000
                                             M2048);                    47904000
             LPDT'DUPLICATIVE:= DEFYESANSWER(TL'DUPLICATIVE,            47906000
                                             M2049);                    47908000
             INITSPOOL := 0;                                            47910000
             IF TL'SPOOL'STATE = 1 OR                                   47912000
                TL'SPOOL'STATE = 2 THEN INITSPOOL := 1;                 47914000
             LDT'SPOOL'STATE :=                                <<D8822>>47916000
             DEFYESANSWER(INITSPOOL, M2050, DEFAULT'CHOSEN);   <<D8822>>47918000
             IF DEFAULT'CHOSEN OR                              <<D8822>>47920000
                LOGICAL(LDT'SPOOL'STATE) = LOGICAL(INITSPOOL)  <<D8822>>47922000
             THEN BEGIN                                        <<D8822>>47924000
                  LDT'SPOOL'STATE := TL'SPOOL'STATE;           <<D8822>>47926000
                  LDT'SPOOL'QUEUES := TL'SPOOL'QUEUES;         <<D8822>>47928000
                  END                                          <<D8822>>47930000
                 ELSE IF NOT DEFAULT'CHOSEN THEN               <<D8822>>47932000
                         BEGIN                                 <<D8822>>47934000
                         IF LOGICAL(INITSPOOL) THEN GO REQREPLY<<s8967>>47936000
                         ELSE IF LOGICAL(LDT'SPOOL'STATE)      <<D8822>>47938000
                                 THEN INOUTSPOOL;              <<s8967>>47940000
                         END;                                  <<D8822>>47942000
  REQREPLY:  LPDT'AUTO'ALLOC := DEFYESANSWER(TL'AUTO'REPLY,    <<s8967>>47944000
                                             M2056);           <<s8967>>47946000
             GOTO CKAUTO;                                      <<s8967>>47948000
             END; <<DEFAULT MODES>>                            <<D8822>>47950000
                                                               <<D8822>>47952000
                                                               <<D8822>>47954000
            << ACCEPT JOBS/SESSIONS >>                         <<MPEIV>>47956000
          LPDT'JOB'ACCEPT := LGETYESNO(M2021);                 <<*LPDT>>47958000
            << ACCEPT DATA >>                                  <<MPEIV>>47960000
          LPDT'DATA'ACCEPT := LGETYESNO(M2022);                <<*LPDT>>47962000
            << INTERACTIVE >>                                  <<MPEIV>>47964000
          LPDT'INTERACTIVE := LGETYESNO(M2023);                <<*LPDT>>47966000
            << DUPLICATIVE >>                                  <<MPEIV>>47968000
          LPDT'DUPLICATIVE := LGETYESNO(M2024);                <<*LPDT>>47970000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<02022>>47972000
          IF TYPE=DISC0 OR TYPE=DISC1 THEN                     <<02022>>47974000
            LDTX'SEEK'AHEAD := LGETYESNO(M2029); <<SEEKAHEAD?>><<*LDTX>>47976000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<02022>>47978000
          TOS := @REQREP2;                                     <<s8967>>47980000
REQSPOOL: GETYESNO(*,M2025);  <<INITIALLY SPOOLED?>>           <<t8392>>47982000
          INOUTSPOOL;                                          <<s8967>>47984000
                                                               <<s8967>>47986000
          <<------------------------------------------->>      <<s8967>>47988000
          << This fix was made to allow auto allocation>>      <<s8967>>47990000
          << for serial discs.  To allow compatability >>      <<s8967>>47992000
          << with the existing method of subtype defs  >>      <<s8967>>47994000
          << >= 8 for magtapes, the LPDT bit for auto  >>      <<s8967>>47996000
          << allocation is set even if the user ignores>>      <<s8967>>47998000
          << this question.  Also, the bit is not set  >>      <<s8967>>48000000
          << even if the user replies "Y" but the devic>>      <<s8967>>48002000
          << cannot be made auto reply. (i.e. magtapes >>      <<s8967>>48004000
          << and sdiscs only).                         >>      <<s8967>>48006000
          <<------------------------------------------->>      <<s8967>>48008000
REQREP2:  LPDT'AUTO'ALLOC := LGETYESNO(M2055);                 <<s8967>>48010000
CKAUTO:   IF TYPE = MAGTAPETYPE THEN                           <<s8967>>48012000
             BEGIN                                             <<s8967>>48014000
             LPDT'AUTO'ALLOC :=                                <<s8967>>48016000
             IF LOGICAL(LPDT'TAPE'AUTO'ALLOC) = 1              <<s8967>>48018000
             OR                                                <<s8967>>48020000
             LOGICAL(LPDT'AUTO'ALLOC) = 1 THEN 1 ELSE 0;       <<s8967>>48022000
             END                                               <<s8967>>48024000
          ELSE IF NOT SDISC'TYPE(TYPE, SUBTYP)                 <<s8967>>48026000
                     THEN LPDT'AUTO'ALLOC := FALSE;            <<s8967>>48028000
                                                               <<s8967>>48030000
  REQDVR:                                                      <<t8392>>48032000
          IF DEV'DEFAULTS THEN                                 <<t8392>>48034000
             BEGIN                                             <<t8392>>48036000
             BINBUF(0) :=%10; <<COUNT FOR GENMESSAGE STR>>     <<t8392>>48038000
             MOVE BINBUF(1) := TL'DRIVER'NAME,(8);             <<t8392>>48040000
             MESSAGE(-M2051,,,,,BINBUF);                       <<t8392>>48042000
             READINPUT;                                        <<t8392>>48044000
             SCAN BPINBUF WHILE BLANK,1;                       <<t8392>>48046000
             IF CARRY THEN << CR ENTERED, USE DEFAULT >>       <<t8392>>48048000
                BEGIN                                          <<t8392>>48050000
                FILL'(BINBUF, 80, " ");                        <<t8392>>48052000
                DVRCORERES := TL'CORE'RES;                     <<t8392>>48054000
                MOVE BINBUF := TL'DRIVER'NAME,(8),2;           <<t8392>>48056000
                MOVE * := %15;  <<CR>>                         <<t8392>>48058000
                END;                                           <<t8392>>48060000
             END                                               <<t8392>>48062000
          ELSE                                                 <<t8392>>48064000
             BEGIN                                             <<t8392>>48066000
             MESSAGE(-M2026);                                  <<t8392>>48068000
             READINPUT;                                        <<t8392>>48070000
             SCAN BPINBUF WHILE BLANK,1;                       <<t8392>>48072000
             END;                                              <<t8392>>48074000
          IF BPS0="*" THEN                                     <<MPEIV>>48076000
            BEGIN   <<CORE RESIDENT DRIVER>>                   <<MPEIV>>48078000
              TOS := TOS+1;                                    <<MPEIV>>48080000
              IF CSDEVICE OR DSDEVICE THEN MESSAGE(M2406)      <<MPEIV>>48082000
                ELSE DVRCORERES := 1;                          <<*DVR*>>48084000
            END;                                               <<MPEIV>>48086000
          @BPINBUF := TOS;                                     <<MPEIV>>48088000
          GETSTR(DRIVB'NAME,@REQDVR,1,8);  <<GET DRIVER NAME>> <<*DVR*>>48090000
          MOVE DVRNAME := DRIVW'NAME,(4);                      <<*DVR*>>48092000
  IF CSDEVICE THEN                                             <<MPEIV>>48094000
     BEGIN                                                     <<MPEIV>>48096000
     IF (LPDT'SUBTYPE MOD 4) = 0 THEN    << SWITCHED ? >>      <<*LPDT>>48098000
        BEGIN                                                  <<MPEIV>>48100000
            GETYESNO(@REQLID,M2120);<<PHONE LIST?>>            <<MPEIV>>48102000
          TOS := CSINDX;                                       <<MPEIV>>48104000
          CSLDTXPHLISTPTR := S0;                               <<MPEIV>>48106000
          @PHONE :=(TOS+@CSLDTX)&LSL(1);                       <<04306>>48108000
          PHINX := 4;   <<POINT PAST SEQUENCE LENGTH>>         <<MPEIV>>48110000
          J:=0;                                                <<MPEIV>>48112000
  PHONENB:MESSAGE(-M2121);   <<PHONE NUMBER>>                  <<MPEIV>>48114000
          READINPUT;                                           <<MPEIV>>48116000
          I:=GETPHNB(@PHONENB,BTEMP,"-");                      <<MPEIV>>48118000
          IF > THEN                                            <<MPEIV>>48120000
            BEGIN                                              <<MPEIV>>48122000
            MOVE PHONE(PHINX):=BTEMP,(I);                      <<MPEIV>>48124000
            PHONE(X:=X-1) := I;                                <<MPEIV>>48126000
            PHINX := PHINX+I+1;<<POINT PAST NEXT SEQUENCE LEN>><<MPEIV>>48128000
            J:=J+1;                                            <<MPEIV>>48130000
            GO PHONENB;                                        <<MPEIV>>48132000
            END;                                               <<MPEIV>>48134000
          IF J<=0 THEN                                         <<MPEIV>>48136000
           BEGIN  <<NO PHONE LIST>>                            <<MPEIV>>48138000
           CSLDTXPHLISTPTR := 0;                               <<MPEIV>>48140000
           END                                                 <<MPEIV>>48142000
          ELSE                                                 <<MPEIV>>48144000
            BEGIN                                              <<MPEIV>>48146000
            PHONE(NUMSEQ) := J; <<# OF PHONE SEQUENCES>>       <<MPEIV>>48148000
            TOS := PHINX&LSR(1);                               <<MPEIV>>48150000
            CSLDTX(CSINDX) := S0-1; <<SIZE OF LIST IN WORDS>>  <<MPEIV>>48152000
            CSINDX := TOS+CSINDX;                              <<MPEIV>>48154000
            END;                                               <<MPEIV>>48156000
        END;                                                   <<MPEIV>>48158000
     IF CONTENTION OR LDT'DEVICE'TYPE = CSDEV17 THEN           <<*LDT*>>48160000
                                                                        48162000
        BEGIN                                                  <<MPEIV>>48164000
        IF (LPDT'SUBTYPE MOD 4) = 0 THEN   << SWITCHED ? >>    <<*LPDT>>48166000
          BEGIN                                                <<MPEIV>>48168000
  REQLID: TOS:=CSINDX;                                         <<MPEIV>>48170000
          CSLDTXIDLISTPTR := S0;                               <<MPEIV>>48172000
          @IDLIST := (TOS+@CSLDTX)&LSL(1);                     <<04306>>48174000
          IDINX := 4;                                          <<MPEIV>>48176000
          J := 0;                                              <<MPEIV>>48178000
          I:=0;                                                <<MPEIV>>48180000
  REQLIDS:MESSAGE(-M2122); <<LOCAL ID SEQUENCE?>>              <<MPEIV>>48182000
          READINPUT;                                           <<MPEIV>>48184000
          SCAN BPINBUF WHILE BLANK,1;                          <<MPEIV>>48186000
          IF CARRY THEN                                        <<MPEIV>>48188000
            BEGIN                                              <<MPEIV>>48190000
            DEL;                                               <<MPEIV>>48192000
            IDLIST(IDINX-1):=0;<<NULL LOCAL ID>>;              <<MPEIV>>48194000
            IDINX:=IDINX+1;   <<POINT TO 1ST REMOTE ID>>       <<MPEIV>>48196000
            END                                                <<MPEIV>>48198000
          ELSE                                                 <<MPEIV>>48200000
            BEGIN                                              <<MPEIV>>48202000
            TOS := GETSEQ(@REQLIDS,BTEMP);                     <<MPEIV>>48204000
            DUPLICATE;                                         <<MPEIV>>48206000
            TOS := TOS LAND %77;                               <<MPEIV>>48208000
            TEMP := TOS;          <<LENGTH>>                   <<MPEIV>>48210000
            IDLIST(IDINX-1):=TOS;       <<LENGTH AND IN TYPE>> <<MPEIV>>48212000
            MOVE IDLIST(IDINX):=BTEMP,(TEMP);                  <<MPEIV>>48214000
            IDINX := IDINX+TEMP+1;  <<BUMP INDEX>>             <<MPEIV>>48216000
            I := I+1;                                          <<MPEIV>>48218000
            END;                                               <<MPEIV>>48220000
  REQRIDS:  MESSAGE(-M2123); <<REMOTE ID SEQUENCE?>>           <<MPEIV>>48222000
          READINPUT;                                           <<MPEIV>>48224000
          TOS := GETSEQ(@REQRIDS,BTEMP);                       <<MPEIV>>48226000
          IF S0=0 THEN                                         <<MPEIV>>48228000
            BEGIN <<NO INPUT>>                                 <<MPEIV>>48230000
            DEL;                                               <<MPEIV>>48232000
            IF I<=0 THEN                                       <<MPEIV>>48234000
              BEGIN     <<NULL ID LIST>>                       <<MPEIV>>48236000
              CSLDTXIDLISTPTR := 0;                            <<MPEIV>>48238000
              GO REQCLSS;                                      <<MPEIV>>48240000
              END;                                             <<MPEIV>>48242000
            IDLIST(NUMSEQ) := I;                               <<MPEIV>>48244000
            TOS := IDINX&LSR(1);                               <<MPEIV>>48246000
            CSLDTX(CSINDX) := S0-1;  <<SIZE OF LIDT IN WORDS>> <<MPEIV>>48248000
            CSINDX := TOS+CSINDX;                              <<MPEIV>>48250000
            GO REQCLSS;                                        <<MPEIV>>48252000
            END;                                               <<MPEIV>>48254000
          DUPLICATE;                                           <<MPEIV>>48256000
          TOS := TOS LAND %77;  <<LENGTH>>                     <<MPEIV>>48258000
          TEMP := TOS;                                         <<MPEIV>>48260000
          IDLIST(IDINX-1) := TOS;                              <<MPEIV>>48262000
          MOVE IDLIST(IDINX) := BTEMP,(TEMP);                  <<MPEIV>>48264000
          IDINX := IDINX+TEMP+1;                               <<MPEIV>>48266000
          I := I+1;                                            <<MPEIV>>48268000
          GO REQRIDS;                                          <<MPEIV>>48270000
          END;                                                 <<MPEIV>>48272000
        END                                                    <<MPEIV>>48274000
     ELSE                                                      <<MPEIV>>48276000
        IF CONTROLST THEN                                      <<MPEIV>>48278000
          BEGIN                                                <<MPEIV>>48280000
  REQIDLAY: CSLDTX(CSINDX+INTCOMDELAY)                         <<MPEIV>>48282000
               :=GETVAL(M2124,0,32767,1);<<INTRCOMPONNT DELAY>><<MPEIV>>48284000
            TOS := GETVAL(M2125,0,32767,1);<<#OF POLLS REPEAT>><<MPEIV>>48286000
            CSLDTX(CSINDX) := S0;                              <<MPEIV>>48288000
            IF TOS=0 THEN GO REQCPST;                          <<MPEIV>>48290000
  REQCIRP:  CSLDTX(CSINDX+CIRPDELAY)                           <<MPEIV>>48292000
               := GETVAL(M2126,0,32767,1);<<CIRC. POLL DELAY>> <<MPEIV>>48294000
  REQCPST:  I := GETVAL(M2127,0,255,1);<<COMPONENTS/STATION>>  <<MPEIV>>48296000
  REQNCOM:  N := GETVAL(M2128,0,63,1);   <<# OF COMPONENTS>>   <<MPEIV>>48298000
            CSLDTXCONTPTR:=CSINDX;                             <<MPEIV>>48300000
            IF CONTROLST THEN CSINDX:=CSINDX+CONSEQSTART       <<MPEIV>>48302000
            ELSE CSINDX:=CSINDX+1; <<TRIBUTARY>>               <<MPEIV>>48304000
            @BCSLDTX:=@CSLDTX&LSL(1);<<BYTE PTR FOR SEQUENCES>><<04306>>48306000
            BINDX := CSINDX&LSL(1);<<INDEX FOR BYTE ARRAY>>    <<MPEIV>>48308000
            IF CONTROLST THEN BCSLDTX(BINDX-2):=(N+I-1)/I;     <<MPEIV>>48310000
               <<DETERMINE # OF STATIONS IF CONTROL STATION>>  <<MPEIV>>48312000
            BCSLDTX(BINDX-1) := N;    <<# OF COMPONENTS>>      <<MPEIV>>48314000
            LASTPOLLENT := 0;                                  <<MPEIV>>48316000
            I := -1;                                           <<MPEIV>>48318000
            WHILE(I:=I+1)<N  DO                                <<MPEIV>>48320000
              BEGIN                                            <<MPEIV>>48322000
              TOS := GETVAL(M2129,0,2,1);<<COMPONENT TYPE>>    <<MPEIV>>48324000
              BCSLDTX(BINDX) := S0;                            <<MPEIV>>48326000
              IF TOS<>2 OR NOT(CONTROLST) THEN                 <<MPEIV>>48328000
                GO REQCOMPSEQ;                                 <<MPEIV>>48330000
              GETYESNO(@REQCOMPSEQ,M2130);<<COMPONENT IN POLL>><<MPEIV>>48332000
              IF LASTPOLLENT=0  THEN                           <<MPEIV>>48334000
                 BEGIN                                         <<MPEIV>>48336000
                 CSLDTX(CONTRSTART+FIRSTCOMP) := I;            <<MPEIV>>48338000
                 LASTPOLLENT := BINDX;                         <<MPEIV>>48340000
                 TOS := BCSLDTX(BINDX);                        <<MPEIV>>48342000
                 TOS.(8:6) := I;                               <<MPEIV>>48344000
                 BCSLDTX(X) := TOS;                            <<MPEIV>>48346000
                 END                                           <<MPEIV>>48348000
              ELSE                                             <<MPEIV>>48350000
                 BEGIN                                         <<MPEIV>>48352000
                 TOS := BCSLDTX(LASTPOLLENT);                  <<MPEIV>>48354000
                 TOS.(8:6) := I;                               <<MPEIV>>48356000
                 BCSLDTX(X) := TOS;                            <<MPEIV>>48358000
                 LASTPOLLENT := BINDX;                         <<MPEIV>>48360000
                 END;                                          <<MPEIV>>48362000
  REQCOMPSEQ: MESSAGE(-M2131); <<COMPONENT SEQUENCE?>>         <<MPEIV>>48364000
              READINPUT;                                       <<MPEIV>>48366000
              TOS := GETSEQ(@REQCOMPSEQ,BTEMP);                <<MPEIV>>48368000
              IF S0=0 THEN                                     <<MPEIV>>48370000
                BEGIN                                          <<MPEIV>>48372000
                DEL;                                           <<MPEIV>>48374000
  BADSEQ:       MESSAGE(M2453);                                <<MPEIV>>48376000
                GO REQCOMPSEQ;                                 <<MPEIV>>48378000
                END;                                           <<MPEIV>>48380000
              DUPLICATE;                                       <<MPEIV>>48382000
              TOS := TOS LAND %77;<<LENGTH>>                   <<MPEIV>>48384000
              IF S0>8 THEN                                     <<MPEIV>>48386000
                BEGIN                                          <<MPEIV>>48388000
                DDEL;                                          <<MPEIV>>48390000
                GOTO BADSEQ;                                   <<MPEIV>>48392000
                END;                                           <<MPEIV>>48394000
              DUPLICATE;                                       <<MPEIV>>48396000
              TOS := @BCSLDTX+BINDX+2; <<SEQUENCE START>>      <<MPEIV>>48398000
              TOS := @BTEMP;   <<GET READY FOR MOVE BYTES>>    <<MPEIV>>48400000
              ASSEMBLE(CAB;MVB 3;XCH); <<ROVE SEQ INTO CSLDTX>><<MPEIV>>48402000
              BCSLDTX(BINDX+1) := TOS;  <<IN TYPE AND LENGTH>> <<MPEIV>>48404000
              BINDX := TOS+BINDX+2;<<POINT PAST THIS SEQUENCE>><<MPEIV>>48406000
              END;                                             <<MPEIV>>48408000
            IF N>0 THEN CSINDX := (BINDX+1)&LSR(1);            <<MPEIV>>48410000
          END;                                                 <<MPEIV>>48412000
     END;                                                      <<MPEIV>>48414000
  REQCLSS:                                                     <<t8392>>48416000
          IF DEV'DEFAULTS THEN                                 <<t8392>>48418000
             BEGIN                                             <<t8392>>48420000
             FILL'(BTEMP,80," ");                              <<t8392>>48422000
             MOVE BTEMP := "DEVICE CLASSES = ",2;              <<t8392>>48424000
             I := 0;                                           <<t8392>>48426000
             NAME'PTR := TL'DEV'CLASS'PTR & LSL(1);            <<t8392>>48428000
             WHILE (I:=I+1) <= TL'NUM'DEV'CLASS DO             <<t8392>>48430000
                BEGIN                                          <<t8392>>48432000
                MOVE BPS0 := TL'ENTB(NAME'PTR),(8);            <<t8392>>48434000
                SCAN * UNTIL BLANK,1;                          <<t8392>>48436000
                IF I < TL'NUM'DEV'CLASS THEN                   <<t8392>>48438000
                   MOVE * := ", ",2;                           <<t8392>>48440000
                NAME'PTR := NAME'PTR + 8;                      <<t8392>>48442000
                END;                                           <<t8392>>48444000
             MOVE * := "?",2;                                  <<t8392>>48446000
             TEMP := TOS-@BTEMP;                               <<t8392>>48448000
             PRINT(IBTEMP ,-TEMP,%320);                        <<t8392>>48450000
             READINPUT;                                        <<t8392>>48452000
             SCAN BPINBUF WHILE BLANK, 1;                      <<t8392>>48454000
             IF CARRY AND TL'DEV'CLASS'PTR <> 0 THEN           <<t8392>>48456000
                BEGIN  << DEFAULT VALUES USED >>               <<t8392>>48458000
                FILL'(BINBUF, 80, " ");                        <<t8392>>48460000
                TEMP := TEMP - 18;  <<COUNT FOR DEV CLASSES>>  <<t8392>>48462000
                MOVE BINBUF := BTEMP(17),(TEMP),2;             <<t8392>>48464000
                BPS0   := %15;  <<CR>>   DEL;                  <<t8392>>48466000
                END;                                           <<t8392>>48468000
             END                                               <<t8392>>48470000
          ELSE                                                 <<t8392>>48472000
             BEGIN                                             <<t8392>>48474000
             MESSAGE(-M2027);                                  <<t8392>>48476000
             READINPUT;                                        <<t8392>>48478000
             END;                                              <<t8392>>48480000
  NEXTCLASS:                                                   <<MPEIV>>48482000
          MORE := FALSE;                                       <<MPEIV>>48484000
          GETSTR(DEVCLASS,@CLSERR,2,8); <<CLASS NAME>>         <<MPEIV>>48486000
          IF = THEN GO PUTINCS;  <<NO CLASS>>                  <<MPEIV>>48488000
          IF < THEN MORE := TRUE;   <<FOLLOWED BY COMMA>>      <<MPEIV>>48490000
          @DCT := @DCT'HEAD + DCTH'DCT'BASE;                   <<dctab>>48492000
          @DCT'B := @DCT & LSL(1);                             <<dctab>>48494000
          I := -1;                                             <<MPEIV>>48496000
          WHILE (I:=I+1) < DCTH'NUM'DCT'ENTRIES DO             <<dctab>>48498000
            BEGIN                                              <<MPEIV>>48500000
              IF DCTB'CLASS'NAME = DEVCLASS,(8) THEN           <<dctab>>48502000
                GOTO ENTEXST;                                  <<MPEIV>>48504000
              @DCT := @DCT + DCT'NEXT'ENTRY;                   <<dctab>>48506000
              @DCT'B := @DCT & LSL(1);                         <<dctab>>48508000
            END;                                               <<MPEIV>>48510000
          DCTABINCR := 7; <<MAKE ROOM FOR NEW ENTRY>>          <<dctab>>48512000
          MOVEDLTABLES;                                        <<MPEIV>>48514000
          @DCT := @DCT - 7;                                    <<dctab>>48516000
          @DCT'B := @DCT & LSL(1);                             <<dctab>>48518000
          MOVE DCTB'CLASS'NAME := DEVCLASS,(8),2;<<CLASS NAME>><<dctab>>48520000
          DCT'CYCLICAL'PTR := 1;                               <<dctab>>48522000
          IF SDISC'TYPE(TYPE,SUBTYP) THEN  <<SERIAL-TYPE DISC>><<03550>>48524000
             BEGIN <<CREATING A DISC CLASS--COULD BE SERIAL>>  <<MPEIV>>48526000
             BTEMP := MOVEAN( BTEMP(1), DEVCLASS, 8);          <<MPEIV>>48528000
             MESSAGE(-M2028,,,,,BTEMP);                        <<MPEIV>>48530000
             DCT'CLASS'ACC'TYPE:= 31;<< SERIAL DISC >>         <<dctab>>48532000
             READINPUT(IBTEMP); <<GET RESPONSE>>               <<MPEIV>>48534000
             MOVE BTEMP:= BTEMP WHILE ANS;                     <<03705>>48536000
             IF BTEMP="Y" THEN GO ISSDISC;                     <<MPEIV>>48538000
             MOVE BTEMP:="IS ",2;                              <<MPEIV>>48540000
             ASSEMBLE(DUP);                                    <<MPEIV>>48542000
             MOVE *:=DEVCLASS WHILE AN,1;                      <<MPEIV>>48544000
             ASSEMBLE(DUP,CAB;SUB);                            <<MPEIV>>48546000
             TEMP:=TOS;                                        <<MPEIV>>48548000
             MOVE *:=" A FOREIGN DISC CLASS?";                 <<MPEIV>>48550000
             PRINT(IBTEMP,-TEMP-25,%320);                      <<MPEIV>>48552000
             DCT'CLASS'ACC'TYPE := 7;<< FOREIGN DISC >>        <<dctab>>48554000
             READINPUT(IBTEMP);                                <<MPEIV>>48556000
             MOVE BTEMP:= BTEMP WHILE ANS;                     <<03705>>48558000
             IF BTEMP<>"Y" THEN                                <<MPEIV>>48560000
               DCT'CLASS'ACC'TYPE := TYPE;                     <<dctab>>48562000
ISSDISC:                                                       <<MPEIV>>48564000
             END                                               <<MPEIV>>48566000
          ELSE                                                 <<MPEIV>>48568000
             DCT'CLASS'ACC'TYPE:=LDT'DEVICE'TYPE;              <<dctab>>48570000
          DCT'NUM'DEVICES := 1;                                <<dctab>>48572000
          DCT(DCT'FIRST'LDEV) := LDEV;                         <<dctab>>48574000
          DCTH'NUM'DCT'ENTRIES := DCTH'NUM'DCT'ENTRIES + 1;    <<dctab>>48576000
          DCTH'SEGMENT'SIZE := DCTH'SEGMENT'SIZE + 7;          <<dctab>>48578000
          DCTH'TDT'BASE := DCTH'TDT'BASE + 7;                  <<dctab>>48580000
          CKTEMPCLASS(DCTB'CLASS'NAME);                        <<tclas>>48582000
          IF MORE THEN GO NEXTCLASS ELSE GO PUTINCS;           <<MPEIV>>48584000
  ENTEXST:I := -1;                                             <<dctab>>48586000
          WHILE (I:=I+1) <= DCT'NUM'DEVICES DO                 <<dctab>>48588000
          IF DCT(DCT'FIRST'LDEV + I) = LDEV THEN               <<dctab>>48590000
            BEGIN    <<DUPLICATE ENTRY>>                       <<MPEIV>>48592000
              MESSAGE(M2453);                                  <<MPEIV>>48594000
  CLSERR:     REMOVECLASSREFS;                                 <<MPEIV>>48596000
              GO REQCLSS;                                      <<MPEIV>>48598000
            END;                                               <<MPEIV>>48600000
          DCTABINCR := 1;       <<ADD 1 WORD>>                 <<dctab>>48602000
          MOVEDLTABLES;                                        <<dctab>>48604000
                                                               <<dctab>>48606000
          << WE STILL NEED TO ADJUST THE ENTRIES INSIDE THE  >><<dctab>>48608000
          << DCTAB TO MAKE THE APPROPRIATE HOLE FOR THE NEW  >><<dctab>>48610000
          << LDEV NUMBER. WE WILL DO THIS NOW.               >><<dctab>>48612000
                                                               <<dctab>>48614000
          @DCT := @DCT - 1;  <<COUNT WRD HAS MOVED BY 1 WORD >><<dctab>>48616000
          @DEST := (@DCT'HEAD + DCTH'TDT'BASE);                <<*7777>>48618000
          @SOURCE := @DEST - 1;                                <<dctab>>48620000
          COUNT := (@SOURCE - @DCT(DCT'NEXT'ENTRY)) + 1;       <<dctab>>48622000
          MOVE DEST := SOURCE,(-COUNT);                        <<dctab>>48624000
                                                               <<dctab>>48626000
          DCT(DCT'NEXT'ENTRY) := LDEV;                         <<dctab>>48628000
          DCT'NUM'DEVICES := DCT'NUM'DEVICES + 1;              <<dctab>>48630000
          DCTH'SEGMENT'SIZE := DCTH'SEGMENT'SIZE + 1;          <<dctab>>48632000
          DCTH'TDT'BASE := DCTH'TDT'BASE + 1;                  <<dctab>>48634000
          DETERMCTYP(@SAMEPLACE,DCT,FALSE);                    <<dctab>>48636000
SAMEPLACE:IF MORE THEN GO NEXTCLASS;                           <<03611>>48638000
  PUTINCS:IF CSDEV17 <= LDT'DEVICE'TYPE <= CSDEV19 THEN        <<*LDT*>>48640000
            BEGIN   <<MOVE CS DEVICE INTO CSTAB>>              <<MPEIV>>48642000
            TOS := CSINDX;                                     <<MPEIV>>48644000
            CSLDTX := S0;                                      <<MPEIV>>48646000
            CSTABINCR := TOS; <<INCREASE TABLE>>               <<MPEIV>>48648000
            MOVEDLTABLES;                                      <<MPEIV>>48650000
            TOS := @CSTAB+CSTAB;   <<FIRST FREE BYTE>>         <<MPEIV>>48652000
            DUPLICATE;                                         <<MPEIV>>48654000
            MOVE *:=CSLDTX,(CSINDX);                           <<MPEIV>>48656000
            CSTAB := CSTAB+CSINDX; <<UPDATE SEGMENT SIZE>>     <<MPEIV>>48658000
            I := -1;                                           <<MPEIV>>48660000
            @CSLDTX := @CSTAB + CSXSTART;                      <<MPEIV>>48662000
            DO I:=I+1                                          <<MPEIV>>48664000
            UNTIL(@CSLDTX:=@CSLDTX+CSLDTX)>S0;                 <<MPEIV>>48666000
            DEL;                                               <<MPEIV>>48668000
            CSDEF(LDEV) := I;                                  <<MPEIV>>48670000
            END;                                               <<MPEIV>>48672000
          GO REQLDEV;                                          <<MPEIV>>48674000
  REQOSP: I:=0;                                                <<MPEIV>>48676000
          J:=0;                                                <<MPEIV>>48678000
          WHILE (I:=I+1) <= HLDEV DO                           <<MPEIV>>48680000
            BEGIN                                              <<*DVR*>>48682000
            DVR'INDEX := I * DVRSIZE;                          <<*DVR*>>48684000
            IF DVRDRTNUM <> 0 OR  <<COUNT USED DRTS>>          <<*DVR*>>48686000
               DVRDSBIT = 1 THEN J:=J+1;                       <<*DVR*>>48688000
            END;                                               <<*DVR*>>48690000
  MAXOSPOOL:                                                   <<MPEIV>>48692000
          GETNEWVAL(M2352,CTAB0(MAXSPOOLF),0,1023-J);          <<LIMIT>>48694000
          IF CTAB0(MAXSPOOLF) > (1023-J) THEN                  <<LIMIT>>48696000
            <<MUST MAKE THIS TEST IN THE CASE WHERE A LARGE>>  <<MPEIV>>48698000
            <<NUMBER OF REAL DEVICES HAVE BEEN ADDED AND   >>  <<MPEIV>>48700000
            <<THE NUMBER OF OPEN SPOOLFILES WAS NOT CHANGED>>  <<MPEIV>>48702000
            BEGIN <<MUST CHANGE MAX # OF OPEN SPOOLFILES>>     <<MPEIV>>48704000
            MESSAGE(M2355);  << MAX OPEN SPOOLFILES >>         <<MPEIV>>48706000
            MESSAGE(M2356); << MAX ALLOWED IN CURRENT CONF >>  <<MPEIV>>48708000
            MOVE  BINBUF := "IS ";                             <<MPEIV>>48710000
            I := ASCII(1023-J,10,BINBUF(3));                   <<*8392>>48712000
            PRINT(INBUF,-I-3,0);                               <<MPEIV>>48714000
            GOTO MAXOSPOOL;                                    <<MPEIV>>48716000
            END;                                               <<MPEIV>>48718000
  NLIOREQ:IF LGETYESNO(M2009) THEN LISTIODEV;                  <<MPEIV>>48720000
            << LIST I/O DEVICES >>                             <<MPEIV>>48722000
          IF CSPRESENT AND LGETYESNO(M2100) THEN LISTCSDEV;    <<MPEIV>>48724000
            << LIST CS DEVICES >>                              <<MPEIV>>48726000
REQTTFC:  TOS := @REQCLC;                                      <<06067>>48728000
          GETYESNO(*,M2312);  <<TERM TYPE CHANGES?>>           <<06067>>48730000
REQLTTF:                                                       <<06067>>48732000
          IF LGETYESNO(M2310) THEN <<LIST TERMTYPE DESCR FILES?<<*7777>>48734000
             IF DCTH'NUM'TDT'ENTRIES <> 0 THEN                 <<*7777>>48736000
                LIST'TTDT                                      <<*7777>>48738000
             ELSE                                              <<*7777>>48740000
                MESSAGE (M2311); <<NO TERM TYPE FILES DEFINED>><<*7777>>48742000
REQDTTF:                                                       <<*7777>>48744000
          TOS := @REQATTF;                                     <<*7777>>48746000
          GETYESNO(*,M2313); <<DELETE TERM TYPE FILES>>        <<*7777>>48748000
GETTTF:   WARN := FALSE;                                       <<*7777>>48750000
          MESSAGE(-M2315); <<FILES?>>                          <<*7777>>48752000
          READINPUT;                                           <<*7777>>48754000
NEXTTTF:  SCAN BPINBUF WHILE BLANK, 1;                         <<*7777>>48756000
          IF NOCARRY THEN  <<NOT A CARRAIGE RETURN INPUT>>     <<*7777>>48758000
            BEGIN                                              <<*7777>>48760000
            MORE := TRUE;                                      <<*7777>>48762000
            @BPINBUF := TOS;                                   <<*7777>>48764000
            SCAN BPINBUF UNTIL CR'COMMA, 1;                    <<*7777>>48766000
            IF CARRY THEN  <<ONLY ONE FILE TO DELETE>>         <<*7777>>48768000
              MORE := FALSE;                                   <<*7777>>48770000
            INSIZE := TOS - @BPINBUF;                          <<*7777>>48772000
            TERMCNTL := 2;  <<COMMA DELIMINATOR>>              <<*7777>>48774000
            IF NOT FULLY'QUALIFY THEN                          <<*7777>>48776000
              GOTO GETTTF;                                     <<*7777>>48778000
            @TDT := @TDTAB;                                    <<*7777>>48780000
            @TDT'B := @TDT & LSL(1);                           <<*7777>>48782000
            I := 0;                                            <<*7777>>48784000
            WHILE  (I:=I+1) <= DCTH'NUM'TDT'ENTRIES DO         <<*7777>>48786000
              BEGIN                                            <<*7777>>48788000
              IF (TDTB'FILE'NAME = FILE,(8)) AND               <<*7777>>48790000
                 (TDTB'GROUP'NAME = GROUP,(8)) AND             <<*7777>>48792000
                 (TDTB'ACCT'NAME = ACCT,(8)) THEN              <<*7777>>48794000
                 BEGIN                                         <<*7777>>48796000
                 DELETE'TTDT;                                  <<*7777>>48798000
                 GOTO NEXT;                                    <<*7777>>48800000
                 END;                                          <<*7777>>48802000
              @TDT := @TDT + TDT'NEXT'ENTRY;                   <<*7777>>48804000
              @TDT'B := @TDT & LSL(1);                         <<*7777>>48806000
              END;                                             <<*7777>>48808000
            WARN := TRUE;                                      <<*7777>>48810000
            MOVE BTEMP := "FILENAME ",2;                       <<*7777>>48812000
            MOVE * := FQFNAME,(FQFNSIZE),2;                    <<*7777>>48814000
            MOVE * := " DOES NOT EXIST";                       <<*7777>>48816000
            PRINT(BTEMP,-(24+FQFNSIZE),0);                     <<*7777>>48818000
NEXT:       IF MORE = TRUE THEN                                <<*7777>>48820000
              GOTO NEXTTTF                                     <<*7777>>48822000
            ELSE                                               <<*7777>>48824000
              IF WARN = TRUE THEN                              <<*7777>>48826000
                BEGIN                                          <<*7777>>48828000
                GETYESNO(@GETTTF,200); <<LIST TT DESCR FILES?>><<*7777>>48830000
                IF DCTH'NUM'TDT'ENTRIES <> 0 THEN              <<*7777>>48832000
                  BEGIN                                        <<*7777>>48834000
                  LIST'TTDT;                                   <<*7777>>48836000
                  GOTO GETTTF;                                 <<*7777>>48838000
                  END                                          <<*7777>>48840000
                ELSE                                           <<*7777>>48842000
                  BEGIN                                        <<*7777>>48844000
                  MESSAGE (M2311);  <<NO TERM TYPE FILES DEF>> <<*7777>>48846000
                  GOTO GETTTF;                                 <<*7777>>48848000
                  END;                                         <<*7777>>48850000
                END;                                           <<*7777>>48852000
              GOTO GETTTF;                                     <<*7777>>48854000
            END;  <<NOT A CARRIAGE RETURN INPUT>>              <<*7777>>48856000
REQATTF:  TOS := @REQLNTC;                                     <<*7777>>48858000
          GETYESNO (*,M2314);  <<ADD TERMTYPE DESCR FILES>>    <<*7777>>48860000
GETADDF:  MESSAGE (-M2316);     <<FILENAME?>>                  <<*7777>>48862000
          READINPUT;                                           <<*7777>>48864000
NEXTADDF: SCAN BPINBUF WHILE BLANK,1;                          <<*7777>>48866000
          IF CARRY THEN  <<CARRIAGE RETURN INPUT>>             <<*7777>>48868000
            GOTO REQLNTC                                       <<*7777>>48870000
          ELSE                                                 <<*7777>>48872000
            BEGIN                                              <<*7777>>48874000
            INSIZE := 26;                                      <<*7777>>48876000
            TERMCNTL := 1;  <<CR DELIMINATOR>>                 <<*7777>>48878000
            IF NOT FULLY'QUALIFY THEN                          <<*7777>>48880000
              GOTO GETADDF;                                    <<*7777>>48882000
            END;                                               <<*7777>>48884000
REQLDEVS: MESSAGE (-M2305);  <<LOGICAL LDEVS?>>                <<*7777>>48886000
          READINPUT;                                           <<*7777>>48888000
          MORE := TRUE;                                        <<*7777>>48890000
NEXTLDEV: WHILE MORE=TRUE DO                                   <<*7777>>48892000
            BEGIN  <<LDEVS>>                                   <<*7777>>48894000
            LDEV := INVAL(@TTFAERR);                           <<*7777>>48896000
            IF = THEN                                          <<*7777>>48898000
              GOTO GETADDF;                                    <<*7777>>48900000
            IF > THEN      <<ONLY ONE LDEV TO ADD>>            <<*7777>>48902000
              MORE := FALSE;                                   <<*7777>>48904000
            IF NOT LDEV'EXISTS(LDEV) THEN                      <<*7777>>48906000
              BEGIN                                            <<*7777>>48908000
              MESSAGE(M120,LDEV);                              <<*8392>>48910000
              TOS := 0;                                        <<*7777>>48912000
                  TOS := 10;                                   <<*8392>>48914000
                  LEN := ASCII(*,*,*);                         <<*8392>>48916000
              GOTO NEXTLDEV;                                   <<*7777>>48918000
              END;                                             <<*7777>>48920000
            IF NOT (LDT'DEVICE'TYPE = 16 <<TERMINAL>> LOR      <<*7777>>48922000
                   LDT'DEVICE'TYPE = 32 <<PRINTER>> LAND       <<*7777>>48924000
                   (LPDT'SUBTYPE=14 LOR                        <<*7777>>48926000
                   LPDT'SUBTYPE=15)) THEN                      <<*7777>>48928000
              BEGIN                                            <<*7777>>48930000
              MESSAGE(M138,LDEV);                              <<*8392>>48932000
            TOS := 10;                                         <<*8392>>48934000
            LEN := ASCII(*,*,*);                               <<*8392>>48936000
              GOTO NEXTLDEV;                                   <<*7777>>48938000
              END;                                             <<*7777>>48940000
            INDEX := LDTX'TDT'OFFSET;                          <<*7777>>48942000
            IF LDTX'TDT'OFFSET = -1 THEN                       <<*7777>>48944000
              GOTO ADDNAME                                     <<*7777>>48946000
            ELSE  <<HAS A FILENAME ASSOCIATED WITH IT ALREADY>><<*7777>>48948000
              BEGIN                                            <<*7777>>48950000
              @TDT := @TDTAB + LDTX'TDT'OFFSET;                <<*7777>>48952000
              @TDT'B := @TDT & LSL(1);                         <<*7777>>48954000
              IF (TDTB'FILE'NAME = FILE,(8)) AND               <<*7777>>48956000
                 (TDTB'GROUP'NAME = GROUP,(8)) AND             <<*7777>>48958000
                 (TDTB'ACCT'NAME = ACCT,(8)) THEN              <<*7777>>48960000
                 GOTO NEXTLDEV   <<SAME NAME-DO NOTHING>>      <<*7777>>48962000
              ELSE                                             <<*7777>>48964000
                 BEGIN  <<REPLACING AN EXISTING FILENAME>>     <<*7777>>48966000
                 MOVE BTEMP := TDTB'FILE'NAME,(8);             <<*7777>>48968000
                 MOVE BTEMP(8) := ".";                         <<*7777>>48970000
                 MOVE BTEMP(9) := TDTB'GROUP'NAME,(8);         <<*7777>>48972000
                 MOVE BTEMP(17) := ".";                        <<*7777>>48974000
                 MOVE BTEMP(18) := TDTB'ACCT'NAME,(8);         <<*7777>>48976000
                 TOS := 0;                                     <<*7777>>48978000
                 TOS := LDEV;                                  <<*7777>>48980000
                 TOS := 10;  << BASE FOR ASCII  >>             <<*8392>>48982000
                 MOVE BTEMP(26) := " REPLACED FOR LDEV ",2;    <<*7777>>48984000
                 LEN := ASCII(*,*,*);                          <<*8392>>48986000
                 PRINT(BTEMP,-(LEN+45),0);                     <<*7777>>48988000
                 REMOVETTDTREFS(LDEV);                         <<*7777>>48990000
                 END;                                          <<*7777>>48992000
              END;                                             <<*7777>>48994000
ADDNAME:                                                       <<*7777>>48996000
            @TDT := @TDTAB;                                    <<*7777>>48998000
            @TDT'B := @TDT & LSL(1);                           <<*7777>>49000000
            I:= 0;                                             <<*7777>>49002000
            WHILE (I:=I+1) <= DCTH'NUM'TDT'ENTRIES DO          <<*7777>>49004000
              BEGIN                                            <<*7777>>49006000
              IF (TDTB'FILE'NAME = FILE,(8)) AND               <<*7777>>49008000
                 (TDTB'GROUP'NAME = GROUP,(8)) AND             <<*7777>>49010000
                 (TDTB'ACCT'NAME = ACCT,(8)) THEN              <<*7777>>49012000
                 GOTO OLDTFENT;                                <<*7777>>49014000
              @TDT := @TDT + TDT'NEXT'ENTRY;                   <<*7777>>49016000
              @TDT'B := @TDT & LSL(1);                         <<*7777>>49018000
              END;                                             <<*7777>>49020000
            <<MAKE ROOM FOR NEW ENTRY>>                        <<*7777>>49022000
            TDTABINCR := 14;                                   <<*7777>>49024000
            MOVEDLTABLES;                                      <<*7777>>49026000
            @TDT := @TDT - 14; << TABLE HAS MOVED DOWN >>      <<*7777>>49028000
            @TDT'B := @TDT & LSL(1);                           <<*7777>>49030000
            MOVE TDTB'FILE'NAME := FILE,(8);                   <<*7777>>49032000
            MOVE TDTB'GROUP'NAME := GROUP,(8);                 <<*7777>>49034000
            MOVE TDTB'ACCT'NAME := ACCT,(8);                   <<*7777>>49036000
            TDT'NUM'DEVICES := 1;                              <<*7777>>49038000
            TDT(TDT'FIRST'LDEV+1) := LDEV;                     <<*7777>>49040000
            DCTH'SEGMENT'SIZE := DCTH'SEGMENT'SIZE + 14;       <<*7777>>49042000
            DCTH'NUM'TDT'ENTRIES := DCTH'NUM'TDT'ENTRIES + 1;  <<*7777>>49044000
            GOTO OFFSET;                                       <<*7777>>49046000
OLDTFENT:   << ADD TO AN ALREADY EXISTING ENTRY >>             <<*7777>>49048000
            TDTABINCR := 1;                                    <<*7777>>49050000
            MOVEDLTABLES;                                      <<*7777>>49052000
            @TDT := @TDT - 1;                                  <<*7777>>49054000
            @DEST := @DCT'HEAD + DCTH'SEGMENT'SIZE;            <<*7777>>49056000
            @SOURCE := @DEST - 1;                              <<*7777>>49058000
            COUNT := (@SOURCE - @TDT(TDT'NEXT'ENTRY)) + 1;     <<*7777>>49060000
            MOVE DEST := SOURCE,(-COUNT);                      <<*7777>>49062000
            TDT(TDT'NEXT'ENTRY) := LDEV;                       <<*7777>>49064000
            TDT'NUM'DEVICES := TDT'NUM'DEVICES + 1;            <<*7777>>49066000
            DCTH'SEGMENT'SIZE := DCTH'SEGMENT'SIZE + 1;        <<*7777>>49068000
            GOTO OFFSET;                                       <<*7777>>49070000
TTFAERR:    MESSAGE(M2453);   <<ILLEGAL INPUT>>                <<*7777>>49072000
            GOTO REQLDEVS;                                     <<*7777>>49074000
OFFSET:     CALC'TTF'OFFSET;                                   <<*7777>>49076000
            END;  <<LDEVS>>                                    <<*7777>>49078000
          GOTO REQLDEVS;                                       <<*7777>>49080000
REQLNTC:  GETYESNO(@REQCLC,M2310); <<LIST TERMTYPE DESC FILES>><<l7934>>49082000
          IF DCTH'NUM'TDT'ENTRIES <> 0 THEN                    <<*7777>>49084000
            LIST'TTDT                                          <<*7777>>49086000
          ELSE                                                 <<*7777>>49088000
            MESSAGE(2311);  <<NO TERM TYPE FILES DEFINED>>     <<*7777>>49090000
   REQCLC:TOS := @UPDODEV;                                     <<06067>>49092000
          GETYESNO(*,M2300);    <<CLASS CHANGES?>>             <<MPEIV>>49094000
   REQLOC:IF LGETYESNO(M2301) THEN LISTCLASSES;                <<MPEIV>>49096000
           GETYESNO(@REQACLS,M2302); <<DELETE CLASSES>>        <<MPEIV>>49098000
           ERROR := FALSE;                                     <<MPEIV>>49100000
   GETCLASSN:                                                  <<MPEIV>>49102000
          MESSAGE(-M2304);  <<CLASS NAMES>>                    <<MPEIV>>49104000
          READINPUT;                                           <<MPEIV>>49106000
   NEXTCL:MORE := FALSE;                                       <<MPEIV>>49108000
          GETSTR(DEVCLASS,@REQLIC,2,8);                        <<MPEIV>>49110000
          IF = AND LAST  THEN GO DCLERR;                       <<MPEIV>>49112000
          IF < THEN MORE := LAST  := TRUE ELSE LAST:=FALSE;    <<MPEIV>>49114000
          I := DELETECLASS(@REQLOC);                           <<MPEIV>>49116000
          K := 0;                                              <<MPEIV>>49118000
          WHILE (K:=K+1) <=HLDEV DO                            <<MPEIV>>49120000
            BEGIN                                              <<*LDT*>>49122000
            LDT'INDEX := K * LDTSIZE;                          <<*LDT*>>49124000
            IF LOGICAL(LDT'CLASS'INDEX) THEN                   <<*LDT*>>49126000
              BEGIN <<OUTPUT DEVICE IS CLASS>>                 <<*LDT*>>49128000
              TOS := LDT'DFLT'OUT'DEV;                         <<*LDT*>>49130000
              IF S0=I THEN                                     <<*LDT*>>49132000
                BEGIN <<OUTPUT DEVICE IS DELETED CLASS>>       <<*LDT*>>49134000
                LDT'DFLT'OUT'DEV := 0;                         <<*LDT*>>49136000
                PUTINTEMPCLASS(DEVCLASS,K);                    <<tclas>>49138000
                END                                            <<*LDT*>>49140000
              ELSE                                             <<*LDT*>>49142000
                IF S0>I THEN LDT'DFLT'OUT'DEV:=S0-1;           <<*LDT*>>49144000
              DEL;                                             <<*LDT*>>49146000
              END;                                             <<*LDT*>>49148000
            END;                                               <<*LDT*>>49150000
          IF MORE THEN GO NEXTCL ELSE GO REQACLS;              <<MPEIV>>49152000
   REQLIC:GETYESNO(@GETCLASSN,M2301); << LIST CLASSES? >>      <<MPEIV>>49154000
          LISTCLASSES;                                         <<MPEIV>>49156000
          GO GETCLASSN;                                        <<MPEIV>>49158000
   DCLERR:MESSAGE(M2453);                                      <<MPEIV>>49160000
          GO GETCLASSN;                                        <<MPEIV>>49162000
   REQACLS:GETYESNO(@REQLNC,M2303);<<ADD CLASSES>>             <<MPEIV>>49164000
   REQNCL:MESSAGE(-M2307); <<CLASS NAME>>                      <<MPEIV>>49166000
          READINPUT;                                           <<MPEIV>>49168000
          GETSTR(DEVCLASS,@REQNCL ,3,8);                       <<MPEIV>>49170000
          IF = THEN GO REQLNC; <<CARRIAGE RETURN>>             <<MPEIV>>49172000
   REQDEVS:I := 0;                                             <<MPEIV>>49174000
          MESSAGE(-M2305);  <<LOGICAL DEVICES #'S>>            <<MPEIV>>49176000
          READINPUT;                                           <<MPEIV>>49178000
   GETNDEV:I:=I+1;                                             <<MPEIV>>49180000
          MORE := FALSE;                                       <<MPEIV>>49182000
          TOS := INVAL(@CLASERR);                              <<MPEIV>>49184000
          IF = THEN                                            <<MPEIV>>49186000
   CLASERR: BEGIN                                              <<MPEIV>>49188000
              MESSAGE(M2453);                                  <<MPEIV>>49190000
              TOS:=I;                                          <<MPEIV>>49192000
              ASSEMBLE(SUBS 0);  <<DELETE INPUT FROM STACK>>   <<MPEIV>>49194000
              GO TO REQNCL;  << TRY AGAIN >>                   <<dctab>>49196000
             END;                                              <<MPEIV>>49198000
          IF < THEN MORE:= TRUE;                               <<MPEIV>>49200000
          NEW'LDEV:= S0;                                       <<03611>>49202000
          IF NOT LDEV'EXISTS(NEW'LDEV) THEN                    <<03611>>49204000
            GO CLASERR;   <<DEVICE NOT DEFINE>>                <<MPEIV>>49206000
          IF MORE THEN GO GETNDEV;                             <<MPEIV>>49208000
          @DCT := @DCT'HEAD + DCTH'DCT'BASE;                   <<dctab>>49210000
          @DCT'B := @DCT & LSL(1);                             <<dctab>>49212000
          J:= -1;                                              <<MPEIV>>49214000
          WHILE (J:=J+1) < DCTH'NUM'DCT'ENTRIES DO             <<dctab>>49216000
            BEGIN                                              <<MPEIV>>49218000
            IF DCTB'CLASS'NAME = DEVCLASS,(8) THEN GO OLDENT;  <<dctab>>49220000
            @DCT := @DCT + DCT'NEXT'ENTRY;                     <<dctab>>49222000
            @DCT'B := @DCT & LSL(1);                           <<dctab>>49224000
            END;                                               <<MPEIV>>49226000
          DCTABINCR := DCT'FIRST'LDEV + I;                     <<dctab>>49228000
          @DCT := @DCT - DCTABINCR;                            <<dctab>>49230000
          @DCT'B := @DCT & LSL(1);                             <<dctab>>49232000
          MOVEDLTABLES;                                        <<dctab>>49234000
          MOVE DCTB'CLASS'NAME := DEVCLASS,(8);                <<dctab>>49236000
          DCT'CYCLICAL'PTR := 1;                               <<dctab>>49238000
          DCT'CLASS'ACC'TYPE := 0;                             <<dctab>>49240000
          DCT'NUM'DEVICES := I;                                <<dctab>>49242000
          TOS := @DCT(DCT'FIRST'LDEV);                         <<dctab>>49244000
          X := -I-1;                                           <<MPEIV>>49246000
          WHILE (X:=X+1)<0  DO                                 <<MPEIV>>49248000
            BEGIN                                              <<MPEIV>>49250000
            PS0 := IAS0(X);                                    <<dctab>>49252000
            TOS := TOS + 1;                                    <<MPEIV>>49254000
            END;                                               <<MPEIV>>49256000
          DCTH'SEGMENT'SIZE := DCTH'SEGMENT'SIZE + I +         <<dctab>>49258000
                                DCT'FIRST'LDEV;                <<dctab>>49260000
          DCTH'NUM'DCT'ENTRIES := DCTH'NUM'DCT'ENTRIES + 1;    <<dctab>>49262000
          DCTH'TDT'BASE := DCTH'TDT'BASE + I + DCT'FIRST'LDEV; <<dctab>>49264000
          DETERMCTYP(@REQLOC,DCT,TRUE); <<DETERMINE CLASS TP>> <<dctab>>49266000
          CKTEMPCLASS(DCTB'CLASS'NAME);                        <<tclas>>49268000
          GO REQNCL;                                           <<MPEIV>>49270000
  OLDENT:                   <<CLASS ALREADY EXISTED>>          <<dctab>>49272000
          K := -I;                                             <<dctab>>49274000
          WHILE (K:=K+1) <= 0 DO                               <<dctab>>49276000
            BEGIN                                              <<MPEIV>>49278000
            M := -1;                                           <<dctab>>49280000
            WHILE (M:=M+1) <= DCT'NUM'DEVICES DO               <<dctab>>49282000
              IF IAS0(K) = DCT(DCT'FIRST'LDEV + M) THEN        <<dctab>>49284000
                BEGIN <<DUPLICATE ENTRIES>>                    <<MPEIV>>49286000
                MESSAGE(M2306);                                <<MPEIV>>49288000
                TOS := I;                                      <<dctab>>49290000
                ASSEMBLE( SUBS 0 );                            <<dctab>>49292000
                GETYESNO(@REQDEVS,M2301); << LIST CLASSES? >>  <<MPEIV>>49294000
                LISTCLASSES;                                   <<MPEIV>>49296000
                GO REQDEVS;                                    <<MPEIV>>49298000
                END;                                           <<MPEIV>>49300000
            END;                                               <<MPEIV>>49302000
          DCTABINCR := I;                                      <<dctab>>49304000
          MOVEDLTABLES;                                        <<MPEIV>>49306000
                                                               <<dctab>>49308000
          << WE STILL NEED TO ADJUST THE ENTRIES INSIDE THE  >><<dctab>>49310000
          << DCTAB TO MAKE THE APPROPRIATE HOLE FOR THE NEW  >><<dctab>>49312000
          << LDEV NUMBER. WE WILL DO THIS NOW.               >><<dctab>>49314000
                                                               <<dctab>>49316000
          @DCT := @DCT - I;  <<COUNT WRD HAS MOVED BY I WORDS>><<dctab>>49318000
          @DCT'B := @DCT & LSL(1);                             <<dctab>>49320000
          @DEST := (@DCT'HEAD + DCTH'TDT'BASE);                <<*7777>>49322000
          @SOURCE := @DEST - I;                                <<dctab>>49324000
          COUNT := (@SOURCE - @DCT(DCT'NEXT'ENTRY)) + 1;       <<dctab>>49326000
          MOVE DEST := SOURCE,(-COUNT);                        <<dctab>>49328000
                                                               <<dctab>>49330000
          TOS := @DCT(DCT'NEXT'ENTRY);                         <<dctab>>49332000
          X := -I-1;                                           <<MPEIV>>49334000
          WHILE (X:=X+1)<0 DO                                  <<MPEIV>>49336000
            BEGIN                                              <<MPEIV>>49338000
            PS0 := IAS0(X);                                    <<dctab>>49340000
            TOS := TOS+1;                                      <<MPEIV>>49342000
            END;                                               <<MPEIV>>49344000
          DCT'NUM'DEVICES := DCT'NUM'DEVICES + I;              <<dctab>>49346000
          DCTH'SEGMENT'SIZE := DCTH'SEGMENT'SIZE + I;          <<dctab>>49348000
          DCTH'TDT'BASE := DCTH'TDT'BASE + I;                  <<dctab>>49350000
          TOS := I + 1;                                        <<dctab>>49352000
          ASSEMBLE(SUBS 0);                                    <<MPEIV>>49354000
          GO REQNCL;                                           <<MPEIV>>49356000
   REQLNC:GETYESNO(@UPDODEV,M2301);<<LIST CLASSES>>            <<MPEIV>>49358000
          LISTCLASSES;                                         <<MPEIV>>49360000
   UPDODEV:                                                    <<tclas>>49362000
          CLEAN'TCLASSES;                                      <<tclas>>49364000
         IF ERROR THEN GO REQOLIO;                             <<MPEIV>>49366000
          GETYESNO(@REQADVRC,M2009);  <<LIST I/O DEVICES>>     <<MPEIV>>49368000
          LISTIODEV;                                           <<MPEIV>>49370000
  REQADVRC:IF COMM(NUMADVRS)>0 THEN                            <<CONFD>>49372000
            BEGIN <<DELETE DVRS FROM CS LIST IF CONFIGURED>>   <<MPEIV>>49374000
            I := -1;                                           <<MPEIV>>49376000
            CSINDX := 0;                                       <<*DVR*>>49378000
            WHILE(I:=I+1)<COMM(NUMADVRS) DO                    <<CONFD>>49380000
              BEGIN <<CHECK IF CONFIGURED>>                    <<MPEIV>>49382000
              J := 0;                                          <<MPEIV>>49384000
              WHILE(J:=J+1)<=COMM(DRTNUM) DO                   <<CONFD>>49386000
                BEGIN                                          <<MPEIV>>49388000
                DVR'INDEX := J * DVRSIZE;                      <<*DVR*>>49390000
                IF COMPARE'WORDS(CSDVR(CSINDX),DVRNAME,4) THEN <<*DVR*>>49392000
                  BEGIN <<DELETE FROM CS LIST>>                <<MPEIV>>49394000
                  MOVE CSDVR(CSINDX) := CSDVR(CSINDX+4),       <<*DVR*>>49396000
                        (COMM(NUMADVRS) - (I+1))*CSDVRSIZE;    <<CONFD>>49398000
                  COMM(X) := COMM(NUMADVRS)-1;                 <<CONFD>>49400000
                  I:=I-1;  <<REFLECT DELETED DVR IN COUNT>>    <<MPEIV>>49402000
                  GOTO NEXTCSD;                                <<MPEIV>>49404000
                  END;                                         <<MPEIV>>49406000
                END;                                           <<MPEIV>>49408000
              CSINDX := CSINDX + 4;  << NEXT CS DRIVER >>      <<*DVR*>>49410000
  NEXTCSD:    END;                                             <<MPEIV>>49412000
            DEL;                                               <<MPEIV>>49414000
            END;                                               <<MPEIV>>49416000
          IF COMM(NUMADVRS)>0 THEN                             <<CONFD>>49418000
            IF LGETYESNO(M2151) THEN<<LIST ADDITIONAL DRIVERS>><<MPEIV>>49420000
               LISTDVRS;                                       <<MPEIV>>49422000
END;  << IOCHANGE >>                                           <<MPEIV>>49424000
$PAGE          "VOLUME TABLE PROCEDURES"                                49426000
$CONTROL SEGMENT=SETUP                                                  49428000
          <<-------------                                               49430000
            FIND VOLUME                                                 49432000
          ------------->>                                               49434000
  INTEGER PROCEDURE FINDVOL(NAME);                                      49436000
    BYTE ARRAY NAME;                                                    49438000
    COMMENT                                                             49440000
      SEARCHES THE VOLUME TABLE FOR THE VOLUME SPECIFIED BY NAME.       49442000
    IF NOT FOUND, RETURNS CCG. OTHERWISE RETURNS CCE AND THE INDEX      49444000
    OF THE ENTRY IN FINDVOL;                                            49446000
      BEGIN                                                             49448000
        INTEGER I:=0;                                                   49450000
          WHILE (I:=I+1)<=HVOL DO                                       49452000
            BEGIN                                                       49454000
              TOS := @VTAB(I*VTABSIZE)&LSL(1);                          49456000
              IF * = NAME,(8) THEN                                      49458000
                BEGIN                                                   49460000
                  FINDVOL := X;                                         49462000
                  CC := CCE;                                            49464000
                  RETURN;                                               49466000
                END;                                                    49468000
            END;                                                        49470000
          CC := CCG;                                                    49472000
      END <<FINDVOL>> ;                                                 49474000
                                                                        49476000
          <<------------                                                49478000
            ADD VOLUME                                                  49480000
          ------------>>                                                49482000
  INTEGER PROCEDURE ADDVOL(NAME,PVTYP);                        <<RH.PV>>49484000
    VALUE PVTYP;                                               <<RH.PV>>49486000
    BYTE ARRAY NAME;                                                    49488000
    LOGICAL PVTYP;  <<TRUE IMPLIES DUMMY PV ENTRY>>            <<RH.PV>>49490000
    OPTION VARIABLE;                                           <<RH.PV>>49492000
    COMMENT                                                             49494000
      ADDS THE VOLUME SPECIFIED BY NAME TO THE VOLUME TABLE. IF THERE   49496000
    IS NO ROOM, RETURNS CCG. OTHERWISE, RETURNS CCE AND THE INDEX OF    49498000
    WHERE IT WAS INSERTED IN ADDVOL;                                    49500000
      BEGIN                                                             49502000
        LOGICAL PMAP = Q-4;                                    <<RH.PV>>49504000
        INTEGER I:=0;                                                   49506000
          CC := CCE;                                           <<01035>>49508000
          IF NOT PMAP THEN PVTYP := FALSE;                     <<01035>>49510000
          IF PVTYP THEN                                        <<01035>>49512000
            BEGIN  << PRIVATE VOLUME ENTRY >>                  <<01035>>49514000
              I := HVOL;                                       <<01035>>49516000
              MVOL := MVOL + 1;                                <<01035>>49518000
              << SAVE SPACE EVEN IF VOL NOT MOUNTED >>         <<01035>>49520000
              IF MVOL > 64 THEN                                <<01035>>49522000
                BEGIN                                          <<01035>>49524000
                   MESSAGE(M200);                              <<01103>>49526000
                   CC := CCG;                                  <<01035>>49528000
                   RETURN;                                     <<01035>>49530000
                END;                                           <<01035>>49532000
              VTABINCR := VTABSIZE;                            <<01035>>49534000
              MOVEDLTABLES;  << ALLOCATE & ZERO NEW ENTRY >>   <<01035>>49536000
              DO I:=I+1  <<RETURN INDEX TO NEXT UNUSED ENTRY>> <<01035>>49538000
                UNTIL VTAB(VTABSIZE*I) = 0;                    <<01035>>49540000
              ADDVOL := X;                                     <<01035>>49542000
            END                                                <<01035>>49544000
          ELSE                                                 <<01035>>49546000
            BEGIN  << SYSTEM VOLUME ENTRY >>                   <<01035>>49548000
              I := 0;                                          <<01035>>49550000
              DO I:=I+1                                        <<01035>>49552000
                UNTIL VTAB(VTABSIZE*I)=0 OR I > HVOL;          <<01035>>49554000
              IF I > HVOL THEN                                 <<01035>>49556000
                BEGIN                                          <<01035>>49558000
                  IF I > 64 THEN                               <<01035>>49560000
                    BEGIN                                      <<01035>>49562000
                      MESSAGE(M200);                           <<01103>>49564000
                      CC := CCG;                               <<01035>>49566000
                      RETURN;                                  <<01035>>49568000
                    END;                                       <<01035>>49570000
                  HVOL := I;                                   <<01120>>49572000
                  VTABINCR := VTABSIZE;                        <<01035>>49574000
                  MOVEDLTABLES;                                <<01035>>49576000
                END;                                           <<01035>>49578000
              << ZERO OUT THE NEW VOLUME ENTRY >>              <<D7829>>49580000
              ZEROBUF(VTAB(VTABSIZE*I),VTABSIZE);              <<D7829>>49582000
              TOS := @VTAB(VTABSIZE*I)&LSL(1);                 <<04306>>49584000
              ADDVOL := X;                                     <<01035>>49586000
              MOVE * := NAME, (8);                             <<01035>>49588000
            END;                                               <<01035>>49590000
    END;  << ADDVOL >>                                         <<01035>>49592000
                                                               <<01035>>49594000
                                                               <<01035>>49596000
                                                               <<01035>>49598000
                                                               <<01035>>49600000
                                                               <<01035>>49602000
                                                                        49604000
          <<-------------------                                         49606000
            LIST VOLUME TABLE                                           49608000
          ------------------->>                                         49610000
  PROCEDURE LISTVOL;                                                    49612000
    COMMENT                                                             49614000
      PRINTS A LISTING OF THE VOLUME TABLE;                             49616000
      BEGIN                                                             49618000
        INTEGER J,I:=0;                                                 49620000
         MOVE BLINE := "VOLUME #    NAME    LOG DEV #";        <<00888>>49622000
         PRINTLINE;                                            <<00888>>49624000
          WHILE (I:=I+1) <= HVOL DO                                     49626000
          IF VTAB(I*VTABSIZE)<>0 THEN                                   49628000
            BEGIN                                                       49630000
              ASCII (I,10,BLINE (3));                          <<*8392>>49632000
              MOVE LINE (5) := VTAB (I*VTABSIZE),(4);          <<00888>>49634000
              ASCII(VTAB(X:=X+VTAB12).VTABLDEV,10,BLINE(23));  <<*8392>>49636000
              PRINTLINE;                                       <<00888>>49638000
            END;                                                        49640000
      END <<LISTVOL>> ;                                                 49642000
        <<---------------------------------->>                 <<MPEIV>>49644000
        <<  LIST VIRTUAL DEVICE ALLOCATION  >>                 <<MPEIV>>49646000
        <<---------------------------------->>                 <<MPEIV>>49648000
                                                               <<MPEIV>>49650000
PROCEDURE LISTVM;                                              <<MPEIV>>49652000
COMMENT:  PRINT LISTING OF THE VIRTUAL MEMORY ALLOCATION ON    <<MPEIV>>49654000
SYSTEM VOLUMES.                                                <<MPEIV>>49656000
;                                                              <<MPEIV>>49658000
BEGIN                                                          <<MPEIV>>49660000
DOUBLE  SECTORS;     << # OF SECTORS ALLOCATED >>              <<MPEIV>>49662000
INTEGER LDEV,         << LDEV# OF CORRESPONDING VOLUME >>      <<MPEIV>>49664000
        SECTORS1      = SECTORS,                               <<MPEIV>>49666000
        SECTORS2      = SECTORS+1,                             <<MPEIV>>49668000
        VOLUME := 0;  << VOLUME INDEX >>                       <<MPEIV>>49670000
                                                               <<MPEIV>>49672000
MOVE BLINE := "VOLUME NAME   LDEV #   VM ALLOCATION";          <<MPEIV>>49674000
PRINTLINE;                                                     <<MPEIV>>49676000
WHILE (VOLUME := VOLUME+1) <= HVOL DO                          <<MPEIV>>49678000
  IF VTAB(VOLUME*VTABSIZE) <> 0 THEN                           <<MPEIV>>49680000
    BEGIN                                                      <<MPEIV>>49682000
    MOVE LINE(1) := VTAB(VOLUME*VTABSIZE), (4);  << VOL NAME>> <<MPEIV>>49684000
    LDEV := GETLDEV(VOLUME);                                   <<MPEIV>>49686000
    LNTOA(LDEV, 10, BLINE(15));  << LOGICAL NUMBER TO ASCII >> <<MPEIV>>49688000
    SECTORS1 := VTAB(VOLUME*VTABSIZE+VTAB10);                  <<MPEIV>>49690000
    SECTORS2 := VTAB(X:=X+1);                                  <<MPEIV>>49692000
    LDNTOA((SECTORS/1024D), 10, BLINE(24)); <<DOUBLE TO ASCII>><<MPEIV>>49694000
    PRINTLINE;                                                 <<MPEIV>>49696000
    END;                                                       <<MPEIV>>49698000
END;  << LISTVM >>                                             <<MPEIV>>49700000
PROCEDURE VERIFYVM;                                            <<MPEIV>>49702000
                                                               <<MPEIV>>49704000
COMMENT:  THIS PROCEDURE IS USED TO DETERMINE IF THE           <<MPEIV>>49706000
VALUES FOR VIRTUAL MEMORY IN THE VOLUME TABLE ARE VALID        <<MPEIV>>49708000
OR IF THEY SHOULD BE REPLACED BY DEFAULT VALUES AND NEW        <<MPEIV>>49710000
SPACE OBTAINED.  THE PROBLEM ARISES WHEN A SPLIT VIRTUAL       <<MPEIV>>49712000
MEMORY SYSTEM IS UPDATED BY A PRE-SPLIT VM SYSTEM AND          <<MPEIV>>49714000
A RECOVER LOST DISC SPACE IS DONE TO RECOVER THE VM            <<MPEIV>>49716000
SPACE. THEN IF YOU UPDATE FORWARD AGAIN, SINCE THE VTAB        <<MPEIV>>49718000
EXISTED CONTINOUSLY IT WILL SHOW THE SPACE STILL               <<MPEIV>>49720000
ALLOCATED FOR VM AND USE IT.  TO MAKE THIS DETERMINATION       <<MPEIV>>49722000
AN ADDITIONAL COLDLOADID IS KEPT IN THE VTAB.  ONLY            <<MPEIV>>49724000
SPLIT VM SYSTEMS WILL KNOW TO UPDATE THIS NUMBER.              <<MPEIV>>49726000
;                                                              <<MPEIV>>49728000
BEGIN                                                          <<MPEIV>>49730000
LOGICAL VOLUME;                                                <<MPEIV>>49732000
                                                               <<MPEIV>>49734000
IF VTAB(VMINTEGRITY) <> COLDLOADID THEN                        <<MPEIV>>49736000
  BEGIN  << LAST RESTART WAS PRE-SPLIT VM - USE DEFAULTS >>    <<MPEIV>>49738000
  MESSAGE(M2219);  << WARNING - USING VM DEFAULT SIZE >>       <<MPEIV>>49740000
  VOLUME := 0;                                                 <<MPEIV>>49742000
  WHILE (VOLUME := VOLUME+1) <= LOGICAL(HVOL) DO               <<MPEIV>>49744000
    IF VTAB(VOLUME*VTABSIZE+VTAB12).VTABLDEV = SYSDISC THEN    <<MPEIV>>49746000
      BEGIN  << VM SIZE DEFAULTS TO 0 EXCEPT SYSDISC >>        <<MPEIV>>49748000
      INFO(VIRMEMSECT) := L'(INFO(VIRMEMSECT)) /               <<MPEIV>>49750000
        NWORDPAGE * NWORDPAGE;  << ROUND DOWN >>               <<MPEIV>>49752000
      TOS := INFOD(VIRMEMADR);                                 <<MPEIV>>49754000
      VTAB(VOLUME*VTABSIZE+VTAB9) := TOS;                      <<MPEIV>>49756000
      VTAB(VOLUME*VTABSIZE+VTAB8) := TOS;                      <<MPEIV>>49758000
      VTAB(VOLUME*VTABSIZE+VTAB10) := 0;                       <<MPEIV>>49760000
      VTAB(VOLUME*VTABSIZE+VTAB11) := INFO(VIRMEMSECT);        <<MPEIV>>49762000
      VTAB(VOLUME*VTABSIZE+VTAB12).VMS := 1;                   <<MPEIV>>49764000
      END  << SYSTEM DISC >>                                   <<MPEIV>>49766000
    ELSE                                                       <<MPEIV>>49768000
      BEGIN  << NOT SYSDISC >>                                 <<MPEIV>>49770000
      VTAB(VOLUME*VTABSIZE+VTAB8) := 0;                        <<MPEIV>>49772000
      VTAB(X:=X+1) := 0;                                       <<MPEIV>>49774000
      VTAB(X:=X+1) := 0;                                       <<MPEIV>>49776000
      VTAB(X:=X+1) := 0;                                       <<MPEIV>>49778000
      VTAB(X:=X+1).VMS := 0;                                   <<MPEIV>>49780000
      END;  << NOT SYSDISC >>                                  <<MPEIV>>49782000
  END;  << INTEGRITY <> COLDLOADID >>                          <<MPEIV>>49784000
END;  << VERIFYVM >>                                           <<MPEIV>>49786000
                                                                        49788000
          <<-----------------                                           49790000
            GET VOLUME NAME                                             49792000
          ----------------->>                                           49794000
  PROCEDURE GETVNAME(CRLABEL);                                          49796000
    VALUE CRLABEL;                                                      49798000
    INTEGER CRLABEL;                                                    49800000
    COMMENT                                                             49802000
      PROMPTS THE OPERATOR FOR A VOLUME NAME. IF A CARRIAGE RETURN      49804000
    IS ENTERED, EXITS TO THE LABEL SPECIFIED BY CRLABEL. OTHERWISE      49806000
    PLACES THE VOLUME NAME ENTERED IN BYTE ARRAY VNAME;                 49808000
      BEGIN                                                             49810000
  REQVNAME:                                                             49812000
          MESSAGE(-M2204);  <<ENTER VOLUME NAME>>              <<01103>>49814000
          READINPUT;                                                    49816000
          SCAN BINBUF WHILE BLANK;                                      49818000
          IF CARRY THEN                                                 49820000
            BEGIN  <<CARRAIGE RETURN INPUT>>                            49822000
              RETURNP := CRLABEL;                                       49824000
              RETURN;                                                   49826000
            END;                                                        49828000
          GETSTR(VNAME,@REQVNAME,1,8);                                  49830000
      END <<GETVNAME>> ;                                                49832000
PROCEDURE RELEASEVM(LDEV, VDSLEN, VDSTART);                    <<MPEIV>>49834000
VALUE LDEV, VDSLEN, VDSTART;                                   <<MPEIV>>49836000
DOUBLE  VDSLEN,   << LENGTH OF VIRTUAL MEMORY >>               <<MPEIV>>49838000
        VDSTART;  << STARTING SECTOR OF V.M. >>                <<MPEIV>>49840000
LOGICAL LDEV;     << LDEV OF DEVICE CONTAINING THIS V.M. >>    <<MPEIV>>49842000
                                                               <<MPEIV>>49844000
COMMENT:  THIS PROCEDURE WILL RELEASE THE DISC SPACE           <<MPEIV>>49846000
ALLOCATED TO VIRTUAL MEMORY IN THE FREE SPACE TABLE OF THE     <<MPEIV>>49848000
LDEV SPECIFIED (BUT IT WON'T ALTER THE VOLUME TABLE ENTRY).    <<MPEIV>>49850000
THE RELEASED SPACE WILL THEN BE CHECKED FOR DEFECTIVE TRACKS   <<MPEIV>>49852000
THAT WERE IN VIRTUAL MEMORY AND DELETE THEM FROM THE DFS       <<MPEIV>>49854000
TABLE.  IF IT IS A RELOAD THEN THE FREE SPACE TABLES WILL BE   <<MPEIV>>49856000
REINITIALIZED SO NOTHING NEEDS TO BE DONE.  IF VDSLEN IS ZERO  <<MPEIV>>49858000
THEN THERE IS NO SPACE TO BE RELEASED.                         <<MPEIV>>49860000
;                                                              <<MPEIV>>49862000
BEGIN                                                          <<MPEIV>>49864000
DOUBLE  VDSTOP,   << LAST SECTOR OF VIRTUAL MEMORY >>          <<MPEIV>>49866000
        BADLENGTH,<< LENGTH OF BAD AREA TO REMOVE >>           <<MPEIV>>49868000
        FSECT,    << 1ST SECT. OF BAD AREA TO DEL. FROM DFS>>  <<MPEIV>>49870000
        LSECT;    << LAST SECT. OF BAD AREA TO DEL. FROM DFS >><<MPEIV>>49872000
                                                               <<MPEIV>>49874000
LOGICAL TYPE,     << DISC TYPE >>                              <<MPEIV>>49876000
        STYPE,    << DISC SUB TYPE >>                          <<MPEIV>>49878000
        TRACKLEN; << LENGTH OF 1 TRACK ON THIS DISC >>         <<MPEIV>>49880000
INTEGER I,        << WHILE LOOP COUNTER - DTT ENTRY # >>       <<*LDT*>>49882000
    LDT'INDEX,                                                 <<*LPDT>>49884000
    LPDT'INDEX;                                                <<*LPDT>>49886000
                                                               <<MPEIV>>49888000
IF RELOAD OR VDSLEN=0D THEN RETURN;  << SEE COMMENT >>         <<MPEIV>>49890000
                                                               <<MPEIV>>49892000
RETDISCSPACE(LDEV, VDSLEN, VDSTART);                           <<MPEIV>>49894000
IF <> THEN MESSAGE(M328);  << DISC SPACE ERROR >>              <<MPEIV>>49896000
                                                               <<MPEIV>>49898000
<< INITIALIZE VARAIBLES >>                                     <<MPEIV>>49900000
VDSTOP := VDSTART + VDSLEN - 1D;                               <<MPEIV>>49902000
LDT'INDEX := LDEV * LDTSIZE;                                   <<*LDT*>>49904000
LPDT'INDEX := LDEV * LPDTSIZE;                                 <<*LPDT>>49906000
TYPE := LDT'DEVICE'TYPE;                                       <<*LDT*>>49908000
STYPE := LPDT'SUBTYPE;                                         <<*LPDT>>49910000
IF TYPE = MHDISCTYPE THEN                                      <<MPEIV>>49912000
  TRACKLEN := MHINFO(STYPE*MHINFOSIZE+MHSECTRK)                <<MPEIV>>49914000
ELSE                                                           <<MPEIV>>49916000
  TRACKLEN := 32;                                              <<MPEIV>>49918000
<< FILL DEFECTIVE TRACKS TABLE >>                              <<MPEIV>>49920000
DISC(READ, LDEV, 1D, DTT, 128);                                <<MPEIV>>49922000
                                                               <<MPEIV>>49924000
IF TYPE = 0 << MH DISC >> OR TYPE = 1 << FH DISC >> THEN       <<*LDT*>>49926000
BEGIN                                                          <<03549>>49928000
I := 0;                                                        <<MPEIV>>49930000
WHILE (I:=I+1) <= DTT DO                                       <<MPEIV>>49932000
  IF DTT(I).(14:2) = 2 THEN                                    <<MPEIV>>49934000
    BEGIN  << DELETED TRACK >>                                 <<MPEIV>>49936000
    FSECT := D'( DTT(I)&LSR(2) ) * D'(TRACKLEN);               <<MPEIV>>49938000
    LSECT := FSECT + D'(TRACKLEN) - 1D;                        <<MPEIV>>49940000
    IF FSECT <= VDSTOP AND LSECT >= VDSTART THEN               <<MPEIV>>49942000
      BEGIN  << AT LEAST PARTIALLY IN VIRTUAL MEMORY >>        <<MPEIV>>49944000
      << REMOVE SPACE OF BAD TRACK THAT WAS IN VIRTUAL    >>   <<MPEIV>>49946000
      << MEMORY FROM FREE SPACE TABLE.                    >>   <<MPEIV>>49948000
      IF VDSTART > FSECT THEN                                  <<MPEIV>>49950000
        << PART OF BAD TRACK OVERLAPS FRONT OF VM >>           <<MPEIV>>49952000
        FSECT := VDSTART;  << ADJUST STARTING SECTOR >>        <<MPEIV>>49954000
      IF LSECT > VDSTOP THEN                                   <<MPEIV>>49956000
        << PART OF BAD TRACK OVERLAPS END OF VM >>             <<MPEIV>>49958000
        LSECT := VDSTOP;  << ADJUST ENDING SECTOR >>           <<MPEIV>>49960000
      BADLENGTH := (LSECT-FSECT) + 1D;                         <<MPEIV>>49962000
      REMDISCSPACE(LDEV, BADLENGTH, FSECT);                    <<MPEIV>>49964000
      IF <> THEN ERRMESSAGE(M329);  << DISC SPACE ERROR >>     <<MPEIV>>49966000
      END;  << BAD TRACK IN V.M. >>                            <<MPEIV>>49968000
    END;  << DELETED TRACK >>                                  <<MPEIV>>49970000
END;                                                           <<03549>>49972000
END;  << RELEASEVM >>                                          <<MPEIV>>49974000
PROCEDURE GETVM(LDEV, VDSLEN, VDSTART, SPECIFIC);              <<MPEIV>>49976000
VALUE LDEV, VDSLEN, SPECIFIC;                                  <<MPEIV>>49978000
DOUBLE  VDSLEN,   << LENGTH OF V.M. TO GET >>                  <<MPEIV>>49980000
        VDSTART;  << STARTING SECTOR OF V.M. (MAY BE INPUT  >> <<MPEIV>>49982000
                  << OR OUTPUT PARAMETER). SEE COMMENT.      >><<MPEIV>>49984000
LOGICAL LDEV,     << LDEV TO GET V.M. SPACE FROM >>            <<MPEIV>>49986000
        SPECIFIC; << TRUE - GET SPECIFIC SPACE REQUESTED >>    <<MPEIV>>49988000
OPTION VARIABLE;                                               <<MPEIV>>49990000
                                                               <<MPEIV>>49992000
COMMENT:  THIS PROCEDURE IS USED TO LOCATE SPACE FOR VIRTUAL   <<MPEIV>>49994000
MEMORY AND REMOVE IT FORM THE FREE SPACE TABLE. IF THE         <<MPEIV>>49996000
PARAMETER SPECIFIC IS TRUE THEN THE ONLY SPACE WE WILL ATTEMPT <<MPEIV>>49998000
TO LOCATE IS THAT STARTING AT SECTOR "VDSTART" FOR "VDSLEN"    <<MPEIV>>50000000
SECTORS.  IF SPECIFIC IS FALSE OR NOT PASSED THEN WE WILL      <<MPEIV>>50002000
LOCATE ANY SPACE OF LENGTH "VDSLEN" AND RETURN THE STARTING    <<MPEIV>>50004000
SECTOR IN VDSTART.                                             <<MPEIV>>50006000
  RETURN CODES:                                                <<MPEIV>>50008000
    CCE - NORMAL RETURN, SPACE FOUND,                          <<MPEIV>>50010000
    CCL - ABNORMAL RETURN, NO SPACE FOUND.                     <<MPEIV>>50012000
;                                                              <<MPEIV>>50014000
BEGIN                                                          <<MPEIV>>50016000
DOUBLE  FSECT,         << 1ST SECTOR OF BAD TRACK >>           <<MPEIV>>50018000
        LSECT,         << LAST   "    "    "      "   >>       <<MPEIV>>50020000
        BADLENGTH,     << LENGTH OF BAD AREA TO REMOVE >>      <<MPEIV>>50022000
        VDSTOP;        << LAST SECTOR OF VIRTUAL MEMORY >>     <<MPEIV>>50024000
                                                               <<MPEIV>>50026000
LOGICAL TYPE,          << DISC TYPE >>                         <<MPEIV>>50028000
        STYPE,         << DISC SUB TYPE >>                     <<MPEIV>>50030000
        TRACKLEN,      << LENGTH OF 1 TRACK ON THIS DISC >>    <<MPEIV>>50032000
        REASSIGNSRETURNED,                                     <<01819>>50034000
        VAR = Q-4;                                             <<MPEIV>>50036000
INTEGER I,             << WHILE LOOP COUNTER - DTT ENTRY # >>  <<*LDT*>>50038000
    LDT'INDEX,                                                 <<*LPDT>>50040000
    LPDT'INDEX;                                                <<*LPDT>>50042000
                                                               <<MPEIV>>50044000
IF NOT VAR THEN SPECIFIC := FALSE;                             <<MPEIV>>50046000
CC := CCE;                                                     <<MPEIV>>50048000
                                                               <<MPEIV>>50050000
LDT'INDEX := LDEV * LDTSIZE;                                   <<*LDT*>>50052000
LPDT'INDEX := LDEV * LPDTSIZE;                                 <<*LPDT>>50054000
TYPE := LDT'DEVICE'TYPE;                                       <<*LDT*>>50056000
STYPE := LPDT'SUBTYPE;                                         <<*LPDT>>50058000
                                                               <<03549>>50060000
<< FILL DEFECTIVE TRACKS TABLE >>                              <<03549>>50062000
DISC(READ, LDEV, 1D, DTT, 128);                                <<03549>>50064000
                                                               <<03549>>50066000
IF RELOAD THEN                                                 <<03549>>50068000
   BEGIN                            << REMOVE REASSIGNED    >> <<03549>>50070000
   REM'RET'REASS(FALSE,LDEV,DTT);   << TRACKS FROM DFSM SO  >> <<03549>>50072000
   REASSIGNSRETURNED := FALSE;      << THERE WON'T BE ANY   >> <<03549>>50074000
                                    << IN VIRTUAL MEMORY    >> <<03549>>50076000
   END                                                         <<03549>>50078000
                                                               <<03549>>50080000
ELSE                            << IF NOT A RELOAD, SPACE  >>  <<03549>>50082000
   REASSIGNSRETURNED := TRUE;   << MAY BE IN USE BY A FILE >>  <<03549>>50084000
                                                               <<MPEIV>>50086000
<< WE'RE READY, LET'S TRY AND FIND SOME SPACE >>               <<MPEIV>>50088000
IF SPECIFIC THEN                                               <<MPEIV>>50090000
  REMDISCSPACE(LDEV, VDSLEN, VDSTART)                          <<MPEIV>>50092000
ELSE                                                           <<MPEIV>>50094000
  VDSTART := GETDISCSPACE(LDEV, VDSLEN);                       <<MPEIV>>50096000
                                                               <<MPEIV>>50098000
IF <> THEN                                                     <<MPEIV>>50100000
  BEGIN  << DIDN'T GET SPACE >>                                <<MPEIV>>50102000
  RETURNDELETES(LDEV);  << RETURN ALL DELETES >>               <<03549>>50104000
  IF SPECIFIC THEN                                             <<MPEIV>>50106000
    REMDISCSPACE(LDEV, VDSLEN, VDSTART)                        <<MPEIV>>50108000
  ELSE                                                         <<MPEIV>>50110000
    VDSTART := GETDISCSPACE(LDEV, VDSLEN);                     <<MPEIV>>50112000
                                                               <<MPEIV>>50114000
  IF <> THEN                                                   <<01963>>50116000
  IF RELOAD THEN                                               <<01963>>50118000
    BEGIN  << BUMMER - STILL DIDN'T GET SPACE >>               <<MPEIV>>50120000
    REM'RET'REASS(TRUE,LDEV,DTT);  << RETURN SPACE FOR      >> <<03549>>50122000
                                   <<    REASSIGNED TRACKS  >> <<03549>>50124000
    REASSIGNSRETURNED := TRUE;                                 <<MPEIV>>50126000
    << LAST CHANCE TO GET SPACE >>                             <<MPEIV>>50128000
    IF SPECIFIC THEN                                           <<MPEIV>>50130000
      REMDISCSPACE(LDEV, VDSLEN, VDSTART)                      <<MPEIV>>50132000
    ELSE                                                       <<MPEIV>>50134000
      VDSTART := GETDISCSPACE(LDEV, VDSLEN);                   <<MPEIV>>50136000
    IF <> THEN CC := CCL;  << WE GAVE IT OUR BEST SHOT & LOST>><<MPEIV>>50138000
    END                                                        <<01819>>50140000
  ELSE  << SPACE NOT FOUND AND NOT RELOAD >>                   <<01819>>50142000
    CC := CCL;                                                 <<01963>>50144000
    << NOTHING LEFT TO TRY >>                                  <<01819>>50146000
                                                               <<MPEIV>>50148000
  IF TYPE = 0 << MH DISC >> OR TYPE = 1 << FH DISC >> THEN     <<*LDT*>>50150000
  BEGIN                                                        <<03549>>50152000
  << IF ANY PORTION OF DELETED TRACK IS OUTSIDE V.M. THEN>>    <<MPEIV>>50154000
  << DELETE THAT PORTION FROM THE DFS TABLE.  OR IF NO   >>    <<MPEIV>>50156000
  << V.M. SPACE WAS FOUND (CC <> CCE) THEN DELETE WHOLE  >>    <<MPEIV>>50158000
  << TRACK.                                              >>    <<MPEIV>>50160000
  VDSTOP := VDSTART + VDSLEN - 1D;                             <<MPEIV>>50162000
  I := 0;                                                      <<MPEIV>>50164000
                                                               <<03549>>50166000
  IF TYPE=MHDISCTYPE THEN                                      <<03549>>50168000
    TRACKLEN := MHINFOL(STYPE*MHINFOSIZE+MHSECTRK)             <<03549>>50170000
  ELSE                                                         <<03549>>50172000
    TRACKLEN := 32;                                            <<03549>>50174000
                                                               <<03549>>50176000
  WHILE (I:=I+1) <= DTT DO                                     <<MPEIV>>50178000
    IF DTT(I).(14:2) = 2 THEN                                  <<MPEIV>>50180000
      BEGIN  << DELETED TRACK >>                               <<MPEIV>>50182000
      FSECT := D'( DTT(I)&LSR(2) ) * D'(TRACKLEN);             <<MPEIV>>50184000
      LSECT := FSECT + D'(TRACKLEN) - 1D;                      <<MPEIV>>50186000
                                                               <<MPEIV>>50188000
      IF FSECT <= VDSTOP AND LSECT >= VDSTART AND CC = CCE THEN<<MPEIV>>50190000
        BEGIN  << AT LEAST PART IN VIRTUAL MEMORY >>           <<MPEIV>>50192000
        IF FSECT >= VDSTART AND LSECT <= VDSTOP THEN           <<MPEIV>>50194000
          << BAD TRACK COMPLETELY IN V.M. >>                   <<MPEIV>>50196000
          GO TO NEXTDTTENTRY;                                  <<MPEIV>>50198000
        IF FSECT < VDSTART THEN                                <<MPEIV>>50200000
          << PART OVERLAPS FRONT OF V.M. >>                    <<MPEIV>>50202000
          LSECT := VDSTART - 1D;  << STOP AT FRONT OF V.M. >>  <<MPEIV>>50204000
        IF LSECT > VDSTOP THEN                                 <<MPEIV>>50206000
          << PART OVERLAPS END OF V.M. >>                      <<MPEIV>>50208000
          FSECT := VDSTOP + 1D;  << START JUST PAST V.M. >>    <<MPEIV>>50210000
        END  << AT LEAST PARTIALLY IN VIRTUAL MEMORY >>        <<MPEIV>>50212000
      ELSE                                                     <<MPEIV>>50214000
        BEGIN                                                  <<MPEIV>>50216000
        << DELETE WHOLE TRACK FROM DFS TABLE - EITHER NOT IN >><<MPEIV>>50218000
        << NEWLY ALLOCATED SPACE OR NO SPACE ALLOCATED.      >><<MPEIV>>50220000
        END;                                                   <<MPEIV>>50222000
      BADLENGTH := (LSECT-FSECT) + 1D;                         <<MPEIV>>50224000
      REMDISCSPACE(LDEV, BADLENGTH, FSECT);                    <<MPEIV>>50226000
      IF <> THEN ERRMESSAGE(M329);                             <<MPEIV>>50228000
NEXTDTTENTRY:                                                  <<MPEIV>>50230000
      END;  << DELETED TRACK >>                                <<MPEIV>>50232000
  END;                                                         <<03549>>50234000
  END;  << DIDN'T GET SPACE ON FIRST TRY >>                    <<MPEIV>>50236000
IF NOT REASSIGNSRETURNED THEN                                  <<MPEIV>>50238000
  REM'RET'REASS(TRUE,LDEV,DTT);    << RETURN SPACE FOR      >> <<03549>>50240000
                                   <<    REASSIGNED TRACKS  >> <<03549>>50242000
END;  << GETVM >>                                              <<MPEIV>>50244000
$PAGE "DEFECTIVE TRACKS TABLE PROCEDURES"                               50246000
$CONTROL SEGMENT=DEFECTRACKS                                            50248000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>50250000
         <<--------------------------------------->>           <<03549>>50252000
         << GET AN AREA FROM A LIST OF DISC AREAS >>           <<03549>>50254000
         <<--------------------------------------->>           <<03549>>50256000
LOGICAL PROCEDURE GET'AREA(AREA'LIST,ENTRY',MAX'ENTRIES,       <<03549>>50258000
                                 LDEV,DISC'ADDR,LENGTH);       <<03549>>50260000
VALUE ENTRY',MAX'ENTRIES;                                      <<03549>>50262000
INTEGER ARRAY                                                  <<03549>>50264000
   AREA'LIST;    << ARRAY OF 5-WORD ENTRIES IN THE FORMAT: >>  <<03549>>50266000
                 <<    WORD    0:  LDEV                    >>  <<03549>>50268000
                 <<    WORDS 1-2:  LOGICAL DISC ADDRESS    >>  <<03549>>50270000
                 <<    WORDS 2-3:  DOUBLE WORD LENGTH      >>  <<03549>>50272000
INTEGER                                                        <<03549>>50274000
   ENTRY',        << ENTRY NO. TO BE OBTAINED >>               <<03549>>50276000
   MAX'ENTRIES,   << MAXIMUM NO. OF ENTRIES IN AREA'LIST >>    <<03549>>50278000
   LDEV;          << RETURN LOGICAL DEVICE NO. >>              <<03549>>50280000
DOUBLE                                                         <<03549>>50282000
   DISC'ADDR,    << RETURN DOUBLE WORD DISC ADDRESS >>         <<03549>>50284000
   LENGTH;       << RETURN DOUBLE WORD LENGTH >>               <<03549>>50286000
                                                               <<03549>>50288000
COMMENT                                                        <<03549>>50290000
GETS AN ENTRY FROM AN ARRAY OF DISC AREAS.  THIS PROCEDURE IS  <<03549>>50292000
USED, FOR ONE THING, TO GET AREAS OF DISC WHICH LOST DATA      <<03549>>50294000
DURING DEFECTIVE TRACKS/SECTORS PROCESSING.  RECOVER LOST DISC <<03549>>50296000
SPACE LOOKS AT THIS ARRAY TO DETERMINE WHICH FILES MAY BE      <<03549>>50298000
MURGED.  IF THE PASSED ENTRY DOES NOT EXIST, IT RETURNS        <<03549>>50300000
FALSE, TRUE OTHERWISE.                                         <<03549>>50302000
;                                                              <<03549>>50304000
BEGIN                                                          <<03549>>50306000
EQUATE                                                         <<03549>>50308000
   ENT'SIZE = 5;     << SIZE OF ENTRY IN AREA'LIST >>          <<03549>>50310000
DOUBLE                                                         <<03549>>50312000
   DADDR,            << TEMP. FOR DISC'ADDR >>                 <<03549>>50314000
   LEN;              << TEMP. FOR LENGTH >>                    <<03549>>50316000
INTEGER                                                        <<03549>>50318000
   DADDR1=DADDR,           << HIGH ORDER WORD OF DADDR >>      <<03549>>50320000
   DADDR2=DADDR+1,         << LOW ORDER WORD OF DADDR >>       <<03549>>50322000
   LEN1=LEN,               << HIGH ORDER WORD OF LEN >>        <<03549>>50324000
   LEN2=LEN+1,             << LOW ORDER WORD OF LEN >>         <<03549>>50326000
   INDEX;                  << CURRENT INDEX INTO AREA'LIST >>  <<03549>>50328000
                                                               <<03549>>50330000
IF ENTRY' < MAX'ENTRIES THEN                                   <<03549>>50332000
   BEGIN                                                       <<03549>>50334000
   INDEX := ENTRY' * ENT'SIZE;   << GET STARTING INDEX >>      <<03549>>50336000
   LDEV := AREA'LIST(INDEX);       << GET LDEV >>              <<03549>>50338000
   DADDR1 := AREA'LIST(INDEX+1);   << GET DISC     >>          <<03549>>50340000
   DADDR2 := AREA'LIST(INDEX+2);   <<    ADDRESS   >>          <<03549>>50342000
   LEN1 := AREA'LIST(INDEX+3);     << GET LENGTH   >>          <<03549>>50344000
   LEN2 := AREA'LIST(INDEX+4);                                 <<03549>>50346000
                                                               <<03549>>50348000
   DISC'ADDR := DADDR;     << COPY TO RETURN PARAMETERS >>     <<03549>>50350000
   LENGTH := LEN;                                              <<03549>>50352000
   GET'AREA := TRUE;       << SUCCESSFUL--RETURN TRUE >>       <<03549>>50354000
   END                                                         <<03549>>50356000
                                                               <<03549>>50358000
ELSE                                                           <<03549>>50360000
   GET'AREA := FALSE;      << ENTRY DOESN'T EXIST >>           <<03549>>50362000
END;   << GET'AREA >>                                          <<03549>>50364000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>50366000
        <<------------------------------------------>>         <<03549>>50368000
        <<   ADD AN ENTRY TO A LIST OF DISC AREAS   >>         <<03549>>50370000
        <<------------------------------------------>>         <<03549>>50372000
LOGICAL PROCEDURE ADD'AREA(AREA'LIST,ENTRY',MAX'ENTRIES,       <<03549>>50374000
                                 LDEV,DISC'ADDR,LENGTH);       <<03549>>50376000
VALUE ENTRY',MAX'ENTRIES,LDEV,DISC'ADDR,LENGTH;                <<03549>>50378000
INTEGER ARRAY                                                  <<03549>>50380000
   AREA'LIST;     << ARRAY OF 5-WORD ENTRIES IN THE FORMAT: >> <<03549>>50382000
                  <<    WORD    0:  LDEV                    >> <<03549>>50384000
                  <<    WORDS 1-2:  LOGICAL DISC ADDRESS    >> <<03549>>50386000
                  <<    WORDS 2-3:  DOUBLE WORD LENGTH      >> <<03549>>50388000
INTEGER                                                        <<03549>>50390000
   ENTRY',         << ENTRY NO. TO BE ADDED >>                 <<03549>>50392000
   MAX'ENTRIES,    << MAXIMUM NUMBER OF ENTRIES IN AREA'LIST >><<03549>>50394000
   LDEV;           << LOGICAL DEVICE NO. >>                    <<03549>>50396000
DOUBLE                                                         <<03549>>50398000
   DISC'ADDR,     << DOUBLE WORD DISC ADDRESS >>               <<03549>>50400000
   LENGTH;        << DOUBLE WORD LENGTH >>                     <<03549>>50402000
                                                               <<03549>>50404000
COMMENT                                                        <<03549>>50406000
ADDS AN ENTRY TO AN ARRAY OF DISC AREAS.  THIS PROCEDURE IS    <<03549>>50408000
USED, FOR ONE THING, TO LOG AREAS OF DISC WHICH LOST DATA      <<03549>>50410000
DURING DEFECTIVE TRACKS PROCESSING.  RECOVER LOST DISC SPACE   <<03549>>50412000
THEN LOOKS AT THIS ARRAY TO DETERMINE WHICH FILES MAY BE       <<03549>>50414000
PURGED.  IF THERE IS NO ROOM FOR THE ENTRY, IT RETURNS         <<03549>>50416000
FALSE, TRUE OTHERWISE.                                         <<03549>>50418000
;                                                              <<03549>>50420000
BEGIN                                                          <<03549>>50422000
EQUATE                                                         <<03549>>50424000
   ENT'SIZE = 5;   << SIZE OF ENTRY IN AREA'LIST >>            <<03549>>50426000
INTEGER                                                        <<03549>>50428000
   DISC'ADDR1=DISC'ADDR,   << HIGH ORDER WORD OF DISC'ADDR >>  <<03549>>50430000
   DISC'ADDR2=DISC'ADDR+1, << LOW ORDER WORD OF DISC'ADDR  >>  <<03549>>50432000
   LENGTH1=LENGTH,         << HIGH ORDER WORD OF LENGTH >>     <<03549>>50434000
   LENGTH2=LENGTH+1,       << LOW ORDER WORD OF LENGTH >>      <<03549>>50436000
   INDEX;                  << CURRENT INDEX INTO AREA'LIST >>  <<03549>>50438000
                                                               <<03549>>50440000
IF ENTRY' < MAX'ENTRIES THEN                                   <<03549>>50442000
   BEGIN                                                       <<03549>>50444000
   INDEX := ENTRY' * ENT'SIZE;    << GET STARTING INDEX >>     <<03549>>50446000
   AREA'LIST(INDEX)   := LDEV;     << PUT LDEV IN >>           <<03549>>50448000
   AREA'LIST(INDEX+1) := DISC'ADDR1;   << PUT DISC ADDRESS >>  <<03549>>50450000
   AREA'LIST(INDEX+2) := DISC'ADDR2;   <<    IN            >>  <<03549>>50452000
   AREA'LIST(INDEX+3) := LENGTH1;      << PUT LENGTH IN >>     <<03549>>50454000
   AREA'LIST(INDEX+4) := LENGTH2;                              <<03549>>50456000
   ADD'AREA := TRUE;         << SUCCESSFUL--RETURN TRUE >>     <<03549>>50458000
   END                                                         <<03549>>50460000
                                                               <<03549>>50462000
ELSE                                                           <<03549>>50464000
   ADD'AREA := FALSE;        << NO ROOM--RETURN FALSE >>       <<03549>>50466000
END;   << ADD'AREA >>                                          <<03549>>50468000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>50470000
          <<-----------------------                                     50472000
            GET TRACK DISPOSITION                                       50474000
          ----------------------->>                                     50476000
  INTEGER PROCEDURE GETDISP(LEGAL);                                     50478000
    VALUE LEGAL;                                                        50480000
    LOGICAL LEGAL;                                                      50482000
    COMMENT                                                             50484000
      ASKS THE OPERATOR FOR THE DISPOSTION OF A DEFECTIVE TRACK.        50486000
    LEGAL CONTAINS A BITMASK DEFINING THE LEGAL ANSWERS AND GETDISP     50488000
    RETURNS THE ANSWER GIVEN AS FOLLOWS:                                50490000
        ANSWER         LEGAL BIT    GETDISP RETURN                      50492000
        ------         ---------    --------------                      50494000
       IGNORE (CR)         15             0                             50496000
       RECOVER             14             1                             50498000
       DELETE              13             2                             50500000
       REASSIGN            12             3;                            50502000
                                                                        50504000
      BEGIN                                                             50506000
        INTEGER I;                                                      50508000
        BYTE ARRAY ANS(0:8)=PB:="REC","DEL","REA";                      50510000
  REQDISP:IF LEGAL=7 THEN TOS := -M2231  <<DELETE OR RECOVER>> <<01103>>50512000
          ELSE IF LEGAL=%14 THEN TOS := -M2232<<DELETE OR REA>><<01103>>50514000
                                                               <<03613>>50516000
          << Reassign, Recover, Ignore >>                      <<03613>>50518000
          ELSE IF legal = %13 THEN                             <<03613>>50520000
             TOS := -m2247                                     <<03613>>50522000
                                                               <<03613>>50524000
          ELSE TOS := -M2233;    <<DELETE,REASSIGN OR RECOVER>><<01103>>50526000
          MESSAGE(*);                                          <<01103>>50528000
          READINPUT;                                                    50530000
          SCAN BINBUF WHILE BLANK;                                      50532000
          IF CARRY THEN                                                 50534000
            BEGIN                                                       50536000
              X := 15;  <<IGNORE>>                                      50538000
              GOTO CHECKDISP;                                           50540000
            END;                                                        50542000
          GETSTR(BBUF,@REQDISP,1,8);                                    50544000
          I := 0;                                                       50546000
          DO IF BBUF=ANS(I*3),(3) THEN GOTO OK UNTIL (I:=I+1)=3;        50548000
  ERROR:  MESSAGE(M2453);  <<ILLEGAL INPUT>>                   <<01103>>50550000
          GO REQDISP;                                                   50552000
  OK:     X := 14-I;                                                    50554000
  CHECKDISP:                                                            50556000
          TOS := LEGAL;                                                 50558000
          ASSEMBLE(TBC 0,X);                                            50560000
          IF = THEN GOTO ERROR;  <<THAT ANSWER NOT ALLOWED>>            50562000
          GETDISP := 15-X;                                              50564000
      END <<GETDISP>> ;                                                 50566000
          <<--------------------------------------                      50568000
            CONVERT TRACK # TO CYLINDER AND HEAD                        50570000
          -------------------------------------->>                      50572000
  DOUBLE PROCEDURE CYLINDERHEAD(TRACK,SUBTYP);                          50574000
    VALUE TRACK,SUBTYP;                                                 50576000
    INTEGER TRACK,SUBTYP;                                               50578000
    COMMENT                                                             50580000
      CONVERTS THE TRACK NUMBER SUPPLIED INTO A CYLINDER NUMBER         50582000
    AND HEAD NUMBER BASED ON THE SUBTYPE OF THE DISC;                   50584000
      BEGIN                                                             50586000
        INTEGER CYLINDER=CYLINDERHEAD+1, HEAD=CYLINDERHEAD, INDEX;      50588000
          TOS := TRACK;                                                 50590000
          TOS := MHINFO((INDEX:=SUBTYP*MHINFOSIZE)+MHTRKCYL);<<TRK/CYL>>50592000
          ASSEMBLE(DIV);                                                50594000
          HEAD := TOS*MHINFO(INDEX+MHTRKMULT)+MHINFO(INDEX+MHSTHEAD);   50596000
          CYLINDER := TOS;  <<CYLINDER #>>                              50598000
      END <<CYLINDERHEAD>> ;                                            50600000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>50602000
          <<------------------------------------>>             <<03549>>50604000
          <<      CHECK FOR A VALID DTT         >>             <<03549>>50606000
          <<------------------------------------>>             <<03549>>50608000
LOGICAL PROCEDURE GOOD'DTT(DTT);                               <<03549>>50610000
INTEGER ARRAY                                                  <<03549>>50612000
   DTT;      << DEFECTIVE TRACKS TABLE >>                      <<03549>>50614000
                                                               <<03549>>50616000
COMMENT                                                        <<03549>>50618000
CHECKS FOR A VALID DEFECTIVE TRACKS TABLE.                     <<03549>>50620000
;                                                              <<03549>>50622000
BEGIN                                                          <<03549>>50624000
IF 0 <= DTT(0) <= MAXDTT THEN                                  <<03549>>50626000
   GOOD'DTT := TRUE                                            <<03549>>50628000
ELSE                                                           <<03549>>50630000
   GOOD'DTT := FALSE;                                          <<03549>>50632000
END;   << GOOD'DTT >>                                          <<03549>>50634000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>50636000
         <<------------------------------------>>              <<03549>>50638000
         <<  SORT THE DEFECTIVE TRACKS TABLE   >>              <<03549>>50640000
         <<------------------------------------>>              <<03549>>50642000
PROCEDURE SORTDTT(DTT);                                        <<03549>>50644000
INTEGER ARRAY                                                  <<03549>>50646000
   DTT;     << DEFECTIVE TRACKS TABLE >>                       <<03549>>50648000
                                                               <<03549>>50650000
COMMENT                                                        <<03549>>50652000
THIS PROCEDURE SORTS THE DEFECTIVE TRACKS TABLE IN             <<03549>>50654000
ORDER OF INCREASING TRACK #.                                   <<03549>>50656000
;                                                              <<03549>>50658000
BEGIN                                                          <<03549>>50660000
INTEGER                                                        <<03549>>50662000
   I,J,TEMP;    << SCRATCH VARIABLES >>                        <<03549>>50664000
                                                               <<03549>>50666000
I := 0;                                                        <<03549>>50668000
WHILE (I:=I+1) < DTT(0) DO                                     <<03549>>50670000
   BEGIN      << SORT TRACKS USING BUBBLESORT >>               <<03549>>50672000
   J := I;                                                     <<03549>>50674000
   WHILE (J:=J+1) <= DTT(0) DO                                 <<03549>>50676000
      IF DTT(I) > DTT(J) THEN                                  <<03549>>50678000
         BEGIN              << REVERSE THE ORDER >>            <<03549>>50680000
         TEMP := DTT(I);    <<   OF TWO ELEMENTS >>            <<03549>>50682000
         DTT(I) := DTT(J);                                     <<03549>>50684000
         DTT(J) := TEMP;                                       <<03549>>50686000
         END;                                                  <<03549>>50688000
   END;                                                        <<03549>>50690000
END;   << SORTDTT >>                                           <<03549>>50692000
          <<-------------------------------------                       50694000
            ADD ENTRY TO DEFECTIVE TRACKS TABLE                         50696000
          ------------------------------------->>                       50698000
  INTEGER PROCEDURE ADDDTTENTRY(TRACK);                                 50700000
    VALUE TRACK;                                                        50702000
    INTEGER TRACK;                                                      50704000
    COMMENT                                                             50706000
      ADDS THE ENTRY SPECIFIED BY TRACK TO THE DEFECTIVE TRACKS         50708000
    TABLE. IF THE ENTRY IS ALREADY IN THE TABLE OR THE TABLE IS         50710000
    FULL, RETURNS A ZERO, OTHERWISE A ONE;                              50712000
      BEGIN                                                             50714000
        INTEGER I:=0;                                                   50716000
          IF DTT=MAXDTT THEN RETURN;  <<TABLE FULL>>           <<00463>>50718000
          WHILE (I:=I+1) <= DTT DO                                      50720000
            BEGIN  <<FIND WHERE IT GOES>>                               50722000
              IF DTT(I)=TRACK THEN RETURN;  <<ALREADY IN TABLE>>        50724000
              IF > THEN                                                 50726000
                BEGIN  <<MAKE ROOM FOR IT>>                             50728000
                  MOVE DTT(DTT+1) := DTT(X:=X-1),(I-DTT-1);             50730000
                  GOTO ADD;                                             50732000
                END;                                                    50734000
            END;                                                        50736000
  ADD:    DTT(I) := TRACK;                                              50738000
          DTT := DTT+1;                                                 50740000
          ADDDTTENTRY := 1;                                             50742000
      END <<ADDDTTENTRY>> ;                                             50744000
          <<------------------------------------------                  50746000
            DELETE ENTRY FROM DEFECTIVE TRACKS TABLE                    50748000
          ------------------------------------------>>                  50750000
  INTEGER PROCEDURE DELDTTENTRY(TRACK);                                 50752000
    VALUE TRACK;                                                        50754000
    INTEGER TRACK;                                                      50756000
    COMMENT                                                             50758000
      REMOVES THE ENTRY WITH THE SPECIFIED TRACK NUMBER AND STATUS      50760000
    (FOUND IN TRACK) FROM THE DTT IF IT EXISTS AND RETURNS -1. IF       50762000
    IT DOES NOT EXIST, RETURNS ZERO;                                    50764000
      BEGIN                                                             50766000
        INTEGER I:=0;                                                   50768000
          WHILE (I:=I+1) <= DTT DO                                      50770000
          IF DTT(I) = TRACK THEN                                        50772000
            BEGIN  <<FOUND IT>>                                         50774000
              DELDTTENTRY := -1;                                        50776000
              MOVE DTT(I) := DTT(I+1),(DTT-I);                          50778000
              DTT := DTT-1;                                             50780000
              RETURN;                                                   50782000
            END;                                                        50784000
      END <<DELDTTENTRY>> ;                                             50786000
          <<---------------------------------------                     50788000
            DELETE ALL ENTRIES FOR TRACK FROM DTT                       50790000
          --------------------------------------->>                     50792000
  INTEGER PROCEDURE DELDTTENTRIES(TRACK);                               50794000
    VALUE TRACK;                                                        50796000
    INTEGER TRACK;                                                      50798000
    COMMENT                                                             50800000
      REMOVES ALL ENTRIES FOR THE SPECIFIED TRACK FROM THE DTT. (TRACK  50802000
    CONTAINS ONLY THE TRACK NUMBER RIGHT JUSTIFIED, NOT ANY STATUS      50804000
    BITS). RETURNS -(# OF WORDS REMOVED);                               50806000
      BEGIN                                                             50808000
        INTEGER COUNT=DELDTTENTRIES, I:=0;                              50810000
          WHILE (I:=I+1) <= DTT DO                                      50812000
          IF DTT(I)&LSR(2)=TRACK THEN                                   50814000
            BEGIN                                                       50816000
  ANOTHER:    COUNT := COUNT+1;                                         50818000
              IF DTT(I:=I+1)&LSR(2)=TRACK THEN GOTO ANOTHER;            50820000
              MOVE DTT(I-COUNT) := DTT(I),(DTT-I+1);                    50822000
              COUNT := -COUNT;                                          50824000
              DTT := DTT+COUNT;                                         50826000
              RETURN;                                                   50828000
            END;                                                        50830000
      END <<DELDTTENTRIES>> ;                                           50832000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>50834000
       <<--------------------------------------->>             <<03549>>50836000
       << INITIALIZE THE DEFECTIVE SECTOR TABLE >>             <<03549>>50838000
       <<--------------------------------------->>             <<03549>>50840000
PROCEDURE INIT'DSCT(DSCT);                                     <<03549>>50842000
INTEGER ARRAY                                                  <<03549>>50844000
   DSCT;       << DEFECTIVE SECTOR TABLE >>                    <<03549>>50846000
                                                               <<03549>>50848000
COMMENT                                                        <<03549>>50850000
INITIALIZES THE DEFECTIVE SECTOR TABLE--SETS UP THE HEADER.    <<03549>>50852000
;                                                              <<03549>>50854000
BEGIN                                                          <<03549>>50856000
                                                               <<03549>>50858000
DSCT(DSCT'NUM'ENTRIES) := 0;         << NO ENTRIES YET >>      <<03549>>50860000
DSCT(DSCT'FIRST'ENTRY) := 6;         << INDEX TO FIRST ENTRY>> <<03549>>50862000
DSCT(DSCT'ENTRY'SIZE)  := 2;         << WORDS PER ENTRY >>     <<03549>>50864000
DSCT(DSCT'MAX'ENTRIES) := MAX'DSCT;  << MAX. NO. OF ENTRIES >> <<03549>>50866000
DSCT(4) := 0;                                                  <<03549>>50868000
DSCT(5) := 0;                                                  <<03549>>50870000
                                                               <<03549>>50872000
END;   << INIT'DSCT >>                                         <<03549>>50874000
$CONTROL SEGMENT=RESIDENT                                      <<03668>>50876000
      <<---------------------------------------->>             <<03549>>50878000
      <<       CHECK FOR A VALID DSCT           >>             <<03549>>50880000
      <<---------------------------------------->>             <<03549>>50882000
LOGICAL PROCEDURE GOOD'DSCT(DSCT);                             <<03549>>50884000
INTEGER ARRAY                                                  <<03549>>50886000
   DSCT;     << DEFECTIVE SECTOR TABLE >>                      <<03549>>50888000
                                                               <<03549>>50890000
COMMENT                                                        <<03549>>50892000
CHECKS TO SEE IF THE DSCT IS VALID                             <<03549>>50894000
;                                                              <<03549>>50896000
BEGIN                                                          <<03549>>50898000
IF 0 <= DSCT(DSCT'NUM'ENTRIES) <= MAX'DSCT AND                 <<03549>>50900000
   DSCT(DSCT'FIRST'ENTRY) = 6 AND                              <<03549>>50902000
   DSCT(DSCT'ENTRY'SIZE)  = 2 AND                              <<03549>>50904000
   DSCT(DSCT'MAX'ENTRIES) = MAX'DSCT AND                       <<03549>>50906000
   DSCT(4) = 0 AND                                             <<03549>>50908000
   DSCT(5) = 0 THEN                                            <<03549>>50910000
   GOOD'DSCT := TRUE                                           <<03549>>50912000
ELSE                                                           <<03549>>50914000
   GOOD'DSCT := FALSE;                                         <<03549>>50916000
END;   << GOOD'DSCT >>                                         <<03549>>50918000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>50920000
        <<----------------------------------->>                <<03549>>50922000
        <<    CHECK FOR A VALID DISC LABEL   >>                <<03549>>50924000
        <<----------------------------------->>                <<03549>>50926000
LOGICAL PROCEDURE GOOD'LABEL(DLABEL,TYPE,SUBTYP);              <<03549>>50928000
VALUE TYPE, SUBTYP;                                            <<03549>>50930000
INTEGER ARRAY                                                  <<03549>>50932000
   DLABEL;      << DISC LABEL >>                               <<03549>>50934000
INTEGER                                                        <<03549>>50936000
   TYPE,        << DEVICE TYPE >>                              <<03549>>50938000
   SUBTYP;      << DEVICE SUBTYPE >>                           <<03549>>50940000
COMMENT                                                        <<03549>>50942000
CHECKS TO SEE IF THE DISC LABEL 'DLABEL' IS VALID FOR A        <<03549>>50944000
SYSTEM-DOMAIN DISC WITH THE GIVEN TYPE AND SUBTYPE.  IF SO,    <<03549>>50946000
GOOD'LABEL RETURNS TRUE, OTHERWISE FALSE.                      <<03549>>50948000
;                                                              <<03549>>50950000
BEGIN                                                          <<03549>>50952000
BYTE ARRAY                                                     <<03549>>50954000
   BLABEL(*) = DLABEL;                                         <<03549>>50956000
                                                               <<03549>>50958000
IF BLABEL(LABSYSID) = "3000" AND                               <<03549>>50960000
   TYPE = DLABEL(LAB6).LABDTYPE AND                            <<03549>>50962000
   SUBTYP = DLABEL(LAB6).LABDSUBTYPE THEN                      <<03549>>50964000
                                                               <<03549>>50966000
   GOOD'LABEL := TRUE                                          <<03549>>50968000
                                                               <<03549>>50970000
ELSE                                                           <<03549>>50972000
                                                               <<03549>>50974000
   GOOD'LABEL := FALSE;                                        <<03549>>50976000
END;   << GOOD'LABEL >>                                        <<03549>>50978000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>50980000
     <<------------------------------------------->>           <<03549>>50982000
     <<   VALIDATE DISC LABEL AND DTT OR DSCT     >>           <<03549>>50984000
     <<------------------------------------------->>           <<03549>>50986000
INTEGER PROCEDURE VALID'SYSDISC(TYPE,SUBTYP,DLABEL,            <<03549>>50988000
                                       DTT'OR'DSCT);           <<03549>>50990000
VALUE TYPE,SUBTYP;                                             <<03549>>50992000
INTEGER                                                        <<03549>>50994000
   TYPE,      << DEVICE TYPE OF DISC >>                        <<03549>>50996000
   SUBTYP;    << DEVICE SUBTYPE OF DISC >>                     <<03549>>50998000
INTEGER ARRAY                                                  <<03549>>51000000
   DLABEL,         << DISC LABEL >>                            <<03549>>51002000
   DTT'OR'DSCT;    << DTT (TYPES 0,1) OR DSCT (TYPE 3) >>      <<03549>>51004000
COMMENT                                                        <<03549>>51006000
THIS PROCEDURE CHECKS TO SEE IF THE LABEL AND DEFECTIVE        <<03549>>51008000
TRACKS TABLE OR DEFECTIVE SECTOR TABLE IS VALID FOR A          <<03549>>51010000
SYSTEM DOMAIN DISC.   THE RETURN VALUES ARE:                   <<03549>>51012000
              0   =  OK                                        <<03549>>51014000
              1   =  NOT A SYSTEM-DOMAIN DISC LABEL            <<03549>>51016000
              2   =  BAD DTT                                   <<03549>>51018000
              3   =  BAD DSCT                                  <<03549>>51020000
;                                                              <<03549>>51022000
BEGIN                                                          <<03549>>51024000
                                                               <<03549>>51026000
VALID'SYSDISC := 0;   << INIT. RETURN TO OK >>                 <<03549>>51028000
                                                               <<03549>>51030000
IF GOOD'LABEL(DLABEL,TYPE,SUBTYP) THEN   << GOOD DISC LABEL >> <<03549>>51032000
                                                               <<03549>>51034000
   IF TYPE = 0 << MH DISC >> OR TYPE = 1 << FH DISC >> THEN    <<*LDT*>>51036000
      IF NOT GOOD'DTT(DTT'OR'DSCT) THEN                        <<03549>>51038000
         VALID'SYSDISC := 2            << BAD DTT >>           <<03549>>51040000
      ELSE               << DO NOTHING >>                      <<03549>>51042000
                                                               <<03549>>51044000
   ELSE IF TYPE = 3 << CS80 DEVICE >> THEN                     <<*LDT*>>51046000
      IF NOT GOOD'DSCT(DTT'OR'DSCT) THEN                       <<03549>>51048000
         VALID'SYSDISC := 3            << BAD DSCT >>          <<03549>>51050000
      ELSE               << DO NOTHING >>                      <<03549>>51052000
                                                               <<03549>>51054000
   ELSE            << DO NOTHING >>                            <<03549>>51056000
                                                               <<03549>>51058000
ELSE                                                           <<03549>>51060000
   VALID'SYSDISC := 1;    << BAD DISC LABEL >>                 <<03549>>51062000
END;   << VALID'SYSDISC >>                                     <<03549>>51064000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>51066000
        <<------------------------------------------->>        <<03549>>51068000
        <<   CHECK FOR A VALID SYSTEM-DOMAIN DISC    >>        <<03549>>51070000
        <<------------------------------------------->>        <<03549>>51072000
INTEGER PROCEDURE VALID'DISC(LDEV);                            <<03549>>51074000
VALUE LDEV;                                                    <<03549>>51076000
INTEGER                                                        <<03549>>51078000
   LDEV;    << LOGICAL DEVICE NO. >>                           <<03549>>51080000
                                                               <<03549>>51082000
COMMENT                                                        <<03549>>51084000
THIS PROCEDURE DETERMINES IF THE GIVEN LDEV IS A VALID         <<03549>>51086000
SYSTEM-DOMAIN DISC.  IT PRINTS MESSAGES WHEN IT DETECTS        <<03549>>51088000
ERRORS, AND RETURNS ONE OF THE FOLLOWING VALUES:               <<03549>>51090000
                                                               <<03549>>51092000
                   0  =  OK                                    <<03549>>51094000
                   1  =  BAD LABEL                             <<03549>>51096000
                   2  =  BAD DTT                               <<03549>>51098000
                   4  =  DISC NOT ON-LINE                      <<03549>>51100000
                   5  =  NOT A DISC                            <<03549>>51102000
                                                               <<03549>>51104000
IF AN INVALID DSCT IS FOUND, IT IS REPAIRED AND WRITTEN OUT TO <<03549>>51106000
THE DISC--NO ERROR IS RETURNED.                                <<03549>>51108000
;                                                              <<03549>>51110000
BEGIN                                                          <<03549>>51112000
INTEGER ARRAY                                                  <<03549>>51114000
   DLABEL(0:127),          << DISC LABEL >>                    <<03549>>51116000
   DTT'OR'DSCT(0:127);     << DEFECTIVE TRACKS TABLE OR >>     <<03549>>51118000
                           << DEFECTIVE SECTOR TABLE    >>     <<03549>>51120000
DOUBLE                                                         <<03549>>51122000
   DTEMP;     << TEMP FOR DRIVER STATUS RETURN >>              <<03549>>51124000
INTEGER                                                        <<03549>>51126000
   TYPE,      << DEVICE TYPE >>                                <<03549>>51128000
   SUBTYP,    << DEVICE SUBTYPE >>                             <<03549>>51130000
   DTEMP2 = DTEMP+1,    << SECOND WORD OF STATUS RETURN >>     <<*LDT*>>51132000
   LDT'INDEX,                                                  <<*LPDT>>51134000
   LPDT'INDEX;                                                 <<*LPDT>>51136000
                                                               <<03549>>51138000
VALID'DISC := 0;                                               <<03549>>51140000
LDT'INDEX := LDEV * LDTSIZE;                                   <<*LDT*>>51142000
LPDT'INDEX := LDEV * LPDTSIZE;                                 <<*LPDT>>51144000
IF NON'DS'LDEV(LDEV) AND    << CHECK THAT IT'S A REAL DISC >>  <<03549>>51146000
   LDT'ACCESS'TYPE = 0 << DIRECT'ACCESS >> THEN                <<*LDT*>>51148000
   BEGIN                                                       <<03549>>51150000
                                                               <<03549>>51152000
   DISC(RSTAT,LDEV,0D,DTEMP,2);    <<SEE IF DISC IS ON-LINE>>  <<03549>>51154000
   IF DTEMP2.NREADYF=1 THEN                                    <<03549>>51156000
      BEGIN                                                    <<03549>>51158000
      MESSAGE(M2408,LDEV);   << LDEV NOT READY >>              <<03549>>51160000
      VALID'DISC := 4;                                         <<03549>>51162000
      END                                                      <<03549>>51164000
                                                               <<03549>>51166000
   ELSE                                                        <<03549>>51168000
      BEGIN                                                    <<03549>>51170000
      TYPE := LDT'DEVICE'TYPE;                                 <<*LDT*>>51172000
      SUBTYP := LPDT'SUBTYPE;                                  <<*LPDT>>51174000
                                                               <<03549>>51176000
    << READ THE DISC LABEL AND THE DEFECTIVE TRACKS TABLE >>   <<03549>>51178000
    <<    OR THE DEFECTIVE SECTOR TABLE                   >>   <<03549>>51180000
                                                               <<03549>>51182000
      DISC(READ,LDEV,0D,DLABEL,128);                           <<03549>>51184000
      DISC(READ,LDEV,1D,DTT'OR'DSCT,128);                      <<03549>>51186000
                                                               <<03549>>51188000
    << CHECK DISC LABEL AND DTT OR DSCT FOR VALIDITY >>        <<03549>>51190000
                                                               <<03549>>51192000
      CASE (VALID'DISC := VALID'SYSDISC(TYPE,SUBTYP,DLABEL,    <<03549>>51194000
                                              DTT'OR'DSCT)) OF <<03549>>51196000
         BEGIN                                                 <<03549>>51198000
         <<  0 >> ;                    << ALL FINE >>          <<03549>>51200000
         <<  1 >> MESSAGE(M234,LDEV);  << BAD LABEL >>         <<03549>>51202000
         <<  2 >> MESSAGE(M235,LDEV);  << BAD DTT >>           <<03549>>51204000
         <<  3 >> BEGIN                                        <<03549>>51206000
                  MESSAGE(M2503,LDEV); << BAD DSCT--REPAIRED>> <<03549>>51208000
                                                               <<03549>>51210000
                  << BAD DSCT WAS FOUND--REINITIALIZE AND >>   <<03549>>51212000
                  << WRITE IT OUT                         >>   <<03549>>51214000
                                                               <<03549>>51216000
                  INIT'DSCT(DTT'OR'DSCT);                      <<03549>>51218000
                  DISC(WRITE,LDEV,1D,DTT'OR'DSCT,128);         <<03549>>51220000
                  VALID'DISC := 0;    << DON'T RETURN ERROR >> <<03549>>51222000
                  END;                                         <<03549>>51224000
         END;                                                  <<03549>>51226000
      END;                                                     <<03549>>51228000
   END                                                         <<03549>>51230000
                                                               <<03549>>51232000
ELSE                                                           <<03549>>51234000
   BEGIN                                                       <<03549>>51236000
   MESSAGE(M2235,LDEV);     << NOT A DISC >>                   <<03549>>51238000
   VALID'DISC := 5;                                            <<03549>>51240000
   END;                                                        <<03549>>51242000
END;   << VALID'DISC >>                                        <<03549>>51244000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>51246000
          <<-------------------------------------->>           <<03549>>51248000
          <<  GET THE LAST ENTRY FROM THE DSCT    >>           <<03549>>51250000
          <<-------------------------------------->>           <<03549>>51252000
LOGICAL PROCEDURE GET'DSCT'ENTRY( DSCT, DISC'ADDRESS);         <<03549>>51254000
INTEGER ARRAY                                                  <<03549>>51256000
   DSCT;       << DEFECTIVE SECTOR TABLE >>                    <<03549>>51258000
DOUBLE                                                         <<03549>>51260000
   DISC'ADDRESS;   << RETURN DISC ADDRESS--LAST >>             <<03549>>51262000
                   <<    ENTRY IN THE DSCT      >>             <<03549>>51264000
COMMENT                                                        <<03549>>51266000
THIS PROCEDURE RETURNS THE CURRENT LAST ENTRY IN THE DSCT.     <<03549>>51268000
IT DOES NOT REMOVE THE ENTRY FROM THE DSCT.  IF THERE ARE      <<03549>>51270000
NO ENTRIES IN THE TABLE, IT RETURNS FALSE, OTHERWISE TRUE.     <<03549>>51272000
;                                                              <<03549>>51274000
BEGIN                                                          <<03549>>51276000
DOUBLE                                                         <<03549>>51278000
   TEMP;      << TEMP. FOR DISC'ADDRESS >>                     <<03549>>51280000
INTEGER                                                        <<03549>>51282000
   TEMP1=TEMP,      << HIGH ORDER WORD OF TEMP >>              <<03549>>51284000
   TEMP2=TEMP+1,    << LOW ORDER WORD OF TEMP  >>              <<03549>>51286000
   INDEX;           << CURRENT INDEX INTO DSCT >>              <<03549>>51288000
                                                               <<03549>>51290000
IF DSCT(DSCT'NUM'ENTRIES) > 0 THEN                             <<03549>>51292000
   BEGIN                                                       <<03549>>51294000
                                                               <<03549>>51296000
 << DETERMINE THE INDEX TO THE LAST ENTRY >>                   <<03549>>51298000
                                                               <<03549>>51300000
   INDEX := DSCT(DSCT'FIRST'ENTRY) +                           <<03549>>51302000
            (DSCT(DSCT'NUM'ENTRIES) - 1) *                     <<03549>>51304000
            DSCT(DSCT'ENTRY'SIZE);                             <<03549>>51306000
                                                               <<03549>>51308000
   TEMP1 := DSCT(INDEX);     << GET THE ENTRY >>               <<03549>>51310000
   TEMP2 := DSCT(INDEX+1);                                     <<03549>>51312000
   DISC'ADDRESS := TEMP;     << COPY IT TO RETURN PARAMETER >> <<03549>>51314000
   GET'DSCT'ENTRY := TRUE;   << RETURN SUCCESSFUL >>           <<03549>>51316000
   END                                                         <<03549>>51318000
                                                               <<03549>>51320000
ELSE                                                           <<03549>>51322000
   GET'DSCT'ENTRY := FALSE;   << NO MORE ENTRIES >>            <<03549>>51324000
END;   << GET'DSCT'ENTRY >>                                    <<03549>>51326000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>51328000
           <<---------------------------------->>              <<03549>>51330000
           <<   REMOVE THE LAST DSCT ENTRY     >>              <<03549>>51332000
           <<---------------------------------->>              <<03549>>51334000
PROCEDURE REMOVE'DSCT'ENTRY( DSCT);                            <<03549>>51336000
INTEGER ARRAY                                                  <<03549>>51338000
   DSCT;    << DEFECTIVE SECTOR TABLE >>                       <<03549>>51340000
                                                               <<03549>>51342000
COMMENT                                                        <<03549>>51344000
REMOVES THE LAST ENTRY IN THE DSCT AND UPDATES THE TABLE       <<03549>>51346000
HEADER ACCORDINGLY.  THIS PROCEDURE DOES NOT POST THE          <<03549>>51348000
DSCT TO DISC.                                                  <<03549>>51350000
;                                                              <<03549>>51352000
BEGIN                                                          <<03549>>51354000
INTEGER                                                        <<03549>>51356000
   INDEX;      << CURRENT INDEX INTO THE DSCT >>               <<03549>>51358000
                                                               <<03549>>51360000
IF DSCT(DSCT'NUM'ENTRIES) > 0 THEN                             <<03549>>51362000
   BEGIN                                                       <<03549>>51364000
                                                               <<03549>>51366000
 << DETERMINE THE INDEX TO THE LAST DSCT ENTRY >>              <<03549>>51368000
                                                               <<03549>>51370000
   INDEX := DSCT(DSCT'FIRST'ENTRY) +                           <<03549>>51372000
            (DSCT(DSCT'NUM'ENTRIES) - 1) *                     <<03549>>51374000
            DSCT(DSCT'ENTRY'SIZE);                             <<03549>>51376000
                                                               <<03549>>51378000
   I := -1;                                                    <<03549>>51380000
   WHILE (I:=I+1) < DSCT(DSCT'ENTRY'SIZE) DO   << ZERO THE  >> <<03549>>51382000
      DSCT(INDEX + I) := 0;                    <<   ENTRY   >> <<03549>>51384000
                                                               <<03549>>51386000
   DSCT(DSCT'NUM'ENTRIES) :=         << DECREMENT THE NO.  >>  <<03549>>51388000
      DSCT(DSCT'NUM'ENTRIES) - 1;    <<    OF DSCT ENTRIES >>  <<03549>>51390000
   END;                                                        <<03549>>51392000
END;   << REMOVE'DSCT'ENTRY >>                                 <<03549>>51394000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03630>>51396000
       <<---------------------------------------->>            <<03630>>51398000
       <<  GET INFORMATION ABOUT A CS'80 DEVICE  >>            <<03630>>51400000
       <<---------------------------------------->>            <<03630>>51402000
PROCEDURE CS80'INFO( LDEV,SECTORS'PER'TRACK,NUM'HEADS,         <<03630>>51404000
                                              NUM'CYLS);       <<03630>>51406000
VALUE LDEV;                                                    <<03630>>51408000
INTEGER                                                        <<03630>>51410000
   LDEV;                 << LOGICAL DEVICE NO. >>              <<03630>>51412000
LOGICAL                                                        <<03630>>51414000
   SECTORS'PER'TRACK,    << RETURN NO. OF SECTORS PER TRACK >> <<03630>>51416000
   NUM'HEADS;            << RETURN NO. OF HEADS ON DISC >>     <<03630>>51418000
DOUBLE                                                         <<03630>>51420000
   NUM'CYLS;             << RETURN NO. OF CYLINDERS ON DISC >> <<03630>>51422000
                                                               <<03630>>51424000
COMMENT                                                        <<03630>>51426000
RETURNS INFORMATION ABOUT A CS80 DEVICE, OBTAINED FROM THE     <<03630>>51428000
DESCRIBE COMMAND.                                              <<03630>>51430000
;                                                              <<03630>>51432000
BEGIN                                                          <<03630>>51434000
EQUATE                                                         <<03630>>51436000
   DESCRIBE = 17;           << DESCRIBE COMMAND OPCODE >>      <<03630>>51438000
DOUBLE                                                         <<03630>>51440000
   TEMP;                                                       <<03630>>51442000
INTEGER                                                        <<03630>>51444000
   TEMP1 = TEMP,        << HIGH ORDER WORD OF TEMP >>          <<03630>>51446000
   TEMP2 = TEMP + 1;    << LOW ORDER WORD OF TEMP  >>          <<03630>>51448000
ARRAY                                                          <<03630>>51450000
   DESC'BUFF(0:18);      << DESCRIBE COMMAND RESULTS >>        <<03630>>51452000
BYTE ARRAY                                                     <<03630>>51454000
   DESC'BUFF'B(*) = DESC'BUFF;                                 <<03630>>51456000
                                                               <<03630>>51458000
DISC(DESCRIBE,LDEV,0D,DESC'BUFF,19);   << GET DESCRIBE INFO >> <<03630>>51460000
                                                               <<03630>>51462000
SECTORS'PER'TRACK := DESC'BUFF(14) + 1;   << SECTORS PER    >> <<03630>>51464000
                                          <<    TRACK       >> <<03630>>51466000
NUM'HEADS := LOGICAL(DESC'BUFF'B(27)) + 1;  << NO. OF HEADS >> <<03630>>51468000
                                                               <<03630>>51470000
TEMP1.(0:8) := 0;                    << NO. OF       >>        <<03630>>51472000
TEMP1.(8:8) := DESC'BUFF'B(24);      <<   CYLINDERS  >>        <<03630>>51474000
TEMP2.(0:8) := DESC'BUFF'B(25);                                <<03630>>51476000
TEMP2.(8:8) := DESC'BUFF'B(26);                                <<03630>>51478000
NUM'CYLS := TEMP + 1D;                                         <<03630>>51480000
END;   << CS80'INFO >>                                         <<03630>>51482000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03630>>51484000
     <<--------------------------------------------------->>   <<03630>>51486000
     << CONVERT CS'80 PHYSICAL ADDRESS TO LOGICAL ADDRESS >>   <<03630>>51488000
     <<--------------------------------------------------->>   <<03630>>51490000
DOUBLE PROCEDURE CS80'PHYS'TO'LOG( LDEV,CYL,HEAD,SECTOR);      <<03630>>51492000
VALUE LDEV,CYL,HEAD,SECTOR;                                    <<03630>>51494000
INTEGER                                                        <<03630>>51496000
   LDEV;        << LOGICAL DEVICE NO. >>                       <<03630>>51498000
DOUBLE                                                         <<03630>>51500000
   CYL;         << CYLINDER NO. >>                             <<03630>>51502000
LOGICAL                                                        <<03630>>51504000
   HEAD,        << HEAD NO. >>                                 <<03630>>51506000
   SECTOR;      << SECTOR NO. >>                               <<03630>>51508000
                                                               <<03630>>51510000
COMMENT                                                        <<03630>>51512000
CONVERT THE GIVEN CYLINDER, HEAD, AND SECTOR TO A LOGICAL      <<03630>>51514000
DISC ADDRESS, ON THE GIVEN CS'80 DISC LDEV.  THE PROCEDURE     <<03630>>51516000
RETURNS A DOUBLE-WORD CONTAINING THE LOGICAL DISC ADDRESS.     <<03630>>51518000
WE CALL CS80'INFO TO GET THE DISC SIZE PARAMETERS.             <<03630>>51520000
;                                                              <<03630>>51522000
BEGIN                                                          <<03630>>51524000
LOGICAL                                                        <<03630>>51526000
   SECTORS'PER'TRACK,     << NO. OF SECTORS PER TRACK >        <<03630>>51528000
   NUM'HEADS;             << NO. OF HEADS ON DISC >>           <<03630>>51530000
DOUBLE                                                         <<03630>>51532000
   NUM'CYLS,              << NO. OF CYLINDERS ON DISC >>       <<03630>>51534000
   SECTORS'PER'CYL;       << NO. OF SECTORS PER CYLINDER >>    <<03630>>51536000
                                                               <<03630>>51538000
CS80'INFO( LDEV, SECTORS'PER'TRACK,    << GET DISC SIZE    >>  <<03630>>51540000
                 NUM'HEADS,            <<    PARAMETERS    >>  <<03630>>51542000
                 NUM'CYLS          );                          <<03630>>51544000
                                                               <<03630>>51546000
SECTORS'PER'CYL := DOUBLE( NUM'HEADS*SECTORS'PER'TRACK);       <<03630>>51548000
                                                               <<03630>>51550000
CS80'PHYS'TO'LOG := CYL * SECTORS'PER'CYL +                    <<03630>>51552000
                    DOUBLE( HEAD * SECTORS'PER'TRACK) +        <<03630>>51554000
                    DOUBLE( SECTOR);                           <<03630>>51556000
END;   << CS80'PHYS'TO'LOG >>                                  <<03630>>51558000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03630>>51560000
      <<--------------------------------------------->>        <<03630>>51562000
      <<  FIND THE NEXT SPARE TRACK ON A CS'80 DISC  >>        <<03630>>51564000
      <<--------------------------------------------->>        <<03630>>51566000
LOGICAL PROCEDURE GET'NEXT'SPARE( FOUND'CYL, FOUND'HEAD,       <<03630>>51568000
                                  NEXT'CYL, NEXT'HEAD,         <<03630>>51570000
                                  SPARE'TABLE'B, NUM'HEADS);   <<03630>>51572000
VALUE NUM'HEADS;                                               <<03630>>51574000
LOGICAL                                                        <<03630>>51576000
   FOUND'CYL,        << RETURN CYLINDER NO. >>                 <<03630>>51578000
   FOUND'HEAD,       << RETURN HEAD NO.     >>                 <<03630>>51580000
   NEXT'CYL,         << RETURN VALUE USED IN A SEQUENCE OF >>  <<03630>>51582000
                     << CALLS, INITIALLY ZERO              >>  <<03630>>51584000
   NEXT'HEAD;        << RETURN VALUE USED IN A SEQUENCE OF >>  <<03630>>51586000
                     << CALLS, INIITALLY ZERO              >>  <<03630>>51588000
BYTE ARRAY                                                     <<03630>>51590000
   SPARE'TABLE'B;    << SPARE TRACK TABLE >>                   <<03630>>51592000
LOGICAL                                                        <<03630>>51594000
   NUM'HEADS;        << NO. OF HEADS ON DISC >>                <<03630>>51596000
                                                               <<03630>>51598000
COMMENT                                                        <<03630>>51600000
GETS THE NEXT SPARE TRACK FROM THE SPARE TRACK TABLE RETURNED  <<03630>>51602000
BY A CS'80 DISC.  INITIALLY, NEXT'CYL AND NEXT'HEAD SHOULD BE  <<03630>>51604000
SET TO ZERO BY THE CALLER.  GET'NEXT'SPARE STARTS ITS SEARCH   <<03630>>51606000
FROM THESE VALUES AND FINDS THE NEXT SPARE TRACK.  TRACKS ARE  <<03630>>51608000
RETURNED IN INCREASING ORDER FIRST BY CYLINDER, THEN HEAD.     <<03630>>51610000
NEXT'CYL AND NEXT'HEAD ARE SET ON EACH RETURN, TO BE USED IN   <<03630>>51612000
THE NEXT CALL.  THEY SHOULD NOT BE SET AGAIN BY THE CALLER.    <<03630>>51614000
FOUND'CYL AND FOUND'HEAD CONTAIN THE CYLINDER AND HEAD OF THE  <<03630>>51616000
SPARE TRACK ON RETURN.  GET'NEXT'SPARE RETURNS TRUE IF A       <<03630>>51618000
SPARE TRACK WAS FOUND, FALSE IF THERE ARE NO MORE.             <<03630>>51620000
;                                                              <<03630>>51622000
BEGIN                                                          <<03630>>51624000
EQUATE                                                         <<03630>>51626000
   INITIAL'VAL = 65000;                                        <<03630>>51628000
INTEGER                                                        <<03630>>51630000
   INDEX,            << INDEX INTO SPARE'TABLE'B >>            <<03630>>51632000
   LOGICAL'SPARES,   << NO. OF LOGICAL SPARES ON A HEAD >>     <<03630>>51634000
   SPARE'INDEX;      << INDEX VAR. >>                          <<03630>>51636000
LOGICAL                                                        <<03630>>51638000
   CYL,              << CURRENT CYLINDER NO. >>                <<03630>>51640000
   HEAD,             << CURRENT HEAD NO. >>                    <<03630>>51642000
   I;                << INDEX FOR A LOOP >>                    <<03630>>51644000
                                                               <<03630>>51646000
FOUND'CYL := INITIAL'VAL;        << INITIALIZE TO     >>       <<03630>>51648000
FOUND'HEAD := INITIAL'VAL;       <<    NOTHING FOUND  >>       <<03630>>51650000
INDEX := 0;                                                    <<03630>>51652000
I := 0;                                                        <<03630>>51654000
                                                               <<03630>>51656000
WHILE I < NUM'HEADS DO       << SEARCH THROUGH SPARE TRACK  >> <<03630>>51658000
   BEGIN                     <<   TABLE                     >> <<03630>>51660000
   HEAD := SPARE'TABLE'B(INDEX);                               <<03630>>51662000
   LOGICAL'SPARES := SPARE'TABLE'B(INDEX+4);                   <<03630>>51664000
   SPARE'INDEX := 0;                                           <<03630>>51666000
                                                               <<03630>>51668000
   << SEARCH ALL SPARE TRACKS ON THIS HEAD >>                  <<03630>>51670000
                                                               <<03630>>51672000
   WHILE SPARE'INDEX < LOGICAL'SPARES DO                       <<03630>>51674000
      BEGIN                                                    <<03630>>51676000
                                                               <<03630>>51678000
      CYL.(0:8) := SPARE'TABLE'B( INDEX+5+(SPARE'INDEX*3)+0);  <<03630>>51680000
      CYL.(8:8) := SPARE'TABLE'B( INDEX+5+(SPARE'INDEX*3)+1);  <<03630>>51682000
                                                               <<03630>>51684000
      << DETERMINE IF CYL AND HEAD ARE THE NEXT CYLINDER    >> <<03630>>51686000
      << AND HEAD BEYOND NEXT'CYL AND NEXT'HEAD IN ORDER.   >> <<03630>>51688000
      << IF SO, MAKE THEM THE NEW FOUND'CYL AND FOUND'HEAD. >> <<03630>>51690000
                                                               <<03630>>51692000
      IF (NEXT'CYL < CYL LAND CYL < FOUND'CYL) OR              <<03630>>51694000
         (CYL = NEXT'CYL OR CYL = FOUND'CYL) AND               <<03630>>51696000
         (NEXT'HEAD <= HEAD LAND HEAD < FOUND'HEAD) THEN       <<03630>>51698000
         BEGIN                                                 <<03630>>51700000
         FOUND'CYL := CYL;                                     <<03630>>51702000
         FOUND'HEAD := HEAD;                                   <<03630>>51704000
         END;                                                  <<03630>>51706000
                                                               <<03630>>51708000
      SPARE'INDEX := SPARE'INDEX + 1;                          <<03630>>51710000
      END;   << WHILE SPARE'INDEX < LOGICAL'SPARES >>          <<03630>>51712000
                                                               <<03630>>51714000
   INDEX := INDEX + 5 + (3 * LOGICAL'SPARES);                  <<03630>>51716000
   I := I + 1;                                                 <<03630>>51718000
   END;   << WHILE I < NUM'HEADS >>                            <<03630>>51720000
                                                               <<03630>>51722000
IF FOUND'CYL < INITIAL'VAL THEN     << FOUND ANOTHER SPARE >>  <<03630>>51724000
   BEGIN                            <<    TRACK            >>  <<03630>>51726000
                                                               <<03630>>51728000
   NEXT'HEAD := (FOUND'HEAD + 1) MOD NUM'HEADS;                <<03630>>51730000
                                                               <<03630>>51732000
   IF NEXT'HEAD = 0 THEN          << IF NEXT HEAD # ROLLED >>  <<03630>>51734000
      NEXT'CYL := FOUND'CYL + 1   <<   OVER, INCREMENT     >>  <<03630>>51736000
   ELSE                           <<   NEXT CYLINDER #     >>  <<03630>>51738000
      NEXT'CYL := FOUND'CYL;                                   <<03630>>51740000
                                                               <<03630>>51742000
   GET'NEXT'SPARE := TRUE;                                     <<03630>>51744000
   END                                                         <<03630>>51746000
                                                               <<03630>>51748000
ELSE                                                           <<03630>>51750000
   GET'NEXT'SPARE := FALSE;    << NO MORE SPARE TRACKS >>      <<03630>>51752000
END;   << GET'NEXT'SPARE >>                                    <<03630>>51754000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03630>>51756000
        <<------------------------------------->>              <<03630>>51758000
        <<  LIST SPARE TRACKS ON A CS'80 DISC  >>              <<03630>>51760000
        <<------------------------------------->>              <<03630>>51762000
PROCEDURE LIST'CS80'SPARES( LDEV);                             <<03630>>51764000
VALUE LDEV;                                                    <<03630>>51766000
INTEGER                                                        <<03630>>51768000
   LDEV;    << LOGICAL DEVICE NO. >>                           <<03630>>51770000
                                                               <<03630>>51772000
COMMENT                                                        <<03630>>51774000
LIST SPARE TRACK INFORMATION FOR A CS'80 DISC.  THE            <<03630>>51776000
PASSED LDEV MUST BE A CS80'DISC.  THE SPARE TRACK TABLE        <<03630>>51778000
IS READ FROM THE DISC.  WE CALL CS80'INFO TO GET DISC          <<03630>>51780000
SIZE PARAMETERS, GET'NEXT'SPARE TO LOCATE THE NEXT SPARE       <<03630>>51782000
TRACK IN ORDER IN THE SPARE TRACK TABLE, AND                   <<03630>>51784000
CS80'PHYS'TO'LOG TO CONVERT A PHYSICAL ADDRESS (CYLINDER,      <<03630>>51786000
HEAD, AND SECTOR) TO A LOGICAL ADDRESS.                        <<03630>>51788000
                                                               <<03630>>51790000
NOTE: THE DIFFERENCE BETWEEN TOTAL'SPARES AND                  <<03630>>51792000
TOTAL'LOGICAL'SPARES IS THAT IF THE TRACK DESIGNATED BY        <<03630>>51794000
A PARTICULAR LOGICAL ADDRESS IS SPARED MORE THAN ONCE,         <<03630>>51796000
SEVERAL SPARE TRACKS ARE USED BUT ONLY ONE LOGICAL             <<03630>>51798000
SPARE TRACK IS USED.                                           <<03630>>51800000
;                                                              <<03630>>51802000
BEGIN                                                          <<03630>>51804000
EQUATE                                                         <<03630>>51806000
   READ'SPARES = 19,    << READ SPARE TABLE OPCODE >>          <<03630>>51808000
   TH1'SIZE    = 34,    << BYTE LENGTH OF TABLE'HEAD1 >>       <<03630>>51810000
   TH2'SIZE    = 37,    << BYTE LENGTH OF TABLE'HEAD2 >>       <<03630>>51812000
   TH3'SIZE    = 52,    << BYTE LENGTH OF TABLE'HEAD3 >>       <<03630>>51814000
   DASH'SIZE   = 55;    << BYTE LENGTH OF DASH'LINE   >>       <<03630>>51816000
LOGICAL                                                        <<03630>>51818000
   SECTORS'PER'TRACK,    << NO. OF SECTORS PER TRACK >>        <<03630>>51820000
   SPARE'OPS,            << SPARE OPERATIONS ON A HEAD >>      <<03630>>51822000
   NUM'HEADS,            << NO. OF HEADS ON THE DISC >>        <<03630>>51824000
   I,                    << INDEX VAR. >>                      <<03630>>51826000
   CYL,                  << CYLINDER NO. >>                    <<03630>>51828000
   HEAD,                 << HEAD NO. >>                        <<03630>>51830000
   NEXT'CYL,             << PARAMETER FOR GET'NEXT'SPARE >>    <<03630>>51832000
   NEXT'HEAD;            << PARAMETER FOR GET'NEXT'SPARE >>    <<03630>>51834000
INTEGER                                                        <<03630>>51836000
   TOTAL'SPARES,           << NO. SPARE TRACKS USED >>         <<03630>>51838000
   TOTAL'LOGICAL'SPARES,   << NO. LOGICAL SPARE TRACKS >>      <<03630>>51840000
   LOGICAL'SPARES,         << LOGICAL SPARE TRACKS ON HEAD >>  <<03630>>51842000
   LEN,                    << LENGTH OF BYTE STRING >>         <<03630>>51844000
   SUBTYP,                 << DEVICE SUBTYPE OF LDEV >>        <<03630>>51846000
   INDEX,                  << INDEX INTO SPARE'TABLE'B >>      <<*LPDT>>51848000
   LPDT'INDEX;             << INDEX INTO LPDT          >>      <<*LPDT>>51850000
DOUBLE                                                         <<03630>>51852000
   NUM'CYLS,             << NO. OF CYLINDERS ON THE DISC >>    <<03630>>51854000
   SPARE'OPS'TOTAL,      << TOTAL SPARE OPERATIONS ON DISC >>  <<03630>>51856000
   DISC'ADDRESS;         << LOGICAL DISC ADDRESS >>            <<03630>>51858000
BYTE ARRAY                                                     <<03630>>51860000
   STRING(0:13);                                               <<03630>>51862000
INTEGER ARRAY                                                  <<03630>>51864000
   AVAIL'SPARES(0:MAXSUBTYPES-1) = PB :=   << SPARE TRACKS  >> <<03630>>51866000
      -1,24,56,-1,56,-1,-1,-1,78,-1,       << AVAILABLE BY  >> <<06142>>51868000
      -1,-1,-1,-1,-1,-1;                   << CS'80 SUBTYPE >> <<03630>>51870000
ARRAY                                                          <<03630>>51872000
   SPARE'TABLE(0:255);     << SPARE TRACK TABLE >>             <<03630>>51874000
BYTE ARRAY                                                     <<03630>>51876000
   SPARE'TABLE'B(*) = SPARE'TABLE;                             <<03630>>51878000
BYTE ARRAY                                                     <<03630>>51880000
   TAB'HEAD1(0:TH1'SIZE-1) = PB :=                             <<03630>>51882000
      "                     SPARED TRACKS";                    <<03630>>51884000
BYTE ARRAY                                                     <<03630>>51886000
   TAB'HEAD2(0:TH2'SIZE-1) = PB :=                             <<03630>>51888000
      "   LOGICAL         FIRST         LAST";                 <<03630>>51890000
BYTE ARRAY                                                     <<03630>>51892000
   TAB'HEAD3(0:TH3'SIZE-1) = PB :=                             <<03630>>51894000
      "  CYL   HEAD     SECTOR(%)     SECTOR(%)      STATUS";  <<03630>>51896000
BYTE ARRAY                                                     <<03630>>51898000
   DASH'LINE(0:DASH'SIZE-1) = PB :=                            <<03630>>51900000
      "---------------------------------------------------",   <<03630>>51902000
      "----";                                                  <<03630>>51904000
                                                               <<03630>>51906000
<< GET DISC SIZE PARAMETERS >>                                 <<03630>>51908000
                                                               <<03630>>51910000
CS80'INFO( LDEV, SECTORS'PER'TRACK, NUM'HEADS, NUM'CYLS);      <<03630>>51912000
                                                               <<03630>>51914000
<< READ THE SPARE TRACK TABLE FROM THE DISC >>                 <<03630>>51916000
                                                               <<03630>>51918000
DISC(READ'SPARES, LDEV, 0D, SPARE'TABLE, 256);                 <<03630>>51920000
                                                               <<03630>>51922000
SPARE'OPS'TOTAL := 0D;                                         <<03630>>51924000
TOTAL'LOGICAL'SPARES := 0;                                     <<03630>>51926000
TOTAL'SPARES := 0;                                             <<03630>>51928000
INDEX := 0;                                                    <<03630>>51930000
I := 0;                                                        <<03630>>51932000
                                                               <<03630>>51934000
<< LOOP THROUGH THE SPARE TRACK TABLE AND COMPUTE THE >>       <<03630>>51936000
<< TOTAL NO. OF SPARE OPERATIONS AND THE TOTAL NO. OF >>       <<03630>>51938000
<< SPARE TRACKS USED.                                 >>       <<03630>>51940000
                                                               <<03630>>51942000
WHILE I < NUM'HEADS DO                                         <<03630>>51944000
   BEGIN                                                       <<03630>>51946000
                                                               <<03630>>51948000
   SPARE'OPS.(0:8) := SPARE'TABLE'B(INDEX+1);                  <<03630>>51950000
   SPARE'OPS.(8:8) := SPARE'TABLE'B(INDEX+2);                  <<03630>>51952000
   SPARE'OPS'TOTAL := SPARE'OPS'TOTAL +                        <<03630>>51954000
                      DOUBLE(SPARE'OPS);                       <<03630>>51956000
                                                               <<03630>>51958000
   TOTAL'SPARES := TOTAL'SPARES +                              <<03630>>51960000
                   INTEGER(SPARE'TABLE'B(INDEX+3));            <<03630>>51962000
                                                               <<03630>>51964000
   LOGICAL'SPARES := INTEGER(SPARE'TABLE'B(INDEX+4));          <<03630>>51966000
   TOTAL'LOGICAL'SPARES := TOTAL'LOGICAL'SPARES +              <<03630>>51968000
                           LOGICAL'SPARES;                     <<03630>>51970000
                                                               <<03630>>51972000
   INDEX := INDEX + 5 + (3 * LOGICAL'SPARES);                  <<03630>>51974000
   I := I + 1;                                                 <<03630>>51976000
   END;                                                        <<03630>>51978000
                                                               <<03630>>51980000
<< PRINT THE TOTALS:  NO. OF SPARE OPERATIONS ON THE DISC, >>  <<03630>>51982000
<< NO. OF SPARE TRACKS USED, AND THE NO. OF SPARE TRACKS   >>  <<03630>>51984000
<< AVAILABLE                                               >>  <<03630>>51986000
                                                               <<03630>>51988000
BLANKLINE;                                                     <<03630>>51990000
LEN := LDNTOA(SPARE'OPS'TOTAL,10,STRING(1));                   <<03630>>51992000
STRING(0) := LEN.(8:8);                                        <<03630>>51994000
MESSAGE( M2504,,,,, STRING);        << SPARE OPERATIONS >>     <<03630>>51996000
MESSAGE( M2505, TOTAL'SPARES);      << SPARE TRACKS USED >>    <<03630>>51998000
                                                               <<03630>>52000000
LPDT'INDEX := LDEV * LPDTSIZE;                                 <<*LPDT>>52002000
SUBTYP := LPDT'SUBTYPE;                                        <<*LPDT>>52004000
                                                               <<03630>>52006000
MESSAGE( M2506,AVAIL'SPARES(SUBTYP)      << SPARE TRACKS  >>   <<03630>>52008000
                  - TOTAL'SPARES    );   <<    AVAILABLE  >>   <<03630>>52010000
                                                               <<03630>>52012000
<< IF THERE ARE ANY SPARE TRACKS, PRINT THE SPARE TRACK >>     <<03630>>52014000
<< HEADER, THEN LOOP AND PRINT ALL SPARE TRACK ENTRIES  >>     <<03630>>52016000
                                                               <<03630>>52018000
IF TOTAL'LOGICAL'SPARES > 0 THEN                               <<03630>>52020000
   BEGIN                                                       <<03630>>52022000
                                                               <<03630>>52024000
   BLANKLINE;                                                  <<03630>>52026000
   MOVE BINBUF := TAB'HEAD1,(TH1'SIZE);    << PRINT HEADER >>  <<03630>>52028000
   PRINT(INBUF, -TH1'SIZE, 0);                                 <<03630>>52030000
   MOVE BINBUF := TAB'HEAD2,(TH2'SIZE);                        <<03630>>52032000
   PRINT(INBUF, -TH2'SIZE, 0);                                 <<03630>>52034000
   MOVE BINBUF := TAB'HEAD3,(TH3'SIZE);                        <<03630>>52036000
   PRINT(INBUF, -TH3'SIZE, 0);                                 <<03630>>52038000
   MOVE BINBUF := DASH'LINE,(DASH'SIZE);    << PRINT FIRST >>  <<03630>>52040000
   PRINT(INBUF, -DASH'SIZE, 0);             <<   DASH LINE >>  <<03630>>52042000
                                                               <<03630>>52044000
   NEXT'CYL := 0;       << INITIALIZE PARAMETERS FOR CALL >>   <<03630>>52046000
   NEXT'HEAD := 0;      <<    TO GET'NEXT'SPARE           >>   <<03630>>52048000
                                                               <<03630>>52050000
   << LOOP AND PRINT ALL SPARE TRACK ENTRIES >>                <<03630>>52052000
                                                               <<03630>>52054000
   WHILE GET'NEXT'SPARE(CYL, HEAD, NEXT'CYL, NEXT'HEAD,        <<03630>>52056000
                        SPARE'TABLE'B, NUM'HEADS    ) DO       <<03630>>52058000
      BEGIN                                                    <<03630>>52060000
                                                               <<03630>>52062000
      INBUF(0) := "  ";                 << BLANK THE BUFFER >> <<03630>>52064000
      MOVE INBUF(1) := INBUF,(30);                             <<03630>>52066000
      ASCII( CYL,10, BINBUF(2));                               <<*8392>>52068000
      ASCII( HEAD,10, BINBUF(9));                              <<*8392>>52070000
                                                               <<03630>>52072000
      << CONVERT CYL AND HEAD TO A LOGICAL DISC ADDRESS >>     <<03630>>52074000
                                                               <<03630>>52076000
      DISC'ADDRESS := CS80'PHYS'TO'LOG( LDEV, DOUBLE(CYL),     <<03630>>52078000
                                             HEAD, 0      );   <<03630>>52080000
                                                               <<03630>>52082000
      LDNTOA(DISC'ADDRESS, 8, BINBUF(18));                     <<03630>>52084000
      LDNTOA(DISC'ADDRESS+DOUBLE(SECTORS'PER'TRACK-1),         <<03630>>52086000
                                        8, BINBUF(32));        <<03630>>52088000
                                                               <<03630>>52090000
      MOVE BINBUF(44) := "REASSIGNED";                         <<03630>>52092000
                                                               <<03630>>52094000
      PRINT(INBUF, -54, 0);     << PRINT THE ENTRY >>          <<03630>>52096000
      END;   << WHILE GET'NEXT'SPARE >>                        <<03630>>52098000
                                                               <<03630>>52100000
   MOVE BINBUF := DASH'LINE,(DASH'SIZE);    << PRINT FINAL  >> <<03630>>52102000
   PRINT(INBUF, -DASH'SIZE, 0);             <<    DASH LINE >> <<03630>>52104000
   END;                                                        <<03630>>52106000
                                                               <<03630>>52108000
BLANKLINE;                                                     <<03630>>52110000
END;   << LIST'CS80'SPARES >>                                  <<03630>>52112000
          <<-----------------------------                               52114000
            LIST DEFECTIVE TRACKS TABLE                                 52116000
          ----------------------------->>                               52118000
  PROCEDURE LISTDTT(LDEV);                                     <<03549>>52120000
  VALUE LDEV;                                                  <<03549>>52122000
  INTEGER                                                      <<03549>>52124000
    LDEV;   << LOGICAL DEVICE NO. OF DISC >>                   <<03549>>52126000
    COMMENT                                                    <<03549>>52128000
    LIST THE DEFECTIVE TRACKS TABLE ON THE GIVEN LDEV.         <<03549>>52130000
                                                               <<03549>>52132000
    ;                                                          <<03549>>52134000
      BEGIN                                                             52136000
        BYTE ARRAY MHEAD1(0:52)=PB:=                                    52138000
          "            FIRST     LAST                  ALTERNATE";      52140000
        BYTE ARRAY MHEAD2(0:52)=PB:=                                    52142000
          "CYL HEAD  SECTOR(%) SECTOR(%)    STATUS     CYL  HEAD";      52144000
        BYTE ARRAY FHEAD1(0:21)=PB:="        FIRST     LAST";           52146000
        BYTE ARRAY FHEAD2(0:33)=PB:=                                    52148000
          "TRACK SECTOR(%) SECTOR(%)   STATUS";                         52150000
        BYTE ARRAY STATS(0:69)=PB:="   SUSPECT     SUSPECT ALT  ",      52152000
          "    DELETED     REASSIGNED  UNREADABLE ALT";                 52154000
        INTEGER I,TYPE,SUBTYP,TRACK,DISP,ALT,INDEX;            <<03549>>52156000
        INTEGER ARRAY DTT(0:127);                              <<03549>>52158000
        INTEGER                                                <<*LDT*>>52160000
            LDT'INDEX,                                         <<*LPDT>>52162000
            LPDT'INDEX,                                        <<*8392>>52164000
            NUM'ALTS;   << # OF AVAILABLE ALTS  >>             <<*8392>>52166000
                                                               <<03549>>52168000
          LDT'INDEX := LDEV * LDTSIZE;                         <<*LDT*>>52170000
          LPDT'INDEX := LDEV * LPDTSIZE;                       <<*LPDT>>52172000
          TYPE := LDT'DEVICE'TYPE;                             <<*LDT*>>52174000
          SUBTYP := LPDT'SUBTYPE;                              <<*LPDT>>52176000
                                                               <<03549>>52178000
          DISC(READ,LDEV,1D,DTT,128);                          <<03549>>52180000
                                                               <<03549>>52182000
          IF TYPE = MHDISCTYPE THEN                            <<03549>>52184000
            BEGIN  <<MOVING HEAD DISC>>                                 52186000
              NUM'ALTS := MHINFO((INDEX:=SUBTYP*MHINFOSIZE)+   <<*8392>>52188000
                MHMAXLPS)*MHINFO(INDEX+MHTRKCYL)-DTT(DTTALT);  <<*8392>>52190000
              MESSAGE(M2251,DTT(DTTLPS),NUM'ALTS);             <<*8392>>52192000
              IF DTT=0 THEN MESSAGE(M2226)<<NO ENTRIES IN TAB>><<01103>>52194000
              ELSE                                                      52196000
                BEGIN  <<PRINT TABLE>>                                  52198000
                  MOVE BLINE := MHEAD1,(53);                   <<00888>>52200000
                  PRINTLINE;                                   <<00888>>52202000
                  MOVE BLINE := MHEAD2,(53);                   <<00888>>52204000
                  PRINTLINE;                                   <<00888>>52206000
                  I := 0;                                               52208000
                  WHILE (I:=I+1)<=DTT DO                                52210000
                    BEGIN  <<LIST EACH ENTRY>>                          52212000
                      INBUF := "  ";                                    52214000
                      MOVE INBUF(1) := INBUF,(26);                      52216000
                      TOS := CYLINDERHEAD(TRACK:=DTT(I)&LSR(2),SUBTYP); 52218000
                      ASSEMBLE(ZERO,XCH);                               52220000
                      ASCII(*,10,BINBUF);                      <<*8392>>52222000
                      ASSEMBLE(ZERO,XCH);                               52224000
                      ASCII(*,10,BINBUF(5));                   <<*8392>>52226000
                      TOS := 0;                                         52228000
                      TOS := TRACK;                                     52230000
                      TOS := TOS**LOGICAL(MHINFO(INDEX+MHSECTRK));      52232000
                      ASSEMBLE(DDUP,DZRO; DXCH,CAB);                    52234000
                      TOS := MHINFO(INDEX+MHSECTRK);                    52236000
                      ASSEMBLE(DECA,DADD);  <<LAST SECTOR>>             52238000
                      LDNTOA(*,8,BINBUF(21));  <<LAST SECTOR>> <<00935>>52240000
                      LDNTOA(*,8,BINBUF(11));  <<FIRST SECTOR>><<00935>>52242000
                      DISP := DTT(I).(14:2);  <<RECORD TYPE>>           52244000
                      IF DISP=0 AND TRACK=DTT(X:=X+1)&LSR(2) THEN       52246000
                        DISP := 4;  <<UNREADABLE ALTERNATE>>            52248000
                      MOVE BINBUF(29) := STATS(DISP*14),(14);           52250000
                      TOS := @INBUF;  <<FOR PRINT>>                     52252000
                      IF LOGICAL(DISP) THEN                             52254000
                        BEGIN  <<THERE IS AN ALTERNATE I.E. TRACK IS    52256000
                              EITHER REASSIGNED OR SUSPECT ALTERNATE>>  52258000
                          ALT := ALTTRACK(LDEV,TRACK); <<GET ALT>>      52260000
                          IF ALT=-2 THEN                                52262000
                            BEGIN <<CAN'T READ ALTERNATE>>              52264000
                              TOS := ADDDTTENTRY(TRACK&LSL(2));         52266000
                                  <<ADD SUSPECT TRACK ENTRY TO TABLE>>  52268000
                              IF TOS=1 THEN                             52270000
                                BEGIN   <<ENTRY ADDED TO TABLE>>        52272000
                                  MOVE BINBUF(29) := STATS(56),(14);    52274000
                                        <<UNREADABLE ALTERNATE>>        52276000
                                  DISC(WRITE,LDEV,1D,DTT,128);          52278000
                                END;                                    52280000
                              GOTO NOALT;                               52282000
                            END;                                        52284000
                          TOS := CYLINDERHEAD(ALT,SUBTYP);              52286000
                          ASSEMBLE(ZERO,XCH);                           52288000
                          ASCII(*,10,BINBUF(44));              <<*8392>>52290000
                          ASSEMBLE(ZERO,XCH);                           52292000
                          ASCII(*,10,BINBUF(50));              <<*8392>>52294000
                          TOS := -52;  <<LINE COUNT>>                   52296000
                        END                                             52298000
                      ELSE                                              52300000
  NOALT:                TOS := -44;  <<BYTE COUNT FOR LINE>>            52302000
                      PRINT(*,*,0);                                     52304000
                      IF DTT(I+1)=TRACK&LSL(2)+3 THEN I:=I+1; <<SKIP>>  52306000
                    END;                                                52308000
                END;                                                    52310000
            END                                                         52312000
          ELSE                                                          52314000
            BEGIN  <<FIXED HEAD DISC>>                                  52316000
              IF DTT=0 THEN MESSAGE(M2226)<<NO ENTRIES IN TAB>><<01103>>52318000
              ELSE                                                      52320000
                BEGIN  <<PRINT HEADING>>                                52322000
                  MOVE BLINE := FHEAD1,(22);                   <<00888>>52324000
                  PRINTLINE;                                   <<00888>>52326000
                  MOVE BLINE := FHEAD2,(34);                   <<00888>>52328000
                  PRINTLINE;                                   <<00888>>52330000
                  I := 0;                                               52332000
                  WHILE (I:=I+1)<=DTT DO                                52334000
                    BEGIN  <<LIST EACH ENTRY>>                          52336000
                      TOS := DTT(I);                                    52338000
                      DISP := S0.(14:2);                                52340000
                      TRACK := TOS&LSR(2);                              52342000
                      ASCII(TRACK,10,BLINE(1));                <<*8392>>52344000
                      TOS := 0D;                                        52346000
                      TOS := TRACK&LSL(5);  <<STARTING SECTOR>>         52348000
                      ASSEMBLE(DUP,DZRO,CAB);                           52350000
                      TOS := TOS+31; <<LAST SECTOR>>                    52352000
                      LDNTOA(*,8,BLINE(18));                   <<00935>>52354000
                      LDNTOA(*,8,BLINE(8));  <<FIRST SECTOR>>  <<00935>>52356000
                      MOVE BLINE(24) := STATS(DISP*14),(14);   <<00888>>52358000
                      PRINTLINE;                               <<00888>>52360000
                    END;                                                52362000
                END;                                                    52364000
            END;                                                        52366000
      END <<LISTDTT>> ;                                                 52368000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>52370000
        <<----------------------------------------->>          <<03549>>52372000
        << LIST DEFECTIVE TRACK/SECTOR INFORMATION >>          <<03549>>52374000
        <<----------------------------------------->>          <<03549>>52376000
PROCEDURE LIST'DEFECTS;                                        <<03549>>52378000
                                                               <<03549>>52380000
COMMENT                                                        <<03549>>52382000
THIS PROCEDURE ASKS IF THE USER WISHES TO LIST DEFECTIVE       <<03549>>52384000
TRACK/SECTOR INFORMATION.  IF SO, IT REQUESTS AN LDEV.         <<03549>>52386000
IF THE LDEV IS A TYPE 0 OR TYPE 1 DISC, WE CALL LISTDTT        <<03549>>52388000
TO LIST THE DEFECTIVE TRACKS TABLE.  IF THE LDEV IS TYPE       <<03549>>52390000
3, WE CALL LIST'CS80'SPARES TO LIST SPARED TRACK/SECTOR        <<03549>>52392000
INFORMATION.                                                   <<03549>>52394000
;                                                              <<03549>>52396000
BEGIN                                                          <<03549>>52398000
INTEGER                                                        <<03549>>52400000
   TYPE,       << DEVICE TYPE >>                               <<03549>>52402000
   LDEV,       << LOGICAL DEVICE NO. >>                        <<*LDT*>>52404000
   LDT'INDEX;                                                  <<*LDT*>>52406000
LOGICAL                                                        <<03549>>52408000
   GOOD'LDEV;  << TRUE IF LDEV IS VALID SYSTEM DOMAIN DISC >>  <<03549>>52410000
                                                               <<03549>>52412000
IF LGETYESNO(M2225) THEN        << LIST DEFECTIVE TRACK/ >>    <<03549>>52414000
   BEGIN                        << SECTOR INFORMATION?   >>    <<03549>>52416000
                                                               <<03549>>52418000
   WHILE TRUE DO                                               <<03549>>52420000
      BEGIN               << DO UNTIL LDEV=0 IS ENTERED >>     <<03549>>52422000
                                                               <<03549>>52424000
      GOOD'LDEV := FALSE;                                      <<03549>>52426000
      WHILE NOT GOOD'LDEV DO                                   <<03549>>52428000
         BEGIN            << PROMPT FOR LDEV UNTIL VALID >>    <<03549>>52430000
                                                               <<03549>>52432000
         LDEV := GETVAL(M2011,0,HLDEV,2);   << LDEV? >>        <<03549>>52434000
         IF LDEV = 0 THEN                                      <<03549>>52436000
            RETURN;        << THAT'S ALL, FOLKS >>             <<03549>>52438000
                                                               <<03549>>52440000
         IF VALID'DISC(LDEV) = 0 THEN   << VALID SYSTEM-    >> <<03549>>52442000
            GOOD'LDEV := TRUE;          <<   DOMAIN DISCS   >> <<03549>>52444000
                                                               <<03549>>52446000
         END;                                                  <<03549>>52448000
      LDT'INDEX := LDTSIZE;                                    <<*LDT*>>52450000
      TYPE := LDT'DEVICE'TYPE;                                 <<*LDT*>>52452000
                                                               <<03549>>52454000
      IF TYPE = 0 << MH DISC >> OR TYPE = 1 << FH DISC >> THEN <<*LDT*>>52456000
         LISTDTT(LDEV)      << LIST DEFECTIVE TRACKS >>        <<03549>>52458000
                                                               <<03549>>52460000
      ELSE IF TYPE = 3 << CS80 DEVICE >> THEN                  <<*LDT*>>52462000
         BEGIN                                                 <<03549>>52464000
         LIST'CS80'SPARES(LDEV);   << LIST SPARE TRACK INFO >> <<03630>>52466000
         END;                                                  <<03549>>52468000
      END;                                                     <<03549>>52470000
   END;                                                        <<03549>>52472000
END;   << LIST'DEFECTS >>                                      <<03549>>52474000
PROCEDURE BUILD'VDSMTAB;                                       <<32BND>>52476000
                                                               <<32BND>>52478000
COMMENT:  THIS PROCEDURE BUILDS THE 0 ENTRY, AND AN ENTRY      <<32BND>>52480000
FOR EACH SYSTEM VOLUME HAVING THE VDS ATTRIBUTE IN THE         <<32BND>>52482000
VDSMTAB.  DELETED TRACKS ARE REMOVED FROM VIRTUAL MEMORY       <<32BND>>52484000
BY MAKING THEM UNAVAILABLE IN THE APPROPRIATE BITMAP.          <<32BND>>52486000
;                                                              <<32BND>>52488000
BEGIN                                                          <<32BND>>52490000
DOUBLE  FSECT,         << 1ST SECTOR OF BAD TRACK >>           <<32BND>>52492000
        LSECT,         << LAST   "    "    "      "   >>       <<32BND>>52494000
        VDSLEN,        << VIRTUAL MEMORY LENGTH IN SECTORS >>  <<32BND>>52496000
        VDSLEN'PAGES,  << "      "      "     "   PAGES >>     <<32BND>>52498000
        VDSTART,       << STARTING SECTOR OF VIRTUAL MEM. >>   <<32BND>>52500000
        VDSTOP;        << LAST SECTOR OF V.M. >>               <<32BND>>52502000
                                                               <<32BND>>52504000
LOGICAL LDEV,          << LOGICAL DEVICE NUMBER >>             <<32BND>>52506000
        TYPE,          << DISC TYPE >>                         <<32BND>>52508000
        STYPE,         << DISC SUB TYPE >>                     <<32BND>>52510000
        VOLUME,        << VOLUME NUMBER OF DISC >>             <<32BND>>52512000
        TRACKLEN,      << LENGTH OF 1 TRACK ON THIS DISC >>    <<32BND>>52514000
        PAGE,          << PAGE BEING REMOVED FROM BITMAP >>    <<32BND>>52516000
        FPAGE,         << 1ST PAGE TO BE "     "    "    >>    <<32BND>>52518000
        LPAGE,         << LAST  "   "  " "     "    "    >>    <<32BND>>52520000
        LOGON1'BAD     := FALSE,                               <<32BND>>52522000
        LOGON2'BAD     := FALSE,                               <<32BND>>52524000
        CURR'VOL'MAP,  << OFFSET TO CURRENT VOLUME'S BIT MAP>> <<32BND>>52526000
        BMLENGTH,      << BIT MAP LENGTH >>                    <<32BND>>52528000
        ENTRYSIZE,     << VDSMTAB VOLUME ENTRY SIZE >>         <<32BND>>52530000
        SYSENTRY,      << SYS DB REL. ADDR FOR LDEV1 VSMT ->>  <<32BND>>52532000
        SYSMAP,        << ENTRY AND BITMAP.                >>  <<32BND>>52534000
        STARTVDS,      << START ADDRESS OF VDMSTAB >>          <<*7893>>52536000
        VDSLEN1        =  VDSLEN,                              <<32BND>>52538000
        VDSLEN2        =  VDSLEN+1,                            <<32BND>>52540000
        VDSTART1       =  VDSTART,                             <<32BND>>52542000
        VDSTART2       =  VDSTART+1;                           <<32BND>>52544000
                                                               <<32BND>>52546000
POINTER VDSMTAB = VDSMTABIX;                                   <<32BND>>52548000
                                                               <<*LDT*>>52550000
INTEGER                                                        <<*LDT*>>52552000
    LDT'INDEX,                                                 <<*LPDT>>52554000
    LPDT'INDEX;                                                <<*LPDT>>52556000
                                                               <<32BND>>52558000
ARRAY VDSENTRY(0:15); <<ARRAY FOR BUILDING VOLUME ENTRIES>>    <<32BND>>52560000
                                                               <<32BND>>52562000
  TOS := INITTABLE(BMOFFSET, 1, BANK0ABOVE, TRUE,              <<*7893>>52564000
              VDSMDSTN, SYSVDSMTAB);                           <<32BND>>52566000
  STARTVDS := TOS;     DEL;                                    <<*7893>>52568000
  << GOT SPACE FOR ENTRY 0, NOW GET SPACE FOR EACH   >>        <<32BND>>52570000
  << VOLUME AS THEY ARE FOUND.                       >>        <<32BND>>52572000
  << SINCE WE DON'T YET KNOW THE SIZE OF VDSMTAB THE DST     >><<32BND>>52574000
  << ENTRY WILL NEED TO BE CORRECTED AT END OF THIS PROCEDURE>><<32BND>>52576000
                                                               <<32BND>>52578000
<< SET UP ENTRY 0 >>                                           <<32BND>>52580000
  VDSMTAB(STARTENTRYINXWORD) := BMOFFSET;                      <<32BND>>52582000
  VDSMTAB(VMPAGESIZEWORD) := NWORDPAGE;                        <<32BND>>52584000
  VDSMTAB(SECTPERVMPAGEWORD) := NSECTPAGE;                     <<32BND>>52586000
  VDSMTAB(OFFSETTOBMWORD) := BMOFFSET;                         <<32BND>>52588000
  VDSMTAB(TOTALVMPAGESWORD) := 0;  << # PAGES IN USE >>        <<32BND>>52590000
                                                               <<32BND>>52592000
<< MAKE VDSMTAB ENTRY FOR EACH VMS VOLUME >>                   <<32BND>>52594000
<< AND CHECK VM AREA IF DELETED TRACKS    >>                   <<32BND>>52596000
  VOLUME := 0;                                                 <<32BND>>52598000
  CURR'VOL'MAP:= %40;                                          <<32BND>>52600000
  WHILE (VOLUME := VOLUME+1) <= LOGICAL(HVOL) DO               <<32BND>>52602000
    IF VTAB(VOLUME*VTABSIZE) <> 0 AND                          <<32BND>>52604000
      VTAB(VOLUME*VTABSIZE+VTAB12).VMS = 1 THEN                <<32BND>>52606000
      BEGIN                                                    <<32BND>>52608000
                                                               <<32BND>>52610000
    << COMPUTE VOLUME INFORMATION >>                           <<32BND>>52612000
      VDSTART1 := VTAB(VOLUME*VTABSIZE+VTAB8);                 <<32BND>>52614000
      VDSTART2 := VTAB(X:=X+1);                                <<32BND>>52616000
      VDSLEN1 := VTAB(X:=X+1);                                 <<32BND>>52618000
      VDSLEN2 := VTAB(X:=X+1);                                 <<32BND>>52620000
      VDSLEN'PAGES := VDSLEN/DOUBLE(NSECTPAGE);                <<32BND>>52622000
      VDSTOP := VDSTART + VDSLEN - 1D;                         <<32BND>>52624000
      << VDSLEN IS ALREADY ROUNDED SO NO SWEAT THERE >>        <<32BND>>52626000
      LDEV := GETLDEV(VOLUME);                                 <<32BND>>52628000
      LDT'INDEX := LDEV * LDTSIZE;                             <<*LDT*>>52630000
      LPDT'INDEX := LDEV * LPDTSIZE;                           <<*LPDT>>52632000
      TYPE := LDT'DEVICE'TYPE;                                 <<*LDT*>>52634000
      STYPE := LPDT'SUBTYPE;                                   <<*LPDT>>52636000
      IF TYPE = MHDISCTYPE THEN                                <<32BND>>52638000
        TRACKLEN := MHINFO(STYPE*MHINFOSIZE+MHSECTRK)          <<32BND>>52640000
      ELSE                                                     <<32BND>>52642000
        TRACKLEN := 32;  << TRACK LENGTH >>                    <<32BND>>52644000
                                                               <<32BND>>52646000
    << SET UP VOLUME BITMAP >>                                 <<32BND>>52648000
      BMLENGTH := L'(VDSLEN'PAGES/16D);  <<DIV BY # BITS/WORD>><<32BND>>52650000
      BMLENGTH := BMLENGTH+1;  << NUM BITMAP WORDS >>          <<32BND>>52652000
      << EXTRA WORD IS FOR LAST PARTIAL WORD IF NEEDED >>      <<32BND>>52654000
      I := L'(VDSLEN'PAGES MODD 16);  << # BITS IN LAST WORD >><<32BND>>52656000
      ENTRYSIZE := ROUND(BMLENGTH+L'(VDSMTAB(OFFSETTOBMWORD)));<<32BND>>52658000
      INITTABLE(ENTRYSIZE, 1, BANK0ABOVE, FALSE);              <<*7893>>52660000
      ABSOLUTE(SYSVDSENTRY) := CURR'VOL'MAP + STARTVDS -       <<*7893>>52662000
                                SYSBASE - BMOFFSET;            <<*7893>>52664000
      ABSOLUTE(SYSVDSMAP) := CURR'VOL'MAP+STARTVDS-SYSBASE;    <<*7893>>52666000
      IF LDEV = SYSDISC THEN                                   <<32BND>>52668000
        BEGIN  << SAVE SYSTEM DISC POINTERS >>                 <<32BND>>52670000
        SYSENTRY := ABSOLUTE(SYSVDSENTRY);                     <<32BND>>52672000
        SYSMAP := ABSOLUTE(SYSVDSMAP);                         <<32BND>>52674000
        END;                                                   <<32BND>>52676000
      X := CURR'VOL'MAP-1;                                     <<32BND>>52678000
      WHILE LOGICAL(X:=X+1) < CURR'VOL'MAP+BMLENGTH-1  DO      <<FIX02>>52680000
               VDSMTAB(X):= -1;                                <<32BND>>52682000
      << SET BITS REPRESENTING AVAILABLE PAGES TO 1 >>         <<32BND>>52684000
      VDSMTAB(CURR'VOL'MAP+BMLENGTH-1):=                       <<32BND>>52686000
                       (-1)&LSL(16-I);<<LAST WORD OF MAP>>     <<32BND>>52688000
                                                               <<32BND>>52690000
      VDSMTAB(VMSVOLUMECNTWORD) := VDSMTAB(VMSVOLUMECNTWORD)+1;<<32BND>>52692000
    << SET UP VOLUME ENTRY HEADER AREA >>                      <<32BND>>52694000
      VDSENTRY(NEXTINLISTWORD) := CURR'VOL'MAP+BMLENGTH;       <<32BND>>52696000
      VDSENTRY(LDEVWORD) := LDEV;                              <<32BND>>52698000
      VDSENTRY(HOSTARTSECTORWORD) := VDSTART1;  << HODA >>     <<32BND>>52700000
      VDSENTRY(LOSTARTSECTORWORD) := VDSTART2;  << LODA >>     <<32BND>>52702000
      VDSENTRY(HOSECTORCONTWORD) := VDSLEN1;                   <<32BND>>52704000
      VDSENTRY(LOSECTORCOUNTWORD) := VDSLEN2;                  <<32BND>>52706000
      VDSENTRY(TOTALPAGESWORD) := L'(VDSLEN'PAGES);            <<32BND>>52708000
      VDSENTRY(AVAILPAGESWORD) := L'(VDSLEN'PAGES);            <<32BND>>52710000
      VDSMTAB(TOTALVMPAGESWORD):=VDSMTAB(TOTALVMPAGESWORD)+    <<32BND>>52712000
           L'(VDSLEN'PAGES);                                   <<32BND>>52714000
      VDSENTRY(WORDSINBITMAPWORD) := BMLENGTH;                 <<32BND>>52716000
      VDSENTRY(SMALLESTMISSWORD) := L'(VDSLEN'PAGES);          <<32BND>>52718000
      VDSENTRY(DEVLEASTAVAILPAGESWORD):=L'(VDSLEN'PAGES);      <<32BND>>52720000
      MTDS(VDSMDSTN, CURR'VOL'MAP-BMOFFSET, VDSENTRY,BMOFFSET);<<32BND>>52722000
                                                               <<32BND>>52724000
      IF TYPE = 0 << MH DISC >> OR TYPE = 1 << FH DISC >> THEN <<*LDT*>>52726000
      BEGIN                                                    <<32BND>>52728000
    << CHECK FOR DELETED TRACKS IN VM >>                       <<32BND>>52730000
      DISC(READ, LDEV, 1D, DTT, 128); <<READ DEF TRACKS TABLE>><<32BND>>52732000
      I := 0;                                                  <<32BND>>52734000
      WHILE (I:=I+1) <= DTT DO                                 <<32BND>>52736000
      IF DTT(I).(14:2) = 2 THEN                                <<32BND>>52738000
        BEGIN  << DELETED TRACK >>                             <<32BND>>52740000
        FSECT := D'( DTT(I)&LSR(2) ) * D'(TRACKLEN);           <<32BND>>52742000
        LSECT := FSECT + D'(TRACKLEN) - 1D;                    <<32BND>>52744000
                                                               <<32BND>>52746000
      << CONVERT FSECT AND LSECT TO THAT PORTION OF THE BAD  >><<32BND>>52748000
      << TRACK THAT LIES WITHIN VIRTUAL MEMORY.              >><<32BND>>52750000
        IF FSECT <= VDSTOP AND LSECT >= VDSTART THEN           <<32BND>>52752000
          BEGIN  << AT LEAST PARTIALLY IN VIRTUAL MEMORY >>    <<32BND>>52754000
          IF FSECT < VDSTART THEN                              <<32BND>>52756000
            << BAD TRACK OVERLAPS END OF V.M. >>               <<32BND>>52758000
            FSECT := VDSTART;                                  <<32BND>>52760000
          IF LSECT > VDSTOP THEN                               <<32BND>>52762000
            << BAD TRACK OVERLAPS END OF V.M. >>               <<32BND>>52764000
            LSECT := VDSTOP;                                   <<32BND>>52766000
                                                               <<32BND>>52768000
        << REMOVE BAD TRACK FROM BITMAP >>                     <<32BND>>52770000
          << WHEN COMPUTING THE FIRST AND LAST PAGES TO    >>  <<32BND>>52772000
          << REMOVE, BOTH WILL BE ROUNDED DOWN.            >>  <<32BND>>52774000
          FPAGE := L'( (FSECT-VDSTART)/D'(NSECTPAGE) );        <<32BND>>52776000
          LPAGE := L'( (LSECT-VDSTART)/D'(NSECTPAGE) );        <<32BND>>52778000
          PAGE := FPAGE;                                       <<32BND>>52780000
          DO                                                   <<32BND>>52782000
            BEGIN  << REMOVE SPACE FROM BITMAP >>              <<32BND>>52784000
            TOS := VDSMTAB(CURR'VOL'MAP+PAGE.(0:12));          <<32BND>>52786000
            X := PAGE.(12:4);  << BIT NUMBER >>                <<32BND>>52788000
            ASSEMBLE(TRBC 0,X);  << MARK UNAVAILABLE >>        <<32BND>>52790000
            IF = THEN ERRMESSAGE(M325,14);  << SPACE ERR >>    <<32BND>>52792000
            VDSMTAB(CURR'VOL'MAP+PAGE.(0:12)) := TOS;          <<32BND>>52794000
            END                                                <<32BND>>52796000
          UNTIL (PAGE := PAGE+1) > LPAGE;                      <<32BND>>52798000
                                                               <<32BND>>52800000
          IF LDEV = SYSDISC AND NOT(INITLOGONDST) THEN         <<32BND>>52802000
            BEGIN  << SEE IF ON DELETED TRACK >>               <<32BND>>52804000
            IF INFOD(LOGONLOC1) <= LSECT AND                   <<32BND>>52806000
              INFOD(LOGONLOC1)+D'(WELMESPAGES-1)>=FSECT THEN   <<32BND>>52808000
              LOGON1'BAD := TRUE;                              <<32BND>>52810000
            IF INFOD(LOGONLOC2) <= LSECT AND                   <<32BND>>52812000
              INFOD(LOGONLOC2)+D'(WELMESPAGES-1)>=FSECT THEN   <<32BND>>52814000
              LOGON2'BAD := TRUE;                              <<32BND>>52816000
            END;                                               <<32BND>>52818000
          END;  << AT LEAST PARTIALLY ON DELETED TRACK >>      <<32BND>>52820000
        END;  << DELETED TRACK >>                              <<32BND>>52822000
      END;                                                     <<32BND>>52824000
                                                               <<32BND>>52826000
        IF LDEV = SYSDISC THEN                                 <<32BND>>52828000
          BEGIN                                                <<32BND>>52830000
          IF WARMSTART THEN                                    <<32BND>>52832000
            BEGIN  << SAVE ODD, IDD, JMAT >>                   <<32BND>>52834000
            TOS := INFOD(ODDLOC);  << DISC ADDR OF ODD >>      <<32BND>>52836000
            TOS := INFOD(IDDLOC);  << DISC ADDR OF IDD >>      <<32BND>>52838000
            TOS := INFOD(JMATLOC);  << DISC ADDR OF JMAT >>    <<32BND>>52840000
            I := -1;                                           <<32BND>>52842000
            WHILE(I:=I+1) < 3 DO                               <<32BND>>52844000
              BEGIN                                            <<32BND>>52846000
              TOS := TOS - VDSTART;                            <<32BND>>52848000
              DELB;                                            <<32BND>>52850000
              FPAGE := TOS / NSECTPAGE;                        <<32BND>>52852000
              LPAGE := FPAGE + L'(PAGES(I)) - 1;               <<32BND>>52854000
              PAGE := FPAGE;                                   <<32BND>>52856000
              DO                                               <<32BND>>52858000
                BEGIN                                          <<32BND>>52860000
                TOS := VDSMTAB(CURR'VOL'MAP+PAGE.(0:12));      <<32BND>>52862000
                X := PAGE.(12:4);                              <<32BND>>52864000
                ASSEMBLE(TRBC 0,X);                            <<32BND>>52866000
                IF = THEN ERRMESSAGE(M231); <<BIT ALREADY 0>>  <<32BND>>52868000
                VDSMTAB(CURR'VOL'MAP+PAGE.(0:12)) := TOS;      <<32BND>>52870000
                END                                            <<32BND>>52872000
              UNTIL (PAGE := PAGE+1) > LPAGE;                  <<32BND>>52874000
              END;                                             <<32BND>>52876000
            END;  << WARMSTART >>                              <<32BND>>52878000
                                                               <<32BND>>52880000
          IF NOT LOGON1'BAD THEN                               <<32BND>>52882000
            BEGIN                                              <<32BND>>52884000
            DISC(READ, SYSDISC, INFOD(LOGONLOC1), LBUF, 1);    <<32BND>>52886000
            IF LBUF < 0 THEN LOGONLOC := LOGONLOC1;            <<32BND>>52888000
            END;                                               <<32BND>>52890000
          IF LOGONLOC = 0 AND NOT LOGON2'BAD THEN              <<32BND>>52892000
            BEGIN                                              <<32BND>>52894000
            DISC(READ,SYSDISC,INFOD(LOGONLOC2),LBUF,1);        <<32BND>>52896000
            IF LBUF < 0 THEN LOGONLOC := LOGONLOC2;            <<32BND>>52898000
            END;                                               <<32BND>>52900000
                                                               <<32BND>>52902000
          IF LOGONLOC = 0 AND (LOGON1'BAD OR LOGON2'BAD)       <<32BND>>52904000
            THEN MESSAGE(M2244);                               <<32BND>>52906000
                                                               <<32BND>>52908000
          IF LOGONLOC <> 0 THEN                                <<32BND>>52910000
            BEGIN  << SAVE LOGONDST VIRTUAL MEM. SPACE >>      <<32BND>>52912000
            FPAGE:=L'((INFOD(LOGONLOC)-VDSTART)/D'(NSECTPAGE));<<32BND>>52914000
            LPAGE := FPAGE + WELMESPAGES - 1;                  <<32BND>>52916000
            PAGE := FPAGE;                                     <<32BND>>52918000
            DO                                                 <<32BND>>52920000
              BEGIN                                            <<32BND>>52922000
              TOS := VDSMTAB(CURR'VOL'MAP+PAGE.(0:12));        <<32BND>>52924000
              X := PAGE.(12:4);                                <<32BND>>52926000
              ASSEMBLE(TRBC 0, X);                             <<32BND>>52928000
              IF = THEN ERRMESSAGE(M325,15);                   <<32BND>>52930000
                << BIT ALREADY SET >>                          <<32BND>>52932000
              VDSMTAB(CURR'VOL'MAP+PAGE.(0:12)) := TOS;        <<32BND>>52934000
              END                                              <<32BND>>52936000
            UNTIL (PAGE := PAGE+1) > LPAGE;                    <<32BND>>52938000
            END;  << LOGONLOC <> 0 - SAVE IT >>                <<32BND>>52940000
          END;  << VOL = SYSTEM DISC >>                        <<32BND>>52942000
      CURR'VOL'MAP:= CURR'VOL'MAP + BMOFFSET + BMLENGTH;       <<32BND>>52944000
      END;  << WHILE VOL <= HVOL >>                            <<32BND>>52946000
                                                               <<32BND>>52948000
  VDSMTAB(TABLELENGTHWORD) := VDSENTRY(NEXTINLISTWORD);        <<32BND>>52950000
  VDSMTAB(GLOBLEASTAVAILPAGE):=VDSMTAB(TOTALPAGESWORD);        <<32BND>>52952000
  DST(VDSMDSTN*4) := VDSMTAB(TABLELENGTHWORD)&LSR(2);          <<32BND>>52954000
    << CORRECT DST LENGTH WORD >>                              <<32BND>>52956000
                                                               <<32BND>>52958000
  << RESET POINTERS TO SYSTEM DISC >>                          <<32BND>>52960000
  VDSENTRY(NEXTINLISTWORD) := BMOFFSET; <<PNT BACK TO 1ST ENT>><<32BND>>52962000
  CURR'VOL'MAP:= CURR'VOL'MAP - (BMOFFSET + BMLENGTH);         <<32BND>>52964000
  MTDS(VDSMDSTN, CURR'VOL'MAP-BMOFFSET, VDSENTRY, BMOFFSET);   <<32BND>>52966000
  ABSOLUTE(SYSVDSENTRY) := SYSENTRY;                           <<32BND>>52968000
  ABSOLUTE(SYSVDSMAP) := SYSMAP;                               <<32BND>>52970000
END;  << BUILD'VDSMTAB >>                                      <<32BND>>52972000
                                                                        52974000
          <<---------------------------------                           52976000
            RETURN SPACE FOR DELETED TRACKS                             52978000
          --------------------------------->>                           52980000
  PROCEDURE RETURNDELETES( LDEV);                              <<03549>>52982000
    VALUE LDEV;                                                <<03549>>52984000
    LOGICAL                                                    <<03549>>52986000
       LDEV;    << LOGICAL DEVICE NO. >>                       <<03549>>52988000
                                                               <<03549>>52990000
  COMMENT                                                      <<03549>>52992000
  RETURN DISC SPACE FOR DELETED TRACKS ON THE GIVEN LDEV.      <<03549>>52994000
  ;                                                            <<03549>>52996000
      BEGIN                                                    <<03549>>52998000
       DOUBLE  FSECT,   << FIRST SECTOR OF TRACK >>            <<03549>>53000000
               LSECT;   << LAST SECTOR OF TRACK >>             <<03549>>53002000
       INTEGER LEN,     << LENGTH OF TRACK >>                  <<03549>>53004000
               I := 0,  << INDEX >>                            <<*LDT*>>53006000
               LDT'INDEX,                                      <<*LPDT>>53008000
               LPDT'INDEX;                                     <<*LPDT>>53010000
       LOGICAL TYPE,    << DEVICE TYPE >>                      <<03549>>53012000
               STYPE;   << DEVICE SUBTYPE >>                   <<03549>>53014000
                                                               <<MPEIV>>53016000
       LDT'INDEX := LDEV * LDTSIZE;                            <<*LDT*>>53018000
       LPDT'INDEX := LDEV * LPDTSIZE;                          <<*LPDT>>53020000
       TYPE := LDT'DEVICE'TYPE;                                <<*LDT*>>53022000
       STYPE := LPDT'SUBTYPE;                                  <<*LPDT>>53024000
       IF TYPE = 0 << MH DISC >> OR TYPE = 1 << FH DISC >> THEN<<*LDT*>>53026000
          BEGIN                                                <<03549>>53028000
          DISC(READ,LDEV,1D,DTT,128);<<DEFECTIVE TRACKS TABLE>><<MPEIV>>53030000
          LEN := IF TYPE=MHDISCTYPE THEN MHINFO(STYPE          <<MPEIV>>53032000
            *MHINFOSIZE+MHSECTRK) ELSE 32;                              53034000
          WHILE (I:=I+1) <= DTT DO                                      53036000
          IF DTT(I).(14:2)=2 THEN                                       53038000
            BEGIN  <<DELETED TRACK>>                                    53040000
              TOS := LOGICAL(DTT(I)&LSR(2))**LOGICAL(LEN);              53042000
              FSECT := TOS;                                             53044000
              RETDISCSPACE(LDEV,D'L(LEN)),FSECT);              <<MPEIV>>53046000
            END;                                                        53048000
          END;                                                 <<03549>>53050000
      END <<RETURNDELETES>> ;                                           53052000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>53054000
        <<---------------------------------------------->>     <<03549>>53056000
        << RETURN OR REMOVE SPACE FOR REASSIGNED TRACKS >>     <<03549>>53058000
        <<---------------------------------------------->>     <<03549>>53060000
PROCEDURE REM'RET'REASS(RETRN,LDEV,DTT);                       <<03549>>53062000
VALUE RETRN,LDEV;                                              <<03549>>53064000
LOGICAL                                                        <<03549>>53066000
   RETRN;    << IF TRUE RETURN SPACE, IF FALSE REMOVE IT >>    <<03549>>53068000
INTEGER                                                        <<03549>>53070000
   LDEV;     << LOGICAL DEVICE # >>                            <<03549>>53072000
INTEGER ARRAY                                                  <<03549>>53074000
   DTT;      << DEFECTIVE TRACKS TABLE (TYPE 0 OR TYPE 1) >>   <<03549>>53076000
                                                               <<03549>>53078000
COMMENT                                                        <<03549>>53080000
RETURNS OR REMOVES DISC SPACE FROM THE DFSM FOR REASSIGNED     <<03549>>53082000
TRACKS ON A PARTICULAR LDEV.                                   <<03549>>53084000
;                                                              <<03549>>53086000
BEGIN                                                          <<03549>>53088000
DOUBLE                                                         <<03549>>53090000
   DADDR;   << STARTING DISC ADDRESS OF REASSIGNED AREA >>     <<03549>>53092000
LOGICAL                                                        <<03549>>53094000
   TYPE,       << DEVICE TYPE >>                               <<03549>>53096000
   STYPE,      << DEVICE SUBTYPE >>                            <<03549>>53098000
   TRACKLEN;   << LENGTH OF A TRACK >>                         <<03549>>53100000
INTEGER                                                        <<03549>>53102000
   I,                                                          <<*LDT*>>53104000
   LDT'INDEX,                                                  <<*LPDT>>53106000
   LPDT'INDEX;                                                 <<*LPDT>>53108000
                                                               <<03549>>53110000
LDT'INDEX := LDEV * LDTSIZE;                                   <<*LDT*>>53112000
LPDT'INDEX := LDEV *LPDTSIZE;                                  <<*LPDT>>53114000
TYPE := LDT'DEVICE'TYPE;                                       <<*LDT*>>53116000
STYPE := LPDT'SUBTYPE;                                         <<*LPDT>>53118000
                                                               <<03549>>53120000
IF TYPE = 0 << MH DISC >> OR TYPE = 1 << FH DISC >> THEN       <<*LDT*>>53122000
   BEGIN                                                       <<03549>>53124000
                                                               <<03549>>53126000
 << GET LENGTH OF REASSIGNED AREA--IN THIS CASE, >>            <<03549>>53128000
 << THE LENGTH OF ONE TRACK                      >>            <<03549>>53130000
                                                               <<03549>>53132000
   IF TYPE = 0 << MH DISC >> THEN                              <<*LDT*>>53134000
      TRACKLEN := MHINFOL(STYPE*MHINFOSIZE+MHSECTRK)           <<03549>>53136000
   ELSE                                                        <<03549>>53138000
      TRACKLEN := 32;                                          <<03549>>53140000
   I := 0;                                                     <<03549>>53142000
   WHILE (I := I+1) <= DTT(0) DO                               <<03549>>53144000
      IF DTT(I).(14:2) = 3 THEN    << REASSIGNED TRACK >>      <<03549>>53146000
         BEGIN                                                 <<03549>>53148000
         DADDR := D'(DTT(I)&LSR(2)) * D'(TRACKLEN);            <<03549>>53150000
         IF RETRN THEN      << RETURN DISC SPACE >>            <<03549>>53152000
            RETDISCSPACE(LDEV,D'(TRACKLEN),DADDR)              <<03549>>53154000
         ELSE               << REMOVE DISC SPACE >>            <<03549>>53156000
            REMDISCSPACE(LDEV,D'(TRACKLEN),DADDR);             <<03549>>53158000
         END;                                                  <<03549>>53160000
   END                                                         <<03549>>53162000
                                                               <<03549>>53164000
ELSE IF TYPE = 3 << CS80 DEVICE >> THEN                        <<*LDT*>>53166000
   BEGIN   << DO NOTHING FOR NOW >>                            <<03549>>53168000
   END;                                                        <<03549>>53170000
END;   << REM'RET'REASS >>                                     <<03549>>53172000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>53174000
         <<-------------------------------------->>            <<03549>>53176000
         <<  GET THE END OF THE RESERVED AREA    >>            <<03549>>53178000
         <<-------------------------------------->>            <<03549>>53180000
DOUBLE PROCEDURE END'RESERVED( LDEV);                          <<03549>>53182000
VALUE LDEV;                                                    <<03549>>53184000
INTEGER                                                        <<03549>>53186000
   LDEV;    << LOGICAL DEVICE NO. >>                           <<03549>>53188000
                                                               <<03549>>53190000
COMMENT                                                        <<03549>>53192000
RETURNS THE ADDRESS OF THE LAST SECTOR OF THE RESERVED AREA    <<03549>>53194000
ON THE GIVEN LDEV.  THE RESERVED AREA IS THE AREA OF THE DISC  <<03549>>53196000
RESERVED FOR INITIAL'S BOOTSTRAP AND FOR INITIAL'S USE         <<03549>>53198000
DURING A BOOT.                                                 <<03549>>53200000
;                                                              <<03549>>53202000
BEGIN                                                          <<03549>>53204000
LOGICAL                                                        <<03549>>53206000
   TEMP;                                                       <<03549>>53208000
                                                               <<03549>>53210000
IF LDEV=SYSDISC THEN                                           <<03549>>53212000
   TEMP := LDEV'1'RESERVED'AREA'SIZE - 1                       <<03549>>53214000
ELSE                                                           <<03549>>53216000
   TEMP := OTHER'DISC'RESERVED'AREA'SIZE - 1;                  <<03549>>53218000
END'RESERVED := DOUBLE(TEMP);                                  <<03549>>53220000
END;   << END'RESERVED >>                                      <<03549>>53222000
          <<----------------------------------                          53224000
            CHECK IF TRACK IS IN SYSTEM AREA                            53226000
          ---------------------------------->>                          53228000
  PROCEDURE CHECKSYS(FSECT,LSECT);                                      53230000
    VALUE FSECT,LSECT;                                                  53232000
    DOUBLE FSECT,LSECT;                                                 53234000
    COMMENT                                                             53236000
      CHECKS IF THE TRACK BOUNDED BY FSECT AND LSECT IS IN ONE OF THE   53238000
    SYSTEM TABLES, INITIAL'S CSTS OR THE MESSAGE CATALOG ON DISC. IF IT 53240000
    IS, RETURNS CCL, OTHERWISE CCE;                                     53242000
      BEGIN                                                             53244000
        INTEGER I:=0;                                                   53246000
        SUBROUTINE COMPARE(LEN,DADDR);                                  53248000
        VALUE LEN;                                                      53250000
        INTEGER LEN;                                                    53252000
        DOUBLE DADDR;                                                   53254000
        BEGIN                                                           53256000
          IF LSECT>=DADDR AND FSECT<DADDR+D'L(LEN)) THEN                53258000
            BEGIN  <<TRACK IS IN SYSTEM AREA>>                          53260000
              CC := CCL;                                                53262000
              ASSEMBLE(EXIT 4); <<EXIT FROM PROCEDURE>>                 53264000
            END;                                                        53266000
        END <<COMPARE>> ;                                               53268000
          COMPARE(VTABSECT,TABLEINFO(VTABINFOX+3)); <<VOLUME TABLE>>    53270000
          TOS := TABLEINFO(STACKINFOX);                                 53272000
          TOS := (TOS+127)&LSR(7);  <<SECTOR COUNT>>                    53274000
          COMPARE(*,TABLEINFO(X:=X+3)); <<INITIAL'S STACK>>             53276000
          DO                                                            53278000
            BEGIN  <<CHECK INITIAL'S CSTS>>                             53280000
              TOS := TCSTINFO(I*5);                                     53282000
              TOS := (TOS+127)&LSR(7);                                  53284000
              COMPARE(*,TCSTINFO(X:=X+3)); <<CST>>                      53286000
            END                                                         53288000
          UNTIL (I:=I+1)=INFO(NUTCST');                                 53290000
          CC := CCE;  <<EVERYTHING OK>>                                 53292000
      END <<CHECKSYS>> ;                                                53294000
          <<-------------------------------------------->>     <<03612>>53296000
          <<CHECK IF DEFECTIVE TRACK IS IN THE DIRECTORY>>     <<03612>>53298000
          <<-------------------------------------------->>     <<03612>>53300000
LOGICAL PROCEDURE CHECK'DIRECTORY (FSECT,LSECT);               <<03612>>53302000
  VALUE FSECT,LSECT;                                           <<03612>>53304000
  DOUBLE FSECT,LSECT;                                          <<03612>>53306000
                                                               <<03612>>53308000
  COMMENT                                                      <<03612>>53310000
    CHECKS IF THE DEFECTIVE TRACK BOUNDED BY FSECT AND LSECT   <<03612>>53312000
  IS IN THE DIRECTORY.  IF IT IS, RETURN TRUE.  THIS PROC      <<03612>>53314000
  IS CALLED FROM MAINSEG1;                                     <<03612>>53316000
                                                               <<03612>>53318000
    BEGIN                                                      <<03612>>53320000
      CHECK'DIRECTORY := FALSE;                                <<03612>>53322000
      IF FSECT < INFOD(DIRADR) + D'L(INFO(DIRSECT))) AND       <<03612>>53324000
         LSECT >= INFOD(DIRADR)                                <<03612>>53326000
         THEN                                                  <<03612>>53328000
           CHECK'DIRECTORY := TRUE;                            <<03612>>53330000
    END;                                                       <<03612>>53332000
   <<-------------------------------------------------------->><<03612>>53334000
   <<CHECK IF DEFECTIVE TRACK IN A SYSTEM DISC RESIDENT TABLE>><<03612>>53336000
   <<-------------------------------------------------------->><<03612>>53338000
LOGICAL PROCEDURE CHECK'RESIDENT (FSECT,LSECT);                <<03612>>53340000
  VALUE FSECT,LSECT;                                           <<03612>>53342000
  DOUBLE FSECT,LSECT;                                          <<03612>>53344000
                                                               <<03612>>53346000
  COMMENT                                                      <<03612>>53348000
    CHECKS IF THE TRACK BOUNDED BY FSECT AND LSECT IS IN THE   <<03612>>53350000
  RIN TABLE, LOG ID, OR LOG TAB AREAS ON DISC.  IF IT IS THEN  <<03612>>53352000
  RETURN TRUE.  THIS PROC IS CALLED BY MAINSEG1;               <<03612>>53354000
                                                               <<03612>>53356000
    BEGIN                                                      <<03612>>53358000
      LOGICAL SUBROUTINE BOUNDS (LEN,ADDR);                    <<03612>>53360000
        VALUE LEN,ADDR;                                        <<03612>>53362000
        INTEGER LEN,ADDR;                                      <<03612>>53364000
        BEGIN                                                  <<03612>>53366000
          BOUNDS := FALSE;                                     <<03612>>53368000
          IF FSECT < INFOD(ADDR) + D'L(INFO(LEN))) AND         <<03612>>53370000
             LSECT >= INFOD(ADDR)                              <<03612>>53372000
             THEN                                              <<03612>>53374000
               BOUNDS := TRUE;                                 <<03612>>53376000
        END; <<BOUNDS>>                                        <<03612>>53378000
      CHECK'RESIDENT := FALSE;                                 <<03612>>53380000
      IF BOUNDS(RINSECT,RINADR) OR                             <<03612>>53382000
         BOUNDS(LOGIDSECT,LOGIDADDR) OR                        <<03612>>53384000
         BOUNDS(LOGTABSECT,LOGTABADDR)                         <<03612>>53386000
         THEN                                                  <<03612>>53388000
           CHECK'RESIDENT := TRUE;                             <<03612>>53390000
    END; <<CHECK'RESIDENT>>                                    <<03612>>53392000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03714>>53394000
    <<----------------------------------------------------->>  <<03714>>53396000
    <<  CHECK IF DEFECTIVE DISC AREA IS IN VIRTUAL MEMORY  >>  <<03714>>53398000
    <<----------------------------------------------------->>  <<03714>>53400000
LOGICAL PROCEDURE CHECK'VM(LDEV, FSECT, LSECT);                <<03714>>53402000
VALUE LDEV, FSECT, LSECT;                                      <<03714>>53404000
INTEGER                                                        <<03714>>53406000
   LDEV;         << LOGICAL DEVICE NO. >>                      <<03714>>53408000
DOUBLE                                                         <<03714>>53410000
   FSECT,        << ADDRESS OF FIRST SECTOR OF AREA >>         <<03714>>53412000
   LSECT;        << ADDRESS OF LAST SECTOR OF AREA  >>         <<03714>>53414000
COMMENT                                                        <<03714>>53416000
CHECKS TO SEE IF THE DISC AREA ON THE GIVEN LDEV BOUNDED BY    <<03714>>53418000
FSECT (STARTING ADDRESS) AND LSECT (ENDING ADDRESS) OVERLAPS   <<03714>>53420000
ANY PART OF VIRTUAL MEMORY.  IF SO, THE PROCEDURE RETURNS      <<03714>>53422000
TRUE, FALSE OTHERWISE.                                         <<03714>>53424000
;                                                              <<03714>>53426000
BEGIN                                                          <<03714>>53428000
DOUBLE                                                         <<03714>>53430000
   VDSTART,           << STARTING DISC ADDRESS OF VM >>        <<03714>>53432000
   VDSLEN;            << LENGTH OF VM IN SECTORS >>            <<03714>>53434000
INTEGER                                                        <<03714>>53436000
   VOLUME,                 << VOLUME NO. OF DISC >>            <<03714>>53438000
   VDSTART1 = VDSTART,     << HIGH ORDER WORD OF VDSTART >>    <<03714>>53440000
   VDSTART2 = VDSTART+1,   << LOW ORDER WORD OF VDSTART >>     <<03714>>53442000
   VDSLEN1  = VDSLEN,      << HIGH ORDER WORD OF VDSLEN >>     <<03714>>53444000
   VDSLEN2  = VDSLEN+1;    << LOW ORDER WORD OF VDSLEN >>      <<03714>>53446000
                                                               <<03714>>53448000
CHECK'VM := FALSE;    << INITIALIZE RETURN >>                  <<03714>>53450000
VOLUME := GETVOL(LDEV);                                        <<03714>>53452000
IF VTAB(VOLUME*VTABSIZE+VTAB12).VMS = 1 THEN                   <<03714>>53454000
   BEGIN                             << DISC HAS VM >>         <<03714>>53456000
                                                               <<03714>>53458000
   VDSTART1 := VTAB(VOLUME*VTABSIZE+VTAB8);                    <<03714>>53460000
   VDSTART2 := VTAB(VOLUME*VTABSIZE+VTAB9);                    <<03714>>53462000
   VDSLEN1  := VTAB(VOLUME*VTABSIZE+VTAB10);                   <<03714>>53464000
   VDSLEN2  := VTAB(VOLUME*VTABSIZE+VTAB11);                   <<03714>>53466000
                                                               <<03714>>53468000
   IF FSECT < (VDSTART + VDSLEN) AND                           <<03714>>53470000
      LSECT >= VDSTART THEN                                    <<03714>>53472000
                                                               <<03714>>53474000
      CHECK'VM := TRUE;       << IT'S IN VIRTUAL MEMORY >>     <<03714>>53476000
   END;                                                        <<03714>>53478000
END;   << CHECK'VM >>                                          <<03714>>53480000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03714>>53482000
    <<------------------------------------------------->>      <<03714>>53484000
    <<  CHECK IF RECOVER LOST DISC SPACE IS NECESSARY  >>      <<03714>>53486000
    <<------------------------------------------------->>      <<03714>>53488000
LOGICAL PROCEDURE RECOVERY'NEEDED(LDEV, FSECT, LSECT);         <<03714>>53490000
VALUE LDEV,FSECT,LSECT;                                        <<03714>>53492000
INTEGER                                                        <<03714>>53494000
   LDEV;           << LOGICAL DEVICE NO. >>                    <<03714>>53496000
DOUBLE                                                         <<03714>>53498000
   FSECT,          << ADDRESS OF FIRST SECTOR OF AREA >>       <<03714>>53500000
   LSECT;          << ADDRESS OF LAST SECTOR OF AREA  >>       <<03714>>53502000
COMMENT                                                        <<03714>>53504000
CHECKS TO SEE IF THE DISC AREA ON THE GIVEN LDEV AND           <<03714>>53506000
BOUNDED BY FSECT AND LSECT, IN WHICH DATA WAS LOST, IS         <<03714>>53508000
SITUATED SUCH THAT RECOVER LOST DISC SPACE WILL BE             <<03714>>53510000
REQUIRED.  RECOVER LOST DISC SPACE IS REQUIRED IF THERE IS     <<03714>>53512000
ANY CHANCE THAT A FILE LOST DATA OR THE DISC FREE SPACE MAP    <<03714>>53514000
LOST DATA.  IF RECOVERY IS REQUIRED, IT RETURNS TRUE.          <<03714>>53516000
;                                                              <<03714>>53518000
BEGIN                                                          <<03714>>53520000
DOUBLE                                                         <<03714>>53522000
   VDSTART,   << STARTING ADDRESS OF VM >>                     <<03714>>53524000
   VDSLEN;    << LENGTH OF VM IN SECTORS >>                    <<03714>>53526000
INTEGER                                                        <<03714>>53528000
   VOLUME,                 << VOLUME NO. OF DISC >>            <<03714>>53530000
   VDSTART1 = VDSTART,     << HIGH ORDER WORD OF VDSTART >>    <<03714>>53532000
   VDSTART2 = VDSTART+1,   << LOW ORDER WORD OF VDSTART >>     <<03714>>53534000
   VDSLEN1  = VDSLEN,      << HIGH ORDER WORD OF VDSLEN >>     <<03714>>53536000
   VDSLEN2  = VDSLEN+1;    << LOW ORDER WORD OF VDSLEN >>      <<03714>>53538000
                                                               <<03714>>53540000
RECOVERY'NEEDED := FALSE;    << INITIALIZE RETURN >>           <<03714>>53542000
                                                               <<03714>>53544000
IF NOT RELOAD THEN           << NEVER DO RECOVERY ON RELOAD >> <<03714>>53546000
   BEGIN                                                       <<03714>>53548000
                                                               <<03714>>53550000
   << IF THE ENTIRE AREA IS WITHIN THE RESERVED AREA, IT >>    <<03714>>53552000
   << DOES NOT REQUIRE A RECOVER LOST DISC SPACE         >>    <<03714>>53554000
                                                               <<03714>>53556000
   IF LSECT <= END'RESERVED(LDEV) THEN                         <<03714>>53558000
      RETURN;                    << NO RECOVERY REQUIRED >>    <<03714>>53560000
                                                               <<03714>>53562000
   VOLUME := GETVOL(LDEV);                                     <<03714>>53564000
   IF VTAB(VOLUME*VTABSIZE+VTAB12).VMS=1 THEN                  <<03714>>53566000
      BEGIN                            << DISC HAS VM >>       <<03714>>53568000
                                                               <<03714>>53570000
      << IF THE AREA WHICH LOST DATA IS TOTALLY WITHIN  >>     <<03714>>53572000
      << VIRTUAL MEMORY THERE IS NO NEED TO RECOVER     >>     <<03714>>53574000
      << LOST DISC SPACE.                               >>     <<03714>>53576000
                                                               <<03714>>53578000
      VDSTART1 := VTAB(VOLUME*VTABSIZE+VTAB8);                 <<03714>>53580000
      VDSTART2 := VTAB(VOLUME*VTABSIZE+VTAB9);                 <<03714>>53582000
      VDSLEN1  := VTAB(VOLUME*VTABSIZE+VTAB10);                <<03714>>53584000
      VDSLEN2  := VTAB(VOLUME*VTABSIZE+VTAB11);                <<03714>>53586000
                                                               <<03714>>53588000
      IF FSECT >= VDSTART AND                                  <<03714>>53590000
         LSECT < (VDSTART + VDSLEN) THEN                       <<03714>>53592000
         << RECOVER LOST DISC SPACE NOT NEEDED >>              <<03714>>53594000
      ELSE                                                     <<03714>>53596000
         RECOVERY'NEEDED := TRUE;                              <<03714>>53598000
                                                               <<03714>>53600000
      END                                                      <<03714>>53602000
                                                               <<03714>>53604000
   ELSE                                                        <<03714>>53606000
      RECOVERY'NEEDED := TRUE;    << NO VM ON THE DISC, >>     <<03714>>53608000
                                  <<   MUST DO RECOVERY >>     <<03714>>53610000
                                                               <<03714>>53612000
   END;                                                        <<03714>>53614000
END;   << RECOVERY'NEEDED >>                                   <<03714>>53616000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03714>>53618000
    <<------------------------------------------------------>> <<03714>>53620000
    <<  ISSUE WARNINGS FOR DATA LOST IN SPECIAL DISC AREAS  >> <<03714>>53622000
    <<------------------------------------------------------>> <<03714>>53624000
PROCEDURE WARN'DISC'ZAPPED(LDEV, FSECT, LSECT);                <<03714>>53626000
VALUE LDEV,FSECT,LSECT;                                        <<03714>>53628000
INTEGER                                                        <<03714>>53630000
   LDEV;     << LOGICAL DEVICE OF DISC >>                      <<03714>>53632000
DOUBLE                                                         <<03714>>53634000
   FSECT,    << ADDRESS OF FIRST SECTOR OF AREA >>             <<03714>>53636000
   LSECT;    << ADDRESS OF LAST SECTOR OF AREA  >>             <<03714>>53638000
COMMENT                                                        <<03714>>53640000
ISSUES WARNINGS FOR DATA LOST IN THE FOLLOWING SPECIAL         <<03714>>53642000
AREAS OF THE DISC:  THE RESERVED AREA, THE SYSTEM AREA,        <<03714>>53644000
THE DIRECTORY, THE DISC FREE SPACE MAP, ANY OTHER DISC         <<03714>>53646000
RESIDENT TABLE, AND VIRTUAL MEMORY.  MORE THAN ONE WARNING     <<03714>>53648000
MAY APPEAR FOR A GIVEN DISC AREA.  THIS PROCEDURE IS USED      <<03714>>53650000
DURING SPARING.                                                <<03714>>53652000
;                                                              <<03714>>53654000
BEGIN                                                          <<03714>>53656000
                                                               <<03714>>53658000
IF FSECT <= END'RESERVED(LDEV) THEN    << WARNING: IN       >> <<03714>>53660000
   MESSAGE(M2240);                     <<    RESERVED AREA  >> <<03714>>53662000
                                                               <<03714>>53664000
IF LDEV = SYSDISC THEN                                         <<03714>>53666000
   BEGIN                                                       <<03714>>53668000
                                                               <<03714>>53670000
   IF NOT LOADFROMTAPE THEN                                    <<03714>>53672000
      BEGIN                                                    <<03714>>53674000
                                                               <<03714>>53676000
      CHECKSYS(FSECT, LSECT);                                  <<03714>>53678000
      IF <> THEN                     << WARNING: IN SYSTEM >>  <<03714>>53680000
         MESSAGE(M2246);             <<    AREA            >>  <<03714>>53682000
                                                               <<03714>>53684000
      END;                                                     <<03714>>53686000
                                                               <<03714>>53688000
   IF NOT RELOAD THEN                                          <<03714>>53690000
      BEGIN                                                    <<03714>>53692000
                                                               <<03714>>53694000
      IF CHECK'DIRECTORY(FSECT, LSECT) THEN    << WARNING:  >> <<03714>>53696000
         MESSAGE(M2241);                    << IN DIRECTORY >> <<03714>>53698000
                                                               <<03714>>53700000
      IF CHECK'RESIDENT(FSECT, LSECT) THEN    << WARNING:   >> <<03714>>53702000
         MESSAGE(M2250);         << IN DISC RESIDENT TABLE  >> <<03714>>53704000
                                                               <<03714>>53706000
      END;                                                     <<03714>>53708000
   END;                                                        <<03714>>53710000
                                                               <<03714>>53712000
IF NOT RELOAD THEN                                             <<03714>>53714000
   IF CHECK'IF'OVERLAPS'DFS'DATA'STRUCTURES(                   <<03714>>53716000
                          LDEV, FSECT, LSECT) THEN             <<03714>>53718000
      MESSAGE(M2248);    << WARNING: IN FREE SPACE MAP >>      <<03714>>53720000
                                                               <<03714>>53722000
IF NOT RELOAD OR RESTORE THEN                                  <<03714>>53724000
   IF CHECK'VM(LDEV, FSECT, LSECT) THEN     << WARNING: IN  >> <<03714>>53726000
      MESSAGE(M2242);                   <<  VIRTUAL MEMORY  >> <<03714>>53728000
                                                               <<03714>>53730000
END;   << WARN'DISC'ZAPPED >>                                  <<03714>>53732000
$CONTROL SEGMENT=SETUP                                         <<03549>>53734000
          <<---------------------------------->>               <<03549>>53736000
          <<     TEST A BIT IN A BIT MAP      >>               <<03549>>53738000
          <<---------------------------------->>               <<03549>>53740000
LOGICAL PROCEDURE TESTBIT(BIT'MAP,BIT'NUM);                    <<03549>>53742000
VALUE BIT'NUM;                                                 <<03549>>53744000
INTEGER ARRAY                                                  <<03549>>53746000
   BIT'MAP;    << BIT MAP >>                                   <<03549>>53748000
INTEGER                                                        <<03549>>53750000
   BIT'NUM;    << BIT NUMBER >>                                <<03549>>53752000
                                                               <<03549>>53754000
COMMENT                                                        <<03549>>53756000
RETURN TRUE IF THE GIVEN BIT'NUM IN BITMAP IS SET (=1).        <<03549>>53758000
OTHERWISE, RETURN FALSE.                                       <<03549>>53760000
;                                                              <<03549>>53762000
BEGIN                                                          <<03549>>53764000
INTEGER                                                        <<03549>>53766000
   TEMP;                                                       <<03549>>53768000
                                                               <<03549>>53770000
TEMP := BIT'MAP(BIT'NUM.(0:12));   << GET APPROPRIATE WORD >>  <<03549>>53772000
                                   <<     FROM BIT'MAP     >>  <<03549>>53774000
IF TEMP&LSL(BIT'NUM.(12:4)) < 0 THEN     << IF BIT IS SET, >>  <<03549>>53776000
   TESTBIT := TRUE                       <<    RETURN TRUE >>  <<03549>>53778000
ELSE                                     << OTHERWISE,     >>  <<03549>>53780000
   TESTBIT := FALSE;                     <<   RETURN FALSE >>  <<03549>>53782000
END;   << TESTBIT >>                                           <<03549>>53784000
$CONTROL SEGMENT=SETUP                                         <<03549>>53786000
           <<-------------------------------->>                <<03549>>53788000
           <<     SET A BIT IN A BIT MAP     >>                <<03549>>53790000
           <<-------------------------------->>                <<03549>>53792000
PROCEDURE SETBIT(BIT'MAP,BIT'NUM);                             <<03549>>53794000
VALUE BIT'NUM;                                                 <<03549>>53796000
INTEGER ARRAY                                                  <<03549>>53798000
   BIT'MAP;   << BIT MAP >>                                    <<03549>>53800000
INTEGER                                                        <<03549>>53802000
   BIT'NUM;   << BIT NUMBER >>                                 <<03549>>53804000
                                                               <<03549>>53806000
COMMENT                                                        <<03549>>53808000
SET THE THE GIVEN BIT'NUM IN BIT'MAP                           <<03549>>53810000
;                                                              <<03549>>53812000
BEGIN                                                          <<03549>>53814000
LOGICAL                                                        <<03549>>53816000
   TEMP,I;                                                     <<03549>>53818000
                                                               <<03549>>53820000
TEMP := BIT'MAP(BIT'NUM.(0:12));   << GET APPROPRIATE WORD >>  <<03549>>53822000
                                   <<    FROM THE BIT MAP  >>  <<03549>>53824000
I := %100000&LSR(BIT'NUM.(12:4));         << SET THE       >>  <<03549>>53826000
BIT'MAP(BIT'NUM.(0:12)) := TEMP LOR I;    <<   DESIRED BIT >>  <<03549>>53828000
END;   << SETBIT >>                                            <<03549>>53830000
$CONTROL SEGMENT=SETUP                                         <<03549>>53832000
          <<------------------------------>>                   <<03549>>53834000
          <<  CLEAR A BIT IN A BIT MAP    >>                   <<03549>>53836000
          <<------------------------------>>                   <<03549>>53838000
PROCEDURE CLEARBIT( BIT'MAP, BIT'NUM);                         <<03549>>53840000
VALUE BIT'NUM;                                                 <<03549>>53842000
INTEGER ARRAY                                                  <<03549>>53844000
   BIT'MAP;    << BIT MAP >>                                   <<03549>>53846000
INTEGER                                                        <<03549>>53848000
   BIT'NUM;    << BIT NUMBER TO CLEAR >>                       <<03549>>53850000
                                                               <<03549>>53852000
COMMENT                                                        <<03549>>53854000
CLEARS (ZEROES) THE GIVEN BIT'NUM IN BIT'MAP                   <<03549>>53856000
;                                                              <<03549>>53858000
BEGIN                                                          <<03549>>53860000
LOGICAL                                                        <<03549>>53862000
   TEMP,I;                                                     <<03549>>53864000
                                                               <<03549>>53866000
TEMP := BIT'MAP(BIT'NUM.(0:12));     << GET THE APPROPRIATE >> <<03549>>53868000
                                     <<   WORD FROM BIT'MAP >> <<03549>>53870000
I := %077777 & CSR(BIT'NUM.(4:12));      << CLEAR THE       >> <<03549>>53872000
BIT'MAP(BIT'NUM.(0:12)) := TEMP LAND I;  <<   DESIRED BIT   >> <<03549>>53874000
END;   << CLEARBIT >>                                          <<03549>>53876000
$CONTROL SEGMENT=SETUP                                         <<03549>>53878000
           <<---------------------------------->>              <<03549>>53880000
           <<  GET SPACE IN THE RESERVED AREA  >>              <<03549>>53882000
           <<---------------------------------->>              <<03549>>53884000
LOGICAL PROCEDURE GET'RESERVED( DADDR, SIZE);                  <<03549>>53886000
VALUE SIZE;                                                    <<03549>>53888000
DOUBLE                                                         <<03549>>53890000
   DADDR;   << RETURN DOUBLE WORD DISC ADDRESS >>              <<03549>>53892000
INTEGER                                                        <<03549>>53894000
   SIZE;    << NUMBER OF SECTORS REQUESTED  >>                 <<03549>>53896000
                                                               <<03549>>53898000
COMMENT                                                        <<03549>>53900000
GET 'SIZE' NUMBER OF CONTIGUOUS SECTORS IN THE RESERVED AREA   <<03549>>53902000
OF THE DISC.  IF A CONTIGUOUS AREA OF THAT SIZE IS NOT         <<03549>>53904000
AVAILABLE, GET'RESERVED RETURNS FALSE.  OTHERWISE, IT          <<03549>>53906000
RETURNS TRUE WITH THE STARTING DISC ADDRESS IN DADDR.          <<03549>>53908000
NOTE:  ALTHOUGH THIS PROCEDURE RETURNS A DOUBLE DISC ADDRESS,  <<03549>>53910000
THE ADDRESS IS ALWAYS <= 32767 (DECIMAL).                      <<03549>>53912000
;                                                              <<03549>>53914000
BEGIN                                                          <<03549>>53916000
INTEGER                                                        <<03549>>53918000
   CUR'SECTOR,      << CURRENT SECTOR >>                       <<03549>>53920000
   LAST'RESERVED,   << LAST SECTOR IN RESERVED AREA >>         <<03549>>53922000
   START'SECTOR;    << CURRENT STARTING SECTOR >>              <<03549>>53924000
LOGICAL                                                        <<03549>>53926000
   FOUND;           << TRUE IF SPACE IS FOUND >>               <<03549>>53928000
                                                               <<03549>>53930000
FOUND := FALSE;                                                <<03549>>53932000
CUR'SECTOR := -1;                                              <<03549>>53934000
LAST'RESERVED := LDEV'1'RESERVED'AREA'SIZE - 1;                <<03549>>53936000
                                                               <<03549>>53938000
WHILE NOT FOUND AND CUR'SECTOR < LAST'RESERVED DO              <<03549>>53940000
   BEGIN                                                       <<03549>>53942000
   FOUND := TRUE;    << HAVEN'T FOUND IT YET, BUT WE'LL TRY >> <<03549>>53944000
   START'SECTOR := CUR'SECTOR + 1;                             <<03549>>53946000
                                                               <<03549>>53948000
 << BEGINNING AT START'SECTOR, CHECK 'SIZE' CONSECUTIVE   >>   <<03549>>53950000
 << SECTORS TO SEE IF THEY ARE ALL FREE                   >>   <<03549>>53952000
                                                               <<03549>>53954000
   WHILE FOUND AND (CUR'SECTOR := CUR'SECTOR + 1)              <<03549>>53956000
                  <= (START'SECTOR + SIZE - 1) DO              <<03549>>53958000
      IF CUR'SECTOR <= LAST'RESERVED THEN                      <<03549>>53960000
         IF NOT TESTBIT(BOOTSPACEMAP, CUR'SECTOR) THEN         <<03549>>53962000
            FOUND := FALSE   << SECTOR ALREADY IN USE >>       <<03549>>53964000
         ELSE                << CONTINUE >>                    <<03549>>53966000
                                                               <<03549>>53968000
      ELSE                                                     <<03549>>53970000
         FOUND := FALSE;     << PAST END OF RESERVED AREA >>   <<03549>>53972000
                                                               <<03549>>53974000
   END;   << WHILE NOT FOUND AND CUR'SECTOR < LAST'RESERVED >> <<03549>>53976000
                                                               <<03549>>53978000
IF FOUND THEN                                                  <<03549>>53980000
   BEGIN             << WE GOT THE SPACE >>                    <<03549>>53982000
   CUR'SECTOR := START'SECTOR - 1;                             <<03549>>53984000
   WHILE (CUR'SECTOR := CUR'SECTOR + 1)      << RESERVE THE >> <<03549>>53986000
                <= (START'SECTOR + SIZE - 1) DO   << SPACE  >> <<03549>>53988000
      CLEARBIT(BOOTSPACEMAP, CUR'SECTOR);                      <<03549>>53990000
   DADDR := DOUBLE(START'SECTOR);                              <<03549>>53992000
   GET'RESERVED := TRUE;                                       <<03549>>53994000
   END                                                         <<03549>>53996000
                                                               <<03549>>53998000
ELSE                                                           <<03549>>54000000
   GET'RESERVED := FALSE;     << COULDN'T GET IT, SO SORRY >>  <<03549>>54002000
                                                               <<03549>>54004000
END;   << GET'RESERVED >>                                      <<03549>>54006000
$CONTROL SEGMENT=SETUP                                         <<03549>>54008000
         <<-------------------------------------->>            <<03549>>54010000
         <<  RELEASE SPACE IN THE RESERVED AREA  >>            <<03549>>54012000
         <<-------------------------------------->>            <<03549>>54014000
PROCEDURE RELEASE'RESERVED( DADDR, SIZE);                      <<03549>>54016000
VALUE DADDR,SIZE;                                              <<03549>>54018000
DOUBLE                                                         <<03549>>54020000
   DADDR;    << STARTING DISC ADDRESS OF RELEASE AREA >>       <<03549>>54022000
INTEGER                                                        <<03549>>54024000
   SIZE;     << LENGTH IN SECTORS OF RELEASE AREA >>           <<03549>>54026000
                                                               <<03549>>54028000
COMMENT                                                        <<03549>>54030000
RELEASES SPACE IN THE RESERVED AREA, PREVIOUSLY RESERVED BY    <<03549>>54032000
GET'RESERVED.  THIS AREA IS AVAILABLE TO INITIAL ONLY FOR      <<03549>>54034000
ITS BOOTSTRAP AND WORKING SPACE.  NOTE:  ALTHOUGH DADDR IS     <<03549>>54036000
A DOUBLE, IT IS ASSUMED THAT IT CONTAINS A VALUE <= 32767.     <<03549>>54038000
ALSO, IF AN ATTEMPT IS MADE TO RETURN SPACE NOT IN THE         <<03549>>54040000
RESERVED AREA OR SPACE ALREADY FREE, INITIAL ABORTS.           <<03549>>54042000
;                                                              <<03549>>54044000
BEGIN                                                          <<03549>>54046000
INTEGER                                                        <<03549>>54048000
   I,                  << CURRENT SECTOR >>                    <<03549>>54050000
   LAST'RESERVED,      << LAST SECTOR IN RESERVED AREA >>      <<03549>>54052000
   START'SECTOR = DADDR+1;   << LOW ORDER WORD OF DADDR >>     <<03549>>54054000
                                                               <<03549>>54056000
I := -1;                                                       <<03549>>54058000
LAST'RESERVED := LDEV'1'RESERVED'AREA'SIZE - 1;                <<03549>>54060000
                                                               <<03549>>54062000
WHILE (I := I + 1) < SIZE DO     << TRY TO FREE SPACE >>       <<03549>>54064000
   BEGIN                                                       <<03549>>54066000
   IF (START'SECTOR + I) > LAST'RESERVED THEN                  <<03549>>54068000
      ERRMESSAGE(M334);      << SPACE NOT IN RESERVED AREA >>  <<03549>>54070000
                                                               <<03549>>54072000
   IF TESTBIT(BOOTSPACEMAP, START'SECTOR + I) THEN             <<03549>>54074000
      ERRMESSAGE(M335);      << SPACE ALREADY FREE >>          <<03549>>54076000
                                                               <<03549>>54078000
 << FREE ONE SECTOR >>                                         <<03549>>54080000
                                                               <<03549>>54082000
   SETBIT(BOOTSPACEMAP, START'SECTOR + I);                     <<03549>>54084000
   END;                                                        <<03549>>54086000
END;   << RELEASE'RESERVED >>                                  <<03549>>54088000
$CONTROL SEGMENT=SETUP                                         <<03549>>54090000
            <<--------------------------------->>              <<03549>>54092000
            <<   GET BOOTSTRAP DISC SPACE      >>              <<03549>>54094000
            <<--------------------------------->>              <<03549>>54096000
INTEGER PROCEDURE BOOTDISCSPACE( SIZE);                        <<03549>>54098000
VALUE SIZE;                                                    <<03549>>54100000
LOGICAL                                                        <<03549>>54102000
   SIZE;    << NO. OF WORDS NEEDED >>                          <<03549>>54104000
COMMENT                                                        <<03549>>54106000
GETS SPACE OF WORD LENGTH SIZE (IN SECTOR MULTIPLES) FROM      <<03549>>54108000
THE BOOTSTRAP AREA OF THE SYSTEM DISC.  RETURNS THE            <<03549>>54110000
SINGLE-WORD DISC ADDRESS IN BOOTDISCSPACE.                     <<03549>>54112000
;                                                              <<03549>>54114000
BEGIN                                                          <<03549>>54116000
DOUBLE                                                         <<03549>>54118000
   DADDR;                << DOUBLE WORD DISC ADDRESS >>        <<03549>>54120000
INTEGER                                                        <<03549>>54122000
   DADDR2 = DADDR + 1;   << LOW ORDER WORD OF DADDR >>         <<03549>>54124000
                                                               <<03549>>54126000
SIZE := (SIZE + 127)/128;   << COMPUTE NO. OF SECTORS >>       <<03549>>54128000
                            <<    (ROUNDED UP)        >>       <<03549>>54130000
                                                               <<03549>>54132000
IF NOT GET'RESERVED(DADDR,SIZE) THEN                           <<03549>>54134000
   ERRMESSAGE( M327);   << OUT OF BOOTSTRAP DISC SPACE >>      <<03549>>54136000
                                                               <<03549>>54138000
BOOTDISCSPACE := DADDR2;   << RETURN DISC SPACE >>             <<03549>>54140000
END;   << BOOTDISCSPACE >>                                     <<03549>>54142000
$CONTROL SEGMENT=SETUP                                         <<03549>>54144000
        <<-------------------------------------->>             <<03549>>54146000
        <<   FIND THE NEXT AREA IN A BIT MAP    >>             <<03549>>54148000
        <<-------------------------------------->>             <<03549>>54150000
LOGICAL PROCEDURE FIND'NEXT'BIT'AREA(BIT'MAP,BIT'MAP'SIZE,     <<03549>>54152000
                          BIT'INDEX,SIZE,NEXT'INDEX,ON'OFF);   <<03549>>54154000
VALUE BIT'MAP'SIZE,ON'OFF;                                     <<03549>>54156000
INTEGER ARRAY                                                  <<03549>>54158000
   BIT'MAP;        << BIT MAP >>                               <<03549>>54160000
INTEGER                                                        <<03549>>54162000
   BIT'MAP'SIZE,   << SIZE OF BIT MAP (IN BITS) >>             <<03549>>54164000
   BIT'INDEX,      << RETURN STARTING LOCATION OF AREA    >>   <<03672>>54166000
   SIZE,           << RETURN SIZE OF AREA >>                   <<03549>>54168000
   NEXT'INDEX;     << RETURN VALUE USED IN A SEQUENCE OF   >>  <<03672>>54170000
                   << CALLS, INITIALLY SET BY USER TO THE  >>  <<03672>>54172000
                   << START OF SEARCH AREA                 >>  <<03672>>54174000
LOGICAL                                                        <<03549>>54176000
   ON'OFF;         << IF TRUE, SEARCH FOR AREAS OF 1.      >>  <<03549>>54178000
                   <<    ELSE SEARCH FOR AREAS OF 0.       >>  <<03549>>54180000
                                                               <<03549>>54182000
COMMENT                                                        <<03549>>54184000
GETS THE NEXT CONTIGUOUS AREA FROM A BITMAP (INDEXED STARTING  <<03672>>54186000
FROM 0) STARTING FROM NEXT'INDEX.  THE AREA CAN EITHER BE      <<03672>>54188000
CONSECUTIVE 1'S (ON'OFF = TRUE) OR 0'S (ON'OFF = FALSE).  IF   <<03672>>54190000
THE NEXT'INDEX PASSED BY THE USER CURRENTLY POINTS AT A BIT    <<03672>>54192000
WHICH IS THE OPPOSITE OF THE VALUE OF ON'OFF, IT SCANS FORWARD <<03672>>54194000
TO FIND THE FIRST AREA.  IF FIND'NEXT'BIT'AREA IS SUCCESSFUL,  <<03672>>54196000
IT RETURNS TRUE AND RETURNS THE STARTING BIT OF THE AREA IN    <<03672>>54198000
BIT'INDEX, THE LENGTH OF THE AREA IN 'SIZE', AND NEXT'INDEX    <<03672>>54200000
 = (BIT'INDEX + SIZE).  NEXT'INDEX CAN THEN BE USED IN THE     <<03672>>54202000
NEXT CALL, TO FIND THE NEXT AREA.  IF NO                       <<03672>>54204000
AREA IS FOUND, FIND'NEXT'BIT'AREA RETURNS FALSE.  NOTE:        <<03672>>54206000
THIS PROCEDURE DOES NOT ALTER THE BIT MAP.                     <<03549>>54208000
;                                                              <<03549>>54210000
BEGIN                                                          <<03549>>54212000
                                                               <<03549>>54214000
FIND'NEXT'BIT'AREA := FALSE;     << INITIALIZE RETURN >>       <<03549>>54216000
BIT'INDEX := NEXT'INDEX;     << STARTING POINT FOR SEARCH >>   <<03672>>54218000
                                                               <<03549>>54220000
IF 0 <= BIT'INDEX <= (BIT'MAP'SIZE - 1) THEN                   <<03549>>54222000
   BEGIN                                                       <<03549>>54224000
                                                               <<03549>>54226000
 << SEARCH FOR THE FIRST BIT WHICH IS THE SAME AS ON'OFF >>    <<03549>>54228000
                                                               <<03549>>54230000
   WHILE BIT'INDEX <= (BIT'MAP'SIZE - 1) AND                   <<03549>>54232000
         TESTBIT( BIT'MAP,BIT'INDEX) <> ON'OFF DO              <<03549>>54234000
      BIT'INDEX := BIT'INDEX + 1;                              <<03549>>54236000
                                                               <<03549>>54238000
   NEXT'INDEX := BIT'INDEX + 1;                                <<03549>>54240000
                                                               <<03549>>54242000
 << IF NO AREA IS FOUND, RETURN FALSE >>                       <<03549>>54244000
                                                               <<03549>>54246000
   IF BIT'INDEX > (BIT'MAP'SIZE - 1) THEN RETURN;              <<03549>>54248000
                                                               <<03549>>54250000
 << WE HAVE FOUND AN AREA, NOW SEARCH FOR THE END OF IT >>     <<03549>>54252000
                                                               <<03549>>54254000
   WHILE NEXT'INDEX <= (BIT'MAP'SIZE - 1) AND                  <<03549>>54256000
         TESTBIT( BIT'MAP,NEXT'INDEX) = ON'OFF DO              <<03549>>54258000
      NEXT'INDEX := NEXT'INDEX + 1;                            <<03549>>54260000
                                                               <<03549>>54262000
   SIZE := NEXT'INDEX - BIT'INDEX;                             <<03549>>54264000
   FIND'NEXT'BIT'AREA := TRUE;                                 <<03549>>54266000
                                                               <<03549>>54268000
   END;                                                        <<03549>>54270000
END;   << FIND'NEXT'BIT'AREA >>                                <<03549>>54272000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>54274000
        <<---------------------------------------->>           <<03549>>54276000
        <<  SPARE SUSPECT SECTOR ON A CS'80 DISC  >>           <<03549>>54278000
        <<---------------------------------------->>           <<03549>>54280000
PROCEDURE CS80'SPARE(LDEV,DISC'ADDRESS,AFFECT'AREA,            <<03549>>54282000
                      AFFECT'AREA'LEN,DATA'LOST'MAP);          <<03549>>54284000
VALUE LDEV,DISC'ADDRESS;                                       <<03549>>54286000
INTEGER                                                        <<03549>>54288000
   LDEV,             << LOGICAL DEVICE NO. >>                  <<03549>>54290000
   AFFECT'AREA'LEN;  << RETURN LENGTH OF THE AFFECTED AREA >>  <<03549>>54292000
                     <<    IN SECTORS                      >>  <<03549>>54294000
DOUBLE                                                         <<03549>>54296000
   DISC'ADDRESS,     << DISC ADDRESS OF SUSPECT SECTOR >>      <<03549>>54298000
   AFFECT'AREA;      << RETURN DISC ADDRESS OF AREA >>         <<03549>>54300000
                     <<    AFFECTED BY THE SPARE    >>         <<03549>>54302000
INTEGER ARRAY                                                  <<03549>>54304000
   DATA'LOST'MAP;    << BIT MAP REPRESENTING THE AFFECTED >>   <<03549>>54306000
                     << AREA-- 1 MEANS DATA WAS LOST, 0   >>   <<03549>>54308000
                     << MEANS DATA WAS RECOVERED--FILLED  >>   <<03549>>54310000
                     << IN BY THIS PROCEDURE              >>   <<03549>>54312000
                                                               <<03549>>54314000
COMMENT                                                        <<03549>>54316000
THIS PROCEDURE SPARES A SUSPECT SECTOR ON A CS'80 DISC.  IT    <<03549>>54318000
FIRST TRIES SPARE RETAINING DATA.  IF THAT FAILS, WE MUST      <<03549>>54320000
DO SPARE NOT RETAINING DATA.  BEFORE THE SPARE NOT RETAINING   <<03549>>54322000
DATA, HOWEVER, WE MUST SAVE THE AREA THE DISC TELLS US TO      <<03549>>54324000
SAVE (A TRACK) INTO THE RESERVED AREA ON LDEV 1.  WE           <<03549>>54326000
REMEMBER WHICH DATA COULD NOT BE READ BY SETTING A BIT IN      <<03549>>54328000
THE DATA'LOST'MAP BIT MAP.  WE THEN PERFORM SPARE NOT          <<03549>>54330000
RETAINING DATA UNTIL THE SPARED AREA IS GOOD.  THE SAVED       <<03549>>54332000
DATA IS THEN COPIED BACK TO ITS ORIGINAL ADDRESS.              <<03549>>54334000
;                                                              <<03549>>54336000
BEGIN                                                          <<03549>>54338000
EQUATE                                                         <<03549>>54340000
   SPARE'RETAIN     = 15,   << SPARE RETAINING DATA >>         <<03549>>54342000
   SPARE'NO'RETAIN  = 16,   << SPARE NOT RETAINING DATA >>     <<03549>>54344000
   RECOV'READ       = 14,   << RECOVERY READ--NOT FATAL IF >>  <<03549>>54346000
                            <<     IT GETS UNRECOVERABLE   >>  <<03549>>54348000
                            <<     DATA ERRORS.            >>  <<03549>>54350000
   RW'ERT           = 18,   << READ/WRITE ERROR RATE TEST  >>  <<03549>>54352000
   RO'ERT           = 23;   << READ-ONLY ERROR RATE TEST   >>  <<03549>>54354000
DOUBLE                                                         <<03549>>54356000
   TEMP,                                                       <<03549>>54358000
   RESERVED;         << DISC ADDRESS IN THE RESERVED AREA >>   <<03549>>54360000
INTEGER                                                        <<03549>>54362000
   TEMP1 = TEMP,     << HIGH ORDER WORD OF TEMP >>             <<03549>>54364000
   TEMP2 = TEMP+1,   << LOW ORDER WORD OF TEMP  >>             <<03549>>54366000
   I;                << INDEX >>                               <<03549>>54368000
INTEGER ARRAY                                                  <<03549>>54370000
   AFFECTS(0:4),     << ARRAY TO HOLD STATUS RETURN FROM   >>  <<03549>>54372000
                     <<    SPARE COMMAND--CONTAINS 6-BYTE  >>  <<03549>>54374000
                     <<    ADDRESS OF AFFECTED AREA        >>  <<03549>>54376000
                     <<    FOLLOWED BY 4-BYTE LENGTH OF    >>  <<03549>>54378000
                     <<    AREA IN BYTES                   >>  <<03549>>54380000
   BUFF(0:127),      << READ/WRITE BUFFER >>                   <<03549>>54382000
   DUMMY(0:0);       << DUMMY ARRAY >>                         <<03549>>54384000
LOGICAL                                                        <<03549>>54386000
   SUCCESS,                                                    <<03549>>54388000
   ANY'SAVED;     << TRUE IF SOME DATA IN SPARED AREA >>       <<03549>>54390000
                  <<    WAS SAVED                     >>       <<03549>>54392000
                                                               <<03549>>54394000
<< FIRST TRY SPARE RETAINING DATA >>                           <<03549>>54396000
                                                               <<03549>>54398000
DISC(SPARE'RETAIN,LDEV,DISC'ADDRESS,AFFECTS,5);                <<03549>>54400000
                                                               <<03549>>54402000
IF = THEN                                                      <<03549>>54404000
   SUCCESS := TRUE       << SPARE RETAINING DATA WORKED >>     <<03549>>54406000
ELSE                                                           <<03549>>54408000
   SUCCESS := FALSE;     << SPARE RETAINING DATA FAILED >>     <<03549>>54410000
                                                               <<03549>>54412000
TEMP1 := AFFECTS(1);     << GET AREA AFFECTED BY >>            <<03549>>54414000
TEMP2 := AFFECTS(2);     <<    THE SPARE         >>            <<03549>>54416000
AFFECT'AREA := TEMP;                                           <<03549>>54418000
TEMP1 := AFFECTS(3);                                           <<03549>>54420000
TEMP2 := AFFECTS(4);                                           <<03549>>54422000
AFFECT'AREA'LEN := INTEGER(((TEMP+255D)/256D));                <<03549>>54424000
                                                               <<03549>>54426000
IF SUCCESS THEN          << SPARE RETAINING DATA WORKED >>     <<03549>>54428000
   BEGIN                                                       <<03549>>54430000
                                                               <<03549>>54432000
   << TRY READ-ONLY ERT ON THE AFFECTED AREA >>                <<03549>>54434000
                                                               <<03549>>54436000
   DISC(RO'ERT,LDEV,AFFECT'AREA,DUMMY,AFFECT'AREA'LEN);        <<03549>>54438000
                                                               <<03549>>54440000
   IF = THEN           << READ-ONLY ERT WORKED, WE'RE DONE >>  <<03549>>54442000
      BEGIN                                                    <<03549>>54444000
      AFFECT'AREA := DISC'ADDRESS;                             <<03549>>54446000
      AFFECT'AREA'LEN := 1;                                    <<03549>>54448000
      RETURN;                                                  <<03549>>54450000
      END;                                                     <<03549>>54452000
   END;                                                        <<03549>>54454000
                                                               <<03549>>54456000
<< TRY TO GET SOME RESERVED AREA ON THE DISC TO SAVE >>        <<03549>>54458000
<< DATA IN THE AFFECTED AREA, BEFORE WE DO A SPARE   >>        <<03549>>54460000
<< NOT RETAINING DATA                                >>        <<03549>>54462000
                                                               <<03549>>54464000
IF GET'RESERVED( RESERVED, AFFECT'AREA'LEN) THEN               <<03549>>54466000
   BEGIN                                                       <<03549>>54468000
                                                               <<03549>>54470000
   << WE GOT SPACE IN THE RESERVED AREA, NOW COPY ALL >>       <<03549>>54472000
   << SECTORS IN THE AFFECTED AREA INTO THE RESERVED  >>       <<03549>>54474000
   << AREA                                            >>       <<03549>>54476000
                                                               <<03549>>54478000
   ANY'SAVED := TRUE;     << SAVED SOME DATA >>                <<03549>>54480000
   I := -1;                                                    <<03549>>54482000
   WHILE (I:=I+1) < AFFECT'AREA'LEN DO                         <<03549>>54484000
      BEGIN                                                    <<03549>>54486000
      DISC(RECOV'READ,LDEV,AFFECT'AREA+DOUBLE(I),BUFF,128);    <<03549>>54488000
                                                               <<03549>>54490000
      << REMEMBER WHICH DATA WAS LOST >>                       <<03549>>54492000
                                                               <<03549>>54494000
      IF <> THEN                                               <<03549>>54496000
         SETBIT(DATA'LOST'MAP,I)   << SHUCKS, WE LOST IT >>    <<03549>>54498000
                                                               <<03549>>54500000
      ELSE                                                     <<03549>>54502000
         CLEARBIT(DATA'LOST'MAP,I);    << STILL HAVE IT >>     <<03549>>54504000
                                                               <<03549>>54506000
      << WRITE THE DATA INTO THE RESERVED AREA >>              <<03549>>54508000
                                                               <<03549>>54510000
      DISC(WRITE,LDEV,RESERVED+DOUBLE(I),BUFF,128);            <<03549>>54512000
      END;                                                     <<03549>>54514000
   END                                                         <<03549>>54516000
                                                               <<03549>>54518000
ELSE             << COULDN'T GET ANY RESERVED AREA, SO >>      <<03549>>54520000
   BEGIN         << MARK DATA AS LOST                  >>      <<03549>>54522000
   I := -1;                                                    <<03549>>54524000
   WHILE (I:=I+1) < AFFECT'AREA'LEN DO                         <<03549>>54526000
      SETBIT(DATA'LOST'MAP,I);                                 <<03549>>54528000
   ANY'SAVED := FALSE;    << NO DATA WAS SAVED >>              <<03549>>54530000
   END;                                                        <<03549>>54532000
                                                               <<03549>>54534000
<< NOW SPARE NOT RETAINING DATA >>                             <<03549>>54536000
                                                               <<03549>>54538000
DISC(SPARE'NO'RETAIN,LDEV,AFFECT'AREA,AFFECTS,5);              <<03549>>54540000
                                                               <<03549>>54542000
<< SEE IF THE SPARED AREA IS GOOD BY DOING A       >>          <<03549>>54544000
<< READ/WRITE ERROR RATE TEST ON THE AFFECTED AREA.>>          <<03549>>54546000
<< IF TEST FAILS, DO SPARE NOT RETAINING DATA      >>          <<03549>>54548000
<< UNTIL WE PASS THE TEST                          >>          <<03549>>54550000
                                                               <<03549>>54552000
SUCCESS := FALSE;                                              <<03549>>54554000
WHILE NOT SUCCESS DO                                           <<03549>>54556000
   BEGIN                                                       <<03549>>54558000
                                                               <<03549>>54560000
   << DO READ/WRITE ERROR RATE TEST >>                         <<03549>>54562000
                                                               <<03549>>54564000
   DISC(RW'ERT,LDEV,AFFECT'AREA,DUMMY,AFFECT'AREA'LEN);        <<03549>>54566000
                                                               <<03549>>54568000
   IF <> THEN      << SPARE NOT RETAINING DATA AGAIN >>        <<03549>>54570000
      DISC(SPARE'NO'RETAIN,LDEV,AFFECT'AREA,AFFECTS,5)         <<03549>>54572000
                                                               <<03549>>54574000
   ELSE                                                        <<03549>>54576000
      SUCCESS := TRUE;     << FOUND A GOOD TRACK >>            <<03549>>54578000
                                                               <<03549>>54580000
   END;                                                        <<03549>>54582000
                                                               <<03549>>54584000
<< NOW COPY THE SAVED DATA BACK TO ITS ORIGINAL LOCATION >>    <<03549>>54586000
                                                               <<03549>>54588000
IF ANY'SAVED THEN    << IF ANY DATA WAS SAVED >>               <<03549>>54590000
   BEGIN                                                       <<03549>>54592000
   I := -1;                                                    <<03549>>54594000
   WHILE (I:=I+1) < AFFECT'AREA'LEN DO                         <<03549>>54596000
      BEGIN                                                    <<03549>>54598000
                                                               <<03549>>54600000
      << ATTEMPT TO READ THE DATA BACK FROM THE RESERVED >>    <<03549>>54602000
      << AREA.  IF WE CAN'T GET IT BACK, THEN MARK THE   >>    <<03549>>54604000
      << DATA AS LOST.                                   >>    <<03549>>54606000
                                                               <<03549>>54608000
      DISC(RECOV'READ,LDEV,RESERVED+DOUBLE(I),BUFF,128);       <<03549>>54610000
      IF <> THEN                                               <<03549>>54612000
         SETBIT(DATA'LOST'MAP,I);   << WE LOST IT >>           <<03549>>54614000
                                                               <<03549>>54616000
      DISC(WRITE,LDEV,AFFECT'AREA+DOUBLE(I),BUFF,128);         <<03549>>54618000
      END;                                                     <<03549>>54620000
   << RELEASE SPACE IN THE RESERVED AREA >>                    <<03549>>54622000
                                                               <<03549>>54624000
   RELEASE'RESERVED(RESERVED,AFFECT'AREA'LEN);                 <<03549>>54626000
   END;                                                        <<03549>>54628000
END;   << CS80'SPARE >>                                        <<03549>>54630000
$CONTROL SEGMENT=DEFECTRACKS                                   <<03549>>54632000
        <<----------------------------------------->>          <<03549>>54634000
        << PROCESS SUSPECT SECTORS ON A CS'80 DISC >>          <<03549>>54636000
        <<----------------------------------------->>          <<03549>>54638000
PROCEDURE CS80'DEFECTS( LDEV,DSCT);                            <<03549>>54640000
VALUE LDEV;                                                    <<03549>>54642000
INTEGER                                                        <<03549>>54644000
   LDEV;      << LOGICAL DEVICE NO. >>                         <<03549>>54646000
INTEGER ARRAY                                                  <<03549>>54648000
   DSCT;      << DEFECTIVE SECTOR TABLE >>                     <<03549>>54650000
                                                               <<03549>>54652000
COMMENT                                                        <<03549>>54654000
CS80'DEFECTS PROCESSES ALL DEFECTIVE SECTOR ENTRIES CURRENTLY  <<03549>>54656000
IN THE DSCT ON A GIVEN LDEV.  IT FIRST PERFORMS A DIAGNOSTIC   <<03549>>54658000
ON THE DISC TO SEE IF THE HARDWARE IS OK. THEN IT ATTEMPTS TO  <<03549>>54660000
RECOVER THE DATA ON THE SECTOR.  IT THEN PERFORMS A READ/WRITE <<03549>>54662000
ERROR RATE TEST ON THE SECTOR.  IF ANY PROBLEMS SHOW UP, IT    <<03549>>54664000
CALLS CS80'SPARE TO SPARE THE SECTOR.  THEN THE SAVED DATA IS  <<03549>>54666000
WRITTEN BACK TO THE SECTOR, AND THE DSCT ENTRY REMOVED.  THIS  <<03549>>54668000
PROCEDURE ALSO PRINTS MESSAGES TELLING WHERE DATA WAS LOST     <<03549>>54670000
AND WARNS THE USER IF THE DATA WAS ON ANY SPECIAL AREA OF THE  <<03549>>54672000
DISC--THE DIRECTORY, VIRTUAL MEMORY, THE RESERVED AREA, THE    <<03549>>54674000
SYSTEM AREA.  IF DATA MAY HAVE BEEN LOST IN A FILE, A          <<03549>>54676000
RECOVER LOST DISC SPACE MUST BE PERFORMED.                     <<03549>>54678000
;                                                              <<03549>>54680000
BEGIN                                                          <<03549>>54682000
EQUATE                                                         <<03549>>54684000
   DIAGNOSTIC   = 22,   << RUN INTERNAL DIAGNOSTIC >>          <<03549>>54686000
   RECOV'READ   = 14,   << READ TO RECOVER DATA >>             <<03549>>54688000
   RW'ERT       = 18;   << READ/WRITE ERROR RATE TEST >>       <<03549>>54690000
DOUBLE                                                         <<03549>>54692000
   DISC'ADDRESS,   << DISC ADDRESS--CURRENT DSCT ENTRY >>      <<03549>>54694000
   DUMMY,                                                      <<03549>>54696000
   AFFECT'AREA,         << STARTING DISC ADDRESS OF AREA >>    <<03714>>54698000
                        <<    AFFECTED BY SPARE          >>    <<03714>>54700000
   FSECT,               <<STARTING SECTOR OF LOST DATA AREA>>  <<03714>>54702000
   LSECT;               <<ENDING SECTOR OF LOST DATA AREA>>    <<03714>>54704000
INTEGER                                                        <<03549>>54706000
   AFFECT'AREA'LEN,     << LENGTH OF THE SPARE AREA >>         <<03549>>54708000
                        <<    IN SECTORS            >>         <<03549>>54710000
   OLD'NREASS,          << STARTING NO. OF BAD DISC AREAS >>   <<03714>>54712000
   CUR'BIT,             << CURRENT BIT IN BIT MAP >>           <<03549>>54714000
   SIZE,                << CURRENT SIZE OF AREA IN BIT MAP >>  <<03549>>54716000
   NEXT'BIT;            << TEMP >>                             <<03549>>54718000
LOGICAL                                                        <<03549>>54720000
   SECTORLOST;          << IF TRUE, THE SECTOR'S DATA WAS  >>  <<03549>>54722000
                        <<    LOST                         >>  <<03714>>54724000
BYTE ARRAY                                                     <<03714>>54726000
   STRINGA(0:13),       << FOR ASCII DISC ADDRESS >>           <<03714>>54728000
   STRINGB(0:13);       << FOR ASCII DISC ADDRESS >>           <<03714>>54730000
INTEGER ARRAY                                                  <<03549>>54732000
   DATA'LOST'MAP(0:19), << BIT MAP FOR DISC SECTORS WHICH  >>  <<03549>>54734000
                        << LOST DATA                       >>  <<03549>>54736000
   BUFF(0:127);         << BUFFER TO SAVE SECTOR'S DATA >>     <<03549>>54738000
                                                               <<03549>>54740000
IF GET'DSCT'ENTRY(DSCT,DISC'ADDRESS) THEN                      <<03549>>54742000
   BEGIN            << THERE ARE ENTRIES IN THE DSCT >>        <<03549>>54744000
   BLANKLINE;                                                  <<03549>>54746000
   MESSAGE(M2500,LDEV);                                        <<03549>>54748000
                                                               <<03549>>54750000
   << RUN DIAGNOSTIC ON DISC BEFORE DOING ANY SPARES.  IF  >>  <<03549>>54752000
   << THE DIAGNOSTIC FAILS, WE NEVER RETURN (INITIAL DIES) >>  <<03549>>54754000
                                                               <<03549>>54756000
   DISC(DIAGNOSTIC,LDEV,0D,DUMMY,1);                           <<03549>>54758000
                                                               <<03549>>54760000
   << PROCESS ALL DEFECTIVE SECTOR ENTRIES.  IF THERE IS NO >> <<03549>>54762000
   << MORE ROOM IN LIST OF AREAS WHICH LOST DATA, DON'T     >> <<03549>>54764000
   << CONTINUE PROCESSING DEFECTIVE SECTORS.                >> <<03549>>54766000
                                                               <<03549>>54768000
   WHILE GET'DSCT'ENTRY(DSCT,DISC'ADDRESS) AND                 <<03549>>54770000
         NREASS < MAX'REASS DO                                 <<03549>>54772000
                                                               <<03549>>54774000
      BEGIN                                                    <<03549>>54776000
      OLD'NREASS := NREASS;   << SAVE CURRENT NREASS >>        <<03714>>54778000
                                                               <<03714>>54780000
      SECTORLOST := FALSE;                                     <<03549>>54782000
      AFFECT'AREA := DISC'ADDRESS;   << INIT. AFFECTED AREA >> <<03549>>54784000
      AFFECT'AREA'LEN := 1;          << TO JUST ONE SECTOR  >> <<03549>>54786000
                                                               <<03549>>54788000
      << TRY TO RECOVER THE SECTOR AT DISC'ADDRESS >>          <<03549>>54790000
                                                               <<03549>>54792000
      DISC(RECOV'READ,LDEV,DISC'ADDRESS,BUFF,128);             <<03549>>54794000
                                                               <<03549>>54796000
      IF <> THEN                                               <<03549>>54798000
         SECTORLOST := TRUE;     << LOST THE SECTOR >>         <<03549>>54800000
                                                               <<03549>>54802000
      << RUN READ/WRITE ERROR RATE TEST ON SECTOR TO >>        <<03549>>54804000
      << SEE IF IT'S REALLY BAD                      >>        <<03549>>54806000
                                                               <<03549>>54808000
      DISC(RW'ERT,LDEV,DISC'ADDRESS,DUMMY,1);                  <<03549>>54810000
      IF <> THEN                                               <<03549>>54812000
                                                               <<03549>>54814000
         << ERT FAILED, CALL CS80'SPARE TO DO SPARING >>       <<03549>>54816000
                                                               <<03549>>54818000
         CS80'SPARE(LDEV,DISC'ADDRESS,AFFECT'AREA,             <<03549>>54820000
                    AFFECT'AREA'LEN,DATA'LOST'MAP);            <<03549>>54822000
                                                               <<03549>>54824000
      << WRITE BACK WHATEVER DATA WAS SAVED >>                 <<03549>>54826000
                                                               <<03549>>54828000
      DISC(WRITE,LDEV,DISC'ADDRESS,BUFF,128);                  <<03549>>54830000
                                                               <<03549>>54832000
      REMOVE'DSCT'ENTRY(DSCT);    << REMOVE THE DSCT ENTRY >>  <<03549>>54834000
                                                               <<03549>>54836000
      << POST THE DSCT TO DISC AFTER EACH SUSPECT SECTOR >>    <<03549>>54838000
      << IS PROCESSED AND REMOVED.                       >>    <<03549>>54840000
                                                               <<03549>>54842000
      DISC(WRITE,LDEV,1D,DSCT,128);                            <<03549>>54844000
                                                               <<03549>>54846000
      CUR'BIT := INTEGER(DISC'ADDRESS-AFFECT'AREA);            <<03549>>54848000
                                                               <<03549>>54850000
      IF SECTORLOST THEN      << SET BIT IN MAP IF DATA >>     <<03549>>54852000
         SETBIT(DATA'LOST'MAP,CUR'BIT)     << WAS LOST  >>     <<03549>>54854000
                                                               <<03549>>54856000
      ELSE                           << OTHERWISE, CLEAR >>    <<03549>>54858000
         CLEARBIT(DATA'LOST'MAP,CUR'BIT);     << THE BIT >>    <<03549>>54860000
                                                               <<03549>>54862000
      << NOW PRINT OUT ALL AREAS OF DISC WHICH LOST DATA >>    <<03549>>54864000
                                                               <<03549>>54866000
      NEXT'BIT := 0;                                           <<03672>>54868000
      WHILE FIND'NEXT'BIT'AREA(DATA'LOST'MAP,AFFECT'AREA'LEN,  <<03549>>54870000
                   CUR'BIT,SIZE,NEXT'BIT,TRUE) DO              <<03549>>54872000
         BEGIN                                                 <<03549>>54874000
                                                               <<03714>>54876000
         IF NOT RELOAD THEN                                    <<03714>>54878000
            BEGIN                                              <<03714>>54880000
                                                               <<03714>>54882000
            << TRY TO ADD THIS AREA TO THE LIST OF DISC >>     <<03714>>54884000
            << AREAS WHICH LOST DATA.                   >>     <<03714>>54886000
                                                               <<03714>>54888000
            NREASS := NREASS + 1;                              <<03714>>54890000
            IF NOT ADD'AREA(REASSIGNED,NREASS,MAX'REASS+1,     <<03714>>54892000
                            LDEV,AFFECT'AREA+DOUBLE(CUR'BIT),  <<03714>>54894000
                            DOUBLE(SIZE)) THEN                 <<03714>>54896000
                                                               <<03714>>54898000
               BEGIN                                           <<03714>>54900000
                                                               <<03714>>54902000
               << NO MORE ROOM IN LIST--BACK UP TO THE FIRST >><<03714>>54904000
               << ENTRY IN THIS SERIES AND WRITE AN ENTRY    >><<03714>>54906000
               << FOR THE ENTIRE AFFECTED AREA.  REMOVE ALL  >><<03714>>54908000
               << OTHER ENTRIES WRITTEN FOR THIS AREA.       >><<03714>>54910000
                                                               <<03714>>54912000
               NREASS := OLD'NREASS + 1;                       <<03714>>54914000
               ADD'AREA(REASSIGNED,NREASS,MAX'REASS+1,         <<SPFIX>>54916000
                        LDEV,AFFECT'AREA,                      <<03714>>54918000
                        DOUBLE(AFFECT'AREA'LEN));              <<03714>>54920000
                                                               <<03714>>54922000
               CUR'BIT := 0;                                   <<03714>>54924000
               SIZE := AFFECT'AREA'LEN;                        <<03714>>54926000
               NEXT'BIT := AFFECT'AREA'LEN;   << GET OUT OF >> <<03714>>54928000
                                              <<  THE LOOP  >> <<03714>>54930000
               END;                                            <<03714>>54932000
            END;   << IF NOT RELOAD >>                         <<03714>>54934000
                                                               <<03714>>54936000
         << PRINT MESSAGE:  DATA LOST DURING SPARE    >>       <<03714>>54938000
         << (INCLUDES LDEV, SECTOR RANGE)             >>       <<03714>>54940000
                                                               <<03714>>54942000
         FSECT := AFFECT'AREA + DOUBLE(CUR'BIT);               <<03714>>54944000
         LSECT := AFFECT'AREA + DOUBLE(CUR'BIT) +              <<03714>>54946000
                  DOUBLE(SIZE) - 1D;                           <<03714>>54948000
         STRINGA(1) := "%";                                    <<03714>>54950000
         STRINGB(1) := "%";                                    <<03714>>54952000
         STRINGA(0) := LDNTOA(FSECT, 8, STRINGA(2)) + 1;       <<03714>>54954000
         STRINGB(0) := LDNTOA(LSECT, 8, STRINGB(2)) + 1;       <<03714>>54956000
         MESSAGE(M501, LDEV,,,, STRINGA, STRINGB);             <<03714>>54958000
                                                               <<03714>>54960000
         << PRINT WARNING MESSAGES IF THE LOST DATA WAS >>     <<03714>>54962000
         << ON ANY SPECIAL AREAS OF THE DISC            >>     <<03714>>54964000
                                                               <<03714>>54966000
         WARN'DISC'ZAPPED(LDEV, FSECT, LSECT);                 <<03714>>54968000
         BLANKLINE;                                            <<03714>>54970000
                                                               <<03714>>54972000
         << CHECK TO SEE IF THE DATA WAS LOST IN AN AREA >>    <<03714>>54974000
         << OF THE DISC WHICH WILL REQUIRE RECOVER LOST  >>    <<03714>>54976000
         << DISC SPACE                                   >>    <<03714>>54978000
                                                               <<03714>>54980000
         IF RECOVERY'NEEDED(LDEV, FSECT, LSECT) THEN           <<03714>>54982000
            RECOVERY := TRUE;     << SET RECOVERY FLAG >>      <<03714>>54984000
                                                               <<03714>>54986000
         END;                                                  <<03714>>54988000
      END;   << WHILE MORE DEFECTIVE SECTORS >>                <<03714>>54990000
                                                               <<03549>>54992000
   << IF OVERFLOWED LIST OF AREAS WHICH LOST DATA, >>          <<03714>>54994000
   << PRINT MESSAGE "NO MORE SPARING ALLOWED THIS  >>          <<03714>>54996000
   << BOOT"                                        >>          <<03714>>54998000
                                                               <<03714>>55000000
   IF NREASS >= MAX'REASS THEN                                 <<03714>>55002000
      MESSAGE(M500);                                           <<03714>>55004000
                                                               <<03549>>55006000
   MESSAGE(M2501,LDEV);     << SPARING COMPLETED ON >>         <<03549>>55008000
                            <<    THIS LDEV         >>         <<03549>>55010000
   END;  << IF ANY DEFECTIVE SECTORS >>                        <<03549>>55012000
END;   << CS80'DEFECTS >>                                      <<03549>>55014000
                                                                        55016000
$CONTROL SEGMENT=SETUP                                         <<03549>>55018000
          <<-----------------------------------------                   55020000
            WRITE DEFAULT CONFIGURATION TABLE TO DISC                   55022000
          ----------------------------------------->>                   55024000
  PROCEDURE WRITEDEFFILE(TABSIZE,RECNUM,LOC,INDEX);            <<t8392>>55026000
    VALUE TABSIZE,RECNUM,INDEX;                                <<t8392>>55028000
    INTEGER TABSIZE,          <<TABLE SIZE>>                   <<t8392>>55030000
            INDEX;            <<INDEX IN INFO TABLE>>          <<t8392>>55032000
    DOUBLE RECNUM;            <<RECORD # IN CONFIGURATION FILE><<t8392>>55034000
    ARRAY LOC;                <<DATA BUFFER>>                  <<t8392>>55036000
    COMMENT                                                    <<t8392>>55038000
      WRITES THE TABLE LOOKUP BUFFER TO THE DEFDATA FILE       <<t8392>>55040000
   AND UPDATES THE DISC ADDRESS IN THE INFO TABLE;             <<t8392>>55042000
      BEGIN                                                    <<t8392>>55044000
          FWRITE(DEFFNUM,RECNUM,LOC,TABSIZE); <<WRITE TO FILE>><<t8392>>55046000
          TOS := DTEMP + RECNUM; <<DISC ADDRESS>>              <<t8392>>55048000
          TABLEINFO(INDEX+4) := TOS; << LOW ORDER >>           <<t8392>>55050000
          TABLEINFO(INDEX+3) := TOS; << HIGH ORDER >>          <<t8392>>55052000
      END <<WRITEDEFFILE>> ;                                   <<t8392>>55054000
                                                               <<t8392>>55056000
          <<-----------------------------------                         55058000
            WRITE CONFIGURATION TABLE TO DISC                           55060000
          ----------------------------------->>                         55062000
  PROCEDURE WRITECONFTABLE(TABSIZE,RECNUM,LOC,INDEX);                   55064000
    VALUE TABSIZE,RECNUM,INDEX;                                         55066000
    INTEGER TABSIZE,          <<TABLE SIZE>>                            55068000
            INDEX;            <<INDEX IN INFO TABLE>>                   55070000
    DOUBLE RECNUM;            <<RECORD # IN CONFIGURATION FILE>>        55072000
    ARRAY LOC;                <<DATA BUFFER>>                           55074000
    COMMENT                                                             55076000
      WRITES THE SPECIFIED CONFIGURATION TABLE TO THE CONFDATA FILE     55078000
   AND UPDATES THE DISC ADDRESS IN THE INFO TABLE;             <<01683>>55080000
      BEGIN                                                             55082000
          FWRITE(CTABFNUM,RECNUM,LOC,TABSIZE); <<WRITE TO FILE>>        55084000
          TOS := DTEMP + RECNUM; <<DISC ADDRESS>>                       55086000
          TABLEINFO(INDEX+4) := TOS; << LOW ORDER >>                    55088000
          TABLEINFO(INDEX+3) := TOS; << HIGH ORDER >>                   55090000
      END <<WRITECONFTABLE>> ;                                          55092000
PROCEDURE WRITEDEVFILE( TABLENR, BUF, LENGTH, INFOX);          <<DEVCO>>55094000
   VALUE TABLENR, LENGTH, INFOX;                               <<DEVCO>>55096000
   INTEGER TABLENR, LENGTH, INFOX;                             <<DEVCO>>55098000
   INTEGER ARRAY BUF;                                          <<DEVCO>>55100000
BEGIN                                                          <<DEVCO>>55102000
   INTEGER INX;                                                <<DEVCO>>55104000
   DOUBLE DISCADR;                                                      55106000
   INTEGER DISCADR1 = DISCADR,                                          55108000
           DISCADR2 = DISCADR+1;                                        55110000
                                                               <<DEVCO>>55112000
   INX := DEVTABENTRIES + TABLENR*2;                           <<DEVCO>>55114000
   DEVREC0(INX) := DEVNEXT;                                    <<DEVCO>>55116000
   DEVREC0(INX+1) := LENGTH;                                   <<DEVCO>>55118000
   FWRITE( DEVFNUM, DOUBLE(DEVNEXT), BUF, LENGTH);             <<DEVCO>>55120000
   DISCADR := DEVFILEADR+DOUBLE(DEVNEXT);                               55122000
   TABLEINFO(INFOX+3) := DISCADR1;                                      55124000
   TABLEINFO(INFOX+4) := DISCADR2;                                      55126000
   DEVNEXT := DEVNEXT + (LENGTH+127)/128;                      <<DEVCO>>55128000
END;                                                           <<DEVCO>>55130000
PROCEDURE READDEVFILE( TABLENR, BUF, LENGTH);                  <<DEVCO>>55132000
   VALUE TABLENR;                                              <<DEVCO>>55134000
   INTEGER TABLENR, LENGTH;                                    <<DEVCO>>55136000
   INTEGER ARRAY BUF;                                          <<DEVCO>>55138000
BEGIN                                                          <<DEVCO>>55140000
   INTEGER INX;                                                <<DEVCO>>55142000
                                                               <<DEVCO>>55144000
   INX := DEVTABENTRIES + TABLENR*2;                           <<DEVCO>>55146000
   LENGTH := DEVREC0(INX+1);                                   <<DEVCO>>55148000
   FREAD( DEVFNUM, DOUBLE(DEVREC0(INX)), BUF, LENGTH);         <<DEVCO>>55150000
END;                                                           <<DEVCO>>55152000
   <<-------------------------------->>                                 55154000
   <<   WRITE DEVICE TABLE TO DISC   >>                                 55156000
   <<-------------------------------->>                                 55158000
                                                                        55160000
PROCEDURE WRITEDEVTABLE( MAXSIZE, LOC, INDEX, TABSIZE);                 55162000
   VALUE MAXSIZE, INDEX, TABSIZE;                                       55164000
   INTEGER MAXSIZE, INDEX, TABSIZE;                                     55166000
   ARRAY LOC;                                                           55168000
BEGIN COMMENT                                                           55170000
                                                                        55172000
   WRITES THE SPECIFIED DEVICE TABLE TO DISC.  IF THIS IS               55174000
   A TAPE COLD LOAD, ENOUGH DISC SPACE FOR THE SPECIFIED                55176000
   SIZE OF THE TABLE IS FIRST OBTAINED;                                 55178000
                                                                        55180000
   DOUBLE                                                               55182000
      DSIZE;                                                            55184000
   DOUBLE POINTER                                                       55186000
      DISCADR;                                                          55188000
                                                                        55190000
   @DISCADR := @TABLEINFO(INDEX+3);                                     55192000
   IF LOADFROMTAPE THEN                                                 55194000
      BEGIN   << GET DISC SPACE FOR TABLE >>                            55196000
      DSIZE := D'L((MAXSIZE+127)&LSR(7)));                              55198000
      SUPERDISCSPACE(-SYSDISC,1,0,DSIZE,DISCADR);                       55200000
      IF <> THEN ERRMESSAGE( M326, SYSDISC); <<OUT DISC>>               55202000
      TOS := DISCADR;                                                   55204000
      BS1 := 0;  << ZERO VOLUME INDEX >>                                55206000
      DISCADR := TOS;                                                   55208000
      END;                                                              55210000
   DISC( WRITE, SYSDISC, DISCADR, LOC, TABSIZE);                        55212000
END;                                                                    55214000
PROCEDURE SAVE'TABLE'ADDR( TABSIZE, LOC, INDEX);                        55216000
   VALUE TABSIZE, INDEX;                                                55218000
   ARRAY LOC;                                                           55220000
   INTEGER TABSIZE, INDEX;                                              55222000
BEGIN COMMENT                                                           55224000
                                                                        55226000
   THIS PROCEDURE RECORDS THE SIZE AND LOCATION                         55228000
   OF TABLES INTO THE COLD LOAD INFORMATION TABLE;                      55230000
                                                                        55232000
   TABLEINFO(INDEX) := TABSIZE;                                         55234000
   PUSH( DB );                                                          55236000
   TOS := TOS + @LOC; << ABS ADR OF THE TABLE >>                        55238000
   TABLEINFO(INDEX+2) := TOS; << LOW ORDER >>                           55240000
   TABLEINFO(INDEX+1) := TOS; << HIGH ORDER >>                          55242000
END; << SAVE'TABLE'ADDR >>                                              55244000
                                                                        55246000
          <<-------------------                                         55248000
            READ DEVICE TABLE                                           55250000
          ------------------->>                                         55252000
  PROCEDURE READTABLE(RECORD,BUF,WORDS);                                55254000
    VALUE WORDS;                                                        55256000
    DOUBLE RECORD;                                                      55258000
    ARRAY BUF;                                                          55260000
    INTEGER WORDS;                                                      55262000
      BEGIN                                                             55264000
          TOS := 0;  <<LOGICAL DEVICE # UNKNOWN>>                       55266000
          TOS := SYSDISCDRT;                                   <<*DVR*>>55268000
          TOS := 0;          << SYSTEM DISC ALWAYS UNIT 0>>    <<*DVR*>>55270000
          TOS := SYSDISCSUBTYPE;                                        55272000
          TOS := READ;                                                  55274000
          TOS := RECORD;                                                55276000
          PUSH(DB);                                                     55278000
          TOS := TOS+@BUF;                                              55280000
          TOS := WORDS;                                                 55282000
          IF SYSDISCTYPE=FHDISCTYPE THEN                       <<*LDT*>>55284000
            TOS := @FHDISC                                     <<*LDT*>>55286000
          ELSE                                                 <<*LDT*>>55288000
            IF SYSDISCTYPE=MHDISCTYPE THEN                     <<*LDT*>>55290000
              IF SYSDISCSUBTYPE < 4 THEN                       <<*LDT*>>55292000
                TOS := @MHDISC                                 <<*LDT*>>55294000
              ELSE                                             <<*LDT*>>55296000
                IF SYSDISCSUBTYPE < NMHSUBTYPES THEN           <<*LDT*>>55298000
                  TOS:=@MH7905                                 <<*LDT*>>55300000
                ELSE ERRMESSAGE(M126,0)                        <<*LDT*>>55302000
            ELSE                                               <<*LDT*>>55304000
              IF SYSDISCTYPE = 3 << CS80 DEVICE >> THEN        <<*LDT*>>55306000
                TOS := @CS80'DRIVER                            <<*LDT*>>55308000
              ELSE ERRMESSAGE( M126);                          <<*LDT*>>55310000
          ASSEMBLE(PCAL 0);                                             55312000
      END <<READTABLE>> ;                                               55314000
           <<---------------------->>                          <<03550>>55316000
           <<   ZERO A BUFFER      >>                          <<03550>>55318000
           <<---------------------->>                          <<03550>>55320000
PROCEDURE ZEROBUF( BUF, LEN);                                  <<03550>>55322000
VALUE LEN;                                                     <<03550>>55324000
ARRAY BUF;     << BUFFER TO BE ZEROED >>                       <<03550>>55326000
INTEGER LEN;   << LENGTH TO ZERO      >>                       <<03550>>55328000
COMMENT                                                        <<03550>>55330000
ZEROES A LOGICAL ARRAY FOR THE SPECIFIED LENGTH                <<03550>>55332000
(IN WORDS).                                                    <<03550>>55334000
;                                                              <<03550>>55336000
BEGIN                                                          <<03550>>55338000
IF LEN > 0 THEN         << IF LENGTH <= 0 DON'T   >>           <<03550>>55340000
   BEGIN                <<     DO ANYTHING        >>           <<03550>>55342000
   BUF := 0;            << OTHERWISE, ZERO IT OUT >>           <<03550>>55344000
   MOVE BUF(1) := BUF,(LEN-1);                                 <<03550>>55346000
   END;                                                        <<03550>>55348000
END;     << ZEROBUF >>                                         <<03550>>55350000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>55352000
          <<-----------------------------                               55354000
            MAKE SIO PROGRAM READ ENTRY                                 55356000
          ----------------------------->>                               55358000
PROCEDURE SIOREADENT( DISCADR, COREADR, SIZE);                 <<02510>>55360000
   VALUE DISCADR, COREADR, SIZE;                               <<02510>>55362000
   DOUBLE DISCADR, COREADR;                                    <<02510>>55364000
   INTEGER SIZE;                                               <<02510>>55366000
BEGIN                                                          <<02510>>55368000
   ENTRY SIOREADENT'; << THIS ENTRY POINT IS USED FOR THE >>   <<02510>>55370000
                      << MICROCODE COLD LOAD READ BECAUSE >>   <<02510>>55372000
                      << ONLY SIX WORDS HAVE BEEN         >>   <<02510>>55374000
                      << ALLOCATED IN THE DISC LABEL      >>   <<02510>>55376000
   EQUATE ARCPTRK = 32;  << ARCS PER TRACK >>                  <<02510>>55378000
   INTEGER ARRAY SCTPERHEAD(0:NMHSUBTYPES-1) = PB :=           <<02510>>55380000
      24,24,24,23,48,48,48,48,64,48,48,48;                     <<02510>>55382000
   INTEGER ARRAY HDBASE(0:NMHSUBTYPES-1) = PB :=               <<02510>>55384000
      0,2,0,0,0,2,0,0,0,0,0,2,0;                               <<02510>>55386000
   INTEGER ARRAY SECPERCYL(4:NMHSUBTYPES-1) = PB :=            <<02510>>55388000
      96,48,144,240,576,96,96,192,64;                          <<02510>>55390000
   INTEGER ARRAY FILEMASK(4:NMHSUBTYPES-1)=PB :=               <<02510>>55392000
      %7406,%7405,%7407,%7407,%7407,%7407,%7406,%7406,         <<02510>>55394000
      %7407,%7400;                                             <<02510>>55396000
   INTEGER ARRAY DISCIOPROG(0:15) = PB :=                      <<02510>>55398000
       %40000,  %1200,                                         <<02510>>55400000
       %14000,      0,                                         <<02510>>55402000
       %67776,      0,                                         <<02510>>55404000
       %40000,      0,                                         <<02510>>55406000
       %40000,  %6000,                                         <<02510>>55408000
       %67776,      0,                                         <<02510>>55410000
       %40000,  %2400;                                         <<03716>>55412000
   INTEGER                                                     <<02510>>55414000
      MAXREAD, << END-OF-CYL CHECK, BECAUSE OF SPLIT DISCS >>  <<02510>>55416000
      NRSECTS,                                                 <<02510>>55418000
      REM,                                                     <<02510>>55420000
      LEN,                                                     <<02510>>55422000
      BANK    = COREADR,                                       <<02510>>55424000
      ADDRESS = COREADR+1;                                     <<02510>>55426000
   LOGICAL                                                     <<02510>>55428000
      FLAG := TRUE; << ENTRY POINT FLAG >>                     <<02510>>55430000
                                                               <<02510>>55432000
   SUBROUTINE READ( WORDS);                                    <<02510>>55434000
      VALUE WORDS;                                             <<02510>>55436000
      INTEGER WORDS;                                           <<02510>>55438000
   BEGIN                                                       <<02510>>55440000
      IF NOT FLAG THEN                                         <<03716>>55442000
         BEGIN                                                 <<03716>>55444000
         SIOPNTR := %14000; << SET BANK INSTRUCTION >>         <<03716>>55446000
         SIOPNTR(1) := BANK;                                   <<03716>>55448000
         @SIOPNTR := @SIOPNTR+2;                               <<03716>>55450000
         END;                                                  <<03716>>55452000
      WHILE WORDS > 0 DO                                       <<02510>>55454000
         BEGIN                                                 <<02510>>55456000
         LEN := IF WORDS > 4096 THEN 4096 ELSE WORDS;          <<02510>>55458000
         SIOPNTR := -LEN;                                      <<02510>>55460000
         SIOPNTR(1) := ADDRESS;                                <<02510>>55462000
         @SIOPNTR := @SIOPNTR+2;                               <<02510>>55464000
         ADDRESS := ADDRESS+LEN;                               <<02510>>55466000
         WORDS := WORDS-LEN;                                   <<02510>>55468000
         END;                                                  <<02510>>55470000
      SIOPNTR(-2).(0:1) := 0; << STOP CHAIN >>                 <<02510>>55472000
   END;                                                        <<02510>>55474000
   FLAG := FALSE;                                              <<02510>>55476000
SIOREADENT':                                                   <<02510>>55478000
   IF SYSDISCTYPE = FHDISCTYPE THEN                            <<02510>>55480000
      BEGIN   << FIXED HEAD DISC >>                            <<02510>>55482000
      TOS := DISCADR;                                          <<02510>>55484000
      TOS := ARCPTRK;                                          <<02510>>55486000
      ASSEMBLE( LDIV );                                        <<02510>>55488000
      SIOPNTR := SIOCNTRL LOR TOS; << ARC # >>                 <<02510>>55490000
      SIOPNTR(1) := TOS;    << TRACK >>                        <<02510>>55492000
      @SIOPNTR := @SIOPNTR+2;                                  <<02510>>55494000
      READ( SIZE);                                             <<02510>>55496000
      END                                                      <<02510>>55498000
   ELSE                                                        <<02510>>55500000
      BEGIN   << MOVING HEAD DISC >>                           <<02510>>55502000
      IF SYSDISCSUBTYPE <= 3 OR FLAG THEN                      <<02510>>55504000
         BEGIN                                                 <<02510>>55506000
         TOS := DISCADR;                                       <<02510>>55508000
         TOS := SCTPERHEAD(SYSDISCSUBTYPE);                    <<02510>>55510000
         ASSEMBLE( LDIV, XCH );                                <<02510>>55512000
         TOS := (TOS+HDBASE(X))&LSL(6); << HEAD NR. >>         <<02510>>55514000
         ASSEMBLE( OR );                                       <<02510>>55516000
         SIOPNTR := SIOCNTRL;                                  <<02510>>55518000
         SIOPNTR(1) := TOS; << HEAD AND SECTOR >>              <<02510>>55520000
         @SIOPNTR := @SIOPNTR+2;                               <<02510>>55522000
         READ( SIZE);                                          <<02510>>55524000
         END                                                   <<02510>>55526000
      ELSE                                                     <<02510>>55528000
         BEGIN  << 7905/7906/7920/7925 >>                      <<02510>>55530000
         WHILE SIZE > 0 DO                                     <<02510>>55532000
            BEGIN                                              <<02510>>55534000
            NRSECTS := (SIZE+127)/128;                         <<02510>>55536000
            TOS := DISCADR;                                    <<02510>>55538000
            TOS := SECPERCYL( SYSDISCSUBTYPE);                 <<02510>>55540000
            ASSEMBLE( LDIV, DELB );                            <<02510>>55542000
            REM := TOS;                                        <<02510>>55544000
            MAXREAD:=IF NRSECTS > SECPERCYL(SYSDISCSUBTYPE)-REM<<02510>>55546000
            THEN (SECPERCYL(SYSDISCSUBTYPE)-REM)*128 ELSE SIZE;<<02510>>55548000
            MOVE SIOPNTR := DISCIOPROG,(14),2;                 <<03716>>55550000
            SIOPNTR(5) := SIOPNTR(11) := SIOCOREADR+ADRBASE;   <<02510>>55552000
            SIOPNTR(7) := FILEMASK( SYSDISCSUBTYPE);           <<02510>>55554000
            @SIOPNTR := TOS;  << CAME FROM MOVE! >>            <<02510>>55556000
            READ( MAXREAD);                                    <<02510>>55558000
            TOS := L'PADR( SYSDISC, DISCADR);                  <<02510>>55560000
            BUF( ADRBASE+1) := TOS;                            <<02510>>55562000
            BUF( ADRBASE) := TOS;                              <<02510>>55564000
            ADRBASE := ADRBASE+2;                              <<02510>>55566000
            DISCADR := DISCADR+DOUBLE((MAXREAD+127)/128);      <<02510>>55568000
            SIZE := SIZE-MAXREAD;                              <<02510>>55570000
            END;                                               <<02510>>55572000
         END;                                                  <<02510>>55574000
      END;                                                     <<02510>>55576000
END;                                                           <<02510>>55578000
$IF   << ****** RETURNING TO COMMON CODE ******** >>           <<02510>>55580000
     << ------------------------------- >>                     <<02510>>55582000
     << MAKE CHANNEL PROGRAM READ ENTRY >>                     <<02510>>55584000
     << ------------------------------- >>                     <<02510>>55586000
PROCEDURE AMIGOREADENT( DISCADR, COREADR, SIZE);               <<02510>>55588000
   VALUE DISCADR, COREADR, SIZE;                               <<02510>>55590000
   DOUBLE DISCADR, COREADR;                                    <<02510>>55592000
   INTEGER SIZE;                                               <<02510>>55594000
BEGIN                                                          <<02510>>55596000
   INTEGER                                                     <<02510>>55598000
      MAXREAD,  << END-OF-CYL CHECK, BECAUSE OF SPLIT DISCS >> <<02510>>55600000
      NRSECTS,                                                 <<02510>>55602000
      REM;                                                     <<02510>>55604000
   INTEGER ARRAY SECPERCYL(4:NMHSUBTYPES-1) = PB :=            <<02510>>55606000
       96,48,144,144,240,576,96,96,192,64;                     <<02510>>55608000
   INTEGER ARRAY CHANIOPROG(0:27) = PB :=                      <<02510>>55610000
      <<  0 >>    %1000,0,                                     <<02510>>55612000
      <<  2 >>    %2010,6,0,0,0,                               <<02510>>55614000
      <<  7 >>    %1000,0,                                     <<02510>>55616000
      <<  9 >>    %2010,2,0,0,0,                               <<02510>>55618000
      << 14 >>    %1000,0,                                     <<02510>>55620000
      << 16 >>    %2010,2,0,0,0,                               <<02510>>55622000
      << 21 >>        0,0,                                     <<02510>>55624000
      << 23 >>    %1400,0,0,0,0;                               <<02510>>55626000
                                                               <<02510>>55628000
   WHILE SIZE > 0 DO                                           <<02510>>55630000
      BEGIN                                                    <<02510>>55632000
      NRSECTS := (SIZE+127)/128;                               <<02510>>55634000
      TOS := DISCADR;                                          <<02510>>55636000
      TOS := SECPERCYL(SYSDISCSUBTYPE);                        <<02510>>55638000
      ASSEMBLE( LDIV, DELB );                                  <<02510>>55640000
      REM := TOS;                                              <<02510>>55642000
      MAXREAD :=IF NRSECTS > SECPERCYL(SYSDISCSUBTYPE)-REM THEN<<02510>>55644000
         (SECPERCYL(SYSDISCSUBTYPE)-REM)*128 ELSE SIZE;        <<02510>>55646000
      MOVE SIOPNTR := CHANIOPROG,(28),2;                       <<02510>>55648000
      SIOPNTR(6) := %7100+ADRBASE;                             <<02510>>55650000
      IF SYSDISCSUBTYPE=S7910 THEN                             <<02510>>55652000
         BEGIN  << JUMP AROUND FILEMASK >>                     <<02510>>55654000
         SIOPNTR(7) := 0;                                      <<02510>>55656000
         SIOPNTR(8) := 7;                                      <<02510>>55658000
         END                                                   <<02510>>55660000
      ELSE                                                     <<02510>>55662000
         SIOPNTR(13) := %7276;                                 <<02510>>55664000
      SIOPNTR(20) := %7277;                                    <<02510>>55666000
      SIOPNTR(24) := MAXREAD&LSL(1);                           <<02510>>55668000
      TOS := COREADR;                                          <<02510>>55670000
      SIOPNTR(27) := TOS;                                      <<02510>>55672000
      SIOPNTR(26) := TOS;   << BANK >>                         <<02510>>55674000
      @SIOPNTR := TOS;   << CAME FROM MOVE! >>                 <<02510>>55676000
      BUF(ADRBASE) := %1000;                                   <<02510>>55678000
      TOS := L'PADR( SYSDISC, DISCADR);                        <<02510>>55680000
      BUF(ADRBASE+2) := TOS;                                   <<02510>>55682000
      BUF(X:=X-1) := TOS;                                      <<02510>>55684000
      ADRBASE := ADRBASE-3;                                    <<02510>>55686000
      DISCADR := DISCADR+D'L((MAXREAD+127)/128));              <<02510>>55688000
      COREADR := COREADR+D'L(MAXREAD));                        <<02510>>55690000
      SIZE := SIZE-MAXREAD;                                    <<02510>>55692000
      END;                                                     <<02510>>55694000
END;                                                           <<02510>>55696000
$IF    << ***** RETURNING TO COMMON CODE ******* >>            <<02510>>55698000
INTEGER PROCEDURE CALCULATECHECKSUM(TARGET,TARGETLEN,OLDCHECKSUM);      55700000
VALUE TARGET,TARGETLEN,OLDCHECKSUM;                            <<00888>>55702000
POINTER TARGET;                                                <<00888>>55704000
INTEGER TARGETLEN;                                             <<00888>>55706000
LOGICAL OLDCHECKSUM;                                           <<00888>>55708000
BEGIN                                                          <<00888>>55710000
<<USING THE VALUE OF OLDCHECKSUM AS A BASE, CALCULATE>>        <<00888>>55712000
<<THE CHECKSUM OF THE TARGET ARRAY AND RETURN IT IN>>          <<00888>>55714000
<<THE PROCEDURE RETURN VALUE.>>                                <<00888>>55716000
FOR XREG:=0 UNTIL TARGETLEN-1 DO                               <<00888>>55718000
   OLDCHECKSUM:=OLDCHECKSUM+TARGET(XREG);                      <<00888>>55720000
CALCULATECHECKSUM:=OLDCHECKSUM;                                <<00888>>55722000
END;  <<CALCULATECHECKSUM>>                                    <<00888>>55724000
         <<---------------------------------->>                <<03550>>55726000
         << BUILD CS'80 BOOT CHANNEL PROGRAM >>                <<03550>>55728000
         <<---------------------------------->>                <<03550>>55730000
PROCEDURE BUILD'CS80'BOOT( BOOT'FMT'TAB, CNT);                 <<03550>>55732000
VALUE BOOT'FMT'TAB, CNT;                                       <<03550>>55734000
INTEGER POINTER BOOT'FMT'TAB;  << POINTER TO TABLE OF >>       <<03550>>55736000
                               << DISC BOOT ADDRESSES >>       <<03550>>55738000
INTEGER CNT;   << NO. OF ENTRIES IN BOOT'FMT'TAB >>            <<03550>>55740000
BEGIN                                                          <<03550>>55742000
EQUATE                                                         <<03550>>55744000
   BASE1         =  %7100,                                     <<03550>>55746000
   BASE2         =  %2000;                                     <<03550>>55748000
EQUATE                                                         <<03550>>55750000
   ENTRY'SIZE    =  5,                                         <<03550>>55752000
   SEED          =  %123456;                                   <<03550>>55754000
DEFINE                                                         <<03550>>55756000
   DISCADR1      =  PNTR#,      << BOOT'FMT'TAB DEFINITION: >> <<03550>>55758000
   DISCADR2      =  PNTR(1)#,   << 5-WORD ENTRIES CONTAIN   >> <<03550>>55760000
   COREADR1      =  PNTR(2)#,   << DOUBLE-WORD DISC ADDRESS,>> <<03550>>55762000
   COREADR2      =  PNTR(3)#,   << DOUBLE-WORD CORE ADDRESS,>> <<03550>>55764000
   LENGTH        =  PNTR(4)#;   << LENGTH OF TABLE (WORDS)  >> <<03550>>55766000
INTEGER                                                        <<03550>>55768000
   CPSIZE,                                                     <<03550>>55770000
   BASE,                                                       <<03550>>55772000
   SIZE,                                                       <<03550>>55774000
   MSGLEN;                                                     <<03550>>55776000
DOUBLE ARRAY DISCADDRESS(0:0)=Q;                               <<03550>>55778000
DOUBLE CPDISCADR;                                              <<03550>>55780000
INTEGER POINTER                                                <<03550>>55782000
   PNTR,                                                       <<03550>>55784000
   CPPNTR;                                                     <<03550>>55786000
BYTE POINTER                                                   <<03550>>55788000
   ADRPNTR,                                                    <<03550>>55790000
   APNTR;                                                      <<03550>>55792000
DEFINE                                                         <<03550>>55794000
   MEMX                   = (8:8)#;                            <<03550>>55796000
EQUATE                                                         <<03550>>55798000
   CDB'READ               =   0,                               <<03550>>55800000
   CDB'REQ'STATUS         = %15,                               <<03550>>55802000
   CDB'SET'SNGL'VEC       = %20,                               <<03550>>55804000
   CDB'SET'LENGTH         = %30,                               <<03550>>55806000
   CDB'SET'UNIT           = %40,                               <<03550>>55808000
   CDB'NO'OP              = %64,                               <<03550>>55810000
   CDB'SET'VOL            =%100,                               <<03550>>55812000
   MAXMSG                 = 200;                               <<03550>>55814000
EQUATE                                                         <<03550>>55816000
   CPBASE'LEN             = %41,                               <<03550>>55818000
   CPBASE'JMP'X           =   2,                               <<03550>>55820000
   CPBASE'STATCMD'X       =   3,                               <<03550>>55822000
   CPBASE'STATBUF         =   4,                               <<03550>>55824000
   CPSTAT'ENTRY           = %16,                               <<03550>>55826000
   CPSTAT'CMD'X           = %22,                               <<03550>>55828000
   CPSTAT'ADR'X           = %31,                               <<03550>>55830000
   CPRD'LEN               = %23,                               <<03550>>55832000
   CPRD'MSGLEN'X          =   1,                               <<03550>>55834000
   CPRD'MSGADR'X          =   4,                               <<03550>>55836000
   CPRD'CNT'X             = %10,                               <<03550>>55838000
   CPRD'BANK'X            = %12,                               <<03550>>55840000
   CPRD'ADR'X             = %13,                               <<03550>>55842000
   CPRD'DSJ'ERR1'X        = %21,                               <<03550>>55844000
   CPRD'DSJ'ERR2'X        = %22,                               <<03550>>55846000
   CPRD'DSJ'NEXT          = %23,                               <<03550>>55848000
   CPEND'LEN              =   3;                               <<03550>>55850000
<<     NOTE:   A "*" BESIDES A NUMBER INDICATES     >>         <<03550>>55852000
<<     A LOCATION WITHIN THE CHANNEL PROGRAM        >>         <<03550>>55854000
<<     THAT NEEDS TO BE UPDATED.                    >>         <<03550>>55856000
ARRAY CHAN'PGM'BASE(*) = PB :=                                 <<03550>>55858000
  <<  0*>>         0, << CHECKSUM                         >>   <<03550>>55860000
                                                               <<03550>>55862000
  <<  1 >>         0, << JUMP COMMAND                     >>   <<03550>>55864000
  <<  2*>>       %36, << JUMP TARGET                      >>   <<03550>>55866000
                                                               <<03550>>55868000
  <<  3 >>       %15, << STATUS REQUEST COMMAND           >>   <<03550>>55870000
                                                               <<03550>>55872000
  <<  4 >> 0,0,0,0,0, << STATUS BUFFER - ERROR STATUS     >>   <<03550>>55874000
  << 11 >> 0,0,0,0,0, << WILL BE RETURNED HERE!           >>   <<03550>>55876000
                                                               <<03550>>55878000
  << 16 >>     %2005, << SEND READ STATUS COMMAND         >>   <<03550>>55880000
  << 17 >>         1,                                          <<03550>>55882000
  << 20 >>         0,                                          <<03550>>55884000
  << 21 >>    %42000,                                          <<03550>>55886000
  << 22*>>         0,                                          <<03550>>55888000
                                                               <<03550>>55890000
  << 23 >>     %1000, << WAIT                             >>   <<03550>>55892000
  << 24 >>         0,                                          <<03550>>55894000
                                                               <<03550>>55896000
  << 25 >>     %1416, << EXECUTION MSG SECONDARY          >>   <<03550>>55898000
  << 26 >>        20, << #STATUS BYTES TO READ            >>   <<03550>>55900000
  << 27 >>         0, << BURST                            >>   <<03550>>55902000
  << 30 >>     %2000, << DATA BANK                        >>   <<03550>>55904000
  << 31*>>         0, << DATA BUFFER ABSOLUTE ADDRESS     >>   <<03550>>55906000
                                                               <<03550>>55908000
  << 32 >>     %1000, << WAIT                             >>   <<03550>>55910000
  << 33 >>         0,                                          <<03550>>55912000
                                                               <<03550>>55914000
  << 34 >>     %2400, << REPORTING MSG SECONDARY          >>   <<03550>>55916000
  << 35 >>         0,                                          <<03550>>55918000
  << 36 >>         0,                                          <<03550>>55920000
                                                               <<03550>>55922000
  << 37 >>      %600, << INT/HALT - BAD NEWS HALT         >>   <<03550>>55924000
  << 40 >>         1; << ERROR - CAUSE SYSTEM HALT!       >>   <<03550>>55926000
ARRAY CHAN'PGM'READ(*) = PB :=                                 <<03550>>55928000
  <<  0 >>     %2005, << COMMAND MSG SECONDARY            >>   <<03550>>55930000
  <<  1*>>         0, << COMMAND MSG BUFFER LENGTH        >>   <<03550>>55932000
  <<  2 >>         0, << BURST                            >>   <<03550>>55934000
  <<  3 >>     %2000, << COMMAND BUFFER BANK              >>   <<03550>>55936000
  <<  4*>>         0, << COMMAND BUFFER ABSOLUTE ADDRESS  >>   <<03550>>55938000
                                                               <<03550>>55940000
  <<  5 >>     %1000, << WAIT                             >>   <<03550>>55942000
  <<  6 >>         0,                                          <<03550>>55944000
                                                               <<03550>>55946000
  <<  7 >>     %1416, << EXECUTION MSG SECONDARY          >>   <<03550>>55948000
  << 10*>>         0, << NUMBER OF DATA BYTES TO READ     >>   <<03550>>55950000
  << 11 >>         0, << BURST                            >>   <<03550>>55952000
  << 12*>>         0, << DATA BANK                        >>   <<03550>>55954000
  << 13*>>         0, << DATA BUFFER ABSOLUTE ADDRESS     >>   <<03550>>55956000
                                                               <<03550>>55958000
  << 14 >>     %1000, << WAIT                             >>   <<03550>>55960000
  << 15 >>         0,                                          <<03550>>55962000
                                                               <<03550>>55964000
  << 16 >>     %2402, << DSJ - REPORTING PHASE            >>   <<03550>>55966000
  << 17 >>         0,                                          <<03550>>55968000
  << 20 >>         0, << A-OK JUMP                        >>   <<03550>>55970000
  << 21*>>         0, << HARD ERROR JUMP                  >>   <<03550>>55972000
  << 22*>>         0; << POWER ON JUMP                    >>   <<03550>>55974000
ARRAY CHAN'PGM'END(*) = PB :=                                  <<03550>>55976000
  <<  0 >>      %600, << INT/HALT                         >>   <<03550>>55978000
  <<  1 >>         0, << GOOD NEWS HALT!                  >>   <<03550>>55980000
                                                               <<03550>>55982000
  <<  2 >>        -1; << TERMINATOR                       >>   <<03550>>55984000
                                                               <<03550>>55986000
SUBROUTINE READ( BANK, ADDRESS, DISCADR, SIZE);                <<03550>>55988000
VALUE BANK, ADDRESS, DISCADR, SIZE;                            <<03550>>55990000
INTEGER BANK, ADDRESS, SIZE;                                   <<03550>>55992000
DOUBLE DISCADR;                                                <<03550>>55994000
                                                               <<03550>>55996000
COMMENT                                                        <<03550>>55998000
BUILDS A CHANNEL PROGRAM TO DO ONE READ.                       <<03550>>56000000
;                                                              <<03550>>56002000
                                                               <<03550>>56004000
BEGIN                                                          <<03550>>56006000
SIZE := SIZE&LSL(1);                                           <<03550>>56008000
@APNTR := @ADRPNTR; << SAVE START OF CMD BUFFER >>             <<03550>>56010000
                                                               <<03550>>56012000
<< BUILD CMD BUFFER >>                                         <<03550>>56014000
                                                               <<03550>>56016000
ADRPNTR := CDB'SET'SNGL'VEC;                                   <<03550>>56018000
ADRPNTR(1) := 0;                                               <<03550>>56020000
ADRPNTR(2) := 0;                                               <<03550>>56022000
TOS := @DISCADR&LSL(1);                                        <<03550>>56024000
MOVE ADRPNTR(3) := *,(4);                                      <<03550>>56026000
ADRPNTR(7) := CDB'SET'LENGTH;                                  <<03550>>56028000
ADRPNTR(8) := 0;                                               <<03550>>56030000
ADRPNTR(9) := 0;                                               <<03550>>56032000
TOS := @SIZE&LSL(1);                                           <<03550>>56034000
MOVE ADRPNTR(10) := *,(2);                                     <<03550>>56036000
ADRPNTR(12) := CDB'READ;                                       <<03550>>56038000
MSGLEN := 13;                                                  <<03550>>56040000
@ADRPNTR := @ADRPNTR(14);                                      <<03550>>56042000
                                                               <<03550>>56044000
<< BUILD CHANNEL PROGRAM >>                                    <<03550>>56046000
                                                               <<03550>>56048000
MOVE CPPNTR := CHAN'PGM'READ,(CPRD'LEN);                       <<03550>>56050000
CPPNTR(CPRD'MSGLEN'X) := MSGLEN;                               <<03550>>56052000
CPPNTR(CPRD'MSGADR'X) := BASE+WORDADDRESS(APNTR)-@BUF;         <<04306>>56054000
CPPNTR(CPRD'CNT'X) := SIZE;                                    <<03550>>56056000
CPPNTR(CPRD'BANK'X).MEMX := BANK;                              <<03550>>56058000
CPPNTR(CPRD'ADR'X) := ADDRESS;                                 <<03550>>56060000
CPPNTR(CPRD'DSJ'ERR1'X) := CPPNTR(CPRD'DSJ'ERR2'X) :=          <<03550>>56062000
   @BUF(CPSTAT'ENTRY) - @CPPNTR(CPRD'DSJ'NEXT);                <<03550>>56064000
@CPPNTR := @CPPNTR+CPRD'LEN;                                   <<03550>>56066000
END;                                                           <<03550>>56068000
                                                               <<03550>>56070000
<< BUILD LARGE CHANNEL PROGRAM WITH MANY READS TO GO >>        <<03550>>56072000
<< AT ADDRESS %2000.                                 >>        <<03550>>56074000
                                                               <<03550>>56076000
BASE := BASE2;                                                 <<03550>>56078000
MOVE BUF := CHAN'PGM'BASE,(CPBASE'LEN),2;                      <<03550>>56080000
@ADRPNTR := TOS&LSL(1); << MAKE BYTE ADDRESS >>                <<03550>>56082000
@CPPNTR := @BUF(MAXMSG);                                       <<03550>>56084000
BUF(CPSTAT'CMD'X) := BASE+CPBASE'STATCMD'X;                    <<03550>>56086000
BUF(CPSTAT'ADR'X) := BASE+CPBASE'STATBUF;                      <<03550>>56088000
                                                               <<03550>>56090000
<< BUILD ONE READ CHANNEL PROGRAM FOR EVERY ENTRY IN >>        <<03550>>56092000
<< BOOT'FMT'TAB.                                     >>        <<03550>>56094000
                                                               <<03550>>56096000
@PNTR := @BOOT'FMT'TAB;  << SET POINTER TO START OF MAP >>     <<03550>>56098000
WHILE CNT > 0 DO    << BUILD READ COMMANDS FOR ALL >>          <<03550>>56100000
   BEGIN            << ENTRIES IN TABLE            >>          <<03550>>56102000
   MOVE DISCADDRESS := DISCADR1,(2);                           <<03550>>56104000
   READ(COREADR1,COREADR2,DISCADDRESS,LENGTH);                 <<03550>>56106000
   @PNTR := @PNTR(ENTRY'SIZE);                                 <<03550>>56108000
   CNT := CNT - 1;                                             <<03550>>56110000
   END;                                                        <<03550>>56112000
MOVE CPPNTR := CHAN'PGM'END,(CPEND'LEN),2;                     <<03550>>56114000
@CPPNTR := TOS;                                                <<03550>>56116000
@PNTR := WORDADDRESS(ADRPNTR);   << CHANGE TO WORD PNTR >>     <<04306>>56118000
CPSIZE := @CPPNTR-@BUF;                                        <<03550>>56120000
<< COMPUTE JUMP TARGET >>                                      <<03550>>56122000
BUF(CPBASE'JMP'X) := @BUF(MAXMSG)-@BUF(CPBASE'JMP'X+1);        <<03550>>56124000
CPDISCADR := D'L( BOOTDISCSPACE( CPSIZE)));                    <<03550>>56126000
DISC( WRITE,SYSDISC,          << WRITE CHANNEL PROGRAM OUT >>  <<03550>>56128000
      CPDISCADR,BUF,CPSIZE);  <<    TO THE RESERVED AREA   >>  <<03550>>56130000
                                                               <<03550>>56132000
<< NOW BUILD THE SMALL CHANNEL PROGRAM, WHICH READS IN >>      <<03550>>56134000
<< THE LARGER ONE, TO RUN AT %7100.                    >>      <<03550>>56136000
                                                               <<03550>>56138000
BASE := BASE1;                                                 <<03550>>56140000
ZEROBUF(BUF,128);                                              <<03550>>56142000
MOVE BUF := CHAN'PGM'BASE,(CPBASE'LEN),2;                      <<03550>>56144000
@ADRPNTR := S0&LSL(1); << MAKE BYTE ADDRESS >>                 <<03550>>56146000
@CPPNTR := TOS+27; << ROOM FOR THREE MSG READS >>              <<03550>>56148000
BUF(CPBASE'JMP'X) := @CPPNTR-@BUF(CPBASE'JMP'X+1);             <<03550>>56150000
BUF(CPSTAT'CMD'X) := BASE+CPBASE'STATCMD'X;                    <<03550>>56152000
BUF(CPSTAT'ADR'X) := BASE+CPBASE'STATBUF;                      <<03550>>56154000
READ(0,BASE2,CPDISCADR,CPSIZE);                                <<03550>>56156000
<< COMPUTE ABSOLUTE JUMP TARGET >>                             <<03550>>56158000
CPPNTR := 0;  << JUMP >>                                       <<03550>>56160000
CPPNTR(1) := BASE2+1-(@CPPNTR(2)-@BUF+BASE);                   <<03550>>56162000
BUF := CALCULATECHECKSUM(BUF,128,SEED);                        <<03550>>56164000
                                                               <<03550>>56166000
<< WRITE THIS CHANNEL PROGRAM OUT TO SECTOR 2 >>               <<03550>>56168000
                                                               <<03550>>56170000
DISC( WRITE,SYSDISC,2D,BUF,128);  << PUT IT AT SECTOR 2 >>     <<03550>>56172000
END;   << BUILD'CS80'BOOT >>                                   <<03550>>56174000
$IF X1=OFF  << ******* SERIES II/III UNIQUE ******** >>        <<02510>>56176000
PROCEDURE BUILD'SIO'BOOT( PNTR, CNT);                          <<02510>>56178000
   VALUE PNTR, CNT;                                            <<02510>>56180000
   INTEGER POINTER PNTR;                                       <<02510>>56182000
   INTEGER CNT;                                                <<02510>>56184000
BEGIN                                                          <<02510>>56186000
   DOUBLE POINTER                                              <<02510>>56188000
      DPNTR = PNTR;                                            <<02510>>56190000
   DOUBLE                                                      <<02510>>56192000
      SIODISCADR;                                              <<02510>>56194000
   INTEGER                                                     <<02510>>56196000
      SIOPGMSIZE;                                              <<02510>>56198000
   INTEGER POINTER                                             <<02510>>56200000
      PS0 = S-0;                                               <<02510>>56202000
                                                               <<02510>>56204000
   ZEROBUF( BUF, 256);                                         <<03550>>56206000
   ADRBASE := 0;                                               <<02510>>56208000
   @SIOPNTR := @BUF(128);                                      <<02510>>56210000
   TOS := CNT;                                                 <<02510>>56212000
   WHILE <> DO                                                 <<02510>>56214000
      BEGIN                                                    <<02510>>56216000
      SIOREADENT(DPNTR,DPNTR(1),PNTR(4));                      <<02510>>56218000
      @PNTR := @PNTR(5);                                       <<02510>>56220000
      TOS := TOS-1;                                            <<02510>>56222000
      END;                                                     <<02510>>56224000
   SIOPNTR := %34000;  << SIO END,I >>                         <<02510>>56226000
   SIOPGMSIZE := @SIOPNTR-@BUF(126);                           <<02510>>56228000
   MOVE BUF( ADRBASE) := BUF(128),(SIOPGMSIZE);                <<02510>>56230000
   SIOPGMSIZE := SIOPGMSIZE+ADRBASE;                           <<02510>>56232000
   SIODISCADR := D'L(BOOTDISCSPACE(SIOPGMSIZE)));              <<02510>>56234000
   DISC(WRITE,SYSDISC,SIODISCADR,BUF,SIOPGMSIZE);              <<02510>>56236000
                                                               <<02510>>56238000
   @SIOPNTR := @BUF;                                           <<02510>>56240000
   SIOREADENT'(SIODISCADR,D'L(SIOCOREADR)),SIOPGMSIZE);        <<02510>>56242000
   DISC(READ,SYSDISC,0D,LBUF,128);  << DISC LABEL >>           <<02510>>56244000
   MOVE LBUF := BUF,(4),2;                                     <<02510>>56246000
   PS0 := 0;  << SIO JUMP >>                                   <<02510>>56248000
   TOS := TOS+1;                                               <<02510>>56250000
   PS0 := SIOCOREADR+ADRBASE;  << JUMP TARGET >>               <<02510>>56252000
   DISC(WRITE,SYSDISC,0D,LBUF,128);                            <<02510>>56254000
END;                                                           <<02510>>56256000
$IF   << ********* RETURNING TO COMMON CODE ********** >>      <<02510>>56258000
PROCEDURE BUILD'AMIGO'BOOT( PNTR, CNT);                        <<02510>>56260000
   VALUE PNTR, CNT;                                            <<02510>>56262000
   INTEGER POINTER PNTR;                                       <<02510>>56264000
   INTEGER CNT;                                                <<02510>>56266000
BEGIN                                                          <<02510>>56268000
   DOUBLE POINTER                                              <<02510>>56270000
      DPNTR = PNTR;                                            <<02510>>56272000
   DOUBLE                                                      <<02510>>56274000
      SIODISCADR;                                              <<02510>>56276000
   INTEGER                                                     <<02510>>56278000
      SIOPGMSIZE;                                              <<02510>>56280000
   EQUATE                                                      <<02510>>56282000
      SEED = %123456;                                          <<02510>>56284000
   INTEGER ARRAY END'W'INT(0:4)=PB :=                          <<02510>>56286000
      %1000,0,  %600,0,  %177777;                              <<02510>>56288000
   INTEGER ARRAY FILEMASK(4:NMHSUBTYPES-1)=PB :=               <<02510>>56290000
      %7406,%7405,%7407,%7407,%7407,%7407,%7406,%7406,         <<02510>>56292000
      %7407,%7400;                                             <<02510>>56294000
                                                               <<02510>>56296000
   ZEROBUF( BUF, 256);                                         <<03550>>56298000
   @SIOPNTR := @BUF(128);                                      <<02510>>56300000
   BUF(127) := %2400;    << READ CHANNEL COMMAND >>            <<02510>>56302000
   BUF(126) := FILEMASK(SYSDISCSUBTYPE);                       <<02510>>56304000
   ADRBASE := 123;                                             <<02510>>56306000
                                                               <<02510>>56308000
   TOS := CNT;                                                 <<02510>>56310000
   WHILE <> DO                                                 <<02510>>56312000
      BEGIN                                                    <<02510>>56314000
      AMIGOREADENT(DPNTR,DPNTR(1),PNTR(4));                    <<02510>>56316000
      @PNTR := @PNTR(5);                                       <<02510>>56318000
      TOS := TOS-1;                                            <<02510>>56320000
      END;                                                     <<02510>>56322000
   MOVE SIOPNTR := END'W'INT,(5),2;                            <<02510>>56324000
   @SIOPNTR := TOS;                                            <<02510>>56326000
   SIOPGMSIZE := @SIOPNTR-@BUF(128);                           <<02510>>56328000
   SIODISCADR := D'L(BOOTDISCSPACE(SIOPGMSIZE)));              <<02510>>56330000
   DISC(WRITE,SYSDISC,SIODISCADR,BUF(128),SIOPGMSIZE);         <<02510>>56332000
                                                               <<02510>>56334000
   @SIOPNTR := @BUF(1);                                        <<02510>>56336000
   AMIGOREADENT(SIODISCADR,D'L(SIOCOREADR)),SIOPGMSIZE);       <<02510>>56338000
   SIOPNTR := 0;  << CHANNEL JUMP >>                           <<02510>>56340000
   << COMPUTE JUMP TARGET >>                                   <<02510>>56342000
   SIOPNTR(1) := SIOCOREADR-(%7100+@SIOPNTR(2)-@BUF);          <<02510>>56344000
   BUF := CALCULATECHECKSUM(BUF,128,SEED);                     <<02510>>56346000
   DISC(WRITE,SYSDISC,2D,BUF,128); << COLD LOAD SECTOR >>      <<02510>>56348000
END;                                                           <<02510>>56350000
$CONTROL SEGMENT=RESIDENT                                      <<03603>>56352000
PROCEDURE DISPATCHER;                                          <<03603>>56354000
   OPTION INTERRUPT;                                           <<03603>>56356000
BEGIN                                                          <<03603>>56358000
END;                                                           <<03603>>56360000
PROCEDURE MOVE'INITIAL( USEDCORE);                             <<03603>>56362000
   VALUE USEDCORE;                                             <<03603>>56364000
   DOUBLE USEDCORE;                                            <<03603>>56366000
BEGIN                                                          <<03603>>56368000
   DOUBLE                                                      <<03603>>56370000
      STACK'ADR,                                               <<03603>>56372000
      USEDCORE'SWAP,                                           <<s8941>>56374000
      SWAP'AREA'ADR,                                           <<s8941>>56376000
      DADR,                                                    <<03603>>56378000
      DTEMP;                                                   <<03603>>56380000
   INTEGER                                                     <<03603>>56382000
      BANK     = DADR,                                         <<03603>>56384000
      ADR      = DADR+1,                                       <<03603>>56386000
      DTEMP1   = DTEMP,                                        <<03603>>56388000
      DTEMP2   = DTEMP+1,                                      <<03603>>56390000
      SWAP'BANK      = SWAP'AREA'ADR,                          <<s8941>>56392000
      SWAP'AREA'SIZE = SWAP'AREA'ADR + 1,                      <<s8941>>56394000
      LAST'BANK,                                               <<03603>>56396000
      STACK'SIZE,                                              <<03603>>56398000
      STACK'DLZ,                                               <<03603>>56400000
      Z'TABLE'SIZE,         << FOR SPACE NEEDED ABOVE Z >>     <<zrela>>56402000
      NEWDBBANK,                                               <<03603>>56404000
      NEWDB,                                                   <<03603>>56406000
      I,                                                       <<03603>>56408000
      J;                                                       <<03603>>56410000
   DEFINE                                                      <<03603>>56412000
      BANK'SIZE= %200000D#,                                    <<s8941>>56414000
      DISP'BK  = ICS(1)#,                                      <<03603>>56416000
      DISP'DB  = ICS(2)#,                                      <<03603>>56418000
      QIDB     = ICS(-4)#,                                     <<03603>>56420000
      QISBK    = ICS(-5)#,                                     <<03603>>56422000
      QIS      = ICS(-6)#,                                     <<03603>>56424000
      QIDL     = ICS(-7)#,                                     <<03603>>56426000
      QIZ      = ICS(-8)#;                                     <<03603>>56428000
                                                               <<03603>>56430000
   DOUBLE ARRAY                                                <<03603>>56432000
      COREADR(*)   = BUF,                                      <<03603>>56434000
      DLBUF(*)     = LBUF;                                     <<03603>>56436000
SUBROUTINE LAUNCH;                                             <<03603>>56438000
BEGIN                                                          <<03603>>56440000
   ABS(DB) := NEWDB;                                           <<03603>>56442000
   ABS(DBBANK) := NEWDBBANK;                                   <<03603>>56444000
   QIDB := NEWDB;                                              <<03603>>56446000
   QISBK := NEWDBBANK;                                         <<03603>>56448000
   DISP'BK := NEWDBBANK;                                       <<03603>>56450000
   DISP'DB := NEWDB;                                           <<03603>>56452000
   PUSH( S, Q, Z, DL );                                        <<03603>>56454000
   TOS := NEWDBBANK;                                           <<03603>>56456000
   TOS := NEWDB;                                               <<03603>>56458000
   TOS := NEWDBBANK; << SBANK >>                               <<03603>>56460000
   SET( S, Q, Z, DL, DB, SBANK );                              <<03603>>56462000
   ASSEMBLE( EXIT 2 ); << LAUNCH >>                            <<03603>>56464000
END;                                                           <<03603>>56466000
                                                               <<03603>>56468000
LOGICAL SUBROUTINE SEGSIZE( CSTNR);                            <<03603>>56470000
   VALUE CSTNR;                                                <<03603>>56472000
   INTEGER CSTNR;                                              <<03603>>56474000
SEGSIZE := TCST( CSTNR*4).(4:12)*4;                            <<03603>>56476000
                                                               <<03603>>56478000
DOUBLE SUBROUTINE GETSPACE( SIZE);                             <<03603>>56480000
   VALUE SIZE;                                                 <<03603>>56482000
   LOGICAL SIZE;                                               <<03603>>56484000
BEGIN                                                          <<03603>>56486000
   J := LAST'BANK;                                             <<03603>>56488000
   WHILE J >= NR'MPE'BANKS DO                                  <<03603>>56490000
      BEGIN                                                    <<03603>>56492000
      DTEMP := DLBUF(J) - DOUBLE(SIZE);                        <<03603>>56494000
      IF J = DTEMP1 THEN << CROSS OVER A BANK BOUNDARY? >>     <<03603>>56496000
         BEGIN  << IT FITS! >>                                 <<03603>>56498000
         DLBUF(J) := DTEMP;                                    <<03603>>56500000
         GETSPACE := DTEMP; << RETURN ADR OF SPACE >>          <<03603>>56502000
         J := 0; << TERMINATE LOOP >>                          <<03603>>56504000
         END                                                   <<03603>>56506000
      ELSE                                                     <<03603>>56508000
         J := J-1; << TRY NEXT BANK >>                         <<03603>>56510000
      END;                                                     <<03603>>56512000
END;                                                           <<03603>>56514000
SUBROUTINE MABS'( DEST, SBANK, SADDRESS, COUNT);               <<03603>>56516000
   VALUE DEST, SBANK, SADDRESS, COUNT;                         <<03603>>56518000
   DOUBLE DEST;                                                <<03603>>56520000
   INTEGER SBANK, SADDRESS, COUNT;                             <<03603>>56522000
BEGIN                                                          <<03603>>56524000
   X := TOS;   << SAVE RETURN ADDRESS >>                       <<03603>>56526000
   ASSEMBLE( MABS 0 );                                         <<03603>>56528000
   TOS := X;   << REPLACE RETURN ADDRESS >>                    <<03603>>56530000
END;                                                           <<03603>>56532000
SUBROUTINE MOVESEG( SEG, COREADR);                             <<03603>>56534000
   VALUE SEG, COREADR;                                         <<03603>>56536000
   INTEGER SEG;                                                <<03603>>56538000
   DOUBLE COREADR;                                             <<03603>>56540000
BEGIN                                                          <<03603>>56542000
   IF LOGICAL( TCST(SEG*4).(0:1)) THEN                         <<03603>>56544000
      BEGIN << ABSENT - READ FROM DISC >>                      <<03603>>56546000
      DISC'(READ,SYSDISC,TCSTDISC(SEG),COREADR,SEGSIZE(SEG));  <<03603>>56548000
      END                                                      <<03603>>56550000
   ELSE                                                        <<03603>>56552000
      BEGIN << PRESENT - MOVE TO NEW LOCATION >>               <<03603>>56554000
      MABS'(COREADR,TCST(SEG*4+2),TCST(X:=X+1),SEGSIZE(SEG));  <<03603>>56556000
      END;                                                     <<03603>>56558000
   TCST(SEG*4).(0:1) := 0; << MARK PRESENT >>                  <<03603>>56560000
   TCST(X:=X+2) := S2;     << BANK >>                          <<03603>>56562000
   TCST(X:=X+1) := S1;     << ADDRESS >>                       <<03603>>56564000
END;                                                           <<03603>>56566000
SUBROUTINE SETUP'SWAP'TAB;                                     <<03603>>56568000
BEGIN                                                          <<03603>>56570000
   I := NSWAPSEG-1;                                            <<03603>>56572000
   DO BEGIN                                                    <<03603>>56574000
      DADR := DADR-D'L(COMM(MAXINITSEG')));                    <<CONFD>>56576000
      SWAPD(I*SWAPDSIZE) := 0; <<CST #>>                       <<03603>>56578000
      SWAPD(X:=X+1) := BANK;                                   <<03603>>56580000
      SWAPD(X:=X+1) := ADR;                                    <<03603>>56582000
         << NEXT MOST LIKELY TO SWAP >>                        <<03603>>56584000
      SWAPD(X:=X+1) := IF I=0 THEN 0 ELSE (I-1)*SWAPDSIZE+3;   <<03603>>56586000
         << NEXT LEAST LIKELY TO SWAP >>                       <<03603>>56588000
      SWAPD(X:=X+1) := IF I=NSWAPSEG-1 THEN 0                  <<03603>>56590000
         ELSE (I+1)*SWAPDSIZE+4;                               <<03603>>56592000
      END UNTIL (I:=I-1) < 0;                                  <<03603>>56594000
   LLSWAP := 4;  << LEAST LIKELY TO SWAP >>                    <<03603>>56596000
   MLSWAP := (NSWAPSEG-1)*SWAPDSIZE+3; << MOST LIKELY >>       <<03603>>56598000
END;                                                           <<03603>>56600000
                                                               <<03603>>56602000
                                                               <<03603>>56604000
<<------------------------------------------------------->>    <<s8941>>56606000
<< Because INITIAL's code segments/stack size is getting >>    <<s8941>>56608000
<< too large, memory sizes less than 256 are no longer   >>    <<s8941>>56610000
<< supported.  However, JUST IN CASE in the future       >>    <<s8941>>56612000
<< parts of INITIAL are moved into PROGEN, refer to      >>    <<s8941>>56614000
<< MPEV-E G.00.00 code to see how INITIAL is "moved" into>>    <<s8941>>56616000
<< high core when the system is configured at less than  >>    <<s8941>>56618000
<< 1/2 megabyte of memory.                               >>    <<s8941>>56620000
<< NOTE: The change to move INITIAL's core resident      >>    <<s8941>>56622000
<< segments to the next-to-the last bank was the result  >>    <<s8941>>56624000
<< of a small swapping area when the system had a large  >>    <<s8941>>56626000
<< I/O configuration.  This slowed down INITIAL greatly. >>    <<s8941>>56628000
<<------------------------------------------------------->>    <<s8941>>56630000
                                                               <<s8941>>56632000
                                                               <<s8941>>56634000
   DADR := USEDCORE-%11D;                                      <<03603>>56636000
   LAST'BANK := BANK;                                          <<03603>>56638000
                                                               <<03603>>56640000
   I := LAST'BANK;                                             <<03603>>56642000
   WHILE I >= NR'MPE'BANKS DO                                  <<03603>>56644000
      BEGIN                                                    <<03603>>56646000
      DLBUF(I) := DADR;                                        <<03603>>56648000
      ADR := %177770;                                          <<03603>>56650000
      BANK := BANK-1;                                          <<03603>>56652000
      I := I-1;                                                <<03603>>56654000
      END;                                                     <<03603>>56656000
                                                               <<03603>>56658000
   STACK'DLZ := QIZ-QIDL;                                      <<03603>>56660000
   Z'TABLE'SIZE := (HLDEV + 1) * (LDTSIZE + LPDTSIZE +         <<zrela>>56662000
                  LDTXSIZE + DVRSIZE) + %15;                   <<zrela>>56664000
   STACK'SIZE := STACK'DLZ+INITSTACKEXTRA;                     <<03603>>56666000
   MAXSTACKSIZE:= STACK'SIZE;                                  <<04266>>56668000
                                                               <<03603>>56670000
   I := NUTCST;                                                <<03603>>56672000
   WHILE > DO                                                  <<03603>>56674000
      BEGIN                                                    <<03603>>56676000
      COREADR(I) := GETSPACE(SEGSIZE(I));                      <<03603>>56678000
      IF COREADR(I) = 0D THEN GO SWAP; << DOESN'T FIT >>       <<03603>>56680000
      I := I-1;                                                <<03603>>56682000
      END;                                                     <<03603>>56684000
                                                               <<03603>>56686000
   STACK'ADR := GETSPACE(STACK'SIZE + Z'TABLE'SIZE);           <<zrela>>56688000
   INITIAL'MEMADR := STACK'ADR;                                <<s8941>>56690000
   IF STACK'ADR = 0D THEN GO SWAP; << DOESN'T FIT >>           <<03603>>56692000
                                                               <<03603>>56694000
   <<  EVERYTHING FITS -- BRING IT IN  >>                      <<03603>>56696000
                                                               <<03603>>56698000
   I := NUTCST;                                                <<03603>>56700000
   WHILE > DO                                                  <<03603>>56702000
      BEGIN                                                    <<03603>>56704000
      MOVESEG( I, COREADR(I));                                 <<03603>>56706000
      I := I-1;                                                <<03603>>56708000
      END;                                                     <<03603>>56710000
                                                               <<03603>>56712000
   DADR := STACK'ADR + D'L(INITSTACKEXTRA));                   <<03603>>56714000
   NEWDBBANK := BANK;                                          <<03603>>56716000
   NEWDB := ADR-QIDL;                                          <<03603>>56718000
   MABS(BANK,ADR,ABS(DBBANK),ABS(DB)+QIDL,STACK'DLZ);          <<03603>>56720000
   MABS( BANK, ADR + STACK'DLZ, ABS(DBBANK),                   <<zrela>>56722000
         ABS(DB) + QIDL + STACK'DLZ, Z'TABLE'SIZE);            <<zrela>>56724000
   LAUNCH; << BLUE SKY  OR  CRASH AND BURN >>                  <<03603>>56726000
                                                               <<03603>>56728000
SWAP:                                                          <<s8941>>56730000
       <<---------------------------------------------->>      <<s8941>>56732000
       <<  IF WE GET HERE, THERE WAS NOT ENOUGH MEMORY >>      <<s8941>>56734000
       <<  TO HOLD INITIAL WITHOUT SWAPPING.           >>      <<03603>>56736000
       <<---------------------------------------------->>      <<s8941>>56738000
                                                               <<03603>>56740000
      <<-------------------------------------------------->>   <<s8941>>56742000
      <<  Use the last address of the next to the last    >>   <<s8941>>56744000
      <<  bank to begin relocating INITIAL's core resident>>   <<s8941>>56746000
      <<  segments.  Subtract 2 from the last address for >>   <<s8941>>56748000
      <<  a safety margin.                                >>   <<s8941>>56750000
      <<-------------------------------------------------->>   <<s8941>>56752000
                                                               <<s8941>>56754000
      USEDCORE'SWAP := USEDCORE - BANK'SIZE;                   <<s8941>>56756000
      DADR := USEDCORE'SWAP - 2D;                              <<s8941>>56758000
                                                               <<03603>>56760000
      <<-------------------------------------------------->>   <<s8941>>56762000
      <<  Read in core resident segments in the following >>   <<s8941>>56764000
      <<  order:    (3)   RESIDENT                        >>   <<s8941>>56766000
      <<            (2)   BOOTSTRAP                       >>   <<s8941>>56768000
      <<            (1)   ININ                            >>   <<s8941>>56770000
      <<-------------------------------------------------->>   <<s8941>>56772000
                                                               <<s8941>>56774000
                                                               <<03603>>56776000
      I := 1;                                                  <<s8941>>56778000
      WHILE I <= NCORRESSEG DO                                 <<s8941>>56780000
         BEGIN                                                 <<03603>>56782000
         DADR := DADR - D'L(SEGSIZE(I)));                      <<03603>>56784000
         MOVESEG( I, DADR);                                    <<03603>>56786000
         I := I + 1;                                           <<s8941>>56788000
         END;                                                  <<03603>>56790000
                                                               <<s8941>>56792000
      INITIAL'MEMADR := DADR;                                  <<s8941>>56794000
                                                               <<s8941>>56796000
                                                               <<03603>>56798000
   <<  FORCE REGISTER SWITCH TO NEW CODE SEGMENT LOCATION  >>  <<03603>>56800000
   <<  BY CALLING A PROCEDURE EXTERNAL TO THIS SEGMENT     >>  <<03603>>56802000
   THISCPU; << THERE GO THE REGISTERS! >>                      <<03603>>56804000
                                                               <<03603>>56806000
   <<  FLAG ALL NON-CORE RESIDENT SEGMENTS ABSENT  >>          <<03603>>56808000
   I := NCORRESSEG+1;                                          <<03603>>56810000
   WHILE I <= NUTCST DO                                        <<03603>>56812000
      BEGIN                                                    <<03603>>56814000
      TCST(I*4).(0:1) := 1; << MARK ABSENT >>                  <<03603>>56816000
      I := I+1;                                                <<03603>>56818000
      END;                                                     <<03603>>56820000
                                                               <<03603>>56822000
      <<---------------------------------------------->>       <<s8941>>56824000
      << Reset the double address pointer to the  last>>       <<s8941>>56826000
      << word of the last bank to calculate the size  >>       <<s8941>>56828000
      << of the swap area.  Subtract 11D for safety   >>       <<s8941>>56830000
      << margin.                                      >>       <<s8941>>56832000
      <<---------------------------------------------->>       <<s8941>>56834000
                                                               <<s8941>>56836000
      DADR := USEDCORE - %11D;                                 <<s8941>>56838000
                                                               <<s8941>>56840000
      SWAP'AREA'SIZE := LOGICAL(ADR-STACK'SIZE-Z'TABLE'SIZE);  <<s8941>>56842000
      SWAP'BANK      := BANK;                                  <<s8941>>56844000
      NSWAPSEG := LOGICAL(SWAP'AREA'SIZE) /                    <<s8941>>56846000
                  LOGICAL(COMM(MAXINITSEG'));                  <<s8941>>56848000
                                                               <<04777>>56850000
                                                               <<04777>>56852000
                                                               <<04777>>56854000
   IF NSWAPSEG > MAXSWAPSEG THEN                               <<03603>>56856000
      NSWAPSEG := MAXSWAPSEG;                                  <<03603>>56858000
   DADR := SWAP'AREA'ADR;                                      <<s8941>>56860000
   SETUP'SWAP'TAB;                                             <<03603>>56862000
                                                               <<03603>>56864000
   <<--------------------------------------------->>           <<s8941>>56866000
   <<  Calculate INITIAL's new stack position by  >>           <<s8941>>56868000
   <<  re-initializing the stack address to the   >>           <<s8941>>56870000
   <<  swap area offset.                          >>           <<s8941>>56872000
   <<--------------------------------------------->>           <<s8941>>56874000
                                                               <<s8941>>56876000
                                                               <<03603>>56878000
   DADR := USEDCORE- %11D - D'L(STACK'DLZ+Z'TABLE'SIZE));      <<s8941>>56880000
                                                               <<03603>>56882000
   <<  MOVE STACK TO IT'S NEW LOCATION  >>                     <<03603>>56884000
                                                               <<03603>>56886000
   MABS'(DADR,QISBK,QIDB+QIDL,STACK'DLZ);                      <<03603>>56888000
   MABS'( DADR + D'L(STACK'DLZ)), QISBK,                       <<zrela>>56890000
          QIDB + QIDL + STACK'DLZ, Z'TABLE'SIZE);              <<zrela>>56892000
                                                               <<zrela>>56894000
   NEWDB := ADR-QIDL;                                          <<03603>>56896000
   NEWDBBANK := BANK;                                          <<03603>>56898000
   LAUNCH; <<  BLUE SKY  OR  CRASH AND BURN  >>                <<03603>>56900000
END; << MOVE'INITIAL >>                                        <<03603>>56902000
$CONTROL SEGMENT=BOOTSTRAP                                     <<02510>>56904000
PROCEDURE CKFORSTARFISH;                                       <<02510>>56906000
BEGIN                                                          <<02510>>56908000
   INTEGER TEMP1, TEMP2;                                       <<02510>>56910000
                                                               <<02510>>56912000
   STARFISH := FALSE;                                          <<02510>>56914000
   IF SERIESII'III THEN                                        <<02510>>56916000
      BEGIN                                                    <<02510>>56918000
      TEMP1 := ABSOLUTE(-1); << SAVE LAST LOCATION >>          <<02510>>56920000
      ABSOLUTE(-1) := %30000;<< REPLACE WITH SIO END INSTRUCTON<<02510>>56922000
      TEMP2 := ABSOLUTE(0);  << SAVE CST POINTER >>            <<02510>>56924000
      MB0 := 4;      << ENABLE/DISABLE >>                      <<02510>>56926000
      MB1 := 1;      << ENABLE         >>                      <<02510>>56928000
      MB4 := 0;      << I/0 STATUS     >>                      <<02510>>56930000
      TOS := ADAPTERDRT;                                       <<02510>>56932000
      TOS := -1;     << SIO PGM PNTR   >>                      <<02510>>56934000
      ASSEMBLE( SIO 1 );                                       <<02510>>56936000
      IF = THEN                                                <<02510>>56938000
         BEGIN                                                 <<02510>>56940000
         I := 100;                                             <<02510>>56942000
         WHILE <> AND NOT STARFISH DO                          <<02510>>56944000
            BEGIN                                              <<02510>>56946000
            IF MB4 < 0 THEN STARFISH := TRUE;                  <<02510>>56948000
            I := I-1;                                          <<02510>>56950000
            END;                                               <<02510>>56952000
         IF GETDRT(ADAPTERDRT,0) = -1 THEN STARFISH:=TRUE;     <<03002>>56954000
         << SIO PGM PNTR WOULD HAVE BEEN 1 FOR A SIO DEVICE >> <<02510>>56956000
         << A DEVICE ON THE MUX CHANNEL WILL HAVE WRAPPED   >> <<02510>>56958000
         << CORE AND DESTROYED THE CST POINTER              >> <<02510>>56960000
         << A DEVICE ON THE SELECTOR CHANNEL WILL HAVE      >> <<02510>>56962000
         << WRAPPED CORE BUT NOT DESTROYED THE CST POINTER  >> <<02510>>56964000
         ABSOLUTE(0) := TEMP2;                                 <<02510>>56966000
         END;                                                  <<02510>>56968000
      ABSOLUTE(-1) := TEMP1; << REPLACE LAST LOCATION >>       <<02510>>56970000
      END;                                                     <<02510>>56972000
END;                                                           <<02510>>56974000
$PAGE "DISC COLD LOAD BOOTSTRAP"                                        56976000
$CONTROL SEGMENT=BOOTSTRAP                                              56978000
  PROCEDURE BOOTSTRAP;                                                  56980000
    COMMENT                                                             56982000
      READS TABLES AND INITIAL'S CSTS FROM SYSTEM DISC. THEN PUTS       56984000
    MARKER ON INITIAL'S STACK SO THAT IXIT WILL GO THERE;               56986000
      BEGIN                                                             56988000
        INTEGER POINTER INFO;     <<INFORMATION TABLE>>                 56990000
        INTEGER POINTER TABLEINFO; <<TABLE INFORMATION>>                56992000
        INTEGER I,N,C,SBANK;                                   <<03603>>56994000
        DOUBLE ADR;                                            <<03603>>56996000
                                                               <<03603>>56998000
          SBANK := ABSOLUTE(ABSOLUTE(QI)-5);                   <<03603>>57000000
          TOS := ABS(ABS(QI)-13); << INFO BANK >>              <<03603>>57002000
          TOS := ABS(X:=X+1); << INFO ADDR >>                  <<03603>>57004000
          SET(DB);  <<SET DB TO POINT AT INFO TABLE>>                   57006000
          @INFO := 0;                                                   57008000
          << FIRMWARE AREA USED FOR INITIAL'S FLAGS >>         <<02510>>57010000
          ZEROABS( %1400, FIRMWARESIZE);                       <<D9089>>57012000
          PUSH( DB ); DELB;                                    <<03603>>57014000
          ABSOLUTE( CHANPROG) := S0+INFOSIZE;                  <<03603>>57016000
          DEL;                                                 <<03603>>57018000
          CS80'LOCK := FALSE;   << PARAM. FOR CS80'DRIVER-- >> <<03672>>57020000
                                << SHOULD BE SET BEFORE THE >> <<03672>>57022000
                                << FIRST CALL TO THIS DRIVER>> <<03672>>57024000
          IF NOT MULTI'IMB'SYS <<CAN NOT USE DRTBANK,DRTADDR>> <<C8392>>57026000
          THEN BEGIN    <<SO ZERO TO EFFECTIVELY PUT>>         <<03002>>57028000
            ABSOLUTE(DRTBANK):=0;  <<DRT TAB IN BANK 0 >>      <<03002>>57030000
            ABSOLUTE(DRTADDR):=0;                              <<03002>>57032000
          END;                                                 <<03002>>57034000
          CKFORSTARFISH;                                       <<02510>>57036000
          INITDRT( INFO(SYSDISCDRT'));                         <<02510>>57038000
          << CLEAR TEMP'CPVA AREA >>                           <<02510>>57040000
          ZEROABS( TEMP'CPVA, 8);                              <<02510>>57042000
          @TABLEINFO := INFO(TABPTR);  <<PTR TO TABLE INFORMATION>>     57044000
          N := INFO(NREAD);  <<# OF ENTRIES TO READ IN>>                57046000
          C := (INFO(TCSTPTR)-INFO(TABPTR))/4;                 <<03603>>57048000
          I := 0;                                                       57050000
          DO                                                            57052000
            BEGIN                                                       57054000
              IF TABLEINFO(I*5) = 0 THEN                                57056000
                GOTO ZEROSIZE; <<NEVER PASS A SIZE=0 TO DVR>>  <<06067>>57058000
              TOS := 0;       <<LDEV>>                                  57060000
              TOS := INFO(SYSDISCDRT');                        <<*DVR*>>57062000
              TOS := 0; << UNIT # 0 >>                         <<*DVR*>>57064000
              TOS := INFO(DISCTST).INFODSUBTYPE;                        57066000
              TOS := READ;                                              57068000
              TOS := TABLEINFO(I*5+3); <<HO DISC ADR>>                  57070000
              TOS := TABLEINFO(X:=X+1);<<LO DISC ADR>>                  57072000
              TOS := TABLEINFO(I*5+1); <<HO MEM ADR>>                   57074000
              TOS := TABLEINFO(X:=X+1);<<LO MEM ADR>>                   57076000
              TOS := TABLEINFO(I*5);   << COUNT >>                      57078000
              TOS := INFO(DISCTST).INFODTYPE;                           57080000
              IF S0 = FHDISCTYPE THEN                          <<*LDT*>>57082000
                TOS := @FHDISC                                 <<*LDT*>>57084000
              ELSE                                             <<*LDT*>>57086000
                IF S0 = MHDISCTYPE THEN                        <<*LDT*>>57088000
                  IF S7 < 4 THEN                               <<*LDT*>>57090000
                    TOS := @MHDISC                             <<*LDT*>>57092000
                  ELSE                                         <<*LDT*>>57094000
                   IF S7 < NMHSUBTYPES THEN TOS := @MH7905     <<*LDT*>>57096000
                   ELSE ASSEMBLE(HALT 9)                       <<*LDT*>>57098000
                ELSE                                           <<*LDT*>>57100000
                  IF S0 = 3 << CS80 DEVICE >> THEN             <<*LDT*>>57102000
                    TOS := @CS80'DRIVER                        <<*LDT*>>57104000
                  ELSE ASSEMBLE( HALT 10);                     <<*LDT*>>57106000
              ASSEMBLE(DELB; PCAL 0);  <<CALL DISC DRIVER>>             57108000
ZEROSIZE:                                                      <<06067>>57110000
            END                                                         57112000
          UNTIL (I:=I+1)=N;                                             57114000
          ABSOLUTE(ABSOLUTE(QI)-6) := ABSOLUTE(ABSOLUTE(QI)-10); <<S>>  57116000
          TOS := SBANK;                     << DB BANK >>      <<03603>>57118000
          TOS := INFO(INITS)+INFO(INITDB)+1;                   <<03603>>57120000
          ADR := TOS;                                          <<03603>>57122000
          SSEA( ADR, INFO(LOADMODE));       << X >>            <<03603>>57124000
          << BUILD DELTA P, INCLUDING MAP FLAG >>              <<*MAP*>>57126000
          I := INFO(DISCENTRY) CAT LOGICALMAPPING'(1:15:1);    <<*MAP*>>57128000
          SSEA( ADR+1D, I);                 << DELTA P >>      <<*MAP*>>57130000
          SSEA( ADR+2D, LOGICAL(@BOOTSTRAPHELP) LAND %100377); <<03603>>57132000
          SSEA( ADR+3D, 4);                 << DELTA Q >>      <<03603>>57134000
          SSEA( ADR+4D, SBANK);             << DB BANK >>      <<03603>>57136000
          SSEA( ADR+5D, INFO(INITDB));      << DB >>           <<03603>>57138000
      END <<BOOTSTRAP>> ;                                               57140000
$PAGE "CODE SEGMENT ABSENCE"                                            57142000
$CONTROL SEGMENT=RESIDENT                                               57144000
COMMENT                                                                 57146000
  THESE PROCEDURES ARE USED WHEN ONE OF INITIAL'S CODE SEGMENTS WHICH   57148000
IS ABSENT IS THE TARGET OF EITHER A PCAL OR AN EXIT INSTRUCTION. THEY   57150000
REFERENCE A TABLE IN INITIAL'S DL AREA (SWAPD) WHICH CONTAINS A 5-WORD  57152000
DESCRIPTOR FOR EACH AVAILABLE SWAPPING AREA (THE SWAPPING AREAS ARE OF  57154000
THE SAME LENGTH, EQUAL TO THE SIZE OF THE LARGEST SEGMENT WHICH IS      57156000
SWAPPED). THE DESCRIPTOR IS FORMATTED AS FOLLOWS:                       57158000
                                                                        57160000
      WORD            CONTENTS                                          57162000
      ----            --------                                          57164000
       0       CST NUMBER                                               57166000
       1       HIGH ORDER CORE ADDRESS                                  57168000
       2       LOW ORDER CORE ADDRESS                                   57170000
       3       LINK TO NEXT MOST LIKELY SEGMENT                         57172000
       4       LINK TO NEXT LEAST LIKELY SEGMENT                        57174000
                                                                        57176000
THE DESCRIPTORS ARE LINKED THROUGH THE 4TH AND 5TH WORDS, WHICH ARE     57178000
POINTERS TO THE NEXT MOST LIKELY ENTRY TO SWAP AND NEXT LEAST LIKELY    57180000
ENTRY TO SWAP, RESPECTIVELY. A ZERO IS THE TERMINATOR FOR THESE LISTS.  57182000
TWO WORDS IN PRIMARY DB, MLSWAP AND LLSWAP, ARE USED AS THE HEADS OF    57184000
THESE LISTS;                                                            57186000
                                                                        57188000
          <<---------------------------------------------------         57190000
            REMOVE ENTRY FROM SWAPPING DESCRIPTOR LINKED LIST           57192000
          --------------------------------------------------->>         57194000
  PROCEDURE REMOVENTRY(INDEX);                                          57196000
    VALUE INDEX;                                                        57198000
    INTEGER INDEX;                                                      57200000
    COMMENT                                                             57202000
      REMOVE THE ENTRY NUMBER INDEX FROM THE SWAPPING DESCRIPTOR LINKED 57204000
    LISTS;                                                              57206000
      BEGIN                                                             57208000
          TOS := SWAPD(INDEX*SWAPDSIZE+3); <<NEXT MOST LIKELY PTR>>     57210000
          TOS := SWAPD(X:=X+1);  <<NEXT LEAST LIKELY PTR>>              57212000
          IF = THEN                                                     57214000
            BEGIN   <<THIS GUY WAS MOST LIKELY>>                        57216000
              DEL;                                                      57218000
              MLSWAP := TOS;   <<NEW MOST LIKELY>>                      57220000
              IF MLSWAP=0 THEN MLSWAP := 3;  <<ONLY ONE SEGMENT>>       57222000
            END                                                         57224000
          ELSE                                                          57226000
            BEGIN                                                       57228000
              ASSEMBLE(DECA,STAX);                                      57230000
              SWAPD(X) := TOS;  <<RELINK NEXT MOST LIKELY PTR>>         57232000
            END;                                                        57234000
          TOS := SWAPD(INDEX*SWAPDSIZE+4);                              57236000
          TOS := SWAPD(X:=X-1);   <<NEXT MOST LIKELY PTR>>              57238000
          IF = THEN                                                     57240000
            BEGIN   <<THIS GUY WAS LEAST LIKELY>>                       57242000
              DEL;                                                      57244000
              LLSWAP := TOS;   <<NEW LEAST LIKELY>>                     57246000
            END                                                         57248000
          ELSE                                                          57250000
            BEGIN                                                       57252000
              ASSEMBLE(INCA,STAX);                                      57254000
              SWAPD(X) := TOS;  <<RELINK NEXT LEAST LIKELY PTR>>        57256000
            END;                                                        57258000
      END <<REMOVENTRY>> ;                                              57260000
                                                                        57262000
          <<--------------------------------------                      57264000
            INSERT ENTRY AS LEAST LIKELY TO SWAP                        57266000
          -------------------------------------->>                      57268000
  PROCEDURE INSERTLLSWAP(INDEX);                                        57270000
    VALUE INDEX;                                                        57272000
    INTEGER INDEX;                                                      57274000
    COMMENT                                                             57276000
      INSERT ENTRY NUMBER INDEX AT THE HEAD OF THE LEAST LIKELY LIST    57278000
    AND THE TAIL OF THE MOST LIKELY LIST;                               57280000
      BEGIN                                                             57282000
          SWAPD(INDEX*SWAPDSIZE+4) := LLSWAP; <<PTR TO OLD LLSWAP>>     57284000
          SWAPD(X:=X-1) := 0;    <<END OF MLSWAP LIST>>                 57286000
          ASSEMBLE(LDXA,DUP);                                           57288000
          IF LLSWAP=0 THEN DEL  <<ONLY ONE SEGMENT>>                    57290000
          ELSE SWAPD(LLSWAP-1) := TOS;  <<NEXT MOST LIKELY PTS HERE>>   57292000
          LLSWAP := TOS+1;  <<NEW LEAST LIKELY PTR>>                    57294000
      END <<INSERTLLSWAP>> ;                                            57296000
                                                                        57298000
          <<----------------------------------                          57300000
            MAKE ABSENT CODE SEGMENT PRESENT                            57302000
          ---------------------------------->>                          57304000
  PROCEDURE MAKEPRESENT;                                                57306000
    COMMENT                                                             57308000
      CALLED FROM THE ENTRY POINT IN SEGMENT ONE FOR CODE SEGMENT       57310000
    ABSENCE. THE PARAMETER STACKED BY THE HARDWARE IS THEREFORE         57312000
    AT Q-4 BECAUSE OF THE EXTRA PCAL. THE ABSENT SEGMENT IS BROUGHT     57314000
    INTO CORE AND IS INSERTED IN THE SWAPPING DESCRIPTOR LINKED LIST    57316000
    AS THE LEAST LIKELY SEGMENT TO SWAP. FOR PCAL'S, THE CALLING        57318000
    SEGMENT IS MADE TO BE THE SECOND LEAST LIKELY SEGMENT TO SWAP.      57320000
    FOR PCAL'S, A NORMAL EXIT IS MADE AFTER SETTING THE CORRECT         57322000
    PB-RELATIVE ADDRESS IN THE PREVIOUS MARKER, WHILE FOR EXITS THE     57324000
    PREVIOUS MARKER IS SKIPPED OVER BY RESETTING Q AND THE EXIT IS MADE 57326000
    DIRECTLY TO THE FORMERLY ABSENT SEGMENT;                            57328000
      BEGIN                                                             57330000
        INTEGER PARM=Q-4,      <<PARAMETER PASSED BY HARDWARE>>         57332000
                STATUS=Q-6,    <<MARKER STATUS>>                        57334000
                PREL=Q-7,      <<MARKER RELATIVE P>>                    57336000
                OLDSTAT=Q-10,  <<STATUS IN PREVIOUS MARKER>>            57338000
                I,             <<INDEX>>                                57340000
                ABSCST,        <<CST # OF ABSENT SEGMENT>>              57342000
                LEN;           <<LENGTH OF SEGMENT>>                    57344000
        DOUBLE  OLDDB,         <<ORIGINAL DB VALUE>>                    57346000
                COREADR;       <<ABSOLUTE ADDRESS OF CODE SEGMENT>>     57348000
          TOS := ABSOLUTE(DBBANK);                                      57350000
          TOS := ABSOLUTE(DB);                                          57352000
          ASSEMBLE(XCHD);   <<SET DB TO STACK>>                         57354000
          OLDDB := TOS;  <<SAVE ORIGINAL DB VALUE>>                     57356000
          TOS := IF PARM<0 THEN  PARM ELSE STATUS;                      57358000
          ABSCST := TOS.(8:8);  <<CST # OF ABSENT SEGMENT>>             57360000
          IF PARM<0 THEN                                                57362000
            BEGIN  <<PCAL - MAKE CALLING SEGMENT LEAST LIKELY>>         57364000
              I := 0;                                                   57366000
              DO IF SWAPD(I*SWAPDSIZE)=OLDSTAT.(8:8) THEN               57368000
              IF SWAPD(X:=X+3)=0 THEN GOTO GETML  <<ALREADY LEAST>>     57370000
              ELSE                                                      57372000
                BEGIN  <<MAKE LEAST LIKELY>>                            57374000
                  REMOVENTRY(I);                                        57376000
                  INSERTLLSWAP(I);                                      57378000
                  GOTO GETML;                                           57380000
                END                                                     57382000
              UNTIL (I:=I+1)=NSWAPSEG;                                  57384000
            END;                                                        57386000
  GETML:  TOS := MLSWAP-3;  <<INDEX OF MOST LIKELY TO SWAP ENTRY>>      57388000
          ASSEMBLE(DUP,STAX);                                           57390000
          TOS := SWAPD(X); <<CST #>>                                    57392000
          IF <> THEN                                                    57394000
            BEGIN  <<SET OLD SEGMENT ABSENT>>                           57396000
              X := TOS&LSL(2)+ABSOLUTE(CSTP);                           57398000
              ABSOLUTE(X).(0:1) := 1;  <<ABSENCE BIT>>                  57400000
            END                                                         57402000
          ELSE DEL;                                                     57404000
          ASSEMBLE(DUP,STAX);                                           57406000
          SWAPD(X) := ABSCST;  <<SET NEW CST # IN DESCRIPTOR>>          57408000
          TOS := SWAPD(X:=X+1);                                         57410000
          TOS := SWAPD(X:=X+1);                                         57412000
          COREADR := TOS;  <<ABSOLUTE CORE ADDRESS>>                    57414000
          TOS := ABSOLUTE(ABSOLUTE(CSTP)+ABSCST&LSL(2));                57416000
          LEN := S0.(4:12)&LSL(2);  <<LENGTH OF CODE SEGMENT>>          57418000
          ASSEMBLE(TRBC 0);  <<PRESENT NOW>>                            57420000
          ABSOLUTE(X) := TOS;                                           57422000
          TOS := COREADR;                                               57424000
          ABSOLUTE(X:=X+3) := TOS;                                      57426000
          ABSOLUTE(X:=X-1) := TOS;  <<PUT CORE ADDRESS IN CST ENTRY>>   57428000
          TOS := TOS/SWAPDSIZE;  <<ENTRY INDEX>>                        57430000
          REMOVENTRY(S0);                                               57432000
          INSERTLLSWAP(*);  <<MAKE ENTRY LEAST LIKELY TO SWAP>>         57434000
          DISC'(READ,SYSDISC,TCSTDISC(ABSCST),COREADR,LEN);             57436000
          TOS := OLDDB;                                                 57438000
          SET(DB);  <<RESET DB WHERE IT WAS>>                           57440000
          TOS := 1;         <<CODE TO MAKE -PRESENT>>          <<03603>>57442000
          TOS := ABSCST;   <<PUSH SEG # FOR HELP>>             <<03603>>57444000
          HELP'MAKE'PRESENT;  <<FIX UP BRKPTS>>                <<03603>>57446000
          DDEL;           <<DELETE CODE,SEG # >>               <<03603>>57448000
                                                               <<03603>>57450000
          IF PARM>=0 THEN                                               57452000
            BEGIN  <<EXIT>>                                             57454000
              TOS := PARM;  <<PARAMETER FOR EXIT>>                      57456000
              PUSH(Q);                                                  57458000
              TOS := TOS-5;                                             57460000
              SET(Q);  <<SKIP OVER MARKER STACKED FOR SEG 1>>           57462000
              TOS := %31400;  <<EXIT INSTRUCTION>>                      57464000
              ASSEMBLE(OR; XEQ 0);  <<EXIT>>                            57466000
            END;                                                        57468000
          TOS := COREADR; <<ABS ADDRESS OF BASE OF SEGMENT>>            57470000
          TOS := TOS+LEN-PARM.(1:7)-1; <<POINT INTO STT>>               57472000
          ASSEMBLE(LSEA);  <<GET LOCAL LABEL FROM STT>>                 57474000
          TOS.(1:1) := 0; << RESET UNCALLABLE BIT >>           <<B7916>>57476000
          IF LOGICALMAPPING THEN TOS.MAPFLAG := 1;             <<*MAP*>>57478000
          PREL := TOS;         << PUT RELATIVE P IN MARKER >>  <<*MAP*>>57480000
      END <<MAKEPRESENT>> ;                                             57482000
$CONTROL SEGMENT=MAINSEG3                                      <<PMBC*>>57484000
PROCEDURE INIT'PMBC;                                           <<PMBC*>>57486000
BEGIN                                                          <<PMBC*>>57488000
   << This procedure will initialize a table of lengths >>     <<PMBC*>>57490000
   << for the PMBC microcode.  This table is used by    >>     <<PMBC*>>57492000
   << the PMBC to check the instructions LST/SST to be  >>     <<PMBC*>>57494000
   << sure they are not accessing outside the bounds of >>     <<PMBC*>>57496000
   << the table.   If the sign bit is set the PMBC will >>     <<PMBC*>>57498000
   << allow negative accessing of 64 locations, this is >>     <<PMBC*>>57500000
   << needed for such tables as the ICS.  The lengths   >>     <<PMBC*>>57502000
   << are stored divided by four, this will allow       >>     <<PMBC*>>57504000
   << addressing of a full 64K of core.                 >>     <<PMBC*>>57506000
                                                               <<PMBC*>>57508000
   INTEGER ARRAY SYSTODST(*) = PB :=                           <<PMBC*>>57510000
      CSTIX,         CSTDSTN,                                  <<PMBC*>>57512000
      DSTIX,         DSTDSTN,                                  <<PMBC*>>57514000
      PCBIX,         PCBDSTN,                                  <<PMBC*>>57516000
      IOQIX,         IOQDSTN,                                  <<PMBC*>>57518000
      SBUFIX,        SBUFDSTN,                                 <<PMBC*>>57520000
      LPDTIX,        LPDTDSTN,                                 <<PMBC*>>57522000
      TRLIX,         TRLDSTN,                                  <<PMBC*>>57524000
      JCUTIX,        JCUTDSTN,                                 <<PMBC*>>57526000
      SIRIX,         SIRDSTN,                                  <<PMBC*>>57528000
      JPCNTIX,       JPCTDSTN,                                 <<PMBC*>>57530000
      TBUFIX,        TBUFDSTN,                                 <<PMBC*>>57532000
      SWAPTABIX,     SWAPTABDSTN,                              <<PMBC*>>57534000
      VDSMTABIX,     VDSMDSTN,                                 <<PMBC*>>57536000
      DISCREQTABIX,  DISCREQTABDSTN,                           <<PMBC*>>57538000
      CSTBLKIX,      CSTBLKDSTN,                               <<PMBC*>>57540000
      MEASINFOTABIX, MEASINFOTABDSTN,                          <<PMBC*>>57542000
      0;                                                       <<PMBC*>>57544000
   INTEGER                                                     <<PMBC*>>57546000
      PMBCADR,                                                 <<PMBC2>>57548000
      DSTENTRIES,                                              <<P8801>>57550000
      CSTENTRIES,                                              <<P8801>>57552000
      CSTXENTRIES,                                             <<P8801>>57554000
      I;                                                       <<PMBC*>>57556000
                                                               <<PMBC*>>57558000
   << ONLY BUILD THE PMBC TABLE IF PMBC MIRCOCODE EXISTS >>    <<PMBC*>>57560000
   IF NOT PMBCFIRMWARE THEN RETURN;                            <<PMBC*>>57562000
                                                               <<PMBC*>>57564000
   PMBCADR := ABS(SYSPMBC);                                    <<PMBC2>>57566000
                                                               <<PMBC*>>57568000
   I := 0;                                                     <<PMBC*>>57570000
   WHILE SYSTODST(I) <> 0 DO                                   <<PMBC*>>57572000
      BEGIN                                                    <<PMBC*>>57574000
      ABS(PMBCADR+SYSTODST(I)) := DST(SYSTODST(I+1)*4).(3:13); <<PMBC*>>57576000
      I := I+2;                                                <<PMBC*>>57578000
      END;                                                     <<PMBC*>>57580000
                                                               <<PMBC*>>57582000
   DSTENTRIES := (CTAB(DSTNUM)+7)/8*8;                         <<P8801>>57584000
   CSTENTRIES := IF LOGICALMAPPING THEN                        <<P8801>>57586000
                    CTAB(CSTNUM) + SYSPHYCST                   <<P8801>>57588000
                 ELSE IF CTAB(CSTNUM) > SYSPHYCST              <<P8801>>57590000
                         THEN SYSPHYCST                        <<P8801>>57592000
                 ELSE CTAB(CSTNUM);                            <<P8801>>57594000
   CSTENTRIES := (CSTENTRIES + 7)/8*8;                         <<P8801>>57596000
   CSTXENTRIES := (CTAB(CSTXNUM)+7)/8*8;                       <<P8801>>57598000
   IF CSTXENTRIES = 8192 THEN CSTXENTRIES := 8191;             <<P8801>>57600000
   ABS(PMBCADR) := %137777;                  << SYSGLOBAL >>   <<PMBC*>>57602000
   ABS(PMBCADR+ICSIX) := %100000;            << ICS >>         <<PMBC*>>57604000
   ABS(PMBCADR+MONBUFIX) := %100400;         << MON BUF >>     <<PMBC*>>57606000
   ABS(PMBCADR+DRTIX) := HIDRT+1;            << DRT >>         <<PMBC*>>57608000
   ABS(PMBCADR+DSTIX) := DSTENTRIES + CSTENTRIES  +            <<P8801>>57610000
      CSTXENTRIES + 1;                                         <<P8801>>57612000
   ABS(PMBCADR+SYSEXTPTR'DB) := SYSEXTSIZE/4;<< SYS EXT >>     <<PMBC*>>57614000
END; << INIT'PMBC >>                                           <<PMBC*>>57616000
$PAGE "NON-RESPONDING-MODULE-INTERRUPT HANDLER"                <<00888>>57618000
$CONTROL SEGMENT=MAINSEG1                                      <<03002>>57620000
   LOGICAL PROCEDURE VERIFY'PHYS'MEMORY (KWORDS);              <<03002>>57622000
   <<===========================================>>             <<03002>>57624000
       VALUE KWORDS;  INTEGER KWORDS;                          <<03002>>57626000
       OPTION VARIABLE;                                        <<*8957>>57628000
                                                               <<03002>>57630000
    BEGIN                                                      <<03002>>57632000
                                                               <<03002>>57634000
    <<======================================================>> <<03002>>57636000
    << THIS PROCEDURE TESTS CONFIGURED MEMORY SIZE:         >> <<03002>>57638000
    <<   INSURES THAT "KWORDS" IS A VALID SIZE              >> <<03002>>57640000
    <<   DETERMINES ACTUAL PHYSICAL MEMORY AVAILABLE        >> <<03002>>57642000
    <<   INSURES THAT "KWORDS" <= ACTUAL PHYSICAL MEMORY    >> <<03002>>57644000
    <<   UPDATES GLOBAL "COREX" INDEX                       >> <<03002>>57646000
    <<   UPDATES CTAB0 VALUES, AND CONFDATA POINTERS        >> <<03002>>57648000
    <<   IF KWORDS IS NOT SPECIFIED THEN THE TABLES WILL  BE>> <<*8957>>57650000
    <<   UPDATED TO REFLECT THE AMOUNT OF PHYSICAL MEMORY   >> <<*8957>>57652000
    <<======================================================>> <<03002>>57654000
                                                               <<03002>>57656000
            << GENERAL MEMORY INFORMATION >>                   <<03002>>57658000
            <<============================>>                   <<03002>>57660000
                                                               <<03002>>57662000
    <<  BYTES    WORDS    BANKS   BANK-BITS   MAX-CONFIG    >> <<03002>>57664000
    <<  -----    -----    -----   ---------   ----------    >> <<03002>>57666000
    <<  128K     64K        1                 SERIES-I      >> <<03002>>57668000
    <<  256K     128K       2         1                     >> <<03002>>57670000
    <<  512K     256K       4         2       SERIES-II     >> <<03002>>57672000
    <<  1M       512K       8         3                     >> <<03002>>57674000
    <<  2M       1M         16        4       SER-III ICF-33>> <<03002>>57676000
    <<  4M       2M         32        5       SERIES-37     >> <<C8392>>57678000
    <<  8M       4M         64        6                     >> <<03002>>57680000
    <<  16M      8M         128       7                     >> <<03002>>57682000
    <<  32M      16M        256       8       ICF-44        >> <<03002>>57684000
    <<  64M      32M        512       9                     >> <<03002>>57686000
    <<  128M     64M        1024      10                    >> <<03002>>57688000
    <<  256M     128M       2048      11                    >> <<03002>>57690000
    <<  512M     256M       4096      12                    >> <<03002>>57692000
    <<  1G       512M       8192      13                    >> <<03002>>57694000
    <<  2G       1G         16384     14                    >> <<03002>>57696000
    <<  4G       2G         32768     15                    >> <<03002>>57698000
    <<  8G       4G         65536     16      ICF-55        >> <<03002>>57700000
    <<===================================================== >> <<03002>>57702000
                                                               <<03002>>57704000
                                                               <<03002>>57706000
        <<AN ARRAY OF VALID CORESIZES,INDEXED BY "COREX">>     <<03002>>57708000
                                                               <<03002>>57710000
        INTEGER ARRAY CORESIZES(0:NCORESIZES-1) = PB :=        <<03002>>57712000
        64, 80, 96, 128, 160, 192, 224, 256, 384, 512, 768,    <<03002>>57714000
        1024, 1152, 1280, 1408, 1536, 1664, 1792, 1920, 2048,  <<03002>>57716000
        2176, 2304, 2432, 2560, 2688, 2816, 2944, 3072,        <<03002>>57718000
        3200, 3328, 3456, 3584, 3712, 3840, 3968, 4096;        <<03002>>57720000
                                                               <<03002>>57722000
        <<AN ARRAY INDEXED BY "THISCPU" TYPE >>                <<03002>>57724000
        <<WHICH CONTAINS THE APPROPRIATE INDEX INTO>>          <<03002>>57726000
        <<CORESIZES FOR THE "MAX" SUPPORTED BY THE CPU. >>     <<03002>>57728000
        <<NOTE: AS IMPLEMENTED HERE, ICF/44,55 ARE >>          <<03002>>57730000
        <<RESTRICTED TO 64 BANKS CAPABILITY>>                  <<03002>>57732000
                                                               <<03002>>57734000
        INTEGER ARRAY MAXCPU'COREX (0:6) = PB :=               <<C8392>>57736000
           0,   <<CPU-0   SERIES-I   64K>>                     <<03002>>57738000
           7,   <<CPU-1   SERIES-II  256K    4 BANKS (2)  >>   <<03002>>57740000
          11,   <<CPU-2   SERIES-33  1M     16 BANKS (4)  >>   <<03002>>57742000
          11,   <<CPU-3   SERIES-III 1M     16 BANKS (4)  >>   <<03002>>57744000
          35,   <<CPU-4   ICF-44     4M     64 BANKS (6)  >>   <<03002>>57746000
          35,   <<CPU-5   ICF-55     4M     64 BANKS (6)  >>   <<C8392>>57748000
          19;   <<CPU-6   SERIES-37  2M     32 BANKS (5)  >>   <<C8392>>57750000
                                                               <<03002>>57752000
        DEFINE MCMD = ASSEMBLE( CON %20104; << ICF'55 MCMD >>  <<03746>>57754000
                                CON      4 )#;                 <<03746>>57756000
        LOGICAL MASK = Q-4;        << OPTION VARIABLE MASK >>  <<*8957>>57758000
        DOUBLE STATUS; << RETURNED BY MCMD >>                  <<03746>>57760000
        LOGICAL MSTATUS = STATUS,                              <<03746>>57762000
                LSTATUS = STATUS+1;                            <<03746>>57764000
        INTEGER NR'BANKS;                                      <<03746>>57766000
        INTEGER MAXCOREX,          <<INDEX CPU SUPPORTS>>      <<03002>>57768000
                INDEX,             <<USED FOR TESTING>>        <<03002>>57770000
                PHYS'SIZE;         <<ACTUAL PHYS CORESIZE>>    <<03002>>57772000
                                                               <<03002>>57774000
        LOGICAL VALIDSIZE,         <<SPECIFIED SIZE VALID>>    <<03002>>57776000
                FOUND'PHYS'SIZE;   <<TRUE WHEN WE HAVE >>      <<03002>>57778000
                                   <<ESTABLISHED ACTUAL >>     <<03002>>57780000
                                   <<PHYSICAL CORESIZE>>       <<03002>>57782000
                                                               <<03002>>57784000
                                                               <<03002>>57786000
       <<------------------------------------------------>>    <<03002>>57788000
                                                               <<03002>>57790000
     VALIDSIZE := FALSE;      <<ASSUME FAILURE>>               <<03002>>57792000
     COREX := 0;              <<START AT LOWEST SIZE>>         <<03002>>57794000
                                                               <<*8957>>57796000
             <<LOOK UP INDEX OF MAX CONFIG FOR THIS CPU>>      <<*8957>>57798000
                                                               <<*8957>>57800000
         MAXCOREX := MAXCPU'COREX( THISCPU);                   <<*8957>>57802000
                                                               <<03002>>57804000
            <<CONFIRM THAT "KWORDS" IS A VALID MEMORY SIZE>>   <<03002>>57806000
            <<EVEN IF IT EXCEEDS AVAILABLE PHYSICAL MEMORY>>   <<03002>>57808000
                                                               <<03002>>57810000
     IF MASK THEN                                              <<*8957>>57812000
        DO IF CORESIZES (COREX) = KWORDS                       <<*8957>>57814000
           THEN VALIDSIZE := TRUE                              <<*8957>>57816000
        UNTIL VALIDSIZE OR (COREX:=COREX+1) = NCORESIZES       <<*8957>>57818000
     ELSE                                                      <<*8957>>57820000
        BEGIN                                                  <<*8957>>57822000
        VALIDSIZE := TRUE;                                     <<*8957>>57824000
        COREX :=  MAXCOREX;                                    <<*8957>>57826000
        END;                                                   <<*8957>>57828000
                                                               <<03002>>57830000
     IF NOT VALIDSIZE                                          <<03002>>57832000
     THEN MESSAGE (M2453)   <<INVALID CORESIZE>>               <<03002>>57834000
     ELSE BEGIN    <<VALID CORESIZE>>                          <<03002>>57836000
                                                               <<03002>>57838000
         INDEX := 3;          <<START AT 128K>>                <<03002>>57840000
                                                               <<03002>>57842000
         FOUND'PHYS'SIZE := FALSE;                             <<03002>>57844000
                                                               <<03002>>57846000
            <<DETERMINE HOW MUCH PHYSICAL MEMORY IS >>         <<03746>>57848000
            <<ACTUALLY AVAILABLE BY WRITING A PATTERN>>        <<03746>>57850000
            <<AND THEN READING IT BACK. >>                     <<03746>>57852000
                                                               <<03746>>57854000
         IF ICF55 THEN                                         <<03746>>57856000
            BEGIN                                              <<03746>>57858000
            << Read status message to memory >>                <<03746>>57860000
            TOS := [7/0,1/1,24/0]D;                            <<03746>>57862000
            TOS := [6/0,4/%12,<<CSB bus op; Send word>>        <<03746>>57864000
                    3/7,      <<CSB address of memory module>> <<03746>>57866000
                    3/3];     <<Go busy, Reply expected>>      <<03746>>57868000
            MCMD;                                              <<03746>>57870000
            STATUS := TOS; <<See memory ERS of Status>>        <<03746>>57872000
            MSTATUS := MSTATUS LAND %777;<<Isolate mem size &>><<03746>>57874000
            LSTATUS := LSTATUS LAND %177400;<<NR. array bits>> <<03746>>57876000
            ASSEMBLE(                                          <<03746>>57878000
               LDD STATUS;                                     <<03746>>57880000
               DCSR 11;                                        <<03746>>57882000
               LSL 1;                                          <<03746>>57884000
               STOR NR'BANKS; << NR. OF BANKS >>               <<03746>>57886000
               DEL  );                                         <<03746>>57888000
            PHYS'SIZE := NR'BANKS*64;                          <<03746>>57890000
            END                                                <<03746>>57892000
         ELSE                                                  <<03746>>57894000
            DO BEGIN                                           <<03746>>57896000
             PHYS'SIZE := CORESIZES(INDEX);                    <<03002>>57898000
                                                               <<03002>>57900000
             COMMENT:                                          <<03002>>57902000
             ************************************************* <<03002>>57904000
             BE CAREFUL OF THIS SECTION OF CODE--IT WILL BITE. <<03002>>57906000
             1-INSTRUCTION FOLLOWING SSEA MUST BE LSEA.        <<03002>>57908000
             2-LSEA ISN'T GUARANTEED TO PUSH A VALUE, SO DON'T <<03002>>57910000
               JUST BLINDLY DELETE TOS.                        <<03002>>57912000
             3-THIS CODE IS TIED TO MODERR, SO CHANGE BOTH IF  <<03002>>57914000
               YOU CHANGE EITHER.                              <<03002>>57916000
             ************************************************* <<03002>>57918000
             END OF COMMENT;                                   <<03002>>57920000
                                                               <<03002>>57922000
             TOS := DOUBLE(PHYS'SIZE)*1024D-1D;                <<03002>>57924000
             ASSEMBLE(DDUP);                                   <<03002>>57926000
             TOS := %12345;           <<ARBITRARY PATTERN>>    <<03002>>57928000
             ASSEMBLE( SSEA; LSEA);   <<WRITE THEN READ BACK>> <<03002>>57930000
             IF S0 <> %12345                                   <<03002>>57932000
             THEN BEGIN               <<MEMORY MISSING>>       <<03002>>57934000
                 FOUND'PHYS'SIZE := TRUE;                      <<03002>>57936000
                 PHYS'SIZE := CORESIZES( INDEX-1);             <<03002>>57938000
                 <<THIS WRITE-READ FAILED SO >>                <<03002>>57940000
                 <<LAST INDEX WAS ACTUAL SIZE>>                <<03002>>57942000
                  END                                          <<03002>>57944000
             ELSE BEGIN                                        <<03002>>57946000
                 INDEX := INDEX + 1; <<TRY NEXT SIZE>>         <<03002>>57948000
                 DDEL;DDEL;DEL;      <<REMOVE ADDRS,VAL>>      <<03002>>57950000
              END;                                             <<03002>>57952000
$PAGE "MAINSEG1  --  INITIALIZATION"                                    57954000
         END UNTIL FOUND'PHYS'SIZE OR INDEX>COREX OR           <<03002>>57956000
                   INDEX > MAXCOREX;                           <<03002>>57958000
                                                               <<03002>>57960000
                                                               <<03002>>57962000
         IF NOT MASK THEN << SET MEMORY TO MAX >>              <<*8957>>57964000
            KWORDS := PHYS'SIZE;                               <<*8957>>57966000
                                                               <<*8957>>57968000
         IF KWORDS > PHYS'SIZE                                 <<03002>>57970000
         THEN BEGIN                                            <<03002>>57972000
             MESSAGE(M124);                                    <<03002>>57974000
             <<CONFIGURED MEMORY EXCEEDS PHYSICAL>>            <<03002>>57976000
             MESSAGE(M2412,PHYS'SIZE);                         <<03002>>57978000
             <<PHYSICAL MEMORY AVAILABLE IS XXX>>              <<03002>>57980000
             END                                               <<03002>>57982000
                                                               <<03002>>57984000
         ELSE BEGIN    <<SUFFICIENT PHYS MEM>>                 <<03002>>57986000
             VERIFY'PHYS'MEMORY := TRUE;  <<SUCCESS>>          <<03002>>57988000
                                                               <<03002>>57990000
             CTAB0(CORESIZE) := KWORDS;                        <<03002>>57992000
           END;    <<SUFFICIENT PHYS MEM>>                     <<03002>>57994000
     END;  <<VALID CORESIZE>>                                  <<03002>>57996000
    END;  <<PROCEDURE VERIFY'PHYS'MEMORY>>                     <<03002>>57998000
PROCEDURE GETDSTS;                                             <<DSTS*>>58000000
BEGIN                                                          <<DSTS*>>58002000
   INTEGER ARRAY DSTS(0:31)=Q;                                 <<DSTS*>>58004000
   LOGICAL LAST;                                               <<DSTS*>>58006000
   INTEGER                                                     <<DSTS*>>58008000
      NRDSTS,                                                  <<DSTS*>>58010000
      CNT,                                                     <<DSTS*>>58012000
      NUM;                                                     <<DSTS*>>58014000
                                                               <<DSTS*>>58016000
   GO START;                                                   <<DSTS*>>58018000
ERROR:                                                         <<DSTS*>>58020000
   MESSAGE(M2453);  << INVALID INPUT >>                        <<DSTS*>>58022000
START:                                                         <<DSTS*>>58024000
   MOVE BLINE := ("ENTER DST NUMBERS OF TABLES TO BE BUILT",   <<DSTS*>>58026000
      " OUTSIDE OF BANK 0");                                   <<DSTS*>>58028000
   PRINTLINE;                                                  <<DSTS*>>58030000
   READINPUT;                                                  <<DSTS*>>58032000
                                                               <<DSTS*>>58034000
   LAST := FALSE;                                              <<DSTS*>>58036000
   NRDSTS := 0;                                                <<DSTS*>>58038000
   DO BEGIN                                                    <<DSTS*>>58040000
      NUM := INVAL(@ERROR);                                    <<DSTS*>>58042000
      PUSH( STATUS );                                          <<DSTS*>>58044000
      CASE TOS.(6:2) OF                                        <<DSTS*>>58046000
         BEGIN                                                 <<DSTS*>>58048000
                                                               <<DSTS*>>58050000
<<CCG>>     BEGIN                                              <<DSTS*>>58052000
            DSTS(NRDSTS) := NUM;                               <<DSTS*>>58054000
            LAST := TRUE;                                      <<DSTS*>>58056000
            NRDSTS := NRDSTS+1;                                <<DSTS*>>58058000
            END;                                               <<DSTS*>>58060000
                                                               <<DSTS*>>58062000
<<CCL>>     BEGIN                                              <<DSTS*>>58064000
            DSTS(NRDSTS) := NUM;                               <<DSTS*>>58066000
            NRDSTS := NRDSTS+1;                                <<DSTS*>>58068000
            END;                                               <<DSTS*>>58070000
                                                               <<DSTS*>>58072000
<<CCE>>     LAST := TRUE;                                      <<DSTS*>>58074000
                                                               <<DSTS*>>58076000
         END;                                                  <<DSTS*>>58078000
      END                                                      <<DSTS*>>58080000
   UNTIL LAST;                                                 <<DSTS*>>58082000
                                                               <<DSTS*>>58084000
   CNT := 0;                                                   <<DSTS*>>58086000
   WHILE NRDSTS > CNT DO                                       <<DSTS*>>58088000
      BEGIN                                                    <<DSTS*>>58090000
      SETBIT( BK1DSEG, DSTS(CNT) );                            <<DSTS*>>58092000
      CNT := CNT+1;                                            <<DSTS*>>58094000
      END;                                                     <<DSTS*>>58096000
END;                                                           <<DSTS*>>58098000
PROCEDURE SYSTAB'CH;                                           <<sytab>>58100000
BEGIN                                                          <<sytab>>58102000
   GETNEWVAL(3001,CTAB(CSTNUM),80,2048);                       <<sytab>>58104000
   GETNEWVAL(3002,CTAB(CSTXNUM),16,8191);                      <<sytab>>58106000
   GETNEWVAL(3003,CTAB(DSTNUM),70,4096);                       <<sytab>>58108000
   GETNEWVAL(3004,CTAB(PCBNUM),12,1024);                       <<sytab>>58110000
   GETNEWVAL(3005,CTAB(IOQNUM),20,1300);                       <<sytab>>58112000
   GETNEWVAL(3006,CTAB(DISCREQTABLE),20,900);                  <<sytab>>58114000
   GETNEWVAL(3007,CTAB(TBUFNUM),1,%143);                       <<sytab>>58116000
   GETNEWVAL(3008,CTAB(SBUFNUM),8,253);                        <<sytab>>58118000
   GETNEWVAL(3009,CTAB(SWAPTABLE),128,5400);                   <<SWAP2>>58120000
   GETNEWVAL(3010,CTAB(PRIMARYMSGTABLE),10,1023);              <<j8918>>58122000
   GETNEWVAL(3011,CTAB(SECNDRYMSGTABLE),10,1023);              <<j8918>>58124000
   GETNEWVAL(3012,CTAB(SPECIALREQTABLE),10,2048);              <<j8918>>58126000
   GETNEWVAL(3013,CTAB(ICSSIZE),256,4096);                     <<sytab>>58128000
   GETNEWVAL(3017,CTAB(LSTSIZE),2048,32760);                   <<*LST3>>58130000
   GETNEWVAL(3014,CTAB(UCRQNUM),1,1024);                       <<sytab>>58132000
   GETNEWVAL(3015,CTAB(TRLNUM),6,1023);                        <<sytab>>58134000
   GETNEWVAL(3016,CTAB(STOPNUM),1,1024);                       <<sytab>>58136000
END;                                                           <<sytab>>58138000
$CONTROL SEGMENT=MAINSEG1                                               58140000
  PROCEDURE MAINSEG1;                                                   58142000
      BEGIN                                                             58144000
      COMMENT                                                           58146000
        THE TAPE SIO PROGRAM OR DISC COLD LOAD BOOTSTRAP HAS   <<zrela>>58148000
      READ MOST OF THE CONFIGURATION TABLES INTO INITIAL'S DL  <<zrela>>58150000
      AREA, 4 TABLES(LDT,LDTX,LPDT,DVRTAB), HOWEVER, ARE READ  <<zrela>>58152000
      INTO THE AREA ABOVE THE Z REGISTER DUE TO THEIR LARGE    <<zrela>>58154000
      POSSIBLE CONFIGURATION SIZE.  AT THIS POINT THE          <<zrela>>58156000
      POINTERS TO THE TABLES ARE INITIALIZED. THE AREA IS SET UP        58158000
      AS FOLLOWS (THE UNCHANGED COPY OF THE VOLUME TABLE (OLDVTAB) AND  58160000
      OLD DISC COLD LOAD INFORMATION TABLE (OLDINFO) ARE PRESENT ONLY   58162000
      IF THIS IS A COLD LOAD FROM A TAPE ON WHICH USER FILES WERE       58164000
      DUMPED):                                                          58166000
              CSTAB  => --------------------                            58168000
                        -        CS        -                            58170000
                        -      TABLE       -                            58172000
            TCLASS   => --------------------                   <<tclas>>58174000
                        -  TEMP CLASS      -                   <<tclas>>58176000
                        -    TABLE         -                   <<tclas>>58178000
            DCTAB HEAD=>--------------------                   <<tclas>>58180000
                        -  DEVICE CLASS    -                   <<tclas>>58182000
                        -  TABLE HEADER    -                   <<tclas>>58184000
                LPDT => --------------------                            58186000
                        - LOGICAL-PHYSICAL -                            58188000
                        -  DEVICE TABLE    -                            58190000
                 LDT => --------------------                            58192000
                        -    LOGICAL       -                            58194000
                        -  DEVICE TABLE    -                            58196000
             DCTAB   => --------------------                   <<tclas>>58198000
                        -  DEVICE CLASS    -                   <<tclas>>58200000
                        -      TABLE       -                            58202000
                TTDT => --------------------                   <<06067>>58204000
                        -  TERMTYPE DESCR  -                   <<06067>>58206000
                        -     TABLE        -                   <<06067>>58208000
                VTAB => --------------------                            58210000
                        -    VOLUME        -                            58212000
                        -     TABLE        -                            58214000
             OLDVTAB => --------------------                            58216000
                        -    UNCHANGED     -                            58218000
                        -   VOLUME TABLE   -                            58220000
             OLDINFO => --------------------                            58222000
                        -  OLD DISC COLD   -                            58224000
                        - LOAD INFO TABLE  -                            58226000
             RECBUF  => --------------------                   <<tclas>>58228000
                        - TEMP SERIAL DISC -                   <<tclas>>58230000
                        -      BUFFER      -                   <<tclas>>58232000
             TZTBUF  => --------------------                   <<tclas>>58234000
                        - TEMP SERIAL DISC -                   <<tclas>>58236000
                        -      BUFFER      -                   <<tclas>>58238000
                CTAB => --------------------                            58240000
                        - CURRENT CORESIZE -                            58242000
                        -  CONFIGURATION   -                            58244000
                        -    INFORMATION   -                            58246000
               CTAB0 => --------------------                            58248000
                        -   NON-CORESIZE   -                            58250000
                        -     RELATED      -                            58252000
                        -  CONFIGURATION   -                            58254000
                        -    INFORMATION   -                            58256000
                  DB => --------------------                   <<zrela>>58258000
                        -    INITIAL'S     -                   <<zrela>>58260000
                        -   DB - Z AREA    -                   <<zrela>>58262000
                   Z => --------------------                   <<zrela>>58264000
                        - %15 WORD BUFFER  -                   <<zrela>>58266000
                        -     AREA         -                   <<zrela>>58268000
              DVRTAB => --------------------                   <<zrela>>58270000
                        -     DRIVER       -                   <<zrela>>58272000
                        -      TABLE       -                   <<zrela>>58274000
                LPDT => --------------------                   <<zrela>>58276000
                        - LOGICAL-PHYSICAL -                   <<zrela>>58278000
                        -  DEVICE TABLE    -                   <<zrela>>58280000
                 LDT => --------------------                   <<zrela>>58282000
                        -    LOGICAL       -                   <<zrela>>58284000
                        -  DEVICE TABLE    -                   <<zrela>>58286000
                LDTX => --------------------                   <<zrela>>58288000
                        - LOGICAL DEVICE   -                   <<zrela>>58290000
                        - TABLE EXTENSION  -                   <<zrela>>58292000
                        --------------------                   <<zrela>>58294000
         ;                                                     <<zrela>>58296000
                                                                        58298000
        INTEGER ARRAY AUTOTBL(*) = PB :=                       <<*9006>>58300000
        <<     ID    TYPE  SUBTYPE    NAME     VMSIZE  >>      <<*9006>>58302000
           %(16)204,   3,      1,   "MH7911U0",  10,           <<*9006>>58304000
           %(16)208,   3,      2,   "MH7912U0",  10,           <<*9006>>58306000
           %(16)20A,   3,      4,   "MH7914U0",  20,           <<*9006>>58308000
           %(16)212,   3,      8,   "MH7935U0",  30,           <<*9006>>58310000
           %(16)220,   3,      5,   "MH7945U0",  10,           <<*9006>>58312000
           0; << TERMINATOR >>                                 <<*9006>>58314000
        EQUATE                                                 <<*9006>>58316000
           ATID        = 0,                                    <<*9006>>58318000
           ATTYPE      = ATID+1,                               <<*9006>>58320000
           ATSUBTYPE   = ATTYPE+1,                             <<*9006>>58322000
           ATNAME      = ATSUBTYPE+1,                          <<*9006>>58324000
           ATVMSIZE    = ATNAME+4,                             <<*9006>>58326000
           ATENTSIZE   = ATVMSIZE+1;                           <<*9006>>58328000
        BYTE ARRAY OPTS(0:8)=PB:="COL","UPD","REL";                     58330000
        INTEGER INX, VTABINX;                                  <<*9006>>58332000
       INTEGER  TYPE;     << DEVICE TYPE >>                    <<03603>>58334000
        INTEGER SUBTYP;     << DEVICE SUBTYPE >>               <<03550>>58336000
        INTEGER SIZE;       << TEMP >>                         <<03552>>58338000
                                                               <<03557>>58340000
        EQUATE SDISC=31,FDISC=7;                               <<MPEIV>>58342000
        BYTE ARRAY RELOPTS(0:14)=PB:="SPR","COM","RES","ACC","NUL";     58344000
          LOGICAL DSDEVICE;                                             58346000
        INTEGER ARRAY CORESIZES(0:NCORESIZES-1) = PB :=        <<01756>>58348000
        64, 80, 96, 128, 160, 192, 224, 256, 384, 512, 768,    <<01756>>58350000
        1024, 1152, 1280, 1408, 1536, 1664, 1792, 1920, 2048,  <<01756>>58352000
        2176, 2304, 2432, 2560, 2688, 2816, 2944, 3072,        <<01756>>58354000
        3200, 3328, 3456, 3584, 3712, 3840, 3968, 4096;        <<01756>>58356000
                                                               <<01756>>58358000
        DOUBLE ARRAY USEDCORE(0:NCORESIZES-1)=PB:=             <<01384>>58360000
        << LAST ADDRESS+1 FOR GIVEN MEMORY SIZE >>             <<01384>>58362000
        <<64K>>%200000D,   <<80K>>%240000D,                    <<01384>>58364000
        <<96K>>%300000D,   <<128K>>%400000D,                   <<01384>>58366000
        <<160K>>%500000D,  <<192K>>%600000D,                   <<01384>>58368000
        <<224K>>%700000D,  <<256K>>%1000000D,                  <<01384>>58370000
        <<384K>>%1400000D, <<512K>>%2000000D,                  <<01384>>58372000
        <<768K>>%3000000D, <<1024K>>%4000000D,                 <<01756>>58374000
        <<1152>>%4400000D, <<1280K>>%5000000D,                 <<01756>>58376000
        <<1408>>%5400000D, <<1536K>>%6000000D,                 <<01756>>58378000
        <<1664>>%6400000D, <<1792K>>%7000000D,                 <<01756>>58380000
        <<1920>>%7400000D, <<2048K>>%10000000D,                <<01756>>58382000
        <<2176>>%10400000D,<<2304K>>%11000000D,                <<01756>>58384000
        <<2432>>%11400000D,<<2560K>>%12000000D,                <<01756>>58386000
        <<2688>>%12400000D,<<2816K>>%13000000D,                <<01756>>58388000
        <<2944>>%13400000D,<<3072K>>%14000000D,                <<01756>>58390000
        <<3200>>%14400000D,<<3328K>>%15000000D,                <<01756>>58392000
        <<3456>>%15400000D,<<3584K>>%16000000D,                <<01756>>58394000
        <<3712>>%16400000D,<<3840K>>%17000000D,                <<01756>>58396000
        <<3968>>%17400000D,<<4096K>>%20000000D;                <<01756>>58398000
                                                               <<01756>>58400000
                                                               <<03557>>58402000
        INTEGER TEMP, COUNT;                                   <<zrela>>58404000
        POINTER PTR;   << TEMP FOR PTR TO IOTABLES           >><<zrela>>58406000
        LOGICAL IOCHANGES;                                     <<00678>>58408000
                                                               <<03635>>58410000
        INTEGER Q;                                             <<02510>>58412000
        POINTER DVCL;   << WORD POINTER TO CLASS TABLE >>      <<04306>>58414000
        INTEGER ARRAY CLBUF(0:34); << COLD LOAD READ INFO >>   <<02510>>58416000
        INTEGER POINTER CLPNTR;                                <<02510>>58418000
        DOUBLE POINTER CLDPNTR = CLPNTR;                       <<02510>>58420000
        LOGICAL CLSTARFISH;                                    <<02510>>58422000
        INTEGER VDSTART1,                                      <<D7830>>58424000
                VDSTART2,                                      <<D7830>>58426000
                VDSLEN1,                                       <<D7830>>58428000
                VDSLEN2;                                       <<D7830>>58430000
        LOGICAL ARRAY INITAREA(0:NCORESIZES-1) = PB :=         <<01756>>58432000
          NCORESIZES(0);                                       <<01756>>58434000
        ARRAY SYSDISC'DRT(0:6)=PB := <<DEFAULT SYSDISC DRTS>>  <<C8392>>58436000
          5,4,49,4,89,25,33;      <<FOR SERIES I,II,33,III, >> <<C8392>>58438000
                                  << 44,55,37               >> <<C8392>>58440000
        DOUBLE ABSLBUF,     << TEMP FOR ABS ADDR OF LBUF >>    <<03557>>58442000
               DISCADR,                                                 58444000
               FSECT,       << START ADDR OF DEFECTIVE AREA >> <<03557>>58446000
               LSECT;       << END ADDR OF DEFECTIVE AREA >>   <<03635>>58448000
                                                               <<03557>>58450000
      LOGICAL VTABCHANGES, DTTCHANGES;                         <<01123>>58452000
                                                               <<03557>>58454000
                                                               <<03557>>58456000
                                                               <<03557>>58458000
      DEFINE  CS80'TYPE = << TRUE IF DEVICE IS A CS80 DISC >>  <<03550>>58460000
              (%(16)200 <= IDENTIFY(SYSDISCDRT) <= %(16)23F)#; <<03550>>58462000
                                                               <<03635>>58464000
      DOUBLE DCOREADDR; <<DOUBLE WORD CORE ADDRESS>>           <<03603>>58466000
      LOGICAL BANK     = DCOREADDR,                            <<03603>>58468000
              COREADDR = DCOREADDR+1;                          <<03603>>58470000
                                                               <<03635>>58472000
      INTEGER POINTER DIRSP';                                  <<03603>>58474000
                                                               <<03635>>58476000
       INTEGER                                                 <<*LDT*>>58478000
           LDT'INDEX,                                          <<*DVR*>>58480000
           LPDT'INDEX,                                         <<*LDTX>>58482000
           LDTX'INDEX,                                         <<*DVR*>>58484000
           DVR'INDEX;                                          <<*DVR*>>58486000
                                                               <<03635>>58488000
                                                               <<MPEIV>>58490000
                                                               <<03001>>58492000
<<=====================================================>>      <<03001>>58494000
                                                               <<03001>>58496000
          <<SET BANK MASK FOR 8 BITS IF ICF 34>>               <<01771>>58498000
                                                               <<01771>>58500000
          ASSEMBLE(CON %020362);                               <<01771>>58502000
          IF TOS=3 THEN                                        <<01771>>58504000
             BEGIN <<ICF34>>                                   <<01771>>58506000
             TOS:=%377; <<BANK MASK>>                          <<01771>>58508000
             ASSEMBLE(CON %20104; CON %4);  << SBM >>          <<01771>>58510000
             END;                                              <<01771>>58512000
                                                               <<01771>>58514000
          IF LOADFROMTAPE THEN                                 <<02510>>58516000
             BEGIN                                             <<02510>>58518000
             << FIRMWARE AREA USED FOR INITIAL'S FLAGS >>      <<02510>>58520000
             ZEROABS( %1400, FIRMWARESIZE);                    <<D9089>>58522000
             CKFORSTARFISH;                                    <<02510>>58524000
             ABSOLUTE(ABSFLAGS).(14:1) := 1; << 7976 NEW REQ >><<02517>>58526000
             END;                                              <<02510>>58528000
          ABS(SYSTCST) := ABS(CSTP)-SYSBASE;                   <<32BND>>58530000
          ABS(SYSICS) := ABS(QI)-SYSBASE;                      <<03603>>58532000
                                                               <<03672>>58534000
          CS80'LOCK := FALSE;   << PARAM. FOR CS80'DRIVER-- >> <<03672>>58536000
                                << SHOULD BE SET BEFORE THE >> <<03672>>58538000
                                << FIRST CALL TO THIS DRIVER>> <<03672>>58540000
                                                               <<03672>>58542000
          IF NOT MULTI'IMB'SYS <<CAN NOT USE DRTBANK,DRTADDR>> <<C8392>>58544000
          THEN BEGIN    <<SO ZERO TO EFFECTIVELY PUT>>         <<03002>>58546000
            ABSOLUTE(DRTBANK):=0;  <<DRT TAB IN BANK 0 >>      <<03002>>58548000
            ABSOLUTE(DRTADDR):=0;                              <<03002>>58550000
            MAXDRT := 127; <<MAX FOR 7-BIT DRT>>               <<03002>>58552000
            END                                                <<03002>>58554000
          ELSE MAXDRT:= 511;  <<MAXDRT FOR 9-BIT DRT>>         <<03002>>58556000
                                                                        58558000
          TOS := ABS(0)-SIOBUFSIZE;                            <<03603>>58560000
          HCLIMIT := S0;                                       <<03603>>58562000
          ABS(SIOPROG) := S0;                                  <<03603>>58564000
          ABS(CHANPROG) := S0;                                 <<03603>>58566000
          ABS(TAPECHANPROG) := LS0+DISCSIOBUFSIZE;             <<03603>>58568000
          ABS(TERMCHANPROG) := LS0+DISCSIOBUFSIZE+             <<03603>>58570000
             TAPESIOBUFSIZE;                                   <<03603>>58572000
          DEL;                                                 <<03603>>58574000
          PUSH( DB );                                          <<03603>>58576000
          ABSOLUTE(DB) := TOS;                                          58578000
          ABSOLUTE(DBBANK) := TOS;                                      58580000
          <<INITIALIZE BRKPT-TABLE FOR HELP>>                  <<03001>>58582000
          <<------------------------------->>                  <<03001>>58584000
          HELP'INIT'BPTAB;   <<SPECIAL ENTRY-PT INTO HELP>>    <<03603>>58586000
                                                               <<03001>>58588000
          ASSEMBLE( RSW );                                     <<02510>>58590000
          CLRSW := S0.(8:8);                                   <<02510>>58592000
          I := TOS;                                            <<02510>>58594000
          CLSTARFISH := FALSE;                                 <<02510>>58596000
          SYSTAPEDRT :=                                        <<*DVR*>>58598000
              IF SERIESII'III                                  <<03002>>58600000
              THEN I.RBITE                                     <<*DVR*>>58602000
              ELSE I;                                          <<*DVR*>>58604000
          IF STARFISH AND I.RBITE = ADAPTERDRT THEN            <<02510>>58606000
             BEGIN                                             <<02510>>58608000
             CLSTARFISH := TRUE;                               <<02510>>58610000
             SYSTAPEDRT := I.LBITE;                            <<02510>>58612000
             END;                                              <<02510>>58614000
          TOS := 0; << DL STARTING ADDRESS >>                  <<03603>>58616000
          TOS := TOS-CSDEFSIZE;                                         58618000
          @CSDEF := S0;  <<DEFAULT LINE DESCRIPTORS>>                   58620000
          TOS := TOS-CSDVRTSIZE;                                        58622000
          @CSDVR := S0;  <<EXTRA CS DRIVERS>>                           58624000
          TOS := TOS-COMMSIZE;                                 <<CONFD>>58626000
          @COMM := S0;  <<SYSDUMP/INITIAL COMMUNICATION>>      <<CONFD>>58628000
          TOS := TOS-CTAB0SIZE;                                         58630000
          @CTAB0  := S0; <<PTR TO CONFIGURATION INFO>>                  58632000
          TOS := TOS-CTABSIZE;                                 <<CONFD>>58634000
          @CTAB := S0; <<PTR TO CORESIZE-RELATED INFO TABLE>>           58636000
          @TZTBUF := S0;                                       <<zrela>>58638000
          @RECBUF := S0;                                       <<zrela>>58640000
          TOS := TOS-COMM(OLDINFOSIZE);                        <<CONFD>>58642000
          @OLDINFO := S0;<<PTR TO OLD DISC COLD LOAD INFO>>             58644000
          TOS := TOS-COMM(OLDVTABSIZE);                        <<CONFD>>58646000
          @OLDVTAB := S0; <<PTR TO UNCHANGED VOLUME TABLE>>             58648000
          SETPOINTERS(*); <<SET POINTERS TO REMAINDER OF TABLES>>       58650000
                                                               <<zrela>>58652000
          << INITIALIZE UNUSED TABLE ENTRIES ABOVE Z >>        <<zrela>>58654000
                                                               <<zrela>>58656000
          HLDEV := COMM(HLDEV');                               <<CONFD>>58658000
          @PTR := @DVRTAB + ((HLDEV + 1) * DVRSIZE);           <<zrela>>58660000
          COUNT  := (MAXLDEV - HLDEV) * DVRSIZE;               <<zrela>>58662000
          ZEROBUF( PTR , COUNT );                              <<zrela>>58664000
          @PTR   := @LPDT + ((HLDEV + 1) * LPDTSIZE);          <<zrela>>58666000
          COUNT  := (MAXLDEV - HLDEV) * LPDTSIZE;              <<zrela>>58668000
          ZEROBUF( PTR, COUNT );                               <<zrela>>58670000
          @PTR   := @LDT + ((HLDEV + 1) * LDTSIZE);            <<zrela>>58672000
          COUNT  := (MAXLDEV - HLDEV) * LDTSIZE;               <<zrela>>58674000
          ZEROBUF( PTR , COUNT );                              <<zrela>>58676000
          @PTR   := @LDTX + ((HLDEV + 1) * LDTXSIZE);          <<zrela>>58678000
          COUNT  := (MAXLDEV - HLDEV) * LDTXSIZE;              <<zrela>>58680000
          ZEROBUF( PTR, COUNT );                               <<zrela>>58682000
          ADDRESS(0):= SYSBASE;                                <<32BND>>58684000
          ZEROABS( TEMP'CPVA, 8); << INIT CPVA AREA >>         <<02510>>58686000
          <<LENGTH MUST BE ZERO TO APPEASE CHANNEL CODE>>      <<00888>>58688000
          <<WHEN TALKING TO UNIT ZERO>>                        <<00888>>58690000
$IF X1=ON << ******* SERIES 33 UNIQUE ********* >>             <<02510>>58692000
          INITDRT( CONSOLEDRT); << SET UP CONSOLE DRT >>       <<02510>>58694000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>58696000
          BAUDRATE := 0;                                       <<00888>>58698000
          SPEEDSENSE; <<SET UP CONSOLE FOR I/0>>               <<00888>>58700000
          SERIALDISCLOAD := FALSE;  << INITIALIZE >>           <<01119>>58702000
          IF NOT LOADFROMTAPE THEN                             <<00888>>58704000
             BEGIN                                             <<00888>>58706000
             IF LOGICAL(LASTLOADMODE.RLMODE) THEN              <<00888>>58708000
                ERRMESSAGE(M100); << PREVIOUS RELOAD ABORTED >><<01103>>58710000
             IF LOGICAL(LASTLOADMODE.TLMODE) THEN              <<00888>>58712000
                ERRMESSAGE(M101);<<PREVIOUS COLD LOAD ABORTED>><<01103>>58714000
             END                                               <<00888>>58716000
          ELSE                                                 <<00888>>58718000
             BEGIN                                             <<02510>>58720000
             IF COMM(SERIALDISCLOAD').LOADTYPE=1 THEN          <<CONFD>>58722000
                BEGIN << READ FROM SERIAL DISC >>              <<00888>>58724000
                SERIALDISCLOAD:=TRUE;   <<True>>               <<03598>>58726000
                IF COMM(SERIALDISCLOAD').LOADDATE=1            <<CONFD>>58728000
                   THEN FUTURE'DATE:=TRUE;   <<True>>          <<03598>>58730000
                  << RESET BITS IN SERIALDISCLOAD' >>          <<I8895>>58732000
                COMM(SERIALDISCLOAD').LOADTYPE:=0;             <<I8895>>58734000
                COMM(SERIALDISCLOAD').LOADDATE:=0;             <<I8895>>58736000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>58738000
                IF TESTIO(SYSTAPEDRTUNIT.DRTFIELD,             <<03002>>58740000
                          %17400) <> 0 THEN                    <<03002>>58742000
                   ERRMESSAGE(M10);<<COLD LOAD TAPE READ ERROR <<01103>>58744000
                END                                            <<00888>>58746000
             ELSE                                              <<00888>>58748000
                IF NOT CLSTARFISH AND                          <<02510>>58750000
                   TESTIO(SYSTAPEDRT,%16) <> %16 THEN          <<02510>>58752000
                   ERRMESSAGE(M10);<<COLD LOAD TAPE READ ERROR <<01103>>58754000
             IF CLSTARFISH AND                                 <<02510>>58756000
                ABSOLUTE(GETDRT(SYSTAPEDRT,0)-2) <> %600       <<03002>>58758000
                THEN ERRMESSAGE(M10); <<COLD LOAD READ ERROR>> <<02510>>58760000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>58762000
                END;                                           <<00888>>58764000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>58766000
             END;                                              <<02510>>58768000
          TAPERECSIZE := COMM(TAPERECSIZE');                   <<CONFD>>58770000
          CLEARLINE;                                           <<PMBC>> 58772000
          IF PMBCFIRMWARE THEN                                 <<PMBC>> 58774000
             BEGIN                                             <<PMBC>> 58776000
             MOVE BLINE := "*** PMBC MICROCODE INSTALLED";     <<PMBC>> 58778000
             PRINTLINE;                                        <<PMBC>> 58780000
             END;                                              <<PMBC>> 58782000
          INBUF := %6412;                                               58784000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>58786000
          MOVE BINBUF(2):="HP32002",2;                                  58788000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>58790000
          MOVE BINBUF(2):="HP32033",2;                         <<00888>>58792000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>58794000
          BPS0 := BYTE(COMM(VERSION'));                        <<CONFD>>58796000
          TOS := TOS+1;                                                 58798000
          BPS0 := ".";                                                  58800000
          TOS := TOS+1;                                                 58802000
          TOS := @COMM(UPDATEL')&LSL(1);                       <<CONFD>>58804000
          MOVE *:=*,(2),2;                                              58806000
          BPS0 := ".";                                                  58808000
          DEL;                                                          58810000
          INBUF(7) := COMM(FIXLEVEL');                         <<CONFD>>58812000
          PRINT(INBUF,8,0);                                             58814000
        <<PRINT WARNING MESSAGE IF SOFTWARE IS EXPERIMENTAL>>  <<06069>>58816000
          EXPFLAG := COMM(EXPFLAG');                           <<CONFD>>58818000
          IF EXPFLAG > 0 THEN                                  <<06069>>58820000
            MESSAGE(M2459,EXPFLAG);                            <<06069>>58822000
                                                               <<s9008>>58824000
        <<--------------------------------------------------->><<s9008>>58826000
        << If a dialogue free startup option is chosen on a  >><<s9008>>58828000
        << Series 37, inform the user what is going on...    >><<s9008>>58830000
        <<--------------------------------------------------->><<s9008>>58832000
                                                               <<s9008>>58834000
        IF STARTTYPE = CBWARM THEN                             <<s9008>>58836000
           MESSAGE(M3064)                                      <<s9008>>58838000
        ELSE IF STARTTYPE = CBCOOL THEN                        <<s9008>>58840000
           MESSAGE(M3065)                                      <<s9008>>58842000
        ELSE IF STARTTYPE = CBUP THEN                          <<s9008>>58844000
           MESSAGE(M3066)                                      <<s9008>>58846000
        ELSE IF STARTTYPE = CBCOLD THEN                        <<s9008>>58848000
           MESSAGE(M3067)                                      <<s9008>>58850000
        ELSE IF STARTTYPE = CBREL THEN                         <<s9008>>58852000
           MESSAGE(M3068)                                      <<s9008>>58854000
        ELSE IF STARTTYPE = CBNEW THEN                         <<s9008>>58856000
              BEGIN                                            <<i9073>>58858000
                                                               <<i9073>>58860000
      << -------------------------------------------- >>       <<i9073>>58862000
      << If a NEW is not being performed on a FOS --  >>       <<i9073>>58864000
      << then flag as warning...                      >>       <<i9073>>58866000
      << -------------------------------------------- >>       <<i9073>>58868000
                                                               <<i9073>>58870000
              IF NOT                                           <<i9073>>58872000
              LOGICAL(COMM(SERIALDISCLOAD').LOADFOS) THEN      <<i9073>>58874000
                 BEGIN                                         <<i9073>>58876000
                                                               <<s9008>>58878000
                 MESSAGE(M2473);                               <<i9073>>58880000
                 GOTO REQOPT;   << need to ask option >>       <<i9073>>58882000
                 END                                           <<i9073>>58884000
              ELSE MESSAGE(M3069);                             <<i9073>>58886000
              END;                                             <<i9073>>58888000
        <<INITIALIZE DB VARIABLES CHANGED ON PREVIOUS COLD LOAD>>       58890000
                                                               <<03551>>58892000
          ldev'index'to'ldev (0) := -1;                        <<03551>>58894000
          MOVE ldev'index'to'ldev (1) :=                       <<03551>>58896000
               ldev'index'to'ldev (0), (max'disc'drives-1);    <<03551>>58898000
          ldev'of'dt'page'in'buffer := -1;                     <<03551>>58900000
          ldev'of'map'in'buffer := -1;                         <<03551>>58902000
                                                               <<03714>>58904000
          << INITIALIZE CONVERSION BIT FOR MIGHTY MOUSE >>     <<t8392>>58906000
          COMM(ID0).MPEVERSION := 1;                           <<t8392>>58908000
          IF LOADFROMTAPE THEN                                 <<03714>>58910000
             BEGIN                                             <<03714>>58912000
                                                               <<03714>>58914000
           << INITIALIZE THE RESERVED AREA BIT MAP.  A '1' >>  <<03714>>58916000
           << MEANS THE SPACE IF FREE.  WE REMOVE SPACE    >>  <<03714>>58918000
           << NOW FOR SECTORS 0-3 (SERIES 33) OR 0-2       >>  <<03714>>58920000
           << (SERIES II/III).  THESE ARE FOR THE DISC     >>  <<03714>>58922000
           << LABEL, THE DTT OR DSCT, AND THE BOOTSTRAP    >>  <<03714>>58924000
           << CHANNEL PROGRAMS.  WE ALSO REMOVE SPACE FOR  >>  <<03714>>58926000
           << THE COLD LOAD INFORMATION TABLE (SECTORS     >>  <<03714>>58928000
           << 28-29), AND THE RESERVED AREA BIT MAP ITSELF >>  <<03714>>58930000
           << (SECTOR 4).                                  >>  <<03714>>58932000
                                                               <<03714>>58934000
             TEMP := -1;                                       <<03714>>58936000
             WHILE (TEMP:=TEMP+1) <                            <<03714>>58938000
                   LDEV'1'RESERVED'AREA'SIZE DO                <<03714>>58940000
                SETBIT(BOOTSPACEMAP,TEMP);                     <<03714>>58942000
                                                               <<03714>>58944000
             CLEARBIT(BOOTSPACEMAP,0);   << RESERVE SECTORS >> <<03714>>58946000
             CLEARBIT(BOOTSPACEMAP,1);   <<     0-2         >> <<03714>>58948000
             CLEARBIT(BOOTSPACEMAP,2);                         <<03714>>58950000
$IF X1=ON  << ********** SERIES 33,44,55 UNIQUE ********** >>  <<03714>>58952000
             CLEARBIT(BOOTSPACEMAP,3);   <<RESERVE SECTOR 3>>  <<03714>>58954000
$IF        << ********* RETURNING TO COMMON CODE ********* >>  <<03714>>58956000
                                                               <<03714>>58958000
           << NOW RESERVE COLD LOAD INFORMATION TABLE >>       <<03714>>58960000
                                                               <<03714>>58962000
             CLEARBIT(BOOTSPACEMAP,INFOSECTOR);                <<03714>>58964000
             CLEARBIT(BOOTSPACEMAP,INFOSECTOR+1);              <<03714>>58966000
             CLEARBIT(BOOTSPACEMAP,INFOSECTOR+2);              <<CONFD>>58968000
             CLEARBIT(BOOTSPACEMAP,INFOSECTOR+3);<<COMM>>      <<CONFD>>58970000
             CLEARBIT(BOOTSPACEMAP,INFOSECTOR+4);<<CL-EXT>>    <<CONFD>>58972000
             CLEARBIT(BOOTSPACEMAP,INFOSECTOR+5);<<CL-EXT>>    <<CONFD>>58974000
                                                               <<03714>>58976000
           <<  RESERVE SPACE FOR THE BOOTSPACEMAP    >>        <<03714>>58978000
           <<     BITMAP                             >>        <<03714>>58980000
                                                               <<03714>>58982000
             CLEARBIT(BOOTSPACEMAP,BOOTSPACE'SECTOR);          <<03714>>58984000
                                                               <<03714>>58986000
             END     << IF LOADFROMTAPE >>                     <<03714>>58988000
                                                               <<03714>>58990000
          ELSE      << BOOTING FROM DISC >>                    <<03714>>58992000
                    << READ IN BOOTSPACEMAP >>                 <<03714>>58994000
                                                               <<03714>>58996000
             DISC(READ,SYSDISC,DOUBLE(BOOTSPACE'SECTOR),       <<03714>>58998000
                  BOOTSPACEMAP,                                <<03714>>59000000
                  (LDEV'1'RESERVED'AREA'SIZE+15)/16);          <<03714>>59002000
                                                               <<03714>>59004000
          RECOVERY := FALSE;                                            59006000
          INITLOGONDST := FALSE;                                        59008000
          ZEROBUF( REASSIGNED, (MAX'REASS+1)*5);               <<03714>>59010000
          NREASS := 0;                                         <<03714>>59012000
          RELOAD := FALSE;                                              59014000
          ACCTSONLY := FALSE;                                           59016000
          LOADMAP := FALSE;                                             59018000
          CHANGES := FALSE;                                             59020000
          SECONDPASS := FALSE;                                          59022000
          IF LOADFROMTAPE THEN                                          59024000
            BEGIN  <<COLD LOAD WAS FROM MAG TAPE>>                      59026000
              IF STARTTYPE = CBUP THEN                         <<F8392>>59028000
                 OPT := UP                                     <<F8392>>59030000
              ELSE IF STARTTYPE = CBCOLD THEN                  <<F8392>>59032000
                 OPT := COLD                                   <<F8392>>59034000
              ELSE IF STARTTYPE = CBREL OR                     <<F8392>>59036000
                      STARTTYPE = CBNEW THEN                   <<F8392>>59038000
                 OPT := REL                                    <<F8392>>59040000
              ELSE                                             <<F8392>>59042000
                 GOTO REQOPT;  <<NEED TO ASK QUESTION>>        <<F8392>>59044000
              GOTO CBOPT;   <<NO DIALOGUE NEEDED>>             <<F8392>>59046000
  REQOPT:     MESSAGE(-M2001);<<WHICH OPTION<COLDSRT/RELOAD/UPD<<01103>>59048000
              READINPUT;                                                59050000
              GETSTR(BBUF,@REQOPT,1,9);  <<GET ANSWER>>                 59052000
              OPT := 0;                                                 59054000
              DO IF BBUF=OPTS(3*OPT),(3) THEN GO OPTOK                  59056000
              UNTIL (OPT:=OPT+1)=NOPT;                                  59058000
            <<ILLEGAL OPTION SPECIFIED>>                                59060000
              MESSAGE(M2453);                                  <<01103>>59062000
              GO REQOPT;                                                59064000
  OPTOK:      OPT := OPT+COLD; <<FIRST OF THE TAPELOAD OPTIONS>>        59066000
CBOPT:        IF OPT=REL THEN    <<RELOAD>>                    <<F8392>>59068000
              BEGIN                                            <<F8392>>59070000
              IF STARTTYPE = CBREL OR                          <<F8392>>59072000
                 STARTTYPE = CBNEW THEN                        <<F8392>>59074000
                 GOTO SPR;                                     <<F8392>>59076000
              IF COMM(FILESDUMPED)=0 THEN                      <<CONFD>>59078000
                BEGIN <<NO USER FILES ON TAPE>>                         59080000
                  GETYESNO(@REQOPT,M2275); <<NO USER FILES ON TAPE;     59082000
                                             DO YOU WANT TO RELOAD?>>   59084000
                  GO SPR; <<RELOAD WITH NO FILES DEFAULTS TO SPREAD>>   59086000
                END                                                     59088000
              ELSE                                                      59090000
                BEGIN  <<FILES ON TAPE>>                                59092000
  REQRELOPT:      MESSAGE(-M2002);<<WHICH OPTION <SPREAD/COMPACT/       59094000
                                   RESTORE/ACCOUNTS/NULL>?>>            59096000
                  READINPUT;                                            59098000
                  SCAN BINBUF WHILE BLANK;                              59100000
                  IF CARRY THEN GOTO SPR;  <<DEFAULT IS SPREAD>>        59102000
                  GETSTR(BBUF,@REQRELOPT,1,8); <<GET ANSWER>>           59104000
                  I := 0;                                               59106000
                  DO IF BBUF=RELOPTS(3*I),(3) THEN GO RELOPTOK          59108000
                  UNTIL (I:=I+1)=NRELOPTS;                              59110000
                <<ILLEGAL OPTION INPUT>>                                59112000
                  MESSAGE(M2453);                              <<01103>>59114000
                  GO REQRELOPT;                                         59116000
  RELOPTOK:       IF I-NRELOPTS+2=0 THEN ACCTSONLY:=TRUE  <<ACCOUNTS>>  59118000
                  ELSE IF > THEN COMM(FILESDUMPED):=0 <<NULL>> <<CONFD>>59120000
                  ELSE OPT := OPT+I;  <<SPREAD,COMPACT OR RESTORE>>     59122000
  SPR:            RELOAD := TRUE;                                       59124000
                END;                                                    59126000
              END;                                             <<F8392>>59128000
              IF UPDATE THEN                                            59130000
                BEGIN  <<READ TABLES FROM SYSTEM DISC>>                 59132000
                  <<GET DEFAULT SYSTEM DISC DRT ON THIS CPU>>  <<02835>>59134000
                  SYSDISCDRT := SYSDISC'DRT( THISCPU);         <<02835>>59136000
                  IF STARTTYPE = CBUP THEN                     <<F8392>>59138000
                    GOTO CBOPTUP;                              <<F8392>>59140000
  REQSYSDISC:     GETNEWVAL(M2003,SYSDISCDRT,LOWESTDRT,MAXDRT);<<03002>>59142000
                  <<SYSTEM DISC DRT#?>>                        <<00071>>59144000
CBOPTUP:          IF SYSDISCDRT=SYSTAPEDRT THEN                <<F8392>>59146000
                     BEGIN <<CONFLICT--2 UNITS AS UNIT ZERO>>  <<SD.00>>59148000
                     MESSAGE(M2401); <<WARNING--SYSTEM DISC AND<<01103>>59150000
                     <<COLDLOAD UNIT ARE ON SAME DRT. SYSTEM>> <<SD.00>>59152000
                     <<DISC MUST BE ONLY UNIT ZERO ON THIS>>   <<SD.00>>59154000
                     <<DRT.>>                                  <<SD.00>>59156000
                     MESSAGE(M2329);<<MAKE UNIT # CHANGES NOW>><<01103>>59158000
                     DO UNTIL LGETYESNO(M2332); <<READY?>>     <<01103>>59160000
                     SYSTAPEUNIT:=GETVAL(M2328,0,7,1);<<COLD>> <<03603>>59162000
                     <<LOAD UNIT NUMBER>>                      <<SD.00>>59164000
                     END;  <<CONFLICT--2 UNITS AS UNIT ZERO>>  <<SD.00>>59166000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>59168000
         TOS := SYSDISCDRT;                                    <<02510>>59170000
         ASSEMBLE( TIO 0 );                                    <<02510>>59172000
         IF <> THEN                                            <<02510>>59174000
            IF STARFISH THEN GO HPIB'DISC                      <<02510>>59176000
         ELSE                                                  <<02510>>59178000
            GO BADSDISC;                                       <<02510>>59180000
         IF TOS > 0 THEN GO BADSDISC;                          <<02510>>59182000
         BUF := %14000;    << SET BANK >>                      <<03603>>59184000
         BUF(1) := ABS(DBBANK);                                <<03603>>59186000
         BUF(2) := SIOCNTRL;                                   <<03603>>59188000
         BUF(3) := 0;      << COLD LOAD READ OPCODE >>         <<03603>>59190000
READSECT0:                                                     <<02510>>59192000
         BUF(4) := (-128) LAND %77777;                         <<03603>>59194000
         BUF(5) := ABS(DB)+@LBUF;                              <<03603>>59196000
         BUF(6) := SIOEND;                                     <<03603>>59198000
         BUF(7) := 0;                                          <<03603>>59200000
         MABS( 0,ABS(SIOPROG),ABS(DBBANK),ABS(DB)+@BUF,8);     <<03603>>59202000
         EXECUTESIO(SYSDISCDRT,ABS(SIOPROG));                  <<03603>>59204000
         SYSDISCTYPE := LBUF(LAB6).LABDTYPE;                   <<02510>>59206000
         SYSDISCSUBTYPE := LBUF(LAB6).LABDSUBTYPE;             <<02510>>59208000
         IF LBUF = 0 OR BLBUF(LABSYSID) <> "3000" THEN         <<03603>>59210000
            IF SYSDISCTYPE=MHDISCTYPE AND (SYSDISCSUBTYPE      <<02510>>59212000
               =UH7900 OR SYSDISCSUBTYPE=UH7905) THEN          <<02510>>59214000
               BEGIN                                           <<02510>>59216000
               BUF(1) := %200; <<READ FROM HEAD 2>>            <<02510>>59218000
               GO READSECT0;                                   <<02510>>59220000
               END                                             <<02510>>59222000
            ELSE                                               <<02510>>59224000
               GO BADSDISC;                                    <<02510>>59226000
         GO FOUND'SDISC;                                       <<02510>>59228000
$IF  << ************* RETURNING TO COMMON CODE *********** >>  <<02510>>59230000
HPIB'DISC:                                                     <<02510>>59232000
       INITDRT( SYSDISCDRT);                                   <<03550>>59234000
       IF CS80'TYPE THEN    << DEVICE ON SYSDISCDRT IS >>      <<03550>>59236000
         BEGIN              << A CS'80 DISC            >>      <<03550>>59238000
         PUSH(DB);             << GET ABSOLUTE ADDRESS >>      <<03550>>59240000
         TOS := TOS + @LBUF;   << OF THE READ BUFFER   >>      <<03550>>59242000
         ABSLBUF := TOS;                                       <<03550>>59244000
                                                               <<03672>>59246000
         CS80'DRIVER( 0,SYSDISCDRT,0,2,          << INIT.   >> <<*DVR*>>59248000
                       INIT'DEV,0D,ABSLBUF,2);   <<  DEVICE >> <<03715>>59250000
         CS80'DRIVER( 0,SYSDISCDRT,0,2,    << READ DEVICE   >> <<*DVR*>>59252000
                    NON'FATAL'READ,0D,ABSLBUF,128); <<LABEL >> <<03550>>59254000
         IF < THEN GO BADSDISC;  << UNABLE TO READ LABEL    >> <<03550>>59256000
                                 << MUST NOT BE SYSTEM DISC >> <<03550>>59258000
         END                                                   <<03550>>59260000
                                                               <<03550>>59262000
       ELSE              << MUST BE A TYPE 0 DISC >>           <<03550>>59264000
         BEGIN           << TRY TO READ THE DISC LABEL >>      <<03550>>59266000
         BUF(34):=0; <<HEAD ZERO/SECTOR ZERO>>                 <<02510>>59268000
RETRY:                                                         <<02510>>59270000
                                                               <<02510>>59272000
         MOVE BUF := (                                         <<03603>>59274000
     << 0>>  %4400,0,            << CLEAR         >>           <<03603>>59276000
     << 2>>  %2010,6,0,0,0,      << SEEK          >>           <<03603>>59278000
     << 7>>  %1000,0,            << WAIT          >>           <<03603>>59280000
     << 9>>  %2010,2,0,0,0,      << SET FILE MASK >>           <<03603>>59282000
     <<14>>  %1000,0,            << WAIT          >>           <<03603>>59284000
     <<16>>  %2010,2,0,0,0,      << READ COMMAND  >>           <<03603>>59286000
     <<21>>  %1400,256,0,0,0,    << READ DATA     >>           <<03603>>59288000
     <<26>>  %1000,0,            << WAIT          >>           <<03603>>59290000
     <<28>>  %600,0,             << END,INT       >>           <<03603>>59292000
     <<30>>  %2400,              << READ COMMAND  >>           <<03603>>59294000
     <<31>>  %7407,              << FILE MASK     >>           <<03603>>59296000
     <<32>>  %1000,              << SEEK COMMAND  >>           <<03603>>59298000
     <<33>>      0);             << CYLINDER ZERO >>           <<03603>>59300000
         BUF(6) := ABS(CHANPROG)+32;                           <<03603>>59302000
         BUF(13) := ABS(CHANPROG)+31;                          <<03603>>59304000
         BUF(20) := ABS(CHANPROG)+30;                          <<03603>>59306000
         BUF(24) := ABS(DBBANK);                               <<03603>>59308000
         BUF(25) := ABS(DB)+@LBUF;                             <<03603>>59310000
         MABS( 0,ABS(CHANPROG),ABS(DBBANK),ABS(DB)+@BUF,35);   <<03603>>59312000
         EXECUTESIOP(SYSDISCDRT,ABS(CHANPROG));                <<03603>>59314000
         END;                                                  <<03550>>59316000
                                                               <<03550>>59318000
         SYSDISCTYPE := LBUF(LAB6).LABDTYPE;                   <<02510>>59320000
         SYSDISCSUBTYPE := LBUF(LAB6).LABDSUBTYPE;             <<02510>>59322000
         IF (STARFISH LAND LBUF=0) LOR                         <<02510>>59324000
            (NOT STARFISH LAND BLBUF <> "SYSTEM DISC") LOR     <<03603>>59326000
            (BLBUF(LABSYSID) <> "3000") THEN                   <<03603>>59328000
            IF BUF(34) = %1000 OR CS80'TYPE THEN               <<03550>>59330000
               BEGIN     << THIS IS NOT THE SYSTEM DISC >>     <<03550>>59332000
BADSDISC:      MESSAGE(M106);   << PRINT ERROR MESSAGE  >>     <<03550>>59334000
               GO REQSYSDISC;   << AND RE-REQUEST THE   >>     <<03550>>59336000
               END              << THE SYSTEM DISC DRT  >>     <<03550>>59338000
            ELSE                                               <<02510>>59340000
               BEGIN <<COULD BE LOWER HALF OF 7906>>           <<02510>>59342000
               BUF(34) := %1000; <<HEAD TWO/SECTOR ZERO>>      <<02510>>59344000
               GO RETRY;                                       <<02510>>59346000
               END;                                            <<02510>>59348000
FOUND'SDISC:                                                   <<02510>>59350000
                  DISCADR := D'L(INFOSECTOR));                          59352000
                  READTABLE( DISCADR, INFO, INFOSIZE);                  59354000
                  @TABLEINFO := @INFO+INFO(TABPTR);                     59356000
                 << SAVE LOAD FROM TAPE VALUES >>              <<t8392>>59358000
                  TOS := COMM(OLDINFOSIZE); <<SIZE OF TABLE IN <<CONFD>>59360000
                  TOS := COMM(OLDVTABSIZE);                    <<CONFD>>59362000
                  TOS := COMM(FIXLEVEL');                      <<CONFD>>59364000
                  TOS := COMM(UPDATEL');                       <<CONFD>>59366000
                  TOS := COMM(VERSION');                       <<CONFD>>59368000
                  TOS := COMM(SERIALDISCLOAD');                <<I8895>>59370000
                  TOS := COMM(MAXINITSEG');                    <<CONFD>>59372000
                  TOS := COMM(DISCENTRY');                     <<CONFD>>59374000
                  TOS := COMM(MITVERSION);                     <<CONFD>>59376000
                  TOS := COMM(MITUPDATE);                      <<CONFD>>59378000
                  TOS := COMM(MITFIX);                         <<CONFD>>59380000
                  TOS := COMM(EXPFLAG');                       <<CONFD>>59382000
                  TOS := COMM(TLBUFSIZE);                      <<t8392>>59384000
                  TOS := COMM(TLBUFENTRIES);                   <<t8392>>59386000
                  DTEMP := COMMSECTOR;                         <<CONFD>>59388000
                  READTABLE(DTEMP,COMM,COMMSIZE);              <<CONFD>>59390000
                                                                        59392000
       << MPEV-E TO MM CONVERSION CHECK -- if conversion >>    <<t8392>>59394000
       << bit on disc has not been set then the system is>>    <<t8392>>59396000
       << running on MPEV-E so save the values for the   >>    <<t8392>>59398000
       << defdata table off loadtape else pop values saved>>   <<t8392>>59400000
                                                                        59402000
                  @PTR := @TL'BUF;                             <<D8917>>59404000
                  IF COMM(ID0).MPEVERSION = 0 THEN             <<t8392>>59406000
                     BEGIN     << MPEV-E VERSION >>            <<t8392>>59408000
                     COMM(TLBUFENTRIES) := TOS;                <<t8392>>59410000
                     COMM(TLBUFSIZE) := TOS;                   <<t8392>>59412000
                     END                                       <<t8392>>59414000
                  ELSE ASSEMBLE(DDEL);   << POP STACK TWICE >><<tlook>> 59416000
                  COMM(EXPFLAG') := TOS;                       <<CONFD>>59418000
                  COMM(MITFIX) := TOS;                         <<CONFD>>59420000
                  COMM(MITUPDATE) := TOS;                      <<CONFD>>59422000
                                                                        59424000
                  COMM(MITVERSION) := TOS;                     <<CONFD>>59426000
                  COMM(DISCENTRY') := TOS;                     <<CONFD>>59428000
                  COMM(MAXINITSEG') := TOS;                    <<CONFD>>59430000
                  COMM(SERIALDISCLOAD') := TOS;                <<I8895>>59432000
                  COMM(VERSION') := TOS;                       <<CONFD>>59434000
                  COMM(UPDATEL') := TOS;                       <<CONFD>>59436000
                  COMM(FIXLEVEL') := TOS;                      <<CONFD>>59438000
                  COMM(OLDVTABSIZE) := TOS;                    <<CONFD>>59440000
                  COMM(OLDINFOSIZE) := TOS;                    <<CONFD>>59442000
                  READTABLE(TABLEINFO(CTAB0INFOX+3),CTAB0,     <<CONFD>>59444000
                     CTAB0SIZE);                               <<CONFD>>59446000
                  READTABLE(TABLEINFO(CTABINFOX+3),CTAB,       <<CONFD>>59448000
                     CTABSIZE);                                <<CONFD>>59450000
                  SETPOINTERS(@OLDVTAB);<<ADJUST DL PTRS FOR NEW SIZES>>59452000
          IF COMM(ID0).MPEVERSION = 0 THEN                     <<D8917>>59454000
             BEGIN                                             <<D8917>>59456000
             COMM(ID0).MPEVERSION := 1;                        <<D8917>>59458000
             << ADJUST TABLE LOCATION TO MATCH  >>             <<D8917>>59460000
             << NEW POINTER VALUE               >>             <<D8917>>59462000
             IF @PTR >= @TL'BUF THEN                           <<A9066>>59464000
                MOVE TL'BUF := PTR,(COMM(TLBUFSIZE))           <<D8917>>59466000
             ELSE                                              <<D8917>>59468000
                MOVE TL'BUF(COMM(TLBUFSIZE)-1) :=              <<D8917>>59470000
                  PTR(COMM(TLBUFSIZE)-1),(-COMM(TLBUFSIZE));   <<D8917>>59472000
             END                                               <<D8917>>59474000
          ELSE                                                 <<D8917>>59476000
             READTABLE(TABLEINFO(TLBUFINFOX+3),TL'BUF,         <<D8917>>59478000
                COMM(TLBUFSIZE)); <<DEFDATA FILE>>             <<D8917>>59480000
          HLDEV := COMM(HLDEV');                               <<CONFD>>59482000
          READTABLE(TABLEINFO(CSDEFINFOX+3),CSDEF,CSDEFSIZE);           59484000
          READTABLE(TABLEINFO(CSDVRINFOX+3),CSDVR,CSDVRTSIZE);          59486000
          READTABLE(TABLEINFO(CSTABINFOX+3),CSTAB,             <<CONFD>>59488000
             COMM(CSTABSIZE));                                 <<CONFD>>59490000
          IF COMM(TTDTSIZE') <> 0 THEN                         <<*7777>>59492000
             READTABLE( TABLEINFO(TTDTINFOX+3), TDTAB,         <<*7777>>59494000
                             COMM( TTDTSIZE'));                <<*7777>>59496000
          READTABLE(TABLEINFO(DVCLINFOX+3),DCTAB,              <<*7777>>59498000
                    COMM(DVCLSIZE'));                          <<*7777>>59500000
          READTABLE( TABLEINFO(DCTHINFOX+3), DCT'HEAD,         <<DEVCO>>59502000
             DCTHSIZE);                                        <<DEVCO>>59504000
          ZEROBUF( LDTX, (MAXLDEV + 1) * LDTXSIZE );           <<*7777>>59506000
          READTABLE(TABLEINFO(LDTXINFOX+3),LDTX,               <<*7777>>59508000
             (HLDEV+1)*LDTXSIZE); <<LDT EXTENSION>>            <<*7777>>59510000
          ZEROBUF( LDT, ( MAXLDEV + 1 ) * LDTSIZE );           <<*7777>>59512000
          READTABLE(TABLEINFO(LDTINFOX+3),LDT,                 <<*7777>>59514000
             (HLDEV+1)*LDTSIZE); <<LOGICAL DEVICE TABLE>>      <<*7777>>59516000
          ZEROBUF( LPDT, (MAXLDEV + 1 ) * LPDTSIZE );          <<*7777>>59518000
          READTABLE(TABLEINFO(LPDTINFOX+3),LPDT,(HLDEV+1)      <<*7777>>59520000
                    *LPDTSIZE); <<LOGICAL-PHYSICAL DEV TABLE>> <<*7777>>59522000
          ZEROBUF( DVRTAB, ( MAXLDEV + 1 ) * DVRSIZE );        <<*7777>>59524000
          READTABLE(TABLEINFO(DVRINFOX+3),DVRTAB,(HLDEV+1)     <<*7777>>59526000
                    *DVRSIZE); <<DRIVER TABLE>>                <<*7777>>59528000
                                                               <<*7777>>59530000
        END;  <<UPDATE>>                                       <<*7777>>59532000
    END  <<COLDLOAD WAS FROM MAGTAPE>>                         <<*7777>>59534000
  ELSE                                                         <<*7777>>59536000
   REQCOOL:BEGIN                                                        59538000
           IF STARTTYPE = CBWARM THEN                          <<F8392>>59540000
              OPT := WARM                                      <<F8392>>59542000
           ELSE IF STARTTYPE = CBCOOL THEN                     <<F8392>>59544000
              OPT := COOL                                      <<F8392>>59546000
           ELSE GOTO REQSTART;   <<NEED DIALOGUE>>             <<F8392>>59548000
           GOTO NODIALOG;        <<NO DIALOGUE>>               <<F8392>>59550000
REQSTART:  MESSAGE(-M2000);<<WHICH OPTION WARMSTART/COOLSTART>><<F8392>>59552000
           WRITECHAR(17);         <<DC1>>                      <<01423>>59554000
           READINPUT;                                                   59556000
           GETSTR(BBUF,@REQCOOL,1,9);                                   59558000
           IF BBUF="WAR" THEN OPT:=WARM                                 59560000
             ELSE IF BBUF="COO" THEN OPT:=COOL                          59562000
                  ELSE BEGIN                                            59564000
                       MESSAGE(M2453);                         <<01103>>59566000
                       GO REQCOOL;                                      59568000
                       END;                                             59570000
            END;                                                        59572000
NODIALOG: PUSH( DL );                                          <<F8392>>59574000
          @DIRSP := S0;                                        <<03675>>59576000
          @DIR := S0;                                          <<03675>>59578000
          @SEGT := TOS;                                        <<03675>>59580000
          IF STARTTYPE = CBNEW THEN                            <<*8957>>59582000
             VERIFY'PHYS'MEM;  << SET MEM TO PHYSICAL MAX >>   <<*8957>>59584000
          LOGGING := CTAB0(LOGBITS).(15:1);  <<TRUE IF LOGGING IS ON>>  59586000
          IF OPT=REL OR OPT=COLD THEN INITLOGONDST:=TRUE;               59588000
                                                               <<03002>>59590000
          IF WARMSTART OR STARTTYPE.(13:3)<>0  <<NO DIALOGUE>> <<F8392>>59592000
                           <<NORMALLY, NO CHANGES ALLOWED>>    <<F8392>>59594000
                           <<BUT WE MUST CONFIRM PHYSICAL>>    <<03002>>59596000
                           <<MEMORY IS SUFFICIENT>>            <<03002>>59598000
          THEN GOTO TEST'PHYS'MEM;                             <<03002>>59600000
                                                               <<03002>>59602000
          IF LGETYESNO (M2005)     <<ANY CHANGES? >>           <<03002>>59604000
          THEN CHANGES := TRUE                                 <<03002>>59606000
          ELSE BEGIN       <<NO CHANGES REQUESTED, BUT >>      <<03002>>59608000
                           <<WE MUST CONFIRM PHYSICAL >>       <<03002>>59610000
                           <<MEMORY IS SUFFICIENT>>            <<03002>>59612000
                                                               <<03002>>59614000
TEST'PHYS'MEM:                                                 <<03002>>59616000
              TEMP := CTAB0( CORESIZE);                        <<03002>>59618000
                                                               <<03002>>59620000
              IF NOT VERIFY'PHYS'MEM (TEMP)                    <<03002>>59622000
              THEN DO BEGIN                                    <<03002>>59624000
                   TEMP := CTAB0(CORESIZE);                    <<03002>>59626000
                   GETNEWVAL(M2007,TEMP,256,4096);             <<s8941>>59628000
                     <<MEMORY SIZE = XXX?>>                    <<03002>>59630000
                   END UNTIL VERIFY'PHYS'MEM(TEMP);            <<03002>>59632000
                                                               <<03002>>59634000
                           <<NOW, SINCE THIS IS A >>           <<03002>>59636000
                           <<WARMSTART OR NO CHANGES>>         <<03002>>59638000
                           <<WE JUMP TO IOCHECK>>              <<03002>>59640000
              GOTO IOCHECK;  <<SKIP CHANGES>>                  <<03002>>59642000
          END;  <<NO CHANGES DESIRED>>                         <<03002>>59644000
                                                               <<03002>>59646000
                           <<HERE WE BEGIN NORMAL>>            <<03002>>59648000
                           << "CHANGES" SEQUENCE>>             <<03002>>59650000
                                                               <<03002>>59652000
          IF LGETYESNO( M2006)   <<LOAD MAP?>>                 <<03002>>59654000
          THEN LOADMAP := TRUE;                                <<03002>>59656000
                                                               <<03002>>59658000
          DO BEGIN                                             <<03002>>59660000
          TEMP := CTAB0(CORESIZE);                             <<03002>>59662000
          GETNEWVAL(M2007,TEMP,256,4096);                      <<s8941>>59664000
            <<MEMORY SIZE = XXX?>>                             <<03002>>59666000
          END UNTIL VERIFY'PHYS'MEM(TEMP);                     <<03002>>59668000
                                                               <<MPEIV>>59670000
  REQIOC: IOCHANGES:=FALSE;                                    <<00678>>59672000
          TLTABLESIZE  := COMM(TLBUFSIZE);                     <<t8392>>59674000
          TLNUMENTRIES := COMM(TLBUFENTRIES);                  <<t8392>>59676000
REQOLIO:WHILE LGETYESNO(M2008) DO IOCHANGE;                    <<MPEIV>>59678000
        << I/O CONFIGURATION CHANGES? >>                       <<MPEIV>>59680000
IOCHECK:CHECKDEV(@REQOLIO);                                    <<MPEIV>>59682000
$PAGE "MAINSEG1 -- SET UP DISC COLD LOAD INFORMATION TABLE"             59684000
          LDT'INDEX := SYSDISC * LDTSIZE;                      <<*LDT*>>59686000
          LPDT'INDEX := SYSDISC * LPDTSIZE;                    <<*LPDT>>59688000
          DVR'INDEX := SYSDISC * DVRSIZE;                      <<*DVR*>>59690000
          SYSDISCTYPE := LDT'DEVICE'TYPE;                      <<*LDT*>>59692000
          SYSDISCSUBTYPE := LPDT'SUBTYPE;                      <<*LPDT>>59694000
          SYSDISCDRT := DVRDRTNUM;                             <<*DVR*>>59696000
<< BEGIN CSLDTX EXPANSION FOR SHOWCOMINFO AREA>>               <<01165>>59698000
         @CSLDTX:=@CSTAB + CSXSTART;                           <<01165>>59700000
         FOR J:=1 UNTIL CSTAB(CSLDTXENTNUM) DO                 <<01165>>59702000
            BEGIN                                              <<01165>>59704000
            IF NOT(LOGICAL(CSLDTXEXP)) THEN                    <<01165>>59706000
               BEGIN                                           <<01165>>59708000
               CSTABINCR:=CSSHOWCOMLEN;                        <<01165>>59710000
               MOVEDLTABLES;                                   <<01165>>59712000
               @CSLDTX:=@CSLDTX-CSSHOWCOMLEN;                  <<01165>>59714000
               FOR I:=CSTAB(COMSYSLEN)-(@CSLDTX(CSSHOWCOMINFO)-<<01165>>59716000
                      @CSTAB-1) STEP -1 UNTIL 0 DO             <<01165>>59718000
                  CSLDTX(I+CSSHOWCOMINFO+CSSHOWCOMLEN):=       <<01165>>59720000
                     CSLDTX(I+CSSHOWCOMINFO);                  <<01165>>59722000
               FOR I:=0 UNTIL CSSHOWCOMLEN-1 DO                <<01165>>59724000
                  CSLDTX(CSSHOWCOMINFO+I):=0;                  <<01165>>59726000
               IF CSLDTXCONTPTR <> 0 THEN                      <<01165>>59728000
                  CSLDTXCONTPTR:=CSLDTXCONTPTR+CSSHOWCOMLEN;   <<01165>>59730000
               IF CSLDTXPHLISTPTR <> 0 THEN                    <<01165>>59732000
                 CSLDTXPHLISTPTR:=CSLDTXPHLISTPTR+CSSHOWCOMLEN;<<01165>>59734000
               IF CSLDTXIDLISTPTR <> 0 THEN                    <<01165>>59736000
                 CSLDTXIDLISTPTR:=CSLDTXIDLISTPTR+CSSHOWCOMLEN;<<01165>>59738000
               CSLDTXEXP:=1;  <<SET EXPANDED FLAG>>            <<01165>>59740000
               CSTAB(COMSYSLEN):=CSTAB(COMSYSLEN)+CSSHOWCOMLEN;<<01165>>59742000
               CSLDTXENTRYSIZE:=CSLDTXENTRYSIZE+CSSHOWCOMLEN;  <<01165>>59744000
               END;                                            <<01165>>59746000
            CSLDTX'DEV'OPENED := 0;                            <<01165>>59748000
            LDT'INDEX := CSLDTXLDEV * LDTSIZE;                 <<*LDT*>>59750000
            IF LDT'DEVICE'TYPE = CSDEV17 THEN                  <<*LDT*>>59752000
               CSLDTX'DEV'DUMPED:=0;                           <<01165>>59754000
            @CSLDTX:=@CSLDTX + CSLDTXENTRYSIZE;                <<01165>>59756000
            END;                                               <<01165>>59758000
<<END CSLDTX EXPANSION FOR SHOWCOMINFO AREA>>                  <<01165>>59760000
IF LOADFROMTAPE THEN                                           <<SD.00>>59762000
  IF SERIALDISCLOAD THEN                                       <<03598>>59764000
    BEGIN <<TAPELOAD FROM SERIAL DISC>>                        <<SD.00>>59766000
    DVR'INDEX := DVRSIZE;  << LDEV # 1 >>                      <<*DVR*>>59768000
    IF SYSTAPEDRT=DVRDRTNUM AND                                <<*DVR*>>59770000
    SYSTAPEUNIT=0 THEN                                         <<00071>>59772000
       BEGIN <<ON SAME DRT COULD BE TROUBLE>>                  <<00071>>59774000
       LPDT'INDEX := SYSDISC * LPDTSIZE;                       <<*LPDT>>59776000
       IF LPDT'SUBTYPE=LH7906 THEN                             <<*LPDT>>59778000
          BEGIN <<USING SPLIT 7906 --THIS IS TROUBLE>>         <<00071>>59780000
          GETYESNO(@GETUNIT,M2004);<<LOAD FROM TOP OF 06>>     <<01103>>59782000
          GOTO SETLDEV; <<YES-THEREFORE UNIT# IS ZERO>>        <<00071>>59784000
          <<AND USER SHOULDN'T HAVE BEEN CHANGING THE>>        <<00071>>59786000
          <<UNIT #'S ON THE DRIVES>>                           <<00071>>59788000
          END   <<USING SPLIT 7906>>                           <<00071>>59790000
       ELSE                                                    <<00071>>59792000
          BEGIN <<USING THE ENTIRE DRIVE AS SYSDISC>>          <<00071>>59794000
GETUNIT:  MESSAGE(M2401); <<WARNING-ON SAME DRT & UNIT>>       <<01103>>59796000
          MESSAGE(M2329); <<MAKE CHANGES NOW>>                 <<01103>>59798000
          DO UNTIL LGETYESNO(M2332);  <<READY?>>               <<01103>>59800000
          SYSTAPEUNIT:=GETVAL(M2328,1,7,1); <<NEW UNIT#>>      <<01103>>59802000
          END;  <<USING THE ENTIRE DRIVE>>                     <<00071>>59804000
       END;  <<ON SAME DRT>>                                   <<00071>>59806000
    END;                                                       <<01119>>59808000
    << GET LOAD DEVICE LDEV, TYPE & SUBTYPE >>                 <<01119>>59810000
SETLDEV: SYSTAPELDEV:=0;                                       <<00071>>59812000
  IF LOADFROMTAPE THEN                                         <<01119>>59814000
    << IF SYSTAPELDEV POINTS TO A DISC THEN THAT DISC CANNOT >><<01119>>59816000
    << BE ADDED TO THE SYSTEM DOMAIN UNLESS IT HAS ALREADY   >><<01119>>59818000
    << BEEN INITIALIZED.  THEREFORE, INITIALIZE THESE SILLY  >><<01119>>59820000
    << VARIABLES UNLESS WARM/COOL START WHEN NO ONE CARES!!  >><<01119>>59822000
    DO                                                         <<SD.00>>59824000
      BEGIN <<FIND VALID SYSTAPELDEV>>                         <<SD.00>>59826000
      I:=0;                                                    <<SD.00>>59828000
      WHILE (I:=I+1)<=HLDEV DO                                 <<SD.00>>59830000
        BEGIN                                                  <<*DVR*>>59832000
        DVR'INDEX := I * DVRSIZE;                              <<*DVR*>>59834000
        IF DVRDRTNUM = SYSTAPEDRT THEN                         <<*DVR*>>59836000
          SYSTAPELDEV:=I;                                      <<SD.00>>59838000
        END;                                                   <<*DVR*>>59840000
      IF SYSTAPELDEV=0 THEN                                    <<SD.00>>59842000
        MESSAGE(M2400); <<WARNING-NOT IN I/O CONFIGURATION>>   <<01103>>59844000
      IF SYSTAPELDEV=1 THEN                                    <<SD.00>>59846000
        MESSAGE(M2401); <<WARNING-ON SAME DRT & UNIT>>         <<01103>>59848000
      IF SYSTAPELDEV < 2 AND SERIALDISCLOAD THEN               <<01119>>59850000
         BEGIN <<INVALID LDEV>>                                <<SD.00>>59852000
         MESSAGE(M2329); <<MAKE CHANGES NOW>>                  <<01103>>59854000
         DO UNTIL LGETYESNO(M2332); <<READY?>>                 <<01103>>59856000
         SYSTAPEUNIT:=GETVAL(M2328,0,7,1); <<NEW UNIT #>>      <<01103>>59858000
         END;  <<INVALID LDEV>>                                <<SD.00>>59860000
      END   <<FIND VALID SYSTAPELDEV>>                         <<SD.00>>59862000
    UNTIL NOT SERIALDISCLOAD OR SYSTAPELDEV >= 2;              <<01119>>59864000
    LDT'INDEX := SYSTAPELDEV * LDTSIZE;                        <<*LDT*>>59866000
    LPDT'INDEX := SYSTAPELDEV * LPDTSIZE;                      <<*LPDT>>59868000
    SYSTAPESTYPE:=LPDT'SUBTYPE;                                <<*LPDT>>59870000
    SYSTAPETYPE:=LDT'DEVICE'TYPE;                              <<*LDT*>>59872000
            <<SET UP DRTS FOR DISCS AND COLDLOAD DEV>>         <<00888>>59874000
            I:=1;                                              <<00888>>59876000
            DO                                                 <<00888>>59878000
               BEGIN <<DRT FOR EACH DISC>>                     <<00888>>59880000
               LDT'INDEX := I * LDTSIZE;                       <<*LDT*>>59882000
               DVR'INDEX := I * DVRSIZE;                       <<*DVR*>>59884000
               IF NON'DS'LDEV(I) AND                           <<03550>>59886000
                 LDT'ACCESS'TYPE = 0 << DIRECT'ACCESS >> THEN  <<*LDT*>>59888000
                  BEGIN                                        <<03550>>59890000
                  INITDRT( DVRDRTNUM);                         <<*DVR*>>59892000
                                                               <<03550>>59894000
                  END;                                         <<03550>>59896000
               END                                             <<00888>>59898000
            UNTIL (I:=I+1)>HLDEV;                              <<00888>>59900000
                                                               <<03672>>59902000
            << MAKE SYSTEM DISC READY TO TALK TO >>            <<03672>>59904000
            DISC(INIT'DEV,SYSDISC,0D,DTEMP,2);                 <<03672>>59906000
                                                               <<03672>>59908000
          IF LOADFROMTAPE THEN                                 <<04580>>59910000
            INITDRT( SYSTAPEDRT); << COLDLOAD DEV >>           <<02510>>59912000
          IF NOT SECONDPASS THEN                                        59914000
            BEGIN  <<SET UP COLD LOAD INFORMATION TABLE>>               59916000
              IF RELOAD THEN                                            59918000
                BEGIN  <<INITIALIZE TABLE>>                             59920000
                  ZEROBUF(INFO,INFOSIZE);                      <<03549>>59922000
                  INFO(COLD'LOAD'ID') := COMM(COLDLOADID');    <<CONFD>>59924000
                  INFO(LOADMODE).RLMODE := 1; <<RELOAD IN PROGRESS>>    59926000
                  INFO(DIRSECT) := CTAB(DIRSECT');             <<CONFD>>59928000
                  INFO(VIRMEMSECT) := CTAB(VIRMEMSECT');       <<CONFD>>59930000
                  INFO(RINS) := CTAB(RINS');                   <<CONFD>>59932000
                  INFO(GRINS) := CTAB(GRINS');                 <<CONFD>>59934000
                  INFO(NLOGPROCS):=CTAB(NLOGPROCS');           <<CONFD>>59936000
                  INFO(LOGIDS) := CTAB(LOGIDS');               <<CONFD>>59938000
                  << BUILD COLD LOAD EXT TABLE >>              <<CONFD>>59940000
                  ZEROBUF( LBUF, 256);                         <<CONFD>>59942000
                  LBUF( LOG'FILE'NUM') := COMM( LOGFILENUM');  <<CONFD>>59944000
                  DISC( WRITE, SYSDISC, CLEXTSECT, LBUF, 256); <<CONFD>>59946000
                END                                                     59948000
              ELSE                                                      59950000
                BEGIN  <<USE COPY OF TABLE ON DISC>>                    59952000
$IF X1=ON  << ******** SERIES 33 UNIQUE ************ >>        <<02510>>59954000
                  DISC(READ,SYSDISC,0D,LBUF,128);              <<00888>>59956000
                  IF BLBUF<>"SYSTEM DISC " OR                  <<00888>>59958000
                  BLBUF(LABSYSID)<>"3000" OR LBUF(LAB6)        <<00888>>59960000
                    .LABDTYPE<>SYSDISCTYPE OR LBUF(LAB6).LABDSUBTYPE    59962000
                    <>SYSDISCSUBTYPE THEN                      <<00888>>59964000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>59966000
                  DISC(READ,SYSDISC,0D,LBUF,128);                       59968000
                  IF LBUF=0 OR BLBUF(LABSYSID)<>"3000" OR LBUF(LAB6)    59970000
                    .LABDTYPE<>SYSDISCTYPE OR LBUF(LAB6).LABDSUBTYPE    59972000
                    <>SYSDISCSUBTYPE THEN                               59974000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>59976000
                    BEGIN  <<SYSTEM DISC RECONFIGURED>>                 59978000
                      MESSAGE(M104);                           <<01103>>59980000
                      GO REQIOC;                                        59982000
                    END;                                                59984000
                  DISC(READ,SYSDISC,D'L(INFOSECTOR)),INFO,INFOSIZE);    59986000
                  IF LOADFROMTAPE THEN                                  59988000
                    BEGIN  <<ADJUST TABLE FOR INCREASES IN SIZES>>      59990000
                    ZEROBUF(LBUF,256);                         <<06067>>59992000
                    MOVE LBUF:=INFO,(INFO(TABPTR));            <<06067>>59994000
                    MOVE LBUF(LOWINFOWORDS):=INFO(INFO         <<06067>>59996000
                       (TABPTR)),(INFO(TCSTPTR)-INFO(TABPTR)); <<06067>>59998000
                    MOVE LBUF(LOWINFOWORDS+NTABLES*5):=        <<06067>>60000000
                       INFO(INFO(TCSTPTR)),(INFO(NUTCST')*5);  <<06067>>60002000
                    MOVE INFO:=LBUF,(256);                     <<06067>>60004000
                    END;                                                60006000
                END;                                                    60008000
              INFO(TABPTR) := LOWINFOWORDS; <<PTR TO TABLE AREA>>       60010000
              INFO(TCSTPTR) := LOWINFOWORDS + (NTABLES * 5);<<TCST PTR>>60012000
              INFO(NREAD) := NTABLES+NSTARTSEG;<<# OF BOOTSTRAP READS>> 60014000
              INFO(RINSECT) := (INFO(RINS)*3 +                 <<*RIN2>>60016000
                                INFO(GRINS)*12+137)&LSR(7);    <<00717>>60018000
              INFO(LOGIDSECT):=(INFO(NLOGPROCS)*33+33)/128 + 2;<<00506>>60020000
              INFO(LOGTABSECT):=(INFO(NLOGPROCS)*38+38)/128 + 2;        60022000
              @TABLEINFO := @INFO+INFO(TABPTR);                         60024000
              @TCSTINFO := @INFO+INFO(TCSTPTR);                         60026000
              COLDLOADID := INFO(COLD'LOAD'ID');                        60028000
              IF RESTORING THEN                                         60030000
                BEGIN <<COPY INFO FROM OLDINFO FOR USE WHEN GETTING BACK60032000
                        THE SAME DISC SPACE AND DETERMINING WHERE       60034000
                        DEFECTIVE TRACKS ARE LOCATED>>                  60036000
                <<COPY DISC ADDRESSES FOR TABLES>>                      60038000
                  @OLDTABLEINFO := @OLDINFO(OLDINFO(TABPTR));           60040000
                  J := (OLDINFO(TCSTPTR)-OLDINFO(TABPTR))&LSR(1);       60042000
          X := CSTABINFOX+1; <<INDEX FOR CSTAB DISC ADR>>               60044000
                  DO BEGIN                                              60046000
                     TABLEINFO(X) := OLDTABLEINFO(X);                   60048000
                     TABLEINFO(X) := OLDTABLEINFO(X:=X+1);              60050000
                     X := X+4;                                          60052000
                     END                                                60054000
                  UNTIL X > J;                                          60056000
                <<COPY DISC ADDRESSES FOR INITIAL'S CST'S>>             60058000
                  @OLDTCSTINFO := @OLDINFO(OLDINFO(TCSTPTR));           60060000
                  I := 0;                                               60062000
                  DO BEGIN                                              60064000
                     TCSTINFO(X) := OLDTCSTINFO(I*5+3);                 60066000
                     TCSTINFO(X) := OLDTCSTINFO(X:=X+1);                60068000
                     END                                                60070000
                  UNTIL (I:=I+1) = OLDINFO(NUTCST');                    60072000
                <<COPY DISC ADDRESSES FOR SYSTEM DISC AREAS>>           60074000
                  INFOD(X) := OLDINFOD(DIRADR);  <<DIRECTORY>>          60076000
                  INFOD(X) := OLDINFOD(VIRMEMADR); <<VIRTUAL MEMORY>>   60078000
                  INFOD(X) := OLDINFOD(RINADR);  <<RIN TABLE>>          60080000
                  INFOD(LOGIDADDR):=OLDINFOD(LOGIDADDR);       <<00506>>60082000
                  INFOD(LOGTABADDR):=OLDINFOD(LOGTABADDR);     <<00506>>60084000
                END;                                                    60086000
              IF NOT RELOAD THEN                                        60088000
                BEGIN  <<READ VOLUME TABLE FROM DISC>>                  60090000
                  I := IF INFO(H'VOL').(0:8) <> 0 THEN         <<RH.PV>>60092000
                       INFO(H'VOL').(0:8) ELSE                 <<RH.PV>>60094000
                       INFO(H'VOL').(8:8);                     <<RH.PV>>60096000
                  VTABINCR := (I-MVOL)*VTABSIZE;               <<RH.PV>>60098000
                  IF <> THEN MOVEDLTABLES; <<MAY BE DIFF. ON COLDSTART>>60100000
                  NVOL := INFO(H'VOL'); << MVOL/HVOL >>        <<RH.PV>>60102000
                  IF MVOL = 0 THEN MVOL := HVOL ELSE           <<RH.PV>>60104000
                  IF HVOL > MVOL THEN HVOL := MVOL;            <<RH.PV>>60106000
                  READTABLE(TABLEINFO(VTABINFOX+3),VTAB,       <<RH.PV>>60108000
                            (MVOL+1)*VTABSIZE); <<READ VTAB>>  <<RH.PV>>60110000
                  IF VTAB(1)<>COLDLOADID THEN ERRMESSAGE(M201);<<01103>>60112000
                     <<VOLUME TABLE DESTROYED; MUST RELOAD>>            60114000
             IF LOGICAL(INFO(LOADMODE).RLMODE) THEN ERRMESSAGE(M100);   60116000
                     <<PREVIOUS RELOAD ABORTED; MUST RELOAD>>           60118000
                  IF LOGICAL(INFO(LOADMODE).RYMODE) THEN RECOVERY:=TRUE;60120000
                END;                                                    60122000
              IF LOADFROMTAPE THEN                                      60124000
                BEGIN<<WRITE OUT INFO TABLE SO LOAD FLAGS CORRECT>>     60126000
                  INFO(LOADMODE).TLMODE := 1; <<COLD LOAD FROM TAPE>>   60128000
                  DISC(WRITE,SYSDISC,D'L(INFOSECTOR)),INFO,INFOSIZE);   60130000
                END;                                                    60132000
$PAGE "MAINSEG1  --  SET UP DISC VOLUMES"                               60134000
       IF STARTTYPE = CBNEW THEN                               <<*9006>>60136000
          BEGIN                                                <<*9006>>60138000
          INX := 0;                                            <<*9006>>60140000
          WHILE AUTOTBL(INX+ATID) <> 0 DO                      <<*9006>>60142000
             BEGIN                                             <<*9006>>60144000
             IF AUTOTBL(INX+ATID) =                            <<*9006>>60146000
                IDENTIFY(SYSDISCDRT) THEN                      <<*9006>>60148000
                BEGIN                                          <<*9006>>60150000
                VTABINCR := -MVOL * VTABSIZE;                  <<*9006>>60152000
                MOVEDLTABLES;                                  <<*9006>>60154000
                MVOL := 0;                                     <<*9006>>60156000
                HVOL := 0;                                     <<*9006>>60158000
                MOVE VNAMEI := AUTOTBL(INX+ATNAME),(4);        <<*9006>>60160000
                VTABINX := ADDVOL( VNAME);                     <<*9006>>60162000
                IF <> THEN ERRMESSAGE( M374, 7);               <<*9006>>60164000
                VTAB(VTABINX+VTAB12).VMS := 1;                 <<*9006>>60166000
                VTAB(VTABINX+VTAB11) :=                        <<*9006>>60168000
                   AUTOTBL(INX+ATVMSIZE)*1024;                 <<*9006>>60170000
                LDT'INDEX := LDTSIZE;                          <<*9006>>60172000
                LPDT'INDEX := LPDTSIZE;                        <<*9006>>60174000
                LDT'DEVICE'TYPE := AUTOTBL(INX+ATTYPE);        <<*9006>>60176000
                LPDT'SUBTYPE := AUTOTBL(INX+ATSUBTYPE);        <<*9006>>60178000
                                                               <<*9006>>60180000
                <<  BUILD DISC LABEL   >>                      <<*9006>>60182000
                                                               <<*9006>>60184000
                ZEROBUF( LBUF, 256);                           <<*9006>>60186000
                MOVE LBUF := "SYSTEM DISC ";                   <<*9006>>60188000
                LBUF(LAB6).LABDTYPE := LDT'DEVICE'TYPE;        <<*9006>>60190000
                LBUF(LAB6).LABDSUBTYPE := LPDT'SUBTYPE;        <<*9006>>60192000
                MOVE BLBUF(LABSYSID) := "3000";                <<*9006>>60194000
                MOVE LBUF(LABVOL) := VNAMEI,(4);               <<*9006>>60196000
                LBUF(LABCOLDLOADID) := COLDLOADID;             <<*9006>>60198000
                INIT'DSCT(LBUF(128));                          <<*9006>>60200000
                DISC(WRITE,SYSDISC,0D,LBUF,256);               <<*9006>>60202000
                END;                                           <<*9006>>60204000
             INX := INX + ATENTSIZE;                           <<*9006>>60206000
             END;                                              <<*9006>>60208000
          END;                                                 <<*9006>>60210000
                                                               <<*9006>>60212000
                                                               <<*9006>>60214000
          <<------------------------------------                        60216000
            FIND OUT WHICH VOLUMES ARE MOUNTED                          60218000
          ------------------------------------>>                        60220000
              I := 0;                                                   60222000
              WHILE (I:=I+1) <= HVOL DO                                 60224000
                                                               <<D7830>>60226000
                <<------------------------------------------>> <<D7830>>60228000
                << CLEAN UP THE SYSTEM VOLUME PORTION OF    >> <<D7830>>60230000
                << THE VOLUME TABLE.  ZERO ALL FIELDS       >> <<D7830>>60232000
                << EXCEPT FOR THE VOLUME NAME AND VM-       >> <<D7830>>60234000
                << RELATED FIELDS.  THIS IS DONE BECAUSE    >> <<D7830>>60236000
                << HISTORICALLY SYSDUMP & INITIAL BUILT     >> <<D7830>>60238000
                << VOLUME TABLE ENTRIES WITH GARBAGE LEFT   >> <<D7830>>60240000
                << IN THEM, WHICH AT TIMES CAUSED PROBLEMS. >> <<D7830>>60242000
                <<------------------------------------------>> <<D7830>>60244000
                                                               <<D7830>>60246000
                IF VTAB(I*VTABSIZE) = 0 THEN  <<UNUSED ENTRY>> <<D7830>>60248000
                  ZEROBUF (VTAB(I*VTABSIZE), VTABSIZE)         <<D7830>>60250000
                                                               <<D7830>>60252000
                ELSE                          << REAL ENTRY >> <<D7830>>60254000
                  IF VTAB(I*VTABSIZE+VTAB12).VMS = 1 THEN      <<D7830>>60256000
                    BEGIN                                      <<D7830>>60258000
                    VDSTART1 := VTAB(I*VTABSIZE+VTAB8);        <<D7830>>60260000
                    VDSTART2 := VTAB(I*VTABSIZE+VTAB9);        <<D7830>>60262000
                    VDSLEN1 := VTAB(I*VTABSIZE+VTAB10);        <<D7830>>60264000
                    VDSLEN2 := VTAB(I*VTABSIZE+VTAB11);        <<D7830>>60266000
                    ZEROBUF (VTAB(I*VTABSIZE+4),               <<D7830>>60268000
                             VTABSIZE-4);                      <<D7830>>60270000
                    VTAB(I*VTABSIZE+VTAB12).VMS := 1;          <<D7830>>60272000
                    VTAB(I*VTABSIZE+VTAB8) := VDSTART1;        <<D7830>>60274000
                    VTAB(I*VTABSIZE+VTAB9) := VDSTART2;        <<D7830>>60276000
                    VTAB(I*VTABSIZE+VTAB10) := VDSLEN1;        <<D7830>>60278000
                    VTAB(I*VTABSIZE+VTAB11) := VDSLEN2;        <<D7830>>60280000
                    END                                        <<D7830>>60282000
                                                               <<D7830>>60284000
                  ELSE                                         <<D7830>>60286000
                    ZEROBUF (VTAB(I*VTABSIZE+4),               <<D7830>>60288000
                             VTABSIZE-4);                      <<D7830>>60290000
                                                               <<D7830>>60292000
              VTABINCR := (HVOL-MVOL) * VTABSIZE;              <<01035>>60294000
              IF <> THEN MOVEDLTABLES;  << DELETE PV AREA >>   <<01035>>60296000
              MVOL := 0;                                       <<01035>>60298000
              << INITIAL COMPUTES A NEW VALUE FOR MVOL IN   >> <<01035>>60300000
              << PRIVATE VOLUME SECTION.  FROM THIS POINT   >> <<01035>>60302000
              << ON, MVOL CONTAINS UNRELIABLE INFORMATION   >> <<01035>>60304000
              << AND SHOULD NOT BE USED UNTIL RECOMPUTED.   >> <<01035>>60306000
              LDEV := 0;                                                60308000
              WHILE (LDEV:=LDEV+1) <= HLDEV DO                          60310000
                BEGIN                                          <<03550>>60312000
                LDT'INDEX := LDEV * LDTSIZE;                   <<*LDT*>>60314000
                LPDT'INDEX := LDEV * LPDTSIZE;                 <<*LPDT>>60316000
                TYPE := LDT'DEVICE'TYPE;                       <<*LDT*>>60318000
                SUBTYP := LPDT'SUBTYPE;                        <<*LPDT>>60320000
                                                               <<03550>>60322000
                IF NON'DS'LDEV(LDEV) AND  << SYSTEM-DOMAIN >>  <<03550>>60324000
                  SYSDISC'TYPE(TYPE,SUBTYP)    << DISC     >>  <<03550>>60326000
                  THEN                                         <<03550>>60328000
                  BEGIN                                        <<03550>>60330000
                                                               <<03550>>60332000
                << IF THE DISC HAS NOT BEEN INITIALIZED >>     <<03715>>60334000
                << YET, DO IT NOW                       >>     <<03715>>60336000
                                                               <<03715>>60338000
                  IF LDEV <> SYSDISC THEN                      <<03715>>60340000
                     DISC(INIT'DEV,LDEV,0D,DTEMP,2);           <<03715>>60342000
                                                               <<03715>>60344000
                  DISC(RSTAT,LDEV,0D,DTEMP,2);  << MAKE SURE >><<03550>>60346000
                  IF DTEMP2.NREADYF=1 THEN      <<   DISC IS >><<03550>>60348000
                    GO TRYANOTHER;              <<   ON-LINE >><<03550>>60350000
                                                               <<03550>>60352000
                << READ THE DISC LABEL AND THE DTT OR  >>      <<03715>>60354000
                << DSCT.                               >>      <<03715>>60356000
                                                               <<03672>>60358000
                  DISC(READ,LDEV,0D,LBUF,256);                 <<03550>>60360000
                                                               <<03550>>60362000
                << CHECK FOR A VALID LABEL AND DTT OR DSCT >>  <<03550>>60364000
                                                               <<03550>>60366000
                  IF VALID'SYSDISC( TYPE, SUBTYP,              <<03550>>60368000
                                        LBUF, DTT) = 0 THEN    <<03550>>60370000
                    BEGIN                                      <<03550>>60372000
                                                               <<03550>>60374000
                  << IF VOLUME WAS PRESENT LAST LOAD OR  >>    <<03550>>60376000
                  << WE'RE DOING A RELOAD, MARK VOLUME   >>    <<03550>>60378000
                  << AS PRESENT IN VTAB                  >>    <<03550>>60380000
                                                               <<03550>>60382000
                    IF LBUF(LABCOLDLOADID) = COLDLOADID OR     <<03550>>60384000
                       RELOAD THEN                             <<03550>>60386000
                       BEGIN                                   <<03550>>60388000
                       INDEX := FINDVOL(BLBUF(LABVOLB));       <<03550>>60390000
                       IF = THEN                               <<03550>>60392000
                            VTAB(INDEX+VTAB12).VTABLDEV        <<03550>>60394000
                                               := LDEV;        <<03550>>60396000
                       END;                                    <<03550>>60398000
                                                               <<03550>>60400000
                    IF TYPE=0 << MH DISC >> OR                 <<*LDT*>>60402000
                       TYPE = 1 << FH DISC >> THEN             <<*LDT*>>60404000
                       BEGIN                                   <<03550>>60406000
                       SORTDTT(DTT);    << SORT DTT >>         <<03550>>60408000
                       DISC(WRITE,LDEV,1D,DTT,128);            <<03550>>60410000
                       END;                                    <<03550>>60412000
                    END;                                       <<03550>>60414000
                  END;                                         <<03550>>60416000
TRYANOTHER:     END;                                           <<03550>>60418000
                                                                        60420000
          <<------------------------------------------------------      60422000
            MAKE SURE ALL PREVIOUSLY MOUNTED VOLUMES ARE PRESENT        60424000
          ------------------------------------------------------>>      60426000
             IF NOT(RELOAD) THEN                                        60428000
                BEGIN                                                   60430000
                  I := 0;                                               60432000
                  WHILE (I:=I+1) <= HVOL DO                             60434000
                  IF VTAB(I*VTABSIZE)<>0 AND VTAB(X:=X+VTAB12)          60436000
                    .VTABLDEV=0 THEN                                    60438000
                    BEGIN  <<AT LEAST ONE NOT MOUNTED>>                 60440000
                      MESSAGE(M2210);  <<FOLLOWING VOLUMES NOT <<01103>>60442000
                      I := I-1;                                         60444000
                      WHILE (I:=I+1) <= HVOL DO                         60446000
                      IF VTAB(I*VTABSIZE)<>0 AND VTAB(X:=X+VTAB12)      60448000
                        .VTABLDEV=0 THEN PRINT(VTAB(I*VTABSIZE),4,0);   60450000
                      GETYESNO(@MUSTMOUNT,M2201);<<LIST VOLUME <<01103>>60452000
                      LISTVOL;                                          60454000
MUSTMOUNT: ERRMESSAGE(M202);<<MOUNT CORRECT VOL OR REL>>       <<01103>>60456000
                    END;                                                60458000
                END;                                                    60460000
            END;                                                        60462000
                                                                        60464000
          <<------------------------------                              60466000
            DISC VOLUME CHANGES DIALOGUE                                60468000
          ------------------------------>>                              60470000
          VTABCHANGES := FALSE;                                <<01123>>60472000
          DTTCHANGES := FALSE;                                 <<01123>>60474000
          IF CHANGES AND LGETYESNO(M2200) THEN                 <<01123>>60476000
            BEGIN  << DISC VOLUME CHANGES? >>                  <<01123>>60478000
              VTABCHANGES := TRUE;                             <<01123>>60480000
              IF LGETYESNO(M2201) THEN LISTVOL;                <<01123>>60482000
              << LIST VOLUME TABLE? >>                         <<01123>>60484000
  REQDVOL:    IF RELOAD THEN                                            60486000
                BEGIN   <<VOLUMES MAY BE DELETED>>                      60488000
                  GETYESNO(@REQAVOL,M2202);    <<DELETE VOLUME?<<01103>>60490000
  REQVNAME1:      GETVNAME(@REQAVOL);  <<GET VOLUME NAME>>              60492000
                  INDEX := FINDVOL(VNAME);                              60494000
                  IF <> THEN                                            60496000
                    BEGIN <<NOT FOUND>>                                 60498000
                      MESSAGE(M2205);  <<NO SUCH VOLUME>>      <<01103>>60500000
                      GO REQVNAME1;                                     60502000
                    END;                                                60504000
                  IF INDEX/VTABSIZE = HVOL THEN                <<01035>>60506000
                    BEGIN  <<MUST COMPACT TABLE>>                       60508000
              DO                                               <<RH.PV>>60510000
                 BEGIN                                         <<RH.PV>>60512000
                 HVOL := HVOL - 1;                             <<01035>>60514000
                 I := HVOL;                                    <<01035>>60516000
                 IF VTAB(I*VTABSIZE) <> 0 THEN                 <<RH.PV>>60518000
                    GOTO SQUISHVTAB;                           <<RH.PV>>60520000
                 END                                           <<RH.PV>>60522000
              UNTIL <>;  <<WILL ALWAYS BE =>>                  <<RH.PV>>60524000
SQUISHVTAB:                                                    <<01035>>60526000
                      VTABINCR := X-INDEX;                     <<RH.PV>>60528000
                      MOVEDLTABLES;  <<COMPACT TABLE>>                  60530000
                    END                                                 60532000
                  ELSE                                                  60534000
                    BEGIN  <<ZERO ENTRY>>                               60536000
                      VTAB(INDEX) := 0;                                 60538000
                      MOVE VTAB(X:=X+1) := VTAB(X:=X-1),(VTABSIZE-1);   60540000
                    END;                                                60542000
                  GO REQVNAME1;                                         60544000
                END;                                                    60546000
  REQAVOL:    GETYESNO(@REQNVL,M2203);  <<ADD VOLUME?>>        <<01103>>60548000
  REQVNAME2:  GETVNAME(@REQNVL);                                        60550000
              FINDVOL(VNAME);                                           60552000
              IF = THEN                                                 60554000
                BEGIN  <<DUPLICATE>>                                    60556000
                  MESSAGE(M2206);  <<VOLUME ALREADY DEFINED>>  <<01103>>60558000
                  GO REQVNAME2;                                         60560000
                END;                                                    60562000
              ADDVOL(VNAME);                                            60564000
              IF <> THEN GO REQDVOL;  <<NO ROOM IN VTAB>>               60566000
              GO REQVNAME2;                                             60568000
REQNVL:       IF LGETYESNO(M2201) THEN LISTVOL;                <<01123>>60570000
              << LIST VOLUME TABLE? >>                         <<01123>>60572000
            END;                                                        60574000
                                                                        60576000
          <<------------------------------                              60578000
            CHECK DISCS FOR VALID LABELS                                60580000
          ------------------------------>>                              60582000
RECHECKLAB:                                                    <<00458>>60584000
          I := 0;                                                       60586000
          WHILE (I:=I+1)<=HVOL DO VTAB(I*VTABSIZE+VTAB12).VTABLDEV:=0;  60588000
          LDEV := 0;                                                    60590000
          WHILE (LDEV:=LDEV+1) <= HLDEV DO                              60592000
            BEGIN                                              <<*LDT*>>60594000
            LDT'INDEX := LDEV * LDTSIZE;                       <<*LDT*>>60596000
            LPDT'INDEX := LDEV * LPDTSIZE;                     <<*LPDT>>60598000
            IF NON'DS'LDEV(LDEV) AND                           <<03550>>60600000
               LDT'ACCESS'TYPE = 0 << DIRECT'ACCESS >> THEN    <<*LDT*>>60602000
              BEGIN         << IT'S A DISC >>                  <<03550>>60604000
                                                               <<03550>>60606000
              TYPE := LDT'DEVICE'TYPE;                         <<*LDT*>>60608000
              SUBTYP := LPDT'SUBTYPE;                          <<*LPDT>>60610000
                                                               <<03550>>60612000
            << IF NOT A SYSTEM-DOMAIN TYPE DISC, DON'T     >>  <<03550>>60614000
            << ALLOW IT TO BE ADDED TO THE SYSTEM VOLUMES  >>  <<03550>>60616000
                                                               <<03550>>60618000
              IF NOT SYSDISC'TYPE(TYPE,SUBTYP) THEN            <<03550>>60620000
                GO SETNSDFLAG                                  <<03648>>60622000
              ELSE LPDT'NON'SYS'DOMAIN := 0;                   <<*LPDT>>60624000
                                                               <<03550>>60626000
            << IF THERE IS THE POSSIBILITY THE DISC HAS   >>   <<03715>>60628000
            << NOT BEEN INITIALIZED YET, DO IT NOW.       >>   <<03715>>60630000
                                                               <<03715>>60632000
              IF SECONDPASS AND (LDEV <> SYSDISC) THEN         <<03715>>60634000
                 DISC(INIT'DEV,LDEV,0D,DTEMP,2);               <<03715>>60636000
                                                               <<03715>>60638000
              IF SDISC'TYPE(TYPE,SUBTYP) THEN                  <<03550>>60640000
                BEGIN                                          <<03550>>60642000
                DISC(RSTAT,LDEV,0D,DTEMP,2);                   <<03550>>60644000
                IF DTEMP2.NREADYF=1 THEN                       <<03550>>60646000
                            << DISC IS OFF-LINE--SET PV BIT >> <<03550>>60648000
                   GOTO SETNSDFLAG;                            <<03550>>60650000
                END;                                           <<03550>>60652000
                                                               <<03550>>60654000
            << READ LABEL AND DTT OR DSCT AND CHECK TO >>      <<03550>>60656000
            << SEE IF THEY ARE VALID                   >>      <<03550>>60658000
                                                               <<03550>>60660000
              DISC(READ,LDEV,0D,LBUF,256);                     <<03550>>60662000
              IF VALID'SYSDISC(TYPE,SUBTYP,LBUF,DTT) = 0 THEN  <<03550>>60664000
                BEGIN   <<VALID LABEL>>                                 60666000
                  VALID := TRUE;  <<VALID LABEL>>                       60668000
                  MOVE VNAMEI := LBUF(LABVOL),(4);                      60670000
                  INDEX := FINDVOL(VNAME);                              60672000
                  IF <> THEN                                            60674000
                    BEGIN   <<NOT FOUND IN TABLE>>                      60676000
                      BINBUF := MOVEAN(BINBUF(1),VNAME,8);     <<01103>>60678000
                      << DEVICE n VOLUME xxxx NOT DEFINED IN TA<<01103>>60680000
                      MESSAGE(M204,LDEV,,,,BINBUF);            <<01103>>60682000
                      GETYESNO(@SETNSDFLAG,M2211);             <<01103>>60684000
                      GETVNAME(@ADDTOTAB);  <<GET VOLUME NAME>>         60686000
                      GO FINDIT;                                        60688000
  V4ERR:              MESSAGE(M2453);  <<ILLEGAL INPUT>>       <<01103>>60690000
                      GO REQVNAME4;                                     60692000
                    END                                                 60694000
                  ELSE IF VTAB(INDEX+VTAB12).VTABLDEV<>0 THEN           60696000
                    BEGIN   <<DUPLICATE VOLUME NAME>>                   60698000
                      BINBUF := MOVEAN(BINBUF(1),VNAME,8);     <<01103>>60700000
                      << VOLUME NAME xxxx ON DEVICE n ALREADY I<<01103>>60702000
                      MESSAGE(M205,LDEV,,,,BINBUF);            <<01103>>60704000
                      GOTO REQVNAME4;                                   60706000
                    END;                                                60708000
                END                                                     60710000
              ELSE                                                      60712000
                BEGIN  <<INVALID LABEL>>                                60714000
                  IF SDISC'TYPE(TYPE,SUBTYP) THEN              <<03550>>60716000
                    BEGIN              << MIGHT BE A PV >>     <<03550>>60718000
                    IF RELOAD AND LDEV<>SYSTAPELDEV OR         <<00458>>60720000
                    SECONDPASS AND LDEV<>SYSTAPELDEV THEN      <<00458>>60722000
                      IF CHANGES OR SECONDPASS OR              <<00458>>60724000
                                                               <<03549>>60726000
                    << CHECK FOR A SCRATCH VOLUME >>           <<03549>>60728000
                                                               <<03549>>60730000
                      LBUF(6).LABDSUBTYPE<>SUBTYP OR           <<PV.PV>>60732000
                      LBUF(6).LABDTYPE<>TYPE OR                <<PV.PV>>60734000
                      LBUF(7)<>0 OR                            <<PV.PV>>60736000
                      LBUF(8)<>0 OR                            <<PV.PV>>60738000
                      LBUF(9)<>0 THEN                          <<PV.PV>>60740000
                      <<MAY BE ADDED TO SYSTEM SET>>           <<PV.PV>>60742000
                      BEGIN                                    <<RH.PV>>60744000
                        MOVE BINBUF := "NON-SYSTEM VOLUME ",2; <<RH.PV>>60746000
                        MOVE * :="ON LDEV ";                   <<00071>>60748000
                        J := ASCII(LDEV,10,BINBUF(26));        <<*8392>>60750000
                        PRINT(INBUF,-J-26,0);                  <<00071>>60752000
                        GETYESNO(@SETNSDFLAG,M2211);           <<01103>>60754000
                        VALID := FALSE;                        <<RH.PV>>60756000
                        ZEROBUF(LBUF,256);                     <<03549>>60758000
                        GOTO REQVNAME4;                        <<RH.PV>>60760000
                      END;                                     <<RH.PV>>60762000
  SETNSDFLAG:       LPDT'NON'SYS'DOMAIN := 1;                  <<*LPDT>>60764000
                    GO TO NEXTVOL;                             <<RH.PV>>60766000
                  END;                                         <<RH.PV>>60768000
                                                               <<03549>>60770000
                  ZEROBUF(LBUF,256);   << ZERO LABEL AND DTT>> <<03549>>60772000
                                       << OR DSCT BUFFER    >> <<03549>>60774000
                  VALID := FALSE;                                       60776000
                  MOVE BINBUF := "INVALID LABEL FOR DEVICE ";           60778000
                  J := ASCII(LDEV,10,BINBUF(25));              <<*8392>>60780000
                  PRINT(INBUF,-25-J,0);                                 60782000
  REQVNAME4:      GETVNAME(@V4ERR);                                     60784000
                  MOVE BLBUF(LABSYSID) := "3000"; <<LABEL VERIFIER>>    60786000
  FINDIT:         MOVE LBUF(LABVOL) := VNAMEI,(4);                      60788000
                  INDEX := FINDVOL(VNAME);                              60790000
                  IF <> THEN                                            60792000
                    BEGIN  <<NOT IN VOLUME TABLE>>                      60794000
  ADDTOTAB:           INDEX := ADDVOL(VNAME);                           60796000
                      IF <> THEN GOTO NEXTVOL; <<NO ROOM IN TABLE>>     60798000
                    END                                                 60800000
                  ELSE IF VTAB(INDEX+VTAB12).VTABLDEV<>0 THEN           60802000
                    BEGIN                                               60804000
                      MESSAGE(M2207); <<ALREADY IN USE>>       <<01103>>60806000
                      GOTO REQVNAME4;                                   60808000
                    END;                                                60810000
                  LPDT'NON'SYS'DOMAIN := 0;                    <<*LPDT>>60812000
                END;                                                    60814000
              IF NOT VALID THEN                                         60816000
                BEGIN  <<INITIALIZE DTT>>                               60818000
                  IF TYPE=MHDISCTYPE THEN                               60820000
                    BEGIN  <<MOVING HEAD>>                              60822000
                      L := SUBTYP*MHINFOSIZE;                  <<03549>>60824000
                      N := MHINFO(L+MHDEFLPS); <<DEFAULT PACK SIZE>>    60826000
                      GETNEWVAL(M2234,N,3*N/4,MHINFO(L+MHMAXLPS));      60828000
                      DTT(DTTLPS) := N;                                 60830000
                      DTT(DTTALT) := SIZE := N*MHINFO(L+MHTRKCYL);      60832000
                      J := MHINFO(L+MHTRKCYL)*MHINFO(L+MHMAXLPS);       60834000
                      K := 0;                                           60836000
                      DO                                                60838000
                        BEGIN  <<CHECK EACH TRACK FOR DEFECTIVE>>       60840000
                                                               <<03549>>60842000
                        DISC(2,LDEV,LOGICAL(K)**               <<03549>>60844000
                             MHINFOL(L+MHSECTRK),BUF,128);     <<03549>>60846000
                                                               <<03549>>60848000
                        IF <> THEN      << FOUND SUSPECT >>    <<03549>>60850000
                           ADDDTTENTRY(K&LSL(2));              <<03549>>60852000
                        END                                             60854000
                      UNTIL (K:=K+1)=J;                                 60856000
                    END                                                 60858000
                  ELSE IF TYPE = 1 << FH DISC >> THEN          <<*LDT*>>60860000
                       DTT(DTTLPS) := FHINFO(SUBTYP)           <<03549>>60862000
                  ELSE IF TYPE = 3 << CS80 DEVICE >> THEN      <<*LDT*>>60864000
                       INIT'DSCT(DSCT);                        <<03549>>60866000
                END;                                                    60868000
                                                                        60870000
          <<----------------------------------------------              60872000
            PROMPT OPERATOR FOR ACTION ON SUSPECT TRACKS                60874000
          ---------------------------------------------->>              60876000
            IF TYPE=0 <<MH DISC>> OR TYPE=1 <<FH DISC>> THEN   <<*LDT*>>60878000
              BEGIN                                            <<03549>>60880000
              L := SUBTYP * MHINFOSIZE;                        <<03549>>60882000
              J := 0;                                                   60884000
              WHILE (J:=J+1) <= DTT DO                                  60886000
                BEGIN  <<SCAN DTT FOR SUSPECTS>>                        60888000
                  K := DTT(J).(14:2);  <<TYPE>>                         60890000
                  IF K>1 THEN GOTO NEXTDTTENT; <<NOT INTERESTED>>       60892000
                  N := DTT(J)&LSR(2);  <<TRACK #>>                      60894000
                  IF K=0 AND J<>DTT AND DTT(J+1)&LSR(2)=N THEN K:=2;    60896000
                              <<UNREADABLE ALTERNATE>>                  60898000
                  TOS := @INBUF;  <<FOR PRINT>>                         60900000
                  TOS := @BINBUF;  <<FOR COMPUTING LINE COUNT>>         60902000
                  DUPLICATE;                                            60904000
                  IF K<2 THEN MOVE * := "SUSPECT",2                     60906000
                  ELSE MOVE * := "UNREADABLE",2;                        60908000
                  IF K>0 THEN MOVE * := " ALT",2;                       60910000
                  MOVE * := " TRK  LDEV #",2;                           60912000
                  TOS := 0;                                             60914000
                  TOS := LDEV;                                          60916000
                  TOS := 10;                                   <<*8392>>60918000
                  TOS := S3;                                   <<*8392>>60920000
                  TOS := ASCII(*,*,*);                         <<*8392>>60922000
                  ASSEMBLE(ADD);  <<NEW BUFFER PTR>>                    60924000
                  IF TYPE=MHDISCTYPE THEN                               60926000
                    BEGIN                                               60928000
                      MOVE * := " CYL=",2;                              60930000
                      TOS := CYLINDERHEAD(N,SUBTYP);                    60932000
                      ASSEMBLE(ZERO,XCH);                               60934000
                      TOS := 10;                               <<*8392>>60936000
                      TOS := S4;  <<BUFFER PTR>>               <<*8392>>60938000
                      TOS := ASCII(*,*,*);                     <<*8392>>60940000
                      ASSEMBLE(CAB,ADD);                                60942000
                      MOVE * := " HEAD=",2;                             60944000
                      ASSEMBLE(ZERO,CAB);                      <<*8392>>60946000
                      TOS := 10;                               <<*8392>>60948000
                      TOS := S3;                               <<*8392>>60950000
                      TOS := ASCII(*,*,*);                     <<*8392>>60952000
                    END                                                 60954000
                  ELSE                                                  60956000
                    BEGIN  <<FIXED HEAD DISC>>                          60958000
                      MOVE * := " TRACK=",2;                            60960000
                      TOS := 0;                                         60962000
                      TOS := N;                                         60964000
                      TOS := 10;                               <<*8392>>60966000
                      TOS := S3;                               <<*8392>>60968000
                      TOS := ASCII(*,*,*);                     <<*8392>>60970000
                    END;                                                60972000
                  ASSEMBLE(ADD); <<UPDATE BUFFER PTR>>                  60974000
                  MOVE * := " (SECTORS %",2;                            60976000
                  IF TYPE=MHDISCTYPE THEN TOS := LOGICAL(N)**MHINFOL    60978000
                    (L+MHSECTRK)                                        60980000
                  ELSE                                                  60982000
                    BEGIN  <<FIXED HEAD>>                               60984000
                      TOS := 0;                                         60986000
                      TOS := N&LSL(5);                                  60988000
                    END;                                                60990000
                  ASSEMBLE(CAB,ZERO);                                   60992000
                  TOS := DS3;  <<FIRST SECTOR>>                         60994000
                  ASSEMBLE(DDUP);                                       60996000
                  FSECT := TOS;                                         60998000
                  TOS := 8;  <<BASE 8>>                        <<00935>>61000000
                  TOS := S4;                                   <<00935>>61002000
                  TOS := LDNTOA(*,*,*);                        <<00935>>61004000
                  ASSEMBLE(ADD);  <<UPDATE BUFFER PTR>>                 61006000
                  MOVE * := "-%",2;                                     61008000
                  ASSEMBLE(ZERO,DXCH);                                  61010000
                  IF TYPE=MHDISCTYPE THEN TOS := TOS+DOUBLE(LOGICAL(    61012000
                    MHINFO(L+MHSECTRK)))-1D                             61014000
                  ELSE TOS := TOS+31D;                                  61016000
                  ASSEMBLE(DDUP);                                       61018000
                  LSECT := TOS;  <<LAST SECTOR>>                        61020000
                  TOS := 8;  <<BASE 8>>                        <<00935>>61022000
                  TOS := S4;                                   <<00935>>61024000
                  TOS := LDNTOA(*,*,*);                        <<00935>>61026000
                  ASSEMBLE(ADD,SUB; DUP,DECB; NEG,STAX);                61028000
                  BINBUF(X) := ")";                                     61030000
                  PRINT(*,*,0);                                         61032000
                <<ASK OPERATOR WHAT TO DO>>                             61034000
REQDISP:                                                       <<03550>>61036000
                << GET THE END OF THE RESERVED AREA >>         <<03550>>61038000
                  DTEMP := END'RESERVED(LDEV);                 <<03550>>61040000
                                                               <<03550>>61042000
                  FLAGGED := FALSE;                                     61044000
                  IF TYPE=MHDISCTYPE AND NOT VALID THEN                 61046000
                    BEGIN  <<CHECK FOR FLAGGED DEFECTIVE>>              61048000
                                                               <<03549>>61050000
                      DISC(2,LDEV,FSECT,BUF,128);              <<03549>>61052000
                                                               <<03549>>61054000
                      IF < THEN FLAGGED := TRUE;  <<TRACK IS FLAGGED>>  61056000
                      TOS := MHINFOL(L+MHSECTRK)**LOGICAL(SIZE);        61058000
                             <<FIRST SECTOR OF ALTERNATE AREA>>         61060000
                      IF TOS <= LSECT THEN                              61062000
                        BEGIN                                           61064000
                          MESSAGE(M2243);<<WARNING-IN ALTERNATE<<01103>>61066000
                          IF FLAGGED THEN                               61068000
                            BEGIN  <<MAY ONLY BE DELETED>>              61070000
  REQDELYN:                   GETYESNO(@DELERR,M2230);<<DELETE <<01103>>61072000
                              TOS := 2;  <<DELETE>>                     61074000
                              GO SETDISP;                               61076000
                            END;                                        61078000
                           GO REQDRI; <<DELETE, RECOVER OR IGNORE>>     61080000
  DELERR:                 MESSAGE(M2453);  <<ILLEGAL INPUT>>   <<01103>>61082000
                          GO REQDELYN;                                  61084000
                        END;                                            61086000
                    END;                                                61088000
                  IF FSECT<=DTEMP THEN  <<IN RESERVED AREA>>            61090000
IF FLAGGED THEN ERRMESSAGE(M232) <<FLAGGED TRACK IN>>          <<01103>>61092000
<<RESERVED AREA -- MUST REINITIALIZE PACK>>                    <<2B.00>>61094000
                  ELSE                                                  61096000
                    BEGIN                                               61098000
                      MESSAGE(M2240);<<WARNING - IN RESERVED AR<<01103>>61100000
  REQRECOVER:         GETYESNO(@IGNORE,M2229);  <<RECOVER?>>   <<01103>>61102000
                      TOS := 1;  <<RECOVER>>                            61104000
                      GOTO SETDISP;                                     61106000
  IGNORE:             TOS := 0;  <<IGNORE>>                             61108000
                      GOTO SETDISP;                                     61110000
                    END;                                                61112000
                  IF LDEV= SYSDISC THEN                                 61114000
                    BEGIN  <<CHECK FOR SPECIAL AREAS ON SYSTEM DISC>>   61116000
                      IF NOT LOADFROMTAPE THEN                          61118000
                        BEGIN  <<CHECK FOR TRACK IN SYSTEM AREA>>       61120000
                          CHECKSYS(FSECT,LSECT);                        61122000
                          IF <> THEN                                    61124000
                            BEGIN  <<IN SYSTEM AREA>>                   61126000
                             MESSAGE(M2246);<<WARNING-IN SYSTEM<<01103>>61128000
                              GO REQRECOVER;                            61130000
                            END;                                        61132000
                        END;                                            61134000
                      IF NOT (RELOAD)                          <<03612>>61136000
                        THEN                                   <<03612>>61138000
                          BEGIN  << CHK FOR DEFECTIVE TRACK  >><<03612>>61140000
                                 << IN THE DIRECTORY OR IN A >><<03612>>61142000
                                 << SYS DISC RESIDENT TABLE. >><<03612>>61144000
                            IF CHECK'DIRECTORY(FSECT,LSECT)    <<03612>>61146000
                              THEN                             <<03612>>61148000
                                BEGIN                          <<03612>>61150000
                                  MESSAGE(M2241);              <<03612>>61152000
                                  GO REQRECOVER;               <<03612>>61154000
                                END;                           <<03612>>61156000
                            IF CHECK'RESIDENT(FSECT,LSECT)     <<03612>>61158000
                              THEN                             <<03612>>61160000
                                BEGIN                          <<03612>>61162000
                                  MESSAGE(M2250);              <<03612>>61164000
                                  GO REQRECOVER;               <<03612>>61166000
                                END;                           <<03612>>61168000
                           END;                                <<03612>>61170000
                    END;                                                61172000
                                                               <<03613>>61174000
                  << Check to make sure it does not overlap >> <<03613>>61176000
                  << the disc free space data structures.   >> <<03613>>61178000
                                                               <<03613>>61180000
                  IF NOT reload THEN                           <<03613>>61182000
                  IF Check'If'Overlaps'Dfs'Data'Structures (   <<03613>>61184000
                        ldev, fsect, lsect) THEN               <<03613>>61186000
                     BEGIN  << Overlap >>                      <<03613>>61188000
                                                               <<03613>>61190000
                        Message (m2248);                       <<03613>>61192000
                        GOTO Req'rec'rea'ign;                  <<03613>>61194000
                                                               <<03613>>61196000
                     END;   << Overlap >>                      <<03613>>61198000
                                                               <<03613>>61200000
                  IF NOT RELOAD OR RESTORE THEN                <<03714>>61202000
                     BEGIN                                     <<03714>>61204000
                                                               <<03714>>61206000
                     IF CHECK'VM(LDEV,FSECT,LSECT) THEN        <<03714>>61208000
                        BEGIN                                  <<03714>>61210000
                        MESSAGE(M2242);   << WARNING: IN VM >> <<03714>>61212000
                        IF RESTORE THEN                        <<03714>>61214000
                           GOTO REQALL                         <<03714>>61216000
                        ELSE                                   <<03714>>61218000
                           GOTO REQDRI;                        <<03714>>61220000
                        END;                                   <<03714>>61222000
                     END;                                      <<03714>>61224000
                                                               <<03714>>61226000
  REQALL:         IF TYPE=MHDISCTYPE THEN                               61228000
                  IF FLAGGED THEN TOS := GETDISP(%14)<<DELETE,REASSIGN>>61230000
                  ELSE TOS := GETDISP(%17)  <<DELETE,REA,RECOVER,IGN>>  61232000
                  ELSE                                                  61234000
  REQDRI:         TOS := GETDISP(7);  <<DELETE,RECOVER,IGNORE>>         61236000
                                                               <<03613>>61238000
                  GOTO Setdisp;                                <<03613>>61240000
                                                               <<03613>>61242000
   Req'rec'rea'ign: IF type = mhdisctype THEN                  <<03613>>61244000
                       TOS := Getdisp (%13)                    <<03613>>61246000
                    ELSE                                       <<03613>>61248000
                       TOS := Getdisp (%3);                    <<03613>>61250000
                                                               <<03613>>61252000
  SETDISP:        M := TOS;                                             61254000
                  IF M=0 THEN GOTO NEXTDTTENT;  <<IGNORE>>              61256000
                  IF M=1 THEN                                           61258000
                    BEGIN  <<RECOVER>>                                  61260000
                      TOS := DELDTTENTRY(DTT(J));                       61262000
                      J := TOS+J;<<UPDATE COUNT BY # OF WORDS DELETED>> 61264000
                      GOTO NEXTDTTENT;                                  61266000
                    END;                                                61268000
                  IF M=3 THEN                                           61270000
                    BEGIN  <<REASSIGN>>                                 61272000
  CHECKALT:           IF DTT(DTTALT) >= MHINFO(L+MHMAXLPS)     <<03549>>61274000
                        *MHINFO(L+MHTRKCYL) THEN                        61276000
                        BEGIN  <<NO ALTERNATES AVAILABLE>>              61278000
                          MESSAGE(M226); <<NO ALTERNATES AVAILA<<01103>>61280000
                          GO REQDISP;                                   61282000
                        END;                                            61284000
                    <<DETERMINE IF FIRST ALT IS DELETED OR SUSPECT>>    61286000
                      Q := 0;                                           61288000
                      WHILE (Q:=Q+1) <= DTT DO                          61290000
                      IF DTT(Q)&LSR(2)=DTT(DTTALT) THEN                 61292000
                        BEGIN  <<AVAILABLE ALTERNATE IS BAD>>           61294000
                          DTT(X) := DTT(DTTALT)+1;                      61296000
                          GOTO CHECKALT;                                61298000
                        END;                                            61300000
                      ALT := DTT(DTTALT);                               61302000
                      DTT(DTTALT) := DTT(DTTALT) + 1;          <<03549>>61304000
                      IF NOT RELOAD THEN                       <<03549>>61306000
                        BEGIN                                  <<03549>>61308000
                                                               <<03549>>61310000
                      << TRY TO ADD AN ENTRY TO THE LIST OF >> <<03549>>61312000
                      << REASSIGNED AREAS.  ADD'AREA        >> <<03549>>61314000
                      << RETURNS FALSE IF THERE'S NO ROOM   >> <<03549>>61316000
                                                               <<03549>>61318000
                        NREASS := NREASS + 1;                  <<03714>>61320000
                        IF NOT ADD'AREA(REASSIGNED,NREASS,     <<03549>>61322000
                                MAX'REASS+1,LDEV,FSECT,        <<03714>>61324000
                                LSECT-FSECT+1D) THEN           <<03549>>61326000
                          BEGIN                                <<03549>>61328000
                                                               <<03549>>61330000
                        << FREE ALT. TRACK AND PRINT MESS. >>  <<03549>>61332000
                                                               <<03549>>61334000
                          NREASS := NREASS - 1;                <<03714>>61336000
                          DTT(DTTALT) := DTT(DTTALT) - 1;      <<03549>>61338000
                          MESSAGE(M233);                       <<03549>>61340000
                          GOTO REQDISP;                        <<03549>>61342000
                          END;                                 <<03714>>61344000
                                                               <<03549>>61346000
                        END;                                   <<03549>>61348000
                    END                                                 61350000
                  ELSE ALT := 0;  <<DELETING>>                          61352000
                                                               <<03714>>61354000
                  << CHECK TO SEE IF THIS TRACK IS SITUATED >> <<03714>>61356000
                  << SUCH THAT A RECOVER LOST DISC SPACE    >> <<03714>>61358000
                  << WILL BE NECESSARY AFTER IT IS          >> <<03714>>61360000
                  << REASSIGNED OR DELETED.                 >> <<03714>>61362000
                                                               <<03714>>61364000
                  IF RECOVERY'NEEDED(LDEV,FSECT,LSECT) THEN    <<03714>>61366000
                     RECOVERY := TRUE;   << SET FLAG >>        <<03714>>61368000
                                                               <<03714>>61370000
                  TOS := DELDTTENTRIES(N);  <<REMOVE ALL ENTRIES FROM   61372000
                             TABLE FOR THIS TRACK>>                     61374000
                  TOS := ADDDTTENTRY(N&LSL(2)+M);                       61376000
                  TOS := J;                                             61378000
                  ASSEMBLE(ADD,ADD);  <<DTT INDEX OFFSET>>              61380000
                  J := TOS;  <<UPDATE DTT INDEX>>                       61382000
                  IF TYPE=MHDISCTYPE THEN FLAGTRACK(LDEV,N,ALT);        61384000
  NEXTDTTENT:   END;                                                    61386000
              END   << PROCESSING SUSPECT TRACKS IN DTT >>     <<03549>>61388000
                                                                        61390000
            ELSE IF TYPE = 3 << CS80 DEVICE >> THEN            <<*LDT*>>61392000
              << PROCESS SUSPECT SECTORS IN DSCT >>            <<*LDT*>>61394000
              CS80'DEFECTS(LDEV,DSCT);                         <<*LDT*>>61396000
                                                               <<03549>>61398000
          <<---------------------                                       61400000
            UPDATE VOLUME LABEL                                         61402000
          --------------------->>                                       61404000
              VTAB(INDEX+VTAB12).VTABLDEV := LDEV;                      61406000
              LDT'INDEX := LDEV * LDTSIZE;                     <<*LDT*>>61408000
              LDT'VOLUME'TBL'INDEX := INDEX/VTABSIZE;          <<*LDT*>>61410000
              N := LBUF(LABCOLDLOADID);                                 61412000
              LBUF(LAB6).LABDTYPE := TYPE;                              61414000
              LBUF(LAB6).LABDSUBTYPE := SUBTYP;                         61416000
              DISC(WRITE,LDEV,0D,LBUF,256);                             61418000
              IF NOT(RELOAD) AND (NOT VALID OR                 <<01483>>61420000
              N <> COLDLOADID) THEN                            <<03551>>61422000
                   Init'Disc'Free'Space'Map (ldev);            <<03551>>61424000
       <<NEW VOL ADDED THIS TIME;INIT DISC FREE SPACE MAP>>    <<01483>>61426000
  NEXTVOL:                                                              61428000
            END;                                                        61430000
          END;                                                 <<*LDT*>>61432000
                                                                        61434000
          <<----------------------------------                          61436000
            MAKE SURE ALL VOLUMES ARE MOUNTED                           61438000
          ----------------------------------->>                         61440000
          I := 0;                                                       61442000
          WHILE (I:=I+1)<=HVOL DO                                       61444000
          IF VTAB(I*VTABSIZE)<>0 AND VTAB(X+VTAB12).VTABLDEV=0 THEN     61446000
            BEGIN   <<AT LEAST ONE VOLUME NOT MOUNTED>>                 61448000
              IF NOT SECONDPASS THEN                           <<00458>>61450000
                 BEGIN                                         <<00458>>61452000
                 << IT IS POSSIBLE THAT THE SYSTEM VOLUME   >> <<00458>>61454000
                 << SET WAS NOT SATISFIED ON THE FIRST      >> <<00458>>61456000
                 << PASS BECAUSE THE OPERATOR WASN'T GIVEN  >> <<00458>>61458000
                 << THE OPPORTUNITY TO MOVE THE SPINDLES    >> <<00458>>61460000
                 << FROM THE PRIVATE DOMAIN. HE WILL BE     >> <<00458>>61462000
                 << GIVEN THIS CHANCE ON PASS 2.            >> <<00458>>61464000
                 SECONDPASS:=TRUE;                             <<00458>>61466000
                 GOTO RECHECKLAB;                              <<00458>>61468000
                 END                                           <<00458>>61470000
              ELSE                                             <<00458>>61472000
                 MESSAGE(M203); << ALL VOLS MUST BE MOUNTED >> <<01103>>61474000
              GETYESNO(@REQIOC,M2201);  <<LIST VOLUME TABLE?>> <<01103>>61476000
              LISTVOL;                                                  61478000
              GO REQIOC;                                                61480000
            END;                                                        61482000
                                                               <<RH.PV>>61484000
                                                               <<01123>>61486000
                                                               <<01123>>61488000
      <<- - - - - - - - - - - - - - - - - - - - - - - - - - ->><<01123>>61490000
      <<              DEFECTIVE TRACKS DIALOG                >><<01123>>61492000
      << - - - - - - - - - - - - - - - - - - - - - - - - - - >><<01123>>61494000
                                                               <<01123>>61496000
                                                               <<01123>>61498000
          IF CHANGES AND VTABCHANGES THEN                      <<01123>>61500000
            BEGIN                                              <<01123>>61502000
              LIST'DEFECTS;    << LIST DEFECTIVE INFO. >>      <<03549>>61504000
              GETYESNO(@ENDDTT, M2227);  << DELETE TRACK? >>   <<01123>>61506000
              DTTCHANGES := TRUE;                              <<01123>>61508000
  REQLCH:     MESSAGE(-M2228);  << ENTER LDEV, CYL. AND HEAD >><<01123>>61510000
              READINPUT;                                       <<01123>>61512000
              LDEV := INVAL(@DELTERR);                         <<01123>>61514000
              IF = THEN GO ENDDTT;  << CR INPUT >>             <<01123>>61516000
              IF > OR NOT (1 <= LDEV <= 255) THEN              <<01123>>61518000
                BEGIN  << ILLEGAL INPUT >>                     <<01123>>61520000
  DELTERR:        MESSAGE(M2453);                              <<01123>>61522000
                  GO REQLCH;                                   <<01123>>61524000
                END;                                           <<01123>>61526000
                                                               <<03549>>61528000
            << INSURE VALID DISC AND DTT >>                    <<03549>>61530000
              IF VALID'DISC(LDEV) <> 0 THEN GOTO REQLCH;       <<03549>>61532000
                                                               <<03549>>61534000
              LDT'INDEX := LDEV * LDTSIZE;                     <<*LDT*>>61536000
              LPDT'INDEX := LDEV * LPDTSIZE;                   <<*LPDT>>61538000
              TYPE := LDT'DEVICE'TYPE;                         <<*LDT*>>61540000
              SUBTYP := LPDT'SUBTYPE;                          <<*LPDT>>61542000
                                                               <<03549>>61544000
              IF TYPE <> 0 << MH DISC >> AND                   <<*LDT*>>61546000
                 TYPE <> 1 << FH DISC >> THEN                  <<*LDT*>>61548000
                 BEGIN       << CAN'T DELETE TRACKS >>         <<03549>>61550000
                 MESSAGE(2502);    << ON THIS DISC  >>         <<03549>>61552000
                 GOTO REQLCH;                                  <<03549>>61554000
                 END;                                          <<03549>>61556000
                                                               <<03549>>61558000
              N := INVAL(@DELTERR);  << GET SECOND PARM >>     <<01123>>61560000
              IF = THEN GOTO DELTERR;  << CR INPUT >>          <<01123>>61562000
              IF > THEN                                        <<01123>>61564000
                IF TYPE = MHDISCTYPE THEN GOTO DELTERR         <<01123>>61566000
                ELSE                                           <<01123>>61568000
                  BEGIN  << FIXED HEAD DISC >>                 <<01123>>61570000
                    IF NOT (0<=N<=FHINFO(SUBTYP)-1) THEN       <<01123>>61572000
                      BEGIN  << INVALID TRACK # >>             <<01123>>61574000
                        MESSAGE(M2237);                        <<01123>>61576000
                        GO REQLCH;                             <<01123>>61578000
                      END;                                     <<01123>>61580000
                    TOS := 0;                                  <<01123>>61582000
                    TOS := N&LSL(5);                           <<01123>>61584000
                    ASSEMBLE(DDUP);                            <<01123>>61586000
                    FSECT := TOS;                              <<01123>>61588000
                    TOS := TOS + 31;                           <<01123>>61590000
                    LSECT := TOS;                              <<01123>>61592000
                    GOTO CHECKDEL;                             <<01123>>61594000
                  END;                                         <<01123>>61596000
              << FOLLOWED BY COMMA >>                          <<01123>>61598000
              IF TYPE=FHDISCTYPE THEN GO DELTERR;              <<01123>>61600000
              IF NOT (0<=N<=MHINFO((INDEX:=SUBTYP*MHINFOSIZE)+ <<01123>>61602000
                MHMAXLPS)-1) THEN                              <<01123>>61604000
                BEGIN  << INVALID CYLINDER NUMBER >>           <<01123>>61606000
                  MESSAGE(M2238);                              <<01123>>61608000
                  GO REQLCH;                                   <<01123>>61610000
                END;                                           <<01123>>61612000
              M := INVAL(@DELTERR);  << GET HEAD # >>          <<01123>>61614000
              IF <= THEN GO DELTERR;                           <<01123>>61616000
              IF NOT (MHINFO(INDEX+MHSTHEAD) <= M <=           <<01123>>61618000
                MHINFO(INDEX+MHTRKMULT)*MHINFO(INDEX+MHTRKCYL) <<01123>>61620000
                +MHINFO(INDEX+MHSTHEAD)-1) THEN                <<01123>>61622000
                BEGIN  << INVALID HEAD # >>                    <<01123>>61624000
                  MESSAGE(M2239);                              <<01123>>61626000
                  GO REQLCH;                                   <<01123>>61628000
                END;                                           <<01123>>61630000
              N := N*MHINFO(INDEX+MHTRKCYL)+(M-MHINFO(INDEX+   <<01123>>61632000
                MHSTHEAD))/MHINFO(INDEX+MHTRKMULT); <<TRACK #>><<01123>>61634000
              TOS := LOGICAL(N)**MHINFOL(INDEX+MHSECTRK);      <<01123>>61636000
              ASSEMBLE(DDUP);                                  <<01123>>61638000
              FSECT := TOS;                                    <<01123>>61640000
              LSECT := TOS+DOUBLE(MHINFOL(X))-1D;              <<01123>>61642000
                                                               <<01123>>61644000
       <<---------------------------------------------------->><<01123>>61646000
       <<CHECK THAT TRACK TO BE DELETED IS NOT IN A BAD PLACE>><<01123>>61648000
       <<---------------------------------------------------->><<01123>>61650000
CHECKDEL:                                                      <<03550>>61652000
              IF FSECT <= END'RESERVED(LDEV) THEN              <<03550>>61654000
                BEGIN  << IN RESERVED AREA >>                  <<01123>>61656000
                  MESSAGE(M227);                               <<01123>>61658000
                  GO REQLCH;                                   <<01123>>61660000
                END;                                           <<01123>>61662000
              IF TYPE=MHDISCTYPE THEN                          <<01123>>61664000
                BEGIN  <<CHECK FOR TRACK USED AS ALTERNATE>>   <<01123>>61666000
                  DISC(READ,LDEV,1D,DTT,128);                  <<01123>>61668000
                  IF DTT(DTTLPS)*MHINFO(INDEX+MHTRKCYL) <=N<=  <<01123>>61670000
                    DTT(DTTALT)-1 THEN                         <<01123>>61672000
                    BEGIN  <<IN ALTERNATE AREA>>               <<01123>>61674000
                      I := 0;                                  <<01123>>61676000
                      WHILE (I:=I+1)<=DTT DO                   <<01123>>61678000
                      IF DTT(I).(14:2)=3 THEN<<REASSGND TRACK>><<01123>>61680000
                      IF ALTTRACK(LDEV,DTT(I)&LSR(2))=N THEN   <<01123>>61682000
                        BEGIN       << SPECIFIED TRACK IS AN >><<01123>>61684000
                          MESSAGE(M229);<<ALT. - CAN'T DELETE>><<01123>>61686000
                          GO REQLCH;                           <<01123>>61688000
                        END;                                   <<01123>>61690000
                    END;                                       <<01123>>61692000
                END;                                           <<01123>>61694000
              IF LDEV=SYSDISC THEN                             <<01123>>61696000
                BEGIN  <<CHECK FOR SPECIAL AREAS ON SYS DISC>> <<01123>>61698000
                  IF NOT (RELOAD)                              <<03612>>61700000
                    THEN                                       <<03612>>61702000
                      BEGIN                                    <<03612>>61704000
                        IF CHECK'RESIDENT(FSECT,LSECT)         <<03612>>61706000
                          THEN                                 <<03612>>61708000
                            BEGIN                              <<03612>>61710000
                              MESSAGE(M236);<<IN SYS RESIDENT>><<03612>>61712000
                                            <<TAB - CAN'T DEL>><<03612>>61714000
                              GO REQLCH;                       <<03612>>61716000
                            END;                               <<03612>>61718000
                        IF CHECK'DIRECTORY(FSECT,LSECT)        <<03612>>61720000
                          THEN                                 <<03612>>61722000
                            BEGIN                              <<03612>>61724000
                              MESSAGE(M228); <<IN DIRECTORY>>  <<03612>>61726000
                                             <<CAN'T DELETE>>  <<03612>>61728000
                              GO REQLCH;                       <<03612>>61730000
                            END;                               <<03612>>61732000
                      END;                                     <<03612>>61734000
                    IF NOT LOADFROMTAPE THEN                   <<MPEIV>>61736000
                      BEGIN  <<CHECK FOR TRACK IN SYSTEM AREA>><<01123>>61738000
                        CHECKSYS(FSECT, LSECT);                <<01123>>61740000
                        IF <> THEN                             <<01123>>61742000
                          BEGIN  <<IN SYSTEM AREA>>            <<01123>>61744000
                            MESSAGE(M230);                     <<01123>>61746000
                            GO REQLCH;                         <<01123>>61748000
                          END;                                 <<01123>>61750000
                      END;                                     <<01123>>61752000
                END;                                           <<01123>>61754000
                                                               <<03613>>61756000
                  << Check to make sure it does not overlap >> <<03613>>61758000
                  << the disc free space data structures.   >> <<03613>>61760000
                                                               <<03613>>61762000
                  IF NOT reload THEN                           <<03613>>61764000
                  IF Check'If'Overlaps'Dfs'Data'Structures (   <<03613>>61766000
                        ldev, fsect, lsect) THEN               <<03613>>61768000
                     BEGIN  << Overlap >>                      <<03613>>61770000
                                                               <<03613>>61772000
                        Message (m237);                        <<03613>>61774000
                        GOTO Reqlch;                           <<03613>>61776000
                                                               <<03613>>61778000
                     END;   << Overlap >>                      <<03613>>61780000
                                                               <<03613>>61782000
              IF NOT RELOAD OR RESTORE THEN                    <<03714>>61784000
                 BEGIN                                         <<03714>>61786000
                                                               <<03714>>61788000
                 IF CHECK'VM(LDEV,FSECT,LSECT) THEN            <<03714>>61790000
                    BEGIN                                      <<03714>>61792000
                    MESSAGE(M2242);   << WARNING: IN VM >>     <<03714>>61794000
                                                               <<03714>>61796000
                    GETYESNO(@REQLCH, M2230);   << DELETE? >>  <<03714>>61798000
                    END;                                       <<03714>>61800000
                 END;                                          <<03714>>61802000
                                                               <<03714>>61804000
              DELDTTENTRIES(N);                                <<BB.02>>61806000
              << REMOVE ALL ENTRIES FOR THIS TRACK >>          <<BB.02>>61808000
              TOS := ADDDTTENTRY(N&LSL(2)+2);                  <<BB.02>>61810000
              << ADD DELETED ENTRY >>                          <<BB.02>>61812000
              IF TOS=0 THEN MESSAGE(M225)  <<TABLE FULL>>      <<BB.02>>61814000
              ELSE                                             <<BB.02>>61816000
                BEGIN         << FLAG DELETED TRACK >>         <<03714>>61818000
                                                               <<03714>>61820000
                  << FIRST CHECK TO SEE IF THIS TRACK IS    >> <<03714>>61822000
                  << SITUATED SUCH THAT A RECOVER LOST DISC >> <<03714>>61824000
                  << SPACE WILL BE NECESSARY AFTER IT IS    >> <<03714>>61826000
                  << DELETED.                               >> <<03714>>61828000
                                                               <<03714>>61830000
                  IF RECOVERY'NEEDED(LDEV,FSECT,LSECT) THEN    <<03714>>61832000
                     RECOVERY := TRUE;    << SET FLAG >>       <<03714>>61834000
                                                               <<03714>>61836000
                  IF TYPE = MHDISCTYPE THEN                    <<03714>>61838000
                     FLAGTRACK(LDEV,N,0);   << DELETE TRACK >> <<03714>>61840000
                                                               <<03714>>61842000
                END;                                           <<03714>>61844000
                                                               <<03714>>61846000
              DISC(WRITE,LDEV,1D,DTT,128); <<UPDATE TABLE>>    <<01123>>61848000
              GO REQLCH;                                       <<01123>>61850000
ENDDTT:     END;  << END OF DEFECTIVE TRACKS DIALOG >>         <<01123>>61852000
                                                               <<01123>>61854000
          IF DTTCHANGES THEN   << LIST DEFECTIVE TRACK/ >>     <<03549>>61856000
             LIST'DEFECTS;     << SECTOR INFORMATION?   >>     <<03549>>61858000
          <<------------------------------------------------->><<RH.PV>>61860000
          <<UPDATE VOLUME TABLE FOR MOUNTED PRIVATE VOLUMES  >><<RH.PV>>61862000
          <<------------------------------------------------->><<RH.PV>>61864000
          LDEV := 0;                                           <<RH.PV>>61866000
          MVOL := HVOL;  << FILL PV AREA OF VTAB >>            <<01035>>61868000
          WHILE (LDEV:=LDEV+1) <= HLDEV DO                     <<RH.PV>>61870000
            BEGIN                                              <<*LDT*>>61872000
            LDT'INDEX := LDEV * LDTSIZE;                       <<*LDT*>>61874000
            LPDT'INDEX := LDEV * LPDTSIZE;                     <<*LPDT>>61876000
            IF NON'DS'LDEV(LDEV) AND                           <<*LDT*>>61878000
              LDT'ACCESS'TYPE = 0 << DIRECT'ACCESS >> THEN     <<*LDT*>>61880000
            IF LPDT'NON'SYS'DOMAIN = 1 THEN                    <<*LPDT>>61882000
              BEGIN   <<ITS A NON-SYSTEM DOMAIN (PV) DISC>>    <<*LDT*>>61884000
                INDEX := ADDVOL(,TRUE);                        <<RH.PV>>61886000
                IF <> THEN LDEV:= HLDEV;                       <<04264>>61888000
              END;                                             <<*LDT*>>61890000
            END;                                               <<*LDT*>>61892000
          LDT'INDEX := SYSDISC * LDTSIZE;                      <<*LDT*>>61894000
          SYSVOL := LDT'VOLUME'TBL'INDEX;                      <<*LDT*>>61896000
          IF VTABCHANGES AND LGETYESNO(M2201) THEN LISTVOL;    <<MPEIV>>61898000
END;  <<  MAINSEG1  >>                                         <<03603>>61900000
$PAGE "MAINSEG1A"                                              <<03603>>61902000
$CONTROL SEGMENT=MAINSEG1A                                     <<03603>>61904000
PROCEDURE MAINSEG1A;                                           <<03603>>61906000
BEGIN                                                          <<03603>>61908000
   DEFINE D'NSECTPAGE = DOUBLE(NSECTPAGE)#;                    <<03603>>61910000
   EQUATE  IOPNTR = 4;       << DIRBASE'+4 >>                  <<SY>>   61912000
   DOUBLE                                                      <<03603>>61914000
      SECTORS,                                                 <<03603>>61916000
      NRSECT,                                                  <<03603>>61918000
      VDSLEN,                                                  <<03603>>61920000
      VDSTART,                                                 <<03603>>61922000
      START,                                                   <<03603>>61924000
      DISCADR;                                                 <<03603>>61926000
   LOGICAL                                                     <<03603>>61928000
      VOLUME,                                                  <<03603>>61930000
      VDSTART1   = VDSTART,                                    <<03603>>61932000
      VDSTART2   = VDSTART+1,                                  <<03603>>61934000
      VDSLEN1    = VDSLEN,                                     <<03603>>61936000
      VDSLEN2    = VDSLEN+1;                                   <<03603>>61938000
   BYTE ARRAY NAME(0:79);                                      <<03603>>61940000
   DOUBLE DCOREADDR;  << DOUBLE WORD CORE ADDRESS >>           <<03603>>61942000
   LOGICAL BANK      = DCOREADDR,                              <<03603>>61944000
           COREADDR  = DCOREADDR+1;                            <<03603>>61946000
INTEGER ENTRIES;                                               <<32BND>>61948000
   INTEGER                                                     <<03603>>61950000
                                                               <<03635>>61952000
      LEN,                                                     <<03603>>61954000
      SIZE,                                                    <<03603>>61956000
      ILOC,                                                    <<03603>>61958000
      I,                                                       <<03603>>61960000
      TEMP,                                                    <<*LDT*>>61962000
      LDT'INDEX,                                               <<*DVR*>>61964000
      LPDT'INDEX,                                              <<*DVR*>>61966000
      LDTX'INDEX,                                              <<*DVR*>>61968000
      DVR'INDEX;                                               <<*DVR*>>61970000
                                                               <<03635>>61972000
          <<----------------                                            61974000
            BOOTSTRAP INFO                                              61976000
          ---------------->>                                            61978000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<c8392>>61980000
  EQUATE  LCSIZE    =    12,         <<LOW CORE AREA SIZE>>    <<c8392>>61982000
          BOOTSTACKSIZE= 128,        <<STACK FOR BOOTSTRAP SIZE<<c8392>>61984000
          BOOTQI    =    32,         <<QI FOR BOOTSTRAP>>      <<c8392>>61986000
          INFOCOREADR=   %3000,      <<CORE ADDRESS FOR INFO TA<<c8392>>61988000
          SIOCOREADR=    %1000;      <<SIO PROGRAM CORE ADDRESS<<c8392>>61990000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<c8392>>61992000
  EQUATE  LCSIZE    =    12,         <<LOW CORE AREA SIZE>>    <<c8392>>61994000
          BOOTSTACKSIZE= 128,        <<STACK FOR BOOTSTRAP SIZE<<c8392>>61996000
          BOOTQI    =    32,         <<QI FOR BOOTSTRAP>>      <<c8392>>61998000
          INFOCOREADR=   %3000,      <<CORE ADDRESS FOR INFO TA<<c8392>>62000000
          SIOCOREADR=    %1000;<<CHANPROGRAM CORE ADDRESS>>    <<c8392>>62002000
$IF         << ***** RETURNING TO COMMON CODE ******* >>       <<c8392>>62004000
   POINTER DVCL;   << WORD POINTER TO CLASS TABLE >>           <<04306>>62006000
   INTEGER HI'STARFISH'DRT; << HIGHEST DRT ON STARTFISH >>     <<03603>>62008000
   INTEGER                                                     <<03675>>62010000
      STKNRSECT;  << INITIAL'S STACK SIZE IN SECTORS >>        <<03675>>62012000
   INTEGER                                                     <<03603>>62014000
      LCDISCADR,        <<DISC ADDRESS OF LOW CORE>>           <<03603>>62016000
      TCSTDISCADR,      <<DISC ADDRESS OF TCST>>               <<03603>>62018000
      ININDISCADR,      <<DISC ADDRESS ON INTERNAL INTS>>      <<03603>>62020000
      STACKDISCADR;     <<DISC ADDRESS OF BOOT STACK>>         <<03603>>62022000
   DOUBLE                                                      <<03603>>62024000
      STACK'DISC'ADR;   <<DISC ADDRESS OF INITIAL'S STK>>      <<03603>>62026000
   INTEGER ARRAY CLBUF(0:34); <<COLD LOAD READ INFO>>          <<03603>>62028000
   INTEGER POINTER CLPNTR;                                     <<03603>>62030000
   DOUBLE POINTER CLDPNTR = CLPNTR;                            <<03603>>62032000
        INTEGER ARRAY CORESIZES(0:NCORESIZES-1) = PB :=        <<03603>>62034000
        64, 80, 96, 128, 160, 192, 224, 256, 384, 512, 768,    <<03603>>62036000
        1024, 1152, 1280, 1408, 1536, 1664, 1792, 1920, 2048,  <<03603>>62038000
        2176, 2304, 2432, 2560, 2688, 2816, 2944, 3072,        <<03603>>62040000
        3200, 3328, 3456, 3584, 3712, 3840, 3968, 4096;        <<03603>>62042000
                                                               <<03603>>62044000
        DOUBLE ARRAY USEDCORE(0:NCORESIZES-1)=PB:=             <<03603>>62046000
        << LAST ADDRESS+1 FOR GIVEN MEMORY SIZE >>             <<03603>>62048000
        <<64K>>%200000D,   <<80K>>%240000D,                    <<03603>>62050000
        <<96K>>%300000D,   <<128K>>%400000D,                   <<03603>>62052000
        <<160K>>%500000D,  <<192K>>%600000D,                   <<03603>>62054000
        <<224K>>%700000D,  <<256K>>%1000000D,                  <<03603>>62056000
        <<384K>>%1400000D, <<512K>>%2000000D,                  <<03603>>62058000
        <<768K>>%3000000D, <<1024K>>%4000000D,                 <<03603>>62060000
        <<1152>>%4400000D, <<1280K>>%5000000D,                 <<03603>>62062000
        <<1408>>%5400000D, <<1536K>>%6000000D,                 <<03603>>62064000
        <<1664>>%6400000D, <<1792K>>%7000000D,                 <<03603>>62066000
        <<1920>>%7400000D, <<2048K>>%10000000D,                <<03603>>62068000
        <<2176>>%10400000D,<<2304K>>%11000000D,                <<03603>>62070000
        <<2432>>%11400000D,<<2560K>>%12000000D,                <<03603>>62072000
        <<2688>>%12400000D,<<2816K>>%13000000D,                <<03603>>62074000
        <<2944>>%13400000D,<<3072K>>%14000000D,                <<03603>>62076000
        <<3200>>%14400000D,<<3328K>>%15000000D,                <<03603>>62078000
        <<3456>>%15400000D,<<3584K>>%16000000D,                <<03603>>62080000
        <<3712>>%16400000D,<<3840K>>%17000000D,                <<03603>>62082000
        <<3968>>%17400000D,<<4096K>>%20000000D;                <<03603>>62084000
        <<-------------------------->>                         <<MPEIV>>62086000
        <<  VIRTUAL MEMORY CHANGES  >>                         <<MPEIV>>62088000
        <<-------------------------->>                         <<MPEIV>>62090000
                                                               <<MPEIV>>62092000
VERIFYVM;  << VERIFY VALIDITY OF VM VALUES >>                  <<MPEIV>>62094000
                                                               <<MPEIV>>62096000
WHILE VTAB(SYSVOL*VTABSIZE+VTAB12).VMS <> 1 OR                 <<01682>>62098000
  CHANGES AND LGETYESNO(M2215) DO                              <<01682>>62100000
  << VIRTUAL MEMORY CHANGES - FORCE ENTRY INTO DIALOG IF    >> <<01682>>62102000
  << THERE IS NO VIRTUAL MEMORY ON THE SYSTEM DISC.         >> <<01682>>62104000
  BEGIN  << VIRTUAL MEMORY CHANGES? >>                         <<MPEIV>>62106000
  IF LGETYESNO(M2216) THEN LISTVM;                             <<MPEIV>>62108000
  << LIST VIRTUAL MEMORY ALLOCATION? >>                        <<MPEIV>>62110000
REDO:                                                          <<MPEIV>>62112000
  MESSAGE(-M2217);  << ENTER VOLUME, SIZE IN KILO SECTORS >>   <<MPEIV>>62114000
  READINPUT;                                                   <<MPEIV>>62116000
  SCAN BINBUF WHILE BLANK, 1;                                  <<MPEIV>>62118000
  IF NOCARRY THEN  << NOT CARRAGE RETURN INPUT >>              <<MPEIV>>62120000
    BEGIN                                                      <<MPEIV>>62122000
    @BPINBUF := TOS;                                           <<MPEIV>>62124000
    << IF 1ST BYTE = ALPHA NAME WAS INPUT ELSE LDEV WAS INPUT>><<MPEIV>>62126000
    IF BPINBUF = ALPHA THEN                                    <<MPEIV>>62128000
      BEGIN  << GET VOLUME # FROM NAME >>                      <<MPEIV>>62130000
      MOVE NAME := "        ";  << 8 BLANKS >>                 <<MPEIV>>62132000
      MOVE NAME := BPINBUF WHILE ANS, 0;                       <<MPEIV>>62134000
      DELB;  << SAVE SOURCE, DELETE DESTINATION >>             <<MPEIV>>62136000
      IF BPS0 <> "," THEN                                      <<MPEIV>>62138000
        BEGIN                                                  <<MPEIV>>62140000
WRONG:  MESSAGE(M2453);  << ILLEGAL INPUT >>                   <<MPEIV>>62142000
        GOTO REDO;                                             <<MPEIV>>62144000
        END;                                                   <<MPEIV>>62146000
      @BPINBUF := TOS+1;  << SKIP COMMA >>                     <<MPEIV>>62148000
      VOLUME := FINDVOL(NAME);                                 <<MPEIV>>62150000
      IF <> THEN                                               <<MPEIV>>62152000
        BEGIN                                                  <<MPEIV>>62154000
        MESSAGE(M2205);  << NO SUCH VOLUME >>                  <<MPEIV>>62156000
        GOTO REDO;                                             <<MPEIV>>62158000
        END;                                                   <<MPEIV>>62160000
      VOLUME := VOLUME / VTABSIZE;                             <<MPEIV>>62162000
      END                                                      <<MPEIV>>62164000
    ELSE                                                       <<MPEIV>>62166000
      BEGIN  << GET VOLUME # FROM LDEV >>                      <<MPEIV>>62168000
      LDEV := INVAL(@WRONG);                                   <<MPEIV>>62170000
      IF >= THEN GOTO WRONG;                                   <<MPEIV>>62172000
      << BPINBUF NOW POINTING JUST PAST COMMA >>               <<MPEIV>>62174000
      VOLUME := GETVOL(LDEV);                                  <<MPEIV>>62176000
      IF <> THEN                                               <<MPEIV>>62178000
        BEGIN                                                  <<MPEIV>>62180000
        MESSAGE(M2205);  << NO SUCH VOLUME >>                  <<MPEIV>>62182000
        GOTO REDO;                                             <<MPEIV>>62184000
        END;                                                   <<MPEIV>>62186000
      END;                                                     <<MPEIV>>62188000
                                                               <<MPEIV>>62190000
  << GOT VOLUME NOW GET SIZE >>                                <<MPEIV>>62192000
    SECTORS := DINVAL(@WRONG);  << REQUESTED VALUE IN SECTORS>>         62194000
    IF <= THEN GOTO WRONG;                                     <<!>>    62196000
    SECTORS := SECTORS * 1024D;  << CONVERT TO KILO SECTORS >>          62198000
                                                               <<MPEIV>>62200000
    LDEV := GETLDEV(VOLUME);                                   <<MPEIV>>62202000
                                                               <<MPEIV>>62204000
    IF LDEV = SYSDISC AND NOT RELOAD THEN                      <<MPEIV>>62206000
      BEGIN                                                    <<MPEIV>>62208000
      MESSAGE(M2402);  << SYSDISC VM SIZE ONLY CHANGED ON REL>><<MPEIV>>62210000
      GOTO REDO;                                               <<MPEIV>>62212000
      END;                                                     <<MPEIV>>62214000
                                                               <<MPEIV>>62216000
    IF VTAB(VOLUME*VTABSIZE+VTAB12).VMS = 1 THEN               <<MPEIV>>62218000
      BEGIN                                                    <<MPEIV>>62220000
      VDSTART1 := VTAB(VOLUME*VTABSIZE+VTAB8);                 <<MPEIV>>62222000
      VDSTART2 := VTAB(X:=X+1);                                <<MPEIV>>62224000
      VDSLEN1  := VTAB(X:=X+1);                                <<MPEIV>>62226000
      VDSLEN2  := VTAB(X:=X+1);                                <<MPEIV>>62228000
      END                                                      <<MPEIV>>62230000
    ELSE                                                       <<MPEIV>>62232000
      BEGIN                                                    <<MPEIV>>62234000
      VDSTART := 0D;                                           <<MPEIV>>62236000
      VDSLEN := 0D;                                            <<MPEIV>>62238000
      END;                                                     <<MPEIV>>62240000
                                                               <<MPEIV>>62242000
  << VIRTUAL MEMORY SIZE HAS CHANGED >>                        <<MPEIV>>62244000
    IF NOT RELOAD AND VDSLEN <> 0D THEN                        <<MPEIV>>62246000
      BEGIN  << RELEASE OLD VIRTUAL MEMORY SPACE >>            <<MPEIV>>62248000
      RELEASEVM(LDEV, VDSLEN, VDSTART);                        <<MPEIV>>62250000
      END;                                                     <<MPEIV>>62252000
                                                               <<MPEIV>>62254000
    IF SECTORS = 0D THEN                                       <<MPEIV>>62256000
      BEGIN  << DELETE VIRTUAL MEMORY, ZERO OLD VALUES >>      <<MPEIV>>62258000
      VDSTART := 0D;                                           <<MPEIV>>62260000
      VDSLEN := 0D;                                            <<MPEIV>>62262000
      END                                                      <<MPEIV>>62264000
    ELSE                                                       <<MPEIV>>62266000
      BEGIN  << TRY TO GET NEW SPACE FOR VIRTUAL MEMORY >>     <<MPEIV>>62268000
      IF RELOAD THEN                                           <<MPEIV>>62270000
        BEGIN                                                  <<MPEIV>>62272000
        << ALLOCATE SPACE AFTER DFS TABLES ARE REINITIALIZED >><<MPEIV>>62274000
        << FOR NOW JUST CHANGE VTAB >>                         <<MPEIV>>62276000
        VDSTART := 0D;                                         <<MPEIV>>62278000
        VDSLEN := SECTORS;                                     <<MPEIV>>62280000
        END  << RELOAD >>                                      <<MPEIV>>62282000
      ELSE                                                     <<MPEIV>>62284000
        BEGIN  << NOT RELOAD - GET SPACE FROM DFS >>           <<MPEIV>>62286000
        GETVM(LDEV, SECTORS, START);  << GET ANY SPACE >>      <<MPEIV>>62288000
        IF <> THEN                                             <<MPEIV>>62290000
          BEGIN  << COULDN'T GET SPACE REQUESTED >>            <<MPEIV>>62292000
          MESSAGE(M2218);  << INSUFFICIENT DISC SPACE >>       <<MPEIV>>62294000
          IF VDSLEN <> 0D THEN                                 <<MPEIV>>62296000
            BEGIN  << GET OLD SPACE BACK >>                    <<MPEIV>>62298000
            GETVM(LDEV, VDSLEN, VDSTART, TRUE);                <<MPEIV>>62300000
            IF <> THEN                                         <<MPEIV>>62302000
              BEGIN                                            <<MPEIV>>62304000
              MESSAGE(M329);  << DISC SPACE ERROR >>           <<MPEIV>>62306000
              VDSTART := 0D;                                   <<MPEIV>>62308000
              VDSLEN := 0D;                                    <<MPEIV>>62310000
              END;                                             <<MPEIV>>62312000
            END;                                               <<MPEIV>>62314000
          END                                                  <<MPEIV>>62316000
        ELSE                                                   <<MPEIV>>62318000
          BEGIN  << GOT SPACE REQUESTED >>                     <<MPEIV>>62320000
          VDSTART := START;                                    <<MPEIV>>62322000
          VDSLEN := SECTORS;                                   <<MPEIV>>62324000
          END;                                                 <<MPEIV>>62326000
        END;  << NOT RELOAD >>                                 <<MPEIV>>62328000
      END;  << SECTORS <> 0 >>                                 <<MPEIV>>62330000
                                                               <<MPEIV>>62332000
    VTAB(VOLUME*VTABSIZE+VTAB8) := VDSTART1;                   <<MPEIV>>62334000
    VTAB(X:=X+1) := VDSTART2;                                  <<MPEIV>>62336000
    VTAB(X:=X+1) := VDSLEN1;                                   <<MPEIV>>62338000
    VTAB(X:=X+1) := VDSLEN2;                                   <<MPEIV>>62340000
    IF VDSLEN = 0D THEN VTAB(X:=X+1).VMS := 0                  <<MPEIV>>62342000
    ELSE VTAB(X:=X+1).VMS := 1;                                <<MPEIV>>62344000
                                                               <<MPEIV>>62346000
    GOTO REDO;                                                 <<MPEIV>>62348000
    END;  << NOT A CARRAGE RETURN INPUT >>                     <<MPEIV>>62350000
  IF VTAB(SYSVOL*VTABSIZE+VTAB12).VMS <> 1 THEN                <<01682>>62352000
    MESSAGE(M2220);  << NO V.M. ALLOCATION ON SYSTEM DISC >>   <<01682>>62354000
  END;  << VIRTUAL MEMORY CHANGES >>                           <<MPEIV>>62356000
  COMM(HLDEV') := HLDEV;                                       <<TSIZE>>62358000
  COMM(SYSTAPELDEV') := COLDLOADLDEV;    <<SET BY CHECKDEV>>   <<I8884>>62360000
                                                               <<00458>>62362000
   <<*******************************************************>> <<zrela>>62364000
   <<    ALLOCATE VIRTUAL DEVICES                           >> <<zrela>>62366000
   <<*******************************************************>> <<zrela>>62368000
                                                               <<zrela>>62370000
   LDEV := 0;                                                  <<zrela>>62372000
   I    := 0;                                                  <<zrela>>62374000
   WHILE I <= CTAB0(MAXSPOOLF) DO                              <<*7646>>62376000
      BEGIN                                                    <<zrela>>62378000
      LDEV := LDEV + 1;                                        <<zrela>>62380000
      DVR'INDEX := LDEV * DVRSIZE;                             <<zrela>>62382000
      IF DVRDRTNUM = 0 AND DVRDSBIT = 0 THEN                   <<zrela>>62384000
         BEGIN                                                 <<zrela>>62386000
         LPDT'INDEX := LDEV * LPDTSIZE;                        <<zrela>>62388000
         LPDT(LPDT'INDEX) := 0;                                <<zrela>>62390000
         MOVE LPDT(LPDT'INDEX + 1) := LPDT(LPDT'INDEX)         <<zrela>>62392000
                                      ,(LPDTSIZE-1);           <<zrela>>62394000
         LPDT'VIRTUAL'DEVICE := 1;                             <<zrela>>62396000
         I := I + 1;                                           <<zrela>>62398000
         END;                                                  <<zrela>>62400000
      END;                                                     <<zrela>>62402000
   IF LDEV > HLDEV THEN HLDEV := LDEV;                         <<zrela>>62404000
   LDT  := HLDEV;                                              <<zrela>>62406000
   LPDT := HLDEV;                                              <<zrela>>62408000
   LDTX := HLDEV;                                              <<zrela>>62410000
          <<--------------------------------------->>          <<00458>>62412000
          <<UPDATE COLDLOADID IN SYSTEM DISC LABELS>>          <<00458>>62414000
          <<--------------------------------------->>          <<00458>>62416000
CONFDONE:                                                      <<00683>>62418000
          I:=0;                                                <<00458>>62420000
          WHILE (I:=I+1)<=HVOL DO                              <<00458>>62422000
          IF VTAB(I*VTABSIZE)<>0 THEN                          <<00458>>62424000
             BEGIN <<MOUNTED SYSTEM VOLUME>>                   <<00458>>62426000
             LDEV:=VTAB(I*VTABSIZE+VTAB12).VTABLDEV;           <<00458>>62428000
             LPDT'INDEX := LDEV * LPDTSIZE;                    <<*LPDT>>62430000
             IF LPDT'NON'SYS'DOMAIN = 0 THEN                   <<*LPDT>>62432000
                BEGIN                                          <<00458>>62434000
                                                               <<03672>>62436000
                << LOCK IN CS'80 DISC DRIVES HERE.  WE DO >>   <<03672>>62438000
                << IT HERE DELIBERATELY BECAUSE THIS IS   >>   <<03672>>62440000
                << THE POINT OF NO RETURN IN INITIAL--WE  >>   <<03672>>62442000
                << ARE UPDATING THE COLDLOADID'S.  SET    >>   <<03672>>62444000
                << CS80'LOCK FOR CS80'DRIVER SO THAT IN   >>   <<03672>>62446000
                << CASE AN UNDELIBERATE DEVICE CLEAR IS   >>   <<03672>>62448000
                << DONE, IT WILL RE-LOCK THE CS'80 DEVICE >>   <<03672>>62450000
                                                               <<03672>>62452000
                CS80'LOCK := TRUE;   << SET FLAG FOR DRIVER >> <<03672>>62454000
                LDT'INDEX := LDEV * LDTSIZE;                   <<*LDT*>>62456000
                IF LDT'DEVICE'TYPE = 3 << CS80 DEVICE >> THEN  <<*LDT*>>62458000
                   DISC(LOCK'DEV,LDEV,0D,DTEMP,2);             <<03672>>62460000
                                                               <<03672>>62462000
                DISC(READ,LDEV,0D,LBUF,128);                   <<00458>>62464000
                LBUF(LABCOLDLOADID):=COLDLOADID+1;             <<00458>>62466000
                DISC(WRITE,LDEV,0D,LBUF,128);                  <<00458>>62468000
                END;                                           <<00458>>62470000
             END;                                              <<00458>>62472000
                                                               <<00458>>62474000
                                                               <<01123>>62476000
              IF CHANGES THEN                                  <<01123>>62478000
                BEGIN  <<ASK QUESTIONS>>                       <<01123>>62480000
                  IF LOGGING THEN                              <<01123>>62482000
                    << DISABLE LOGGING? >>                     <<01123>>62484000
                    LOGGING := NOT(LGETYESNO(M2450));          <<01123>>62486000
                  IF LGETYESNO(3000) THEN SYSTAB'CH;           <<sytab>>62488000
REQMKILS:         I := LDNTOA(DCTAB0(KILOSECTS),10,BINBUF(1)); <<01123>>62490000
                  MESSAGE(-M2353);<<MAX# SPOOLFILE KILOSECT'S>><<01123>>62492000
                  BINBUF := "=";                               <<01123>>62494000
                  BINBUF(I+1):="?";                            <<01123>>62496000
                  PRINT(INBUF,-I-2,%320);                      <<01123>>62498000
                  READINPUT;                                   <<01123>>62500000
                  TOS := DINVAL(@REQMKILS);                    <<01123>>62502000
                  IF = THEN                                    <<01123>>62504000
                    BEGIN                                      <<01123>>62506000
                      DEL;                                     <<01123>>62508000
                      GO REQEXTS;                              <<01123>>62510000
                    END;                                       <<01123>>62512000
                  IF > THEN                                    <<01123>>62514000
                    DCTAB0(KILOSECTS) := TOS;                  <<01123>>62516000
REQEXTS:          ILOC:= CTAB0(EXTSSECT');                     <<02834>>62518000
REQEXTSR:         GETNEWVAL(M2354,CTAB0(EXTSSECT'),128,32767); <<02834>>62520000
                  IF CTAB0(EXTSSECT').(14:2)<>0 THEN           <<02834>>62522000
                    BEGIN                                      <<02834>>62524000
                    MESSAGE(M2357);        <<NOT MOD 4>>       <<02834>>62526000
                    CTAB0(EXTSSECT'):= ILOC; <<RESTORE VALUE>> <<02834>>62528000
                    GO TO REQEXTSR;                            <<02834>>62530000
                    END;                                       <<02834>>62532000
                  IF NOT RELOAD AND NOT RECOVERY THEN          <<01123>>62534000
                    BEGIN  << RECOVER LOST DISC SPACE >>       <<01123>>62536000
                        GETYESNO(@CONSOL,M2451);               <<01123>>62538000
                      RECOVERY := TRUE;                        <<01123>>62540000
                    END;                                       <<01123>>62542000
                END;                                           <<01123>>62544000
          IF CTAB0(EXTSSECT')=0 THEN CTAB0(EXTSSECT'):=128;    <<01123>>62546000
CONSOL:                                                        <<01123>>62548000
                                                               <<01123>>62550000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<01123>>62552000
<<-------------------------------------------->>               <<00888>>62554000
<<RECONFIGURE CONSOLE TO REFLECT SPEED SENSING>>               <<00888>>62556000
<<-------------------------------------------->>               <<00888>>62558000
LDTX'INDEX := CONSOLELDEV * LDTXSIZE;                          <<*LDTX>>62560000
LDTX'BAUD'RATE'CODE := BAUDRATE;                               <<*LDTX>>62562000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>62564000
$PAGE "MAINSEG1  --  GET DISC SPACE FOR SYSTEM"                         62566000
          <<---------------------------------                           62568000
            INITIALIZE DISC FREE SPACE MAPS                             62570000
          --------------------------------->>                           62572000
          LDT'NUM'ENTRIES := HLDEV;                            <<*LDT*>>62574000
          LDT'ENTRY'SIZE := LDTSIZE;                           <<*LDT*>>62576000
          COMM(DVCLSIZE') := DCTH'TDT'BASE - DCTH'DCT'BASE;    <<*7777>>62578000
          COMM(TTDTSIZE') := DCTH'SEGMENT'SIZE - DCTH'TDT'BASE;<<*7777>>62580000
          << THIS NEXT TEST WAS REQUIRED FOR MPEV CONVERSION. ><<*7777>>62582000
          << THE TDTAB WAS CREATED 3000 WORDS LONG AND NOW WE ><<*7777>>62584000
          << SHRINK IT DOWN TO ITS CORRECT SIZE BEFORE WE MAKE><<*7777>>62586000
          << A PHOTO COPY OF CORE .                           ><<*7777>>62588000
          IF COMM(TTDTSIZE') <> (@TL'BUF - @TDTAB) THEN        <<t8392>>62590000
            BEGIN                                              <<*7777>>62592000
            TDTABINCR := COMM(TTDTSIZE') - (@TL'BUF-@TDTAB);   <<t8392>>62594000
            << NOTE THAT IF TDTABINCR IS EVER > ZERO THEN WE >><<*7777>>62596000
            << ARE IN BIG TROUBLE!!! >>                        <<*7777>>62598000
            MOVEDLTABLES;                                      <<*7777>>62600000
            END;                                               <<*7777>>62602000
          COMM(HVOL') := NVOL;                                 <<CONFD>>62604000
          INFO(H'VOL') := NVOL;                                <<03603>>62606000
          VTAB(VTABSYSVOLNUM) := HVOL;                         <<03603>>62608000
          LPDT'ENTRY'SIZE := LPDTSIZE;                         <<*LPDT>>62610000
          LPDT'MAX'ENTRIES := HLDEV;                           <<*LPDT>>62612000
          VTAB := MVOL&LSL(8)+VTABSIZE;                        <<03603>>62614000
          VTAB(VMINTEGRITY) := COLDLOADID+1;                   <<03603>>62616000
          IF NOT RELOAD THEN                                   <<03603>>62618000
            BEGIN<<FORCE AGREEMENT ON NEXT COLD LOAD IF ABORTED<<03603>>62620000
              VTAB(VTABCOLDLOADID) := COLDLOADID+1;            <<03603>>62622000
              INFO(COLD'LOAD'ID') := COLDLOADID+1;             <<03603>>62624000
              DISC(WRITE,SYSDISC,D'L(INFOSECTOR)),INFO,        <<03603>>62626000
                 INFOSIZE);                                    <<03603>>62628000
              @CLDPNTR := @TABLEINFO(VTABINFOX+3);                      62630000
              DISC(WRITE,SYSDISC,CLDPNTR,VTAB,                          62632000
                (MVOL+1)*VTABSIZE);                            <<03603>>62634000
            END                                                <<03603>>62636000
          ELSE                                                 <<03603>>62638000
            BEGIN  <<INITIALIZE SPACE MAPS>>                   <<03603>>62640000
              I := 0;                                          <<03603>>62642000
              WHILE (I:=I+1) <= HVOL DO                        <<03603>>62644000
                 IF VTAB(I*VTABSIZE) <> 0 THEN                 <<03603>>62646000
                    Init'Disc'Free'Space'Map(GETLDEV(I));      <<03615>>62648000
        MESSAGE(M3050); <<DISC FREE SPACE MAPS COMPLETE>>      <<*8392>>62650000
            END;                                               <<03603>>62652000
   SAVE'TABLE'ADDR(CSDVRTSIZE, CSDVR, CSDVRINFOX);             <<zrela>>62654000
   SAVE'TABLE'ADDR(CSDEFSIZE, CSDEF, CSDEFINFOX);              <<zrela>>62656000
   @CLDPNTR := @TABLEINFO( COMMINFOX+3);                                62658000
   CLDPNTR := COMMSECTOR;                                               62660000
   SAVE'TABLE'ADDR( COMMSIZE, COMM, COMMINFOX);                         62662000
   SAVE'TABLE'ADDR((HLDEV+1)*DVRSIZE, DVRTAB, DVRINFOX);       <<zrela>>62664000
   SAVE'TABLE'ADDR(CTAB0SIZE, CTAB0, CTAB0INFOX);              <<zrela>>62666000
   SAVE'TABLE'ADDR(CTABSIZE, CTAB, CTABINFOX);                 <<CONFD>>62668000
   SAVE'TABLE'ADDR(COMM(TLBUFSIZE), TL'BUF, TLBUFINFOX);       <<t8392>>62670000
   SAVE'TABLE'ADDR((HLDEV+1)*LPDTSIZE, LPDT, LPDTINFOX);       <<zrela>>62672000
   SAVE'TABLE'ADDR((HLDEV+1)*LDTSIZE,                          <<zrela>>62674000
     LDT, LDTINFOX);                                           <<zrela>>62676000
   SAVE'TABLE'ADDR((HLDEV+1)*LDTXSIZE, LDTX, LDTXINFOX);       <<zrela>>62678000
   SAVE'TABLE'ADDR(DCTHSIZE,DCT'HEAD,DCTHINFOX);               <<zrela>>62680000
   SAVE'TABLE'ADDR( DCTH'TDT'BASE - DCTH'DCT'BASE,             <<*7777>>62682000
                     DCTAB, DVCLINFOX);                        <<*7777>>62684000
   SAVE'TABLE'ADDR((DCTH'SEGMENT'SIZE - DCTH'TDT'BASE),        <<*7777>>62686000
                              TDTAB, TTDTINFOX);               <<*7777>>62688000
   SAVE'TABLE'ADDR((MVOL+1)*VTABSIZE, VTAB, VTABINFOX);        <<zrela>>62690000
   SAVE'TABLE'ADDR(CSTAB, CSTAB, CSTABINFOX);                  <<zrela>>62692000
   STKNRSECT := (TABLEINFO(STACKINFOX)+127)/128;               <<zrela>>62694000
                                                               <<03603>>62696000
                                                               <<03603>>62698000
  RECBUFINCR := RECBUFLEN + 1;                                 <<depen>>62700000
  TZTBUFINCR := TZTBUFLEN + 1;                                 <<depen>>62702000
  MOVEDLTABLES;                                                <<zrela>>62704000
  IF LOADFROMTAPE THEN                                         <<zrela>>62706000
     IF SERIALDISCLOAD THEN                                    <<zrela>>62708000
        @TAPEBUF := @LBUF                                      <<zrela>>62710000
     ELSE                                                      <<zrela>>62712000
        @TAPEBUF := @RECBUF;                                   <<zrela>>62714000
          <<------------------------------------>>             <<03603>>62716000
          <<  WRITE INITIAL'S SEGMENTS TO DISC  >>             <<03603>>62718000
          <<------------------------------------>>             <<03603>>62720000
                                                               <<03603>>62722000
          NUTCST := NTCST;                                     <<03603>>62724000
          DO NUTCST:=NUTCST-1 UNTIL TCST(NUTCST*4) <> 0;       <<03603>>62726000
                                                               <<03603>>62728000
          @TCSTDISC := @SEGDISCADR;<<DISCADR PTR>>             <<03603>>62730000
          IF NOT LOADFROMTAPE THEN                             <<03603>>62732000
            BEGIN  << MOVE DISC ADDRS FROM INFO TO TCSTDISC >> <<03603>>62734000
            I := 0;                                            <<03603>>62736000
            DO BEGIN                                                    62738000
               @CLDPNTR := @TCSTINFO(I*5+3);                            62740000
               TCSTDISC(I+1) := CLDPNTR;                                62742000
               END                                                      62744000
            UNTIL (I:=I+1) = NUTCST;                                    62746000
            END                                                <<03603>>62748000
          ELSE                                                 <<03603>>62750000
            BEGIN  <<WRITE SEGMENTS TO DISC>>                  <<03603>>62752000
                                                               <<03603>>62754000
            IF SERIALDISCLOAD THEN                             <<03603>>62756000
              BEGIN  <<Setup to Read Serial Disc>>             <<03603>>62758000
              SDISCREEL:=0;                                    <<03603>>62760000
              COLD'LOAD'MEDIA(REWIND);<<This Forces TZT'INIT >><<03603>>62762000
              END;   <<Setup to Read Serial Disc>>             <<03603>>62764000
                                                               <<03603>>62766000
            <<  MODIFY ININ  -  CHANGE COLD LOAD TRAP LABEL >> <<03603>>62768000
            <<  FOR DISC BOOT.  STT 44 := STT 45            >> <<03603>>62770000
            TOS := TCST(6);  << ININ BANK >>                   <<03603>>62772000
            TOS := TCST(7)+TCST(4).(4:12)*4-%46;               <<03603>>62774000
            ASSEMBLE( LSEA; INCB; SSEA; DDEL );                <<03603>>62776000
                                                               <<03603>>62778000
            <<  RELEASE DISC SPACE FOR THE OLD VERSION  >>     <<03603>>62780000
            <<  OF INITIAL.                             >>     <<03603>>62782000
            IF NOT RELOAD THEN                                 <<03603>>62784000
               BEGIN                                           <<03603>>62786000
               I := 0;                                         <<03603>>62788000
               DO BEGIN                                        <<03603>>62790000
                  @CLDPNTR := @TCSTINFO(I*5+3);                         62792000
                  IF CLDPNTR > END'RESERVED(SYSDISC) THEN               62794000
                     BEGIN                                     <<03603>>62796000
                     NRSECT := DOUBLE((TCSTINFO(I*5)+127)/128);<<.DAN.>>62798000
                     RETDISCSPACE(SYSDISC, NRSECT, CLDPNTR);            62800000
                     END;                                      <<03603>>62802000
                  END UNTIL (I:=I+1) = INFO(NUTCST');          <<03603>>62804000
               END;                                            <<03603>>62806000
                                                               <<03603>>62808000
           INFO(NUTCST') := NUTCST;<<NR CST'S FOR NEW INITIAL>><<03603>>62810000
                                                               <<03603>>62812000
           I := 1; << FIRST CST >>                             <<03603>>62814000
           DO                                                  <<03603>>62816000
              BEGIN                                            <<03603>>62818000
              SIZE := TCST(I&LSL(2)).(4:12)&LSL(2);            <<03603>>62820000
                                                               <<03603>>62822000
              IF 1 <= I <= 2 THEN                              <<03603>>62824000
                BEGIN  << ININ OR BOOTSTRAP SEGMENT >>         <<03603>>62826000
                TOS := 0;                                      <<03603>>62828000
                TOS := BOOTDISCSPACE(SIZE);  <<GET BOOT SPACE>><<03603>>62830000
                TCSTDISC(I) := TOS;                            <<03603>>62832000
                END                                            <<03603>>62834000
              ELSE                                             <<03603>>62836000
                BEGIN                                          <<03603>>62838000
                DTEMP := D'L((SIZE+127)&LSR(7)));              <<03603>>62840000
                SUPERDISCSPACE(-SYSDISC,1,0,DTEMP,TCSTDISC(I));<<03603>>62842000
                IF <> THEN ERRMESSAGE(M326, SYSDISC);          <<03603>>62844000
                TOS := TCSTDISC(I);                            <<03603>>62846000
                BS1 := 0;      <<ZERO VOLUME INDEX>>           <<03603>>62848000
                TCSTDISC(X) := TOS;                            <<03603>>62850000
                END;                                           <<03603>>62852000
                                                               <<03603>>62854000
              TOS := TCST(I&LSL(2)+2); << BANK OF SEGMENT >>            62856000
              TOS := TCST(X:=X+1);  << ADDRESS OF SEGMENT >>            62858000
              DCOREADDR := TOS;                                         62860000
              TOS := TCSTDISC(I);                                       62862000
              TCSTINFO((I-1)*5) := SIZE;                                62864000
              TCSTINFO(X:=X+1) := BANK;                                 62866000
              TCSTINFO(X:=X+1) := COREADDR;                             62868000
              TCSTINFO(X:=X+2) := TOS;                                  62870000
              TCSTINFO(X:=X-1) := TOS;                                  62872000
                                                               <<03603>>62874000
              IF DCOREADDR <> 0D THEN                          <<03603>>62876000
                 BEGIN                                         <<03603>>62878000
                 TOS:=0; TOS:=I; HELP'MAKE'ABSENT; DDEL;       <<03603>>62880000
                 DISC'(WRITE,SYSDISC,TCSTDISC(I),DCOREADDR,    <<03603>>62882000
                       SIZE);  << WRITE SEGMENT TO DISC >>     <<03603>>62884000
                 TOS:=1; TOS:=I; HELP'MAKE'PRESENT; DDEL;      <<03603>>62886000
                 END                                           <<03603>>62888000
              ELSE                                             <<03603>>62890000
                BEGIN   <<MUST READ FROM TAPE>>                <<03603>>62892000
                DISCADR := TCSTDISC(I);                        <<03603>>62894000
                TEMP := SIZE;                                  <<03603>>62896000
                WHILE TEMP <> 0 DO                             <<03603>>62898000
                   BEGIN                                       <<03603>>62900000
                   LEN := IF TEMP > TAPERECSIZE THEN           <<03603>>62902000
                      TAPERECSIZE ELSE TEMP;                   <<03603>>62904000
                   COLD'LOAD'MEDIA( READ,TAPEBUF,LEN);         <<03603>>62906000
                   WHILE END'OF'TAPE DO                        <<03603>>62908000
                      BEGIN                                    <<03603>>62910000
                      NEXTREEL( TAPEBUF);                      <<03603>>62912000
                      COLD'LOAD'MEDIA( READ,TAPEBUF,LEN);      <<03603>>62914000
                      END;                                     <<03603>>62916000
                   DISC( WRITE,SYSDISC,DISCADR,TAPEBUF,LEN);   <<03603>>62918000
                   DISCADR := DISCADR+DOUBLE((LEN+127)/128);   <<03603>>62920000
                   TEMP := TEMP-LEN;                           <<03603>>62922000
                   END;                                        <<03603>>62924000
                END;                                           <<03603>>62926000
                                                               <<03603>>62928000
              END                                              <<03603>>62930000
            UNTIL (I:=I+1) > NUTCST;                           <<03603>>62932000
            END;                                               <<03603>>62934000
            STKNRSECT := (TABLEINFO(STACKINFOX)+127)/128;               62936000
          IF LOADFROMTAPE THEN                                 <<03603>>62938000
                                                               <<03603>>62940000
            BEGIN                                              <<03603>>62942000
            INFO(DISCENTRY) := COMM(DISCENTRY');               <<CONFD>>62944000
            INFO(DISCTST).INFODTYPE := SYSDISCTYPE;            <<03603>>62946000
            INFO(DISCTST).INFODSUBTYPE := SYSDISCSUBTYPE;      <<03603>>62948000
            DVR'INDEX := DVRSIZE;  << POINT TO LDEV # 1 >>     <<*DVR*>>62950000
            INFO(SYSDISCDRT') := DVRDRTNUM;                    <<*DVR*>>62952000
            INFO(INITDB) := DBVALUE;                           <<03603>>62954000
            INFO(INITZ) := ZVALUE;                             <<03603>>62956000
            INFO(INITQ) := QVALUE;                             <<03603>>62958000
            INFO(INITS) := SVALUE;                             <<03603>>62960000
            SAVE'TABLE'ADDR(ZVALUE, 0, STACKINFOX);            <<03603>>62962000
                                                               <<03603>>62964000
          <<------------------------------------>>             <<03603>>62966000
          <<  BUILD DISC COLD LOAD SIO PROGRAM  >>             <<03603>>62968000
          <<------------------------------------>>             <<03603>>62970000
      @CLPNTR := @CLBUF;                                       <<03603>>62972000
                                                               <<03603>>62974000
         << GET SPACE FOR LOW CORE >>                          <<03603>>62976000
                                                               <<03603>>62978000
      LCDISCADR := BOOTDISCSPACE(LCSIZE);                      <<03603>>62980000
      CLDPNTR := D'L(LCDISCADR));                              <<03603>>62982000
      CLDPNTR(1) := 0D; << MEMORY ADDRESS >>                   <<03603>>62984000
      CLPNTR(4) := LCSIZE;                                     <<03603>>62986000
      @CLPNTR := @CLPNTR+5;                                    <<03603>>62988000
                                                               <<03603>>62990000
         << GET SPACE FOR TCST >>                              <<03603>>62992000
                                                               <<03603>>62994000
      TCSTDISCADR := BOOTDISCSPACE(TCSTSIZE);                  <<03603>>62996000
      CLDPNTR := D'L(TCSTDISCADR));                            <<03603>>62998000
      CLDPNTR(1) := D'L(ABSOLUTE(CSTP)));                      <<03603>>63000000
      CLPNTR(4) := TCSTSIZE;                                   <<03603>>63002000
      @CLPNTR := @CLPNTR+5;                                    <<03603>>63004000
                                                               <<03603>>63006000
         << GET SPACE FOR INTERNAL INTERRUPTS >>               <<03603>>63008000
                                                               <<03603>>63010000
      CLDPNTR := TCSTDISC(1);<< DISC ADR OF ININ SEG >>        <<03603>>63012000
      CLPNTR(2) := TCST(6);  << ININ BANK >>                   <<03603>>63014000
      CLPNTR(3) := TCST(7);  << ININ ADDRESS >>                <<03603>>63016000
      CLPNTR(4) := TCST(4).(4:12)&LSL(2);                      <<03603>>63018000
      @CLPNTR := @CLPNTR+5;                                    <<03603>>63020000
                                                               <<03603>>63022000
         << BOOTSTRAP SEGMENT >>                               <<03603>>63024000
                                                               <<03603>>63026000
      CLDPNTR := TCSTDISC(2);<< DISC ADR OF BOOTSTRAP SEG      <<03603>>63028000
      CLPNTR(2) := TCST(10); << BOOTSTRAP BANK >>              <<03603>>63030000
      CLPNTR(3) := TCST(11); << BOOTSTRAP ADDRESS >>           <<03603>>63032000
      CLPNTR(4) := TCST(8).(4:12)&LSL(2);                      <<03603>>63034000
      @CLPNTR := @CLPNTR+5;                                    <<03603>>63036000
                                                               <<03603>>63038000
         << COLD LOAD INFORMATION TABLE >>                     <<03603>>63040000
                                                               <<03603>>63042000
      CLDPNTR := D'L(INFOSECTOR));                             <<03603>>63044000
      CLDPNTR(1) := D'L(INFOCOREADR));                         <<03603>>63046000
      CLPNTR(4) := INFOSIZE;                                   <<03603>>63048000
      @CLPNTR := @CLPNTR+5;                                    <<03603>>63050000
                                                               <<03603>>63052000
         << GET SPACE FOR BOOTSTRAP STACK >>                   <<03603>>63054000
                                                               <<03603>>63056000
      STACKDISCADR := BOOTDISCSPACE(BOOTSTACKSIZE);            <<03603>>63058000
      CLDPNTR := D'L(STACKDISCADR));                           <<03603>>63060000
      CLDPNTR(1) := D'L(ABSOLUTE(QI)-BOOTQI));                 <<03603>>63062000
      CLPNTR(4) := BOOTSTACKSIZE;                              <<03603>>63064000
      @CLPNTR := @CLPNTR+5;                                    <<03603>>63066000
                                                               <<03603>>63068000
         << RESIDENT SEGMENT >>                                <<03603>>63070000
                                                               <<03603>>63072000
      IF SYSDISCTYPE = 0 AND SYSDISCSUBTYPE <= 3 THEN ELSE     <<03603>>63074000
         BEGIN                                                 <<03603>>63076000
         CLDPNTR := TCSTDISC(3);<<DISC ADR OF RESIDENT SE      <<03603>>63078000
         CLPNTR(2) := TCST(14); << RESIDENT BANK >>            <<03603>>63080000
         CLPNTR(3) := TCST(15); << RESIDENT ADDRESS >>         <<03603>>63082000
         CLPNTR(4) := TCST(12).(4:12)&LSL(2);                  <<03603>>63084000
         @CLPNTR := @CLPNTR+5;                                 <<03603>>63086000
         END;                                                  <<03603>>63088000
                                                               <<03603>>63090000
      I := (@CLPNTR-@CLBUF)/5; << NR. ENTRIES >>               <<03603>>63092000
$IF X1=OFF  <<  ******  SERIES II/III UNIQUE  ********* >>     <<03603>>63094000
      BUILD'SIO'BOOT( CLBUF, I);                               <<03603>>63096000
$IF         <<  RETURN TO COMMON CODE  >>                      <<03603>>63098000
      IF SYSDISCTYPE=3 <<CS80 DEVICE>> THEN<<BUILD THE APPRO->><<*LDT*>>63100000
         BUILD'CS80'BOOT( CLBUF, I)      << PRIATE BOOT  >>    <<*LDT*>>63102000
      ELSE                           << CHANNEL PROGRAM  >>    <<03614>>63104000
         BUILD'AMIGO'BOOT( CLBUF, I);<< ON THE DISC      >>    <<03614>>63106000
                                                               <<03603>>63108000
                                                               <<03603>>63110000
          <<--------------------------->>                      <<03603>>63112000
          <<  WRITE BOOTSTRAP TO DISC  >>                      <<03603>>63114000
          <<--------------------------->>                      <<03603>>63116000
           DISC'(WRITE,SYSDISC,D'L(TCSTDISCADR)),D'L(ABS(0))), <<03603>>63118000
                TCSTSIZE);                                     <<03603>>63120000
                                                               <<03603>>63122000
                                                               <<03603>>63124000
            << BUILD LOW CORE >>                               <<03603>>63126000
            ZEROBUF(BUF,LCSIZE);                               <<03603>>63128000
            BUF := ABSOLUTE(CSTP);  << CST PNTR >>             <<03603>>63130000
            BUF(QI) := ABSOLUTE(QI);                           <<03603>>63132000
            BUF(ZI) := ABSOLUTE(ZI);                           <<03603>>63134000
            BUF(DRTBANK) := 1;                                 <<03603>>63136000
            BUF(DRTADDR) := 0;                                 <<03603>>63138000
            BUF(DB) := ABSOLUTE(DB);                           <<03603>>63140000
            BUF(DBBANK) := ABSOLUTE(DBBANK);                   <<03603>>63142000
            LDT'INDEX := SYSDISC * LDTSIZE;                    <<*LDT*>>63144000
            BUF(SDTYPE) := LDT'DEVICE'TYPE;                    <<*LDT*>>63146000
            DISC(WRITE,SYSDISC,D'L(LCDISCADR)),BUF,LCSIZE);    <<03603>>63148000
                                                               <<03603>>63150000
            << BUILD ICS >>                                    <<03603>>63152000
            ZEROBUF(BUF,BOOTSTACKSIZE);                        <<03603>>63154000
            BUF(BOOTQI+2) := ABSOLUTE(DB);<<DISPATCHER DB>>    <<03603>>63156000
            BUF(BOOTQI+1) := ABSOLUTE(DBBANK);<<DISP BANK>>    <<03603>>63158000
            BUF(BOOTQI-4) := ABSOLUTE(DB);                     <<03603>>63160000
            BUF(BOOTQI-5) := ABSOLUTE(DBBANK);                 <<03603>>63162000
            BUF(BOOTQI-7) := DLVALUE;                          <<03603>>63164000
            BUF(BOOTQI-8) := ZVALUE;                           <<03603>>63166000
            BUF(BOOTQI-10) := SVALUE+6; <<SAVE S IN QI-10>>    <<03603>>63168000
            BUF(BOOTQI-12) := INFOCOREADR;<<DB FOR BOOTSTRAP>> <<03603>>63170000
            BUF(BOOTQI-13) := 0; << BANK OF INFO TABLE >>      <<03603>>63172000
            BUF(BOOTQI-18) := 1; <<P DISABLED>>                <<03603>>63174000
            DISC(WRITE,SYSDISC,D'L(STACKDISCADR)),BUF,         <<03603>>63176000
                 BOOTSTACKSIZE);                               <<03603>>63178000
                                                               <<03714>>63180000
            <<-------------------------------------->>         <<03714>>63182000
            <<  WRITE RESERVED AREA BITMAP TO DISC  >>         <<03714>>63184000
            <<-------------------------------------->>         <<03714>>63186000
                                                               <<03714>>63188000
            << WRITE RESERVED AREA BITMAP TO DISC.  THE >>     <<03714>>63190000
            << BITMAP MUST AT THIS POINT ACCURATELY     >>     <<03714>>63192000
            << REFLECT WHAT IS IN THE RESERVED AREA     >>     <<03714>>63194000
            << FOR THE NEXT DISC BOOT.                  >>     <<03714>>63196000
                                                               <<03714>>63198000
            DISC(WRITE,SYSDISC,DOUBLE(BOOTSPACE'SECTOR),       <<03714>>63200000
                 BOOTSPACEMAP,                                 <<03714>>63202000
                 (LDEV'1'RESERVED'AREA'SIZE+15)/16);           <<03714>>63204000
                                                               <<03714>>63206000
            END;  << LOADFROMTAPE - BUILD COLD LOAD SIO PROG >><<03603>>63208000
                                                               <<03603>>63210000
            <<  PARPARE TO RELOCATE INITIAL TO HIGH CORE.  >>  <<03603>>63212000
                                                               <<03603>>63214000
            << UPDATE ICS VALUES >>                            <<03603>>63216000
            PUSH( Z, DL);                                      <<03603>>63218000
            ICS(-7) := TOS; << DL >>                           <<03603>>63220000
            ICS(-8) := TOS; << Z  >>                           <<03603>>63222000
            << IF NO CHANGES THEN COREX MAY NOT >>             <<03603>>63224000
            << REFLECT CORESIZE                 >>             <<03603>>63226000
            COREX := 0;                                        <<03603>>63228000
            DO COREX := COREX+1 UNTIL                          <<03603>>63230000
               CORESIZES(COREX) = CTAB0(CORESIZE);             <<03603>>63232000
                                                               <<03603>>63234000
            << BUILD DISPATCHER'S MARKER >>                    <<03603>>63236000
            I := @DISPATCHER;                                  <<03603>>63238000
            J := I.(1:7);      << STT >>                       <<03603>>63240000
            I := I.(8:8);      << SEG >>                       <<03603>>63242000
            TOS := TCST(I*4+2);    << BANK >>                  <<03603>>63244000
            TOS := TCST(X:=X+1)+TCST(X:=X-3).(4:12)*4-1-J;     <<03603>>63246000
            ASSEMBLE( LSEA ); << LOAD DELTA P >>               <<03603>>63248000
            ICS(-2) := TOS; << DELTA P >>                      <<03603>>63250000
            ICS(-1) := LOGICAL(I) LOR %100000;<<STATUS>>       <<03603>>63252000
                                                               <<03603>>63254000
            <<  COMPACT TABLES RESIDING ABOVE Z >>             <<zrela>>63256000
                                                               <<zrela>>63258000
            TOS := @DVRTAB + (HLDEV + 1) * DVRSIZE;            <<zrela>>63260000
            ASSEMBLE(DUP);                                     <<zrela>>63262000
            MOVE * := LPDT, (HLDEV + 1) * LPDTSIZE;            <<zrela>>63264000
            @LPDT := TOS;                                      <<zrela>>63266000
            TOS := @DVRTAB +                                   <<zrela>>63268000
                          (HLDEV +1) * (DVRSIZE + LPDTSIZE);   <<zrela>>63270000
            ASSEMBLE(DUP);                                     <<zrela>>63272000
            MOVE * := LDT, (HLDEV + 1) * LDTSIZE;              <<zrela>>63274000
            @LDT := TOS;                                       <<zrela>>63276000
            TOS := @DVRTAB +                                   <<zrela>>63278000
                      (HLDEV + 1)*(DVRSIZE+LPDTSIZE+LDTSIZE);  <<zrela>>63280000
            ASSEMBLE(DUP);                                     <<zrela>>63282000
            MOVE * := LDTX, (HLDEV + 1) * LDTXSIZE;            <<zrela>>63284000
            @LDTX := TOS;                                      <<zrela>>63286000
                                                               <<zrela>>63288000
            <<  MOVE INITIAL TO THE LAST BANK  >>              <<03603>>63290000
                                                               <<03603>>63292000
            MOVE'INITIAL( USEDCORE(COREX) );                   <<03603>>63294000
                                                               <<03603>>63296000
  IF NOT RELOAD AND RECOVERY THEN                              <<03603>>63298000
     BEGIN<< RETURN ALL DISC SPACE BACK TO SYSTEM>>            <<03603>>63300000
   MESSAGE(M3051); <<RECOVER LOST DISC SPACE IN PROGRESS>>     <<*8392>>63302000
     IF RECOVERY THEN INFO(LOADMODE).RYMODE := 1;              <<03603>>63304000
     DISC(WRITE,SYSDISC,D'L(INFOSECTOR)),INFO,INFOSIZE);       <<03603>>63306000
     I := 0;                                                   <<03603>>63308000
     WHILE (I:=I+1) <= HVOL DO                                 <<03603>>63310000
        IF VTAB(I*VTABSIZE) <> 0 THEN                          <<03603>>63312000
           Init'Disc'Free'Space'Map(GETLDEV(I),TRUE);          <<03615>>63314000
     END;                                                      <<03603>>63316000
                                                                        63318000
          <<--------------------------------------------                63320000
            GET SPACE FOR DIRECTORY AND VIRTUAL MEMORY                  63322000
          -------------------------------------------->>                63324000
          IF NOT RELOAD THEN                                            63326000
            BEGIN                                                       63328000
              IF LOADFROMTAPE AND NOT RECOVERY OR NOT LOADFROMTAPE      63330000
                AND RECOVERY THEN                                       63332000
                BEGIN  <<REMOVE OR RETURN DISC SPACE FOR MESSAGE CATALOG63334000
                        AND INITIAL'S TABLES AND CODE SEGMENTS>>        63336000
                  @CLDPNTR := @TABLEINFO(VTABINFOX+3);<<DISC ADR>>      63338000
                  REMRETDSPACE( VTABSECT, CLDPNTR);                     63340000
                  << TAKE CARE OF INITIAL'S STACK >>           <<03675>>63342000
                  @CLDPNTR := @TABLEINFO(STACKINFOX+3);<<DISC ADR>>     63344000
                  REMRETDSPACE( STKNRSECT, CLDPNTR);                    63346000
                END;                                           <<03603>>63348000
                                                               <<03603>>63350000
              I := 0;                                          <<03603>>63352000
              IF RECOVERY THEN                                 <<03603>>63354000
                  DO                                                    63356000
                    BEGIN <<TAKE CARE OF INITIAL'S SEGMENTS>>           63358000
                      NRSECT :=DOUBLE((TCSTINFO(I*5)+127)/128);<<03603>>63360000
            TOS := TCSTINFO(X:=X+3);                                    63362000
            TOS := TCSTINFO(X:=X+1);                                    63364000
            DISCADR := TOS;                                             63366000
                      IF DISCADR > END'RESERVED(SYSDISC) THEN  <<03603>>63368000
                         REMDISCSPACE(SYSDISC,NRSECT,DISCADR); <<03603>>63370000
                    END                                                 63372000
                  UNTIL (I:=I+1)=INFO(NUTCST');                         63374000
                                                               <<MPEIV>>63376000
            << CHECK FOR TABLE SIZE CHANGES >>                 <<MPEIV>>63378000
              TOS := INFO(DIRSECT);                                     63380000
              IF S0 <> CTAB(DIRSECT') THEN MESSAGE(M2403);     <<CONFD>>63382000
                <<WARNING DIRECTORY SIZE ONLY CHANGED ON RELOAD>>       63384000
              CTAB(X) := TOS;                                  <<CONFD>>63386000
              IF INFO(RINS)<>CTAB(RINS') OR INFO(GRINS)<>      <<CONFD>>63388000
                CTAB(GRINS') THEN MESSAGE(M2404);              <<CONFD>>63390000
                  <<WARNING RIN TABLE SIZE ONLY CHANGED ON RELOAD>>     63392000
              CTAB(RINS') := INFO(RINS);                       <<CONFD>>63394000
              CTAB(GRINS') := INFO(GRINS);                     <<CONFD>>63396000
              INFO(LOGIDS) := CTAB(LOGIDS');                   <<CONFD>>63398000
              IF INFO(NLOGPROCS) <> CTAB(NLOGPROCS') THEN      <<n7948>>63400000
                  MESSAGE(M2405);<<LOGID CHANGE ON RELOAD>>    <<n7948>>63402000
              CTAB(NLOGPROCS') := INFO(NLOGPROCS);             <<CONFD>>63404000
                                                               <<MPEIV>>63406000
              IF RECOVERY THEN                                          63408000
                BEGIN  <<REMOVE SPACE FOR DIRECTORY AND VIRTUAL MEM>>   63410000
                <<------------------------------------------->><<SI.DR>>63412000
                << If dir. > 6112 sectors then the beginning >><<SI.DR>>63414000
                << of the dir. space starts at dir. addr - 29>><<SI.DR>>63416000
                <<------------------------------------------->><<SI.DR>>63418000
                IF LOGICAL( INFO (DIRSECT)) > 6112 THEN        <<SI.DR>>63420000
                  REMDISCSPACE (SYSDISC, D'L (INFO (DIRSECT))),<<SI.DR>>63422000
                    INFOD (DIRADR) - 29D)                      <<SI.DR>>63424000
                ELSE                                           <<SI.DR>>63426000
                  REMDISCSPACE(SYSDISC,D'L(INFO(DIRSECT))),             63428000
                    INFOD(DIRADR));                                     63430000
                  IF <> THEN ERRMESSAGE(M329);                 <<01442>>63432000
                  << GETTING FREE SPACE ERROR >>               <<01442>>63434000
                  REMDISCSPACE(SYSDISC,D'L(INFO(RINSECT))),             63436000
                    INFOD(RINADR));                                     63438000
                  IF <> THEN ERRMESSAGE(M329);                 <<MPEIV>>63440000
                  REMDISCSPACE(SYSDISC,D'L(INFO(LOGIDSECT))),  <<MPEIV>>63442000
                    INFOD(LOGIDADDR));                         <<MPEIV>>63444000
                  IF <> THEN ERRMESSAGE(M329);                 <<MPEIV>>63446000
                  REMDISCSPACE(SYSDISC,D'L(INFO(LOGTABSECT))), <<MPEIV>>63448000
                    INFOD(LOGTABADDR));                        <<MPEIV>>63450000
                  IF <> THEN ERRMESSAGE(M329);                 <<MPEIV>>63452000
                END;  << RECLAIM DISC SPACE >>                 <<MPEIV>>63454000
            END  << NOT RELOAD >>                              <<MPEIV>>63456000
          ELSE                                                          63458000
            BEGIN  <<RELOAD>>                                           63460000
              DISC(READ,SYSDISC,1D,DTT,128);                            63462000
                                                               <<03549>>63464000
            << REMOVE REASSIGNED TRACKS FROM DFSM SO THERE >>  <<03549>>63466000
            << WON'T BE ANY IN THE DIRECTORY, ETC.         >>  <<03549>>63468000
                                                               <<03549>>63470000
              REM'RET'REASS(FALSE,SYSDISC,DTT);                <<03549>>63472000
              IF RESTORE THEN     << RESTORE OPTION ONLY >>    <<03714>>63474000
                BEGIN  <<TRY TO GET OLD SPACE BACK>>                    63476000
                <<------------------------------------------->><<SI.DR>>63478000
                << Try first to get space dir. addr - 29.    >><<SI.DR>>63480000
                <<------------------------------------------->><<SI.DR>>63482000
                REMDISCSPACE (SYSDISC, D'L (INFO (DIRSECT))),  <<SI.DR>>63484000
                   (INFOD (DIRADR) := INFOD (DIRADR) - 29D));  <<SI.DR>>63486000
                IF <> THEN                                     <<SI.DR>>63488000
                  REMDISCSPACE (SYSDISC, D'L (INFO (DIRSECT))),<<SI.DR>>63490000
                     (INFOD (DIRADR) := INFOD (DIRADR) + 29D));<<SI.DR>>63492000
                  IF <> THEN                                            63494000
                    BEGIN  <<CAN'T GET IT; GET NEW SPACE>>              63496000
                      TOS := GETDISCSPACE(SYSDISC,D'L(INFO(DIRSECT)))); 63498000
                      IF <> THEN ERRMESSAGE(M326, SYSDISC);    <<MPEIV>>63500000
                      INFOD(DIRADR) := TOS;                             63502000
                    END;                                                63504000
                  REMDISCSPACE(SYSDISC,D'L(INFO(RINSECT))),             63506000
                    INFOD(RINADR));                                     63508000
                  IF <> THEN                                            63510000
                    BEGIN  <<GET ANY SPACE>>                            63512000
                      TOS := GETDISCSPACE(SYSDISC,D'L(INFO(RINSECT)))); 63514000
                      IF <> THEN ERRMESSAGE(M326, SYSDISC);    <<MPEIV>>63516000
                      INFOD(RINADR) := TOS;                             63518000
                    END;                                                63520000
                  REMDISCSPACE(SYSDISC,D'L(INFO(LOGIDSECT))),  <<MPEIV>>63522000
                    INFOD(LOGIDADDR));                         <<MPEIV>>63524000
                  IF <> THEN                                   <<MPEIV>>63526000
                     BEGIN                                     <<MPEIV>>63528000
                     TOS := GETDISCSPACE(SYSDISC,              <<MPEIV>>63530000
                       D'L(INFO(LOGIDSECT))));                 <<MPEIV>>63532000
                     IF <> THEN ERRMESSAGE(M326, SYSDISC);     <<MPEIV>>63534000
                     INFOD(LOGIDADDR) := TOS;                  <<MPEIV>>63536000
                     END;                                      <<MPEIV>>63538000
                  REMDISCSPACE(SYSDISC,D'L(INFO(LOGTABSECT))), <<MPEIV>>63540000
                    INFOD(LOGTABADDR));                        <<MPEIV>>63542000
                  IF <> THEN                                   <<MPEIV>>63544000
                     BEGIN                                     <<MPEIV>>63546000
                     TOS := GETDISCSPACE(SYSDISC,              <<MPEIV>>63548000
                       D'L(INFO(LOGTABSECT))));                <<MPEIV>>63550000
                     IF <> THEN ERRMESSAGE(M326, SYSDISC);     <<MPEIV>>63552000
                     INFOD(LOGTABADDR) := TOS;                 <<MPEIV>>63554000
                     END;                                      <<MPEIV>>63556000
                END                                                     63558000
              ELSE                                                      63560000
                BEGIN   << NOT RESTORE, GET SPACE ANYWHERE >>  <<03714>>63562000
                        <<   ON THE DISC                   >>  <<03714>>63564000
                  TOS := GETDISCSPACE(SYSDISC,D'L(INFO(DIRSECT))));     63566000
                  IF <> THEN ERRMESSAGE(M326, SYSDISC);        <<MPEIV>>63568000
                  INFOD(DIRADR) := TOS;                                 63570000
                  TOS := GETDISCSPACE(SYSDISC,D'L(INFO(RINSECT))));     63572000
                  IF <> THEN ERRMESSAGE(M326, SYSDISC);        <<MPEIV>>63574000
                  INFOD(RINADR) := TOS;                                 63576000
                  TOS := GETDISCSPACE(SYSDISC,                 <<MPEIV>>63578000
                    D'L(INFO(LOGIDSECT))));                    <<MPEIV>>63580000
                  IF <> THEN ERRMESSAGE(M326, SYSDISC);        <<MPEIV>>63582000
                  INFOD(LOGIDADDR) := TOS;                     <<MPEIV>>63584000
                  TOS := GETDISCSPACE(SYSDISC,                 <<MPEIV>>63586000
                    D'L(INFO(LOGTABSECT))));                   <<MPEIV>>63588000
                  IF <> THEN ERRMESSAGE(M326, SYSDISC);        <<MPEIV>>63590000
                  INFOD(LOGTABADDR) := TOS;                    <<MPEIV>>63592000
                END;                                                    63594000
                                                               <<SI.DR>>63596000
              <<--------------------------------------------->><<SI.DR>>63598000
              << If allocated directory space is > 6112 then >><<SI.DR>>63600000
              << dir. bit map is 32 sectors long and the dir.>><<SI.DR>>63602000
              << addr. must be set to the 29 sector of the   >><<SI.DR>>63604000
              << directory space.                            >><<SI.DR>>63606000
              <<--------------------------------------------->><<SI.DR>>63608000
              IF LOGICAL (INFO (DIRSECT)) > 6112 THEN          <<SI.DR>>63610000
                 INFOD (DIRADR) := INFOD (DIRADR) + 29D;       <<SI.DR>>63612000
                                                               <<03549>>63614000
            << RETURN SPACE FOR REASSIGNED TRACKS >>           <<03549>>63616000
              DISC(READ,SYSDISC,1D,DTT,128);                   <<03668>>63618000
              REM'RET'REASS(TRUE,SYSDISC,DTT);                 <<03549>>63620000
                                                               <<03549>>63622000
            END;  << RELOAD >>                                 <<MPEIV>>63624000
                                                               <<MPEIV>>63626000
                                                               <<MPEIV>>63628000
        << GET SPACE FOR VIRTUAL MEMORY >>                     <<MPEIV>>63630000
                                                               <<MPEIV>>63632000
        VOLUME := 0;                                           <<MPEIV>>63634000
        WHILE (VOLUME:= VOLUME+1) <= L'(HVOL) DO               <<MPEIV>>63636000
          IF VTAB(VOLUME*VTABSIZE+VTAB12).VMS = 1 THEN         <<MPEIV>>63638000
            BEGIN  << INSURE SPACE ALLOCATED FOR V.M. >>       <<MPEIV>>63640000
            VDSTART1 := VTAB(VOLUME*VTABSIZE+VTAB8);           <<MPEIV>>63642000
            VDSTART2 := VTAB(X:=X+1);                          <<MPEIV>>63644000
            VDSLEN1 := VTAB(X:=X+1);                           <<MPEIV>>63646000
            VDSLEN2 := VTAB(X:=X+1);                           <<MPEIV>>63648000
            LDEV := GETLDEV(VOLUME);                           <<MPEIV>>63650000
                                                               <<MPEIV>>63652000
            IF RECOVERY AND NOT RELOAD THEN                    <<01819>>63654000
              BEGIN  << RECOVER EXACTLY SAME SPACE AS BEFORE >><<MPEIV>>63656000
              GETVM(LDEV, VDSLEN, VDSTART, TRUE);              <<MPEIV>>63658000
              IF <> THEN ERRMESSAGE(M329);  <<SPACE NOT THERE>><<MPEIV>>63660000
              END                                              <<MPEIV>>63662000
            ELSE                                               <<MPEIV>>63664000
              IF RELOAD THEN                                   <<MPEIV>>63666000
                BEGIN                                          <<MPEIV>>63668000
                IF RESTORE THEN                                <<03714>>63670000
                  BEGIN  << TRY TO GET SAME SPACE AS BEFORE >> <<MPEIV>>63672000
                  GETVM(LDEV, VDSLEN, VDSTART, TRUE);          <<MPEIV>>63674000
                  IF <> THEN                                   <<MPEIV>>63676000
                    BEGIN  << SETTLE FOR ANY SPACE >>          <<MPEIV>>63678000
                    GETVM(LDEV, VDSLEN, VDSTART);              <<MPEIV>>63680000
                    IF <> THEN ERRMESSAGE(M326, LDEV);         <<MPEIV>>63682000
                    END;                                       <<MPEIV>>63684000
                  END   << RELOAD AND RESTORE >>               <<03714>>63686000
                ELSE                                           <<MPEIV>>63688000
                  BEGIN   << RELOAD AND NOT RESTORE >>         <<03714>>63690000
                          <<  GET SPACE ANYWHERE    >>         <<03714>>63692000
                  GETVM(LDEV, VDSLEN, VDSTART);                <<MPEIV>>63694000
                  IF <> THEN ERRMESSAGE(M326, LDEV);           <<MPEIV>>63696000
                  END;                                         <<MPEIV>>63698000
                VTAB(VOLUME*VTABSIZE+VTAB8) := VDSTART1;       <<MPEIV>>63700000
                VTAB(X := X+1) := VDSTART2;                    <<MPEIV>>63702000
                IF LDEV = SYSDISC THEN                         <<MPEIV>>63704000
                  BEGIN  << SAVE SIZE FOR NEXT DEFAULT VALUE >><<MPEIV>>63706000
                  INFO(VIRMEMSECT) := INTEGER(VDSLEN);         <<MPEIV>>63708000
                  INFOD(VIRMEMADR) := VDSTART;                 <<MPEIV>>63710000
                  END;                                         <<MPEIV>>63712000
                END;  << RELOAD >>                             <<MPEIV>>63714000
            END;  << VOLUME WITH VMS ATTRIBUTE >>              <<MPEIV>>63716000
$PAGE "MOVE INITIAL TO HIGH CORE - SETUP FOR SWAPPING"         <<01683>>63718000
          <<--------------------------                                  63720000
            SYSTEM GLOBAL AREA (SYS)                                    63722000
          -------------------------->>                                  63724000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>63726000
          LCMEMLOC := 12;  <<START OF LOW CORE AREA>>                   63728000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>63730000
          LCMEMLOC := %40;  <<START OF LOW CORE /33,/44,/55>>  <<02510>>63732000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>63734000
          ADDRESS(0):= SYSBASE;                                <<32BND>>63736000
          INITTABLE(SYSSIZE, 1, BANK0ABOVE, TRUE); <<SYSGLOB>> <<32BND>>63738000
          ADDRESS(0):= ADDRESS(0)+FIRMWARESIZE;                <<32BND>>63740000
          <<SET LOGICAL MAPPING FLAG IN SYSGLOB>>              <<*MAP*>>63742000
          LOGICALMAPPING := LOGICALMAPPING';                   <<*MAP*>>63744000
          INITTABLE(SYSEXTSIZE, 1, BANK0ABOVE, TRUE,,          <<32BND>>63746000
                    SYSEXTPTR);          <<SYSGLOB EXT>>       <<32BND>>63748000
          << INITIALIZE INITIAL'S TEMP CST POINTER >>          <<03603>>63750000
          ABS(SYSTCST) := ABS(CSTP)-SYSBASE;                   <<32BND>>63752000
          ABS(SYSICS) := ABS(QI)-SYSBASE;                      <<03603>>63754000
                                                                        63756000
          <<------------------------------                              63758000
            DEVICE REFERENCE TABLE (DRT)                                63760000
          ------------------------------>>                              63762000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>63764000
                                                               <<02707>>63766000
          << FIRST, IF THERE IS A STARFISH ON THE SYSTEM,   >> <<02707>>63768000
          << FIND OUT THE HIGHEST DRT THAT EXISTS ON THE    >> <<02707>>63770000
          << STARFISH.  WE NEED TO MAKE SURE WE ALLOCATE    >> <<02707>>63772000
          << ENOUGH DRTS TO INCLUDE THIS BECAUSE            >> <<02707>>63774000
          << RESETSTARFISH ZERO'S THE LAST WORD OF EACH     >> <<02707>>63776000
          << DRT ON STARFISH.                               >> <<02707>>63778000
                                                               <<02707>>63780000
          IF STARFISH THEN                                     <<02707>>63782000
             BEGIN                                             <<02707>>63784000
             TEMP := RIOC( 0, ROLLCALL); << DO A ROLL CALL >>  <<02707>>63786000
             IF <> THEN ERRMESSAGE(M29);   << RIOC FAILED >>   <<02707>>63788000
             I := 0;                                           <<02707>>63790000
             WHILE I < 16 AND                                  <<02707>>63792000
                NOT LOGICAL(TEMP&LSR(I)) DO I := I + 1;        <<02707>>63794000
             HI'STARFISH'DRT :=                                <<02707>>63796000
                IF I < 16 THEN (15-I)&LSL(3) + DEVPERCHAN-1    <<02707>>63798000
                          ELSE 0;                              <<02707>>63800000
             HIDRT := MAX( HI'STARFISH'DRT, COMM(DRTNUM));     <<CONFD>>63802000
                                                               <<02707>>63804000
             << PREVENT THE OVERLAYING OF THE STARFISH      >> <<02707>>63806000
             << MAILBOX (DRTS 125-127).  NO DEVICES CAN BE  >> <<02707>>63808000
             << BE CONFIGURED ON THESE DRTS IF THERE IS A   >> <<02707>>63810000
             << STARFISH.  THEN COMPUTE THE NO. OF DRT      >> <<02707>>63812000
             << ENTRIES TO ALLOCATE.  WE SUBTRACT 2 BECAUSE >> <<02707>>63814000
             << DRTS ON SERIES II,III START AT 3.           >> <<02707>>63816000
                                                               <<02707>>63818000
             IF HIDRT >= ADAPTERDRT THEN                       <<02707>>63820000
                HIDRT := ADAPTERDRT - 1;                       <<02707>>63822000
             I := HIDRT - 2;                                   <<02707>>63824000
             END                                               <<02707>>63826000
                                                               <<02707>>63828000
          ELSE            << NO STARFISH >>                    <<02707>>63830000
             BEGIN                                             <<02707>>63832000
             HIDRT := COMM(DRTNUM);                            <<CONFD>>63834000
             I := HIDRT - 2;                                   <<02707>>63836000
             END;                                              <<02707>>63838000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>63840000
          HIDRT := COMM(DRTNUM) + (DEVPERCHAN -                <<CONFD>>63842000
                   COMM(DRTNUM) MOD DEVPERCHAN) - 1;           <<CONFD>>63844000
          I := HIDRT - LOWESTDRT + 1;                          <<02707>>63846000
$IF << ******** RETURN TO COMMON CODE ******* >>               <<02510>>63848000
                                                               <<03744>>63850000
          <<************************************************>> <<03744>>63852000
          << *** WARNING! *** ANY I/O OPERATIONS TRIED      >> <<03744>>63854000
          << BETWEEN THE TIME THE DRT TABLE IS ZEROED AND   >> <<03744>>63856000
          << THE DRTS ARE RE-INITIALIZED WILL KILL INITIAL. >> <<03744>>63858000
          << THIS INCLUDES ANY SWAPS CAUSED BY PCALS.       >> <<03744>>63860000
          <<************************************************>> <<03744>>63862000
                                                               <<03744>>63864000
          IF HIDRT<= 127                                       <<03022>>63866000
          THEN BEGIN    <<DRT TABLE WILL REMAIN BK-0>>         <<03002>>63868000
             INITTABLE(I, DRTSIZE, BANK0ONLY, FALSE);          <<32BND>>63870000
             ABSOLUTE(DRTBANK) := 0;                           <<03002>>63872000
             ABSOLUTE(DRTADDR) := 0;                           <<03002>>63874000
             END                                               <<03002>>63876000
          ELSE BEGIN                                           <<03002>>63878000
              <<ZERO OUT THE DRT-TABLE IN BANK 1>>             <<03002>>63880000
              BANK := 1; COREADDR :=0;                         <<03002>>63882000
              SSEA( DCOREADDR,0);  <<ZERO 1ST WORD>>           <<03002>>63884000
              MABS( BANK,COREADDR+1,  <<DEST>>                 <<03002>>63886000
                    BANK,COREADDR,    <<SOURCE>>               <<03002>>63888000
                    HIDRT*4+3); <<LENGTH>>                     <<03022>>63890000
               <<ZERO THE REST OF THE DRT TABLE>>              <<03002>>63892000
            END;                                               <<03002>>63894000
                                                               <<03002>>63896000
         COMMENT ****************************                  <<03002>>63898000
                                                               <<03002>>63900000
                                                               <<00888>>63902000
                                                               <<00888>>63904000
            WHERE    CTAB0(DRTNUM) IS HIGHEST CONFIGURED DRT NUMBER     63906000
                     LOWESTDRT     IS LOWEST ALLOWED DRT NUMBER         63908000
                     DEVPERCHAN    IS NUMBER OF DEVICES PER CHANNEL     63910000
                                                                        63912000
                                                                        63914000
            THIS IS NECESSARY BECAUSE DRT'S ZERO (0) THRU LOWESDRT      63916000
            ARE NOT ALLOWED AND WHEN AN INIT(I/O INITIALIZE CHANNEL)    63918000
            IS EXECUTED FOR THE HIGHEST CONFIGURED CHANNEL IT           63920000
            SETS THE LAST WORD OF EACH(ALL) DRT ON THAT CHANNEL TO ZERO.63922000
            THEREFORE THE HIGHEST DRT # RESERVED IN LOW MEMORY MUST     63924000
            BE A MULTIPLE OF THE NUMBER OF DEVICES PER CHANNEL.         63926000
                                                                        63928000
                                                                        63930000
            *************************************************; <<00888>>63932000
          <<RESET DRTS FOR ALL DISCS AND COLDLOAD DEV>>        <<00888>>63934000
          I:=1;                                                <<00888>>63936000
          DO                                                   <<00888>>63938000
             BEGIN                                             <<00888>>63940000
             LDT'INDEX := I * LDTSIZE;                         <<*LDT*>>63942000
             DVR'INDEX := I * DVRSIZE;                         <<*DVR*>>63944000
             IF LDT'ACCESS'TYPE = 0 << DIRECT'ACCESS >> AND    <<*LDT*>>63946000
             DVRDRTNUM <>0 AND                                 <<*DVR*>>63948000
             DVRDSBIT=0 <<NOT DS DEV>> THEN                    <<*DVR*>>63950000
                INITDRT( DVRDRTNUM );                          <<*DVR*>>63952000
             END                                               <<00888>>63954000
          UNTIL (I:=I+1) > HLDEV;                              <<00888>>63956000
      IF LOADFROMTAPE THEN                                     <<04580>>63958000
          INITDRT( SYSTAPEDRT);                                <<02510>>63960000
          INITDRT( CONSOLEDRT);                                <<02510>>63962000
                                                                        63964000
   <<------------------------>>                                <<32BND>>63966000
   <<   DST, CST, AND CSTX   >>                                <<32BND>>63968000
   <<------------------------>>                                <<32BND>>63970000
                                                               <<32BND>>63972000
   << initialize DST table >>                                  <<32BND>>63974000
   ENTRIES := (CTAB(DSTNUM)+7)/8*8;                            <<CONFD>>63976000
   MEMADR := INITTABLE(ENTRIES,CSTSIZE,BANK0ABOVE,TRUE,        <<32BND>>63978000
      DSTDSTN,SYSDST);                                         <<32BND>>63980000
   ABS(DSTP) := LOGICAL(MEMADR);                               <<32BND>>63982000
   INITFREELIST(MEMADR,ENTRIES,CSTSIZE,FREEDSTN);              <<32BND>>63984000
   INSERTDST(SYSBASE D,SYSDSTN,256,0);                         <<32BND>>63986000
   ABS(DFC) := TABSIZE;                                        <<32BND>>63988000
                                                               <<32BND>>63990000
   << initialize CST table >>                                  <<32BND>>63992000
   ENTRIES := IF LOGICALMAPPING THEN CTAB(CSTNUM)+SYSPHYCST    <<CONFD>>63994000
      ELSE IF CTAB(CSTNUM)>192 THEN 192 ELSE CTAB(CSTNUM);     <<CONFD>>63996000
   ENTRIES := (ENTRIES+7)/8*8;                                 <<32BND>>63998000
   MEMADR := INITTABLE(ENTRIES,CSTSIZE,BANK0ABOVE,TRUE,        <<32BND>>64000000
      CSTDSTN,SYSCST);                                         <<32BND>>64002000
   IF LOGICALMAPPING THEN                                      <<32BND>>64004000
      BEGIN         << MAPPING FIRMWARE PRESENT >>             <<32BND>>64006000
      << THE FREE PHYSICALLY AND LOGICALLY MAPPED    >>        <<32BND>>64008000
      << CST'S WILL BE LINKED INTO SEPARATE LISTS.   >>        <<32BND>>64010000
      << THE CST HEADER WILL POINT TO THE PHYSICALLY >>        <<32BND>>64012000
      << MAPPED CST'S.  JUST BEFORE INITIAL EXITS    >>        <<32BND>>64014000
      << TO PROGEN THE HEADER WILL BE SWITCHED TO    >>        <<32BND>>64016000
      << POINT TO THE LOGICALLY MAPPED CST'S.        >>        <<32BND>>64018000
      << LINK LOGICALLY MAPPED CST'S >>                        <<32BND>>64020000
      INITFREELIST(MEMADR,ENTRIES,CSTSIZE,FREECSTN);           <<C8493>>64022000
      << LINK PHYSICALLY MAPPED CST'S >>                       <<32BND>>64024000
      INITFREELIST(MEMADR,SYSPHYCST,CSTSIZE,FREECSTN);         <<32BND>>64026000
      END                                                      <<32BND>>64028000
   ELSE                                                        <<32BND>>64030000
      BEGIN             << NO MAPPING FIRMWARE >>              <<32BND>>64032000
      <<THE CST HEADER WILL POINT TO THE CST'S>>               <<32BND>>64034000
      INITFREELIST(MEMADR,ENTRIES,CSTSIZE,FREECSTN);           <<C8493>>64036000
      END;                                                     <<32BND>>64038000
   ABS(DFS) := ABS(DFC) + TABSIZE; << OFFSET TO CSTX >>        <<32BND>>64040000
                                                               <<32BND>>64042000
   << initialize CSTX table >>                                 <<32BND>>64044000
   ENTRIES := (CTAB(CSTXNUM)+7)/8*8;                           <<CONFD>>64046000
   IF ENTRIES = 8192 THEN ENTRIES := 8191;                     <<*CSTX>>64048000
   MEMADR := INITTABLE(ENTRIES,CSTSIZE,BANK0ABOVE,TRUE,        <<32BND>>64050000
      CSTXDSTN);                                               <<32BND>>64052000
   INITFREELIST(MEMADR,ENTRIES,CSTSIZE,FREECSTXN);             <<32BND>>64054000
                                                               <<32BND>>64056000
   <<----------------------------------->>                     <<32BND>>64058000
   <<   INTERRUPT CONTROL STACK (ICS)   >>                     <<32BND>>64060000
   <<----------------------------------->>                     <<32BND>>64062000
                                                               <<32BND>>64064000
   MEMADR := INITTABLE(ICSQMINUS+CTAB(ICSSIZE),1,BANK0ONLY,    <<32BND>>64066000
      TRUE,ICSDSTN);                                           <<32BND>>64068000
   ABS(SYSICS) := BUILDSYSPTR(MEMADR+DOUBLE(ICSQMINUS));       <<32BND>>64070000
   PUSH( DB, DL, Z);                                           <<32BND>>64072000
   ICS( -STDB')  := TOS;   << DB ADDRESS >>                    <<32BND>>64074000
   ICS( -SBANK') := TOS;   << S-BANK     >>                    <<32BND>>64076000
   ICS( -DL')    := TOS;   << DL         >>                    <<32BND>>64078000
   ICS( -Z')     := TOS;   << Z          >>                    <<32BND>>64080000
   ICS(-11) := STARTTYPE;                                      <<*9006>>64082000
   ABS(QI) := LOGICAL(MEMADR)+ICSQMINUS;                       <<32BND>>64084000
   ABS(ZI) := LOGICAL(MEMADR)+TABSIZE-2;                       <<32BND>>64086000
                                                               <<PMBC2>>64088000
   <<----------------------------------------->>               <<PMBC2>>64090000
   <<   RESERVE MEMORY SPACE FOR PMBC TABLE   >>               <<PMBC2>>64092000
   <<----------------------------------------->>               <<PMBC2>>64094000
                                                               <<PMBC2>>64096000
   IF PMBCFIRMWARE THEN                                        <<PMBC2>>64098000
      BEGIN                                                    <<PMBC2>>64100000
      DCOREADDR := INITTABLE(256,1,BANK0ONLY,FALSE);           <<PMBC2>>64102000
      ABS(SYSPMBC) := COREADDR;                                <<PMBC2>>64104000
      END;                                                     <<PMBC2>>64106000
                                                               <<PMBC2>>64108000
          <<------------------------                                    64110000
            DIRECTORY DATA SEGMENT                                      64112000
          ------------------------>>                                    64114000
          DIRSPINCR := DIRSPSIZE';                             <<03675>>64116000
          DIRINCR := DIRLEN;                                   <<03675>>64118000
          MOVEDLTABLES;                                        <<03675>>64120000
          PUSH(DB);                                            <<01683>>64122000
          TOS := TOS + @DIR;                                   <<01683>>64124000
          INSERTDST(*, DIRDSTN, DIRLEN, 0);                    <<32BND>>64126000
          DIR := 0;                                                     64128000
          MOVE DIR(1) := DIR,(DIRLEN-1);   <<ZERO TABLE>>               64130000
          DIR (L:=DIRZ+IOPNTR) := TEMP := DIRZ+(2*DIRX)+DIRY;  <<RV.PV>>64132000
          DIR(L+DIRX) := TEMP+128*DMAXBZ+DIRMAXENTZ;                    64134000
          TOS := INFOD(DIRADR);                                         64136000
          ASSEMBLE(DDUP,DDUP);                                          64138000
          ABSOLUTE(DIRDISCADR2) := TOS;                                 64140000
          ABSOLUTE(X:=X-1) := TOS;                                      64142000
          DIRDISCADR := TOS;                                            64144000
          DIR (TEMP-DIRY) := 3;     << System account index  >><<SI.DR>>64146000
          DIR (X:=X+2) := TOS;                                 <<RV.PV>>64148000
          DIR(X:=X-1) := TOS;                                           64150000
          DIR (X).(0:8) := SYSDISC; << Set system ldev       >><<SI.DR>>64152000
          TOS := .85;  << DISTRIBUTION FACTOR >>               <<DE>>   64154000
          DIR(X:=X+15) := TOS;                                 <<DE>>   64156000
          DIR(X:=X-1) := TOS;                                           64158000
          DIR(TEMP-DIRY+4) := SYSDISC;                         <<DE>>   64160000
                                                               <<DE>>   64162000
          <<--------------------->>                            <<DE>>   64164000
          <<DIRECTORY SPACE TABLE>>                            <<DE>>   64166000
          <<--------------------->>                            <<DE>>   64168000
          PUSH(DB);                                            <<01683>>64170000
          TOS := TOS + @DIRSP;                                 <<01683>>64172000
          INSERTDST(*, DIRSPDSTN, DIRSPSIZE', 0);              <<32BND>>64174000
          << Initialize directory space mgr. control data    >><<SI.DR>>64176000
          DIRSP := 0;                                          <<SI.DR>>64178000
          MOVE DIRSP (1) := DIRSP, (127);                      <<SI.DR>>64180000
          DIRSP (15) := INFO (DIRSECT);<< Save directory size>><<SI.DR>>64182000
          <<------------------------------------------------->><<SI.DR>>64184000
          << If directory is > 6112 sectors (dir. bit map > 3>><<SI.DR>>64186000
          << sectors) then the directory size in DSM DST must>><<SI.DR>>64188000
          << be lower by 29 sectors because new directory bit>><<SI.DR>>64190000
          << map is 32 sectors long and only 3 sectors of    >><<SI.DR>>64192000
          << of the directory bit map are represented in the >><<SI.DR>>64194000
          << directory bit map.                              >><<SI.DR>>64196000
          <<------------------------------------------------->><<SI.DR>>64198000
          IF LOGICAL( DIRSP (15)) > 6112 THEN                  <<SI.DR>>64200000
             DIRSP (15) := DIRSP (15) - 29;                    <<SI.DR>>64202000
          DIRSP (14) := 1; << Requested sector               >><<SI.DR>>64204000
                                                               <<SI.DR>>64206000
          TOS := COLDLOADID;                                            64208000
          ASSEMBLE(INCA,DUP; DDUP);                                     64210000
          ABSOLUTE(COLD'LOAD'ID) := TOS;                                64212000
          INFO(COLD'LOAD'ID') := TOS;                                   64214000
          VTAB(VTABCOLDLOADID) := TOS;                                  64216000
          COLDLOADID := TOS;                                            64218000
          DISC( READ, SYSDISC, CLEXTSECT, LBUF, 256);          <<CLEXT>>64220000
          IF LBUF(LOG'FILE'NUM') >= 9999 THEN                  <<CLEXT>>64222000
             LBUF(LOG'FILE'NUM') := 0                          <<CLEXT>>64224000
          ELSE                                                 <<CLEXT>>64226000
             LBUF(LOG'FILE'NUM') := LBUF(LOG'FILE'NUM')+1;     <<CLEXT>>64228000
          ABSOLUTE(LOGFILENUM) := LBUF(LOG'FILE'NUM');         <<CLEXT>>64230000
          DISC( WRITE, SYSDISC, CLEXTSECT, LBUF, 256);         <<CLEXT>>64232000
                                                                        64234000
          <<--------------------                                        64236000
            CLEAN UP DIRECTORY                                          64238000
          -------------------->>                                        64240000
          HEADING'PRINTED := FALSE;                            <<01442>>64242000
          ZEROBUF( LDMAPBUF,       << ZERO BUFFER USED FOR >>  <<03668>>64244000
                   LDMAP'SIZE);    << SAVING NAMES OF      >>  <<03668>>64246000
                                   << FILES WHICH LOST DATA>>  <<03668>>64248000
          IF NOT RELOAD THEN                                            64250000
            BEGIN  <<CLEAN UP ACCOUNTS, GROUPS AND FILES>>              64252000
              TOS := 0D;                                                64254000
              IF RECOVERY THEN                                          64256000
                BEGIN                                          <<03668>>64258000
                                                               <<03668>>64260000
                                                               <<03668>>64262000
                  TOS := %120;  <<ALL FILES>>                  <<RV.PV>>64264000
                END                                                     64266000
              ELSE TOS := %320;  <<ALL GROUPS>>                <<RV.PV>>64268000
              BUF := OPT;  <<WHICH OPTION>>                             64270000
              BUF(1) := 0;  <<# OF FILES PURGED>>                       64272000
              BUF(14) := RECOVERY;                                      64274000
              TOS := DIRECSCAN(*,0,NULLNAME,NULLNAME,NULLNAME,          64276000
                DIRECTORYCLEAN,BUF);                                    64278000
              IF <> THEN DIRERROR(*,BBUF);                              64280000
              DDEL;                                                     64282000
              IF RECOVERY THEN                                 <<03668>>64284000
                 BEGIN                                         <<03668>>64286000
               MESSAGE(M3052); << RECOVER LOST DISC  >>        <<*8392>>64288000
                                   <<    SPACE COMPLETE  >>    <<03668>>64290000
                                                               <<03668>>64292000
                 << ALLOW USER TO PURGE/SAVE FILES WHICH >>    <<03668>>64294000
                 <<    LOST DATA                         >>    <<03668>>64296000
                                                               <<03668>>64298000
                 FILE'DAMAGE;                                  <<03668>>64300000
                 END;                                          <<03668>>64302000
              MESSAGE(M3053); <<INITIALIZE DIRECTORY DONE>>    <<*8392>>64304000
            END;                                                        64306000
                                                               <<03668>>64308000
                                                                        64310000
END;  << MAINSEG1 >>                                           <<03603>>64312000
$PAGE "MAINSEG1B"                                              <<03603>>64314000
$CONTROL SEGMENT=MAINSEG1B                                     <<03603>>64316000
PROCEDURE MAINSEG1B;                                           <<03603>>64318000
BEGIN                                                          <<03603>>64320000
    EQUATE SEED = %123456; <<STARTING VALUE FOR CHECKSUM>>     <<DEVCO>>64322000
    INTEGER POINTER DIRSP', DIRSP2';                           <<DE>>   64324000
    LOGICAL LDIRC, LNUM;                                       <<DE>>   64326000
INTEGER                                                        <<*RIN*>>64328000
   LEN,                                                        <<*RIN*>>64330000
   LENGTH,                                                     <<*RIN*>>64332000
   NRRINS,                                                     <<*RIN*>>64334000
   NRGRINS,                                                    <<*RIN*>>64336000
   GAREA,                                                      <<*RIN*>>64338000
   INX,                                                        <<*RIN*>>64340000
   OLDINX,                                                     <<*RIN*>>64342000
   CNT;                                                        <<*RIN*>>64344000
DOUBLE                                                         <<*RIN*>>64346000
   MEMADR;                                                     <<*RIN*>>64348000
INTEGER ARRAY                                                  <<*RIN*>>64350000
   RIN(*) = DB+0;                                              <<*RIN*>>64352000
INTEGER POINTER                                                <<*RIN*>>64354000
   GLAREA = DB+1;                                              <<*RIN*>>64356000
                                                               <<03603>>64358000
     INTEGER                                                   <<*LDT*>>64360000
         LDT'INDEX,                                            <<*DVR*>>64362000
         LPDT'INDEX,                                           <<*DVR*>>64364000
         DVR'INDEX;                                            <<*DVR*>>64366000
    ASSEMBLE( RSW );                                           <<03603>>64368000
    IF TOS.(8:8) <> CLRSW THEN HELP;                           <<03603>>64370000
                                                               <<03603>>64372000
$IF X1=ON    << ****** SERIES 33 UNIQUE ********* >>           <<03603>>64374000
          <<--------------------------->>                      <<03603>>64376000
          <<  MAKE SYSTEM DISC UNIQUE  >>                      <<03603>>64378000
          <<--------------------------->>                      <<03603>>64380000
            DISC(READ,SYSDISC,0D,LBUF,128);                    <<03603>>64382000
            MOVE BLBUF:="SYSTEM DISC ";                        <<03603>>64384000
            DISC(WRITE,SYSDISC,0D,LBUF,128);                   <<03603>>64386000
                                                               <<03603>>64388000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<03603>>64390000
   <<-------------------------->>                              <<*RIN*>>64392000
   <<   INITIALIZE RIN TABLE   >>                              <<*RIN*>>64394000
   <<-------------------------->>                              <<*RIN*>>64396000
                                                               <<*RIN*>>64398000
   NRRINS := INFO(RINS);                                       <<*RIN*>>64400000
   NRGRINS := INFO(GRINS);                                     <<*RIN*>>64402000
   LENGTH := (NRRINS+1)*3+NRGRINS*12+4;                        <<*RIN*>>64404000
   MEMADR := INITTABLE(LENGTH,1,TEMPORARY'TAB,FALSE,RINTDSTN); <<*RIN*>>64406000
   IF RELOAD THEN                                              <<*RIN*>>64408000
      IF COMM(FILESDUMPED) = 0 THEN                            <<CONFD>>64410000
         BEGIN  << INITIALIZE TO NULL TABLE >>                 <<*RIN*>>64412000
         EXCHANGEDB( RINTDSTN );                               <<*RIN*>>64414000
         << INITIALIZE FREE LIST >>                            <<*RIN*>>64416000
         INX := 0;                                             <<*RIN*>>64418000
         WHILE INX < NRRINS*3 DO                               <<*RIN*>>64420000
            BEGIN                                              <<*RIN*>>64422000
            RIN( INX) := INX+3;                                <<*RIN*>>64424000
            INX := INX+3;                                      <<*RIN*>>64426000
            END;                                               <<*RIN*>>64428000
         << INITIALIZE GLOBAL AREA >>                          <<*RIN*>>64430000
         @GLAREA := (NRRINS+1) * 3;                            <<*RIN*>>64432000
         IF NRGRINS <> 0 THEN                                  <<*RIN*>>64434000
            BEGIN                                              <<*RIN*>>64436000
            << INITIALIZE HEADER ENTRY >>                      <<*RIN*>>64438000
            GLAREA := 4;                                       <<*RIN*>>64440000
            GLAREA(1) := NRGRINS;   << # ENTRIES >>            <<*RIN*>>64442000
            GLAREA(2) := NRGRINS;   << # FREE >>               <<*RIN*>>64444000
            << INITIALIZE GLOBAL FREE LIST >>                  <<*RIN*>>64446000
            INX := GLAREA;                                     <<*RIN*>>64448000
            CNT := 1;                                          <<*RIN*>>64450000
            WHILE CNT < NRGRINS DO                             <<*RIN*>>64452000
               BEGIN                                           <<*RIN*>>64454000
               GLAREA( INX) := INX+12;                         <<*RIN*>>64456000
               INX := INX+12;                                  <<*RIN*>>64458000
               CNT := CNT+1;                                   <<*RIN*>>64460000
               END;                                            <<*RIN*>>64462000
            END;                                               <<*RIN*>>64464000
         EXCHANGEDB( 0 );                                      <<*RIN*>>64466000
         END                                                   <<*RIN*>>64468000
      ELSE                                                     <<*RIN*>>64470000
         BEGIN  <<READ IT OFF THE TAPE>>                       <<*RIN*>>64472000
         INX := 0;                                             <<*RIN*>>64474000
         WHILE INX <> LENGTH DO                                <<*RIN*>>64476000
            BEGIN                                              <<*RIN*>>64478000
            LEN := IF LENGTH-INX > TAPERECSIZE THEN            <<*RIN*>>64480000
               TAPERECSIZE ELSE LENGTH-INX;                    <<*RIN*>>64482000
            COLD'LOAD'MEDIA( READ,TAPEBUF,LEN);                <<*RIN*>>64484000
            WHILE END'OF'TAPE DO                               <<*RIN*>>64486000
               BEGIN                                           <<*RIN*>>64488000
               NEXTREEL(TAPEBUF);                              <<*RIN*>>64490000
               COLD'LOAD'MEDIA( READ,TAPEBUF,LEN);             <<*RIN*>>64492000
               END;                                            <<*RIN*>>64494000
            MTDS( RINTDSTN, INX, TAPEBUF, LEN);                <<*RIN*>>64496000
            INX := INX+LEN;                                    <<*RIN*>>64498000
            END;                                               <<*RIN*>>64500000
         GO CLEANRIN;                                          <<*RIN*>>64502000
         END                                                   <<*RIN*>>64504000
   ELSE                                                        <<*RIN*>>64506000
      BEGIN  << NOT A RELOAD -- USE COPY ON DISC >>            <<*RIN*>>64508000
      DISC'(READ,SYSDISC,INFOD(RINADR),MEMADR,LENGTH);         <<*RIN*>>64510000
CLEANRIN:                                                      <<*RIN*>>64512000
      EXCHANGEDB( RINTDSTN );                                  <<*RIN*>>64514000
      OLDINX := 0;  << LAST FREE RIN >>                        <<*RIN*>>64516000
      INX := 3;                                                <<*RIN*>>64518000
      WHILE INX <= NRRINS*3 DO                                 <<*RIN*>>64520000
         BEGIN                                                 <<*RIN*>>64522000
         IF RIN( INX).(0:2) <> 2 THEN                          <<*RIN*>>64524000
            BEGIN   << NOT A GLOBAL RIN >>                     <<*RIN*>>64526000
            RIN( INX) := 0; << MAKE LAST >>                    <<*RIN*>>64528000
            RIN( OLDINX) := INX; << PT. PREV LAST TO LAST >>   <<*RIN*>>64530000
            OLDINX := INX;                                     <<*RIN*>>64532000
            END;                                               <<*RIN*>>64534000
         RIN( INX+1) := 0;                                     <<*RIN*>>64536000
         RIN( INX+2) := 0;                                     <<*RIN*>>64538000
         INX := INX + 3;                                       <<*RIN*>>64540000
         END;                                                  <<*RIN*>>64542000
      EXCHANGEDB( 0 );                                         <<*RIN*>>64544000
      END;                                                     <<*RIN*>>64546000
   ABSENT( RINTDSTN, -1, INFOD(RINADR));                       <<*RIN*>>64548000
                                                               <<*RIN*>>64550000
         N:=INFO(NLOGPROCS);                                   <<00506>>64552000
         TOS:=N*33+33;                                         <<00506>>64554000
         ASSEMBLE(DUP,NEG);                                    <<00506>>64556000
         PUSH(DL);                                             <<00506>>64558000
         DLSAVE:=S0;                                           <<00506>>64560000
         ASSEMBLE(ADD,DUP);                                    <<00506>>64562000
         @LIDTAB:=TOS;                                         <<00506>>64564000
         SET(DL);                                              <<00506>>64566000
         CHECKMEM;                                             <<00506>>64568000
         K:=TOS;   <<LENGTH OF LOGGIND ID TABLE>>              <<00506>>64570000
         IF RELOAD  THEN                                       <<00506>>64572000
         IF COMM(FILESDUMPED) = 0 THEN                         <<CONFD>>64574000
            BEGIN  <<INIT TO NULL>>                            <<00506>>64576000
            MOVE LIDTAB:="  ";                                 <<00506>>64578000
            MOVE LIDTAB(1):=LIDTAB,(N*33);                     <<00506>>64580000
            LIDTAB(0):=0;                                      <<00506>>64582000
            LIDTAB(1):=N;                                      <<00506>>64584000
            LIDTAB(3):=0;                                      <<00506>>64586000
            LIDTAB(4):=33;                                     <<00506>>64588000
            DO                                                 <<00506>>64590000
               BEGIN                                           <<00506>>64592000
               LIDTAB(LIDTAB(4)*(LIDTAB(3):=LIDTAB(3)+1)+32):=-1;       64594000
               END UNTIL LIDTAB(3)=LIDTAB(1);                  <<00506>>64596000
            END                                                <<00506>>64598000
         ELSE                                                  <<00506>>64600000
            BEGIN                                              <<00506>>64602000
            INX := 0;                                          <<03603>>64604000
            WHILE INX <> K DO                                  <<03603>>64606000
               BEGIN                                           <<03603>>64608000
               LEN := IF K-INX > TAPERECSIZE THEN              <<03603>>64610000
                  TAPERECSIZE ELSE K-INX;                      <<03603>>64612000
               COLD'LOAD'MEDIA( READ,LIDTAB(INX),LEN);         <<03603>>64614000
               WHILE END'OF'TAPE DO                            <<03603>>64616000
                  BEGIN                                        <<03603>>64618000
                  NEXTREEL( TAPEBUF);                          <<03603>>64620000
                  COLD'LOAD'MEDIA( READ,LIDTAB(INX),LEN);      <<03603>>64622000
                  END;                                         <<03603>>64624000
               INX := INX+LEN;                                 <<03603>>64626000
               END;                                            <<03603>>64628000
            END                                                <<00506>>64630000
         ELSE                                                  <<00506>>64632000
            BEGIN                                              <<00506>>64634000
            DISC(READ,SYSDISC,INFOD(LOGIDADDR),LIDTAB,K);      <<00506>>64636000
            END;                                               <<00506>>64638000
         DISC(WRITE,SYSDISC,INFOD(LOGIDADDR),LIDTAB,K);        <<00506>>64640000
         TOS:=K&LSR(2)+2;                                      <<00506>>64642000
         TOS.(0:1):=1;                                         <<00506>>64644000
         DST(LIDDST&LSL(2)):=TOS;                              <<00506>>64646000
         TOS:=INFOD(LOGIDADDR);                                <<00506>>64648000
         DST(LIDDST&LSL(2)+3):=TOS;                            <<00506>>64650000
         TOS.(0:8):=SYSDISC;                                   <<00506>>64652000
         DST(X:=X-1):=TOS;                                     <<00506>>64654000
        DST(X:=X-1).DISCCOPYVALIDFLAG:=1;                      <<MPEIV>>64656000
        DST(X).SYSTEMFLAG:=1;                                  <<MPEIV>>64658000
         TOS:=DLSAVE;                                          <<00506>>64660000
         SET(DL);                                              <<00506>>64662000
         N:=INFO(NLOGPROCS);                                   <<00506>>64664000
         TOS:=N*38+38;                                         <<00506>>64666000
         ASSEMBLE(DUP,NEG);                                    <<00506>>64668000
         PUSH(DL);                                             <<00506>>64670000
         DLSAVE:=S0;                                           <<00506>>64672000
         ASSEMBLE(ADD,DUP);                                    <<00506>>64674000
         @LOGTAB:=TOS;                                         <<00506>>64676000
         SET(DL);                                              <<00506>>64678000
         CHECKMEM;                                             <<00506>>64680000
         M:=TOS;                                               <<00506>>64682000
      IF WARMSTART THEN                                        <<00506>>64684000
         BEGIN   <<WARMSTART, SAVE LIDTAB>>                    <<00506>>64686000
         DISC(READ,SYSDISC,INFOD(LOGTABADDR),LOGTAB,M);        <<00506>>64688000
         <<CHECK AND CLEAN UP TABLE HERE>>                     <<00506>>64690000
         END                                                   <<00506>>64692000
      ELSE                                                     <<00506>>64694000
         BEGIN  <<COOL, COLD, RELOAD.  INIT>>                  <<00506>>64696000
         MOVE LOGTAB:="  ";                                    <<00506>>64698000
         MOVE LOGTAB(1):=LOGTAB,(INFO(NLOGPROCS)*38);          <<00506>>64700000
         LOGTAB(0):=INFO(NLOGPROCS);                           <<00506>>64702000
         LOGTAB(1):=38;                                        <<00506>>64704000
         LOGTAB(2):=-1;                                        <<00506>>64706000
         LOGTAB(3):=38;                                        <<00506>>64708000
         LOGTAB(4):=0;                                         <<00506>>64710000
         LOGTAB(5):=-1;                                        <<00506>>64712000
         LOGTAB(6):=38;                                        <<00506>>64714000
         LOGTAB(7):=38;                                        <<00506>>64716000
         DO                                                    <<00506>>64718000
            BEGIN                                              <<00506>>64720000
            LOGTAB(6):=LOGTAB(3)*LOGTAB(4)+LOGTAB(7);          <<00506>>64722000
            LOGTAB(LOGTAB(6)+37):=LOGTAB(5);                   <<00506>>64724000
            LOGTAB(LOGTAB(6)+36):=LOGTAB(6)+LOGTAB(7);         <<00506>>64726000
            LOGTAB(5):=LOGTAB(6);                              <<00506>>64728000
            END UNTIL (LOGTAB(4):=LOGTAB(4)+1) = LOGTAB(0);    <<00506>>64730000
          LOGTAB(LOGTAB(6)+36):=-1;                            <<00506>>64732000
          LOGTAB(3):=0;                                        <<00506>>64734000
         LOGTAB(0):=0;                                         <<00506>>64736000
         LOGTAB(4):=INFO(NLOGPROCS);                           <<00506>>64738000
         LOGTAB(5):=INFO(LOGIDS);                              <<00506>>64740000
         END;                                                  <<00506>>64742000
         DISC(WRITE,SYSDISC,INFOD(LOGTABADDR),LOGTAB,M);       <<00506>>64744000
         TOS:=M&LSR(2)+2;                                      <<00506>>64746000
         TOS.(0:1):=1;                                         <<00506>>64748000
         DST(LOGDST&LSL(2)):=TOS;                              <<00506>>64750000
         TOS:=INFOD(LOGTABADDR);                               <<00506>>64752000
         DST(LOGDST&LSL(2)+3):=TOS;                            <<00506>>64754000
         TOS.(0:8):=SYSDISC;                                   <<00506>>64756000
         DST(X:=X-1):=TOS;                                     <<00506>>64758000
        DST(X:=X-1).DISCCOPYVALIDFLAG:=1;                      <<MPEIV>>64760000
        DST(X).SYSTEMFLAG:=1;                                  <<MPEIV>>64762000
         TOS:=DLSAVE;                                          <<00506>>64764000
         SET(DL);                                              <<00506>>64766000
                                                                        64768000
          <<----------------------                                      64770000
            INITIALIZE DIRECTORY                                        64772000
          ---------------------->>                                      64774000
          IF RELOAD THEN                                                64776000
          IF COMM(FILESDUMPED) = 0 THEN                        <<CONFD>>64778000
            BEGIN  <<CREATE NULL DIRECTORY WITH SYS, PUB, MANAGER>>     64780000
              TOS := DIRECNULL(CTAB(DIRSECT'));                <<CONFD>>64782000
              IF <> THEN DIRERROR(*,BBUF);                              64784000
              DDEL;                                                     64786000
              TOS := DIRECINSERT(ACCTYPE,0,SYSACCT,NULLNAME,NULLNAME,   64788000
                      SYSINFO);                                         64790000
              IF <> THEN DIRERROR(*,BBUF);                              64792000
              DDEL;                                                     64794000
              TOS := DIRECINSERT(GRPTYPE,0,SYSACCT,PUBGRP,NULLNAME,     64796000
                      PUBINFO);                                         64798000
              IF <> THEN DIRERROR(*,BBUF);                              64800000
              DDEL;                                                     64802000
              TOS := DIRECINSERT(USERTYPE,0,SYSACCT,MANUSER,NULLNAME,   64804000
                      MANAGERINFO);                                     64806000
              IF <> THEN DIRERROR(*,BBUF);                              64808000
              DDEL;                                                     64810000
              NUSERFILES := 0;                                          64812000
            END                                                         64814000
          ELSE                                                          64816000
            BEGIN  <<DIRECTORY ON TAPE>>                                64818000
              COLD'LOAD'MEDIA(READ,TAPEBUF,20);                <<03603>>64820000
              WHILE END'OF'TAPE DO                             <<03603>>64822000
                 BEGIN                                         <<03603>>64824000
                 NEXTREEL( TAPEBUF);                           <<03603>>64826000
                 COLD'LOAD'MEDIA(READ,TAPEBUF,20);             <<03603>>64828000
                 END;                                          <<03603>>64830000
              <<--------------------------------------------->><<SI.DR>>64832000
              << Read directory from tape. If dir. > 6112    >><<SI.DR>>64834000
              << then directory addr. must be adjusted. In   >><<SI.DR>>64836000
              << such case the dir. addr. does not points to >><<SI.DR>>64838000
              << the beginning of dir. space but to 29 sector>><<SI.DR>>64840000
              << of the dir. space.                          >><<SI.DR>>64842000
              <<--------------------------------------------->><<SI.DR>>64844000
              IF LOGICAL (INFO (DIRSECT)) > 6112 THEN          <<SI.DR>>64846000
                 WRITEDISC (INFOD (DIRADR) - 29D)              <<SI.DR>>64848000
              ELSE                                             <<SI.DR>>64850000
              WRITEDISC(INFOD (DIRADR));                       <<depen>>64852000
                                                               <<SI.DR>>64854000
              BUF := OPT;                                               64856000
              BUF(1) := 0;                                              64858000
              BUF(15) := ACCTSONLY;                                     64860000
              TOS := DIRECSCAN (%120,0,NULLNAME,NULLNAME,      <<RV.PV>>64862000
                NULLNAME,DIRECTORYCLEAN,BUF);                  <<RV.PV>>64864000
              IF <> THEN DIRERROR(*,BBUF);                              64866000
              DDEL;                                                     64868000
              NUSERFILES := BUF(1);                                     64870000
            END;                                                        64872000
                                                                        64874000
                                                                        64876000
          TOS := DIRECFIND( GRPTYPE, 0, SYSACCT, PUBGRP,       <<S9090>>64878000
             NULLNAME, BUF);                                   <<S9090>>64880000
          IF <> THEN DIRERROR( *, BBUF);                       <<S9090>>64882000
          DDEL;                                                <<S9090>>64884000
          XPPUBFILES := BUF(4);                                <<S9090>>64886000
                                                               <<S9090>>64888000
          <<-----------------------------                               64890000
            READ SYSTEM FILES FROM TAPE                                 64892000
          ----------------------------->>                               64894000
          IF LOADFROMTAPE THEN                                          64896000
            BEGIN  <<READ FILES FROM TAPE>>                             64898000
              MESSAGE(M3063); << LOADING SYS FILES IN PROG>>   <<P8830>>64900000
REDOFSF:      COLD'LOAD'MEDIA(FWDSPFILE);                      <<00678>>64902000
              IF END'OF'TAPE THEN                              <<00678>>64904000
                 BEGIN                                         <<00678>>64906000
                 NEXTREEL(TAPEBUF);                            <<03603>>64908000
                 GOTO REDOFSF;                                 <<00678>>64910000
                 END;                                          <<00678>>64912000
READNEXT:     COLD'LOAD'MEDIA(READ,TAPEBUF,TAPERECSIZE);       <<03603>>64914000
              IF > THEN                                        <<00678>>64916000
                   GOTO REWINDTAPE;                            <<00678>>64918000
                 IF END'OF'TAPE THEN                           <<00678>>64920000
                   BEGIN                                       <<00678>>64922000
                   NEXTREEL(TAPEBUF);                          <<03603>>64924000
                   GOTO READNEXT;                              <<00678>>64926000
                   END;                                        <<00678>>64928000
              FREPLACE;                                        <<00678>>64930000
              GOTO READNEXT;                                   <<00678>>64932000
REWINDTAPE:                                                    <<00678>>64934000
MESSAGE(M3054); <<LOADING SYSTEM FILES COMPLETE>>              <<*8392>>64936000
IF NOT RELOAD OR NUSERFILES=0 THEN COLD'LOAD'MEDIA(REWUNLOAD); <<00678>>64938000
            END;                                               <<00678>>64940000
$PAGE "MAINSEG1  --  SET UP FOR DISC COLD LOAD"                         64942000
          <<----------------------                                      64944000
            WRITE TABLES TO DISC                                        64946000
          ---------------------->>                                      64948000
          TOS := DIRECSCAN (%720,0,NULLNAME,NULLNAME,NULLNAME, <<RV.PV>>64950000
                            USERCLEAN,BUF);                    <<RV.PV>>64952000
          IF <> THEN DIRERROR(*,BBUF);                                  64954000
          DDEL;                                                         64956000
          TOS := DIRECSCAN(%30, 0, SYSACCT, MANUSER, NULLNAME, <<01090>>64958000
            SET'1'MGR, BUF);                                   <<01090>>64960000
          IF <> THEN DIRERROR(*,BBUF);                         <<01090>>64962000
          DDEL;                                                <<01090>>64964000
          TOS := DIRECSCAN (%1120,0,NULLNAME,NULLNAME,NULLNAME,<<RV.PV>>64966000
                            VSDCLEAN,BUF);                     <<RV.PV>>64968000
          IF <> THEN DIRERROR (*,BBUF);                        <<RV.PV>>64970000
          DDEL;                                                <<RV.PV>>64972000
          FCBHD := 0;                                                   64974000
          I := 0;                                                       64976000
          DO FCB(I*FCBSIZE) := (I+1)*FCBSIZE UNTIL (I:=I+1)=3;          64978000
                                                               <<DEVCO>>64980000
   CTABFNUM := FOPEN( CTABFILE);                               <<DEVCO>>64982000
   TOS := FCBDBL + D'L(FCB(FCBSECTOFF)));                      <<DEVCO>>64984000
   BS1 := 0;   << ZERO LDEV >>                                 <<DEVCO>>64986000
   DTEMP := TOS; << USED BY WRITECONFTABLE >>                  <<DEVCO>>64988000
   COMM(CSTABSIZE) := CSTAB;                                   <<CONFD>>64990000
   CTAB0(CTABVERSION) := CTABCURVERSION;                       <<CONFD>>64992000
   CTAB0(CTABCHECKSUM) := CALCULATECHECKSUM( CTAB0(1),         <<CONFD>>64994000
      127, NOT(SEED));                                         <<CONFD>>64996000
   WRITECONFTABLE( CTAB0SIZE, CTAB0RECNUM, CTAB0, CTAB0INFOX); <<DEVCO>>64998000
   WRITECONFTABLE( CTABSIZE, CTABRECNUM, CTAB, CTABINFOX);     <<CONFD>>65000000
   FCLOSE( CTABFNUM);                                          <<DEVCO>>65002000
                                                               <<t8392>>65004000
   <<WRITE DEFAULT I/O CONFIGURATION TO DISC>>                 <<t8392>>65006000
                                                               <<t8392>>65008000
   DEFFNUM := FOPEN(DEFFILE);                                  <<t8392>>65010000
   TOS := FCBDBL + D'L(FCB(FCBSECTOFF)));                      <<t8392>>65012000
   BS1 := 0;   << ZERO LDEV >>                                 <<t8392>>65014000
   DTEMP := TOS; <<USED BY WRITEDEFFILE>>                      <<t8392>>65016000
                                                               <<t8392>>65018000
   <<BUILD HEADER>>                                            <<t8392>>65020000
                                                               <<t8392>>65022000
   ZEROBUF(DEFREC0, 128);                                      <<t8392>>65024000
   @TL'HEAD := @DEFREC0;                                       <<t8392>>65026000
   TLH'VERSION := DEFCURVERSION;                               <<t8392>>65028000
   TLH'TABLE'SIZE := COMM(TLBUFSIZE);                          <<t8392>>65030000
   TLH'NUM'ENTRIES := COMM(TLBUFENTRIES);                      <<t8392>>65032000
                                                               <<t8392>>65034000
   WRITEDEFFILE(TLH'TABLE'SIZE, 1D, TL'BUF, TLBUFINFOX);       <<t8392>>65036000
                                                               <<t8392>>65038000
   TLH'CHECKSUM := CALCULATECHECKSUM(DEFREC0(1),127,SEED);     <<t8392>>65040000
   FWRITE(DEFFNUM, 0D, DEFREC0, DEFREC0SIZE);                  <<t8392>>65042000
   FCLOSE(DEFFNUM);                                            <<t8392>>65044000
                                                               <<t8392>>65046000
   << WRITE I/O CONFIGURATION TO DISC >>                       <<DEVCO>>65048000
                                                               <<DEVCO>>65050000
   DEVFNUM := FOPEN( DEVFILE);                                 <<DEVCO>>65052000
   TOS := FCBDBL + D'L(FCB(FCBSECTOFF)));                      <<DEVCO>>65054000
   BS1 := 0;   << ZERO LDEV >>                                 <<DEVCO>>65056000
   DEVFILEADR := TOS;                                          <<DEVCO>>65058000
   ZEROBUF( DEVREC0, 128);                                     <<DEVCO>>65060000
   DEVVERSION := DEVCURVERSION;                                <<DEVCO>>65062000
   DEVNEXT := 2;                                               <<DEVCO>>65064000
   DEVHLDEV := COMM(HLDEV');                                   <<TSIZE>>65066000
   DEVHDRT := HIDRT;                                           <<DEVCO>>65068000
   DEVNRADVRS := COMM(NUMADVRS); << NR. CS DRIVERS >>          <<CONFD>>65070000
                                                               <<DEVCO>>65072000
   WRITEDEVFILE( DEVDVR, DVRTAB, (HLDEV+1)*DVRSIZE, DVRINFOX); <<DEVCO>>65074000
   WRITEDEVFILE( DEVLPDT, LPDT, (HLDEV+1)*LPDTSIZE, LPDTINFOX);<<DEVCO>>65076000
   WRITEDEVFILE( DEVLDT, LDT, (HLDEV+1)*LDTSIZE, LDTINFOX);    <<DEVCO>>65078000
   WRITEDEVFILE( DEVLDTX, LDTX, (HLDEV+1)*LDTXSIZE, LDTXINFOX);<<DEVCO>>65080000
   WRITEDEVFILE( DEVDCTH, DCT'HEAD, DCTHSIZE, DCTHINFOX);      <<DEVCO>>65082000
   WRITEDEVFILE( DEVDCT, DCTAB,                                <<*7777>>65084000
           (DCTH'TDT'BASE-DCTH'DCT'BASE), DVCLINFOX);          <<*7777>>65086000
   WRITEDEVFILE( DEVTTDT, TDTAB,                               <<*7777>>65088000
           (DCTH'SEGMENT'SIZE - DCTH'TDT'BASE),TTDTINFOX);     <<*7777>>65090000
   WRITEDEVFILE( DEVCSDVR, CSDVR, CSDVRTSIZE, CSDVRINFOX);     <<DEVCO>>65092000
   WRITEDEVFILE( DEVCSDEF, CSDEF, CSDEFSIZE, CSDEFINFOX);      <<DEVCO>>65094000
   WRITEDEVFILE( DEVCSTAB, CSTAB, CSTAB, CSTABINFOX);          <<DEVCO>>65096000
   DEVCHECKSUM := CALCULATECHECKSUM( DEVREC0(1), 127, SEED);   <<DEVCO>>65098000
   FWRITE( DEVFNUM, 0D, DEVREC0, DEVREC0SIZE);                 <<DEVCO>>65100000
   FCLOSE( DEVFNUM);                                           <<DEVCO>>65102000
                                                               <<DEVCO>>65104000
   WRITEDEVTABLE( VTABTSIZE, VTAB, VTABINFOX,                  <<DEVCO>>65106000
      (MVOL+1)*VTABSIZE);                                      <<DEVCO>>65108000
   DISC( SYSDISC, WRITE, COMMSECTOR, COMM, COMMSIZE);                   65110000
          TOS := @CSTAB;                                                65112000
          DLVALUE := S0;                                                65114000
          INFO(INITDL) := TOS;                                          65116000
          IF LOADFROMTAPE THEN                                          65118000
            BEGIN                                                       65120000
              WRITEDEVTABLE(INFO(INITZ), 0, STACKINFOX,        <<01683>>65122000
                INFO(INITZ));  << DB TO Z AREA >>              <<01683>>65124000
            END;                                                        65126000
$PAGE "MAINSEG1  --  SET UP FOR FULL CORE SIZE"                         65128000
          <<-----------------                                           65130000
            COMPRESS TABLES                                             65132000
          ----------------->>                                           65134000
          IF RELOAD AND NUSERFILES<>0 OR                                65136000
          WARMSTART AND RECOVERY THEN                                   65138000
          ELSE INFO(LOADMODE) := 0;                                     65140000
          DISC(WRITE,SYSDISC,D'L(INFOSECTOR)),INFO,INFOSIZE);           65142000
          TL'INCR := -COMM(TLBUFSIZE);                         <<t8392>>65144000
          MOVEDLTABLES;   <<SHRINK TABLE LOOKUP BUFFER>>       <<t8392>>65146000
          OLDINFOINCR := -COMM(OLDINFOSIZE); <<DON'T NEED IT AN<<CONFD>>65148000
          MOVEDLTABLES;  <<SHRINK TABLES>>                              65150000
                                                               <<01683>>65152000
          SEGTINCR := SEGT'SIZE;                               <<03675>>65154000
          MOVEDLTABLES;                                        <<03675>>65156000
        << DIRECTORY DST'S IN DL SO MAY HAVE MOVED >>          <<01683>>65158000
          PUSH(DB);                                                     65160000
          TOS := TOS+@DIR;                                              65162000
          DST(DIRDSTN&LSL(2)+3) := TOS;                                 65164000
          X := X-1;                                                     65166000
          DST(X).(8:8) := TOS;  << HIGH ORDER ADDR >>          <<01756>>65168000
          PUSH(DB);                                                     65170000
          TOS := TOS+@DIRSP;                                            65172000
          DST(DIRSPDSTN&LSL(2)+3) := TOS;                               65174000
          X := X-1;                                                     65176000
          DST(X).(8:8) := TOS;  << HIGH ORDER ADDR >>          <<01756>>65178000
      END <<MAINSEG1B>> ;                                      <<01683>>65180000
$PAGE "MAINSEG2  --  RELOAD USER FILES"                                 65182000
$CONTROL SEGMENT=MAINSEG2                                      <<MPEIV>>65184000
PROCEDURE MAINSEG2;                                            <<32BND>>65186000
BEGIN                                                          <<32BND>>65188000
   DEFINE                                                      <<32BND>>65190000
      IUNIT             = 10#,                                 <<s8967>>65192000
      TAPEBLOCKSIZE     = LBUF(27)#;                           <<32BND>>65194000
   INTEGER POINTER                                             <<32BND>>65196000
      DRIVERENT;                                               <<32BND>>65198000
   LOGICAL                                                     <<32BND>>65200000
      ADCCRESERVED := FALSE,                                   <<32BND>>65202000
      SEEKMASK,                                                <<32BND>>65204000
      DRIVERADR,     << ABS ADR OF CS DRIVER SECT >>           <<32BND>>65206000
      POINTERADR,                                              <<32BND>>65208000
      SECONDPASS;                                              <<32BND>>65210000
   EQUATE                                                      <<32BND>>65212000
      GLINKAGE     = 24, << LOCATION IN GROUP ENTRY >>         <<32BND>>65214000
      GROUPLEVEL   = 1,                                        <<32BND>>65216000
      PV           = 1;                                        <<32BND>>65218000
   DEFINE                                                      <<32BND>>65220000
      TERMTYP     = (0:7)#,                                    <<*LDT*>>65222000
      TERMSPEED   = (10:6)#,                                   <<*LDTX>>65224000
      RUNWAIT     = (0:1)#,      <<DVR REQUIRES IDLE IO PROG>> <<c8392>>65226000
      RUNWAIT'    = (11:1)#,     <<RUNWAIT BIT IN DVR OB>>     <<c8392>>65228000
      PVF         = 0:1 #;                                     <<32BND>>65230000
   BYTE POINTER                                                <<32BND>>65232000
      LCNPTR;                                                  <<32BND>>65234000
   DOUBLE                                                      <<32BND>>65236000
      ILTLOC,         << ABSOLUTE LOCATION OF CURRENT ILT >>   <<32BND>>65238000
      DITLOC,         << ABSOLUTE LOCATION OF CURRENT DIT >>   <<32BND>>65240000
      TABLOC,         << ABSOLUTE ADDRESS OF CURRENT TABLE >>  <<32BND>>65242000
      MEMLOC,         << ABSOLUTE MEMORY LOCATION  >>          <<32BND>>65244000
      WCSADR;         << DISC ADDRESS OF WCS >>                <<32BND>>65246000
   INTEGER                                                     <<32BND>>65248000
      ILTADR    = ILTLOC + 1,                                  <<32BND>>65250000
      DITADR    = DITLOC + 1,                                  <<32BND>>65252000
      TABADR    = TABLOC + 1,                                  <<32BND>>65254000
      TOTILTSIZE,    << TOTAL ILT SIZE >>                      <<32BND>>65256000
      STDADR,        << ABS ADR OF CS STANDARD SECT >>         <<32BND>>65258000
      CONTADR,       << ABS ADR OF CS CONTROL SECT >>          <<32BND>>65260000
      DRIVERDISP,    << DVR SECT DISP OF BASE OF DIT >>        <<32BND>>65262000
      RELPRI,        << RELATIVE PRIORITY >>                   <<32BND>>65264000
      ABSPRI,        << ABSOLUTE PRIORITY >>                   <<32BND>>65266000
      NCHANQ,        << # OF MULTI-CONTROLLER CHANS >>         <<32BND>>65268000
      LCN,                                                     <<32BND>>65270000
      LDEV,                                                    <<32BND>>65272000
      DITSIZE,       << SIZE OF DIT >>                         <<32BND>>65274000
      SIOSIZE,       << SIZE OF SIO PROGRAM >>                 <<32BND>>65276000
      STATSIZE,      << SIZE OF STATUS RETURN AREA >>          <<32BND>>65278000
      CHANNEL,       << SOFTWARE CHANNEL NUMBER >>             <<32BND>>65280000
      UNITN,         << UNIT NUMBER >>                         <<*DVR*>>65282000
      ILTSTART,      << BASE ADDRESS OF ILT >>                 <<32BND>>65284000
      MOVE'LEN,                                                <<32BND>>65286000
      LDTXINDEX,                                               <<32BND>>65288000
      TYPE,           << DEVICE TYPE >>                        <<32BND>>65290000
      SUBTYP,         << DEVICE SUBTYP >>                      <<32BND>>65292000
      DVRINDEX,                                                <<32BND>>65294000
      LCMEDPDMAX,                                              <<32BND>>65296000
      DEFDVRINDEX,                                             <<32BND>>65298000
      CONTSECTSIZE,                                            <<32BND>>65300000
      I,                                                       <<32BND>>65302000
      J,                                                       <<32BND>>65304000
      K,                                                       <<32BND>>65306000
      N,                                                       <<*LDT*>>65308000
      LDT'INDEX,       << INDEX INTO LDT >>                    <<*DVR*>>65310000
      LPDT'INDEX,                                              <<*LDTX>>65312000
      LDTX'INDEX,                                              <<*DVR*>>65314000
      DVR'INDEX;                                               <<*DVR*>>65316000
                                                               <<32BND>>65318000
   << THE FOLLOWING GROUP OF VARIABLES ARE USED TO  >>         <<32BND>>65320000
   << HOLD A DIRECTORY ENTRY - DO NOT DISTURP ORDER >>         <<32BND>>65322000
   DOUBLE                                                      <<32BND>>65324000
      NAM1,                                                    <<32BND>>65326000
      NAM2,                                                    <<32BND>>65328000
      FILEADR;                                                 <<32BND>>65330000
   LOGICAL                                                     <<32BND>>65332000
      FILEADR1 = FILEADR,                                      <<32BND>>65334000
      FILEADR2 = FILEADR+1;                                    <<32BND>>65336000
   INTEGER ARRAY FILENTRY(*) = NAM1;                           <<32BND>>65338000
   BYTE VOLUME = FILEADR;                                      <<32BND>>65340000
                                                               <<32BND>>65342000
   LOGICAL ARRAY DRIV'WNAME(0:3);  << TEMP STORAGE FOR      >> <<zrela>>65344000
   BYTE ARRAY DRIV'BNAME(*) = DRIV'WNAME;<< DRIVER NAME     >> <<*DVR*>>65346000
                                                               <<*DVR*>>65348000
   DOUBLE POINTER                                              <<csdec>>65350000
      DBLPTR;                                                  <<csdec>>65352000
   INTEGER ARRAY              <<STT #'S OF INITIALIZATION>>    <<32BND>>65354000
      INIT'LIZAT'NSTT(0:31),  << ROUTINES OF ADDITIONAL  >>    <<32BND>>65356000
                              << CS DRIVERS              >>    <<32BND>>65358000
      ILT(0:ILTSIZE),         << TEMP BUFFER FOR ILT >>        <<32BND>>65360000
      CHNUMB(0:63) = Q;       << RESOURCE QUEUE # >>           <<32BND>>65362000
                                                               <<03557>>65364000
                                                               <<03557>>65366000
                                                               <<03557>>65368000
          ASSEMBLE( RSW );                                     <<01091>>65370000
          IF TOS.(8:8) <> CLRSW THEN HELP;                     <<02510>>65372000
          CSDRTN := 0;   <<INITIALIZE CSDRTN ARRAY TO ZEROS>>  <<03002>>65374000
          MOVE CSDRTN(1) := CSDRTN,(31);                       <<03002>>65376000
          CHECKMEM;                                                     65378000
          HEADING'PRINTED := FALSE;                            <<01442>>65380000
          IF NOT LOADFROMTAPE THEN                                      65382000
            BEGIN <<UPDATE COLDLOADID IN SYSTEM PROGRAM FILES>>         65384000
            I := 0;                                                     65386000
            DO                                                          65388000
              BEGIN                                                     65390000
              J := FOPEN(PROTECTED(I*8));                               65392000
              TOS := FLAB(FLMISCX);                                     65394000
              TOS.(0:3) := 0;                                           65396000
              TOS.(14:2) := 1; <<OPEN FOR READ>>                        65398000
              FLAB(X) := TOS;                                           65400000
              FLFCBVECT := 0D;                                 <<*FLAB>>65402000
              FLCLID := COLDLOADID;                                     65404000
              CHECKSUM;                                                 65406000
              FLCHECKSUM := TOS;                                        65408000
              FILEADR := FLEXT0;                               <<03603>>65410000
              LDEV := GETLDEV( VOLUME);                        <<03603>>65412000
              IF <> THEN ERRMESSAGE( M452); << DEF FILE LBL >> <<03603>>65414000
              VOLUME := 0;                                     <<03603>>65416000
              DISC( WRITE,LDEV,FILEADR,FLAB,128);              <<03603>>65418000
              FCLOSE(J);                                                65420000
              END                                                       65422000
            UNTIL(I:=I+1) = NPROTECTED;                                 65424000
            END;                                               <<00.EB>>65426000
              MOVE FLAB := ("LOADMAP ","PUB     ","SYS     ",           65428000
                            "MANAGER ","        ");                     65430000
              FLFOPTIONS := 5;                                          65432000
              FLRECSIZE := -128;                               <<00.DL>>65434000
              FLBLKSIZE := 128;                                         65436000
              FLSECTOFF := 1;                                           65438000
              FLNUMEXTS := 0;                                           65440000
              FLFILECODE:=0;                                            65442000
              FLFLIM := 178D;                                  <<00.DL>>65444000
              FLEXTSIZE  := FLLASTEXTSIZE := 30; <<30 SECTORS>><<01734>>65446000
              FLEOF := 54D;                                    <<00.DL>>65448000
              FLAB(46) := 0;                                            65450000
              MOVE FLAB(47) := FLAB(46),(61);                           65452000
              FLEXT0 := -1D; << MAKE NON ZERO FOR FREPLACE>>            65454000
              CHECKSUM;                                        <<03603>>65456000
              FLCHECKSUM := TOS;                               <<03603>>65458000
              MOVE TAPEBUF := FLAB,(128);                      <<03603>>65460000
              FREPLACE(TRUE);                                           65462000
              TOS := FLEXT0;                                            65464000
              S1.(0:8) := 0;                                            65466000
              LOADMAPADR := TOS;                                        65468000
          I := 0;                                              <<03000>>65470000
          DISC(READ,SYSDISC,0D,LBUF,128);                      <<03000>>65472000
          TOS := NR'WCS'FILES;                                 <<03000>>65474000
          WHILE <> DO                                          <<03000>>65476000
             BEGIN                                             <<03000>>65478000
             WCSADR := 0D;                                     <<03000>>65480000
             DIRECFIND(FILETYPE,0,SYSACCT,PUBGRP,WCSNAMES(I),  <<03000>>65482000
                       FILENTRY);                              <<03000>>65484000
             IF = AND FILEADR1.(8:1)  = 0                      <<04545>>65486000
                  AND GETLDEV(VOLUME) = SYSDISC THEN           <<04545>>65488000
                BEGIN                                          <<03000>>65490000
                << READ FILE LABEL >>                          <<03000>>65492000
                DISC(READ,SYSDISC,FILEADR,FLAB,128);           <<03000>>65494000
                IF FLEOF <> 0D THEN                            <<03000>>65496000
                   WCSADR := L'PADR(SYSDISC,                   <<03000>>65498000
                      FLEXT0+DOUBLE(FLSECTOFF));               <<03000>>65500000
                                                               << 9082>>65502000
                flab(flmiscx).( 0:3) := 0;                     << 9082>>65504000
                flab(flmiscx).(14:2) := 0;                     << 9082>>65506000
                IF WCSNAMES(I+4)&CSR(THISCPU) THEN             <<03000>>65508000
                   BEGIN  << PROTECT FILE FROM BEING PURGED >> <<03000>>65510000
                   TOS := FLAB(FLMISCX);                       <<03000>>65512000
                   TOS.(14:2) := 1; << OPEN FOR READ >>        <<03000>>65514000
                   FLAB(X) := TOS;                             <<03000>>65516000
                   END;                                        <<03000>>65518000
                FLFCBVECT := 0D;                               <<*FLAB>>65520000
                FLCLID := COLDLOADID;                          <<03000>>65522000
                CHECKSUM;                                      <<03000>>65524000
                FLCHECKSUM := TOS;                             <<03000>>65526000
                DISC(WRITE,SYSDISC,FLEXT0,FLAB,128);           <<03000>>65528000
                END;                                           <<03000>>65530000
             DISCWCSTAB(WCSNAMES(I+5)) := WCSADR;              <<03000>>65532000
             I := I+6; << NEXT ENTRY >>                        <<03000>>65534000
             TOS := TOS-1;   << COUNTER >>                     <<03000>>65536000
             END;                                              <<03000>>65538000
                                                               <<i9073>>65540000
 << ----------------------------------------------- >>         <<i9073>>65542000
 << If we are loading from a FOS tape, then mark all>>         <<i9073>>65544000
 << unique system program files i.e. currently only >>         <<i9073>>65546000
 << installation files, as protected so they do not >>         <<i9073>>65548000
 << get purged.                                     >>         <<i9073>>65550000
 << ----------------------------------------------- >>         <<i9073>>65552000
                                                               <<i9073>>65554000
 IF LOGICAL(COMM(SERIALDISCLOAD').LOADFOS) THEN                <<i9073>>65556000
    BEGIN                                                      <<i9073>>65558000
    I := 0;                                                    <<i9073>>65560000
                                                               <<i9073>>65562000
    DO BEGIN                                                   <<i9073>>65564000
       DIRECFIND(FILETYPE,0,SYSACCT,PUBGRP,FOSFILES(I*4),      <<i9073>>65566000
                 FILENTRY);                                    <<i9073>>65568000
       IF = AND FILEADR1.(8:1) = 0  THEN                       <<i9073>>65570000
          BEGIN                                                <<i9073>>65572000
          << READ FILE LABEL >>                                <<i9073>>65574000
          DISC(READ, GETLDEV(VOLUME), FILEADR, FLAB, 128);     <<i9073>>65576000
          IF FLEOF <> 0D THEN                                  <<i9073>>65578000
             BEGIN                                             <<i9073>>65580000
             << PROTECT FILE FROM BEING PURGED >>              <<i9073>>65582000
             TOS := FLAB(FLMISCX);                             <<i9073>>65584000
             TOS.(0:3) := 0;                                   <<i9073>>65586000
             TOS.(14:2) := 1; << OPEN FOR READ >>              <<i9073>>65588000
             FLAB(X) := TOS;                                   <<i9073>>65590000
             FLFCBVECT := 0D;                                  <<i9073>>65592000
             FLCLID := COLDLOADID;                             <<i9073>>65594000
             CHECKSUM;                                         <<i9073>>65596000
             FLCHECKSUM := TOS;                                <<i9073>>65598000
             DISC(WRITE,GETLDEV(VOLUME),FLEXT0,FLAB,128);      <<i9073>>65600000
             END;                                              <<i9073>>65602000
          END;                                                 <<i9073>>65604000
        END                                                    <<i9073>>65606000
     UNTIL (I := I+1) = NR'FOSFILES;                           <<i9073>>65608000
     END;                                                      <<i9073>>65610000
                                                               <<i9073>>65612000
          DISC(WRITE,SYSDISC,0D,LBUF,128);                     <<03000>>65614000
          IF RELOAD AND NUSERFILES<>0 THEN                              65616000
            BEGIN  <<RELOAD FILES>>                                     65618000
              MESSAGE(M3055); <<RELOAD USER FILES IN PROGRESS>><<*8392>>65620000
              IF SERIALDISCLOAD AND                            <<03598>>65622000
              SYSTAPETYPE = 2 << FLOPPY DISC >> THEN           <<*LDT*>>65624000
                BEGIN                                          <<00071>>65626000
                IF NOT FUTURE'DATE THEN                        <<03598>>65628000
                BEGIN                                          <<00678>>65630000
                NEXTREEL(LBUF);                                <<00678>>65632000
                COLD'LOAD'MEDIA(FWDSPFILE,,,TRUE);             <<01092>>65634000
                IF < THEN GO TO ABORT;                         <<01092>>65636000
                COLD'LOAD'MEDIA(FWDSPFILE,,,TRUE);             <<01092>>65638000
                IF < THEN GO TO ABORT;                         <<01092>>65640000
                END;                                           <<00678>>65642000
                END;                                           <<00678>>65644000
              NNODISC:=-1;<<# OF FILES WITHOUT DISC SPACE>>    <<00.06>>65646000
              LEN:=COLD'LOAD'MEDIA(READ,LBUF,1024,TRUE); <<READ THE>>   65648000
              <<HEADER RECORD WITH PARITY CHECKING ON>>        <<00.06>>65650000
              IF < THEN                                        <<00.06>>65652000
                BEGIN <<PARITY ERROR>>                         <<00.06>>65654000
                IF LEN = 1 THEN GO TO ABORT;                   <<01092>>65656000
                HEDLABP:=TRUE;<<SIGNAL PARITY ERROR IN>>       <<00.06>>65658000
                <<HEADER LABEL--THIS IMPLIES THAT IT WILL>>    <<00.06>>65660000
                <<NOT BE POSSIBLE TO RECOVER FROM A>>          <<00.06>>65662000
                <<PARITY ERROR IN ANY OF THE TRAILER>>         <<00.06>>65664000
                <<LABELS OF THIS TAPE SET>>                    <<00.06>>65666000
                COLD'LOAD'MEDIA(FWDSPFILE,,,TRUE);             <<01092>>65668000
                <<SKIP EOF AFTER HEADER LABEL>>                <<01092>>65670000
                IF < THEN GO TO ABORT;                         <<01092>>65672000
                GOTO SKIPTONEXT;                               <<00.06>>65674000
                END;                                           <<00.06>>65676000
              IF > THEN                                        <<00.06>>65678000
                BEGIN <<FOUND EOF--NOT HEADER LABEL>>          <<00.06>>65680000
                HEDLABP:=TRUE;<<NOT ABLE TO GET REEL#>>        <<00.06>>65682000
                <<FROM HEADER LABEL, SO TREAT AS A>>           <<00.06>>65684000
                <<PARITY ERROR>>                               <<00.06>>65686000
                GOTO SKIPTONEXT;                               <<00.06>>65688000
                END;                                           <<00.06>>65690000
              IF LEN <> 40 THEN                                <<00.06>>65692000
                BEGIN <<NOT A HEADER LABEL>>                   <<00.06>>65694000
                HEDLABP:=TRUE;                                 <<00.06>>65696000
                COLD'LOAD'MEDIA(FWDSPFILE,,,TRUE);             <<01092>>65698000
                IF < THEN GO TO ABORT;                         <<01092>>65700000
                GOTO SKIPTONEXT;                               <<00.06>>65702000
                END;                                           <<00.06>>65704000
              <<READ A GOOD HEADER LABEL>>                     <<00.06>>65706000
              HEDLABP:=FALSE;<<SIGNAL NO PARITY ERROR>>        <<00.06>>65708000
              <<DURING READING OF THIS HEADER LABEL>>          <<00.06>>65710000
              REEL:=REELNUM;<<INITIALIZE REEL COUNTER>>        <<00.06>>65712000
              MOVE ITMP:=CHDATE,(3);<<INITIALIZE>>             <<00.06>>65714000
      IF TAPEBLOCKSIZE=0 THEN TAPEBLOCKSIZE:=1024;             <<KS.88>>65716000
      RECSIZE:=TAPEBLOCKSIZE; <<SIZE STORE BLOCK SIZE>>        <<KS.88>>65718000
                                                               <<KS.88>>65720000
<< NOW ALLOCATE TEMPORARY BUFFER FOR RESTORE BLOCKS>>          <<KS.88>>65722000
                                                               <<KS.88>>65724000
      PUSH(DL);                                                <<KS.88>>65726000
      TOS:=TOS-RECSIZE;                                        <<KS.88>>65728000
      ASSEMBLE(DUP);                                           <<KS.88>>65730000
      SET(DL);                                                 <<KS.88>>65732000
      @RESTOREBUF:=TOS;                                        <<KS.88>>65734000
      @BRESTOREBUF:=@RESTOREBUF&LSL(1);                        <<KS.88>>65736000
                                                               <<KS.88>>65738000
              <<CREATION DATE>>                                <<00.06>>65740000
              COLD'LOAD'MEDIA(FWDSPFILE,,,TRUE);               <<01092>>65742000
              IF < THEN GO TO ABORT;                           <<01092>>65744000
  SKIPTONEXT:                                                           65746000
              IF NUSERFILES=0 THEN                                      65748000
                BEGIN                                                   65750000
                  COLD'LOAD'MEDIA(REWUNLOAD,,,TRUE);           <<01092>>65752000
                  IF < THEN GO TO ABORT;                       <<01092>>65754000
                  GOTO FINISHEDRELOAD;                                  65756000
                END;                                                    65758000
              READTAPE'(0); <<FORWARD SPACE FILE>>             <<01092>>65760000
              <<FIRST TIME, THIS SKIPS THE (NON-EXISTENT)>>    <<00.06>>65762000
              <<DIRECTORY>>                                    <<00.06>>65764000
              IF < THEN                                        <<00.06>>65766000
                BEGIN <<PARITY ERROR ON LABEL OF NEXT FILE>>   <<00.06>>65768000
                IF LEN = 1 THEN GO TO ABORT;                   <<01092>>65770000
                I:=2; <<PARAMETERS FOR TAPERROR>>              <<00.06>>65772000
         MOVE BLBUF:="NAME    IS      UNKNOWN ";               <<KS.88>>65774000
                                                               <<KS.88>>65776000
                                                               <<KS.88>>65778000
                GOTO TAPERROR;                                 <<00.06>>65780000
                END;                                           <<00.06>>65782000
              IF > THEN                                        <<*9006>>65784000
                 BEGIN   << NO MORE TAPE SETS AVAIL >>         <<*9006>>65786000
                 IF STARTTYPE = CBNEW THEN                     <<*9006>>65788000
                    GO NOLIST                                  <<*9006>>65790000
                 ELSE                                          <<*9006>>65792000
                    GO FPURGE;                                 <<*9006>>65794000
                 END;                                          <<*9006>>65796000
      READTAPE'(RECSIZE); <<NO NEED TO TEST PARITY AS>>        <<KS.88>>65798000
              <<THIS IS A LOGICAL READ ONLY.  THE PHYSICAL>>   <<00.06>>65800000
              <<READ TOOK PLACE IN READTAPE'(0) ABOVE.>>       <<00.06>>65802000
      TOS:=DIRECFIND(GROUPLEVEL&LSL(3),0,RESTOREBUF(8),        <<KS.88>>65804000
             RESTOREBUF(4),RESTOREBUF,BUF);                    <<KS.88>>65806000
                IF < THEN DIRERROR(*,BRESTOREBUF);             <<KS.88>>65808000
              IF > THEN                                        <<RV.PV>>65810000
      IF S0<>2 THEN DIRERROR(*,BRESTOREBUF)                    <<KS.88>>65812000
              ELSE                                             <<RV.PV>>65814000
                 BEGIN <<NOT FOUND>>                           <<RV.PV>>65816000
                 DDEL;                                         <<RV.PV>>65818000
                 GOTO SKIPTONEXT;                              <<RV.PV>>65820000
                 END;  <<NOT FOUND>>                           <<RV.PV>>65822000
              DDEL;                                            <<RV.PV>>65824000
              IF BUF(GLINKAGE).(PVF)=PV THEN                   <<RV.PV>>65826000
                 BEGIN <<GROUP ASSIGNED TO A PV>>              <<RV.PV>>65828000
                 GOTO SKIPTONEXT;                              <<RV.PV>>65830000
                 END;                                          <<RV.PV>>65832000
              <<ONLY FILES FROM GROUPS ASSIGNED TO THE>>       <<RV.PV>>65834000
              <<SYSTEM DOMAIN WILL PASS THIS POINT AND>>       <<RV.PV>>65836000
              <<BE RESTORED>>                                  <<RV.PV>>65838000
      TOS:=DIRECFIND(FILETYPE,0,RESTOREBUF(8),RESTOREBUF(4),   <<KS.88>>65840000
             RESTOREBUF,BUF);                                  <<KS.88>>65842000
      IF < THEN DIRERROR(*,BRESTOREBUF);                       <<KS.88>>65844000
      IF > THEN IF S0<>2 THEN DIRERROR(*,BRESTOREBUF)          <<KS.88>>65846000
              ELSE                                                      65848000
                BEGIN                                                   65850000
                  DDEL;                                                 65852000
                  GO SKIPTONEXT;                                        65854000
                END;                                                    65856000
              DDEL;                                                     65858000
              IF BUF(4).(8:1)<>1 THEN GOTO SKIPTONEXT; <<ALREADY FOUND>>65860000
              NUSERFILES := NUSERFILES-1;                               65862000
      TOS:=DIRECPURGE(FILETYPE,0,RESTOREBUF(8),RESTOREBUF(4),  <<KS.88>>65864000
             RESTOREBUF);                                      <<KS.88>>65866000
      IF <> THEN DIRERROR(*,BRESTOREBUF);                      <<KS.88>>65868000
              DDEL;                                                     65870000
      MOVE FLAB:=RESTOREBUF,(128);  <<COPY FILE LABEL>>        <<KS.88>>65872000
              SECTORS := 0D;                                            65874000
              I := 0;                                                   65876000
              DO                                                        65878000
                BEGIN  <<TOTAL UP SPACE USED>>                          65880000
                  TOS := 0;                                             65882000
                  IF FLABDBL(EXT0+I)=0D THEN TOS := 0                   65884000
                  ELSE TOS := GETEXTLEN(I);  <<EXTENT SIZE>>            65886000
                  ASSEMBLE(DDUP);                                       65888000
                  SECTORS := TOS+SECTORS;                               65890000
                  EXTSIZES(I) := TOS;                                   65892000
                END                                                     65894000
              UNTIL (I:=I+1) > FLNUMEXTS;                               65896000
              FLLASTEXTSIZE:=INTEGER(EXTSIZES(I-1));           <<03597>>65898000
              TOS := 0;  <<FOR SUPERDISCSPACE>>                         65900000
              IF RESTORING THEN                                         65902000
                BEGIN   <<GET LDN OF OLD VOLUME>>                       65904000
                  TOS := @VNAME;                                        65906000
                  TOS := @OLDVTAB(VTABSIZE*BUF(4).(0:8))       <<04306>>65908000
                                                     &LSL(1);  <<04306>>65910000
                  MOVE * := *,(8);                                      65912000
                  I := 0;                                               65914000
                  WHILE (I:=I+1) <= HVOL DO                    <<03550>>65916000
                    BEGIN                                               65918000
                      TOS := @VTAB(I*VTABSIZE)&LSL(1);         <<04306>>65920000
                      IF * = VNAME,(8) THEN                             65922000
                        BEGIN  <<FOUND IT>>                             65924000
                          TOS := VTAB(I*VTABSIZE+VTAB12).VTABLDEV;      65926000
                          GOTO GETSPACE;                                65928000
                        END;                                            65930000
                    END;                                                65932000
                END;                                                    65934000
              TOS := 0;  <<ANY DEVICE OK>>                              65936000
  GETSPACE:                                                             65938000
              LDEV := SUPERDISCSPACE(*,FLNUMEXTS+1,FLAB(28),EXTSIZES,   65940000
                FLABDBL(EXT0));                                         65942000
              IF <> THEN                                                65944000
                BEGIN  <<COULDN'T FIND THE SPACE>>                      65946000
              I := 1; <<INSUFFICIENT DISC SPACE>>                       65948000
  TAPERROR:        <<TAPE PARITY ERROR>>                                65950000
                  NNODISC := NNODISC+1;                                 65952000
              IF = THEN                                                 65954000
               BEGIN                                                    65956000
               << XXX FILES PURGED BECAUSE OF ERRORS - LIST >> <<01103>>65958000
               LISTPURGE := LGETYESNO(M2281);                  <<01103>>65960000
               IF NOT LISTPURGE THEN GO SKIPTONEXT;            <<01103>>65962000
               END;                                                     65964000
         IF LISTPURGE THEN PRINTFNR(BRESTOREBUF,I);            <<KS.88>>65966000
                GOTO SKIPTONEXT;                                        65968000
                END;                                                    65970000
              LDT'INDEX := LDEV * LDTSIZE;                     <<*LDT*>>65972000
              LPDT'INDEX := LDEV * LPDTSIZE;                   <<*LPDT>>65974000
              TOS := LDT'DEVICE'TYPE & LSL(2);                 <<*LDT*>>65976000
              TOS.(4:4) := LPDT'SUBTYPE;                       <<*LPDT>>65978000
              FLAB(28) := TOS;                                          65980000
              FLFCBVECT := 0D;                                 <<*FLAB>>65982000
              FLCLID := COLDLOADID;                                     65984000
     FLAB(108):=FLAB(109):=FLAB(110):=0; <<CLEAR RESTORE DATE>><<00601>>65986000
          CHECKSUM;           <<NEW CHECKSUM>>                          65988000
          FLCHECKSUM := TOS;  <<UPDATE FLAB>>                           65990000
      MOVE RESTOREBUF:=FLAB,(128);                             <<KS.88>>65992000
              TOS := FLEXT0;                                            65994000
              ASSEMBLE(XCH);                                            65996000
              LDT'INDEX := LDEV * LDTSIZE;                     <<*LDT*>>65998000
              TOS.(0:8) := LDT'VOLUME'TBL'INDEX;               <<*LDT*>>66000000
              ASSEMBLE(XCH);                                            66002000
              DTEMP := TOS;                                             66004000
              TOS := DIRECINSERTFILE(SECTORS,FLAB(8),FLAB(4),FLAB,      66006000
                DTEMP);                                                 66008000
              IF <> THEN DIRERROR(*,BFLAB);                             66010000
              DDEL;                                                     66012000
              IF FLFOPTIONS.(8:2)<>1 THEN                               66014000
                BEGIN  <<FIXED OR UNDEFINED RECORDS>>                   66016000
                  TOS := FLEOF;                                         66018000
                  TOS := FLBLKSIZE;                                     66020000
                  TOS := FLRECSIZE;                                     66022000
                  IF = THEN TOS := TOS+128                              66024000
                  ELSE IF < THEN TOS := (-TOS+1)&LSR(1);                66026000
                  ASSEMBLE(DIV,DEL);                                    66028000
                  X := TOS;                                             66030000
                  ASSEMBLE(ZERO,CAB; LDXA,LDIV; CAB,LDXA; LDIV);        66032000
                  IF TOS<>0 THEN TOS := TOS+1D;                         66034000
                  X := (FLBLKSIZE+127)&LSR(7);                          66036000
                  ASSEMBLE(LDXA,LMPY; CAB,LDXA; MPY,ZERO; DADD,ZERO);   66038000
                  TOS := FLSECTOFF;                                     66040000
                  ASSEMBLE(DADD);                                       66042000
                  SECTORS := TOS;                                       66044000
                END;                                                    66046000
              NBLKS := LEN&LSR(7);                                      66048000
              BLOCKSWRITTEN := 0;                                       66050000
              I := 0;                                                   66052000
              DO                                                        66054000
                BEGIN  <<COPY FILE PER EXTENT>>                         66056000
                  @ENTRE := @FLEXTMAP+I&LSL(1);                         66058000
                  TOS := ENTRE0.(0:8);                                  66060000
                  X := TOS*VTABSIZE+VTAB12;                             66062000
                  LDEV := VTAB(X).VTABLDEV;                             66064000
                  TOS := SECTORS;                                       66066000
                  TOS := 0;                                             66068000
                  TOS := FLEXTSIZE;                                     66070000
                  ASSEMBLE(DSUB);                                       66072000
                  IF < THEN                                             66074000
                    BEGIN  <<LAST EXTENT>>                              66076000
                      CNT := INTEGER(SECTORS);                          66078000
                      DDEL;                                             66080000
                      SECTORS := 0D;                                    66082000
                    END                                                 66084000
                  ELSE                                                  66086000
                    BEGIN                                               66088000
                      CNT := FLEXTSIZE;                                 66090000
                      SECTORS := TOS;                                   66092000
                    END;                                                66094000
                  IF ENTRE=0D THEN GO NULLEXT;                          66096000
                  NN := 0;                                              66098000
                  WHILE NN<CNT DO                                       66100000
                    BEGIN                                               66102000
                      IF BLOCKSWRITTEN=NBLKS THEN                       66104000
                        BEGIN  <<READ NEXT RECORD>>                     66106000
                          READTAPE'(RECSIZE);                  <<01092>>66108000
                          IF < THEN GO TO REMOVE'FILE;         <<01092>>66110000
                          IF (LEN MOD 128)<>0 THEN             <<01092>>66112000
                            GO TO REMOVE'FILE;                 <<01092>>66114000
                          NBLKS := LEN&LSR(7);                          66116000
                          BLOCKSWRITTEN := 0;                           66118000
                        END;                                            66120000
                      SECTORSLEFT := CNT-NN;                            66122000
                      MM := NBLKS-BLOCKSWRITTEN;                        66124000
                      IF SECTORSLEFT < MM THEN MM:=SECTORSLEFT;         66126000
                      TOS := 0;                                         66128000
                      TOS := NN;                                        66130000
                      TOS := TOS + ENTRE;                               66132000
                      S1.(0:8) := 0;                                    66134000
                      DTEMP := TOS;                                     66136000
            DISC(WRITE,LDEV,DTEMP,                             <<KS.88>>66138000
                 RESTOREBUF(BLOCKSWRITTEN&LSL(7)),             <<KS.88>>66140000
                        MM&LSL(7));                                     66142000
                      BLOCKSWRITTEN := BLOCKSWRITTEN+INTEGER(MM);       66144000
                      NN := NN+MM;                                      66146000
                    END;                                                66148000
  NULLEXT:        I := I+1;                                             66150000
                END                                                     66152000
              UNTIL SECTORS=0D OR I > FLNUMEXTS;                        66154000
              IF SECTORS<>0D THEN GO TO REMOVE'FILE;           <<01092>>66156000
              GOTO SKIPTONEXT;                                          66158000
                                                               <<01092>>66160000
REMOVE'FILE:                                                   <<01092>>66162000
    SECTORS := DOUBLE(I:=0);                                   <<01092>>66164000
    DO                                                         <<01092>>66166000
      BEGIN  << RETURN ALLOCATED SPACE >>                      <<01092>>66168000
        IF EXTSIZES (I) <> 0D THEN                             <<01092>>66170000
           Return'Disc'Space (ldev, flabdbl(ext0+i),           <<03551>>66172000
                              extsizes(i));                    <<03551>>66174000
        SECTORS := SECTORS + EXTSIZES(I)                       <<01092>>66176000
      END                                                      <<01092>>66178000
    UNTIL (I:=I+1) > FLNUMEXTS;                                <<01092>>66180000
    MOVE RESTOREBUF: = FLAB, (12);  << F.G.A >>                <<01092>>66182000
    TOS := 0D;     <<RETURN VALUE>>                            <<01092>>66184000
    TOS := SECTORS;  << DIR ACCOUNTING >>                      <<01092>>66186000
    TOS := DIRECPURGEFILE(*, *, FLAB(8), FLAB(4), FLAB);       <<01092>>66188000
    IF <> THEN DIRERROR(*, BRESTOREBUF);                       <<01092>>66190000
    DDEL;                                                      <<01092>>66192000
    IF LEN = 1 OR (LEN MOD 128) <> 0 THEN                      <<01122>>66194000
      BEGIN                                                    <<01122>>66196000
        MESSAGE(M375);                                         <<01122>>66198000
        GO TO ABORT;                                           <<01122>>66200000
      END;                                                     <<01122>>66202000
    I := 2;  << TAPE PARITY ERROR >>                           <<01092>>66204000
    GO TO TAPERROR;  << REPORT & SKIP FILE >>                  <<01092>>66206000
                                                               <<01092>>66208000
ABORT:                                                         <<01092>>66210000
          COLD'LOAD'MEDIA(REWUNLOAD,,,TRUE);                   <<01122>>66212000
          MESSAGE(M2283); << RELOAD OF USER FILES ABORTED >>   <<01103>>66214000
  FPURGE: LISTPURGE := FALSE;                                           66216000
           GETYESNO(@NOLIST,M2278,NUSERFILES);<<FILES NOT FOUND<<01103>>66218000
          LISTPURGE := TRUE;                                            66220000
          MESSAGE(M2277);<<FOLLOWING FILES PURGE - NOT FOUND>> <<01103>>66222000
  NOLIST: BUF := NUSERFILES;                                            66224000
              TOS := DIRECSCAN (%120,0,NULLNAME,NULLNAME,      <<RV.PV>>66226000
                                NULLNAME,FILEPURGE,BUF);       <<RV.PV>>66228000
              IF <> THEN DIRERROR(*,BBUF);                              66230000
              DDEL;                                                     66232000
  FINISHEDRELOAD:                                                       66234000
              INFO(LOADMODE) := 0;                                      66236000
              DISC(WRITE,SYSDISC,D'L(INFOSECTOR)),INFO,INFOSIZE);       66238000
              MESSAGE(M3056); <<RELOAD USER FILES COMPLETE>>   <<*8392>>66240000
                END;                                                    66242000
                                                               <<KS.88>>66244000
<< DELETE RESTORE TAPE BUFFERS >>                              <<KS.88>>66246000
                                                               <<KS.88>>66248000
   IF @RESTOREBUF<>0 THEN                                      <<KS.88>>66250000
   BEGIN                                                       <<KS.88>>66252000
      PUSH(DL);                                                <<KS.88>>66254000
      TOS:=TOS+RECSIZE; <<DEALLOCATE DL-DB BUFFER>>            <<KS.88>>66256000
      SET(DL);                                                 <<KS.88>>66258000
   END;                                                        <<KS.88>>66260000
          <<-------------------------->>                       <<SD.00>>66262000
          <<DELETE SERIAL DISC BUFFERS>>                       <<SD.00>>66264000
          <<-------------------------->>                       <<SD.00>>66266000
   RECBUFINCR := -RECBUFLEN;                                   <<zrela>>66268000
   TZTBUFINCR := -TZTBUFLEN;                                   <<zrela>>66270000
   MOVEDLTABLES;                                               <<zrela>>66272000
   PUSH(DB);                                                   <<zrela>>66274000
   TOS := TOS + @DIR;                                          <<zrela>>66276000
   DST(DIRDSTN & LSL(2) + 3) := TOS;                           <<zrela>>66278000
   PUSH(DB);                                                   <<zrela>>66280000
   TOS := TOS + @DIRSP;                                        <<zrela>>66282000
   DST(DIRSPDSTN & LSL(2) + 3) := TOS;                         <<zrela>>66284000
$PAGE "MAINSEG2  --  CORE RESIDENT TABLE SETUP"                         66286000
   <<--------------->>                                         <<32BND>>66288000
   <<   CORE SIZE   >>                                         <<32BND>>66290000
   <<--------------->>                                         <<32BND>>66292000
                                                               <<32BND>>66294000
   INSERTDST(0D,COREDSTN,CTAB0(CORESIZE)&LSL(2),0);            <<32BND>>66296000
                                                               <<32BND>>66298000
          <<----------------------                                      66300000
            BUILD CS DRIVER TABLE                                       66302000
          ----------------------->>                                     66304000
          CSDVRAREASIZE := 0;                                           66306000
          PUSH(DL);                                                     66308000
          @CSDVRAREA := TOS;  <<PTR TO DRIVER TABLE WORK AREA>>         66310000
          CSTAB(DRIVERENTNUM) := 0;                                     66312000
          IF CSPRESENT THEN FORMATCSDVRENTRY(CSDUMMY); <<FOR CSDUMMY>>  66314000
          DRTN := LOWESTDRT;                                   <<00888>>66316000
          DO                                                            66318000
            BEGIN  <<ADD DRIVER FOR EACH CONFIGURED LINE TO TABLE>>     66320000
              LDEV := 2;                                                66322000
              DO                                               <<*LDT*>>66324000
                BEGIN                                          <<*LDT*>>66326000
                LDT'INDEX := LDEV * LDTSIZE;                   <<*LDT*>>66328000
                DVR'INDEX := LDEV * DVRSIZE;                   <<*DVR*>>66330000
                IF DVRDRTNUM = DRTN                            <<*DVR*>>66332000
                 AND CSDEV17 <=                                <<03002>>66334000
                LDT'DEVICE'TYPE <= CSDEV19 THEN                <<*LDT*>>66336000
                BEGIN  << CS DEVICE >>                                  66338000
                  MOVE DRIV'WNAME := DVRNAME,(4);              <<*DVR*>>66340000
                  TOS := CSDRTN(DRTN.(0:12));                           66342000
                  X := DRTN.(12:4);                                     66344000
                  ASSEMBLE(TSBC 0,X);     <<SET CS BIT>>                66346000
                  CSDRTN(DRTN.(0:12)) := TOS;                           66348000
                  I := 0;                                               66350000
                  @DRIVERENTRY := @CSDVRAREA;                           66352000
                  WHILE (I:=I+1)<=CSTAB(DRIVERENTNUM) DO                66354000
                    BEGIN  <<CHECK FOR ALREADY IN TABLE>>               66356000
                      IF COMPARE'WORDS(DRIV'WNAME,DRNAME,4)    <<*DVR*>>66358000
                        THEN GOTO NEXTCSDRT;                   <<*DVR*>>66360000
                      @DRIVERENTRY := @DRIVERENTRY+DRIVERENTRY;         66362000
                    END;                                                66364000
                  FORMATCSDVRENTRY(DRIV'BNAME);                <<*DVR*>>66366000
                END                                                     66368000
                END                                            <<*LDT*>>66370000
              UNTIL (LDEV:=LDEV+1)>HLDEV;                               66372000
  NEXTCSDRT:END                                                         66374000
          UNTIL (DRTN := DRTN+1) > HIDRT;                      <<02707>>66376000
          INIT'LIZAT'NSTT := 0;                                <<00.06>>66378000
          MOVE INIT'LIZAT'NSTT(1) := INIT'LIZAT'NSTT,(31);     <<00.06>>66380000
          I := -1;                                             <<00.06>>66382000
          WHILE(I:=I+1) < COMM(NUMADVRS) DO                    <<CONFD>>66384000
            BEGIN <<ADD ADDITIONAL CS DRIVERS TO TABLE>>       <<00.06>>66386000
            TOS := 0;  <<FOR PROCEDURE RETURN>>                <<00.06>>66388000
            TOS := @CSDVR(I*CSDVRSIZE)&LSL(1);                 <<04306>>66390000
            INIT'LIZAT'NSTT(I) := FORMATCSDVRENTRY(*);         <<00.06>>66392000
            END;                                               <<00.06>>66394000
   <<--------------------------------->>                       <<32BND>>66396000
   <<   INITIALIZE TEMPROARY TABLES   >>                       <<32BND>>66398000
   <<--------------------------------->>                       <<32BND>>66400000
                                                               <<32BND>>66402000
   NPROCQ := 0;   <<# OF TYPE 2 PROCESSES>>                    <<32BND>>66404000
   NCNTRLQ := 0;  <<# OF MULTI-UNIT CONTROLLERS>>              <<32BND>>66406000
   NIOPROC := 0;  <<# OF I/O PROCESSES>>                       <<32BND>>66408000
   NDLT := 0;     <<# OF ENTRIES IN DLT>>                      <<32BND>>66410000
   NCHANQ := 0;   <<# OF MULTI-CONTROLLER CHANNELS>>           <<32BND>>66412000
   PUSH(DL);                                                   <<32BND>>66414000
   TOS := TOS-HLDEV*IOPROCSIZE;                                <<32BND>>66416000
   @IOPROC := S0;   <<PTR TO I/O PROCESS TABLE>>               <<32BND>>66418000
   TOS := TOS-HLDEV*INTRSIZE;                                  <<32BND>>66420000
   @INTR := S0&LSL(1);                                         <<32BND>>66422000
   TEMP := IF HLDEV > 256 THEN 256 ELSE HLDEV;                 <<zrela>>66424000
   TOS := TOS-(TEMP+COMM(NUMADVRS))*DLTSIZE;                   <<CONFD>>66426000
   @DLT' := TOS;   <<PTR TO TEMPORARY DRIVER LINKAGE TABLE>>   <<32BND>>66428000
   DLSIZE( @CSDVRAREA-@DLT');                                  <<32BND>>66430000
                                                               <<32BND>>66432000
   <<------------------------------->>                         <<32BND>>66434000
   <<   BUILD TABLES IN DRT ORDER   >>                         <<32BND>>66436000
   <<------------------------------->>                         <<32BND>>66438000
                                                               <<32BND>>66440000
   ILTSTART := ADDRESS;                                        <<32BND>>66442000
   DRTN := LOWESTDRT;                                          <<32BND>>66444000
                                                               <<32BND>>66446000
   DO BEGIN                                                    <<32BND>>66448000
      FIRST := TRUE;  <<FIRST LDEV FOR THIS DRT>>              <<32BND>>66450000
      SECONDPASS := FALSE;                                     <<32BND>>66452000
STARTPASS:                                                     <<32BND>>66454000
      LDEV := 1;                                               <<32BND>>66456000
      DO                                                       <<*DVR*>>66458000
        BEGIN                                                  <<*DVR*>>66460000
        DVR'INDEX := LDEV * DVRSIZE;                           <<*DVR*>>66462000
        IF DVRDSBIT = 1 <<DS DEV>>                             <<*DVR*>>66464000
         AND SECONDPASS OR                                     <<32BND>>66466000
         DVRDRTNUM = DRTN                                      <<*DVR*>>66468000
         AND NOT(SECONDPASS) THEN                              <<32BND>>66470000
         BEGIN<<MAY BE DEVICE ON THIS CONTROLLER>>             <<32BND>>66472000
         IF SECONDPASS THEN                                    <<32BND>>66474000
            BEGIN                                              <<32BND>>66476000
            DVR'INDEX := DVRMASTERLDEV * DVRSIZE;              <<*DVR*>>66478000
            DRTN := DVRDRTNUM;                                 <<*DVR*>>66480000
            DVR'INDEX := LDEV * DVRSIZE;                       <<*DVR*>>66482000
            END;                                               <<32BND>>66484000
         UNITN := DVRUNITNUM;   <<UNIT #>>                     <<*DVR*>>66486000
         MOVE DRIV'WNAME := DVRNAME,(4);                       <<*DVR*>>66488000
         LDT'INDEX := LDEV * LDTSIZE;                          <<*LDT*>>66490000
         LPDT'INDEX := LDEV * LPDTSIZE;                        <<*LPDT>>66492000
         TYPE := LDT'DEVICE'TYPE;                              <<*LDT*>>66494000
         SUBTYP := LPDT'SUBTYPE;                               <<*LPDT>>66496000
         DVRFNUM := FOPEN(DRIV'BNAME);  <<OPEN DRIVER FILE>>   <<*DVR*>>66498000
         FREAD(DVRFNUM,0D,REC0,128);  <<RECORD ZERO>>          <<32BND>>66500000
         FREAD(DVRFNUM,D'L(REC0(3))),DBINFO,384);  <<DB AREA>> <<32BND>>66502000
         RESIDENT := LOGICAL(DBINFO.CORERES) LOR LOGICAL(      <<32BND>>66504000
           DVRCORERES);                                        <<*DVR*>>66506000
         DITSIZE := DBINFO.(0:8);  <<SIZE OF DIT AREA>>        <<32BND>>66508000
         STATSIZE := DBINFO(DVRDB3).STRETSIZE;                 <<32BND>>66510000
           <<SIZE OF STATUS RETURN AREA>>                      <<32BND>>66512000
         TOS := DVRFNUM;                                       <<32BND>>66514000
         TOS := 0;                                             <<32BND>>66516000
         TOS := REC0(10);  <<ENTRY POINT>>                     <<32BND>>66518000
         TOS := 128;                                           <<32BND>>66520000
         ASSEMBLE(DIV);                                        <<32BND>>66522000
         INDEX := TOS;   <<POSITION IN BUFFER>>                <<32BND>>66524000
         TOS := TOS+REC0(4);  <<CODE SEG RECORD #>>            <<32BND>>66526000
         FREAD(*,*,OBINFO,256);  <<OUTER BLOCK CODE>>          <<32BND>>66528000
                                                               <<32BND>>66530000
         <<--------------->>                                   <<32BND>>66532000
         <<   BUILD ILT   >>                                   <<32BND>>66534000
         <<--------------->>                                   <<32BND>>66536000
                                                               <<32BND>>66538000
         IF NOT SECONDPASS THEN                                <<32BND>>66540000
          IF FIRST THEN                                        <<32BND>>66542000
             BEGIN  <<CREATE ILT>>                             <<32BND>>66544000
             ZEROBUF( ILT, ILTSIZE);                           <<32BND>>66546000
             SEEKMASK := 0;                                    <<32BND>>66548000
             ILT(ICNTRL).DRTN' := DRTN;                        <<32BND>>66550000
             IF NOT(CSDEV) THEN                                <<32BND>>66552000
                BEGIN <<NOT CS DEVICE>>                        <<32BND>>66554000
                ILT(IUNIT):=DBINFO(DVRDB2);                    <<32BND>>66556000
                  << UNIT EXTRACT INFO >>                      <<32BND>>66558000
                ILT(IFLAG).RUNWAIT := DBINFO.RUNWAIT';         <<32BND>>66560000
                TOS := DBINFO(DVRDB3).SIOPSIZE;                <<32BND>>66562000
                  <<SIO PROG SIZE>>                            <<32BND>>66564000
                SIOSIZE := S0&LSL(1);                          <<32BND>>66566000
                ILT(IQUEUE).SIOPSIZE := TOS;                   <<32BND>>66568000
                CHANNEL:=DVRCHANNUM;       <<CHANNEL #>>       <<*DVR*>>66570000
                I := 1;                                        <<32BND>>66572000
                N := UNITN; <<WILL HOLD HIGHEST UNIT #>>       <<*DVR*>>66574000
                K := 0;  <<# OF DEVICES ON CONTROLLER>>        <<32BND>>66576000
                                                               <<32BND>>66578000
                DO                                             <<*DVR*>>66580000
                  BEGIN                                        <<*DVR*>>66582000
                  DVR'INDEX := I * DVRSIZE;                    <<*DVR*>>66584000
                  IF DVRDRTNUM = DRTN THEN                     <<*DVR*>>66586000
                    BEGIN  <<DEVICE ON THIS CONTROLLER>>       <<*DVR*>>66588000
                    TOS := DVRUNITNUM;                         <<*DVR*>>66590000
                    LDTX'INDEX := I * LDTXSIZE;                <<*DVR*>>66592000
                    IF LDTX'SEEK'AHEAD = 1 THEN                <<*DVR*>>66594000
                      BEGIN                                    <<32BND>>66596000
                      X := S0;                                 <<32BND>>66598000
                      TOS := SEEKMASK;                         <<32BND>>66600000
                      ASSEMBLE(TSBC 0, X);                     <<32BND>>66602000
                      SEEKMASK := TOS;                         <<32BND>>66604000
                      END;                                     <<32BND>>66606000
                    J := 0;                                    <<*DVR*>>66608000
                    WHILE (J:=J+1) < I DO                      <<*DVR*>>66610000
                      BEGIN                                    <<*DVR*>>66612000
                      DVR'INDEX := J * DVRSIZE;                <<*DVR*>>66614000
                      IF DVRDRTNUM = DRTN                      <<*DVR*>>66616000
                         AND DVRUNITNUM = S0                   <<*DVR*>>66618000
                         THEN GOTO SAMEDU;                     <<32BND>>66620000
                      END;                                     <<*DVR*>>66622000
                   K := K+1;                                   <<32BND>>66624000
SAMEDU:            IF S0>N THEN N := TOS ELSE DEL;             <<32BND>>66626000
                   END                                         <<32BND>>66628000
                ELSE                                           <<32BND>>66630000
                   IF CHANNEL <> 0 AND DVRCHANNUM              <<*DVR*>>66632000
                      =CHANNEL THEN                            <<32BND>>66634000
                      BEGIN <<MULTI-CONTROLLER CHANNEL>>       <<32BND>>66636000
                      ILT(ICNTRL).MCHAN := 1;                  <<32BND>>66638000
                      X := 0;                                  <<32BND>>66640000
                      WHILE (X:=X+1)<=NCHANQ DO                <<32BND>>66642000
                         IF CHNUMB(X)=CHANNEL THEN             <<32BND>>66644000
                            BEGIN<<QUEUE ALREADY RESERVED>>    <<32BND>>66646000
                                 <<           FOR CHANNEL>>    <<32BND>>66648000
                            TOS := X;                          <<32BND>>66650000
                            GO SETCHANQUE;                     <<32BND>>66652000
                            END;                               <<32BND>>66654000
                      TOS := NCHANQ+1;                         <<32BND>>66656000
                      NCHANQ := S0;                            <<32BND>>66658000
                      X := S0;                                 <<32BND>>66660000
                      CHNUMB(X) := CHANNEL;                    <<32BND>>66662000
SETCHANQUE:           ILT(ICNTRL).CHANQUE := TOS;              <<32BND>>66664000
                      END;                                     <<*DVR*>>66666000
                  END                                          <<*DVR*>>66668000
                UNTIL (I:=I+1) > HLDEV;                        <<32BND>>66670000
                                                               <<32BND>>66672000
                IF K<>1 AND DBINFO(ILTSIZE).TERM'=0 THEN       <<32BND>>66674000
                   BEGIN<<MULTI-UNIT, NON-TERMINAL CONTROLLER>><<32BND>>66676000
                   TOS := NCNTRLQ+1; <<# OF MULTI-UNIT CNTRLS>><<32BND>>66678000
                   NCNTRLQ := S0;                              <<32BND>>66680000
                   ILT(IQUEUE).CNTRLRQ := TOS; <<REL Q #>>     <<32BND>>66682000
                   END;                                        <<32BND>>66684000
                ILT(IFLAG).HCUNIT:=N; <<SET>>                  <<32BND>>66686000
                <<HIGHEST CONFIGURED UNIT #>>                  <<32BND>>66688000
                INTHS'UNITS(DRTN) := N+1; <<MAX UNITS>>        <<32BND>>66690000
                TOTILTSIZE := ILTSIZE+STATSIZE+SIOSIZE+N+1;    <<32BND>>66692000
                IF TYPE = 0 << MH DISC >> OR                   <<*LDT*>>66694000
                   TYPE = 1 << FH DISC >> THEN                 <<*LDT*>>66696000
                   TOTILTSIZE := TOTILTSIZE + DVR'GLOBAL'VARS; <<32BND>>66698000
                ILTLOC := INITTABLE(TOTILTSIZE,1,BANK0ONLY,    <<32BND>>66700000
                   FALSE,ILTDSTN);                             <<32BND>>66702000
                I := ILTADR-SYSBASE+ILTSIZE+N+1;               <<32BND>>66704000
                ILT(ISTAP) := IF STATSIZE=0 THEN 0 ELSE I;     <<32BND>>66706000
                I := I + STATSIZE;                             <<32BND>>66708000
                IF TYPE = 0 << MH DISC >> OR                   <<*LDT*>>66710000
                   TYPE = 1 << FH DISC >> THEN                 <<*LDT*>>66712000
                   I := I + DVR'GLOBAL'VARS;                   <<32BND>>66714000
                ILT(ISIOP) := I;                               <<32BND>>66716000
                MTDS( ILTDSTN, I+SYSBASE-ILTADR,               <<32BND>>66718000
                   DBINFO(DITSIZE+DVRDB4), SIOSIZE);           <<32BND>>66720000
                IF TYPE = 0 << MH DISC >> OR                   <<*LDT*>>66722000
                   TYPE = 1 << FH DISC >>  THEN                <<*LDT*>>66724000
                   ABS(ILT(ISIOP)-1+SYSBASE) := SEEKMASK;      <<32BND>>66726000
                END                                            <<32BND>>66728000
             ELSE                                              <<32BND>>66730000
                BEGIN <<CS DEVICE>>                            <<32BND>>66732000
                RESIDENT := 0;                                 <<32BND>>66734000
                ILTLOC := INITTABLE( ILTSIZE+1, 1, BANK0ONLY,  <<32BND>>66736000
                   FALSE, ILTDSTN);                            <<32BND>>66738000
                INTHS'UNITS(DRTN) := 1;                        <<32BND>>66740000
                END;                                           <<32BND>>66742000
            PUTDRT( DRTN, DBI, ILTADR); <<ADDR OF ILT>>        <<CSDEV>>66744000
            MTDS( ILTDSTN, 0, ILT, ILTSIZE);                   <<CSDEV>>66746000
            END                                                <<32BND>>66748000
         ELSE                                                  <<32BND>>66750000
            BEGIN  << --- NOT FIRST --- >>                     <<32BND>>66752000
            I := 0;                                            <<32BND>>66754000
            WHILE (I:=I+1) < LDEV DO                           <<32BND>>66756000
               BEGIN                                           <<32BND>>66758000
               DVR'INDEX := I * DVRSIZE;                       <<*DVR*>>66760000
               IF DVRDRTNUM = DRTN AND                         <<*DVR*>>66762000
                  DVRUNITNUM = UNITN THEN                      <<*DVR*>>66764000
                  BEGIN   <<SAME DRT AND UNIT>>                <<32BND>>66766000
                  LPDT'INDEX := I * LPDTSIZE;                  <<*LPDT>>66768000
                  TOS := LPDT'DIT'PTR;                         <<*LPDT>>66770000
                  LPDT'INDEX := LDEV * LPDTSIZE;               <<*LPDT>>66772000
                  LPDT'DIT'PTR := TOS;                         <<*LPDT>>66774000
                  LPDT'VIRTUAL'DEVICE := 0;                    <<*LPDT>>66776000
                  IF CSDEV THEN                                <<32BND>>66778000
                     BEGIN    << UPDATE CSTAB >>               <<32BND>>66780000
                     LDTXINDEX := CSDEF(I);                    <<32BND>>66782000
                     @CSLDTX := @CSTAB(7);                     <<32BND>>66784000
                     J := -1;                                  <<32BND>>66786000
                     WHILE(J:=J+1)<LDTXINDEX DO                <<32BND>>66788000
                        @CSLDTX := @CSLDTX+CSLDTX;             <<32BND>>66790000
                     TOS := CSLDTXDRINDEX;                     <<32BND>>66792000
                     LDTXINDEX := CSDEF(LDEV);                 <<32BND>>66794000
                     J := -1;                                  <<32BND>>66796000
                     @CSLDTX := @CSTAB(7);                     <<32BND>>66798000
                     WHILE(J:=J+1)<LDTXINDEX DO                <<32BND>>66800000
                        @CSLDTX := @CSLDTX+CSLDTX;             <<32BND>>66802000
                     CSLDTXLDEV := LDEV;                       <<32BND>>66804000
                     CSLDTXDRINDEX:= TOS;                      <<32BND>>66806000
                     GOTO NEXTLDEV;                            <<32BND>>66808000
                     END                                       <<32BND>>66810000
                  ELSE                                         <<32BND>>66812000
                     << DON'T BUILD NEW DIT FOR DISCS >>       <<32BND>>66814000
                     IF TYPE&LSR(3) = DIRACCESS THEN           <<32BND>>66816000
                        GOTO NEXTLDEV                          <<32BND>>66818000
                  ELSE                                         <<32BND>>66820000
                     GOTO CONSOLCHECK;                         <<32BND>>66822000
                  END;                                         <<32BND>>66824000
               END;                                            <<32BND>>66826000
            END;                                               <<32BND>>66828000
                                                               <<32BND>>66830000
CONSOLCHECK:                                                   <<32BND>>66832000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<32BND>>66834000
         <<------------------------------------------->>       <<32BND>>66836000
         <<   BUILD TERMINAL INITIALIZATION PROGRAM   >>       <<32BND>>66838000
         <<------------------------------------------->>       <<32BND>>66840000
                                                               <<32BND>>66842000
         LDTX'INDEX := LDEV * LDTXSIZE;                        <<*LDTX>>66844000
         DVR'INDEX  := LDEV * DVRSIZE;                         <<*DVR*>>66846000
         IF NOT ADCCRESERVED THEN  << NOT DONE YET >>          <<32BND>>66848000
            IF DVRDSBIT = 0 THEN                               <<*DVR*>>66850000
               IF (TYPE = 16 << TERMINAL >>  LOR               <<*LDT*>>66852000
                   TYPE = 32 << PRINTER >> LAND                <<*LDT*>>66854000
                  (SUBTYP=14 LOR SUBTYP=15))                   <<32BND>>66856000
                  AND (LDTX'TERMID <> LYNX'BOARD) AND          <<08392>>66858000
                      (LDTX'TERMID <> TIC'BOARD) THEN          <<08392>>66860000
                  BEGIN                                        <<32BND>>66862000
                  << IF THERE IS AT LEAST ONE ADCC-        >>  <<32BND>>66864000
                  << CONNECTED PORT CONFIGURED, SAVE ROOM  >>  <<32BND>>66866000
                  << FOR CHANNEL PROGRAMS OF PRINTCHAR AND >>  <<32BND>>66868000
                  << READCHAR OF HARDRES.  ALSO SAVE SPACE >>  <<32BND>>66870000
                  << FOR ADCC TERMINAL INIT. CHANNEL PROG, >>  <<32BND>>66872000
                  << WHICH EXISTS IN ONLY ONE PLACE        >>  <<32BND>>66874000
                  INITTABLE(HARDRES'SIOAREA,1,BANK0ABOVE,0);   <<32BND>>66876000
                                                               <<32BND>>66878000
                  IF INITTCP'>384<<SIZE OF DBINFO ARRAY>>      <<32BND>>66880000
                     THEN ERRMESSAGE(M251);                    <<32BND>>66882000
                  <<TERMINAL SIOPROG IS TOO LARGE!>>           <<32BND>>66884000
                  <<CAN'T EVEN GET TO INITPROG SIZEWORD>>      <<32BND>>66886000
                  J := DBINFO(INITTCP'-1);                     <<32BND>>66888000
                  TABLOC := INITTABLE(J, 1, BANK0ABOVE,        <<32BND>>66890000
                              FALSE, TEMPDSTN);                <<32BND>>66892000
                  ABSOLUTE(INITTCP):=TABADR-SYSBASE;           <<32BND>>66894000
                  I := 384-(INITTCP');                         <<32BND>>66896000
                  MTDS( TEMPDSTN, 0, DBINFO(INITTCP'), I);     <<32BND>>66898000
                  J := J-I; << AMOUNT LEFT >>                  <<32BND>>66900000
                  IF J > 384 THEN ERRMESSAGE(M250);            <<32BND>>66902000
                  <<INITPROG CAN'T EXTEND INTO DBREC6>>        <<32BND>>66904000
                  IF J > 0 THEN                                <<32BND>>66906000
                     BEGIN <<GET REST FROM DBREC3-5>>          <<32BND>>66908000
                     FREAD(DVRFNUM,D'L(REC0(3)+3)),            <<32BND>>66910000
                        DBINFO,384);                           <<32BND>>66912000
                     MTDS( TEMPDSTN, I, DBINFO, J);            <<32BND>>66914000
                     FREAD(DVRFNUM,D'L(REC0(3))),              <<32BND>>66916000
                        DBINFO,384);                           <<32BND>>66918000
                     END;                                      <<32BND>>66920000
                  ADCCRESERVED := TRUE; <<DON'T DO AGAIN>>     <<32BND>>66922000
                  END;                                         <<32BND>>66924000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<32BND>>66926000
                                                               <<32BND>>66928000
         <<--------------->>                                   <<32BND>>66930000
         <<   BUILD DIT   >>                                   <<32BND>>66932000
         <<--------------->>                                   <<32BND>>66934000
                                                               <<32BND>>66936000
         IF NOT(CSDEV) THEN                                    <<32BND>>66938000
            BEGIN <<  MOVE IN INITIALIZED DIT  >>              <<32BND>>66940000
            DITLOC := INITTABLE(DITSIZE,1,BANK0ABOVE,FALSE,    <<32BND>>66942000
               DITDSTN);                                       <<32BND>>66944000
            LPDT'INDEX := LDEV * LPDTSIZE;                     <<*LPDT>>66946000
            LPDT'DIT'PTR := DITADR-SYSBASE;                    <<*LPDT>>66948000
            IF NOT SECONDPASS THEN                             <<32BND>>66950000
               ABS(ILTADR+IDITP+UNITN) := DITADR-SYSBASE;      <<*DVR*>>66952000
            MTDS( DITDSTN, 0, DBINFO(DVRDB4), DITSIZE);        <<32BND>>66954000
                                                               <<32BND>>66956000
            <<   FILL IN DIT ENTRIES FOR ADCC    >>            <<32BND>>66958000
            <<   TERMINALS, NOT FOR LYNX         >>            <<32BND>>66960000
            LDTX'INDEX := LDEV * LDTXSIZE;                     <<*LDTX>>66962000
            LDT'INDEX := LDEV * LDTSIZE;                       <<*LDT*>>66964000
            IF (TYPE = 16 << TERMINAL >> LOR                   <<*LDT*>>66966000
               TYPE = 32 << PRINTER >> LAND                    <<*LDT*>>66968000
               (SUBTYP=14 LOR SUBTYP=15))                      <<32BND>>66970000
$IF X1=ON   << *********** SERIES 33,44,55 UNIQUE ********* >> <<32BND>>66972000
                AND (LDTX'TERMID <> LYNX'BOARD) AND            <<08392>>66974000
                    (LDTX'TERMID <> TIC'BOARD)                 <<08392>>66976000
$IF         << ********* RETURNING TO COMMON CODE ********* >> <<32BND>>66978000
               << MULTIPOINT TOO! >>                           <<32BND>>66980000
               OR TYPE = 16 << TERMINAL >>  AND                <<*LDT*>>66982000
                 (LDT'DFLT'TERM'TYPE = 14 LOR                  <<*LDT*>>66984000
                  LDT'DFLT'TERM'TYPE = 17)                     <<*LDT*>>66986000
               THEN                                            <<32BND>>66988000
               BEGIN                                           <<32BND>>66990000
               IF DITSIZE >= 24 THEN                           <<32BND>>66992000
                  BEGIN  << NOT PSEUDO TERMINAL >>             <<32BND>>66994000
                  ABS(DITADR+23).TERMTYP :=                    <<32BND>>66996000
                    LDT'DFLT'TERM'TYPE;                        <<*LDT*>>66998000
                  ABS(DITADR+23).TERMSPEED :=                  <<32BND>>67000000
                    LDTX'BAUD'RATE'CODE;                       <<*LDTX>>67002000
                  END;                                         <<32BND>>67004000
               END;                                            <<32BND>>67006000
            END;                                               <<32BND>>67008000
                                                               <<32BND>>67010000
            <<------------------>>                             <<32BND>>67012000
            <<   BUILT CS DIT   >>                             <<32BND>>67014000
            <<------------------>>                             <<32BND>>67016000
                                                               <<32BND>>67018000
         IF CSDEV THEN                                         <<32BND>>67020000
            BEGIN                                              <<32BND>>67022000
            LPDT'INDEX := LDEV * LPDTSIZE;                     <<*LPDT>>67024000
            IF LPDT'SUBTYPE = 7 THEN                           <<*LPDT>>67026000
               LCN := 7                                        <<32BND>>67028000
            ELSE                                               <<32BND>>67030000
               BEGIN                                           <<32BND>>67032000
               TOS := LPDT'SUBTYPE;                            <<*LPDT>>67034000
               TOS := 3;                                       <<32BND>>67036000
               ASSEMBLE(DIV,ADD);                              <<32BND>>67038000
               LDT'INDEX := LDEV * LDTSIZE;                    <<*LDT*>>67040000
               LCN := IF LDT'DEVICE'TYPE = CSDEV19             <<*LDT*>>67042000
                   THEN TOS+4  <<LINE CONNECTION>>             <<32BND>>67044000
                   ELSE TOS+1; <<NETWORK        >>             <<32BND>>67046000
               END;                                            <<32BND>>67048000
            LDTXINDEX := CSDEF(LDEV);<<LINE DESCRIPTOR INDEX>> <<32BND>>67050000
            @CSLDTX := @CSTAB(7);                              <<32BND>>67052000
            I := -1;                                           <<32BND>>67054000
            WHILE (I:=I+1) < LDTXINDEX DO                      <<32BND>>67056000
               @CSLDTX:= @CSLDTX+CSLDTX;                       <<32BND>>67058000
            DEFDVRINDEX := 0;                                  <<32BND>>67060000
            LCMEDPDMAX := 0;                                   <<32BND>>67062000
            @DRIVERENTRY := @CSDVRAREA; <<PT TO DUMMY DRIVER>> <<32BND>>67064000
            I := -1;                                           <<32BND>>67066000
            WHILE (I:=I+1)<CSTAB(DRIVERENTNUM) DO              <<32BND>>67068000
               BEGIN<<COMPUTE MAX DIT FOR COMPATIBLE DRIVERS>> <<32BND>>67070000
               @LCNPTR := @DRLCN&LSL(1);                       <<32BND>>67072000
               J := 0;                                         <<32BND>>67074000
               DO IF INTEGER(LCNPTR(J))=LCN OR I=0 THEN        <<32BND>>67076000
                  BEGIN <<COMPATIBLE DRIVER>>                  <<32BND>>67078000
                  IF COMPARE'WORDS(DRNAME,DRIV'WNAME,4) THEN   <<*DVR*>>67080000
                     BEGIN                                     <<32BND>>67082000
                     DEFDVRINDEX := I;                         <<32BND>>67084000
                     GO SUMLENS;                               <<32BND>>67086000
                     END;                                      <<32BND>>67088000
                  IF LOGICAL(CSLDTXDRCHANGEABLE) OR I=0 THEN   <<32BND>>67090000
                     BEGIN<<SUM SIZES OF LCM,EDT,PDT SECTIONS>><<32BND>>67092000
SUMLENS:             TOS := @DRCAPSECTSIZE;                    <<32BND>>67094000
                     TOS := PS0;                               <<32BND>>67096000
                     ASSEMBLE(ADD,INCA);  <<PTR TO LCM LENGTH>><<32BND>>67098000
                     N := 0;                                   <<32BND>>67100000
                     K := 0;                                   <<32BND>>67102000
                                                               <<32BND>>67104000
                     DO BEGIN  <<SUM LENGTHS>>                 <<32BND>>67106000
                        TOS := PS0;                            <<32BND>>67108000
                        N := S0+N;                             <<32BND>>67110000
                        ASSEMBLE(ADD,INCA);  <<NEW PTR>>       <<32BND>>67112000
                        END                                    <<32BND>>67114000
                     UNTIL (K:=K+1) = 4;                       <<32BND>>67116000
                                                               <<32BND>>67118000
                     IF N>LCMEDPDMAX THEN LCMEDPDMAX := N;     <<32BND>>67120000
                     DEL;                                      <<32BND>>67122000
                     END;                                      <<32BND>>67124000
                  END                                          <<32BND>>67126000
               UNTIL (J:=J+1)=3;                               <<32BND>>67128000
               @DRIVERENTRY := @DRIVERENTRY+DRIVERENTRY;       <<32BND>>67130000
               END;                                            <<32BND>>67132000
            CONTSECTSIZE := 0;<<NO CONTROL SECTION IN DIT>>    <<32BND>>67134000
            DITSIZE := MPESTDSIZE+CSSTDSIZE+CONTSECTSIZE+      <<32BND>>67136000
               LCMEDPDMAX;                                     <<32BND>>67138000
            DITLOC := INITTABLE( DITSIZE, 1, BANK0ABOVE,       <<32BND>>67140000
               FALSE, DITDSTN);                                <<32BND>>67142000
            LPDT'INDEX := LDEV * LPDTSIZE;                     <<*LPDT>>67144000
            LPDT'DIT'PTR := DITADR-SYSBASE;                    <<*LPDT>>67146000
            IF NOT SECONDPASS THEN                             <<32BND>>67148000
               ABS(ILTADR+IDITP+UNITN) := DITADR-SYSBASE;      <<*DVR*>>67150000
            @DRIVERENTRY := @CSDVRAREA;                        <<32BND>>67152000
            STDADR := DITADR + MPESTDSIZE;                     <<32BND>>67154000
            CONTADR := STDADR + CSSTDSIZE;                     <<32BND>>67156000
            DRIVERADR := CONTADR + CONTSECTSIZE;               <<32BND>>67158000
            POINTERADR := DITADR + LCMP;                       <<32BND>>67160000
            DRIVERDISP := MPESTDSIZE+CSSTDSIZE+CONTSECTSIZE;   <<32BND>>67162000
            CONTROLP := 0;                                     <<32BND>>67164000
            @DRIVERENT := @CSDVRAREA+DRINFOSIZE+DRCAPSECTSIZE; <<32BND>>67166000
            K := 0;                                            <<32BND>>67168000
            DVRINDEX := 0;                                     <<32BND>>67170000
                                                               <<32BND>>67172000
            DO BEGIN  <<MOVE IN LCM,EDT,PHYS DRIVER FOR DUMMY>><<32BND>>67174000
               MTDS(DITDSTN,DRIVERDISP+DVRINDEX,               <<32BND>>67176000
                  DRIVERENT(DVRINDEX+K+1),                     <<32BND>>67178000
                  DRIVERENT(DVRINDEX+K));                      <<32BND>>67180000
               ABSOLUTE(POINTERADR+LOGICAL(K)):=DRIVERADR      <<32BND>>67182000
                        +LOGICAL(DVRINDEX)-SYSBASE;            <<32BND>>67184000
               DVRINDEX := DVRINDEX+DRIVERENT(DVRINDEX+K);     <<32BND>>67186000
               END UNTIL (K:=K+1) = 3;                         <<32BND>>67188000
                                                               <<32BND>>67190000
            MTDS(DITDSTN,DRIVERDISP+DVRINDEX,                  <<32BND>>67192000
               DRIVERENT(DVRINDEX+4),DRIVERENT(DVRINDEX+3));   <<32BND>>67194000
            ABS(ILTADR+ISIOP) :=                               <<32BND>>67196000
                  DRIVERADR+LOGICAL(DVRINDEX)-SYSBASE;         <<32BND>>67198000
            ABS(ILTADR+IQUEUE).SIOPSIZE :=                     <<32BND>>67200000
                  DRIVERENT(DVRINDEX+3);                       <<32BND>>67202000
            LPDT'INDEX := LDEV * LPDTSIZE;                     <<*LPDT>>67204000
            CSSUBTYPE := LPDT'SUBTYPE;                         <<*LPDT>>67206000
            LDT'INDEX := LDEV * LDTSIZE;                       <<*LDT*>>67208000
            CSDEVTYPE := LDT'DEVICE'TYPE;                      <<*LDT*>>67210000
            CSLCN := LCN;                                      <<32BND>>67212000
            CSLDTXDRINDEX := DEFDVRINDEX;                      <<32BND>>67214000
            CSLDTXLDEV := LDEV;                                <<32BND>>67216000
            CSMODE := CSLDTXMODE;                              <<32BND>>67218000
            CSCODE := CSLDTXCODE;                              <<32BND>>67220000
            CSPROTOCOL := CSLDTXPROTOCOL;                      <<32BND>>67222000
            CSDOPTIONS := CSLDTXDOPTIONS;                      <<32BND>>67224000
            CSHSI'CHAN := CSLDTXHSI'CHAN;   <<UNIT NUMBER>>    <<32BND>>67226000
            CSDUAL'SPEED := CSLDTXDUAL'SPEED;                  <<32BND>>67228000
            CSHALF'SPEED := CSLDTXHALF'SPEED;                  <<32BND>>67230000
            CSXMSN'MODE := CSLDTXXMSN'MODE;                    <<32BND>>67232000
            CSSPEED'CHNGBLE := CSLDTXSPEEDCHNGBLE;             <<32BND>>67234000
            CSANSWER := CSLDTXANSWER;                          <<32BND>>67236000
            CSDIAL := CSLDTXDIAL;                              <<32BND>>67238000
            CSRECV'TIMEOUT := CSLDTXRECV'TIMEOUT;              <<32BND>>67240000
            CSLOCAL'TIMEOUT := CSLDTXLOCAL'TIMEOUT;            <<32BND>>67242000
            CSCONCT'TIMEOUT := CSLDTXCONCT'TIMEOUT;            <<32BND>>67244000
            @DBLPTR := @CSLDTXINSPEED;                         <<csdec>>67246000
            TOS := DBLPTR;                                     <<csdec>>67248000
            ASSEMBLE(XCH);                                     <<32BND>>67250000
            CSINSPEED := TOS;                                  <<32BND>>67252000
            ABS(X:=X+1) := TOS;                                <<32BND>>67254000
            @DBLPTR := @CSLDTXOUTSPEED;                        <<csdec>>67256000
            TOS := DBLPTR;                                     <<csdec>>67258000
            ASSEMBLE(XCH);                                     <<32BND>>67260000
            CSOUTSPEED := TOS;                                 <<32BND>>67262000
            ABS(X:=X+1) := TOS;                                <<32BND>>67264000
            CSMAXRETRIES := DRRETRIES;                         <<32BND>>67266000
            END; << BUILD OF CS DIT >>                         <<32BND>>67268000
                                                               <<CSDEV>>67270000
                                                               <<CSDEV>>67272000
         ABS(DITADR+DLDEV) := LDEV;                            <<CSDEV>>67274000
         ABS(DITADR+DUNIT) := ABS(DITADR+DUNIT) + UNITN;       <<*DVR*>>67276000
         IF SECONDPASS THEN                                    <<CSDEV>>67278000
            BEGIN     << NO  ILT POINTER >>                    <<CSDEV>>67280000
            ABS(DITADR+DILTP) := DVRMASTERLDEV;                <<*DVR*>>67282000
            END                                                <<CSDEV>>67284000
         ELSE                                                  <<CSDEV>>67286000
            BEGIN                                              <<CSDEV>>67288000
            ABS(DITADR+DILTP) := ILTADR-SYSBASE; <<PTR TO ILT>><<CSDEV>>67290000
            IF ILT(IQUEUE).CNTRLRQ <> 0 THEN                   <<CSDEV>>67292000
               ABS(DITADR+DFLAG).MUNIT := 1;                   <<CSDEV>>67294000
            END;                                               <<CSDEV>>67296000
                                                               <<CSDEV>>67298000
            <<--------------------->>                          <<32BND>>67300000
            <<   BUILD DLT ENTRY   >>                          <<32BND>>67302000
            <<--------------------->>                          <<32BND>>67304000
                                                               <<32BND>>67306000
         I := 0;                                               <<32BND>>67308000
         WHILE (I:=I+1) < HLDEV DO                             <<32BND>>67310000
            BEGIN   <<SEARCH FOR DEVICE WITH SAME DRIVER>>     <<32BND>>67312000
            DVR'INDEX := I * DVRSIZE;                          <<*DVR*>>67314000
            IF COMPARE'WORDS(DRIV'WNAME,DVRNAME,4) THEN        <<*DVR*>>67316000
               IF SECONDPASS THEN                              <<32BND>>67318000
                  IF I < LDEV THEN                             <<32BND>>67320000
                     GO USEOLD                                 <<32BND>>67322000
                  ELSE                                         <<32BND>>67324000
                     GO BUILDNEW                               <<32BND>>67326000
            ELSE     <<NON DS DEVICE>>                         <<32BND>>67328000
               IF DVRDRTNUM = DRTN                             <<*DVR*>>67330000
                  AND I < LDEV OR                              <<32BND>>67332000
                  DVRDRTNUM < DRTN THEN                        <<*DVR*>>67334000
USEOLD:           BEGIN  <<DRIVER ALREADY IN DLT>>             <<32BND>>67336000
                  NEWDLT := FALSE;  <<NO NEW ENTRY>>           <<32BND>>67338000
                  LPDT'INDEX := I * LPDTSIZE;                  <<*LPDT>>67340000
                  TOS := LPDT'DIT'PTR;  <<DIT PTR>>            <<*LPDT>>67342000
                  TOS := ABSOLUTE(TOS+SYSBASE+DDLTP);          <<32BND>>67344000
                  ASSEMBLE(DUP,DUP;STAX);  <<DLT INDEX>>       <<32BND>>67346000
                  DVRTYPE := DLT'(X).DRVRTYPE;                 <<32BND>>67348000
                  DLTINDEX := TOS;                             <<32BND>>67350000
                  ABS(DITADR+DDLTP) := TOS;  <<SAVE IN DIT>>   <<32BND>>67352000
                  TOS := DLT'(DLTINDEX).CORERES;               <<32BND>>67354000
                  TOS := TOS LOR LOGICAL(RESIDENT);            <<32BND>>67356000
                  RESIDENT := TOS;                             <<32BND>>67358000
                  GOTO SETRES;                                 <<32BND>>67360000
                  END;                                         <<32BND>>67362000
            END;                                               <<32BND>>67364000
                                                               <<32BND>>67366000
         <<  MAKE NEW DLT ENTRY  >>                            <<32BND>>67368000
BUILDNEW:NEWDLT := TRUE;                                       <<32BND>>67370000
         TOS := NDLT;  <<# OF ENTRIES IN DLT TABLE>>           <<32BND>>67372000
         NDLT := S0+1;                                         <<32BND>>67374000
         DLTINDEX := S0*DLTSIZE;  <<INDEX TO THIS ENTRY>>      <<32BND>>67376000
         INTRINDEX := (TOS*INTRSIZE)&LSL(1); <<INT TAB INDEX>> <<32BND>>67378000
         TOS := (IF CSDEV17<=TYPE<=CSDEV19 THEN 1              <<32BND>>67380000
                   ELSE DBINFO.DRVRTYPE); <<DRIVER TYPE>>      <<32BND>>67382000
         DVRTYPE := S0;                                        <<32BND>>67384000
         DLT'(DLTINDEX).DRVRTYPE := TOS;                       <<32BND>>67386000
         DLT'(DLTINDEX+DMNTR) := OBINFO(INDEX).(8:8);          <<32BND>>67388000
                   <<MONITOR STT #>>                           <<32BND>>67390000
         DLT'(DLTINDEX+DINIT) := OBINFO(INDEX+1).(8:8);        <<32BND>>67392000
                   <<INITIATOR STT #>>                         <<32BND>>67394000
         DLT'(DLTINDEX+DCOMP) := OBINFO(INDEX+2).(8:8);        <<32BND>>67396000
                   <<COMPLETOR STT #>>                         <<32BND>>67398000
         TOS := OBINFO(INDEX+5);<<# OF INTERRUPT ROUTINES>>    <<32BND>>67400000
         M := S0;                                              <<32BND>>67402000
         INTR(INTRINDEX) := TOS;                               <<32BND>>67404000
         J := -1;                                              <<32BND>>67406000
         WHILE (J:=J+1)<M DO <<PUT INTERUPT STT'S IN INTR>>    <<32BND>>67408000
            INTR(INTRINDEX+J+1) := OBINFO(INDEX+J+6).(8:8);    <<32BND>>67410000
         LDT'INDEX := LDEV * LDTSIZE;                          <<*LDT*>>67412000
         DLT'(DLTINDEX+DTYPE).DEVTYPE := LDT'DEVICE'TYPE;      <<*LDT*>>67414000
         DLT'(X).DITSIZE' := DITSIZE;                          <<32BND>>67416000
         IF CSDEV THEN                                         <<32BND>>67418000
            DLT'(DLTINDEX+DEDITOR):=OBINFO(INDEX+3).(8:8);     <<32BND>>67420000
         ABS(DITADR+DDLTP) := DLTINDEX;                        <<32BND>>67422000
         DLT'(DLTINDEX+DINTPL):=OBINFO(INDEX+4).(8:8);         <<32BND>>67424000
                           <<INITIALIZATION STT>>              <<32BND>>67426000
                                                               <<32BND>>67428000
            <<------------------------------------>>           <<32BND>>67430000
            <<   SET UP I/O PROCESS TABLE ENTRY   >>           <<32BND>>67432000
            <<------------------------------------>>           <<32BND>>67434000
                                                               <<32BND>>67436000
         IF DVRTYPE = 2 THEN                                   <<32BND>>67438000
            BEGIN  <<SET UP I/O PROCESS>>                      <<32BND>>67440000
            GETIOPROCNAME;   <<GET PROCESS NAME>>              <<32BND>>67442000
            J := -1;                                           <<32BND>>67444000
            WHILE (J:=J+1) < NIOPROC DO                        <<32BND>>67446000
               BEGIN   <<SEARCH FOR NAME ALREADY IN TABLE>>    <<32BND>>67448000
               TOS := @IOPROC(J*IOPROCSIZE)&LSL(1);            <<32BND>>67450000
               IF * = IOPROCNAME,(16) AND IOPROC(X:=X+8)       <<32BND>>67452000
                  .DRVRTYPE=2 AND IOPROC(X).NOCREATE =         <<32BND>>67454000
                  DBINFO.NOCREATE THEN                         <<32BND>>67456000
                  BEGIN  <<MATCHES OTHER TYPE 2 PROCESS>>      <<32BND>>67458000
                  IF RESIDENT THEN IOPROC(X).CORERES:= 1;      <<32BND>>67460000
                  DLT'(DLTINDEX).QNUMB := J;                   <<32BND>>67462000
                  GOTO SETRES;                                 <<32BND>>67464000
                  END;                                         <<32BND>>67466000
               END;                                            <<32BND>>67468000
            <<ADD PROCESS TO TABLE>>                           <<32BND>>67470000
            ADDIOPROC;                                         <<32BND>>67472000
            END;                                               <<32BND>>67474000
SETRES:  DLT'(DLTINDEX).CORERES := RESIDENT;                   <<32BND>>67476000
                                                               <<32BND>>67478000
         IF DVRTYPE = 3 THEN                                   <<32BND>>67480000
            BEGIN  <<SET UP PROCESS FOR TYPE 3 DRIVER>>        <<32BND>>67482000
            GETIOPROCNAME;                                     <<32BND>>67484000
            IF DBINFO.(13:1)=1 AND FIRST OR DBINFO.(13:1)=0    <<32BND>>67486000
               THEN BEGIN  <<ADD ENTRY TO TABLE>>              <<32BND>>67488000
               IF NEWDLT THEN                                  <<32BND>>67490000
                  ADDIOPROC << ADD FROM OBINFO >>              <<32BND>>67492000
               ELSE                                            <<32BND>>67494000
                  BEGIN  <<COPY FROM SIMILAR ENTRY>>           <<32BND>>67496000
                  ABS(DITADR+DPCBN) := NIOPROC;                <<32BND>>67498000
                  MOVE IOPROC(NIOPROC*IOPROCSIZE) := IOPROC    <<32BND>>67500000
                     (DLT'(DLTINDEX).QNUMB*IOPROCSIZE),        <<32BND>>67502000
                     (IOPROCSIZE);                             <<32BND>>67504000
                  IOPROC(NIOPROC*IOPROCSIZE+8).CORERES :=      <<32BND>>67506000
                     RESIDENT;                                 <<32BND>>67508000
                  NIOPROC := NIOPROC+1;                        <<32BND>>67510000
                  END;                                         <<32BND>>67512000
               END                                             <<32BND>>67514000
            ELSE                                               <<32BND>>67516000
               BEGIN  <<ENSURE  OTHER UNITS USE SAME PROCESS>> <<32BND>>67518000
               I := 0;                                         <<32BND>>67520000
NEXTDIT:       IF ILT(ILTSIZE+I)<>0 AND I<>UNITN THEN          <<*DVR*>>67522000
                  BEGIN  <<ANOTHER UNIT ON THIS CONTROLLER>>   <<32BND>>67524000
                  X := ABSOLUTE(ILT(X)+SYSBASE+DDLTP);         <<32BND>>67526000
                  TOS := DLT'(X).QNUMB; <<IOPROC INDEX>>       <<32BND>>67528000
                  X := S0*IOPROCSIZE;                          <<32BND>>67530000
                  K := TOS;                                    <<32BND>>67532000
                  TOS := @IOPROC(X)&LSL(1);                    <<32BND>>67534000
                  IF *<>IOPROCNAME,(16) THEN                   <<32BND>>67536000
                     ERRMESSAGE(M252,DRTN)                     <<32BND>>67538000
                  ELSE                                         <<32BND>>67540000
                     BEGIN                                     <<32BND>>67542000
                     IF RESIDENT THEN IOPROC(X:=X+8)           <<32BND>>67544000
                        .CORERES := 1;                         <<32BND>>67546000
                     ABS(DITADR+DPCBN) := K;  <<PROCESS INDEX>><<32BND>>67548000
                     END;                                      <<32BND>>67550000
                  END                                          <<32BND>>67552000
               ELSE                                            <<32BND>>67554000
                  BEGIN  <<LOOK AT NEXT UNIT>>                 <<32BND>>67556000
                  I := I+1;                                    <<32BND>>67558000
                  GOTO NEXTDIT;                                <<32BND>>67560000
                  END;                                         <<32BND>>67562000
               END;                                            <<32BND>>67564000
            END; << DRIVER TYPE 3 >>                           <<32BND>>67566000
                                                               <<32BND>>67568000
            FIRST := FALSE;                                    <<*DVR*>>67570000
NEXTLDEV:                                                      <<32BND>>67572000
            FCLOSE(DVRFNUM);                                   <<*DVR*>>67574000
         END;                                                  <<*DVR*>>67576000
      END UNTIL (LDEV:=LDEV+1) > HLDEV;                        <<32BND>>67578000
                                                               <<32BND>>67580000
      IF SECONDPASS THEN GO MOVEDLT;                           <<32BND>>67582000
                                                               <<32BND>>67584000
   END UNTIL (DRTN := DRTN+1) > HIDRT;                         <<32BND>>67586000
                                                               <<32BND>>67588000
                                                               <<32BND>>67590000
   <<--------------------------->>                             <<32BND>>67592000
   <<   BUILD DLT FOR CSDUMMY   >>                             <<32BND>>67594000
   <<--------------------------->>                             <<32BND>>67596000
                                                               <<32BND>>67598000
   IF CSPRESENT THEN                                           <<32BND>>67600000
      BEGIN <<RESERVE DLT ENTRIES FOR CSDUMMY >>               <<32BND>>67602000
            << AND ADDITIONAL CS DRIVERS      >>               <<32BND>>67604000
      TOS := NDLT;                                             <<32BND>>67606000
      CSDUMMYINDEX := S0*DLTSIZE;                              <<32BND>>67608000
      NDLT := TOS+COMM(NUMADVRS)+1;                            <<CONFD>>67610000
      I := -1;                                                 <<32BND>>67612000
      WHILE (I:=I+1) < COMM(NUMADVRS) DO                       <<CONFD>>67614000
         <<PUT INITIALIZATION STT IN DLT ENTRIES>>             <<32BND>>67616000
         DLT'(CSDUMMYINDEX+(I+1)*DLTSIZE+DINTPL) :=            <<32BND>>67618000
           INIT'LIZAT'NSTT(I);                                 <<32BND>>67620000
      END;                                                     <<32BND>>67622000
   IF NOT(SECONDPASS) THEN                                     <<32BND>>67624000
      BEGIN                                                    <<32BND>>67626000
      FIRST := FALSE;                                          <<32BND>>67628000
      SECONDPASS := TRUE;                                      <<32BND>>67630000
      GO STARTPASS;                                            <<32BND>>67632000
      END;                                                     <<32BND>>67634000
                                                               <<32BND>>67636000
   <<-------------------------->>                              <<32BND>>67638000
   <<   MOVE DLT TO LOW CORE   >>                              <<32BND>>67640000
   <<-------------------------->>                              <<32BND>>67642000
                                                               <<32BND>>67644000
MOVEDLT:                                                       <<32BND>>67646000
   INSERTDST( D'L(ILTSTART)), ILTDITDSTN, ADDRESS              <<32BND>>67648000
      -LOGICAL(ILTSTART), 0);                                  <<32BND>>67650000
   MEMADR := INITTABLE( NDLT, DLTSIZE, BANK0ONLY, TRUE,        <<32BND>>67652000
      DLTDSTN);                                                <<32BND>>67654000
   MTDS( DLTDSTN, 0, DLT', TABSIZE);                           <<32BND>>67656000
   DLTPTR' := LOGICAL(MEMADR) -SYSBASE;                        <<32BND>>67658000
                                                               <<32BND>>67660000
   <<--------------------------------->>                       <<32BND>>67662000
   <<   CRUNCH TEMPORARY I/O TABLES   >>                       <<32BND>>67664000
   <<--------------------------------->>                       <<32BND>>67666000
                                                               <<32BND>>67668000
   MOVE IOPROC(HLDEV*IOPROCSIZE-1) := IOPROC(NIOPROC*          <<32BND>>67670000
     IOPROCSIZE-1),(-X-1),2;                                   <<32BND>>67672000
   @IOPROC := S0+1;                                            <<32BND>>67674000
   TOS := INTRSIZE*NDLT;                                       <<32BND>>67676000
   TOS := S0-1;                                                <<32BND>>67678000
   TOS := WORDADDRESS(INTR);    << GET WORD POINTER >>         <<32BND>>67680000
   ASSEMBLE(ADD,XCH; NEG; MOVE 2);                             <<32BND>>67682000
   ASSEMBLE(INCA,DUP);                                         <<32BND>>67684000
   @INTR := TOS&LSL(1);                                        <<32BND>>67686000
   SET(DL);                                                    <<32BND>>67688000
                                                               <<32BND>>67690000
   <<--------------------------->>                             <<32BND>>67692000
   <<   BUILD RESOURCE TABLES   >>                             <<32BND>>67694000
   <<--------------------------->>                             <<32BND>>67696000
                                                               <<32BND>>67698000
   NRESQ := NCNTRLQ+NCHANQ+NPROCQ+2;                           <<32BND>>67700000
   TOS := INITTABLE(NRESQ, 3, BANK0ONLY, TRUE, RESQDSTN);      <<32BND>>67702000
   DELB;  << DELETE BANK >>                                    <<32BND>>67704000
   TOS := TOS-SYSBASE;                                         <<32BND>>67706000
   ABSOLUTE(SYSBUSY) := S0;   <<BUSY TABLE PTR>>               <<32BND>>67708000
   TOS := TOS+NRESQ;                                           <<32BND>>67710000
   ABSOLUTE(SYSHEAD) := S0;   <<HEAD TABLE PTR>>               <<32BND>>67712000
   TOS := TOS+NRESQ;                                           <<32BND>>67714000
   ABSOLUTE(SYSTAIL) := TOS;  <<TAIL TABLE PTR>>               <<32BND>>67716000
   I := 0;                                                     <<32BND>>67718000
   DO SYS(ABS(SYSHEAD)+I) := -1 UNTIL (I:=I+1) = NRESQ;        <<32BND>>67720000
   I := 0;                                                     <<32BND>>67722000
   DO SYS(ABS(SYSTAIL)+I) := ABS(SYSHEAD)+I-1                  <<32BND>>67724000
      UNTIL (I:=I+1) = NRESQ;                                  <<32BND>>67726000
                                                               <<32BND>>67728000
   <<---------------------------------------------->>          <<32BND>>67730000
   <<   UPDATE DLT AND MULTI-UNIT QUEUE POINTERS   >>          <<32BND>>67732000
   <<---------------------------------------------->>          <<32BND>>67734000
                                                               <<32BND>>67736000
   DRTN := LOWESTDRT;                                          <<32BND>>67738000
   DO IF GETDRT( DRTN, DBI) <> 0 THEN                          <<32BND>>67740000
      BEGIN  << DRT IS USED >>                                 <<32BND>>67742000
      ILTADR := GETDRT( DRTN, DBI);                            <<32BND>>67744000
                                                               <<32BND>>67746000
      <<  UPDATE CONTROLLER QUEUE NUMBER  >>                   <<32BND>>67748000
      IF ABS(ILTADR+IQUEUE).CNTRLRQ <> 0 THEN                  <<32BND>>67750000
         ABS(X).CNTRLRQ := ABS(X).CNTRLRQ + NPROCQ + 1;        <<32BND>>67752000
                                                               <<32BND>>67754000
      <<  UPDATE CHANNEL QUEUE NUMBER  >>                      <<32BND>>67756000
      IF ABS(ILTADR+ICNTRL).CHANQUE <> 0 THEN                  <<32BND>>67758000
         ABS(X).CHANQUE := ABS(X).CHANQUE+NCNTRLQ+NPROCQ+1;    <<32BND>>67760000
                                                               <<32BND>>67762000
      <<  UPDATE DLT POINTER IN DIT  >>                        <<32BND>>67764000
      N := INTHS'UNITS(DRTN);  <<# OF UNITS ON CONTROLLER>>    <<32BND>>67766000
      I := 0;                                                  <<32BND>>67768000
      DO IF ABS(ILTADR+IDITP+I) <> 0 THEN                      <<32BND>>67770000
         BEGIN                                                 <<32BND>>67772000
         DITADR := ABS(X) + SYSBASE;                           <<32BND>>67774000
         ABS(X) := ABS(DITADR+DDLTP) + DLTPTR';                <<32BND>>67776000
         END                                                   <<32BND>>67778000
      UNTIL (I:=I+1) = N;                                      <<32BND>>67780000
                                                               <<32BND>>67782000
      END                                                      <<32BND>>67784000
   UNTIL (DRTN := DRTN+1) > HIDRT;                             <<32BND>>67786000
                                                               <<32BND>>67788000
   <<--------------------------------------------->>           <<32BND>>67790000
   <<   ASSIGN ABSOLUTE PRIORITIES TO PROCESSES   >>           <<32BND>>67792000
   <<--------------------------------------------->>           <<32BND>>67794000
                                                               <<32BND>>67796000
   RELPRI := 0;                                                <<32BND>>67798000
   ABSPRI := IOPRI;                                            <<32BND>>67800000
                                                               <<32BND>>67802000
   DO BEGIN  << ASSIGN PRIORITIES >>                           <<32BND>>67804000
                                                               <<32BND>>67806000
      I := 0;                                                  <<32BND>>67808000
      DO IF IOPROC(I*IOPROCSIZE+9).(8:8) = RELPRI THEN         <<32BND>>67810000
         BEGIN                                                 <<32BND>>67812000
         IOPROC(X).(0:8) := ABSPRI;                            <<32BND>>67814000
         ABSPRI := ABSPRI+1;                                   <<32BND>>67816000
         END                                                   <<32BND>>67818000
      UNTIL (I:=I+1) = NIOPROC;                                <<32BND>>67820000
                                                               <<32BND>>67822000
      END                                                      <<32BND>>67824000
   UNTIL (RELPRI := RELPRI+1) > 255;                           <<32BND>>67826000
                                                               <<32BND>>67828000
   <<---------------------------->>                            <<32BND>>67830000
   <<   MEMORY MANAGEMENT INFO   >>                            <<32BND>>67832000
   <<---------------------------->>                            <<32BND>>67834000
                                                               <<32BND>>67836000
   TOS:=(CTAB0(CORESIZE)+63)&LSR(6);                           <<32BND>>67838000
   TOS:=TOS-1;                                                 <<32BND>>67840000
   ABSOLUTE(NBANKS):=TOS;                                      <<32BND>>67842000
   TOS:=CTAB0(CORESIZE);                                       <<32BND>>67844000
   TOS:=S0.(10:6); <<KWORDS IN LAST PARTIAL BANK>>             <<32BND>>67846000
   IF = THEN                                                   <<32BND>>67848000
      BEGIN <<LAST BANK IS COMPLETE>>                          <<32BND>>67850000
      ASSEMBLE(DEL);                                           <<32BND>>67852000
      ABSOLUTE(SYSLASTBASE):=%177777;                          <<32BND>>67854000
      TOS:=TOS.(0:10); <<NUMBER OF COMPLETE BANKS>>            <<32BND>>67856000
      TOS:=TOS-1; <<BANK NUMBER OF LAST BANK>>                 <<32BND>>67858000
      ABSOLUTE(SYSLASTBANK):=TOS;                              <<32BND>>67860000
      END                                                      <<32BND>>67862000
   ELSE                                                        <<32BND>>67864000
      BEGIN <<LAST BANK IS PARTIAL>>                           <<32BND>>67866000
      TOS:=TOS&LSL(10)-1;                                      <<32BND>>67868000
      ABSOLUTE(SYSLASTBASE):=TOS;                              <<32BND>>67870000
      TOS:=TOS.(0:10);                                         <<32BND>>67872000
      ABSOLUTE(SYSLASTBANK):=TOS;                              <<32BND>>67874000
      END;                                                     <<32BND>>67876000
                                                               <<32BND>>67878000
   <<--------------------->>                                   <<32BND>>67880000
   <<   CST BLOCK TABLE   >>                                   <<32BND>>67882000
   <<--------------------->>                                   <<32BND>>67884000
                                                               <<32BND>>67886000
   INITTABLE(CTAB(CONPROGNUM)+9+(CTAB(CONPROGNUM)-1)&LSR(4)+2, <<32BND>>67888000
      1,BANK0ONLY,TRUE,CSTBLKDSTN,SYSCSTBLK);                  <<32BND>>67890000
   CSTBLK(0):=CTAB(CONPROGNUM)+8;<<USER AND SYS>>              <<32BND>>67892000
   I := 0;                                                     <<32BND>>67894000
   WHILE (I:=I+1) <= CSTBLK(0) DO CSTBLK(I):=-1;               <<32BND>>67896000
                                                               <<32BND>>67898000
   <<---------------------------->>                            <<32BND>>67900000
   <<   MEASUREMENT INFO TABLE   >>                            <<32BND>>67902000
   <<---------------------------->>                            <<32BND>>67904000
                                                               <<32BND>>67906000
   INITTABLE(MEASINFOTABSIZE,1,BANK0ONLY,TRUE,MEASINFOTABDSTN, <<32BND>>67908000
      SYSMEASINFOTAB);                                         <<32BND>>67910000
                                                               <<32BND>>67912000
   <<----------------------------------------->>               <<32BND>>67914000
   <<   VIRTUAL DISC SPACE MANAGEMENT TABLE   >>               <<32BND>>67916000
   <<----------------------------------------->>               <<32BND>>67918000
                                                               <<32BND>>67920000
   BUILD'VDSMTAB;                                              <<32BND>>67922000
                                                               <<32BND>>67924000
   <<----------------------------->>                           <<JPCNT>>67926000
   <<   JOB PROCESS COUNT TABLE   >>                           <<JPCNT>>67928000
   <<----------------------------->>                           <<JPCNT>>67930000
                                                               <<JPCNT>>67932000
   TEMP := CTAB(MAXRJOB)+CTAB(MAXRSES);                        <<JPCNT>>67934000
   << HEADER 4 WDS  >>                                         <<JPCNT>>67936000
   M := (TEMP+15)/16+4;  << JPCNT BIT MAP >>                   <<JPCNT>>67938000
   MEMADR := INITTABLE(M,1,BANK0ONLY,TRUE,JPCTDSTN,SYSJPCNT);  <<JPCNT>>67940000
   JPCNT(0) := TEMP;         << MAX RUNNING JOBS >>            <<JPCNT>>67942000
   JPCNT(1) := TEMP;         << NR. OF FREE BITS >>            <<JPCNT>>67944000
   <<  INITIALIZE JPCNT BIT MAP  >>                            <<JPCNT>>67946000
   I := TEMP;                                                  <<JPCNT>>67948000
   WHILE (I:=I-1) >= 0 DO                                      <<JPCNT>>67950000
      JPCNT(4+I.(0:12)) := JPCNT(4+I.(0:12)) LOR               <<JPCNT>>67952000
         %100000 &CSR(I.(12:4));                               <<JPCNT>>67954000
                                                               <<32BND>>67956000
                                                               <<PORTS>>67958000
          <<--------------------------------->>                <<PORTS>>67960000
          << INITIALIZE INCORE MESSAGE TABLE >>                <<PORTS>>67962000
          <<--------------------------------->>                <<PORTS>>67964000
          INIT'MESSAGE'SYSTEM;                                 <<PORTS>>67966000
                                                               <<PORTS>>67968000
END;    << MAINSEG2 >>                                         <<32BND>>67970000
$PAGE "MAINSEG3  --  ALLOCATE SYSTEM LIBRARY"                           67972000
$CONTROL SEGMENT=MAINSEG3                                               67974000
  PROCEDURE MAINSEG3;                                                   67976000
      BEGIN                                                             67978000
      LOGICAL FIRSTDRT;                                        <<00.04>>67980000
      INTEGER TEMP;                                            <<03002>>67982000
      INTEGER POINTER                                          <<32BND>>67984000
         DLTTAB,                                               <<32BND>>67986000
         DLT;                                                  <<32BND>>67988000
      INTEGER NSEG,  << TEMP FOR NO. OF CST'S ALLOCATED >>     <<03004>>67990000
              ILTADR, << ABSOLUTE ADDRESS OF ILT >>            <<32BND>>67992000
              DITADR, << AGSOLUTE ADDRESS OF DIT >>            <<32BND>>67994000
              DLTLEN, << TOTAL LENGTH OF DLT TABLE >>          <<32BND>>67996000
              FIRSTCST;   << 1ST PHYSICAL CST FOR DRIVER >>    <<03004>>67998000
      INTEGER ADDDVRNUM;<<CS ADDITIONAL DRIVER BEING PROCESSD>><<00.06>>68000000
      INTEGER CSTBLKINDEX;    <<PGM CSTBLK INDEX>>             <<00652>>68002000
      INTEGER UNIT;            << UNIT NUMBER >>               <<03552>>68004000
      INTEGER PCBPT;                                           <<*pcb*>>68006000
      DOUBLE  DISCADR;                                         <<03603>>68008000
      BYTE VOLUME = DISCADR;                                   <<03603>>68010000
      BYTE LDEV = DISCADR;                                     <<03603>>68012000
      DOUBLE  SAVDRT;     << TEMP. FOR NEW DRT LOCATION >>     <<03744>>68014000
      LOGICAL SAVDRTBANK = SAVDRT,                             <<03744>>68016000
              SAVDRTADDR = SAVDRT+1;                           <<03744>>68018000
      LOGICAL BANK,       << TEMP. FOR BANK # >>               <<03744>>68020000
              OFFSET;     << TEMP. FOR BANK OFFSET >>          <<03744>>68022000
       INTEGER                                                 <<*DVR*>>68024000
            LDT'INDEX,                                         <<*DVR*>>68026000
            LPDT'INDEX,                                        <<*DVR*>>68028000
            DVR'INDEX;                                         <<*DVR*>>68030000
                                                                        68032000
      LOGICAL ARRAY DRIV'WNAME(0:4)=Q; << TEMP ARRAY FOR  >>   <<*DVR*>>68034000
      BYTE ARRAY DRIV'BNAME(*) = DRIV'WNAME;<< DRIVER TABLE >> <<*DVR*>>68036000
                                                               <<*DVR*>>68038000
EQUATE  IOMESSPRI   =    120,  <<IO MESSAGES AND LOGGING >>    <<*8392>>68040000
        IOMESSPROC  =      9,  <<I/O MESSAGES AND LOGGING>>    <<*8392>>68042000
        IOMESSSBIT  =      3,  <<I/O MESSAGES AND LOGGING>>    <<*8392>>68044000
        IOMESSSTACK =   4096;  <<I/O MESSAGES STACK      >>    <<*8392>>68046000
EQUATE  SDSLDEVLAB = SYSBASE + %323, <<EXT LABEL FOR SDSLDEV>> <<s8967>>68048000
        IOQSIZE      =   12,                                   <<s8967>>68050000
        DISCREQSIZE  =   17,                                   <<s8967>>68052000
        SBUFSIZE     =  129,                                   <<s8967>>68054000
        MONBUFSIZE   = 1024,                                   <<s8967>>68056000
        SIRSIZE      =    4,                                   <<s8967>>68058000
        NSIR         =   43,                                   <<s8967>>68060000
        SRTSIZE      =    6;                                   <<s8967>>68062000
                                                               <<s8967>>68064000
                                                               <<s8967>>68066000
          ASSEMBLE( RSW );                                     <<01091>>68068000
          IF TOS.(8:8) <> CLRSW THEN HELP;                     <<02510>>68070000
          ABSOLUTE(MAXCODESEG) := CTAB(MCSS);                           68072000
          ABSOLUTE(MAXSEGPROC) := CTAB(MCSP);                           68074000
          ABSOLUTE(MAXDATA) := CTAB(MSTACK);                            68076000
          ABSOLUTE(MAXXTRADSEG) := CTAB(MXDSS);                         68078000
          ABSOLUTE(MAXDSEGPROC) := CTAB(MXDSP);                         68080000
          ABSOLUTE(STDSTACK) := CTAB0(SSS);                             68082000
          ABSOLUTE(LOGONLIM) := CTAB0(LOGON);                           68084000
          ABSOLUTE(CPUTIME)  := CTAB0(CPULIM);                          68086000
          ABSOLUTE(HSYSDRT) := COMM(DRTNUM);                   <<CONFD>>68088000
                                                                        68090000
          <<---------------------------------->>               <<03002>>68092000
          << ALLOCATE DRT TABLE FROM INITTABLE>>               <<32BND>>68094000
                                                               <<32BND>>68096000
          <<---------------------------------->>               <<03002>>68098000
          IF HIDRT > 127                                       <<03022>>68100000
          THEN BEGIN                                           <<03002>>68102000
            I:=4* (HIDRT + ( DEVPERCHAN -                      <<03022>>68104000
               HIDRT MOD DEVPERCHAN) );                        <<03022>>68106000
                                                               <<03002>>68108000
            << WE MUST SAVE DRT TABLE ELSEWHERE BECAUSE WE >>  <<03744>>68110000
            << MAY MOVE IT ON TOP OF ITS OLD LOCATION      >>  <<03744>>68112000
                                                               <<03744>>68114000
            PUSH(DB);                     << GET ABS. ADDR. >> <<03744>>68116000
            OFFSET := TOS + @LDMAPBUF;    << OF LDMAPBUF    >> <<03744>>68118000
            BANK := TOS;                                       <<03744>>68120000
                                                               <<03744>>68122000
            MABS(BANK,OFFSET,            << COPY DRT TABLE  >> <<03744>>68124000
                 ABSOLUTE(DRTBANK),      <<    TEMPORARILY  >> <<03744>>68126000
                 ABSOLUTE(DRTADDR),I);                         <<03744>>68128000
                                                               <<03744>>68130000
            << NOW POINT THE DRT POINTERS AT THE TEMPORARY  >> <<03744>>68132000
            << COPY ONLY FOR THE CALL TO MAM.  WE ONLY DO   >> <<03744>>68134000
            << THIS BECAUSE WE CANNOT DO ANY I/O WHILE MAM  >> <<03744>>68136000
            << IS ZEROING THE NEW DRT TABLE, AND MAM MAY    >> <<03744>>68138000
            << CAUSE SOME SWAPS.                            >> <<03744>>68140000
                                                               <<03744>>68142000
            ABSOLUTE( DRTBANK) := BANK;                        <<03744>>68144000
            ABSOLUTE( DRTADDR) := OFFSET;                      <<03744>>68146000
                                                               <<03744>>68148000
            SAVDRT:= INITTABLE(I, 1, ANYWHERE'TAB,             <<32BND>>68150000
                       TRUE, , DRTIX);                         <<*DRT*>>68152000
                                       << ZERO OUT DRT TABLE>> <<03744>>68154000
                                                               <<03744>>68156000
            MABS(SAVDRTBANK,SAVDRTADDR,     <<COPY DRT TABLE>> <<03744>>68158000
                          BANK,OFFSET,I);   << TO NEW SPOT  >> <<03744>>68160000
                                                               <<03744>>68162000
            ABSOLUTE( DRTBANK):= SAVDRTBANK;                   <<03002>>68164000
            ABSOLUTE( DRTADDR):= SAVDRTADDR;                   <<03002>>68166000
          END;                                                 <<03002>>68168000
                                                               <<32BND>>68170000
   <<--------------------------------------->>                 <<32BND>>68172000
   <<   PROCESS CONTROL BLOCK TABLE (PCB)   >>                 <<32BND>>68174000
   <<--------------------------------------->>                 <<32BND>>68176000
                                                               <<32BND>>68178000
   INITSYSTABLE(CTAB(PCBNUM),0,PCBSIZE,PCBDSTN,SYSPCB);        <<*SLL*>>68180000
   ABSOLUTE(PCBP) := 0;                                        <<*pcb*>>68182000
   TOS:=0;                                                     <<32BND>>68184000
   TOS:=SYSBASE;                                               <<32BND>>68186000
   ASSEMBLE(XCHD); <<DB TO SYSDB>>                             <<32BND>>68188000
                                                               <<32BND>>68190000
   <<PLACE PROGENITOR'S PCB ENTRY AT HEAD OF DISPQ>>           <<32BND>>68192000
   PCBPT := PROGPCBN * PCBSIZE;                                <<*pcb*>>68194000
   DISPQHEAD := PROGPCBN * PCBSIZE;                            <<*pcb*>>68196000
   DISPQTAIL := PROGPCBN * PCBSIZE;                            <<*pcb*>>68198000
   <<FIX PROGENITOR'S QUEUE FIELDS>>                           <<32BND>>68200000
   WAKEMASK.MEMWAITFLAG:=1;                                    <<32BND>>68202000
   QUEUEINGINFO.DISPQFLAG:=1;                                  <<32BND>>68204000
   ASSEMBLE(XCHD);                                             <<32BND>>68206000
   ASSEMBLE(DDEL);                                             <<32BND>>68208000
   GETENTRY( PCBDSTN); << RESERVE ENTRY 1 FOR PROGEN >>        <<*sll5>>68210000
                                                               <<32BND>>68212000
   <<--------------->>                                         <<32BND>>68214000
   <<   SWAPTABLE   >>                                         <<32BND>>68216000
   <<--------------->>                                         <<32BND>>68218000
                                                               <<32BND>>68220000
   << MAKE SURE ENOUGH ENTRIES ARE CONFIGURED >>               <<*SLL*>>68222000
   I := IF CTAB(SWAPTABLE) < CTAB(PCBNUM) *2 THEN              <<*SLL*>>68224000
        CTAB(PCBNUM) * 2 ELSE CTAB(SWAPTABLE);                 <<*SLL*>>68226000
   INITSYSTABLE(I,0,SWAPTABSIZE,SWAPTABDSTN,SYSSWAPTAB);       <<*SLL*>>68228000
                                                               <<32BND>>68230000
   <<--------------------------->>                             <<*SLL*>>68232000
   <<   SPECIAL REQUEST TABLE   >>                             <<*SLL*>>68234000
   <<--------------------------->>                             <<*SLL*>>68236000
                                                               <<*SLL*>>68238000
   I := IF CTAB(SPECIALREQTABLE) < HLDEV+CTAB(PCBNUM) THEN     <<*SLL*>>68240000
       HLDEV+CTAB(PCBNUM) ELSE CTAB(SPECIALREQTABLE);          <<*SLL*>>68242000
   INITSYSTABLE(I,HLDEV,SRTSIZE,SPECREQTABDSTN,SYSSPECREQTAB); <<*SLL*>>68244000
                                                               <<*SLL*>>68246000
   <<---------------------->>                                  <<JCUT*>>68248000
   <<   JOB CUTOFF TABLE   >>                                  <<JCUT*>>68250000
   <<---------------------->>                                  <<JCUT*>>68252000
                                                               <<JCUT*>>68254000
   M := CTAB(MAXRJOB) + CTAB(MAXRSES);                         <<JCUT*>>68256000
   INITTABLE(M+2,JCUTSIZE,ANYWHERE'TAB,TRUE,JCUTDSTN,SYSJCUT); <<JCUT*>>68258000
   JCUT(0) := M;                                               <<JCUT*>>68260000
   JCUT(1) := JCUTSIZE;                                        <<JCUT*>>68262000
   JCUT(2) := JCUTSIZE*2;                                      <<JCUT*>>68264000
   <<    INTITIALIZE FREE LIST    >>                           <<JCUT*>>68266000
   X := JCUTSIZE*2;                                            <<JCUT*>>68268000
   FOR I := 2 UNTIL M DO                                       <<JCUT*>>68270000
      X := JCUT(X) := X+JCUTSIZE;                              <<JCUT*>>68272000
   JCUT(3) := X;   << PTR TO LAST ENTRY >>                     <<JCUT*>>68274000
   ABSOLUTE(DEFAULTQUEUE) := DEFAULTJOBPRI;                    <<JCUT*>>68276000
   ABSOLUTE(MAXQUEUE) := DEFAULTJOBPRI;                        <<JCUT*>>68278000
                                                               <<IOTAB>>68280000
                                                               <<*pcb*>>68282000
                                                               <<IOTAB>>68284000
   <<-------------------------->>                              <<*TRL*>>68286000
   <<   TIMER REQUEST QUEUE    >>                              <<*TRL*>>68288000
   <<-------------------------->>                              <<*TRL*>>68290000
                                                               <<*TRL*>>68292000
   INITTABLE(CTAB(TRLNUM)+1,TRLSIZE,ANYWHERE'TAB,TRUE,         <<*TRL*>>68294000
      TRLDSTN,SYSTRL);                                         <<*TRL*>>68296000
   TRL(0) := CTAB(TRLNUM); << NR. ENTRIES >>                   <<*TRL*>>68298000
   TRL(1) := TRLSIZE;   << ENTRY SIZE  >>                      <<*TRL*>>68300000
   TRL(2) := 3*TRLSIZE; << FREE LIST HEAD >>                   <<*TRL*>>68302000
   << INITIALIZE FREE LIST >>                                  <<*TRL*>>68304000
   FOR I := 3 UNTIL CTAB(TRLNUM)-1 DO                          <<*TRL*>>68306000
      TRL(I*TRLSIZE) := I+1;                                   <<*TRL*>>68308000
                                                               <<IOTAB>>68310000
   <<-------------------->>                                    <<IOTAB>>68312000
   <<   SYSTEM BUFFERS   >>                                    <<IOTAB>>68314000
   <<-------------------->>                                    <<IOTAB>>68316000
                                                               <<IOTAB>>68318000
   INITIOTABLE(CTAB(SBUFNUM),SECSBUF,SBUFSIZE,SBUFDSTN,        <<IOTAB>>68320000
      SYSSBUF);                                                <<IOTAB>>68322000
   <<   ALLOCATE TERMINAL BUFFERS   >>                         <<IOTAB>>68324000
   <<------------------------------->>                         <<IOTAB>>68326000
                                                               <<IOTAB>>68328000
   << FOR ADCC- OR ATC-CONNECTED TERMINALS, ALLOCATE>>         <<IOTAB>>68330000
   << TBUF'S IN BANK 0.  LYNX SOFTWARE ALLOCATES ITS>>         <<IOTAB>>68332000
   << OWN TBUF'S.  NO. OF TBUF'S = TBUF'S/PORT *    >>         <<IOTAB>>68334000
   << NO. OF TERMINALS, NOT GREATER THAN LIMIT      >>         <<IOTAB>>68336000
                                                               <<IOTAB>>68338000
                                                               <<IOTAB>>68340000
          <<----------------------------->>                    <<IOTAB>>68342000
          <<LOGICAL-PHYSICAL DEVICE TABLE>>                    <<IOTAB>>68344000
          <<----------------------------->>                    <<IOTAB>>68346000
                                                               <<IOTAB>>68348000
          INITTABLE(HLDEV+1, LPDTSIZE, ANYWHERE'TAB, TRUE,     <<nomem>>68350000
                            LPDTDSTN, SYSLPDT);                <<IOTAB>>68352000
          MTDS(LPDTDSTN, 0, LPDT, (HLDEV+1)*LPDTSIZE);         <<IOTAB>>68354000
                                                               <<IOTAB>>68356000
          <<--------->>                                        <<IOTAB>>68358000
          <<I/O QUEUE>>                                        <<IOTAB>>68360000
          <<--------->>                                        <<IOTAB>>68362000
                                                               <<IOTAB>>68364000
          INITIOTABLE(CTAB(IOQNUM),SECIOQ,IOQSIZE,             <<IOTAB>>68366000
               IOQDSTN, SYSIOQ);                               <<IOTAB>>68368000
                                                               <<IOTAB>>68370000
          <<---------------------->>                           <<IOTAB>>68372000
          <<DISC I/O REQUEST TABLE>>                           <<IOTAB>>68374000
          <<---------------------->>                           <<IOTAB>>68376000
                                                               <<IOTAB>>68378000
          INITIOTABLE(CTAB(DISCREQTABLE),SECDISC,              <<IOTAB>>68380000
           DISCREQSIZE,DISCREQTABDSTN,SYSDISCREQTAB);          <<IOTAB>>68382000
   <<--------------->>                                         <<IOTAB>>68384000
   <<   SIR TABLE   >>                                         <<IOTAB>>68386000
   <<--------------->>                                         <<IOTAB>>68388000
                                                               <<IOTAB>>68390000
   M := CTAB(MAXRJOB) + CTAB(MAXRSES);                         <<IOTAB>>68392000
   MEMADR := INITTABLE( NSIR+M, SIRSIZE, ANYWHERE'TAB, TRUE,   <<IOTAB>>68394000
      SIRDSTN, SYSSIR);                                        <<IOTAB>>68396000
   SSEA( MEMADR, NSIR+M);                                      <<IOTAB>>68398000
   SSEA( MEMADR+1D, SIRSIZE);                                  <<IOTAB>>68400000
                                                               <<IOTAB>>68402000
   <<----------------------------------------->>               <<IOTAB>>68404000
   <<   MEMORY MANAGEMENT MONITORING BUFFER   >>               <<IOTAB>>68406000
   <<----------------------------------------->>               <<IOTAB>>68408000
                                                               <<IOTAB>>68410000
   INITTABLE( MONBUFSIZE, 1, ANYWHERE'TAB, TRUE, , SYSMONBUF); <<SYPTR>>68412000
                                                               <<IOTAB>>68414000
   <<--------------------------->>                             <<PMBC*>>68416000
   <<   INITIALIZE PMBC TABLE   >>                             <<PMBC*>>68418000
   <<--------------------------->>                             <<PMBC*>>68420000
                                                               <<PMBC*>>68422000
   INIT'PMBC;                                                  <<PMBC*>>68424000
                                                               <<PMBC*>>68426000
MESSAGE(M3057, 1, 6); <<CORE SYSTEM TABLE SET UP DONE>>        <<*8392>>68428000
          <<-----------------------------                               68430000
            BUILD INITIAL SEGMENT TABLE                                 68432000
          ----------------------------->>                               68434000
          HCST := IF LOGICALMAPPING THEN MAXPHYCST             <<*MAP*>>68436000
             ELSE CTAB(CSTNUM);                                <<*MAP*>>68438000
          SEGTLEN := SEGTPDB+SEGDIRLEN;                        <<*MAP*>>68440000
          @SEGXFORM := @SEGT+SEGTLEN;                          <<*MAP*>>68442000
          SEGT := SEGTPDB+SEGLCTLEN+128;      << @DIR >>       <<*MAP*>>68444000
          SEGT(1) := SEGDIRLEN;               << DIR LENGTH >> <<*MAP*>>68446000
          SEGT(2) := SEGTPDB;                 << @LCT >>       <<*MAP*>>68448000
          SEGT(7) := SEGTPDB+SEGLCTLEN;       << @SBUF0 >>     <<*MAP*>>68450000
          SEGT(SEG'HEAD) := 0;             << HEAD AND TAIL >> <<*MAP*>>68452000
          MOVE SEGT(SEG'HEAD+1) := SEGT(SEG'HEAD),             <<*MAP*>>68454000
             ((SEG'TAIL-SEG'HEAD)*2-1);       << LINKS >>      <<*MAP*>>68456000
          SAGL := 0; << STARTING ADDRESS OF GARBAGE LIST >>    <<*MAP*>>68458000
                                                               <<*MAP*>>68460000
          << BUILD GARGAGE ENTRY >>                            <<*MAP*>>68462000
                                                               <<*MAP*>>68464000
          @SEGDIR := @SEGT+SEGTPDB+3; << LOCAL PTR >>          <<*MAP*>>68466000
          SEGDIR := 0;                << TYPE      >>          <<*MAP*>>68468000
          SEGDIR(-1) := SEGDIRLEN;    << RLENGTH   >>          <<*MAP*>>68470000
          SEGDIR(-2) := 0;            << BKWDLINK  >>          <<*MAP*>>68472000
          SEGDIR(-3) := 0;            << FWDLINK   >>          <<*MAP*>>68474000
                                                               <<*MAP*>>68476000
          << LINK GARBAGE ENTRY >>                             <<*MAP*>>68478000
                                                               <<*MAP*>>68480000
          SEGT(SEG'HEAD) := SEGTPDB+3;      << HEAD LINK >>    <<*MAP*>>68482000
          SEGT(SEG'TAIL) := SEGT(SEG'HEAD); << TAIL LINK >>    <<*MAP*>>68484000
          X := 0;                                              <<*MAP*>>68486000
          DO BEGIN                                             <<*MAP*>>68488000
             SEGXFORM(X) := %177400;                           <<*MAP*>>68490000
             END UNTIL (X:=X+1) = HCST;                        <<*MAP*>>68492000
                                                                        68494000
          <<------------------------------                              68496000
            LOAD SYSTEM LIBRARY SEGMENTS                                68498000
          ------------------------------>>                              68500000
            MOVE INBUF := "LOADMAP ";                                   68502000
            LDMAPFNUM := FOPEN(BINBUF);                                 68504000
            LDMAPBUF := "  ";                                           68506000
            MOVE LDMAPBUF(1) := LDMAPBUF,(LDMAP'SIZE-1);       <<03668>>68508000
            FWRITE(LDMAPFNUM,0D,LDMAPBUF,128);                 <<00.DL>>68510000
            FWRITE(LDMAPFNUM,1D,LDMAPBUF,128);                 <<00.DL>>68512000
            MOVE LDMAPBUF:="MPE V   U.FF.VV ";                 <<.VER.>>68514000
            LDMAPBUF(4).LBITE:=COMM(VERSION').RBITE;           <<CONFD>>68516000
            LDMAPBUF(5):=COMM(UPDATEL');                       <<CONFD>>68518000
            LDMAPBUF(6).RBITE:=COMM(FIXLEVEL').LBITE;          <<CONFD>>68520000
            LDMAPBUF(7).LBITE:=COMM(FIXLEVEL').RBITE;          <<CONFD>>68522000
            MOVE LDMAPBUF(64) := "  1 ININ";                   <<01103>>68524000
            IF LOADMAP THEN PRINT(LDMAPBUF(64),-8,0);          <<01103>>68526000
          SLFNUM := FOPEN(SLFILE);                                      68528000
          FREAD(SLFNUM,0D,SLREC0,256);  <<RECORDS 0 AND 1>>             68530000
          SLRTNUM := -1;                                       <<S9090>>68532000
          RTNUM := SLREC0(9)-1;  <<# OF REFERENCE TABLE ENTRIES -1>>    68534000
          I := -1;                                                      68536000
          DO ALLOCATEALL(I:=I+1,0) UNTIL I=RTNUM;                       68538000
          I := FREECSTN-1;                                              68540000
          DO                                                            68542000
            BEGIN                                                       68544000
              FIXSTT(I:=I+1);                                           68546000
              IF CST(I&LSL(2))>0 THEN                                   68548000
                  READCODE(I, CORERES');                       <<01384>>68550000
            END                                                         68552000
          UNTIL I=CSTN;                                                 68554000
          TOS := FLAB(28);                                              68556000
          TOS.(14:2) := 0;  <<RESET READ BIT >>                         68558000
          TOS.(0:4) := 2;   <<RESET LOAD BIT,CLEAR S,R,X BITS>>         68560000
          FLAB(X) := TOS;                                               68562000
          FLCLID := ABSOLUTE(COLD'LOAD'ID);                             68564000
          FLFCBVECT := 0D;                                     <<*FLAB>>68566000
          CHECKSUM;          <<NEW CHECKSUM>>                           68568000
          FLCHECKSUM := TOS; <<UPDATE LABEL>>                           68570000
          DISCADR := FCBDBL(SLFNUM*FCBDSIZE); << ADR FST EXT >><<03603>>68572000
          TOS := DISCADR;                                      <<03603>>68574000
          ABSOLUTE(SLDISCADR2) := TOS;                         <<03603>>68576000
          ABSOLUTE(X:=X-1) := TOS;                             <<03603>>68578000
          SEGDIRENT(DISCADR,SLTYP,FREECSTN,CSTN);              <<03603>>68580000
          DISC(WRITE,LDEV,DISCADR,FLAB,128);                   <<03603>>68582000
          ABSOLUTE(TERMINTLAB) := INTLABEL(ABSOLUTE(TERMEXTLAB) :=      68584000
            PLABEL(TERMNAME));                                          68586000
          ABSOLUTE(CIINTLAB) := INTLABEL(ABSOLUTE(CIEXTLAB) :=          68588000
            PLABEL(CINAME));                                            68590000
          ABSOLUTE(FIXL) := COMM(FIXLEVEL');                   <<CONFD>>68592000
          ABSOLUTE(UPDATEL) := COMM(UPDATEL');                 <<CONFD>>68594000
          ABSOLUTE(VERSION) := COMM(VERSION');                 <<CONFD>>68596000
          SYSGLOBEXT(GLOBMITVERSION) := COMM(MITVERSION);      <<CONFD>>68598000
          SYSGLOBEXT(GLOBMITUPDATE) := COMM(MITUPDATE);        <<CONFD>>68600000
          SYSGLOBEXT(GLOBMITFIX) := COMM(MITFIX);              <<CONFD>>68602000
          SYSGLOBEXT(SYS'STARTUP'OPT) := OPT;                  <<I8884>>68604000
         MESSAGE(M3058, 2, 6); <<SL BINDING COMPLETE>>         <<*8392>>68606000
$PAGE "MAINSEG3  --  LOAD DISC FILES"                                   68608000
          <<---------------------                                       68610000
            INTERNAL INTERRUPTS                                         68612000
          --------------------->>                                       68614000
          LOAD(ININFILE,CSTINDEX,DSTINDEX,0,GLOB,PROCSTART     <<00652>>68616000
                 ,0,FALSE,CSTBLKINDEX,FIRSTCST,NSEG);          <<03004>>68618000
                                                                        68620000
$PAGE "MAINSEG3  --  SET UP I/O PROCESSES AND DRIVERS"                  68622000
          <<------------------                                          68624000
            CREATE PROCESSES                                            68626000
          ------------------>>                                          68628000
          @DRIVERENTRY := @CSDVRAREA;                                   68630000
          DLSIZE(NDLT);  << MAKE ROOM FOR TEMPORARY TABLES >>  <<01384>>68632000
          PUSH(DL);                                                     68634000
          @DLT' := TOS;                                        <<01384>>68636000
          DLTLEN := NDLT * DLTSIZE;                            <<32BND>>68638000
          DLSIZE( DLTLEN);                                     <<32BND>>68640000
          PUSH( DL );                                          <<32BND>>68642000
          @DLTTAB := TOS;                                      <<32BND>>68644000
          MFDS( DLTTAB, DLTDSTN, 0, DLTLEN);                   <<32BND>>68646000
          LINKED := 0;  <<DO CORE RESIDENT ONES FIRST>>                 68648000
  NONCORE:I := 0;   <<PROCESS INDEX>>                                   68650000
          DO IF IOPROC(I*IOPROCSIZE+8).CORERES<>INTEGER(LINKED) THEN    68652000
            BEGIN  <<CREATE PROCESS>>                                   68654000
              TOS := 0;                                                 68656000
              TOS := @IOPROC(INDEX:=I*IOPROCSIZE)&LSL(1);      <<04306>>68658000
              DUPLICATE;                                                68660000
              IF IOPROC(INDEX:=INDEX+8).DRVRTYPE=2 THEN        <<01.EB>>68662000
              IF *=SYSIOPROC,(16) THEN TOS := SIOPROC                   68664000
              ELSE TOS := -1 <<DOESN'T GO IN LOGICAL PROC TABLE>>       68666000
              ELSE BEGIN DEL;TOS := -1; END;                            68668000
              IF IOPROC(INDEX).NOCREATE = 0 THEN               <<06067>>68670000
              TOS:=PROCREATE(*,*,IOPROC(INDEX:=INDEX+1).(0:8), <<01.EB>>68672000
                IF LINKED THEN LKIOSTACK ELSE CRIOSTACK,JUNKWAIT,4,1,1, 68674000
                LINKED*2,IOPROC(INDEX:=INDEX-1).QNUMB)         <<06067>>68676000
              ELSE TOS:=0;                                     <<06067>>68678000
              IF IOPROC(INDEX).DRVRTYPE=2 THEN                 <<01.EB>>68680000
                BEGIN  <<TYPE 2 - PUT PIN IN BUSY TABLE>>               68682000
                  TOS := TOS*PCBSIZE;                                   68684000
                  SYS(ABS(SYSBUSY)+IOPROC(INDEX).QNUMB) := TOS;<<32BND>>68686000
                END                                                     68688000
              ELSE IOPROC(INDEX:=INDEX+1).(0:8):=TOS;<<PIN>>   <<01.EB>>68690000
            END                                                         68692000
          UNTIL (I:=I+1)=NIOPROC;                                       68694000
         IF LINKED THEN                                        <<*8392>>68696000
          MESSAGE(M3059, 3, 6); <<I/O PROCESS CREATION DONE>>  <<*8392>>68698000
          <<--------------                                              68700000
            LOAD DRIVERS                                                68702000
          -------------->>                                              68704000
          DRTN := LOWESTDRT;                                   <<00888>>68706000
          DO                                                            68708000
            BEGIN  <<LOAD IN DRT ORDER>>                                68710000
              IF (UNIT:=INTHS'UNITS(DRTN).NUNIT)=0 THEN        <<00888>>68712000
                BEGIN  <<NOT USED>>                                     68714000
                  DRTN := DRTN+1;                                       68716000
                  GOTO NEXTDRT;                                         68718000
                END;                                                    68720000
              ILTADR := GETDRT( DRTN, DBI);                    <<32BND>>68722000
              TOS := CSDRTN(DRTN.(0:12));                               68724000
              X := DRTN.(12:4);                                         68726000
              ASSEMBLE(TBC 0,X);                                        68728000
              IF <> THEN                                                68730000
                BEGIN <<CS DEVICE>>                                     68732000
                DEL;                                                    68734000
                DRTN := DRTN+1;                                         68736000
                GOTO NEXTDRT;                                           68738000
                END                                                     68740000
              ELSE DEL;                                                 68742000
              I := 0;  <<UNIT COUNTER>>                                 68744000
              N := 0;   <<MAX # OF INTERRUPT HANDLERS>>                 68746000
              DO                                                        68748000
                BEGIN  <<CHECK EACH DIT>>                               68750000
                  IF ABS(ILTADR+IDITP+I)=0 THEN GOTO NEXTDIT;  <<32BND>>68752000
                  DITADR := ABS(X) + SYSBASE;                  <<32BND>>68754000
                  TOS := ABS(DITADR+DDLTP);  <<DLT PTR>>       <<32BND>>68756000
                  DLTINDEX := ( TOS+SYSBASE - DST(DLTDSTN&     <<32BND>>68758000
                               LSL(2)+3));                     <<32BND>>68760000
                  @DLT := @DLTTAB(DLTINDEX);                   <<32BND>>68762000
                  DLTINDEX := DLTINDEX / DLTSIZE;              <<32BND>>68764000
                  IF DLT(DPROC).CORERES=INTEGER(LINKED) THEN GO NEXTDIT;68766000
                  DVRTYPE := DLT(DPROC).DRVRTYPE;                       68768000
                  INTRINDEX := INTRSIZE*DLTINDEX&LSL(1);       <<03004>>68770000
                  DVR'INDEX:=ABS(DITADR+DLDEV)*DVRSIZE;        <<DVRF1>>68772000
                  MOVE DRIV'WNAME:=DVRNAME,(4);                <<*DVR*>>68774000
                  IF DLT'(DLTINDEX)<>0 THEN                    <<03004>>68776000
                    BEGIN <<ALREADY LOADED>>                            68778000
                    CSTINDEX := DLT'(DLTINDEX);                <<03004>>68780000
                    UPDATESTT(CSTINDEX,DRIV'BNAME);<<GET STT >><<*DVR*>>68782000
                    GOTO SETPIN;                               <<0+.04>>68784000
                    END;                                                68786000
                <<LOAD IT>>                                             68788000
                  LOAD(DRIV'BNAME, CSTINDEX, DSTINDEX, 0, GLOB,<<*DVR*>>68790000
                     PROCSTART, LINKED&ASL(1), FALSE,          <<03004>>68792000
                     CSTBLKINDEX, FIRSTCST, NSEG);             <<03004>>68794000
                  UPDATESTT( CSTINDEX); << MAKE SURE STT OF >> <<03004>>68796000
                                << O.B. SEGMENT IS IN 'STT' >> <<03004>>68798000
                  DLT'(DLTINDEX) := CSTINDEX;                           68800000
                  J := 0;                                               68802000
                  DO                                                    68804000
                    BEGIN  <<FIX UP PLABELS FOR MONITOR, INIT, COMP>>   68806000
                      TOS := 0;                                         68808000
                      TOS := DLT(J+DMNTR);                              68810000
                      IF = THEN DDEL                                    68812000
                      ELSE DLT(X) := STTLABEL(*);                       68814000
                    END                                                 68816000
                  UNTIL (J := J+1)=3;                                   68818000
                  IF DLT(DPROC).CORERES=1 THEN                          68820000
                    BEGIN  <<MAKE SURE INIT AND COMP ARE CORE RESIDENT>>68822000
                      J := 0;                                           68824000
                      DO IF DLT(DINIT+J)<>0 AND CST(DLT(X).(8:8)&LSL(2))68826000
                        <0 THEN                                         68828000
                        BEGIN  <<NOT RESIDENT>>                         68830000
                        ERRMESSAGE(M253,                       <<32BND>>68832000
                            ABS(DITADR+DLDEV));                <<DITS*>>68834000
                        END                                             68836000
                      UNTIL (J:=J+1)=2;                                 68838000
                    END;                                                68840000
                  IF DVRTYPE=2 THEN DLT(DPROC).QNUMB := IOPROC(DLT(     68842000
                    DPROC).QNUMB*IOPROCSIZE+8).QNUMB; <<RESOURCE Q #>>  68844000
                <<FIX UP INITIALIZATION PLABEL>>                        68846000
                  TOS := 0;                                    <<0+.04>>68848000
                  TOS := DLT(DINTPL);<<INITIALIZATION STT>>    <<0+.04>>68850000
                  IF = THEN DDEL                                        68852000
                  ELSE DLT(X) := STTLABEL(*);                  <<0+.04>>68854000
                                                               <<03004>>68856000
                << IF THE DRIVER HAS NO INTERNAL DRIVER    >>  <<03004>>68858000
                << ENTRY POINTS, IT IS A DUMMY DRIVER, AND >>  <<03004>>68860000
                << ITS CST ENTRIES MAY BE REMOVED          >>  <<03004>>68862000
                  IF DUMMYDRIVER( DLT, INTRINDEX, FIRSTCST,    <<32BND>>68864000
                            FIRSTCST+NSEG-1, FALSE) THEN       <<03004>>68866000
                                                               <<03004>>68868000
                    << RETURN ALL CST ENTRIES ALLOCATED FOR>>  <<03004>>68870000
                    << THE DUMMY DRIVER.  RETURN THEM IN   >>  <<03004>>68872000
                    << REVERSE ORDER SO THEY WILL BE       >>  <<03004>>68874000
                    << RE-ALLOCATED IN INCREASING ORDER    >>  <<03004>>68876000
                    BEGIN                                      <<03004>>68878000
                    J := FIRSTCST+NSEG-1;                      <<03004>>68880000
                    DO                                         <<03004>>68882000
                       DELETECST( J)                           <<03004>>68884000
                    UNTIL (J:=J-1) < FIRSTCST;                 <<03004>>68886000
                    << MARK AS DUMMY DRIVER, WITH           >> <<03004>>68888000
                    << -( LOGICAL O.B. SEGMENT #) - 1       >> <<03004>>68890000
                    DLT'(DLTINDEX) := -(CSTINDEX-FIRSTCST)-1;  <<03004>>68892000
                    END                                        <<03004>>68894000
                  ELSE        << NOT A DUMMY DRIVER, SO    >>  <<03004>>68896000
                              << PRINT ALL CST ENTRIES     >>  <<03004>>68898000
                    LDMAP( FIRSTCST, NSEG, DRIV'BNAME);        <<*DVR*>>68900000
                                                               <<03004>>68902000
  SETPIN:         IF DVRTYPE=3 THEN ABS(DITADR+DPCBN) :=       <<32BND>>68904000
                   IOPROC(DLT(DPROC).QNUMB*IOPROCSIZE+9).(0:8);<<32BND>>68906000
                <<FIX UP INTERRUPT PLABELS>>                            68908000
                  K := INTR(INTRINDEX);                        <<03004>>68910000
                  IF K>N THEN N := K;  <<# OF INTERRUPT ROUTINES>>      68912000
                  IF ABS(DITADR+DFLAG).SPECIH=1 THEN           <<32BND>>68914000
                     DLT(DINTP):=STTLABEL(INTR(INTRINDEX+1))   <<32BND>>68916000
                  ELSE                                                  68918000
                    BEGIN  <<PRIMARY INTERRUPT HANDLER>>                68920000
                      J := 0;                                           68922000
                      DO                                                68924000
                        BEGIN  <<UPDATE DRT>>                           68926000
                          IF DRTN+J > HIDRT OR                 <<02707>>68928000
                            INTHS'UNITS(DRTN+J) <> 0 AND       <<02707>>68930000
                            J <> 0 THEN                        <<02707>>68932000
                            GOTO DONEINT;  <<FINISHED UPDATE>> <<02707>>68934000
                          TOS := STTLABEL(INTEGER(INTR(INTRINDEX+J+1)));68936000
                          TOS := GETDRT(DRTN+J,PI);            <<03002>>68938000
                          IF = THEN                                     68940000
                            BEGIN  <<NO PREVIOUS HANDLER SPECIFIED>>    68942000
                              DEL;                                      68944000
                              TEMP := TOS;                     <<03002>>68946000
                              PUTDRT(DRTN+J,PI,TEMP);          <<03002>>68948000
                            END                                         68950000
                          ELSE                                          68952000
                            BEGIN  <<MAKE SURE THIS ONE IS THE SAME AS  68954000
                                     THE ONE PREVIOUSLY SPECIFIED>>     68956000
                              ASSEMBLE(CMP);                            68958000
                              IF <> THEN                                68960000
  IHERROR:                      BEGIN  <<DIFFERENT>>                    68962000
                                ERRMESSAGE(M254,DRTN+J);       <<01103>>68964000
                                END;                                    68966000
                            END;                                        68968000
                        END                                             68970000
                      UNTIL (J:=J+1)=K;                                 68972000
  DONEINT:          END;                                                68974000
  NEXTDIT:      END                                                     68976000
              UNTIL (I:=I+1) = UNIT;                                    68978000
              IF N>INTHS'UNITS(DRTN).NINTH THEN INTHS'UNITS(X) <<01283>>68980000
                .NINTH := N;  <<# OF INTERRUPT HANDLERS>>      <<00888>>68982000
              DRTN := DRTN+1;                                           68984000
  NEXTDRT:  END                                                         68986000
          UNTIL DRTN > HIDRT;                                  <<02707>>68988000
      IF CSPRESENT THEN                                        <<WH.24>>68990000
        BEGIN                                                  <<WH.24>>68992000
          K := 1;                                                       68994000
          ADDDVRNUM := 1;                                      <<00.06>>68996000
          M := IF CSTAB(DRIVERENTNUM)=0 THEN 0 ELSE 2;                  68998000
          WHILE K<CSTAB(DRIVERENTNUM) AND LINKED OR K<M AND NOT         69000000
            LINKED DO                                                   69002000
            BEGIN  <<LOAD CS DRIVER>>                                   69004000
              MOVE DRIV'WNAME := DRNAME,(4);                   <<*DVR*>>69006000
              LOAD( DRIV'BNAME, CSTINDEX, DSTINDEX, 0, GLOB,   <<*DVR*>>69008000
                 PROCSTART, LINKED&LSL(1), FALSE,              <<03004>>69010000
                 CSTBLKINDEX, FIRSTCST, NSEG);                 <<03004>>69012000
              UPDATESTT( CSTINDEX);  << MAKE SURE STT OF OB >> <<03004>>69014000
                                     << SEGMENT IS IN 'STT' >> <<03004>>69016000
              J := 0;                                                   69018000
              I := 1;                                                   69020000
              FIRSTDRT := TRUE;                                <<00.04>>69022000
              IF NOT LINKED THEN <<CSDUMMY>>                            69024000
                 @DLT := @DLTTAB(DLTINDEX:=CSDUMMYINDEX)       <<32BND>>69026000
              ELSE                                             <<00.06>>69028000
              BEGIN  <<CONFIGURED OR ADDITIONAL DRIVER>>       <<00.06>>69030000
              DO                                                        69032000
                BEGIN <<FIND CS DRT'S FOR THIS DRIVER>>                 69034000
                LDT'INDEX := I * LDTSIZE;                      <<*LDT*>>69036000
                DVR'INDEX := I * DVRSIZE;                      <<*DVR*>>69038000
                IF NOT(CSDEV17<=LDT'DEVICE'TYPE<=CSDEV19) THEN <<*LDT*>>69040000
                GO LOOKFORCSDRT;                                        69042000
                IF NOT(COMPARE'WORDS(DRNAME, DVRNAME, 4)) THEN <<*DVR*>>69044000
                   GO LOOKFORCSDRT;                            <<*DVR*>>69046000
                DRTN := DVRDRTNUM;                             <<*DVR*>>69048000
                ILTADR := GETDRT( DRTN, DBI);                  <<32BND>>69050000
                DITADR := ABS(ILTADR+IDITP) + SYSBASE;         <<32BND>>69052000
                TOS := ABS(DITADR+DDLTP); <<DLT PTR>>          <<32BND>>69054000
                TOS := TOS+SYSBASE-DST(DLTDSTN&LSL(2)+3);               69056000
                INTRINDEX:=(DLTINDEX:=TOS)/DLTSIZE*INTRSIZE+1;          69058000
                @DLT := @DLTTAB(DLTINDEX);                     <<32BND>>69060000
                INTHS'UNITS(DRTN).NUNIT := 1;                  <<00888>>69062000
                IF FIRSTDRT THEN                               <<00.04>>69064000
                 BEGIN <<DO ONLY ONCE PER DRIVER>>             <<00.04>>69066000
                 TOS := 0;                                     <<00.04>>69068000
                 TOS := DLT(DINTPL); <<INITIALIZATION STT>>    <<0+.04>>69070000
                 IF = THEN DDEL                                <<00.04>>69072000
                 ELSE DLT(X) := STTLABEL(*);                   <<0+.04>>69074000
                 FIRSTDRT := FALSE;                            <<00.04>>69076000
                 END;                                          <<00.04>>69078000
                TOS := STTLABEL(INTEGER(INTR(INTRINDEX)));              69080000
                TOS := GETDRT(DRTN,PI);                        <<03002>>69082000
                IF = THEN                                               69084000
                  BEGIN                                                 69086000
                  DEL;                                                  69088000
                  TEMP := TOS;                                 <<03002>>69090000
                  PUTDRT(DRTN,PI,TEMP);                        <<03002>>69092000
                  END                                                   69094000
                ELSE                                                    69096000
                  BEGIN                                                 69098000
                  ASSEMBLE(CMP);                                        69100000
                  IF <> THEN GOTO IHERROR;                              69102000
                  END;                                                  69104000
  LOOKFORCSDRT: END                                                     69106000
              UNTIL(I:=I+1)>HLDEV;                                      69108000
              IF FIRSTDRT THEN                                 <<00.06>>69110000
                BEGIN <<MUST BE ADDITIONAL DRIVER>>            <<00.06>>69112000
                DLTINDEX := CSDUMMYINDEX+ADDDVRNUM*DLTSIZE;    <<00.06>>69114000
                @DLT := @DLTTAB(DLTINDEX);                     <<32BND>>69116000
                TOS := 0;                                      <<00.06>>69118000
                TOS := DLT(DINTPL);                            <<00.06>>69120000
                IF = THEN DDEL                                 <<00.06>>69122000
                ELSE DLT(X) := STTLABEL(*);                    <<00.06>>69124000
                DLT(0).DRVRTYPE := 1;                          <<00.06>>69126000
                ADDDVRNUM := ADDDVRNUM+1;                      <<00.06>>69128000
                END;                                           <<00.06>>69130000
              END;  <<CONFIGURED OR ADDITIONAL DRIVER>>        <<00.06>>69132000
              TOS := @DRLCMPLABEL;                                      69134000
              I := 0;                                                   69136000
              DO                                                        69138000
               BEGIN  <<PUT LABELS IN DLT>>                             69140000
                  TOS := PS0;   <<GET STT #>>                           69142000
                  IF <> THEN                                            69144000
                    BEGIN   <<PROCEDURE SPECIFIED>>                     69146000
                      X := -S0+STTINDEX;                                69148000
                      TOS := STT(X);                                    69150000
                      IF < THEN DELB  <<EXTERNAL LABEL>>                69152000
                      ELSE                                              69154000
                        BEGIN  <<INTERNAL LABEL>>                       69156000
                          DEL;                                          69158000
                          TOS := TOS&LSL(8)+CSTINDEX;                   69160000
                          TOS.(0:1) := 1;                               69162000
                        END;                                            69164000
                    END;                                                69166000
                  ASSEMBLE(XCH);                                        69168000
                  TOS := TOS+1;  <<POINT TO NEXT LABEL>>                69170000
                END                                                     69172000
              UNTIL (I:=I+1)=5;                                         69174000
              DEL;                                                      69176000
              CSIH'PLABEL := TOS;                                       69178000
              EDITOR'PLABEL := TOS;                                     69180000
              PHYS'DVR'PLABEL := TOS;                                   69182000
              CSSLC'PLABEL := TOS;                                      69184000
              LCM'PLABEL := TOS;                                        69186000
                                                               <<03004>>69188000
              << IF THE DRIVER HAS NO INTERNAL ENTRY       >>  <<03004>>69190000
              << POINTS, IT IS A DUMMY DRIVER, AND ITS     >>  <<03004>>69192000
              << CST ENTRIES MAY BE RELEASED.              >>  <<03004>>69194000
              IF DUMMYDRIVER( DLT, INTRINDEX-1, FIRSTCST,      <<32BND>>69196000
                       FIRSTCST+NSEG-1, TRUE) THEN             <<03004>>69198000
                                                               <<03004>>69200000
                 << RETURN ALL CST'S ALLOCATED TO DRIVER IN>>  <<03004>>69202000
                 << REVERSE ORDER SO THEY MAY BE RE-       >>  <<03004>>69204000
                 << ALLOCATED IN INCREASING ORDER          >>  <<03004>>69206000
                 BEGIN                                         <<03004>>69208000
                 J := FIRSTCST+NSEG-1;                         <<03004>>69210000
                 DO                                            <<03004>>69212000
                    DELETECST( J)                              <<03004>>69214000
                 UNTIL (J:=J-1) < FIRSTCST;                    <<03004>>69216000
                 END                                           <<03004>>69218000
              ELSE          << NOT A DUMMY DRIVER, SO      >>  <<03004>>69220000
                            << PRINT ALL CST'S ALLOCATED   >>  <<03004>>69222000
                 LDMAP( FIRSTCST, NSEG, DRIV'BNAME);           <<*DVR*>>69224000
                                                               <<03004>>69226000
              DRDLTP := DLTINDEX;                                       69228000
              @DRIVERENTRY := @DRIVERENTRY+DRIVERENTRY;                 69230000
              K := K+1;                                                 69232000
            END;                                                        69234000
          I := 1;                                                       69236000
          TEMP := DST(DLTDSTN&LSL(2)+3)-SYSBASE;                        69238000
          WHILE(I:=I+1)<=HLDEV DO                                       69240000
            BEGIN                                              <<*DVR*>>69242000
            DVR'INDEX := I * DVRSIZE;                          <<*DVR*>>69244000
            IF DVRDSBIT = 1 <<DS DEV>> THEN                    <<*DVR*>>69246000
              BEGIN <<LOAD DS DRIVER & UPDATE DLT POIINTER>>            69248000
              LPDT'INDEX := I * LPDTSIZE;                      <<*LPDT>>69250000
              DITADR := LPDT'DIT'PTR + SYSBASE;                <<*LPDT>>69252000
              IF ABS(DITADR+DPROC).CORERES=INTEGER(LINKED) THEN<<32BND>>69254000
                 GO NEXTDSDEV;                                 <<32BND>>69256000
              TOS := ABS(DITADR+DDLTP);                        <<32BND>>69258000
              TOS := S0+TEMP;  <<SYDB REL POINTER TO DLT>>     <<32BND>>69260000
              ABS(X) := TOS;                                   <<32BND>>69262000
              @DLT := @DLTTAB(S0);                             <<32BND>>69264000
              DLTINDEX := TOS/DLTSIZE;                         <<03004>>69266000
              INTRINDEX := INTRSIZE*DLTINDEX&LSL(1);           <<03004>>69268000
              MOVE DRIV'WNAME := DVRNAME, (4);                 <<*DVR*>>69270000
              IF DLT'(DLTINDEX)<>0 THEN                        <<03004>>69272000
                BEGIN <<ALREADY LOADED>>                                69274000
                CSTINDEX := DLT'(DLTINDEX);                    <<03004>>69276000
                UPDATESTT( CSTINDEX,DRIV'BNAME); << GET STT >> <<*DVR*>>69278000
                GOTO NEXTDSDEV;                                <<0+.04>>69280000
                END;                                                    69282000
              LOAD( DRIV'BNAME, CSTINDEX, DSTINDEX, 0, GLOB,   <<*DVR*>>69284000
                 PROCSTART, LINKED&ASL(1), FALSE,              <<03004>>69286000
                 CSTBLKINDEX, FIRSTCST, NSEG);                 <<03004>>69288000
              UPDATESTT( CSTINDEX);  << MAKE SURE STT OF OB >> <<03004>>69290000
                                     << SEGMENT IS IN 'STT' >> <<03004>>69292000
              DLT'(DLTINDEX) := CSTINDEX;                               69294000
              J := 0;                                                   69296000
              DO                                                        69298000
                BEGIN <<FIX UP PLABELS FOR MONITOR,INIT,COMP>>          69300000
                TOS := 0;                                               69302000
                TOS := DLT(J+DMNTR);                                    69304000
                IF = THEN DDEL                                          69306000
                ELSE DLT(X) := STTLABEL(*);                             69308000
                END                                                     69310000
              UNTIL (J:=J+1) =3;                                        69312000
              IF DLT(DPROC).DRVRTYPE=2 THEN DLT(DPROC).QNUMB :=         69314000
                IOPROC(DLT(DPROC).QNUMB*IOPROCSIZE+8).QNUMB;            69316000
                << RESOURCE Q NUMBER>>                                  69318000
              TOS := 0;                                        <<0+.04>>69320000
              TOS := DLT(DINTPL);  <<INITIALIZATION STT>>      <<0+.04>>69322000
              IF = THEN DDEL                                            69324000
              ELSE DLT(X) := STTLABEL(*);                      <<0+.04>>69326000
                                                               <<03004>>69328000
              << IF THE DRIVER HAS NO INTERNAL ENTRY       >>  <<03004>>69330000
              << POINTS, IT IS A DUMMY DRIVER, AND ITS     >>  <<03004>>69332000
              << CST ENTRIES MAY BE RELEASED.              >>  <<03004>>69334000
              IF DUMMYDRIVER( DLT, INTRINDEX, FIRSTCST,        <<32BND>>69336000
                    FIRSTCST+NSEG-1, FALSE) THEN               <<03004>>69338000
                                                               <<03004>>69340000
                 << RETURN ALL CST'S ALLOCATED TO THE      >>  <<03004>>69342000
                 << DRIVER IN REVERSE ORDER, SO THAT THEY  >>  <<03004>>69344000
                 << WILL BE RE-ALLOCATED IN INCREASING     >>  <<03004>>69346000
                 << ORDER.                                 >>  <<03004>>69348000
                 BEGIN                                         <<03004>>69350000
                 J := FIRSTCST+NSEG-1;                         <<03004>>69352000
                 DO                                            <<03004>>69354000
                    DELETECST( J)                              <<03004>>69356000
                 UNTIL (J:=J-1) < FIRSTCST;                    <<03004>>69358000
                 << MARK AS DUMMY DRIVER, WITH       >>        <<03004>>69360000
                 << -(LOGICAL OB SEGMENT #) - 1      >>        <<03004>>69362000
                 DLT'(DLTINDEX) := -(CSTINDEX-FIRSTCST)-1;     <<03004>>69364000
                 END                                           <<03004>>69366000
              ELSE           << NOT A DUMMY DRIVER, SO     >>  <<03004>>69368000
                             << PRINT ALL CST'S ALLOCATED  >>  <<03004>>69370000
                 LDMAP( FIRSTCST, NSEG, DRIV'BNAME);           <<*DVR*>>69372000
                                                               <<03004>>69374000
  NEXTDSDEV:  END;                                                      69376000
            END;                                               <<*DVR*>>69378000
        END;                                                   <<WH.24>>69380000
          IF NOT LINKED THEN                                            69382000
             BEGIN << MAKE REST ABSENT >>                      <<01384>>69384000
              LINKED := 1;                                              69386000
              GOTO NONCORE;  <<DO SECOND PASS>>                         69388000
            END;                                                        69390000
                                                                        69392000
       MTDS(DLTDSTN, 0, DLTTAB, DLTLEN);                       <<32BND>>69394000
       DLSIZE( -DLTLEN ); << RETURN SPACE FOR DLT >>           <<32BND>>69396000
                                                               <<32BND>>69398000
    MESSAGE(M3060, 4, 6); <<DRIVER LOADING COMPLETE>>          <<*8392>>69400000
          <<-------------------                                         69402000
            DELETE TEMPORARY TABLES                                     69404000
          ------------------->>                                         69406000
          ABSOLUTE(CCLOSELAB) := PLABEL(CCLOSENAME);                    69408000
          ABSOLUTE(CSIOWLAB) := PLABEL(CSIOWAITNAME);                   69410000
          MOVE BINBUF := "7DSCHECK";                                    69412000
          ABSOLUTE(DSCHECKLAB) := PLABEL(BINBUF);                       69414000
          MOVE BINBUF := "6DSOPEN";                                     69416000
          ABSOLUTE(DSOPENLAB) := PLABEL(BINBUF);                        69418000
          MOVE BINBUF := "7DSCLOSE";                                    69420000
          ABSOLUTE(DSCLOSELAB) := PLABEL(BINBUF);                       69422000
          MOVE BINBUF := "?MANAGEWRITECONV";                            69424000
          ABSOLUTE(MWRITECONVLAB) := PLABEL(BINBUF);                    69426000
          MOVE BINBUF := ";CONSDSLINE'";                                69428000
          ABSOLUTE(CONSDSLINE'LAB) := PLABEL(BINBUF);                   69430000
          MOVE BINBUF := ";CONSMPLINE'";                       <<MP.00>>69432000
          ABSOLUTE(CONSMPLINE'LAB) := PLABEL(BINBUF);          <<MP.00>>69434000
          MOVE BINBUF := "9CONSMRJE'";                        <<MRJE>>  69436000
          ABSOLUTE(CONSMRJE'LAB) := PLABEL(BINBUF);           <<MRJE>>  69438000
          MOVE BINBUF := ";PLABEL3270'";                       <<00181>>69440000
          SYSGLOBEXT(CONS3270'LAB) := PLABEL(BINBUF);          <<01165>>69442000
          MOVE BINBUF := "8CSHOWCOM";                          <<01165>>69444000
          ABSOLUTE(CONSHOWCOM'LAB) := PLABEL(BINBUF);          <<01165>>69446000
          MOVE BINBUF := "8CXREMOTE";                                   69448000
          ABSOLUTE(CXREMOTELAB) := PLABEL(BINBUF);                      69450000
          MOVE BINBUF := "8CXDSLINE";                                   69452000
          ABSOLUTE(CXDSLINELAB) := PLABEL(BINBUF);                      69454000
          MOVE BINBUF := "5CXRFA";                                      69456000
          ABSOLUTE(CXRFALAB) := PLABEL(BINBUF);                         69458000
          MOVE BINBUF := "7DSIMAGE";                                    69460000
          ABSOLUTE(DSIMAGELAB) := PLABEL(BINBUF);                       69462000
          MOVE BINBUF := "7DSBREAK";                                    69464000
          ABSOLUTE(DSBREAKLAB) := PLABEL(BINBUF);                       69466000
          MOVE BINBUF := "7SDSLDEV";                           <<00.06>>69468000
          ABSOLUTE(SDSLDEVLAB) := PLABEL(BINBUF);              <<00.06>>69470000
          PUSH(DL);                                            <<01384>>69472000
          TOS := TOS-@CSDVRAREA;                               <<01384>>69474000
          DLSIZE(*);  << REMOVE TEMPORARY I/O TABLE AREA >>    <<01384>>69476000
          LPDT'INDEX := SYSDISC * LPDTSIZE;                    <<*LPDT>>69478000
          ABSOLUTE(SYSDIT8) := LPDT'DIT'PTR+SYSBASE+8;         <<*LPDT>>69480000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>69482000
          ABSOLUTE(12+PI) := PLABEL(CLOCKNAME); <<CLOCK INT HANDLER>>   69484000
          ABSOLUTE(12+DBI) := ABSOLUTE(SYSTRL)+SYSBASE; <<CLOCK DB>>    69486000
          ABSOLUTE(CONSLDEV) := CONSPEED&LSL(8)+CONSOLELDEV;            69488000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>69490000
          ABSOLUTE(CONSLDEV) := CONSOLELDEV;                   <<03004>>69492000
          SYSGLOBEXT(SYSCONSPEED) := CONSPEED;                 <<S7651>>69494000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>69496000
                                                                        69498000
          <<----------------------------                                69500000
            CREATE I/O MESSAGE PROCESS                                  69502000
          --------------------------->>                                 69504000
          ABSOLUTE(IOMESSSTOP) := PROCREATE(IOMESSNAME,IOMESSPROC,      69506000
            IOMESSPRI,IOMESSSTACK,9<<MSG wait>>,4,0,1,2,0)     <<02807>>69508000
            & lsl(8) + IOMESSSBIT;                             <<02807>>69510000
          ABSOLUTE(X:=X+1) := %20;                                      69512000
           ABSOLUTE(NPROCSTOP):=5;                                      69514000
                                                               <<PORTS>>69516000
        <<-------------------------------->>                   <<PORTS>>69518000
        << CREATE ICS PORT SERVER PROCESS >>                   <<PORTS>>69520000
        <<-------------------------------->>                   <<PORTS>>69522000
        SYSGLOBEXT(SYSPORT'PIN) := PROCREATE(SYSPORTNAME,0,    <<PORTS>>69524000
             SYSPORTPRI,SYSPORTSTACK,9<<MSG WAIT>>,4,0,1,2,0); <<PORTS>>69526000
                                                               <<PORTS>>69528000
          IF PLABEL (NMMONNAME) <> 0 THEN                      <<AL.00>>69530000
             BEGIN                                             <<AL.00>>69532000
                                                               <<AL.00>>69534000
        <<-------------------------------->>                   <<AL.00>>69536000
        <<    CREATE NM MONITOR PROCESS   >>                   <<AL.00>>69538000
        <<-------------------------------->>                   <<AL.00>>69540000
                                                               <<AL.00>>69542000
             ABSOLUTE(NMMONSTOP) := PROCREATE (NMMONNAME,      <<AL.00>>69544000
                NMMONPROC,NMMONPRI,NMMONSTACK,FATHERWAIT,      <<AL.00>>69546000
                   4,0,TRUE,2,0) & LSL(8) + NMMONBIT;          <<AL.00>>69548000
             ABSOLUTE(NMMONSTOP+1) := 4;    << AWAKE ON MSG >> <<AL.00>>69550000
             ABSOLUTE(NPROCSTOP) := 6;      << ADD TO TOTAL >> <<AL.00>>69552000
             END;                                              <<AL.00>>69554000
                                                               <<AL.00>>69556000
      END <<MAINSEG3>> ;                                       <<AL.00>>69558000
$PAGE "MAINSEG3  --  TABLE SETUP"                                       69560000
$PAGE "MAINSEG4  --  TABLE SETUP"                              <<03580>>69562000
$CONTROL SEGMENT=MAINSEG4                                      <<03580>>69564000
                                                               <<03580>>69566000
  <<------------------------>>                                 <<03580>>69568000
  << Build Tape Label Table >>                                 <<03580>>69570000
  <<------------------------>>                                 <<03580>>69572000
                                                               <<03580>>69574000
   PROCEDURE BUILD'TAPE'LABEL'TABLE;                           <<03580>>69576000
                                                               <<03580>>69578000
COMMENT                                                        <<03580>>69580000
                                                               <<03580>>69582000
   Allocates space for tape label table and fills it with      <<03580>>69584000
   LDEV #'s for tape devices and for non-system-domain discs.  <<04263>>69586000
   The resulting table is an interim table from which LABSEG   <<04263>>69588000
   builds the completed Tape Label Table for use by the system.<<04263>>69590000
   The interim table consists of one word entries, bits (0:14) <<TLT  >>69592000
   contain the qualifying LDEV#, and bits (14:2) contain a "1" <<TLT  >>69594000
   "1" if the LDEV# specifies an actual tape type device(i.e.  <<TLT  >>69596000
   if Device Type = 24).                                       <<TLT  >>69598000
   byte containing a "1" if the LDEV# specifies an actual tape <<04263>>69600000
   type device (i.e. if Device Type = %30).                    <<04263>>69602000
   ;                                                           <<03580>>69604000
                                                               <<03580>>69606000
BEGIN                                                          <<03580>>69608000
DEFINE CLASS'ACC'TYP = (10:6)#;                                <<03580>>69610000
EQUATE SDISC = 31; <<CLASS ACCESS TYPE FOR SERIAL DISC>>       <<03580>>69612000
INTEGER POINTER TLT'LDEVS;                                     <<P8673>>69614000
INTEGER TLT'LDEVS'INDX:= 2,                                    <<03580>>69616000
        LDEV,                                                  <<03580>>69618000
        TLTMAX,                                                <<03580>>69620000
        J,                                                     <<03580>>69622000
        I;                                                     <<03580>>69624000
                                                               <<03580>>69626000
                                                               <<03580>>69628000
  INTEGER                                                      <<*LDT*>>69630000
      LDT'INDEX,                                               <<*LPDT>>69632000
      LPDT'INDEX;                                              <<*LPDT>>69634000
                                                               <<P8673>>69636000
  DLSIZE( HLDEV );                                             <<P8673>>69638000
  PUSH( DL );                                                  <<P8673>>69640000
  @TLT'LDEVS := TOS;                                           <<P8673>>69642000
                                                               <<P8673>>69644000
  I := 1;                                                      <<03580>>69646000
  WHILE (I:=I+1)<=HLDEV DO                                     <<04263>>69648000
    IF LDEV'EXISTS(I) THEN                                     <<04263>>69650000
                                                               <<04263>>69652000
      <<check if tape unit or non-system domain disc>>         <<04263>>69654000
      BEGIN                                                    <<*LDT*>>69656000
      LDT'INDEX := I * LDTSIZE;                                <<*LDT*>>69658000
      LPDT'INDEX := I * LPDTSIZE;                              <<*LPDT>>69660000
      IF  LDT'DEVICE'TYPE = 24 << MAG TAPE >> OR               <<*LDT*>>69662000
          (LPDT'NON'SYS'DOMAIN = 1 LAND                        <<*LPDT>>69664000
           0 <= LDT'DEVICE'TYPE <= 9) THEN                     <<*LDT*>>69666000
                                                               <<04263>>69668000
        BEGIN <<Include in Tape Label Table>>                  <<04263>>69670000
        TLT'LDEVS(TLT'LDEVS'INDX):= I&LSL(2);                  <<TLT  >>69672000
                                                               <<04263>>69674000
        <<indicate tape units with "1" in right byte>>         <<04263>>69676000
        IF LDT'DEVICE'TYPE = 24 << MAG TAPE >> THEN            <<*LDT*>>69678000
          TLT'LDEVS(TLT'LDEVS'INDX).(14:2):= 1;                <<TLT  >>69680000
                                                               <<04263>>69682000
        TLT'LDEVS'INDX:= TLT'LDEVS'INDX+1;                     <<04263>>69684000
        END;                                                   <<04263>>69686000
      END;                                                     <<*LDT*>>69688000
                                                               <<03580>>69690000
<<ALLOCATE SPACE>>                                             <<03580>>69692000
TLTMAX := (TLT'LDEVS'INDX-1) * TLTSIZE;                        <<32BND>>69694000
TLT'LDEVS(0):= TLTMAX;                                         <<03580>>69696000
TLT'LDEVS(1):= TLT'LDEVS'INDX-2;                               <<03580>>69698000
INITTABLE(TLTMAX,1,TEMPORARY'TAB,0,TLTDSTN);                   <<32BND>>69700000
MTDS(TLTDSTN,0,TLT'LDEVS,TLT'LDEVS'INDX);                      <<32BND>>69702000
ABSENT( TLTDSTN, -1);                                          <<32BND>>69704000
                                                               <<32BND>>69706000
ABSOLUTE(AVR) := 1; << TURN ON AVR >>                          <<32BND>>69708000
DLSIZE( -HLDEV );                                              <<P8673>>69710000
END; <<BUILD'TAPE'LABEL'TABLE>>                                <<03580>>69712000
$CONTROL SEGMENT=MAINSEG4                                               69714000
  PROCEDURE MAINSEG4;                                                   69716000
      BEGIN                                                             69718000
        INTEGER POINTER TABLE;                                 <<MPEIV>>69720000
        DEFINE  STOP'ENT0'X = TABLE(0) #,                      <<MPEIV>>69722000
                STOP'ENT1'X = (STOP'ENT0'X+MINSTOPSIZE) #;     <<MPEIV>>69724000
        LOGICAL DONE;                                          <<01384>>69726000
        INTEGER IDDSEGSIZE,  << SIZE OF IDD TABLE >>           <<02614>>69728000
                ODDSEGSIZE,  << SIZE OF ODD TABLE >>           <<02614>>69730000
                INITIDDSIZE, <<# SECTORS IDD CREATED WITH>>    <<*8392>>69732000
                IDDTSIZE,    <<  SIZE OF IDD/ODD IN WORDS>>    <<*8392>>69734000
                JMATSEGSIZE,                                   <<01384>>69736000
                MAXNIDDENT, <<MAX # OF IDD SUBENTRIES>>                 69738000
                NIDDENT,    <<# OF IDD SUBENTRIES>>                     69740000
                INDEX',                                        <<SD.00>>69742000
                STOP'DSTSIZE,                                  <<MPEIV>>69744000
                STOP'PCB'EXTSIZE,                              <<MPEIV>>69746000
                STOP'TABSIZE,                                  <<MPEIV>>69748000
                LEN,                                           <<dctab>>69750000
                JOBNUMB,    <<CURRENT JOB NUMBER>>             <<TL.02>>69752000
                FPOINT,   <<FREE POINTER>>                     <<*LDT*>>69754000
                LDT'INDEX,                                     <<*DVR*>>69756000
                LPDT'INDEX,                                    <<*DVR*>>69758000
                DVR'INDEX;                                     <<*DVR*>>69760000
        DOUBLE LENGTH;       << LENGTH OF EXTENT IN SECTORS >> <<02614>>69762000
        DOUBLE LSECT;                                          <<03557>>69764000
        DOUBLE NLINES,EOF,EXTADR;                              <<00.+4>>69766000
        INTEGER LDEV';                                         <<00.+4>>69768000
        ARRAY WELBUF(0:1);                                     <<P8673>>69770000
        BYTE ARRAY DESTROYED'BEFORE(*)=PB :=                   <<01103>>69772000
           28,"- DESTROYED BEFORE WARMSTART";                  <<01103>>69774000
        BYTE ARRAY DESTROYED'DURING(*)=PB :=                   <<01103>>69776000
           27,"- DESTROYED DURING RECOVERY";                   <<01103>>69778000
        DOUBLE  DCOREADDR;                                     <<01384>>69780000
        LOGICAL BANK     = DCOREADDR,                          <<01384>>69782000
                COREADDR = DCOREADDR+1;                        <<01384>>69784000
        INTEGER CLABEL;                                        <<01384>>69786000
        DOUBLE  VDSTART;  << VM STARTING SECTOR >>             <<MPEIV>>69788000
        LOGICAL VDSTART1 = VDSTART,                            <<MPEIV>>69790000
                VDSTART2 = VDSTART+1;                          <<MPEIV>>69792000
                                                               <<MPEIV>>69794000
       INTEGER NRIMB,I;                                        <<03002>>69796000
       ARRAY IMB (0:3);                                        <<03002>>69798000
   INTEGER ARRAY CMHDR(0:255); <<CMHDRUNICATION ARRAY>>                 69800000
   INTEGER COMMDSTN;        <<CMHDRUNICATION DATA SEG #>>               69802000
                                                                        69804000
   ASSEMBLE( RSW );                                            <<32BND>>69806000
   IF TOS.(8:8) <> CLRSW THEN HELP;                            <<32BND>>69808000
   VDSTART1 := ABS(ABS(SYSVDSENTRY)+SYSBASE+HOSTARTSECTORWORD);<<32BND>>69810000
   VDSTART2 := ABS(ABS(SYSVDSENTRY)+SYSBASE+LOSTARTSECTORWORD);<<32BND>>69812000
   <<--------------------->>                                   <<32BND>>69814000
   <<   CS DATA SEGMENT   >>                                   <<32BND>>69816000
   <<--------------------->>                                   <<32BND>>69818000
                                                               <<32BND>>69820000
   CSTAB(GROUPENTPTR) := CSTAB;                                <<32BND>>69822000
   CSTAB(DRIVERENTPTR) := CSTAB;                               <<32BND>>69824000
   MEMADR := INITTABLE(CSTAB+CSDVRAREASIZE,1,TEMPORARY'TAB,0,  <<32BND>>69826000
      CSDSTN);                                                 <<32BND>>69828000
   MTDS( CSDSTN, 0, CSTAB, CSTAB);                             <<32BND>>69830000
   MTDS( CSDSTN, CSTAB, CSDVRAREA, CSDVRAREASIZE);             <<32BND>>69832000
   SSEA( MEMADR, TABSIZE);                                     <<32BND>>69834000
   ABSENT( CSDSTN, -1);                                        <<32BND>>69836000
                                                               <<32BND>>69838000
   <<----------------------------->>                           <<32BND>>69840000
   <<   REPLY INFORMATION TABLE   >>                           <<32BND>>69842000
   <<----------------------------->>                           <<32BND>>69844000
                                                               <<32BND>>69846000
   MEMADR := INITTABLE(2048,1,TEMPORARY'TAB,0,RITDSTN);        <<32BND>>69848000
   SSEA( MEMADR+1D, 39);                                       <<32BND>>69850000
   SSEA( MEMADR+2D, 4);                                        <<32BND>>69852000
   ABSENT( RITDSTN, -1);                                       <<32BND>>69854000
                                                               <<32BND>>69856000
   <<------------------------------->>                         <<32BND>>69858000
   <<   UCOP REQUEST QUEUE (UCRQ)   >>                         <<32BND>>69860000
   <<------------------------------->>                         <<32BND>>69862000
                                                               <<32BND>>69864000
   MEMADR := INITTABLE(CTAB(UCRQNUM)+2,UCRQSIZE,               <<32BND>>69866000
      TEMPORARY'TAB,0,UCRQDSTN);                               <<32BND>>69868000
   SSEA( MEMADR, CTAB(UCRQNUM));                               <<32BND>>69870000
   ABSENT( UCRQDSTN, -1);                                      <<32BND>>69872000
                                                               <<32BND>>69874000
   <<---------------------------------->>                      <<32BND>>69876000
   <<   INIT P-P COMMUNICATION TABLE   >>                      <<32BND>>69878000
   <<---------------------------------->>                      <<32BND>>69880000
                                                               <<32BND>>69882000
   MEMADR := INITTABLE(CTAB(PCBNUM)+1,PPCTSIZE,TEMPORARY'TAB,  <<PPCOM>>69884000
      0,PPCTDSTN);                                             <<32BND>>69886000
   ABSENT(PPCTDSTN,-1);                                        <<32BND>>69888000
                                                               <<32BND>>69890000
   <<--------------------------------->>                       <<32BND>>69892000
   <<   JOB-PROCESS CROSS REF TABLE   >>                       <<32BND>>69894000
   <<--------------------------------->>                       <<32BND>>69896000
                                                               <<32BND>>69898000
   MEMADR := INITTABLE( CTAB(PCBNUM)+1, 1,                     <<JXREF>>69900000
               TEMPORARY'TAB, 0, JPXREFDSTN);                  <<32BND>>69902000
   SSEA( MEMADR, CTAB(PCBNUM));                                <<32BND>>69904000
   SSEA( MEMADR+1D, 1);                                        <<32BND>>69906000
   ABSENT( JPXREFDSTN, -1);                                    <<32BND>>69908000
                                                               <<32BND>>69910000
   <<---------------->>                                        <<*JIT*>>69912000
   <<   SYSTEM JIT   >>                                        <<*JIT*>>69914000
   <<---------------->>                                        <<*JIT*>>69916000
                                                               <<*JIT*>>69918000
   INITTABLE(67,1,TEMPORARY'TAB,FALSE,SJITDSTN);               <<*JIT*>>69920000
   << INITIALIZATION OF JIT DONE IN PROGEN >>                  <<*JIT*>>69922000
   ABSENT( SJITDSTN, -1);                                      <<*JIT*>>69924000
                                                               <<*JIT*>>69926000
   <<---------------->>                                        <<*JIT*>>69928000
   <<   SYSTEM JDT   >>                                        <<*JIT*>>69930000
   <<---------------->>                                        <<*JIT*>>69932000
                                                               <<*JIT*>>69934000
   INITTABLE(SJDTSIZE,1,TEMPORARY'TAB,FALSE,SJDTDSTN);         <<*JIT*>>69936000
   << INITIALIZATION OF JDT DONE IN PROGEN >>                  <<*JIT*>>69938000
   ABSENT( SJDTDSTN, MAXSJDTSIZE);                             <<*JIT*>>69940000
                                                                        69942000
          <<-----------                                                 69944000
            WARMSTART                                                   69946000
          ----------->>                                                 69948000
                                                                        69950000
          IF WARMSTART THEN                                             69952000
            BEGIN                                                       69954000
                                                                        69956000
            DISC(READ,SYSDISC,INFOD(IDDLOC),INBUF,4);          <<01384>>69958000
            IDDSEGSIZE := INBUF.(8:8)&LSL(7);                  <<01384>>69960000
            INSERT'ABSENT'DST(INFOD(IDDLOC),IDDDSTN,IDDSEGSIZE,         69962000
                                                  MAXIDDTSIZE);         69964000
            DISC(READ,SYSDISC,INFOD(JMATLOC),INBUF,2);         <<01384>>69966000
            JMATSEGSIZE := INBUF.(8:8)&LSL(7);                 <<01384>>69968000
            INSERT'ABSENT'DST(INFOD(JMATLOC),JMATDSTN,                  69970000
                                JMATSEGSIZE,MAXJMSIZE);                 69972000
            DISC(READ,SYSDISC,INFOD(ODDLOC),INBUF,2);                   69974000
            ODDSEGSIZE := INBUF.(8:8)&LSL(7);                  <<02614>>69976000
            INSERT'ABSENT'DST(INFOD(ODDLOC),ODDDSTN,                    69978000
                                 ODDSEGSIZE,MAXODDTSIZE);               69980000
            GO COOLST;                                                  69982000
            END  <<WARMSTART>>;                                         69984000
                                                                        69986000
                                                                        69988000
   <<---------------------->>                                  <<JMAT*>>69990000
   <<   JOB MASTER TABLE   >>                                  <<JMAT*>>69992000
   <<---------------------->>                                  <<JMAT*>>69994000
                                                               <<JMAT*>>69996000
   INITTABLE(JMATTSIZE,1,TEMPORARY'TAB,FALSE,JMATDSTN);        <<JMAT*>>69998000
   ZEROBUF( BUF, JMATSIZE);                                    <<JMAT*>>70000000
   BUF := MAXJMATSIZE&LSL(8) + INITJMATSIZE;                   <<JMAT*>>70002000
   BUF(1) := JMATSIZE;                                         <<JMAT*>>70004000
   BUF(2) := JMATSIZE;                                         <<JMAT*>>70006000
   BUF(SCHEDTAILP) := SCHEDHEADP;                              <<JMAT*>>70008000
   BUF(5) := %40001;                                           <<JMAT*>>70010000
   BUF(7) := %100001;                                          <<JMAT*>>70012000
   BUF(10) := CTAB(MAXRSES);                                   <<JMAT*>>70014000
   BUF(12) := CTAB(MAXRJOB);                                   <<JMAT*>>70016000
   MTDS( JMATDSTN, 0, BUF, JMATSIZE);                          <<JMAT*>>70018000
   ABSENT( JMATDSTN, MAXJMSIZE);                               <<JMAT*>>70020000
                                                               <<*XDD*>>70022000
   <<---------------------------->>                            <<*XDD*>>70024000
   <<   INPUT DEVICE DIRECTORY   >>                            <<*XDD*>>70026000
   <<---------------------------->>                            <<*XDD*>>70028000
                                                               <<*XDD*>>70030000
   INITIDDSIZE := ((HLDEV + 3) * XDDHEADSIZE) & LSR(7) + 1;    <<*8392>>70032000
   IDDTSIZE    := INITIDDSIZE & LSL(7);                        <<*8392>>70034000
   MEMADR := INITTABLE(IDDTSIZE,1,TEMPORARY'TAB,FALSE,IDDDSTN);<<*XDD*>>70036000
   SSEA( MEMADR, MAXIDDSIZE&LSL(8)+INITIDDSIZE);               <<*XDD*>>70038000
   SSEA( MEMADR+1D, XDDHEADSIZE&LSL(8)+XDDSUBSIZE);            <<*XDD*>>70040000
   SSEA( MEMADR+3D, 1);                                        <<*XDD*>>70042000
                                                               <<*XDD*>>70044000
   I := 0;                                                     <<*XDD*>>70046000
   K := 3;                                                     <<*XDD*>>70048000
   J := 12;                                                    <<*XDD*>>70050000
   WHILE (I:=I+1) <= HLDEV DO                                  <<*XDD*>>70052000
      IF LDEV'EXISTS(I) THEN                                   <<*XDD*>>70054000
         BEGIN                                                 <<*XDD*>>70056000
         << LOOK FOR INPUT/OUTPUT ACCEPTING DEVICES >>         <<*XDD*>>70058000
         LDT'INDEX := I * LDTSIZE;                             <<*XDD*>>70060000
         LPDT'INDEX := I * LPDTSIZE;                           <<*XDD*>>70062000
         IF LDT'ACCESS'TYPE = CONINOUT OR                      <<*XDD*>>70064000
            LDT'ACCESS'TYPE = NCONINOUT OR                     <<*XDD*>>70066000
            LDT'ACCESS'TYPE = DIRACCESS AND                    <<*XDD*>>70068000
            LPDT'NON'SYS'DOMAIN = 1 THEN                       <<*XDD*>>70070000
            BEGIN  << INPUT OR OUTPUT >>                       <<*XDD*>>70072000
            LDT'XDD'HEAD'ENTRY'PTR := K;                       <<*XDD*>>70074000
            K := K + 1;                                        <<*XDD*>>70076000
            SSEA(MEMADR+DOUBLE(J+2), J+1); << TAIL >>          <<*XDD*>>70078000
            SSEA(MEMADR+DOUBLE(J+3), I);   << LDEV >>          <<*XDD*>>70080000
            J := J+4;                                          <<*XDD*>>70082000
            END;                                               <<*XDD*>>70084000
         END;                                                  <<*XDD*>>70086000
                                                               <<*XDD*>>70088000
   I := 0;                                                     <<*XDD*>>70090000
   WHILE (I:=I+1) <= HLDEV DO                                  <<*XDD*>>70092000
      IF LDEV'EXISTS(I) THEN                                   <<*XDD*>>70094000
         BEGIN                                                 <<*XDD*>>70096000
         << LOOK FOR INPUT-ONLY DEVICES >>                     <<*XDD*>>70098000
         LDT'INDEX := I * LDTSIZE;                             <<*XDD*>>70100000
         IF LDT'ACCESS'TYPE = SERINPUT THEN                    <<*XDD*>>70102000
            BEGIN  << INPUT ONLY >>                            <<*XDD*>>70104000
            LDT'XDD'HEAD'ENTRY'PTR := K;                       <<*XDD*>>70106000
            K := K + 1;                                        <<*XDD*>>70108000
            SSEA(MEMADR+DOUBLE(J+2), J+1); << TAIL >>          <<*XDD*>>70110000
            SSEA(MEMADR+DOUBLE(J+3), I);   << LDEV >>          <<*XDD*>>70112000
            J := J+4;                                          <<*XDD*>>70114000
            END;                                               <<*XDD*>>70116000
         END;                                                  <<*XDD*>>70118000
                                                               <<*XDD*>>70120000
   SSEA( MEMADR+DOUBLE(SUBAREAP), J);                          <<*XDD*>>70122000
   ABSENT( IDDDSTN, MAXIDDTSIZE);                              <<*XDD*>>70124000
                                                               <<*XDD*>>70126000
   <<----------------------------->>                           <<*XDD*>>70128000
   <<   OUTPUT DEVICE DIRECTORY   >>                           <<*XDD*>>70130000
   <<----------------------------->>                           <<*XDD*>>70132000
                                                               <<*XDD*>>70134000
   MEMADR := INITTABLE(IDDTSIZE,1,TEMPORARY'TAB,FALSE,ODDDSTN);<<*8392>>70136000
   SSEA( MEMADR, MAXODDSIZE&LSL(8)+INITIDDSIZE);               <<*XDD*>>70138000
   SSEA( MEMADR+1D, XDDHEADSIZE&LSL(8)+XDDSUBSIZE);            <<*XDD*>>70140000
   SSEA( MEMADR+3D, %100001);                                  <<*XDD*>>70142000
   SSEA( MEMADR+4D, 1);  << OUTFENCE >>                        <<*XDD*>>70144000
   SSEA( MEMADR+10D, 9);                                       <<*XDD*>>70146000
                                                               <<*XDD*>>70148000
   I := 0;                                                     <<*XDD*>>70150000
   K := 3;                                                     <<*XDD*>>70152000
   J := 12;                                                    <<*XDD*>>70154000
   WHILE (I:=I+1) <= HLDEV DO                                  <<*XDD*>>70156000
      IF LDEV'EXISTS(I) THEN                                   <<*XDD*>>70158000
         BEGIN                                                 <<*XDD*>>70160000
         << LOOK FOR INPUT/OUTPUT ACCEPTING DEVICES >>         <<*XDD*>>70162000
         LDT'INDEX := I * LDTSIZE;                             <<*XDD*>>70164000
         LPDT'INDEX := I * LPDTSIZE;                           <<*XDD*>>70166000
         IF LDT'ACCESS'TYPE = CONINOUT OR                      <<*XDD*>>70168000
            LDT'ACCESS'TYPE = NCONINOUT OR                     <<*XDD*>>70170000
            LDT'ACCESS'TYPE = DIRACCESS AND                    <<*XDD*>>70172000
            LPDT'NON'SYS'DOMAIN = 1 THEN                       <<*XDD*>>70174000
            BEGIN   << INPUT AND OUTPUT >>                     <<*XDD*>>70176000
            <<INX TO HEAD ALREADY IN LDEVTAB FROM FIXUP OF IDD><<*XDD*>>70178000
            K := K+1;                                          <<*XDD*>>70180000
            SSEA( MEMADR+DOUBLE(J+2), J+1); << TAIL >>         <<*XDD*>>70182000
            SSEA( MEMADR+DOUBLE(J+3), I);   << LDEV >>         <<*XDD*>>70184000
            J := J+4;                                          <<*XDD*>>70186000
            END;                                               <<*XDD*>>70188000
         END;                                                  <<*XDD*>>70190000
                                                               <<*XDD*>>70192000
   I := 0;                                                     <<*XDD*>>70194000
   WHILE (I:=I+1) <= HLDEV DO                                  <<*XDD*>>70196000
      IF LDEV'EXISTS(I) THEN                                   <<*XDD*>>70198000
         BEGIN                                                 <<*XDD*>>70200000
         << LOOK FOR OUPUT-ONLY DEVICES >>                     <<*XDD*>>70202000
         LDT'INDEX := I * LDTSIZE;                             <<*XDD*>>70204000
         IF LDT'ACCESS'TYPE = SEROUTPUT THEN                   <<*XDD*>>70206000
            BEGIN   <<OUTPUT ONLY>>                            <<*XDD*>>70208000
            LDT'XDD'HEAD'ENTRY'PTR := K;                       <<*XDD*>>70210000
            K := K+1;                                          <<*XDD*>>70212000
            SSEA( MEMADR+DOUBLE(J+2), J+1); << TAIL >>         <<*XDD*>>70214000
            SSEA( MEMADR+DOUBLE(J+3), I);   << LDEV >>         <<*XDD*>>70216000
            J := J+4;                                          <<*XDD*>>70218000
            END;                                               <<*XDD*>>70220000
         END;                                                  <<*XDD*>>70222000
                                                               <<*XDD*>>70224000
   SSEA( MEMADR+DOUBLE(SUBAREAP), J);                          <<*XDD*>>70226000
   ABSENT( ODDDSTN, MAXODDTSIZE);                              <<*XDD*>>70228000
                                                               <<*XDD*>>70230000
   ABSOLUTE(NUMSSECT) := 0;                                    <<*XDD*>>70232000
   ABSOLUTE(NUMSSECT1) := 0;                                   <<*XDD*>>70234000
                                                               <<*XDD*>>70236000
COOLST:                                                        <<*XDD*>>70238000
   ABSOLUTE(INITINTLAB):=INTLABEL(ABSOLUTE(INITEXTLAB):=       <<*XDD*>>70240000
                         PLABEL(INITNAME));                    <<*XDD*>>70242000
   MOVE BINBUF:="7SPOOLIN";                                    <<*XDD*>>70244000
   ABSOLUTE(SPOOLININTLAB):=INTLABEL(ABSOLUTE(SPOOLINEXTLAB)   <<*XDD*>>70246000
                                      :=PLABEL(BINBUF));       <<*XDD*>>70248000
   MOVE BINBUF:="8SPOOLOUT";                                   <<*XDD*>>70250000
   ABSOLUTE(SPOOLOUTINTLAB):=INTLABEL(ABSOLUTE(SPOOLOUTEXTLAB) <<*XDD*>>70252000
                                      :=PLABEL(BINBUF));       <<*XDD*>>70254000
   MOVE BINBUF:="6RECLOG";                                     <<*XDD*>>70256000
   ABSOLUTE(RECLOGDELTAP):=INTLABEL(ABSOLUTE(RECLOGPLABEL)     <<*XDD*>>70258000
                                :=PLABEL(BINBUF));             <<*XDD*>>70260000
   MOVE BINBUF:="8ULOGPROC";                                   <<*XDD*>>70262000
   ABSOLUTE(ULOGDELTAP):=INTLABEL(ABSOLUTE(ULOGPLABEL)         <<*XDD*>>70264000
                                 :=PLABEL(BINBUF));            <<*XDD*>>70266000
   MOVE BINBUF:="7RESTART";                                    <<*XDD*>>70268000
   ABSOLUTE(ULOGRSTARTDELTAP) :=                               <<*XDD*>>70270000
      INTLABEL(ABSOLUTE(ULOGRSTARTPLABEL) := PLABEL(BINBUF));  <<*XDD*>>70272000
                                                               <<*XDD*>>70274000
                                                               <<fmavt>>70276000
   <<------------------------------------>>                    <<fmavt>>70278000
   <<   FILE MULTI-ACCESS VECTOR TABLE   >>                    <<fmavt>>70280000
   <<------------------------------------>>                    <<fmavt>>70282000
                                                               <<fmavt>>70284000
   MEMADR := INITTABLE(192,1,TEMPORARY'TAB,FALSE,FMAVTDSTN);   <<fmavt>>70286000
   SSEA( MEMADR, 192);                                         <<fmavt>>70288000
   SSEA( MEMADR+1D, 6);                                        <<fmavt>>70290000
   SSEA( MEMADR+2D, 3072);                                     <<fmavt>>70292000
   ABSENT( FMAVTDSTN, 3072);                                   <<fmavt>>70294000
                                                                        70296000
          X := JMATDSTN&LSL(2)+2;                                       70298000
          TOS := DST(X).(8:8);  << HIGH ORDER ADDR >>          <<01756>>70300000
          TOS := DST(X:=X+1);                                           70302000
          INFOD(JMATLOC) := TOS;                                        70304000
          X := IDDDSTN&LSL(2)+2;                                        70306000
          TOS := DST(X).(8:8);  << HIGH ORDER ADDR >>          <<01756>>70308000
          TOS := DST(X:=X+1);                                           70310000
          TOS := DST(X:=X+3).(8:8);  << HIGH ORDER ADDR >>     <<01756>>70312000
          TOS := DST(X:=X+1);                                           70314000
          INFOD(ODDLOC) := TOS;                                         70316000
          INFOD(IDDLOC) := TOS;                                         70318000
          TOS := DCTAB0(KILOSECTS);                                     70320000
          X := 1000; << CONVERT FROM KILOSECTORS TO SECTORS>>  <<*LDT*>>70322000
          ASSEMBLE(LDXA,LMPY;CAB,LDXA;MPY,ZERO;DADD);                   70324000
               <<MULTIPLY A INTEGER BY A DOUBLE>>                       70326000
          ABSOLUTE(MAXSSECT1) := TOS;                                   70328000
          ABSOLUTE(MAXSSECT) := TOS;                                    70330000
          ABSOLUTE(EXTSSECT) := CTAB0(EXTSSECT');                       70332000
          <<-------------                                               70334000
            WELCOME MESSAGE                                             70336000
          --------------->>                                             70338000
          MEMSEG := ROUND(LOGONDSTSIZE);                       <<01384>>70340000
          DCOREADDR:= INITTABLE(MEMSEG, 1, TEMPORARY'TAB,      <<32BND>>70342000
                                 FALSE);                       <<32BND>>70344000
          IF LOGONLOC = 0 THEN                                          70346000
            BEGIN                                                       70348000
            INSERTDST(DCOREADDR,LOGONDSTN1,MEMSEG,0);          <<32BND>>70350000
            INSERTDST(DCOREADDR,LOGONDSTN2,MEMSEG,0);          <<32BND>>70352000
          <<SSEA(DCOREADDR, 0);>>                              <<01384>>70354000
            SSEA(DCOREADDR+1D, MEMSEG);  << LENGTH >>          <<01489>>70356000
            ABSENT(LOGONDSTN1,LOGONDSTSIZE);                            70358000
            ABSENT(LOGONDSTN2,LOGONDSTSIZE);                            70360000
            END                                                         70362000
          ELSE                                                          70364000
            BEGIN                                                       70366000
            IF LOGONLOC=LOGONLOC1 THEN                                  70368000
              BEGIN                                                     70370000
              INSERTDST(DCOREADDR,LOGONDSTN2,MEMSEG,0);        <<32BND>>70372000
            <<SSEA(DCOREADDR, 0);>>                            <<01384>>70374000
              SSEA(DCOREADDR+1D, MEMSEG);  << LENGTH >>        <<01489>>70376000
              ABSENT(LOGONDSTN2,LOGONDSTSIZE);                          70378000
              END                                                       70380000
            ELSE                                                        70382000
              BEGIN                                                     70384000
              INSERTDST(DCOREADDR,LOGONDSTN1,MEMSEG,0);        <<32BND>>70386000
            <<SSEA(DCOREADDR, 0);>>                            <<01384>>70388000
              SSEA(DCOREADDR+1D, MEMSEG);  << LENGTH >>        <<01489>>70390000
              ABSENT(LOGONDSTN1,LOGONDSTSIZE);                          70392000
              END;                                                      70394000
            TOS := INFOD(LOGONLOC)-VDSTART;                             70396000
            DELB;                                                       70398000
            TOS := TOS/NSECTPAGE;                                       70400000
            L := S0;                                                    70402000
            M := TOS+WELMESPAGES;                                       70404000
            DO                                                          70406000
              BEGIN                                                     70408000
              TOS := SYS(ABS(SYSVDSMAP)+L.(0:12));             <<32BND>>70410000
              X := L.(12:4);                                            70412000
              ASSEMBLE(TSBC 0,X);                                       70414000
              SYS(ABS(SYSVDSMAP)+L.(0:12)) := TOS;             <<32BND>>70416000
              END                                                       70418000
            UNTIL (L:=L+1)>=M;                                          70420000
            DISC(READ,SYSDISC,INFOD(LOGONLOC),WELBUF,2);       <<P8673>>70422000
            IF LOGICAL(LOGONLOC) THEN I:=LOGONDSTN2 ELSE                70424000
              I := LOGONDSTN1;                                          70426000
            INSERTDST(DCOREADDR,I,WELBUF(1),0);                <<P8673>>70428000
            DISC'(READ,SYSDISC,INFOD(LOGONLOC),                         70430000
              DCOREADDR,LOGONDSTSIZE);                         <<01384>>70432000
            LOGONLOC := I;                                              70434000
            SSEA(DCOREADDR, %100000);                          <<01384>>70436000
            ABSENT(LOGONLOC,LOGONDSTSIZE);                              70438000
            END;                                                        70440000
          ABSOLUTE(DSTLOGON) := LOGONLOC;                               70442000
          X := LOGONDSTN1&LSL(2)+2;                                     70444000
          TOS:=DST(X);                                         <<MPEIV>>70446000
          TOS := DST(X:=X+1);                                           70448000
          TOS:=DST(X:=X+3);                                    <<MPEIV>>70450000
          TOS := DST(X:=X+1);                                           70452000
          INFOD(LOGONLOC2) := TOS;                                      70454000
          INFOD(X:=X-1) := TOS;                                         70456000
          INFO(LOADMODE) := 0;                                          70458000
          DISC(WRITE,SYSDISC,D'L(INFOSECTOR)),INFO,INFOSIZE);           70460000
   <<--------------------->>                                   <<32BND>>70462000
   <<   C.I. LOG ON DST   >>                                   <<32BND>>70464000
   <<--------------------->>                                   <<32BND>>70466000
                                                               <<32BND>>70468000
   MEMADR := INITTABLE(4,128,TEMPORARY'TAB,0,CILOGDSTN);       <<32BND>>70470000
   TEMP := (CTAB(MAXRSES)+3)&LSR(2)&LSL(2);                    <<32BND>>70472000
   SSEA( MEMADR, TEMP&LSL(8)+4);  <<MAX&CUR SIZE>>             <<32BND>>70474000
   SSEA( MEMADR+1D, 128);   <<ENTRY SIZE>>                     <<32BND>>70476000
   ABSENT( CILOGDSTN, TEMP&LSL(7));                            <<32BND>>70478000
                                                               <<32BND>>70480000
   <<---------------------->>                                  <<dctab>>70482000
   <<   TAPE LABEL TABLE   >>                                  <<dctab>>70484000
   <<---------------------->>                                  <<dctab>>70486000
                                                               <<dctab>>70488000
   BUILD'TAPE'LABEL'TABLE;                                     <<dctab>>70490000
                                                               <<dctab>>70492000
   <<-------------------------->>                              <<dctab>>70494000
   <<   LOGICAL DEVICE TABLE   >>                              <<dctab>>70496000
   <<-------------------------->>                              <<dctab>>70498000
                                                               <<dctab>>70500000
   LEN := (HLDEV+1) * (LDTSIZE+LDTXSIZE);                      <<dctab>>70502000
   INITTABLE( LEN, 1, TEMPORARY'TAB, FALSE, LDTDSTN);          <<dctab>>70504000
   MTDS( LDTDSTN, 0, LDT, LEN);                                <<dctab>>70506000
   ABSENT( LDTDSTN, -1);                                       <<dctab>>70508000
                                                               <<dctab>>70510000
   <<----------------------------------------->>               <<dctab>>70512000
   <<   DEVICE CLASS TABLE  AND  TTDT TABLE   >>               <<dctab>>70514000
   <<----------------------------------------->>               <<dctab>>70516000
                                                               <<dctab>>70518000
   LEN := DCTH'SEGMENT'SIZE;                                   <<*7777>>70520000
   INITTABLE( LEN, 1, TEMPORARY'TAB, FALSE, DCTDSTN);          <<dctab>>70522000
   MTDS( DCTDSTN, 0, DCT'HEAD, LEN);                           <<dctab>>70524000
   ABSENT( DCTDSTN, -1);                                       <<dctab>>70526000
                                                               <<dctab>>70528000
   <<------------------>>                                      <<32BND>>70530000
   <<   VOLUME TABLE   >>                                      <<32BND>>70532000
   <<------------------>>                                      <<32BND>>70534000
                                                               <<32BND>>70536000
   INITTABLE(MVOL+1, VTABSIZE, TEMPORARY'TAB, 0, VTABDSTN);    <<32BND>>70538000
   MTDS( VTABDSTN, 0, VTAB, TABSIZE);                          <<32BND>>70540000
   ABSENT( VTABDSTN, -1);                                      <<32BND>>70542000
                                                               <<32BND>>70544000
   <<----------------------->>                                 <<32BND>>70546000
   <<   ASSOCIATION TABLE   >>                                 <<32BND>>70548000
   <<----------------------->>                                 <<32BND>>70550000
                                                               <<32BND>>70552000
   INITTABLE(HLDEV+1, ASS'SIZE, TEMPORARY'TAB, 0, ASS'DST);    <<32BND>>70554000
   ABSENT( ASS'DST, -1);                                       <<32BND>>70556000
                                                               <<32BND>>70558000
   <<-------------------------->>                              <<32BND>>70560000
   <<   MOUNTED VOLUME TABLE   >>                              <<32BND>>70562000
   <<-------------------------->>                              <<32BND>>70564000
                                                               <<32BND>>70566000
   MEMADR := INITTABLE(MVTABTSIZE,1,TEMPORARY'TAB,0,MVTABDSTN);<<32BND>>70568000
   SSEA( MEMADR, MVTABSIZE&LSL(8)+MVTABMAX);                   <<32BND>>70570000
   DIRDISCADDR1.(0:8) := SYSDISC;                              <<32BND>>70572000
   SSEA( MEMADR+2D, DIRDISCADDR1);  << HODA >>                 <<32BND>>70574000
   SSEA( MEMADR+3D, DIRDISCADDR2);  << LODA >>                 <<32BND>>70576000
   ABSENT (MVTABDSTN, MVTABTSIZE);                             <<32BND>>70578000
                                                               <<32BND>>70580000
   <<------------------------------->>                         <<32BND>>70582000
   <<   PRIVATE VOLUME USER TABLE   >>                         <<32BND>>70584000
   <<------------------------------->>                         <<32BND>>70586000
                                                               <<32BND>>70588000
   MEMADR:=INITTABLE(PVUSERTSIZE,1,TEMPORARY'TAB,0,PVUSERDSTN);<<32BND>>70590000
   SSEA( MEMADR, PVUSERTSIZE);                                 <<32BND>>70592000
   SSEA( MEMADR+3D, MAXPVUSERTSIZE);                           <<32BND>>70594000
   SSEA( MEMADR+4D, 5);  << FIRST AVAILABLE WORD >>            <<32BND>>70596000
   ABSENT( PVUSERDSTN, MAXPVUSERTSIZE);                        <<32BND>>70598000
                                                               <<32BND>>70600000
                                                               <<PORTS>>70602000
          <<-------------------------->>                       <<PORTS>>70604000
          << IOWAIT PORT VECTOR TABLE >>                       <<PORTS>>70606000
          <<-------------------------->>                       <<PORTS>>70608000
          INIT'IOWAIT'VECTOR'TABLE;                            <<PORTS>>70610000
                                                               <<PORTS>>70612000
          <<--------------------------------->>                <<PORTS>>70614000
          << PORT PROCEDURE DICTIONARY TABLE >>                <<PORTS>>70616000
          <<--------------------------------->>                <<PORTS>>70618000
          INIT'PORT'DICT'TABLE;                                <<PORTS>>70620000
                                                               <<PORTS>>70622000
          <<------------------>>                               <<MPEIV>>70624000
          << BREAKPOINT TABLE >>                               <<MPEIV>>70626000
          <<------------------>>                               <<MPEIV>>70628000
                                                               <<MPEIV>>70630000
                                                               <<MPEIV>>70632000
          << GET SIZE OF TWO TABLES IN BREAKPOINT DST >>       <<MPEIV>>70634000
          STOP'TABSIZE := ROUND((CTAB(STOPNUM)+1)*MAXSTOPSIZE);<<MPEIV>>70636000
          << PCB EXT. TABLE SIZE = MIN OF # OF PCB'S AND >>    <<MPEIV>>70638000
          << MAXIMUM NUMBER OF ENTRIES                   >>    <<MPEIV>>70640000
          STOP'PCB'EXTSIZE :=                                  <<MPEIV>>70642000
             IF CTAB(PCBNUM) <= STOP'TABSIZE/MINSTOPSIZE       <<MPEIV>>70644000
             THEN CTAB(PCBNUM)                                 <<MPEIV>>70646000
             ELSE STOP'TABSIZE/MINSTOPSIZE;                    <<MPEIV>>70648000
          STOP'PCB'EXTSIZE:=ROUND(STOP'PCB'EXTSIZE);<<M>>      <<MPEIV>>70650000
          STOP'DSTSIZE := STOP'PCB'EXTSIZE+STOP'TABSIZE;       <<MPEIV>>70652000
                                                               <<MPEIV>>70654000
          MEMSEG := STOP'DSTSIZE;                              <<MPEIV>>70656000
          DLSIZE(MEMSEG);                                      <<MPEIV>>70658000
          PUSH(DL);                                            <<MPEIV>>70660000
          @TABLE := TOS;                                       <<MPEIV>>70662000
          PUSH(DB);                                            <<MPEIV>>70664000
          TOS := TOS + @TABLE;                                 <<32BND>>70666000
          INSERTDST(*,STOPDSTN,MEMSEG,0);                      <<32BND>>70668000
                                                               <<MPEIV>>70670000
          ABSOLUTE(SYSSTOPS) := 0;  << MARK TABLE UNLOCKED >>  <<MPEIV>>70672000
          << ENTRY(0) OF PCB EXT. TABLE >>                     <<MPEIV>>70674000
          TABLE(0) := STOP'PCB'EXTSIZE;                        <<MPEIV>>70676000
                                                               <<MPEIV>>70678000
          << ENTRY(0) OF BREAKPOINT TABLE >>                   <<MPEIV>>70680000
          TABLE(STOP'ENT0'X) := STOP'TABSIZE;                  <<MPEIV>>70682000
          << HEAD FREE LIST >>                                 <<MPEIV>>70684000
          TABLE(STOP'ENT0'X+1) := STOP'ENT0'X+MINSTOPSIZE;     <<MPEIV>>70686000
                                                               <<MPEIV>>70688000
          << ENTRY(1) OF BREAKPOINT TABLE             >>       <<MPEIV>>70690000
          << FREE ENTRY - REST OF TABLE (LESS 1 WORD) >>       <<MPEIV>>70692000
          TABLE(STOP'ENT1'X) := STOP'DSTSIZE-STOP'ENT1'X-1;    <<MPEIV>>70694000
          TABLE(STOP'ENT1'X).(0:1) := 1;      <<MARK FREE    >><<MPEIV>>70696000
          TABLE(STOP'ENT1'X+1) := STOP'ENT1'X;<<FORWARD LINK >><<MPEIV>>70698000
          TABLE(STOP'ENT1'X+2) := STOP'ENT1'X;<<BACKWARD LINK>><<MPEIV>>70700000
          << LAST WORD OF TABLE >>                             <<MPEIV>>70702000
          TABLE(STOP'DSTSIZE-1) := 1; << MARK USED ENTRY >>    <<MPEIV>>70704000
                                                               <<MPEIV>>70706000
          ABSENT (STOPDSTN,-1);                                <<MPEIV>>70708000
          DLSIZE(-MEMSEG);                                     <<MPEIV>>70710000
                                                               <<MPEIV>>70712000
MESSAGE(M3061, 5, 6); <<TABLE SET UP COMPLETE>>                <<*8392>>70714000
   <<------------------------------->>                                  70716000
   <<   LOG BUFFERS AND PROCESSES   >>                                  70718000
   <<------------------------------->>                                  70720000
                                                                        70722000
   MEMADR := INITTABLE( CTAB0(LOGRECSIZE), 128,                         70724000
      TEMPORARY'TAB, FALSE, LOG1DSTN);                                  70726000
   ABSENT( LOG1DSTN, -1);                                               70728000
   MEMADR := INITTABLE( CTAB0(LOGRECSIZE), 128,                         70730000
      TEMPORARY'TAB, FALSE, LOG2DSTN);                                  70732000
   ABSENT( LOG2DSTN, -1);                                               70734000
                                                                        70736000
   ABS(LOGSTOP) := CREATE( LOGFILE, LOGPROC, LOGPRI,                    70738000
      LOGSTACK, FATHERWAIT, 4, 0, 1, 2, 0)&LSL(8)+LOGSBIT;              70740000
   ABS( X:=X+1) := %20;                                                 70742000
                                                                        70744000
   << SET LOG EVENT MASKS - 3 WORDS >>                                  70746000
   ABS( LOGBITS')   := CTAB0( LOGBITS);                                 70748000
   ABS( LOGBITS'+1) := CTAB0( LOGBITS+1);                               70750000
   ABS( LOGBITS'+2) := CTAB0( LOGBITS+2);                               70752000
   TOS := LOG1DSTN;                                                     70754000
   TOS.(0:2) := 1;  << CURRENT BUFFER >>                       <<LOG2*>>70756000
   ABS( LOGBUF1) := TOS;                                                70758000
   ABS( LOGBUF2) := LOG2DSTN;                                           70760000
   ABS( LOGRECSIZE') := CTAB0( LOGRECSIZE);                             70762000
   ABS( LOGFILESIZE') := CTAB0( LOGFILESIZE);                           70764000
                                                                        70766000
           <<----------------                                           70768000
             CREATE MEMLOGP                                             70770000
           ----------------->>                                          70772000
           ABSOLUTE(MEMLGSTOP):=CREATE(MEMLGFILE,MEMLGPROC,MEMLGPRI,    70774000
                                MEMLGSTACK,FATHERWAIT,4,0,1,2,0)&LSL(8)+70776000
                                MEMLGSBIT;                              70778000
           ABSOLUTE(X:=X+1):=%20;                                       70780000
           <<-------------------------------                     RH.PV  70782000
             CREATE PV RECOGNITION PROCESS                       RH.PV  70784000
           ------------------------------->>                   <<RH.PV>>70786000
           CREATE (PVPROCFILE,%222,PVPRI,PVSTACK,FATHERWAIT,   <<RH.PV>>70788000
                  4,0,1,2,0);                                  <<RH.PV>>70790000
                                                                        70792000
$PAGE "MAINSEG4  --  FINISH UP"                                         70794000
                                                                        70796000
          <<-------------                                               70798000
            CREATE UCOP                                                 70800000
          ------------->>                                               70802000
          ABSOLUTE(UCOPSTOP) := CREATE(UCOPFILE,UCOPPROC,UCOPPRI,       70804000
            UCOPSTACK,FATHERWAIT,4,0,1,2,0)&LSL(8)+UCOPSBIT;            70806000
          ABSOLUTE(X:=X+1) := %20;                                      70808000
                                                                        70810000
          <<-----------------------------------                         70812000
            CREATE POWER FAIL RESTART PROCESS                           70814000
          ----------------------------------->>                         70816000
          CREATE(PFAILFILE,PFAILPROC,PFAILPRI,PFAILSTACK,               70818000
                 JUNKWAIT,4,0,1,2,0);                                   70820000
          <<-----------------------------------                         70822000
            CREATE DEVICE RECOGNITION PROCESS                           70824000
          ----------------------------------->>                         70826000
          ABSOLUTE(DEVRECSTOP) := CREATE(DEVRECFILE,DEVRECPROC,         70828000
             DEVRECPRI,DEVRECSTACK,JUNKWAIT,4,0,1,2,0)&LSL(8)           70830000
             +DEVRECSBIT;                                               70832000
          ABSOLUTE(X:=X+1) := %20;                                      70834000
                                                                        70836000
          <<---------------------                                       70838000
            CREATE LOAD PROCESS                                         70840000
          --------------------->>                                       70842000
          CREATE(LOADFILE,LOADPROC,LOADPRI,LOADSTACK,                   70844000
            JUNKWAIT,4,0,1,2,0);                                        70846000
                                                                        70848000
                                                                        70850000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>70852000
          <<-------------------------------------->>           <<00888>>70854000
          <<SET PI AND DBI FOR NON-CONFIGURED DRTS>>           <<00888>>70856000
          <<-------------------------------------->>           <<00888>>70858000
          DRTN:=LOWESTDRT;                                     <<03603>>70860000
          DO                                                   <<00888>>70862000
             BEGIN <<REPEAT FOR ALL DRTS>>                     <<00888>>70864000
             IF INTHS'UNITS(DRTN).NUNIT=0 AND                  <<00888>>70866000
             GETDRT(DRTN,PI)=0 THEN                            <<03002>>70868000
                BEGIN <<DRT NOT CONFIGURED>>                   <<00888>>70870000
                PUTDRT(DRTN,PI,GHOSTEXTLAB);                   <<03002>>70872000
                PUTDRT(DRTN,DBI,TEMP'CPVA);                    <<03002>>70874000
                END;                                           <<00888>>70876000
             END                                               <<00888>>70878000
          UNTIL (DRTN := DRTN+1) > HIDRT;                      <<02707>>70880000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>70882000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>70884000
          <<--------------------------------------                      70886000
            BRING IN I/O INITIALIZATION SEGMENTS                        70888000
          -------------------------------------->>                      70890000
          K := 1; <<INDEX FOR DS DEVICES>>                              70892000
          DRTN := 3;                                                    70894000
          DO IF INTHS'UNITS(DRTN).NUNIT <> 0 THEN                       70896000
            BEGIN  <<FOUND A REAL DRT>>                                 70898000
              N := INTHS'UNITS(DRTN).NINTH; << #  INT. HNDLRS>><<01478>>70900000
              TEMP := GETDRT( DRTN, DBI);                      <<32BND>>70902000
              I := 0;                                                   70904000
              WHILE (I:=I+1)<N DO                                       70906000
                BEGIN  <<HOOK UP CONSECUTIVE DRTS TO THIS ILT>>         70908000
                  IF DRTN+I > HIDRT OR                         <<02707>>70910000
                     INTHS'UNITS(DRTN+I)<>0 THEN               <<01478>>70912000
                    BEGIN  <<REACHED LIMIT FOR THIS DRT>>               70914000
                      N := I;                                           70916000
                      GOTO DONEILT;                                     70918000
                    END;                                                70920000
                  PUTDRT(DRTN+I,DBI,TEMP);                     <<03002>>70922000
                END;                                                    70924000
  DONEILT:    IF GETDRT(DRTN,PI) = 0 THEN                      <<03002>>70926000
                BEGIN  <<NO PRIMARY HANDLER SPECIFIED>>                 70928000
                  I := 0;                                               70930000
                  DO PUTDRT(DRTN+I,PI,PLABEL(GIPNAME))         <<03002>>70932000
                  UNTIL (I:=I+1)=N;                                     70934000
                END;                                                    70936000
            END                                                         70938000
            ELSE IF GETDRT(DRTN,PI) = 0 THEN                   <<03002>>70940000
                   BEGIN <<PUT GHOST PLABEL IN PI>>                     70942000
                    PUTDRT(DRTN,PI,GHOSTEXTLAB);               <<03002>>70944000
                    PUTDRT(DRTN,DBI,TEMP'CPVA);                <<03603>>70946000
                   END                                                  70948000
          UNTIL (DRTN := DRTN+1) > HIDRT;                      <<02707>>70950000
                                                                        70952000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>70954000
          <<---------------------------                                 70956000
            CREATE PROGENITOR PROCESS                                   70958000
          --------------------------->>                                 70960000
          CREATE(PROGFILE,PROGPROC,PROGPRI,PROGSTACK,ACTIVE,            70962000
          4,0,0,2,0);                                          <<MPEIV>>70964000
      MESSAGE(M3062, 6, 6); <<SYSTEM PROC CREAT DONE>>         <<*8392>>70966000
          <<---------------------------->>                     <<00.DL>>70968000
          <<WRITE LOADMAP & UPDATE LABEL>>                     <<00.DL>>70970000
          <<---------------------------->>                     <<00.DL>>70972000
                                                                        70974000
          I:=-128;                                             <<00.DL>>70976000
          DTEMP:=2D;                                           <<00.DL>>70978000
          DO                                                   <<00.DL>>70980000
            FWRITE(LDMAPFNUM,DTEMP,LDMAPBUF(I:=I+128),128)     <<00.DL>>70982000
          UNTIL (DTEMP:=DTEMP+1D)>26D;                         <<00.DL>>70984000
            DISC(READ,SYSDISC,LOADMAPADR,FLAB,128);                     70986000
            CHECKSUM;                                                   70988000
            FLCHECKSUM := TOS;                                          70990000
            DISC(WRITE,SYSDISC,LOADMAPADR,FLAB,128);                    70992000
                                                                        70994000
   <<----------------------------------------------------->>   <<32BND>>70996000
   <<   ICS GLOBAL CELLS FOR DISPATCHER AND PSEUDO-INTS   >>   <<32BND>>70998000
   <<----------------------------------------------------->>   <<32BND>>71000000
                                                               <<32BND>>71002000
   ICS(2):=SYSBASE; <<DISPATCHER DB>>                          <<32BND>>71004000
   TOS:=0; <<DAMN COMPILER>>                                   <<32BND>>71006000
   TOS:=PLABEL(DISPATCHNAME);                                  <<32BND>>71008000
   ICS(-1):=LOGICAL(S0) LAND %100377;  <<DISP STATUS>>         <<32BND>>71010000
   ICS(-2):=INTLABEL(*);<<DISPATCHER DELTA P>>                 <<32BND>>71012000
   ICS(-JCUT') := ABSOLUTE(SYSJCUT)+SYSBASE;                   <<32BND>>71014000
   TOS := 0;                                                   <<32BND>>71016000
   TOS := PLABEL(PSINTNAME);  <<PSEUDO INTERRUPT PLABEL>>      <<32BND>>71018000
   ICS(-PSTA) := LOGICAL(S0) LAND %100377;                     <<32BND>>71020000
   ICS(-PADDR) := INTLABEL(*);                                 <<32BND>>71022000
                                                               <<32BND>>71024000
          <<-----------------------                                     71026000
            DIRECTORY SPACE TABLE                                       71028000
          ----------------------->>                                     71030000
          ABSENT(DIRDSTN,-1);                                           71032000
          ABSENT (DIRSPDSTN,-1);                               <<RV.PV>>71034000
                                                                        71036000
          <<-----------------------------                               71038000
            WRITE SEGMENT TABLE TO DISK                                 71040000
          ----------------------------->>                               71042000
          << CHECK WHETHER SL ENTRY HAS TOO MANY >>            <<*MAP*>>71044000
          << UNUSED SEGLIST ENTRIES              >>            <<*MAP*>>71046000
                                                               <<*MAP*>>71048000
          @SEGDIR := @SEGT+SEGT(SEG'HEAD+SLTYP);<<LOCAL PTR>>  <<*MAP*>>71050000
          IF SEGDIR(4).(8:8)-SEGDIR(4).(0:8) > 20 THEN         <<*MAP*>>71052000
             BEGIN << MORE THAN 20 UNUSED ENTRIES >>           <<*MAP*>>71054000
             TOS := SEGDIR(-1);   << OLD LENGTH >>             <<*MAP*>>71056000
             SEGDIR(4).(8:8) := SEGDIR(4).(0:8)+20;            <<*MAP*>>71058000
             I := 21+SEGDIR(4).(8:8)*3; << NEW LENGTH >>       <<*MAP*>>71060000
             SEGDIR(-1) := I+3;                                <<*MAP*>>71062000
                                                               <<*MAP*>>71064000
             << BUILD NEW GARBAGE ENTRY >>                     <<*MAP*>>71066000
                                                               <<*MAP*>>71068000
             @SEGDIR := @SEGDIR+I+3;<<LOCAL PNTR>>             <<*MAP*>>71070000
             SEGDIR(-1) := TOS-I-3; <<LEN=OLD LEN-NEW LEN>>    <<*MAP*>>71072000
             SEGDIR := 0;           <<TYPE = GARBAGE>>         <<*MAP*>>71074000
                                                               <<*MAP*>>71076000
             << LINK INTO GARGABE CHAIN >>                     <<*MAP*>>71078000
                                                               <<*MAP*>>71080000
             SEGDIR(-2) := 0;            <<BKWDLINK>>          <<*MAP*>>71082000
             SEGDIR(-3) := SEGT(SEG'HEAD);<<FWDLINK >>         <<S8512>>71084000
             SEGT(SEG'HEAD) := @SEGDIR-@SEGT;  <<HEAD LINK>>   <<*MAP*>>71086000
             @SEGDIR := SEGDIR(-3)+@SEGT;<<NEXT GARBAGE>>      <<*MAP*>>71088000
             SEGDIR(-2) := SEGT(SEG'HEAD); <<TAIL LINK>>       <<*MAP*>>71090000
             END;                                              <<*MAP*>>71092000
                                                               <<*MAP*>>71094000
          << ADJUST LINKS IN LST ENTRIES FOR >>                <<*MAP*>>71096000
          << LCT AND BUFFERS                 >>                <<*MAP*>>71098000
                                                               <<*MAP*>>71100000
          I := -1;                                             <<*MAP*>>71102000
          WHILE (I:=I+1) <= 8 DO                               <<*MAP*>>71104000
             BEGIN       << EACH ENTRY TYPE >>                 <<*MAP*>>71106000
             TOS := SEGT(SEG'HEAD+I);   << HEAD LINK >>        <<*MAP*>>71108000
             WHILE S0 <> 0 DO                                  <<*MAP*>>71110000
                BEGIN                  << EACH CHAINED ENTRY >><<*MAP*>>71112000
                @SEGDIR := @SEGT+TOS;   << LOCAL PTR >>        <<*MAP*>>71114000
                TOS := SEGDIR(-3); << SAVE OLD FWD LINK >>     <<*MAP*>>71116000
                << UPDATE FDWLINK AND BKWDLINK >>              <<*MAP*>>71118000
                IF SEGDIR(-3) <> 0 THEN                        <<*MAP*>>71120000
                   SEGDIR(-3) := SEGDIR(-3)+SEGLCTLEN+128;     <<*MAP*>>71122000
                IF SEGDIR(-2) <> 0 THEN                        <<*MAP*>>71124000
                   SEGDIR(-2) := SEGDIR(-2)+SEGLCTLEN+128;     <<*MAP*>>71126000
                END; <<WHILE>>                                 <<*MAP*>>71128000
             DEL;  <<LINK>>                                    <<*MAP*>>71130000
             << UPDATE HEAD/TAIL LINKS >>                      <<*MAP*>>71132000
             IF SEGT(SEG'HEAD+I) <> 0 THEN                     <<*MAP*>>71134000
                SEGT(SEG'HEAD+I) := SEGT(SEG'HEAD+I)+          <<*MAP*>>71136000
                   SEGLCTLEN+128;                              <<*MAP*>>71138000
             IF SEGT(SEG'TAIL+I) <> 0 THEN                     <<*MAP*>>71140000
                SEGT(SEG'TAIL+I) := SEGT(SEG'TAIL+I)+          <<*MAP*>>71142000
                   SEGLCTLEN+128;                              <<*MAP*>>71144000
             END; <<WHILE>>                                    <<*MAP*>>71146000
                                                               <<*MAP*>>71148000
          I := SEGTLEN+SEGLCTLEN+128;                          <<*MAP*>>71150000
          MOVE SEGT(I-1) := SEGT(SEGTLEN-1),(-SEGDIRLEN);      <<*MAP*>>71152000
          DST(SEGTDSTN&LSL(2)) := (I+3)&LSR(2);                <<.LST.>>71154000
          PUSH(DB);                                                     71156000
          TOS := TOS+@SEGT;                                             71158000
          DST(X:=X+3) := TOS;                                           71160000
          DST(X:=X-1) := TOS;                                           71162000
          ABSENT(SEGTDSTN,CTAB(LSTSIZE));                      <<.LST.>>71164000
                                                                        71166000
          IF CHANGES OR LOADFROMTAPE THEN                      <<01299>>71168000
            BEGIN                                              <<01299>>71170000
            MESSAGE(M2452, BANK0);                             <<01299>>71172000
            END;                                               <<01299>>71174000
            << SETUP FOR COMMUNICATION DATA SEGMENT TO BE>>             71176000
            << USED BY PROGEN.  THE FORMAT OF THE DATA   >>             71178000
            << IS:  WORD 0   - POINTER TO START OF CTAB0 >>             71180000
            <<      WORD 1   - POINTER TO START OF CTAB  >>             71182000
            <<      WORD 2   - START UP OPTION           >>             71184000
            <<      WORD 3   - RECOVER LOST DISC SPACE FL>>             71186000
            <<      WORD 256 - CTAB0 ARRAY               >>             71188000
            <<      WORD 256+CTAB0SIZE - CTAB ARRAY      >>             71190000
            <<                                           >>             71192000
            << COMMUNICATION DATA SEGMENT DST # IS PASSED>>             71194000
            << VIA SYSGLOG EXTENTION CELL %122           >>             71196000
                                                                        71198000
            COMMDSTN := GETENTRY(DSTDSTN);                              71200000
            INITTABLE(512,1,TEMPORARY'TAB,FALSE,COMMDSTN);              71202000
            ZEROBUF(CMHDR,256);                                         71204000
            CMHDR := 256;  <<SETUP POINTER TO CTAB0>>                   71206000
            CMHDR(1) := 256+CTAB0SIZE;  <<POINTER TO CTAB>>             71208000
            CMHDR(2) := OPT;  <<START-UP OPTION>>                       71210000
            CMHDR(3) := RECOVERY;<<RECOVER LOST DISC SPAC FLAG>>        71212000
            CMHDR(4) := IF LOADFROMTAPE THEN                   <<I8895>>71214000
                           COMM(SERIALDISCLOAD').LOADFOS       <<I8895>>71216000
                        ELSE 0;                                <<I8895>>71218000
            << MOVE CMHDR, CTAB0 AND CTAB ARRAYS TO MAKE UP >>          71220000
            << THE COMMUNICATION DATA SEGMENT               >>          71222000
            MTDS(COMMDSTN,0,CMHDR,256);                                 71224000
            MTDS(COMMDSTN,CMHDR,CTAB0,CTAB0SIZE);                       71226000
            MTDS(COMMDSTN,CMHDR(1),CTAB,CTABSIZE);                      71228000
            SYSGLOBEXT(%122) := COMMDSTN;                               71230000
            ABSENT(COMMDSTN,-1);                                        71232000
                                                                        71234000
                                                               <<S7828>>71236000
          << UNLOCK ALL CS/80 DISC DRIVES SO THAT IF WE >>     <<S7828>>71238000
          << DIE EARLY IN PROGEN THE PACK CAN STILL BE  >>     <<S7828>>71240000
          << SPUN DOWN.  NOTE THAT TO UNLOCK A DISC WE  >>     <<S7828>>71242000
          << MUST DO AN I/O (ENABLE RELEASE TIMEOUT).   >>     <<S7828>>71244000
                                                               <<S7828>>71246000
          UNLOCK'CS80;                                         <<S7828>>71248000
          CS80'LOCK := FALSE;                                  <<S7828>>71250000
                                                               <<03553>>71252000
  << WARNING!  INITIAL SHOULD NOT PERFOM ANY I/O         >>    <<03553>>71254000
  << OPERATIONS AFTER THIS POINT, BECAUSE BE ARE ABOUT   >>    <<03553>>71256000
  << TO INITIALIZE THE I/O HARDWARE.  THIS INCLUDES NOT  >>    <<03553>>71258000
  << MAKING A CALL TO A PROCEDURE WHICH IS NOT RESIDENT  >>    <<03553>>71260000
  << AND WOULD THUS CAUSE A SWAP.                        >>    <<03553>>71262000
                                                               <<02510>>71264000
          << -------------- >>                                 <<02510>>71266000
          << SETUP STARFISH >>                                 <<02510>>71268000
          << -------------- >>                                 <<02510>>71270000
                                                               <<02510>>71272000
          RESETSTARFISH;                                       <<02510>>71274000
          <<INITIALIZE DST REL INDEX OF LAST ALLOCATED>>       <<WH.20>>71276000
          <<SYSTEM DST AND CST                        >>       <<WH.20>>71278000
          ABSOLUTE(MAXSYSDST):=DST(3)-4;                       <<WH.20>>71280000
          ABSOLUTE(MAXSYSCST):=CST(3)-4+CTAB(DSTNUM)&LSL(2);   <<WH.20>>71282000
          ASSEMBLE(RSW);                                       <<00888>>71284000
          IF TOS.(8:8) <> CLRSW THEN ASSEMBLE(HALT 14);        <<02510>>71286000
$IF X1=OFF << ******* SERIES II,III UNIQUE ******* >>          <<00888>>71288000
          TOS := CONSOLEDRT;                                            71290000
          TOS := %100000;  <<MASTER CLEAR>>                             71292000
          ASSEMBLE(CIO 1; BL*-1; DEL);  <<SHUT OFF INTERRUPTS AND ECHO>>71294000
$IF X1=ON  << ******* SERIES 33 UNIQUE ******* >>              <<00888>>71296000
   <<  FIND OUT WHAT IMB'S EXIST               >>              <<03002>>71298000
   <<  RMSK RETURNS ZERO IF IMB DOESN'T EXIST  >>              <<03002>>71300000
                                                               <<03002>>71302000
   NRIMB := IF MULTI'IMB'SYS THEN 3 ELSE 0;                    <<C8392>>71304000
   TOS := -1D;                                                 <<03002>>71306000
   TOS := -1D;                                                 <<03002>>71308000
   ASSEMBLE( SMSK;                                             <<03002>>71310000
             RMSK );  << IMB 0 = S-0, IMB 3 = S-3 >>           <<03002>>71312000
   X := 0;                                                     <<03002>>71314000
   DO BEGIN                                                    <<03002>>71316000
      IMB(X) := TOS;                                           <<03002>>71318000
      X := X+1;                                                <<03002>>71320000
      END UNTIL X > NRIMB;                                     <<03002>>71322000
                                                               <<03002>>71324000
   <<  DO A ROLL CALL ON ALL IMB'S THAT EXIST  >>              <<03002>>71326000
                                                               <<03002>>71328000
   I := 0;   <<USE I NOT X REG!!>>                             <<C8392>>71330000
   DO BEGIN                                                    <<03002>>71332000
      IF IMB(I) <> 0 THEN  <<IMB EXISTS?>>                     <<C8392>>71334000
         BEGIN                                                 <<03002>>71336000
         IF MULTI'IMB'SYS THEN                                 <<C8392>>71338000
            BEGIN                                              <<03002>>71340000
            TOS := I&LSL(7);  <<FORM IMB NR.>>                 <<C8392>>71342000
            TOS := %120000;   << ROLL CALL    >>               <<03002>>71344000
            ASSEMBLE( RIOA );                                  <<03002>>71346000
            END                                                <<03002>>71348000
         ELSE                                                  <<03002>>71350000
            BEGIN                                              <<03002>>71352000
            TOS := %120000;   << ROLL CALL    >>               <<03002>>71354000
            ASSEMBLE( RIOC );                                  <<03002>>71356000
            END;                                               <<03002>>71358000
         IMB(I) := TOS;  <<REPLACE MASK WITH ROLL CALL>>       <<C8392>>71360000
         END;                                                  <<03002>>71362000
      I := I+1;                                                <<C8392>>71364000
      END UNTIL I > NRIMB;                                     <<C8392>>71366000
                                                               <<03002>>71368000
   <<  INITIALIZE ALL CONFIGURED GICS  >>                      <<03002>>71370000
                                                               <<03002>>71372000
   I := HIDRT.(7:6); << DELETE DEV# >>                         <<03022>>71374000
   DO BEGIN                                                    <<03002>>71376000
      TOS := IMB(I.(10:2));  << IMB NR. >>                     <<03002>>71378000
      X := I.(12:4);         << CHAN NR. >>                    <<03002>>71380000
      ASSEMBLE( TBC 0,X );                                     <<03002>>71382000
      IF <> THEN                                               <<03002>>71384000
         BEGIN                                                 <<03002>>71386000
         TOS := I&LSL(3);    << ADD DEV NR. >>                 <<03002>>71388000
         ASSEMBLE( INIT );                                     <<03002>>71390000
         END;                                                  <<03002>>71392000
      DEL;                                                     <<03002>>71394000
      I := I-1;                                                <<03002>>71396000
      END UNTIL =;                                             <<03002>>71398000
                                                               <<03002>>71400000
          TOS := 0D;                                           <<03002>>71402000
          TOS := 0D;                                           <<03002>>71404000
          ASSEMBLE (SMSK);    <<CLEAR MASK>>                   <<03002>>71406000
          I := LOWESTDRT;                                      <<00888>>71408000
          DO IF GETDRT(I,DBI) <> 0 THEN                        <<03002>>71410000
             ABSOLUTE( GETDRT(I,DBI) ) := 0                    <<03002>>71412000
             << CLEAR CPVA 0 IN CASE INITIAL'S DRIVERS CHANGED IT >>    71414000
          UNTIL (I:=I+1) > HIDRT;                              <<02707>>71416000
$IF        << ******* RETURNING TO COMMON CODE ******* >>      <<00888>>71418000
          ABSOLUTE(SYSTCST) := 0;  << INITIAL'S CST POINTER >> <<32BND>>71420000
          ABSOLUTE(CPCB):=0;                                   <<MPEIV>>71422000
$IF X1=ON <<SERIES 33 UNIQUE>>                                 <<MPEIV>>71424000
          ABSOLUTE(CPCB):=-1;<<SIGNAL TO INIT LDEV1>>          <<MPEIV>>71426000
$IF                                                            <<MPEIV>>71428000
                                                               <<03553>>71430000
  << WARNING!!   NO EXTERNAL PCAL'S OR I/O OPERATIONS    >>    <<03553>>71432000
  <<    SHOULD BE PERFORMED AFTER THIS POINT, BECAUSE    >>    <<03553>>71434000
  <<    INITIAL'S CST TABLE AND ITS CHANNEL PROGRAM      >>    <<03553>>71436000
  <<    BUFFERS MAY BE WIPED OUT BY INITMEMORYLISTS.     >>    <<03553>>71438000
  <<    INITMEMORYLISTS MUST BE IN THE SAME SEGMENT      >>    <<03553>>71440000
  <<    AS THE CALL TO IT.                               >>    <<03553>>71442000
  <<    ALSO, IMMEDIATELY AFTER THIS WE CHANGE THE CST   >>    <<03553>>71444000
  <<    POINTER TO POINT TO THE SYSTEM'S CST.            >>    <<03553>>71446000
                                                               <<03553>>71448000
          TOS := 0;                << SET UP THE AVAILABLE >>  <<03553>>71450000
          TOS := SYSBASE;          <<    REGION LISTS      >>  <<03553>>71452000
          ASSEMBLE(XCHD; DDUP);                                <<03553>>71454000
          HOLELISTHEAD := 0D;                                  <<jb.dc>>71456000
          HOLELISTTAIL := 0D;                                  <<jb.dc>>71458000
          HOLECOUNT := 0;                                      <<jb.dc>>71460000
          INITMEMORYLISTS(*);                                  <<03553>>71462000
          ASSEMBLE(XCHD; DDEL);                                <<03553>>71464000
                                                               <<03553>>71466000
          ABSOLUTE(CSTP) := ABSOLUTE(SYSCST)+  << SWITCH TO >> <<03553>>71468000
                            SYSBASE;        << SYSTEM'S CST >> <<03553>>71470000
                                                               <<03553>>71472000
          IF LOGICALMAPPING THEN                               <<*MAP*>>71474000
             BEGIN                                             <<*MAP*>>71476000
             <<   FIX CST HEADER TO POINT AT THE   >>          <<*MAP*>>71478000
             <<   LOGICALLY MAPPED CST'S           >>          <<*MAP*>>71480000
             ABS( NRPHYCST) := CST(0);                         <<*PHY*>>71482000
             ABS( PHYCSTHEAD) := CST(3);                       <<*PHY*>>71484000
             TOS := (ABSOLUTE(DFS)-ABSOLUTE(DFC))&LSR(2);      <<*MAP*>>71486000
             TOS := S0; << DUP - # CSTS >>                     <<*MAP*>>71488000
             TOS := TOS-1;     << # CSTS -1 >>                 <<*MAP*>>71490000
             ABSOLUTE(ABSOLUTE(CSTP)) := TOS;   <<HDR=#CSTS-1>><<*MAP*>>71492000
             TOS := TOS-SYSPHYCST;       <<# LOG MAPPED CSTS >><<*MAP*>>71494000
             ABSOLUTE(X:=X+2) := TOS;    <<HEADER+2=#LOG CSTS>><<*MAP*>>71496000
             TOS := SYSPHYCST&LSL(2);    <<PTR TO 1st LOG CST>><<*MAP*>>71498000
             ABSOLUTE(X:=X+1) := TOS; <<HDR+3=PTR 1st LOG CST>><<*MAP*>>71500000
             END;                                              <<*MAP*>>71502000
       ASSEMBLE( DISP );  << HELLO MPE >>                      <<*MAP*>>71504000
      END <<MAINSEG4>> ;                                                71506000
$PAGE "MAIN PROGRAM"                                                    71508000
$CONTROL SEGMENT=BOOTSTRAP                                              71510000
  DISCBOOT:                                                             71512000
          LASTLOADMODE:=X; <<FROM INFOTABLE--SEE BOOTSTRAP>>   <<00888>>71514000
          LOADFROMTAPE := FALSE;                                        71516000
  TAPELOAD:                                                             71518000
          PUSH(DB,Z,Q,S);                                               71520000
          DBVALUE := TOS;                                               71522000
          DEL;                                                          71524000
          ZVALUE := TOS;                                                71526000
          QVALUE := TOS;                                                71528000
          SVALUE := TOS;                                                71530000
          MAINSEG1;                                            <<03603>>71532000
          MAINSEG1A;                                           <<03603>>71534000
          MAINSEG1B;                                           <<01683>>71536000
          MAINSEG2;                                                     71538000
          MAINSEG3;                                                     71540000
          MAINSEG4;                                                     71542000
END. << PROGRAM "INITIAL" >>                                   <<03603>>71544000
