<< LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION>>               00005000
$CONTROL MAP,SOURCE,CODE                                                00010000
<< PROGEN -- MODULE 9 >>                                                00015000
<<HP32002C MPE SOURCE C.00.00>>                                         00020000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00025000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00030000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00035000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00040000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00045000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00050000
$CONTROL MAIN=PROGEN                                                    00055000
$THIRTY                                                                 00060000
$CONTROL PRIVILEGED                                                     00065000
$CONTROL UNCALLABLE                                                     00070000
            << >>                                                       00075000
            << PROGENITOR PROCESS >>                                    00080000
            << >>                                                       00085000
<< Move init. of TLT before start User Logging recovery.     >><<03771>>00090000
BEGIN                                                                   00095000
$control adr                                                            00100000
                                                                        00105000
<< The following variable should not be moved. It is         >>         00110000
<< used for debugging progen and we expect to find it        >>         00115000
<< at DB+0 always. It is a bit map of debugging options      >>         00120000
<< which are defined below. You can set this from Initial    >>         00125000
<< by setting up location %1424 which is copied into         >>         00130000
<< this variable at the begining of PROGEN. You can also     >>         00135000
<< halt progen with the maintenance panel and set it.        >>         00140000
LOGICAL                                                        <<08968>>00145000
      CALLDEBUG := 0;      << Set this to TRUE in HELP if >>   <<08968>>00150000
                           << you wish to enter DEBUG     >>   <<08968>>00155000
                           << during system startup.      >>   <<08968>>00160000
      << Bit 15 turned on calls debug just after Initio      >>         00165000
      << Bit 14 turned on calls debug before setting         >>         00170000
      << date and time.                                      >>         00175000
      << Bit 13 turned on calls debug at the start of        >>         00180000
      << system startup state processing.                    >>         00185000
      << Bit 12 turned on suspends system startup state      >>         00190000
      << processing.                                         >>         00195000
      << Bit 11 turned on will Halt PROGEN at the very       >>         00200000
      << beginning before Initjobtables. You cannot use      >>         00205000
      << Debug at this point.                                >>         00210000
      << Bit 10 lets you get into Help the easy way.         >>         00215000
      << Bit  9 calls Debug just before the Command Intrinsic>>         00220000
      << call inside System Startup State Code.              >>         00225000
                                                                        00230000
$control nolist                                                         00235000
$control list                                                           00240000
$INCLUDE INCLJPCT                                              <<06561>>00245000
$INCLUDE INCLLPDT                                              <<06222>>00250000
$INCLUDE INCLPCB5                                              <<06562>>00255000
LOGICAL POINTER PCB = SYSPCBINDEX;                             <<06562>>00260000
$INCLUDE INCLPXG                                               <<06826>>00265000
$INCLUDE PCBFINCL                                              <<07225>>00270000
$INCLUDE INCLRIT                                               <<04824>>00275000
$SET X8=OFF                                                    <<06563>>00280000
$INCLUDE INCLJMAT                                              <<06563>>00285000
<< Auxiliary JMAT definitions >>                               <<06563>>00290000
                                                               <<06563>>00295000
EQUATE                                                         <<06563>>00300000
   JOBSCHED  = %70,                                            << 8201>>00305000
   JOBSUSP    = 4,                                             <<06563>>00310000
   JOBEXEC    = 2,                                             <<06563>>00315000
   JOBINIT    = %60;                                           <<06563>>00320000
                                                               <<06563>>00325000
DEFINE                                                                  00330000
      A'              = ABSOLUTE        #,                              00335000
      DISABLE         = ASSEMBLE(SED 0) #,                              00340000
      ENABLE          = ASSEMBLE(SED 1) #,                              00345000
      PSEUDODISABLE   = ASSEMBLE(PSDB)  #,                              00350000
      PSEUDOENABLE    = ASSEMBLE(PSEB)  #,                              00355000
      THRU            = STEP 1 UNTIL    #,                              00360000
      OPTIONS   = OPTION PRIVILEGED,UNCALLABLE,INTERNAL #;              00365000
INTEGER                                                                 00370000
      X     = X    ,                                                    00375000
      DB0   = DB+0 ,                                                    00380000
      DB1   = DB+1 ,                                                    00385000
      S0    = S-0  ,                                                    00390000
      S1    = S-1  ,                                                    00395000
      S2    = S-2  ,                                                    00400000
      S3    = S-3  ,                                           <<00.02>>00405000
      XREG  = X    ;                                                    00410000
INTEGER POINTER                                                         00415000
      PS0   = S-0  ,                                                    00420000
      PS1   = S-1  ;                                                    00425000
LOGICAL POINTER                                                         00430000
      LPS0  = S-0  ;                                                    00435000
BYTE POINTER                                                            00440000
      BPS0  = S-0  ;                                                    00445000
$PAGE "***   GLOBAL CONSTANTS   ***"                                    00450000
EQUATE                                                                  00455000
   <<FIXED CELLS>>                                                      00460000
      CSTB        = 0        ,                                          00465000
      XCST        = 1        ,                                          00470000
      DSTB        = 2        ,                                          00475000
      QI          = 5        ,                                          00480000
      ZI          = 6        ,                                          00485000
   <<PROCESS NOS>>                                                      00490000
      UCOPPCBN    = 2        ,                                          00495000
      DRECPCBN    = 4        ,                                          00500000
      NMMONPCBN   = 5        ,                                 <<06823>>00505000
      LOGPCBN     = 7        ,                                          00510000
      MEMLPCBN    = 11       ,                                          00515000
   <<TABLES/DST/SIR/SIZE>>                                              00520000
      DSTSIZE     = 4        ,                                          00525000
      IDDDST      = 45       ,                                          00530000
      IDDSIR      = 3        ,                                          00535000
      ODDDST      = 46       ,                                          00540000
      ODDSIR      = 4        ,                                          00545000
      RINSDST     = 22       ,                                          00550000
      LOGONDST1   = 47       ,                                          00555000
      LOGONDST2   = 48       ;                                 <<04824>>00560000
$INCLUDE INCLJIT                                               <<06289>>00565000
$INCLUDE INCLJDT                                               <<06289>>00570000
$INCLUDE INCLLDT5                                              <<06216>>00575000
$INCLUDE INCLXDD5                                              <<07350>>00580000
$PAGE "***   SYSGLOB / LDT / LPDT   ***"                                00585000
   <<SYSTEM GLOBAL>>                                                    00590000
EQUATE                                                                  00595000
      SYSDB          = 512   ,  <<SYSTEM DB OFFSET>>                    00600000
      JOBSYNC        = %121  ,                                          00605000
      SYSUP          = %73   ,                                          00610000
      CONSOL         = %74   ,                                          00615000
      UPDATEL        = SYSDB+%114,  <<UPDATE LEVEL>>                    00620000
      FIXL           = SYSDB+%115,  <<FIX LEVEL>>                       00625000
      WELCOME        = %277  ,                                          00630000
      MESSDST        = %373,                                   <<06022>>00635000
      DSLINE'PLAB    = %341  ,                                 <<DS>>   00640000
      MPLINE'PLAB    = %374  ,                               <<MP.00>>  00645000
      SESSION1 = %214,        <<JOB # OF 1ST CONSOLE SESSION>> <<00552>>00650000
      MRJE'PLAB      = %375  ,                                <<MRJE>>  00655000
      EXTLAB'3270    = %73   ,  << CONS3270 PLABEL, SYSEXT >>  <<01165>>00660000
      SYSPORT'PIN    = %120,  << In the SYSGLOB Ext. >>        <<06824>>00665000
      SYSEXTPTR      = %377  ,  << SYSDB PTR TO SYSGLOBEXT >>  <<01165>>00670000
      LOGINFO        = %167  ,                                 <<00.PV>>00675000
      PVPROC         = %363  ,  <<PV RECOGN. PROCESS>>         <<00.PV>>00680000
      VMOUNTLOC      = %365  ;  <<PV ENABLED INFO>>            <<RH.PV>>00685000
DEFINE                                                                  00690000
      ABSYS          = %1000 #,                                         00695000
      ABSYS'SYSUP    = A'(ABSYS+SYSUP)     #,                           00700000
      ABSYS'CONSOL   = A'(ABSYS+CONSOL)    #,                           00705000
      ABSYS'MESSDST  = A'(ABSYS+MESSDST)  #,                   <<06022>>00710000
      CONSOLELDEV    = ABSYS'CONSOL        #,                  <<06822>>00715000
DIT'TERM=DIT+7).(5:5#,      <<DIT TERM TYPE>>                           00720000
DIT'HSTATE=DIT+13).(4:3#,     <<DIT HANGUP STATE>>             <<00632>>00725000
DIT'UPBIT=DIT).(1:1#,    <<DIT UP BIT>>                                 00730000
      ABSYS'DSLINE   = A'(ABSYS+DSLINE'PLAB)#,                 <<DS>>   00735000
      ABSYS'MPLINE   = A'(ABSYS+MPLINE'PLAB)#,               <<MP.00>>  00740000
      ABSYS'MRJE     = A'(ABSYS+MRJE'PLAB)#,                  <<MRJE>>  00745000
      PLABEL3270     = SYSGLOBEXT(EXTLAB'3270)#,               <<01165>>00750000
      SYSPORTPROC    = SYSGLOBEXT(SYSPORT'PIN) #,              <<06824>>00755000
      ABSYS'JOBSYNC  = A'(ABSYS+JOBSYNC)   #,                           00760000
        JOBREADY'F   = 13:1                #,                           00765000
        DEVFREED'F   = 14:1                #,                           00770000
        JOBWAITING'F = 15:1                #,                           00775000
      ABSYS'WELCOME  = A'(ABSYS+WELCOME)   #,                           00780000
      ABSYS'LOGINFO  = A'(ABSYS+LOGINFO)   #,                  <<00.PV>>00785000
      ABSYS'PVPROC   = A'(ABSYS+PVPROC )   #,                  <<00.PV>>00790000
      ABSYS'VMOUNT   = A'(ABSYS+VMOUNTLOC) #;                  <<RH.PV>>00795000
DEFINE  LGNAME   =    BTABINDEX#;                              <<00651>>00800000
POINTER                                                                 00805000
      SYSGLOBEXT     = SYSEXTPTR;                              <<06562>>00810000
   LOGICAL ARRAY LOGTAB(*) = DB;                               <<00651>>00815000
   BYTE ARRAY BLOGTAB(*) = DB;                                 <<00651>>00820000
ARRAY   MSGX(0:4) := "*INVALID* " ;                                     00825000
ARRAY   MSGY(0:4) := "*WELCOME* " ;                                     00830000
BYTE ARRAY MSGZ(0:4) := "SHUT",0; <<GENMSG NEEDS 0 TERMINATOR>><<02315>>00835000
   BYTE ARRAY MSGEQ(0:1):="=",0;<<GENMSG NEEDS 0 TERMINATOR>>  <<KS.01>>00840000
                                                                        00845000
LOGICAL                                                                 00850000
        SAVE'LOG'INFO,                                         <<04845>>00855000
        PIN     ,                                                       00860000
        UP,                                                    <<00552>>00865000
        CHAR    ,                                                       00870000
        CNT     ,                                                       00875000
        OK      ;                                                       00880000
LOGICAL MESSAGE'STATUS;                                        <<03518>>00885000
INTEGER                                                                 00890000
        TERM,DIT,                                              <<00552>>00895000
        COMLGTH ,                                                       00900000
        COMNO   ,                                                       00905000
        LPDT'INDEX,  << Index into LPDT (see include file) >>  <<06222>>00910000
        OLDSLIMIT ,      <<LIMITS B4 "=LOGOFF">>                        00915000
        OLDJLIMIT := -1 ;<<-1 => NOT IN LOGOFF MODE>>                   00920000
                                                               << 8494>>00925000
LOGICAL M'Mouse := FALSE;                                      << 8494>>00930000
EQUATE CPU'MM = 6;                                             << 8494>>00935000
   << The previous two declarations are for support of       >><< 8494>>00940000
   << the Mighty Mouse processor, known at this time         >><< 8494>>00945000
   << as the SERIES 37. If PROGEN detects that it is         >><< 8494>>00950000
   << running on a Mighty Mouse processor, it will           >><< 8494>>00955000
   << read MM's Time Of Century Clock when coming up,        >><< 8494>>00960000
   << and use it to set the date and time.                   >><< 8494>>00965000
                                                                        00970000
ARRAY BUF(0:36);                                                        00975000
BYTE ARRAY BBUF(*) = BUF;                                               00980000
BYTE POINTER BP1;                                                       00985000
BYTE ARRAY                                                              00990000
      DICT (0:389) :=                                          <<01165>>00995000
                       4, 2,"UP",                                       01000000
                       6, 4,"DOWN",                                     01005000
                       7, 5,"REPLY",                                    01010000
                       6, 4,"TELL",                                     01015000
                       6, 4,"WARN",                                     01020000
                       7, 5,"SHOWQ",                                    01025000
                      10, 8,"ABORTJOB",                                 01030000
                       6, 4,"GIVE",                                     01035000
                       6, 4,"TAKE",                                     01040000
                       9, 7, "ABORTIO",                                 01045000
                      10, 8,"SHUTDOWN",                                 01050000
                       9, 7,"SESSION",                                  01055000
                       8, 6,"ACCEPT",                                   01060000
                       8, 6,"REFUSE",                                   01065000
                       9, 7,"SHOWJOB",                                  01070000
                       8, 6,"LOGOFF",                                   01075000
                       7, 5, "LOGON",                                   01080000
                       9,7,"WELCOME",                          <<C0.00>>01085000
                       7,5,"LIMIT",                            <<C0.00>>01090000
                       9,7,"STREAMS",                          <<C0.00>>01095000
                       10,8,"JOBFENCE",                        <<C0.00>>01100000
                       10,8,"OUTFENCE",                        <<C0.00>>01105000
                       9, 7, "SHOWDEV",                        <<C0.00>>01110000
                       7, 5, "SPOOL",                          <<C0.00>>01115000
                       8, 6, "ALTJOB",                         <<C0.00>>01120000
                       8, 6, "SHOWIN",                         <<C0.00>>01125000
                       9, 7, "SHOWOUT",                        <<C0.00>>01130000
                       8, 6, "DELETE",                         <<C0.00>>01135000
                       9, 7, "ALTFILE",                        <<C0.00>>01140000
                      10, 8, "BREAKJOB",                                01145000
                      11, 9, "RESUMEJOB",                               01150000
                      10, 8, "SHOWTIME",                                01155000
                       8, 6, "HEADON",                                  01160000
                       9, 7, "HEADOFF",                                 01165000
                       8, 6, "RECALL",                                  01170000
                       8, 6, "DSLINE",                         <<DS>>   01175000
                       8, 6, "MPLINE",                       <<MP.00>>  01180000
                       6, 4, "MRJE",                          <<MRJE>>  01185000
                       6, 4, "3270",                           <<00182>>01190000
                       9, 7, "SHOWCOM",                        <<01165>>01195000
                       5, 3, "MON",                                     01200000
                       6, 4, "MOFF",                                    01205000
                       8, 6, "VMOUNT",                         <<RH.PV>>01210000
                       7, 5, "MOUNT",                          <<RH.PV>>01215000
                      10, 8, "DISMOUNT",                       <<RH.PV>>01220000
                       7, 5, "DSTAT",                          <<RH.PV>>01225000
                       8, 6, "VSUSER",                         <<RH.PV>>01230000
                       10, 8, "DOWNLOAD",                      <<00176>>01235000
     5,3,"LOG",                                                <<00506>>01240000
      0;                                                       <<00506>>01245000
                                                                        01250000
DOUBLE                                                                  01255000
         DESCRIP1  ,                                                    01260000
         DESCRIP2  ,                                                    01265000
         DESCRIP3  ,                                                    01270000
         DESCRIP4  ,                                                    01275000
         DESCRIP5  ,                                                    01280000
         DESCRIP6  ;                                                    01285000
BYTE POINTER                                                            01290000
         PARAM1 = DESCRIP1    ,                                         01295000
         PARAM2 = DESCRIP2    ,                                         01300000
         PARAM3 = DESCRIP3    ,                                         01305000
         PARAM4 = DESCRIP4    ,                                         01310000
         PARAM5 = DESCRIP5    ,                                         01315000
         PARAM6 = DESCRIP6    ;                                         01320000
BYTE                                                                    01325000
         LEN1   = DESCRIP1 + 1   ,                                      01330000
         LEN2   = DESCRIP2 + 1   ,                                      01335000
         LEN3   = DESCRIP3 + 1   ,                                      01340000
         LEN4   = DESCRIP4 + 1   ,                                      01345000
         LEN5   = DESCRIP5 + 1   ,                                      01350000
         LEN6   = DESCRIP6 + 1   ;                                      01355000
DOUBLE ARRAY                                                            01360000
         PARMS(*) = DESCRIP1     ;                                      01365000
INTEGER ARRAY                                                           01370000
         IPARMS(*) = DESCRIP1    ;                                      01375000
                                                               <<00552>>01380000
LOGICAL PROCID;                                                << 7844>>01385000
LOGICAL PLABEL;                                                << 7844>>01390000
BYTE ARRAY REMOTE'MPE(0:10) := "REMOTE'MPE ";                  << 7844>>01395000
BYTE ARRAY GETDS'NODENAME(0:14) := "GETDS'NODENAME ";          << 8762>>01400000
INTEGER ARRAY JPCNTARR(*) = DB+0;                              <<06222>>01405000
BYTE ARRAY HELLOSTRING(0:29); <<CONSOLE SESSION HELLO PARMS>>  <<00594>>01410000
INTEGER JOBNUM;                <<JOB # FOR CONSOLE SESSION>>   <<00552>>01415000
ARRAY SYS(0:3); <<NAME OF SYSTEM ACCOUNT>>                     <<00416>>01420000
INTEGER DUMMY;  <<DUMMY ARRAY FOR DIRECSCAN>>                  <<00416>>01425000
byte array PROCNAME(0:16);                                     << 7961>>01430000
INTEGER ID'NLS,PLABEL'NLS;                                     << 7961>>01435000
                                                               << 8959>>01440000
<< INITIAL communication DST declarations >>                   << 8959>>01445000
LOGICAL                                                        << 8959>>01450000
   FOS'FLAG;                                                   << 8959>>01455000
INTEGER                                                        <<07350>>01460000
   COMMDSTN,   <<COMMUNICATION DST#>>                          <<07350>>01465000
   START'UP'OPTION;                                            <<07350>>01470000
EQUATE                                                         <<07350>>01475000
   COMMDSTNLOC = %122;  <<SYS GLOB EXT CELL FOR COMM DST#>>    <<07350>>01480000
                                                               <<03100>>01485000
EQUATE               << Messages EQUATEs. >>                   <<03100>>01490000
   SYSSET              = 1,   << System message set. >>        <<03100>>01495000
   NOSTACKFORHORIZON      = 500,                               <<06826>>01500000
   CANTCREATEHORIZONPROC  = 501,                               <<06826>>01505000
   NO'LOG'PROC         = 298; << INITIAL didn't create log >>  <<03100>>01510000
                              <<    process.               >>  <<03100>>01515000
<< The following code was added to support privileged mode >>  <<04650>>01520000
<< bounds checking. The low core limit found in SYSDB 20,21>>  <<04650>>01525000
<< is transfered to extended CPU registers along with the  >>  <<04650>>01530000
<< address of the ICS base found at ABSOLUTE (5).          >>  <<04650>>01535000
                                                               <<04650>>01540000
DEFINE   CPUNUM   = ASSEMBLE(PCN)#;      << Get CPU number >>  <<04650>>01545000
                                                               <<04650>>01550000
DEFINE   SBL      = CON %20104, %12#;                          <<04650>>01555000
                                                               <<04650>>01560000
DEFINE   INIT'PMBCREGS=                                        <<04650>>01565000
                                                               <<04650>>01570000
  BEGIN                                                        <<04650>>01575000
  TOS:= 0;                                                     <<04650>>01580000
  ASSEMBLE (SBL);                                              <<04650>>01585000
  END#;                                                        <<04650>>01590000
                                                                        01595000
    << ============================================================= >> 01600000
    << =====    Definitions for the Startup State Configurator ===== >> 01605000
    << ============================================================= >> 01610000
                                                               << GDR >>01615000
    EQUATE                                                     << GDR >>01620000
              Key'Dict'Size  = 77;                             << 8587>>01625000
    BYTE ARRAY                                                 << GDR >>01630000
              Startup'Key'Dict(0:Key'Dict'Size-1) :=           << GDR >>01635000
                        11, 9, "WARMSTART",                    << GDR >>01640000
                        11, 9, "COOLSTART",                    << GDR >>01645000
                        11, 9, "COLDSTART",                    << GDR >>01650000
                        8,  6, "UPDATE",                       << GDR >>01655000
                        8,  6, "RELOAD",                       << GDR >>01660000
                        9,  7, "STARTUP",                      << GDR >>01665000
                        10, 8, "SHUTDOWN",                     << GDR >>01670000
                        8,  6, "LOGOFF",                       << GDR >>01675000
                        0;                                     << GDR >>01680000
                                                               << GDR >>01685000
    << .................................................. >>   << GDR >>01690000
    <<   Startup "Types" -- a definition of integer codes >>   << GDR >>01695000
    <<     which define startup types (by INITIAL).       >>   << GDR >>01700000
    << .................................................. >>   << GDR >>01705000
    EQUATE                                                     << GDR >>01710000
        T'Warmstart          = 0,                              << GDR >>01715000
        T'Coolstart          = 1,                              << GDR >>01720000
        T'Coldstart          = 2,                              << GDR >>01725000
        T'Update             = 3,                              << GDR >>01730000
        T'Reload             = 4,                              << GDR >>01735000
        T'Startup            = 5;                              << 8587>>01740000
                                                               << GDR >>01745000
    EQUATE                                                              01750000
        Cierr'set            = 2,    << CIERROR message set         >>  01755000
        Max'Buffer           = 240,  << command length (bytes)      >>  01760000
        Op'Not'Logged'On     = 300,  << STARTDEVICE failed          >>  01765000
        Misc'FS'Err          = 1000, << Unlikely CC from Filesys    >>  01770000
                                                                        01775000
        Start'Processing     = 1001, << First message               >>  01780000
        Done'All'Processing  = 1002, << Last message                >>  01785000
        Freaddir'Died        = 1003, << In middle of file.          >>  01790000
        Too'Big'So'Skipping  = 1004, << Skips to next record.       >>  01795000
        Expected'Keyword     = 1005, << Expected keyword not found  >>  01800000
        Multiple'Keywords    = 1006, << keyword specified > once    >>  01805000
        Invalid'Command      = 1007, << invalid startup command     >>  01810000
        Header'msg           = 1008, << Block header message        >>  01815000
        Session'On'Console   = 1009, << Previous loggon      >><< 8587>>01820000
        Illegal'rec'format   = 1010, << Rec fmt<>FIXED ASCII >><< 8587>>01825000
        Illegal'creator      = 1011, << Creator<>MANAGER.SYS >>         01830000
        No'Keyword           = 1012, <<No keywd in 1st record>>         01835000
        Data'After'Key       = 1013, << Found junk in header >>         01840000
        Truncating           = 1014, << File too wide.       >>         01845000
        No'Records           = 1015  << No records in file.  >>         01850000
        ;                                                               01855000
                                                               << GDR >>01860000
    << this variable allows the Startup State configurator >>  << GDR >>01865000
    << code to be skipped, if the keyword "nostart" is     >>  << GDR >>01870000
    << entered at time/date                                >>  << GDR >>01875000
                                                               << GDR >>01880000
                                                               << GDR >>01885000
    LOGICAL                                                    << GDR >>01890000
        Do'startup := true;                                    << GDR >>01895000
                                                               << GDR >>01900000
    INTEGER                                                    << GDR >>01905000
        Start'Error;  << parameter to CHECK'TERM'ATTRIBUTES >> << GDR >>01910000
    DEFINE                                                     << GDR >>01915000
        Startup'name = "SYSSTART/ "#;                          << GDR >>01920000
                                                               << GDR >>01925000
    INTRINSIC Command,                                                  01930000
              Ffileinfo, Freaddir,  Ferrmsg;                            01935000
                                                               << GDR >>01940000
                                                               << GDR >>01945000
    << ========================================================<< GDR >>01950000
                                                               <<04650>>01955000
EQUATE   SERIES64 = 4;                                         <<04650>>01960000
                                                               <<06134>>01965000
INTRINSIC DEBUG;                                               <<06134>>01970000
INTRINSIC LOADPROC,UNLOADPROC;                                 << 7844>>01975000
PROCEDURE HELP;                                                         01980000
   OPTION EXTERNAL;                                                     01985000
                                                                        01990000
LOGICAL PROCEDURE SETSYSDB;                                             01995000
   OPTION EXTERNAL;                                                     02000000
                                                                        02005000
PROCEDURE RESETDB(D);                                                   02010000
   VALUE   D;                                                           02015000
   LOGICAL D;                                                           02020000
   OPTION EXTERNAL;                                                     02025000
                                                                        02030000
LOGICAL PROCEDURE EXCHANGEDB(DSTX);                                     02035000
   VALUE   DSTX;                                                        02040000
   LOGICAL DSTX;                                                        02045000
   OPTION EXTERNAL;                                                     02050000
                                                                        02055000
PROCEDURE LOG;                                                          02060000
   OPTION EXTERNAL;                                                     02065000
                                                                        02070000
PROCEDURE LOG6 (NJ, NS, NT, SIX);                                       02075000
   VALUE NJ, NS, NT, SIX;                                               02080000
   INTEGER NJ, NS, NT, SIX;                                             02085000
   OPTION EXTERNAL;                                                     02090000
                                                                        02095000
PROCEDURE DELAY (MSEC);                                                 02100000
   VALUE MSEC;                                                          02105000
   DOUBLE MSEC;                                                         02110000
   OPTION EXTERNAL;                                                     02115000
                                                                        02120000
INTEGER PROCEDURE GENMSG(SETNO,MSGNO,MASK,A,B,C,D,E,           <<0U.EB>>02125000
      DEST,REPLY,BUFF,DST,IOTYPE);                             <<0U.EB>>02130000
   VALUE SETNO,MSGNO,MASK,A,B,C,D,E,DEST,REPLY,BUFF,           <<0U.EB>>02135000
      DST,IOTYPE;                                              <<0U.EB>>02140000
   LOGICAL SETNO,MSGNO,MASK,A,B,C,D,E,DEST,REPLY,BUFF,         <<0U.EB>>02145000
      DST,IOTYPE;                                              <<0U.EB>>02150000
   OPTION VARIABLE,EXTERNAL;                                   <<0U.EB>>02155000
                                                               <<0U.EB>>02160000
PROCEDURE INITMSG; OPTION EXTERNAL;                            <<0U.EB>>02165000
                                                               <<0U.EB>>02170000
LOGICAL PROCEDURE SYSPROC(LPIN);                                        02175000
   VALUE   LPIN;                                                        02180000
   LOGICAL LPIN;                                                        02185000
   OPTION EXTERNAL;                                                     02190000
                                                                        02195000
PROCEDURE WAIT(WF,DC);                                                  02200000
   VALUE   WF,DC;                                                       02205000
   LOGICAL WF,DC;                                                       02210000
   OPTION EXTERNAL;                                                     02215000
                                                                        02220000
PROCEDURE UNIMPEDE(PCBPT);                                     <<00.02>>02225000
   VALUE   PCBPT;                                              <<00.02>>02230000
   INTEGER PCBPT;                                              <<00.02>>02235000
   OPTION EXTERNAL;                                            <<00.02>>02240000
                                                               <<00.02>>02245000
PROCEDURE AWAKE(PIN,AF,WF);                                             02250000
   VALUE   PIN,AF,WF;                                                   02255000
   INTEGER PIN,AF,WF;                                                   02260000
   OPTION EXTERNAL;                                                     02265000
                                                                        02270000
LOGICAL PROCEDURE GETSIR(N);                                            02275000
   VALUE   N;                                                           02280000
   LOGICAL N;                                                           02285000
   OPTION EXTERNAL;                                                     02290000
                                                                        02295000
PROCEDURE RELSIR(N,B);                                                  02300000
   VALUE   N,B;                                                         02305000
   LOGICAL N,B;                                                         02310000
   OPTION EXTERNAL;                                                     02315000
                                                                        02320000
INTEGER PROCEDURE READ(MES,XL);                                         02325000
   VALUE   XL;                                                          02330000
   INTEGER XL;                                                          02335000
   ARRAY   MES;                                                         02340000
   OPTION EXTERNAL;                                                     02345000
                                                                        02350000
PROCEDURE PRINT(MES,L,T);                                               02355000
   VALUE   L,T;                                                         02360000
   INTEGER L,T;                                                         02365000
   ARRAY   MES;                                                         02370000
   OPTION EXTERNAL;                                                     02375000
                                                                        02380000
DOUBLE PROCEDURE ATTACHIO(P1,P2,P3,P4,P5,P6,P7,P8,P9);                  02385000
   VALUE      P1,P2,P3,P4,P5,P6,P7,P8,P9;                               02390000
   INTEGER    P1,P2,P3,P4,P5,P6,P7,P8,P9;                               02395000
   OPTION EXTERNAL;                                                     02400000
                                                               <<00.05>>02405000
PROCEDURE INITIO (FLAG);                                       <<00.05>>02410000
   VALUE   FLAG;                                               <<00.05>>02415000
   LOGICAL FLAG;                                               <<00.05>>02420000
   OPTION EXTERNAL;                                            <<00.05>>02425000
                                                                        02430000
PROCEDURE SETUP'TAPES;                                         <<02565>>02435000
   OPTION EXTERNAL;                                            <<02565>>02440000
PROCEDURE CLOSE'GLOBAL'FILES;                                  <<06825>>02445000
OPTION EXTERNAL;                                               <<06825>>02450000
                                                                        02455000
LOGICAL PROCEDURE CONSRECALL(BP1);                             <<04526>>02460000
BYTE ARRAY BP1;                                                <<04526>>02465000
OPTION EXTERNAL;                                               <<04526>>02470000
                                                               <<02565>>02475000
PROCEDURE ABORTIO(LDEV);                                                02480000
   VALUE LDEV;                                                          02485000
   INTEGER LDEV;                                                        02490000
   OPTION EXTERNAL;                                                     02495000
                                                                        02500000
PROCEDURE STARTCLOCK(YEARDAY,TIMEDAY);                         <<00.05>>02505000
   VALUE   YEARDAY,TIMEDAY;                                    <<00.05>>02510000
   INTEGER YEARDAY;                                            <<00.05>>02515000
   DOUBLE  TIMEDAY;                                            <<00.05>>02520000
   OPTION EXTERNAL;                                            <<00.05>>02525000
                                                               <<00.01>>02530000
PROCEDURE QUEUEPROC(PROCSYSDBINX,QUEUENAME,LOCATION);          <<MPEIV>>02535000
VALUE PROCSYSDBINX,QUEUENAME,LOCATION;                         <<MPEIV>>02540000
INTEGER PROCSYSDBINX,QUEUENAME,LOCATION;                       <<MPEIV>>02545000
OPTION EXTERNAL;                                               <<MPEIV>>02550000
DOUBLE PROCEDURE TIMER;                                        <<MPEIV>>02555000
OPTION EXTERNAL;                                               <<MPEIV>>02560000
                                                                        02565000
LOGICAL PROCEDURE CONVERTDATE(DATE);VALUE DATE;                <<00.EB>>02570000
   BYTE POINTER DATE; OPTION EXTERNAL;                         <<00.EB>>02575000
                                                               <<00.EB>>02580000
DOUBLE PROCEDURE CONVERTTIME(PTR);VALUE PTR;                   <<00.EB>>02585000
   BYTE POINTER PTR; OPTION EXTERNAL;                          <<00.EB>>02590000
                                                               <<00.EB>>02595000
PROCEDURE DATE'LINE(BBUF);                                              02600000
   BYTE ARRAY BBUF;                                                     02605000
   OPTION EXTERNAL;                                                     02610000
                                                                        02615000
PROCEDURE DCU'REQUEST(PARM);                                   <<04183>>02620000
   VALUE PARM;                                                 <<04183>>02625000
   INTEGER PARM;                                               <<04183>>02630000
   OPTION EXTERNAL;                                            <<04183>>02635000
                                                               <<04183>>02640000
PROCEDURE REMRITENTRY(ADR);                                             02645000
   VALUE   ADR;                                                         02650000
   INTEGER ADR;                                                         02655000
   OPTION EXTERNAL;                                                     02660000
                                                                        02665000
DOUBLE PROCEDURE DIRECSCAN(A,B,C,D,E,F,G,H);                   <<00416>>02670000
VALUE A,B,H;                                                   <<00416>>02675000
INTEGER A,H;                                                   <<00416>>02680000
DOUBLE B;                                                      <<00416>>02685000
ARRAY C,D,E,G;                                                 <<00416>>02690000
INTEGER PROCEDURE F;                                           <<00416>>02695000
OPTION EXTERNAL,VARIABLE;                                      <<00416>>02700000
DOUBLE PROCEDURE DIRECFIND( TYPE, LINKAGE'INDEXP, ANAME,       <<06289>>02705000
   GUNAME, FNAME, PRETURN);                                    <<06289>>02710000
   VALUE TYPE, LINKAGE'INDEXP;                                 <<06289>>02715000
   INTEGER TYPE;                                               <<06289>>02720000
   DOUBLE LINKAGE'INDEXP;                                      <<06289>>02725000
   ARRAY ANAME, GUNAME, FNAME, PRETURN;                        <<06289>>02730000
   OPTION EXTERNAL;                                            <<06289>>02735000
                                                               <<00416>>02740000
INTEGER PROCEDURE FAMILY(P,LP);                                         02745000
   VALUE   P,LP;                                                        02750000
   INTEGER P,LP;                                                        02755000
   OPTION EXTERNAL;                                                     02760000
                                                                        02765000
PROCEDURE SUDDENDEATH(N);                                               02770000
   VALUE   N;                                                           02775000
   INTEGER N;                                                           02780000
   OPTION EXTERNAL;                                                     02785000
                                                                        02790000
LOGICAL PROCEDURE CONSABORTJOB(BARRAY);                                 02795000
   BYTE ARRAY BARRAY;                                                   02800000
   OPTION EXTERNAL;                                                     02805000
                                                                        02810000
PROCEDURE WRITEDSEG (DSTX);                                             02815000
   VALUE DSTX;                                                          02820000
   INTEGER DSTX;                                                        02825000
   OPTION EXTERNAL;                                                     02830000
                                                                        02835000
LOGICAL PROCEDURE CONSSPOOL (PARMS);                                    02840000
   BYTE ARRAY PARMS;                                                    02845000
   OPTION EXTERNAL;                                                     02850000
                                                                        02855000
PROCEDURE INITSPOOLING;                                                 02860000
   OPTION EXTERNAL;                                                     02865000
                                                                        02870000
PROCEDURE SROOSTER (DEVICE);                                            02875000
   VALUE DEVICE;                                                        02880000
   INTEGER DEVICE;                                                      02885000
   OPTION EXTERNAL;                                                     02890000
                                                               <<00506>>02895000
PROCEDURE INITRECLOG;                                          <<00506>>02900000
OPTION EXTERNAL;                                               <<00506>>02905000
                                                               <<00506>>02910000
                                                                        02915000
LOGICAL PROCEDURE DELETEJOB (JMATP);                                    02920000
   VALUE JMATP;                                                         02925000
   INTEGER POINTER JMATP;                                               02930000
   OPTION EXTERNAL;                                                     02935000
                                                                        02940000
INTEGER PROCEDURE STARTDEVICE(A,B,C,D,E,F,G,H,I);              <<00552>>02945000
VALUE A,C,D;                                                   <<00552>>02950000
INTEGER A,C,G,H,I;                                             <<00552>>02955000
LOGICAL D;                                                     <<00552>>02960000
BYTE ARRAY B;                                                  <<00552>>02965000
INTEGER POINTER E,F;                                           <<00552>>02970000
OPTION EXTERNAL,VARIABLE;                                      <<00552>>02975000
                                                               << 8201>>02980000
PROCEDURE RECOVERSCHED( JMATP );                               << 8201>>02985000
   VALUE JMATP;                                                << 8201>>02990000
   INTEGER POINTER JMATP;                                      << 8201>>02995000
OPTION EXTERNAL;                                               << 8201>>03000000
                                                               <<00552>>03005000
   PROCEDURE LOG15(I,J,K,L);                                   <<KS.01>>03010000
   VALUE I,J,K,L;                                              <<KS.01>>03015000
   LOGICAL I,J,K,L;                                            <<KS.01>>03020000
   OPTION EXTERNAL;                                            <<KS.01>>03025000
                                                               <<03518>>03030000
PROCEDURE PROCESS'SYS'DISC'FREE'SPACE'MAPS (INIT);             <<03518>>03035000
   VALUE INIT;                                                 <<03518>>03040000
   LOGICAL INIT;                                               <<03518>>03045000
   OPTION EXTERNAL;                                            <<03518>>03050000
                                                               <<03518>>03055000
PROCEDURE PROCESS'DFS'ERROR (LDEV, ERROR'STATUS,               <<03518>>03060000
                             TYPE'OF'ERROR);                   <<03518>>03065000
   VALUE LDEV, ERROR'STATUS, TYPE'OF'ERROR;                    <<03518>>03070000
   INTEGER LDEV;                                               <<03518>>03075000
   LOGICAL ERROR'STATUS;                                       <<03518>>03080000
   INTEGER TYPE'OF'ERROR;                                      <<03518>>03085000
   OPTION EXTERNAL;                                            <<03518>>03090000
                                                               <<03518>>03095000
LOGICAL PROCEDURE PORTSTATUS (PORTNUMBER);                     <<03518>>03100000
   VALUE PORTNUMBER;                                           <<03518>>03105000
   INTEGER PORTNUMBER;                                         <<03518>>03110000
   OPTION EXTERNAL;                                            <<03518>>03115000
                                                               <<03518>>03120000
PROCEDURE RECEIVEMSG (PORTNUM, MSGLENGTH, FLAGS);              <<03518>>03125000
   VALUE PORTNUM, MSGLENGTH, FLAGS;                            <<03518>>03130000
   INTEGER PORTNUM, MSGLENGTH;                                 <<03518>>03135000
   LOGICAL FLAGS;                                              <<03518>>03140000
   OPTION EXTERNAL;                                            <<03518>>03145000
                                                               <<03518>>03150000
PROCEDURE PROCESS'PAGE'IO'ERROR (LDEV, PAGE, ERROR'STATUS);    <<03529>>03155000
   VALUE LDEV, PAGE, ERROR'STATUS;                             <<03518>>03160000
   INTEGER LDEV, PAGE;                                         <<03518>>03165000
   LOGICAL ERROR'STATUS;                                       <<03518>>03170000
   OPTION EXTERNAL;                                            <<03518>>03175000
                                                               <<06826>>03180000
PROCEDURE PROCREATE( PIN, PLABEL, DELTAP, STACKDST,            <<06826>>03185000
                     GLOBSIZE, DLSIZE, LOCSIZE, PRI,           <<06826>>03190000
                     STRING, STRLEN, PARAM, FLAGS,             <<06826>>03195000
                     MAXSTACK, STDIN, STDLIST );               <<06826>>03200000
   VALUE PLABEL, DELTAP, STACKDST, GLOBSIZE, DLSIZE,           <<06826>>03205000
         LOCSIZE, PRI, STRING, STRLEN, PARAM, FLAGS, MAXSTACK; <<06826>>03210000
   INTEGER PLABEL, DELTAP, STACKDST, GLOBSIZE, DLSIZE,         <<06826>>03215000
         LOCSIZE, PRI, STRING, STRLEN, PARAM, PIN, MAXSTACK;   <<06826>>03220000
   LOGICAL FLAGS;                                              <<06826>>03225000
   LOGICAL ARRAY STDIN, STDLIST;                               <<06826>>03230000
OPTION PRIVILEGED, EXTERNAL;                                   <<06826>>03235000
                                                               <<06826>>03240000
LOGICAL PROCEDURE GETSTACK( N, MP );                           <<06826>>03245000
   VALUE N, MP;                                                <<06826>>03250000
   LOGICAL N, MP;                                              <<06826>>03255000
OPTION EXTERNAL;                                               <<06826>>03260000
                                                               <<06826>>03265000
INTEGER PROCEDURE CONVEXTLABELTODELTAP( EXTLABEL );            <<06826>>03270000
   VALUE  EXTLABEL;                                            <<06826>>03275000
   INTEGER EXTLABEL;                                           <<06826>>03280000
OPTION EXTERNAL;                                               <<06826>>03285000
                                                               <<06826>>03290000
PROCEDURE HRZNSYSPROC;                                         <<06826>>03295000
OPTION EXTERNAL;                                               <<06826>>03300000
                                                               <<06826>>03305000
PROCEDURE RELDATASEG( DSTN );                                  <<06826>>03310000
   VALUE   DSTN;                                               <<06826>>03315000
   LOGICAL DSTN;                                               <<06826>>03320000
OPTION EXTERNAL;                                               <<06826>>03325000
                                                               <<06826>>03330000
PROCEDURE ShutDownCaching;                                     <<*8595>>03335000
   OPTION External;                                            <<*8595>>03340000
                                                               <<*8595>>03345000
INTRINSIC BINARY,ASCII,MYCOMMAND,SEARCH;                       <<RH.PV>>03350000
INTRINSIC FOPEN, FCONTROL, FCHECK, FREAD, FCLOSE;              << 8494>>03355000
                                                               <<00594>>03360000
                                                               <<00205>>03365000
PROCEDURE SDFINIT(MODE);                                       <<00205>>03370000
VALUE MODE; INTEGER MODE;                                      <<00205>>03375000
OPTION EXTERNAL;                                               <<00205>>03380000
                                                               <<04165>>03385000
PROCEDURE STOP'ALL'USERLOGS;                                   <<04165>>03390000
   OPTION EXTERNAL;                                            <<04165>>03395000
                                                               <<t7690>>03400000
PROCEDURE RECOVER'XDD;                                         <<t7690>>03405000
   OPTION EXTERNAL;  << Defined in Spoolcoms1 >>               <<t7690>>03410000
                                                               <<04165>>03415000
INTRINSIC ZSIZE;                                               <<07350>>03420000
                                                               <<00651>>03425000
INTEGER PROCEDURE THISCPU;                                     << 8494>>03430000
   OPTION EXTERNAL; << Defined in Miscsegc >>                  << 8494>>03435000
                                                               << 8494>>03440000
PROCEDURE INITDATETIME;                                        << 8494>>03445000
   OPTION FORWARD;                                             << 8494>>03450000
                                                               << 8494>>03455000
PROCEDURE Check'Term'Attributes( Ldev, Error );                << GDR >>03460000
  VALUE   Ldev;                                                << GDR >>03465000
  LOGICAL Ldev;                                                << GDR >>03470000
  INTEGER Error;                                               << GDR >>03475000
                                                               << GDR >>03480000
  OPTION EXTERNAL;                                             << GDR >>03485000
                                                               << GDR >>03490000
$PAGE "CHECK'FOR'MESSAGE"                                      <<03518>>03495000
$control segment=called'once                                            03500000
PROCEDURE MFDS( BUF, DSTN, OFFSET, COUNT);                     <<06289>>03505000
   VALUE DSTN, OFFSET, COUNT;                                  <<06289>>03510000
   ARRAY BUF;                                                  <<06289>>03515000
   INTEGER DSTN, OFFSET, COUNT;                                <<06289>>03520000
BEGIN                                                          <<06289>>03525000
   TOS := @BUF;                                                <<06289>>03530000
   TOS := DSTN;                                                <<06289>>03535000
   TOS := OFFSET;                                              <<06289>>03540000
   TOS := COUNT;                                               <<06289>>03545000
   ASSEMBLE( MFDS );                                           <<06289>>03550000
END;                                                           <<06289>>03555000
$control segment=called'once                                            03560000
PROCEDURE MTDS( DSTN, OFFSET, BUF, COUNT);                     <<06289>>03565000
   VALUE DSTN, OFFSET, COUNT;                                  <<06289>>03570000
   ARRAY BUF;                                                  <<06289>>03575000
   INTEGER DSTN, OFFSET, COUNT;                                <<06289>>03580000
BEGIN                                                          <<06289>>03585000
   TOS := DSTN;                                                <<06289>>03590000
   TOS := OFFSET;                                              <<06289>>03595000
   TOS := @BUF;                                                <<06289>>03600000
   TOS := COUNT;                                               <<06289>>03605000
   ASSEMBLE( MTDS );                                           <<06289>>03610000
END;                                                           <<06289>>03615000
$control segment=never'called                                           03620000
PROCEDURE MDS( TARGETDSTN,TOFFSET,SOURCEDSTN,SOFFSET,COUNT);   <<06289>>03625000
   VALUE TARGETDSTN, TOFFSET, SOURCEDSTN, SOFFSET, COUNT;      <<06289>>03630000
   INTEGER TARGETDSTN, TOFFSET, SOURCEDSTN, SOFFSET, COUNT;    <<06289>>03635000
BEGIN                                                          <<06289>>03640000
   TOS := TARGETDSTN;                                          <<06289>>03645000
   TOS := TOFFSET;                                             <<06289>>03650000
   TOS := SOURCEDSTN;                                          <<06289>>03655000
   TOS := SOFFSET;                                             <<06289>>03660000
   TOS := COUNT;                                               <<06289>>03665000
   ASSEMBLE( MDS );                                            <<06289>>03670000
END;                                                           <<06289>>03675000
                                                               <<06289>>03680000
$control segment=called'once                                            03685000
PROCEDURE ZEROBUF( BUF, LENGTH);                               <<06289>>03690000
   VALUE LENGTH;                                               <<06289>>03695000
   ARRAY BUF;                                                  <<06289>>03700000
   INTEGER LENGTH;                                             <<06289>>03705000
BEGIN                                                          <<06289>>03710000
   BUF := 0;                                                   <<06289>>03715000
   MOVE BUF(1) := BUF,(LENGTH-1);                              <<06289>>03720000
END;                                                           <<06289>>03725000
$control segment=loop                                                   03730000
LOGICAL PROCEDURE CHECK'FOR'MESSAGE;                           <<03518>>03735000
                                                                        03740000
<<==============================================================        03745000
                                                                        03750000
      This procedure checks to see if any messages have been            03755000
   sent to PROGEN via the low level message system, port 0.             03760000
   If a message was recieved, the approriate procedure is               03765000
   called to process the message, then it checks to see if              03770000
   any other messages are waiting.                                      03775000
                                                                        03780000
      Currently only two types of messages are sent to                  03785000
   PROGEN, both by the Disc Free Space management code.  A              03790000
   message i.d. is the last word of the message, telling                03795000
   PROGEN which procedure to call.                                      03800000
                                                                        03805000
      Message i.d. 0 is a request to call Process'Dfs'Error             03810000
   to handle a fatal Disc Free Space error.  The four word              03815000
   message looks like this:                                             03820000
                                                                        03825000
      word 0 - ldev - ldev number of device that got the                03830000
               error.                                                   03835000
      word 1 - error status - Disc Free Space error status.             03840000
      word 2 - type of error - A code that indicates what was           03845000
               going on when the error occured.                         03850000
      word 3 - 0 - message i.d.                                         03855000
                                                                        03860000
      Message  i.d. 1 is a request to call                              03865000
   Process'Page'Io'Error to handle a I/O or checksum error that         03870000
   occured on the Disc Free Space bitmap.  The four word                03875000
   message looks like this:                                             03880000
                                                                        03885000
      word 0 - ldev - ldev number of the device that got the            03890000
                      error.                                            03895000
      word 1 - page - page number of the bit map page that              03900000
                      got the error.                                    03905000
      word 2 - error status - Disc Free Space error status.             03910000
      word 3 - 1 - message i.d.                                         03915000
                                                                        03920000
                                                                        03925000
   Parameters:                                                          03930000
      None.                                                             03935000
                                                                        03940000
   Returns:                                                             03945000
      TRUE - if any message where processed.                            03950000
      FALSE - if no messages where processed.                           03955000
                                                                        03960000
   Assumptions on entry:                                                03965000
      DB is at the stack.                                               03970000
                                                                        03975000
   Exit conditions:                                                     03980000
      DB is unchanged.                                                  03985000
                                                                        03990000
   Globals:                                                             03995000
      None.                                                             04000000
                                                                        04005000
   Externals:                                                           04010000
      Portstatus                                                        04015000
      Receivemsg                                                        04020000
      Suddendeath                                                       04025000
      Process'Dfs'Error                                                 04030000
      Print'Page'Io'Error                                               04035000
                                                                        04040000
   Intrinsics:                                                          04045000
      None.                                                             04050000
                                                                        04055000
   Callers:                                                             04060000
      PROGEN outer block.                                               04065000
                                                                        04070000
                                                                        04075000
   Fix ID:                                                              04080000
         This procedure was added as part of the new disc               04085000
      free space map changes.  The fix number on the                    04090000
      procedure header applies to the whole procedure.                  04095000
                                                                        04100000
   Changes:                                                             04105000
                                                                        04110000
                                                                        04115000
==============================================================>>        04120000
                                                                        04125000
BEGIN                                                                   04130000
                                                                        04135000
   LOGICAL MESSAGE'IN'PORT;                                             04140000
                                                                        04145000
   LOGICAL RETURN'VALUE = CHECK'FOR'MESSAGE;                            04150000
                                                                        04155000
   << - - - - - - - - - - >>                                            04160000
                                                                        04165000
   RETURN'VALUE := FALSE;                                               04170000
                                                                        04175000
   << Check for any messages in PORT 0, continue until                  04180000
      no messages are available.                        >>              04185000
                                                                        04190000
   DO                                                                   04195000
      BEGIN  << Check for waiting message >>                            04200000
                                                                        04205000
         MESSAGE'IN'PORT := PORTSTATUS (0);                             04210000
                                                                        04215000
         IF MESSAGE'IN'PORT THEN                                        04220000
            BEGIN   << Got a message >>                                 04225000
                                                                        04230000
               RETURN'VALUE := TRUE;                                    04235000
                                                                        04240000
               << Allocate buffer on TOS for message >>                 04245000
                                                                        04250000
               ASSEMBLE (ADDS 4);                                       04255000
                                                                        04260000
               << Read message >>                                       04265000
                                                                        04270000
               RECEIVEMSG (0, 4, 0);                                    04275000
               IF <> THEN                                               04280000
                  SUDDENDEATH (373);                                    04285000
                                                                        04290000
               << The type (I.D.) of the message will be on TOS >>      04295000
                                                                        04300000
               CASE TOS OF                                              04305000
                  BEGIN  << Process message >>                          04310000
                                                                        04315000
                     << 0 - call Process'Dfs'Error >>                   04320000
                                                                        04325000
                     PROCESS'DFS'ERROR (*, *, *);                       04330000
                                                                        04335000
                                                                        04340000
                     << 1 - Generate message for Page'Io'Error >>       04345000
                                                                        04350000
                     PROCESS'PAGE'IO'ERROR (*, *, *);          <<03529>>04355000
                                                                        04360000
                  END;   << Process message >>                          04365000
                                                                        04370000
            END;    << Got a message >>                                 04375000
                                                                        04380000
      END    << Check for waiting message >>                            04385000
   UNTIL NOT MESSAGE'IN'PORT;                                           04390000
                                                                        04395000
END;   << Check'For'Message >>                                          04400000
                                                                        04405000
<<  ***** FIX INFORMATION: The Fix number for all the lines >>          04410000
<<  of the STARTUP STATE CONFIGURATOR IS AS BELOW:         >>           04415000
                                                               << 8968>>04420000
                                                                        04425000
$control segment=called'once                                            04430000
$page "System Startup Processor - Print'Block'Type"                     04435000
                                                                        04440000
<< ================================================================ >>  04445000
<< =====              Procedure Print'Block'Type              ===== >>  04450000
<< ================================================================ >>  04455000
                                                                        04460000
PROCEDURE Print'Block'Type( Block'type );                               04465000
                                                                        04470000
VALUE   Block'type;                                                     04475000
INTEGER Block'type;                                                     04480000
                                                                        04485000
Comment                                                                 04490000
                                                                        04495000
Print'Block'Type prints the name (i.e. COOLSTART, WARMSTART, etc.)      04500000
of the Block about to be processed.                                     04505000
                                                                        04510000
Parameters:                                                             04515000
                                                                        04520000
   Block'type -- Input -- Type of block to print                        04525000
                          (see T' declarations).                        04530000
                                                                        04535000
;                                                                       04540000
                                                                        04545000
BEGIN                        << ***** Print'Block'Type ***** >>         04550000
                                                                        04555000
BYTE ARRAY                                                              04560000
         Block'Name(0 : 10);                                            04565000
                                                                        04570000
CASE Block'type  OF                                                     04575000
BEGIN                                                                   04580000
  MOVE Block'Name := ("WARMSTART", 0);   << 0 >>                        04585000
  MOVE Block'Name := ("COOLSTART", 0);   << 1 >>                        04590000
  MOVE Block'Name := ("COLDSTART", 0);   << 2 >>                        04595000
  MOVE Block'Name := ("UPDATE", 0);      << 3 >>                        04600000
  MOVE Block'Name := ("RELOAD", 0);      << 4 >>                        04605000
  MOVE Block'name := ("STARTUP", 0);     << 5 >>                        04610000
END;                                                                    04615000
                                                                        04620000
Genmsg ( Sysset, Header'Msg, 0, @Block'Name );                          04625000
                                                                        04630000
END;                         << ***** Print'Block'Type ***** >>         04635000
                                                                        04640000
                                                                        04645000
$Page "System Startup Processor - Get Next Record Out Of The Block"     04650000
<< ================================================================ >>  04655000
<< =====              Procedure Get'Next'Record               ===== >>  04660000
<< ================================================================ >>  04665000
                                                                        04670000
LOGICAL PROCEDURE Get'Next'Record ( Fnum, Record'Number, Out'Rec,       04675000
                                    Length, Quiet);            <<s9044>>04680000
VALUE    Quiet, Fnum;                                          <<s9044>>04685000
INTEGER Length, Fnum;                                                   04690000
LOGICAL Quiet;                                                 <<s9044>>04695000
ARRAY   Out'Rec;                                                        04700000
DOUBLE  Record'Number;                                                  04705000
                                                                        04710000
Comment                                                                 04715000
                                                                        04720000
This procedure gets the "next" record from the system startup           04725000
time.  The next record is the one pointed to by Record'Number.          04730000
                                                                        04735000
Parameters:                                                             04740000
                                                                        04745000
  Fnum           -- Input  -- The startup file number                   04750000
  Record'Number  -- Update -- Input record number, updated to the       04755000
                              following record number.                  04760000
  Out'Rec        -- Output -- The output record                         04765000
  Length         -- Output -- The length of the output record.          04770000
  Quiet          -- Input  -- To suppress the error messages   <<s9044>>04775000
                              when skipping large records.     <<s9044>>04780000
                                                               <<s9044>>04785000
  ( Get'Next'Record is called from 3 different places          <<s9044>>04790000
    inside the System Startup Processor. The first 2           <<s9044>>04795000
    times are when we scan for keywords. If we find a          <<s9044>>04800000
    continued record that is bigger than our buffer,           <<s9044>>04805000
    we skip it without printing an error message.              <<s9044>>04810000
    Later when Process'Block calls us, we will give            <<s9044>>04815000
    an appropriate message once only. The Quiet variable       <<s9044>>04820000
    is how we suppress the messages the first time. )          <<s9044>>04825000
                                                               <<s9044>>04830000
                                                               <<s9044>>04835000
Functional Return:                                             <<s9044>>04840000
                                                                        04845000
  True:  The next record was successfully retrieved.                    04850000
  False: No record retrieved, for example EOF encountered.              04855000
                                                                        04860000
;                                                                       04865000
                                                                        04870000
                                                                        04875000
BEGIN                        << ***** Get'Next'Record ***** >>          04880000
                                                                        04885000
    INTEGER Temp'Length := 0;        << holds temp. command length   >> 04890000
    INTEGER I;                       << loop var for blank stripping >> 04895000
    LOGICAL More'Command := true;    << true until have command      >> 04900000
                                                                        04905000
    << the following two OWN variables keep their values      >>        04910000
    << from call to call (the init. takes place on first call >>        04915000
    OWN LOGICAL First'Time := true;  << true the first time here     >> 04920000
    OWN INTEGER Reclen;              << Start file record length     >> 04925000
                                                                        04930000
    LOGICAL Numbered;                << true if file is numbered     >> 04935000
                                     << ... called                   >> 04940000
                                                                        04945000
    ARRAY Temp(0:Max'Buffer-1/2);      << holds each line of comm.   >> 04950000
    BYTE ARRAY B'Temp (*) = Temp;                                       04955000
                                                                        04960000
    BYTE ARRAY B'Out'Rec (*) = Out'Rec;                                 04965000
                                                                        04970000
    DOUBLE Save'Number := 0D;                                           04975000
    << Used to keep track of first record number when        >>         04980000
    << we are concatenating records together. This           >>         04985000
    << is used when we overflow the buffer.                  >>         04990000
                                                                        04995000
    LOGICAL EOF := FALSE; << To detect early EOF on          >>         05000000
                          << Startup file                    >>         05005000
                                                                        05010000
$page                                                                   05015000
                                                                        05020000
                                                                        05025000
<< **************************************************************** >>  05030000
<< *****           Subroutine Read'File                       ***** >>  05035000
<< **************************************************************** >>  05040000
                                                                        05045000
LOGICAL SUBROUTINE Read'File( Fnum, Target, Reclen, Recnum );           05050000
VALUE          Fnum, Reclen, Recnum;                                    05055000
LOGICAL ARRAY                   Target;                                 05060000
INTEGER        Fnum, Reclen;                                            05065000
DOUBLE                       Recnum;                                    05070000
                                                                        05075000
Comment                                                                 05080000
                                                                        05085000
This procedure reads the specified record from the file.                05090000
If successful it returns True, otherwise if an error occurs             05095000
a message is printed, and false is returned. (False is                  05100000
returned on EOF as well).                                               05105000
                                                                        05110000
Parameters:                                                             05115000
                                                                        05120000
  Fnum     --  Input  --  File number of startup file.                  05125000
  Target   --  Output --  Array target of data                          05130000
  Reclen   --  Input  --  Record length of startup file (bytes)         05135000
  Recnum   --  Input  --  Record to read                                05140000
                                                                        05145000
;                                                                       05150000
                                                                        05155000
BEGIN                        << ***** Read'File ***** >>                05160000
                                                                        05165000
  Read'File := True;                                                    05170000
                                                                        05175000
  Freaddir ( Fnum, Target, -Reclen, Recnum );                           05180000
  IF > THEN                                                             05185000
    Read'File := False     << EOF has been hit >>                       05190000
  ELSE                                                                  05195000
  IF < THEN                                                             05200000
  BEGIN                                                                 05205000
      Recnum := Recnum + 1D;                                   <<s9044>>05210000
      << In error messages we count records from 1.          >><<s9044>>05215000
                                                               <<s9044>>05220000
      Genmsg (Sysset, Freaddir'Died, %20000, @Recnum);                  05225000
      Read'File := False;                                               05230000
  END                                                                   05235000
END;                         << ***** Read'File ***** >>                05240000
$page                                                                   05245000
                                                                        05250000
<< **************************************************************** >>  05255000
<< *****            Subroutine Get'File'Reclen                ***** >>  05260000
<< **************************************************************** >>  05265000
                                                                        05270000
SUBROUTINE Get'File'Reclen( Reclen );                                   05275000
INTEGER Reclen;                                                         05280000
                                                                        05285000
Comment                                                                 05290000
                                                                        05295000
This procedure determines the startup file record length                05300000
(minus the line number).                                                05305000
                                                                        05310000
Note that the maximum record length we allow is Max'Buffer -1 chars.    05315000
(counting the line number).  If the record length is larger             05320000
than that, then we truncate the records (oh well...).                   05325000
(We need to leave room for a trailing C/R.)                             05330000
                                                                        05335000
Parameters:                                                             05340000
                                                                        05345000
   Reclen  --  Output  --  File record length (bytes)                   05350000
                                                                        05355000
Globals referenced:                                                     05360000
                                                                        05365000
  Fnum      --  Read                                                    05370000
  I         --  Modified                                                05375000
  Temp      --  Modified (used as a temporary record)                   05380000
;                                                                       05385000
BEGIN                        << ***** Get'File'Reclen ***** >>          05390000
                                                                        05395000
Ffileinfo (Fnum,                                                        05400000
           4,            << Record length item number >>                05405000
           Reclen );     << ... >>                                      05410000
                                                                        05415000
Reclen := -Reclen;  << Negative Byte Length returned >>                 05420000
                                                                        05425000
IF Reclen >= Max'Buffer  THEN                                           05430000
BEGIN                                                                   05435000
  Reclen := Max'Buffer - 1;                                             05440000
  Genmsg (Sysset, Truncating );                                         05445000
END                                                                     05450000
ELSE BEGIN                                                              05455000
                                                                        05460000
  B'Temp := 0;                                                          05465000
  MOVE B'Temp (1) := B'Temp, (Reclen - 1);                              05470000
                                                                        05475000
  IF Read'File( Fnum, Temp, Reclen, 0d )   << read first record >>      05480000
  THEN BEGIN                                                            05485000
    << Determine if there is a line number >>                           05490000
    Numbered := true;  << assume it is numbered >>                      05495000
                                                                        05500000
    FOR I := Reclen - 8   UNTIL  Reclen - 1  DO                         05505000
      IF B'Temp(I) <> Numeric  THEN Numbered := False;                  05510000
                                                                        05515000
      IF Numbered  THEN  Reclen := Reclen - 8;                          05520000
  END                                                                   05525000
  ELSE EOF := TRUE; << Eof on first read.                    >>         05530000
                                                                        05535000
END;                                                                    05540000
                                                                        05545000
END;                         << ***** Get'File'Reclen ***** >>          05550000
$page                                                                   05555000
                                                                        05560000
                                                                        05565000
<< **************************************************************** >>  05570000
<< *****           Subroutine Strip'Trailing'Blanks           ***** >>  05575000
<< **************************************************************** >>  05580000
                                                                        05585000
integer SUBROUTINE Strip'Trailing'Blanks;                               05590000
                                                                        05595000
Comment                                                                 05600000
                                                                        05605000
This routine strips leading blanks from the command                     05610000
buffer.  The new length is returned.                                    05615000
                                                                        05620000
Globals referenced:                                                     05625000
                                                                        05630000
I              --   Modified                                            05635000
B'Temp         --   Read                                                05640000
Record'Length  --   Read                                                05645000
                                                                        05650000
;                                                                       05655000
                                                                        05660000
BEGIN                        << ***** Strip'Trailing'Blanks ***** >>    05665000
                                                                        05670000
    I := Reclen - 1;                                                    05675000
    WHILE I >= 0  AND  B'Temp(I) = " "                                  05680000
          DO I := I - 1;                                                05685000
                                                                        05690000
    Strip'Trailing'Blanks := I + 1;  << new length >>                   05695000
                                                                        05700000
END;                         << ***** Strip'Trailing'Blanks ***** >>    05705000
$page                                                                   05710000
                                                                        05715000
<< **************************************************************** >>  05720000
<< *****            Subroutine Strip'Leading'Blanks           ***** >>  05725000
<< **************************************************************** >>  05730000
                                                                        05735000
SUBROUTINE Strip'Leading'Blanks( Local'Length );                        05740000
integer Local'Length;                                                   05745000
                                                                        05750000
Comment                                                                 05755000
                                                                        05760000
This routine strips leading blanks from the command                     05765000
buffer.  The new length is returned.                                    05770000
                                                                        05775000
Parameters:                                                             05780000
                                                                        05785000
  Local'Length  --  Update --  Length of B'Temp command string          05790000
                                                                        05795000
Globals referenced:                                                     05800000
                                                                        05805000
  I       --  Modified                                                  05810000
  B'Temp  --   Modified                                                 05815000
                                                                        05820000
                                                                        05825000
;                                                                       05830000
                                                                        05835000
BEGIN                        << ***** Strip'Leading'Blanks ***** >>     05840000
                                                                        05845000
      I := 0;                                                           05850000
      WHILE B'Temp(I) = " "  DO I := I + 1;                             05855000
      Local'Length := Local'Length - I;                                 05860000
      IF I <> 0 THEN                                                    05865000
        MOVE B'Temp := B'Temp(I), (Local'Length);                       05870000
                                                                        05875000
END;                         << ***** Strip'Leading'Blanks ***** >>     05880000
                                                                        05885000
                                                                        05890000
$page                                                                   05895000
Length := 0;                                                            05900000
EOF := FALSE;                                                           05905000
Get'Next'Record := FALSE;                                               05910000
                                                                        05915000
IF First'Time THEN                                                      05920000
BEGIN                                                                   05925000
  Get'File'Reclen( Reclen );                                            05930000
  First'Time := false;                                                  05935000
  IF EOF THEN RETURN;                                                   05940000
END;                                                                    05945000
                                                                        05950000
B'Out'Rec := " ";                                                       05955000
MOVE B'Out'Rec(1) := B'Out'Rec, ( Max'Buffer - 1);                      05960000
                                                                        05965000
WHILE More'Command  DO    << loop until we have the whole command >>    05970000
BEGIN                                                                   05975000
                                                                        05980000
  Get'Next'Record := FALSE;  << assume failure until sure ok >>         05985000
                                                                        05990000
  B'Temp := 0;                                                          05995000
  MOVE B'Temp (1) := B'Temp, (Reclen-1);                                06000000
                                                                        06005000
  IF NOT Read'File (Fnum, Temp, Reclen, Record'Number)                  06010000
  THEN More'Command := False                                            06015000
  ELSE BEGIN                                                            06020000
                                                                        06025000
    Temp'Length := Strip'Trailing'Blanks;  << length returned >>        06030000
                                                                        06035000
    << ........................................................... >>   06040000
    <<    Allow blank lines in the file by reading the next rec.   >>   06045000
    <<    Note that we only do this if this is not a subsequent    >>   06050000
    <<    line of a multiple line command.  Length = 0 means that  >>   06055000
    <<    this is the first line of a command and (Temp'Length = 0)>>   06060000
    <<    means that this is a blank line.                         >>   06065000
    << ........................................................... >>   06070000
                                                                        06075000
    IF  Length = 0  AND  Temp'Length = 0 THEN                           06080000
      Record'Number := Record'Number + 1d    << skip it >>              06085000
    ELSE BEGIN                                                          06090000
                                                                        06095000
      IF Length = 0  << This is first record of the command. >><<s9044>>06100000
      THEN BEGIN                                                        06105000
        Strip'Leading'Blanks( Temp'Length );                            06110000
        Save'Number := Record'Number + 1D;                     <<s9044>>06115000
                                                               <<s9044>>06120000
        << We are pointing at the record now, but our        >><<s9044>>06125000
        << error messages consider record 0 as the           >><<s9044>>06130000
        << first record (Freaddir uses 0).                   >><<s9044>>06135000
                                                               <<s9044>>06140000
      END;                                                              06145000
                                                                        06150000
      IF Length + Temp'Length > Max'Buffer -1 THEN                      06155000
                                                                        06160000
      << Leave room for the Carriage Return.                 >>         06165000
                                                                        06170000
      BEGIN                                                             06175000
          << Record is too big for our stack, so skip it.    >><<s9044>>06180000
          Length := 0;                                                  06185000
                                                               <<s9044>>06190000
          IF NOT Quiet THEN                                    <<s9044>>06195000
            Genmsg (Sysset,Too'Big'So'Skipping, %20000,        <<s9044>>06200000
                  @Save'Number);                                        06205000
                                                                        06210000
          << Save'Number is where we started doing           >>         06215000
          << continuations.                                  >>         06220000
                                                                        06225000
          << Skip forward over rest of bad continued record.>> <<s9044>>06230000
                                                               <<s9044>>06235000
          WHILE B'Temp ( Temp'Length - 1 ) = "&" DO            <<s9044>>06240000
          BEGIN                                                <<s9044>>06245000
            Record'Number := Record'Number + 1D;               <<s9044>>06250000
                                                               <<s9044>>06255000
            B'Temp := 0;                                       <<s9044>>06260000
            MOVE B'Temp(1) := B'Temp, (Reclen - 1);            <<s9044>>06265000
                                                               <<s9044>>06270000
            IF Read'File (Fnum, Temp, Reclen,                  <<s9044>>06275000
                          Record'Number)                       <<s9044>>06280000
            THEN << Got a record.                            >><<s9044>>06285000
              Temp'Length := Strip'Trailing'Blanks             <<s9044>>06290000
            ELSE                                               <<s9044>>06295000
              More'Command := FALSE; <<EOF>>                   <<s9044>>06300000
                                                               <<s9044>>06305000
          << So we keep reading forwards until we find       >><<s9044>>06310000
          << a record that doesn't have a "&". We then       >><<s9044>>06315000
          << leave without incrementing Record'Number,       >><<s9044>>06320000
          << which gets incremented about 15 lines down.     >><<s9044>>06325000
          << The next caller of Read'File gets               >><<s9044>>06330000
          << the next record into his                        >><<s9044>>06335000
          << buffer. This may not necessarily be inside      >><<s9044>>06340000
          << the same iteration of Get'Next'Record.          >><<s9044>>06345000
                                                               <<s9044>>06350000
          END;                                                 <<s9044>>06355000
                                                               <<s9044>>06360000
          B'Out'Rec := " ";                                    <<s9044>>06365000
          MOVE B'Out'Rec(1) := B'Out'Rec, ( Max'Buffer - 1);   <<s9044>>06370000
      END                                                      <<s9044>>06375000
      ELSE BEGIN                                               <<s9044>>06380000
                                                               <<s9044>>06385000
        MOVE B'Out'Rec (Length) := B'Temp, (Temp'Length);      <<s9044>>06390000
        Length := Length + Temp'Length;                        <<s9044>>06395000
                                                               <<s9044>>06400000
        IF B'Out'Rec (Length-1) = "&"                          <<s9044>>06405000
        THEN Length := Length - 1                              <<s9044>>06410000
        ELSE BEGIN         << We seem to have a command. >>    <<s9044>>06415000
          More'Command := false;                               <<s9044>>06420000
          Get'Next'Record := true;                             <<s9044>>06425000
        END;                                                   <<s9044>>06430000
                                                               <<s9044>>06435000
      END;                                                     <<s9044>>06440000
      Record'Number := Record'Number + 1D;                     <<s9044>>06445000
                                                               <<s9044>>06450000
    END;  << blank line >>                                              06455000
                                                                        06460000
  END;      << (More'Command) >>                                        06465000
                                                                        06470000
END;            << WHILE >>                                             06475000
                                                                        06480000
END;                         << ***** Get'Next'Record ***** >>          06485000
$page "System Startup Processor - Find'keywords"                        06490000
                                                                        06495000
<< ================================================================ >>  06500000
<< =====              Procedure Find'keywords                 ===== >>  06505000
<< ================================================================ >>  06510000
                                                                        06515000
PROCEDURE Find'keywords( Fnum,           << Startup file number >>      06520000
                         Type,           << Startup type >>             06525000
                         Startup'record, << Record for STARTUP >>       06530000
                         Type'record );  << Record for Type start >>    06535000
VALUE   Fnum, Type;                                                     06540000
INTEGER Fnum, Type;                                                     06545000
DOUBLE              Startup'record, Type'record;                        06550000
                                                                        06555000
Comment                                                                 06560000
                                                                        06565000
This procedure searches the INPUT startup file for the keywords         06570000
relevant to this startup.  The STARTUP keyword is always                06575000
searched for and its record returned as well as the specific            06580000
Type (INPUT) record.                                                    06585000
                                                                        06590000
Note, a -1d returned in either output record number, means that         06595000
that startup type was not found.                                        06600000
                                                                        06605000
Parameters:                                                             06610000
                                                                        06615000
Fnum           -- Input  -- File number of startup file.                06620000
Type           -- Input  -- Type of startup                             06625000
Startup'record -- Output -- Record number of STARTUP keyword            06630000
Type'record    -- Output -- Record number of Type keyword.              06635000
                                                                        06640000
;                                                                       06645000
                                                                        06650000
BEGIN                        << ***** Find'keywords ***** >>            06655000
                                                                        06660000
                                                                        06665000
LOGICAL ARRAY L'Keyword(0:Max'Buffer-1/2);                              06670000
BYTE ARRAY                                                              06675000
        Keyword(*) = L'Keyword;                                         06680000
                                                                        06685000
LOGICAL A'Keyword;      << True when the next record is a keyword >>    06690000
INTEGER Type'Entry,                                                     06695000
        Keywdlen,                                                       06700000
        Length;                                                         06705000
DOUBLE  Current'Record;                                                 06710000
                                                                        06715000
DEFINE Quiet = TRUE#;  << For Get'Next'Record                >><<s9044>>06720000
                                                               <<s9044>>06725000
<< set default values >>                                                06730000
Startup'Record := -1d;                                                  06735000
Type'Record    := -1d;                                                  06740000
                                                                        06745000
Current'Record := 0d;                                                   06750000
A'Keyword := true;  << the first record should be a keyword >>          06755000
Length := 0;                                                            06760000
                                                                        06765000
$page                                                                   06770000
                                                                        06775000
<< ............................................................. >>     06780000
<<    Loop through the whole file, note that Get'Next'Record     >>     06785000
<<    will update Current'Record to the next Record              >>     06790000
<< ............................................................. >>     06795000
                                                                        06800000
WHILE                                                          <<s9044>>06805000
  Get'Next'Record( Fnum, Current'Record, L'Keyword,            <<s9044>>06810000
                   Length, Quiet )                             <<s9044>>06815000
  AND ( Startup'Record = -1d OR Type'Record = -1d ) DO         <<s9044>>06820000
                                                                        06825000
      << The check above lets us stop early if we find both  >>         06830000
      << blocks in the file. In this case there seems to be  >>         06835000
      << little point continuing searching the file. If      >>         06840000
      << there is a duplicate block, we will not detect it.  >>         06845000
                                                                        06850000
BEGIN                                                                   06855000
                                                                        06860000
IF A'Keyword THEN                                                       06865000
BEGIN                                                                   06870000
  << .............................................................. >>  06875000
  <<   This is the first record in the file, or the record following>>  06880000
  <<   an asterisk ("*") record, and thus must be a keyword         >>  06885000
  << .............................................................. >>  06890000
                                                                        06895000
  Keywdlen := 0;                                                        06900000
  MOVE Keyword := Keyword WHILE AS,1; << upshift the keyword >>         06905000
  Keywdlen := TOS - @Keyword;                                           06910000
  IF Keywdlen < Length THEN                                             06915000
    Genmsg (Sysset, Data'After'Key, %20000,                             06920000
            @Current'Record);                                           06925000
                                                                        06930000
  << We got junk after the keyword, ignore it.               >>         06935000
                                                                        06940000
  Type'Entry := Search(Keyword, Keywdlen, Startup'Key'Dict) - 1;        06945000
  IF Type'Entry = -1  THEN                                              06950000
  BEGIN                                                                 06955000
    Keyword( Length ) := 0;  << Genmsg expects 0 terminator >>          06960000
    Genmsg( Sysset, Expected'Keyword, 0, @Keyword );                    06965000
  END                                                                   06970000
  ELSE                                                                  06975000
    IF Type'Entry = T'Startup THEN                                      06980000
      IF Startup'Record <> -1d  THEN                                    06985000
        BEGIN                                                           06990000
          << Keyword specified more than once >>                        06995000
          Keyword( Length ) := 0;  << Genmsg expects 0 terminator >>    07000000
          Genmsg( Sysset, Multiple'Keyword, 0, @Keyword );              07005000
        END                                                             07010000
      ELSE Startup'Record := Current'Record - 1d  << we went one past >>07015000
    ELSE                                                                07020000
      IF Type'Entry = Type THEN                                         07025000
        IF Type'Record <> -1d THEN                                      07030000
        BEGIN                                                           07035000
          << Keyword specified more than once >>                        07040000
          Keyword( Length ) := 0;  << Genmsg expects 0 terminator >>    07045000
          Genmsg( Sysset, Multiple'Keyword, 0, @Keyword );              07050000
        END                                                             07055000
        ELSE                                                            07060000
          Type'Record := Current'Record -1d;                            07065000
                                                                        07070000
  A'Keyword := false;  << next record cannot be a keyword >>            07075000
END                                                                     07080000
ELSE IF Keyword(0) = "*"                                                07085000
     THEN A'Keyword := true;  << next record is a keyword >>            07090000
                                                                        07095000
                                                                        07100000
END;   << while >>                                                      07105000
                                                                        07110000
                                                                        07115000
                                                                        07120000
                                                                        07125000
END;                         << ***** Find'keywords ***** >>            07130000
                                                                        07135000
$page "System Startup Processor - Remove'Passwords"                     07140000
                                                                        07145000
<< ================================================================ >>  07150000
<< =====              Procedure Remove'Passwords              ===== >>  07155000
<< ================================================================ >>  07160000
                                                                        07165000
PROCEDURE Remove'Passwords( Buffer,         << Command buffer         >>07170000
                            Length);        << Length of Buffer       >>07175000
                                                                        07180000
                                                                        07185000
INTEGER Length;                                                         07190000
BYTE ARRAY      Buffer;                                                 07195000
                                                                        07200000
Comment                                                                 07205000
                                                                        07210000
Remove'Passwords removes (or tries to remove) Passwords and             07215000
Lockwords from command strings before the string is echoed.             07220000
The updated length of the Buffer is returned.                           07225000
                                                                        07230000
It is hard to be know when we have found a password since               07235000
no parsing of the command is done.  Therefore, when we                  07240000
find something that looks like a password we assume it                  07245000
is one. A password, to be removed must have the following               07250000
characteristics:                                                        07255000
                                                                        07260000
   (1) It begins with a slash                                           07265000
   (2) The first character of the password is ALPHA                     07270000
   (3) The password is delimited by one of the following                07275000
       characters: period, comma, semicolon, space, carriage            07280000
       return.                                                          07285000
   (4) The password is no more than 8 characters in length.             07290000
                                                                        07295000
Parameters:                                                             07300000
                                                                        07305000
   Buffer -- Update --  Command Buffer (terminated by CR)               07310000
   Length -- Update --  Input length of Buffer and Output updated length07315000
                                                                        07320000
;                                                                       07325000
                                                                        07330000
$page                                                                   07335000
                                                                        07340000
BEGIN                        << ***** Remove'Passwords ***** >>         07345000
                                                                        07350000
INTEGER  I, J;        << Indexes into Buffer >>                         07355000
BYTE     Delimiter;   << Holds the password delimiter.  >>              07360000
                                                                        07365000
                                                                        07370000
<< loop through the Buffer looking for passwords >>                     07375000
                                                                        07380000
FOR I := Length-1  STEP -1 UNTIL  0  DO                                 07385000
BEGIN                                                                   07390000
  IF Buffer(I) = "/" THEN  << We may have a password >>                 07395000
    IF Buffer(I+1) = ALPHA THEN   << password must begin with ALPHA >>  07400000
    BEGIN                                                               07405000
      << find the end of the password >>                                07410000
      J := I + 1;                                                       07415000
      WHILE Buffer(J) <> SPECIAL  DO  J := J + 1;                       07420000
                                                                        07425000
      Delimiter := Buffer(J);                                           07430000
      IF Delimiter = "."    OR                                          07435000
         Delimiter = ","    OR                                          07440000
         Delimiter = ";"    OR                                          07445000
         Delimiter = " "    OR                                          07450000
         Delimiter = %15                                                07455000
      THEN IF J - I <= 9  THEN                                          07460000
      BEGIN                    << We have a password (oh goodie!) >>    07465000
        << ...................................................... >>    07470000
        << I is pointing at the slash, J is pointing one past the >>    07475000
        << password.  Remove the password and update the length   >>    07480000
        << ...................................................... >>    07485000
        MOVE Buffer(I+1) := Buffer(J), (Length-J+1);                    07490000
        Length := Length - (J-I-1);                                     07495000
      END;                                                              07500000
                                                                        07505000
    END;                                                                07510000
                                                                        07515000
                                                                        07520000
  END;          << FOR >>                                               07525000
                                                                        07530000
END;                         << ***** Remove'Passwords ***** >>         07535000
$page "System Startup Processor - Valid'Command"                        07540000
                                                                        07545000
<< ================================================================ >>  07550000
<< =====              Procedure Valid'Command                 ===== >>  07555000
<< ================================================================ >>  07560000
                                                                        07565000
LOGICAL PROCEDURE Valid'Command( Buffer );       << Command buffer  >>  07570000
                                                                        07575000
BYTE ARRAY      Buffer;                                                 07580000
                                                                        07585000
Comment                                                                 07590000
                                                                        07595000
Valid'Command verifies that each command to be executed                 07600000
is a valid one, that is one that is allowed at system                   07605000
startup time.                                                           07610000
                                                                        07615000
It is this procedure, specifically the DICT array Com'Dict,             07620000
which defines which MPE commands are allowed at system                  07625000
startup time.                                                           07630000
                                                                        07635000
Parameters:                                                             07640000
                                                                        07645000
   Buffer -- Input  --  Command Buffer (terminated by a CR)             07650000
                                                                        07655000
                                                                        07660000
Functional Return:                                                      07665000
                                                                        07670000
   True:    The command is a valid one                                  07675000
   False:   The command is invalid                                      07680000
                                                                        07685000
;                                                                       07690000
                                                                        07695000
$page                                                                   07700000
BEGIN                        << ***** Valid'Command ***** >>            07705000
                                                                        07710000
INTEGER    Length;      << length of command in the Buffer >>           07715000
BYTE ARRAY                                                              07720000
           Command(0 : Max'Buffer-1/2);                                 07725000
EQUATE                                                                  07730000
           Com'Dict'Size  =  405;                                       07735000
                                                                        07740000
OWN BYTE ARRAY                                                          07745000
           Com'Dict(0:Com'Dict'Size-1) :=                               07750000
                    8,  6, "ALTLOG",                                    07755000
                    9,  7, "COMMENT",                                   07760000
                    9,  7, "CONSOLE",                                   07765000
                    6,  4, "TELL",                                      07770000
                    8,  6, "TELLOP",                                    07775000
                    8,  6, "ACCEPT",                                    07780000
                    7,  5, "ALLOW",                                     07785000
                    10, 8, "DISALLOW",                                  07790000
                    6,  4, "DOWN",                                      07795000
                    10, 8, "DOWNLOAD",                                  07800000
                    11, 9, "DSCONTROL",                                 07805000
                    9,  7, "FOREIGN",                                   07810000
                    6,  4, "GIVE",                                      07815000
                    9,  7, "HEADOFF",                                   07820000
                    8,  6, "HEADON",                                    07825000
                    12,10, "IMFCONTROL",                                07830000
                    10, 8, "JOBFENCE",                                  07835000
                    8,  6, "JOBPRI",                                    07840000
                    13,11, "JOBSECURITY",                               07845000
                    11, 9, "LDISMOUNT",                                 07850000
                    7,  5, "LIMIT",                                     07855000
                    8,  6, "LMOUNT",                                    07860000
                    5,  3, "LOG",                                       07865000
                    8,  6, "MPLINE",                                    07870000
                    13,11, "MRJECONTROL",                               07875000
                    10, 8, "OUTFENCE",                                  07880000
                    8,  6, "REFUSE",                                    07885000
                    12,10, "STARTSPOOL",                                07890000
                    11, 9, "STOPSPOOL",                                 07895000
                    8,  6, "STREAM",                                    07900000
                    9,  7, "STREAMS",                                   07905000
                    12,10, "STARTCACHE",                                07910000
                    11, 9, "STOPCACHE",                                 07915000
                    14,12, "SUSPENDSPOOL",                              07920000
                    6,  4, "TAKE",                                      07925000
                    6,  4, "TUNE",                                      07930000
                    4,  2, "UP",                                        07935000
                    8,  6, "VMOUNT",                                    07940000
                    11, 9, "STARTSESS",                                 07945000
                    10, 8, "SCHEDJOB",                                  07950000
                    9,  7, "DISCRPS",                                   07955000
                    10, 8, "ALLOCATE",                                  07960000
                    12,10, "DEALLOCATE",                                07965000
                    14,12, "CACHECONTROL",                              07970000
                    0;                                                  07975000
$page                                                                   07980000
                                                                        07985000
MOVE Command := Buffer  WHILE  AS, 1;                                   07990000
  << TOS will contain what we will consider the end of command >>       07995000
  << Command contains the upshifted command >>                          08000000
Length := TOS - @Command;                                               08005000
                                                                        08010000
IF Search( Command, Length, Com'Dict ) <> 0                             08015000
THEN Valid'Command := True                                              08020000
ELSE Valid'Command := False;                                            08025000
                                                                        08030000
END;                         << ***** Valid'Command ***** >>            08035000
                                                                        08040000
$Page "System Startup Processor - Process a block within the file."     08045000
                                                                        08050000
                                                                        08055000
<< ================================================================ >>  08060000
<< =====              Procedure Process'Block                 ===== >>  08065000
<< ================================================================ >>  08070000
                                                                        08075000
PROCEDURE Process'Block (Fnum, Start'Rec);                              08080000
VALUE   Fnum, Start'Rec;                                                08085000
INTEGER Fnum;                                                           08090000
DOUBLE        Start'Rec;                                                08095000
                                                                        08100000
Comment                                                                 08105000
                                                                        08110000
Process'Block executes each command in a "Block".  A block is defined   08115000
as one startup type.  For example, the COOLSTART block.  The record     08120000
which is the start of the block in the file is a parameter to this      08125000
procedure.                                                              08130000
                                                                        08135000
Parameters:                                                             08140000
                                                                        08145000
    Fnum        --  INPUT  --  The file number of the startup file.     08150000
    Start'Rec:  --  INPUT  --  The record number of the start of the    08155000
                               block (this will be a pointer to the     08160000
                               block name).                             08165000
                                                                        08170000
                                                                        08175000
;                                                                       08180000
                                                                        08185000
BEGIN                        << ***** Process'Block ***** >>            08190000
                                                                        08195000
    << ....................................................... >>       08200000
    <<                  Process'Block Declarations             >>       08205000
    << ....................................................... >>       08210000
                                                                        08215000
    INTEGER Length,           << length of command string >>            08220000
            Err,              << return from Command intrinsic >>       08225000
            Parm,             << parameter from Command intrinsic >>    08230000
            Edit'Length;                                                08235000
                                                                        08240000
    LOGICAL More'In'Block; << True while more to process in block >>    08245000
    DOUBLE  Current'Rec;   << Current record we are dealing with >>     08250000
                                                                        08255000
    ARRAY                                                               08260000
          L'Cmd'Buffer (0:Max'Buffer-1/2),<< Holds command string >>    08265000
          L'Edit'Buffer(0:Max'Buffer-1/2);<< Com. string edited here >> 08270000
                                                                        08275000
    BYTE ARRAY                                                          08280000
            Edit'Buffer(*) = L'Edit'Buffer,                             08285000
            Cmd'Buffer (*) = L'Cmd'Buffer,                              08290000
            Unk (0:9);  << "Unknown" parameter substitution" >>         08295000
                                                                        08300000
    EQUATE  CR = %15;                                                   08305000
                                                                        08310000
    DEFINE Verbose = FALSE#; << For Get'Next'Record.         >><<s9044>>08315000
                                                               <<s9044>>08320000
    << ....................................................... >>       08325000
                                                                        08330000
$page                                                                   08335000
                                                                        08340000
    << ....................................................... >>       08345000
    <<           Main Code for Procedure Process'Block         >>       08350000
    << ....................................................... >>       08355000
                                                                        08360000
    MOVE Unk := ("<Unknown>",0);                                        08365000
                                                                        08370000
    Current'Rec   := Start'Rec + 1D;  << move past header record >>     08375000
    More'In'Block := true;                                              08380000
                                                                        08385000
                                                                        08390000
    WHILE  More'In'Block   DO                                           08395000
    BEGIN                                                               08400000
                                                                        08405000
      IF NOT Get'Next'Record (Fnum, Current'Rec, L'Cmd'Buffer, <<s9044>>08410000
                              Length, Verbose )                <<s9044>>08415000
      THEN More'In'Block := false                                       08420000
      ELSE  IF Cmd'Buffer(0) = "*" THEN                                 08425000
              More'In'Block := false                                    08430000
                                                                        08435000
            ELSE BEGIN                                                  08440000
              Cmd'Buffer(Length) := CR; << for Command       >>         08445000
                                        << Intrinsic         >>         08450000
                                                                        08455000
              << copy the command and its length (for the echo) >>      08460000
              MOVE Edit'Buffer := Cmd'Buffer, (Length+1);               08465000
                                                                        08470000
              << Must copy Length+1 because Remove'Passwords >>         08475000
              << expects to find a terminator.               >>         08480000
                                                                        08485000
              Edit'Length := Length;                                    08490000
              Remove'passwords( Edit'Buffer, Edit'Length );             08495000
              Edit'Buffer( Edit'Length ) := 0;  << Genmsg terminator >> 08500000
              Genmsg ( -1, @Edit'Buffer );                              08505000
                                                                        08510000
              IF NOT Valid'Command( Cmd'Buffer) THEN                    08515000
              BEGIN                                                     08520000
                Cmd'Buffer(Length) := 0;  << Genmsg expects 0 term. >>  08525000
                Genmsg( Sysset, Invalid'Command, 0, @Cmd'Buffer );      08530000
              END                                                       08535000
                                                                        08540000
              ELSE BEGIN                                                08545000
                                                                        08550000
                << Make sure Err and Parm are initialized    >>         08555000
                << so we don't get previous error messages   >>         08560000
                << again.                                    >>         08565000
                                                                        08570000
                Err := Parm := 0;                                       08575000
                IF CALLDEBUG.(9:1) THEN DEBUG;                          08580000
                Command (Cmd'Buffer, Err, Parm);                        08585000
                IF Err <> 0 THEN                                        08590000
                  Genmsg (Cierr'set, \Err\, 0,                          08595000
                          @Unk, @Unk, @Unk, @Unk,                       08600000
                          @Unk);                                        08605000
                                                                        08610000
              END;                                                      08615000
            END;                                                        08620000
    END;    << While >>                                                 08625000
                                                                        08630000
END;                         << ***** Process'Block ***** >>            08635000
                                                                        08640000
                                                                        08645000
$page "System Startup Processor - Handle'file'error"                    08650000
                                                                        08655000
<< ================================================================ >>  08660000
<< =====              Procedure Handle'file'error             ===== >>  08665000
<< ================================================================ >>  08670000
                                                                        08675000
PROCEDURE Handle'file'error(Fnum);                                      08680000
VALUE Fnum;                                                             08685000
INTEGER Fnum;                                                           08690000
                                                                        08695000
Comment                                                                 08700000
                                                                        08705000
The error message strategy is:                                          08710000
                                                                        08715000
Since Progen is executing this code, it would be nice to preserve some  08720000
backwards compatibility.  When we attempt to Fopen the startup file,    08725000
if it doesn't exist, we terminate the startup processing with no        08730000
message. If we get anything other than FSERR 52, we put together a      08735000
civilized error message, then return.                                   08740000
                                                                        08745000
;                                                                       08750000
                                                                        08755000
BEGIN                        << ***** Handle'file'error ***** >>        08760000
                                                                        08765000
INTEGER                                                                 08770000
           File'Error,                                                  08775000
           Msg'Length;                                                  08780000
                                                                        08785000
ARRAY      L'Error'Msg (0:60);                                          08790000
                                                                        08795000
BYTE ARRAY Error'Msg (*) = L'Error'Msg;                                 08800000
                                                                        08805000
EQUATE                                                                  08810000
           Non'Existent'File = 52; << Fcheck error number    >>         08815000
                                                                        08820000
$page                                                                   08825000
                                                                        08830000
                                                                        08835000
Fcheck (Fnum, File'Error);                                              08840000
IF < THEN                                                               08845000
BEGIN                                                                   08850000
  Genmsg( Sysset, Misc'FS'Err );                                        08855000
  RETURN;                                                               08860000
END;                                                                    08865000
IF File'Error = Non'Existent'File THEN RETURN                           08870000
ELSE                                                                    08875000
BEGIN                                                                   08880000
  L'Error'Msg := "  ";                                                  08885000
  MOVE L'Error'Msg (1) := L'Error'Msg, (60);                            08890000
  Msg'Length := 0;                                                      08895000
                                                                        08900000
  Ferrmsg (File'Error, L'Error'Msg, Msg'Length);                        08905000
  IF <> THEN                                                            08910000
      Genmsg( Sysset, Misc'FS'Err );                                    08915000
                                                                        08920000
  MOVE Error'Msg (Msg'Length) := " on filename ",2;                     08925000
  MOVE * := Startup'name, 2;                                            08930000
  Msg'Length := TOS - @Error'Msg;                                       08935000
  Error'Msg (Msg'Length) := 0;                                          08940000
  Genmsg (-1, @Error'Msg);                                              08945000
END;                                                                    08950000
                                                                        08955000
END;                         << ***** Handle'file'error ***** >>        08960000
                                                                        08965000
                                                                        08970000
$Page "System Startup Processor - Openfile"                             08975000
                                                                        08980000
<< ================================================================ >>  08985000
<< =====              Procedure Openfile                     ====== >>  08990000
<< ================================================================ >>  08995000
                                                                        09000000
LOGICAL PROCEDURE Openfile( Start'File'No );                            09005000
INTEGER Start'File'No;                                                  09010000
                                                                        09015000
Comment                                                                 09020000
                                                                        09025000
This procedure opens the file SYSSTART.PUB.SYS (defined in              09030000
Startup'Name). The file is opened as specified in the                   09035000
FOPTIONS and AOPTIONS defined below.                                    09040000
                                                                        09045000
;                                                                       09050000
                                                                        09055000
BEGIN                        << ***** Openfile ***** >>                 09060000
                                                                        09065000
                                                                        09070000
    ARRAY L'Startup'File (0:17);                                        09075000
                                                                        09080000
    BYTE ARRAY Startup'File (*) = L'Startup'File;                       09085000
                                                                        09090000
    EQUATE                                                              09095000
                                                                        09100000
          Start'Fopt  = [2/0,    << Reserved                       >>   09105000
                         3/0,    << Standard File                  >>   09110000
                         1/0,    << Allow :FILE                    >>   09115000
                         1/0,    << No tape labels                 >>   09120000
                         1/0,    << NOCCTL                         >>   09125000
                         2/0,    << Fixed Length ONLY              >>   09130000
                         3/0,    << No default designator          >>   09135000
                         1/1,    << Ascii                          >>   09140000
                         2/1],   << Old Permanent File             >>   09145000
                                                                        09150000
          Start'Aopt  = [3/0,    << Reserved                       >>   09155000
                         1/0,    << Native Mode                    >>   09160000
                         1/0,    << Normal wait I/O                >>   09165000
                         2/0,    << Non-multi access               >>   09170000
                         1/0,    << Buffered I/O                   >>   09175000
                         2/2,    << Exclusive allowing read        >>   09180000
                         1/0,    << Non Flocking                   >>   09185000
                         1/0,    << No Multi-record                >>   09190000
                         0/4];   << Read only                      >>   09195000
                                                                        09200000
$page                                                                   09205000
                                                                        09210000
    L'Startup'File := 0;                                                09215000
    MOVE L'Startup'File (1) := L'Startup'File, (17);                    09220000
    Start'File'No := 0;                                                 09225000
                                                                        09230000
    MOVE L'Startup'File := Startup'name;                                09235000
                                                                        09240000
    Start'File'No := Fopen (Startup'File, Start'Fopt,                   09245000
                            Start'Aopt);                                09250000
    IF < THEN                                                           09255000
    BEGIN                                                               09260000
       Handle'File'Error( Start'File'No );                              09265000
       Openfile := False;                                               09270000
    END                                                                 09275000
    ELSE                                                                09280000
       Openfile := True;                                                09285000
                                                                        09290000
                                                                        09295000
END;                         << ***** Openfile ***** >>                 09300000
                                                                        09305000
$page "System Startup Processor - Valid'Startup"                        09310000
                                                                        09315000
<< ================================================================ >>  09320000
<< =====              Procedure Valid'Startup                 ===== >>  09325000
<< ================================================================ >>  09330000
                                                                        09335000
logical PROCEDURE Valid'Startup(Fnum);                                  09340000
INTEGER Fnum;                                                           09345000
                                                                        09350000
Comment                                                                 09355000
                                                                        09360000
This procedure determines whether there is a valid startup              09365000
file from which to execute system startup commands.  It                 09370000
returns true if such a file is found, false otherwise.  A               09375000
valid startup file is defined as follows:                               09380000
                                                                        09385000
            (1) The specified file exists and may be opened             09390000
            (2) The file is a fixed-length ASCII file                   09395000
            (3) The creator of the file is MANAGER                      09400000
            (4) The first record of the file is a keyword               09405000
                (STARTUP, COOLSTART, WARMSTART, etc. which              09410000
                we recognize.                                           09415000
                                                                        09420000
                                                                        09425000
Parameters:                                                             09430000
                                                                        09435000
  Fnum --  Output --  File number of the startup file (if valid).       09440000
                                                                        09445000
Functional Return:                                                      09450000
                                                                        09455000
  True:  There is a valid startup file                                  09460000
  False: Not a valid startup.                                           09465000
                                                                        09470000
;                                                                       09475000
                                                                        09480000
                                                                        09485000
BEGIN                        << ***** Valid'Startup ***** >>            09490000
                                                                        09495000
INTRINSIC                                                               09500000
        Ffileinfo;                                                      09505000
                                                                        09510000
LOGICAL ARRAY                                                           09515000
        L'Keyword(0:Max'Buffer-1/2);   << Buffer for keyword >>         09520000
BYTE ARRAY                                                              09525000
        Creator(0:7),   << Creator name >>                              09530000
        Keyword(*) = L'Keyword;                                         09535000
                                                                        09540000
INTEGER Length;              << Length of Keyword >>                    09545000
INTEGER Keywdlen;                                                       09550000
DOUBLE  Rec;                 << parameter to Get'Next'Record >>         09555000
                                                                        09560000
LOGICAL Foptions;            << Startup file Foptions (returned) >>     09565000
DEFINE  Fixed'bit = (8:2)#,                                    << 8968>>09570000
        Ascii'Bit = (13:1)#;                                            09575000
                                                                        09580000
DEFINE Quiet = TRUE#;  << For Get'Next'Record.               >><<s9044>>09585000
                                                               <<s9044>>09590000
$page                                                                   09595000
                                                                        09600000
<< **************************************************************** >>  09605000
<< *****              Subroutine Valid'Access                 ***** >>  09610000
<< **************************************************************** >>  09615000
                                                                        09620000
LOGICAL SUBROUTINE Valid'Access( Fnum );                                09625000
VALUE   Fnum;                                                           09630000
INTEGER Fnum;                                                           09635000
                                                                        09640000
Comment                                                                 09645000
                                                                        09650000
This subroutine verifies that the startup file is a fixed-              09655000
length ASCII file created by MANAGER.                                   09660000
                                                                        09665000
                                                                        09670000
Parameters:                                                             09675000
                                                                        09680000
  Fnum   -- Input  -- Startup file number                               09685000
                                                                        09690000
Functional Return:                                                      09695000
                                                                        09700000
  True:  Accesses are valid                                             09705000
  False: Accesses invalid                                               09710000
                                                                        09715000
;                                                                       09720000
                                                                        09725000
                                                                        09730000
                                                                        09735000
BEGIN                        << ..... Valid'Access ..... >>             09740000
                                                                        09745000
Valid'Access := false;                                         << 8968>>09750000
                                                               << 8968>>09755000
Ffileinfo( Fnum,  2, Foptions,                                 << 8968>>09760000
                 18, Creator  );                               << 8968>>09765000
                                                               << 8968>>09770000
IF Foptions.Ascii'bit AND Foptions.Fixed'bit = 0               << 8968>>09775000
   THEN IF Creator = "MANAGER"                                 << 8968>>09780000
           THEN Valid'Access := true                           << 8968>>09785000
           ELSE Genmsg( Sysset, Illegal'creator )              << 8968>>09790000
   ELSE Genmsg( Sysset, Illegal'rec'format );                  << 8968>>09795000
                                                               << 8968>>09800000
                                                               << 8968>>09805000
                                                               << 8968>>09810000
END;                         << ..... Valid'Access ..... >>             09815000
                                                                        09820000
$page                                                                   09825000
                                                                        09830000
Valid'Startup := false;  << assume failure >>                           09835000
                                                                        09840000
IF Openfile( Fnum )  THEN                                               09845000
  IF Valid'Access( Fnum )  THEN                                         09850000
     BEGIN                                                              09855000
                                                                        09860000
       << Read the first record, lookup in the Dictionary >>            09865000
       Rec := 0d;   << a reference parameter >>                         09870000
       IF Get'Next'Record( Fnum, Rec, L'Keyword,               <<s9044>>09875000
                           Length, Quiet )                     <<s9044>>09880000
       THEN BEGIN                                                       09885000
         MOVE Keyword := Keyword WHILE AS,1; << upshift the keyword >>  09890000
         Keywdlen := TOS - @Keyword;                                    09895000
         << This is a test to find and ignore junk after     >>         09900000
         << the keyword. It will have an error message       >>         09905000
         << printed in Find'Keywords later.                  >>         09910000
                                                                        09915000
         IF Search( Keyword, Keywdlen, Startup'Key'Dict) <> 0           09920000
         THEN Valid'Startup := true                                     09925000
         ELSE BEGIN                                                     09930000
               Fclose ( Fnum, 0, 0);                                    09935000
               Genmsg ( Sysset, No'Keyword );                           09940000
               << Got the first record but it had no         >>         09945000
               << keyword.                                   >>         09950000
         END;                                                           09955000
       END                                                              09960000
       ELSE                                                             09965000
       BEGIN                                                            09970000
         Fclose ( Fnum, 0, 0);                                          09975000
         Genmsg ( Sysset, No'Records );                                 09980000
       END;                                                             09985000
                                                                        09990000
     END                                                                09995000
     ELSE Fclose ( Fnum, 0, 0);                                         10000000
END;                         << ***** Valid'Startup ***** >>            10005000
                                                                        10010000
                                                                        10015000
$Page "System Startup Processor - Process'Startup"                      10020000
                                                                        10025000
<< ================================================================ >>  10030000
<< =====              Procedure Process'Startup              ====== >>  10035000
<< ================================================================ >>  10040000
                                                                        10045000
PROCEDURE Process'Startup;                                              10050000
                                                                        10055000
Comment                                                                 10060000
                                                                        10065000
This is the main procedure (i.e. that one which is called from          10070000
PROGEN's main program) of those set of procedures which process         10075000
the System Startup Configurator file.  This file, SYSSTART.PUB.SYS      10080000
contains commands which are executed before a session is                10085000
logged onto the console. Note that due to the programmatic              10090000
creation of sessions, OPERATOR.SYS is not always logged                 10095000
on. It may be someone else.                                             10100000
If the file does not exist or is not in the format we                   10105000
expect (see the procedure VALID'STARTUP) then no processing             10110000
takes place, and a message explaining why is printed.          << 8968>>10115000
                                                                        10120000
Parameters:   None                                                      10125000
                                                                        10130000
Functional Return: None                                                 10135000
                                                                        10140000
;                                                                       10145000
                                                                        10150000
BEGIN                        << ***** Process'Startup ***** >>          10155000
                                                                        10160000
    INTEGER Start'File'No;    << File number of startup file >>         10165000
                                                                        10170000
    << ..................................................... >>         10175000
    << These are the record numbers of the STARTUP block and >>         10180000
    << block of whatever type of start (COOLSTART,etc.) which>>         10185000
    << has been done.                                        >>         10190000
    << ..................................................... >>         10195000
    DOUBLE                                                              10200000
            Startup'record,                                             10205000
            Type'record;                                                10210000
                                                                        10215000
$page                                                                   10220000
                                                                        10225000
    << ......................................................... >>     10230000
    << Determine if there is a valid startup file by opening the >>     10235000
    << file (START'FILE'NO) and checking the type, access, etc.  >>     10240000
    << ......................................................... >>     10245000
                                                                        10250000
    IF CALLDEBUG.(13:1) THEN DEBUG;                                     10255000
                                                                        10260000
    IF Valid'Startup( Start'File'No ) THEN                              10265000
    BEGIN                                                               10270000
                                                                        10275000
      Genmsg( Sysset, Start'Processing );                               10280000
                                                                        10285000
      Find'keywords( Start'File'No, Start'Up'Option, Startup'Record,    10290000
                                                  Type'Record );        10295000
      IF Startup'Record <> -1d  THEN                                    10300000
      BEGIN                                                             10305000
        Print'Block'Type( T'Startup );                                  10310000
        Process'Block ( Start'File'No, Startup'Record );                10315000
      END;                                                              10320000
                                                                        10325000
      IF Type'Record <> -1d   THEN                                      10330000
      BEGIN                                                             10335000
        Print'Block'Type( Start'Up'Option );                            10340000
        Process'Block ( Start'File'No, Type'Record );                   10345000
      END;                                                              10350000
                                                                        10355000
      << ......................................................... >>   10360000
      <<      Now we just clean up.                                >>   10365000
      << ......................................................... >>   10370000
                                                                        10375000
      Fclose ( Start'File'No, 0, 0);                                    10380000
      IF < THEN                                                         10385000
        Genmsg( Sysset, Misc'FS'Err );                                  10390000
                                                                        10395000
      Genmsg( Sysset, Done'All'Processing );                            10400000
                                                                        10405000
    END;                                                                10410000
                                                                        10415000
                                                                        10420000
END;                         << ***** Process'Startup ***** >>          10425000
$PAGE "=SHUTDOWN & LOGOFF COMMANDS EXECUTOR"                   <<08968>>10430000
LOGICAL PROCEDURE CONSSHUTDOWN (PARMS);                                 10435000
   BYTE ARRAY PARMS;                                                    10440000
   OPTIONS;                                                             10445000
BEGIN                                                                   10450000
   LOGICAL PCBPT;                                              <<06562>>10455000
   ENTRY CONSLOGOFF;                                                    10460000
   INTEGER           RESULT            = CONSSHUTDOWN;                  10465000
   EQUATE            JOBSGONEMSG       = 206;                           10470000
   DEFINE            IODELAY           = 200D #;                        10475000
   DEFINE            HIGHESTDEVICE     = DB0.(0:8) #;                   10480000
   INTEGER           SAVESIR;                                  <<C0.00>>10485000
   INTEGER           LJLIM,            <<(LOCAL) JOB LIM>>     <<C0.00>>10490000
                     LSLIM;            <<(LOCAL) SESSION LIM>> <<C0.00>>10495000
   DEFINE            TBLQUANTUM  = 128  #;                     <<06563>>10500000
   << ...................................................... >><<06563>>10505000
   <<      Declarations for referencing the JMAT             >><<06563>>10510000
   <<   JMATARR -- A DB+0 direct array which is the JMAT     >><<06563>>10515000
   <<              table.                                    >><<06563>>10520000
   <<   JMATINX -- The index used in the include file defs.  >><<06563>>10525000
   <<              to reference each entry in the JMAT.      >><<06563>>10530000
   <<   JMATP --   A pointer version of JMATINX.             >><<06563>>10535000
   << ...................................................... >><<06563>>10540000
                                                               <<06563>>10545000
   INTEGER ARRAY     JMATARR(*) = DB+0; << JMAT array >>       <<06563>>10550000
   INTEGER           JMATINX; << Index into JMATARR >>         <<06563>>10555000
   INTEGER POINTER   JMATP    = JMATINX;<< Ptr. to an entry >> <<06563>>10560000
   INTEGER           LIMIT;<< Index to last JMAT entry >>      <<06563>>10565000
                                                               <<06563>>10570000
   EQUATE            MEMLSTOP =   4;                           <<00.02>>10575000
   DOUBLE            STOPBITS          = DB+%300;                       10580000
   INTEGER           NUMSTOPS          = DB+%302;                       10585000
   DOUBLE ARRAY      STOPS (*)         = DB+%304;                       10590000
   DOUBLE            CURRENTSTOP;                                       10595000
   INTEGER           X1                = CURRENTSTOP,                   10600000
                     WAITFIELD         = X1 +1;                         10605000
   DEFINE            PIN               = X1.(0:8) #,                    10610000
                     STOPBIT           = X1.(8:8) #;                    10615000
   INTEGER           DEVX;             <<LOG DEV INDEX>>                10620000
   BYTE ARRAY        STOPBUF (0:15);   <<PARMARRAY FOR =SPOOL>><<C0.00>>10625000
   INTEGER ARRAY     LDT (*)           = DB+0;  <<LDT TABLE>>  <<06216>>10630000
   INTEGER                                                     <<06216>>10635000
      LPDT'INDEX := 0,                                         << 8102>>10640000
      LDT'INDEX := 0;                                          <<06216>>10645000
                                                               <<06216>>10650000
   EQUATE            TERMTYPE          = 16;    <<TERMINAL>>   <<00.05>>10655000
SUBROUTINE STOPSPOOLERS (SPOOLERTYPE);                         <<C0.00>>10660000
   VALUE SPOOLERTYPE;                                          <<C0.00>>10665000
   INTEGER SPOOLERTYPE;                                        <<C0.00>>10670000
BEGIN                                                          <<C0.00>>10675000
   EXCHANGEDB (LDT'DST);                                       <<06216>>10680000
   DEVX := LDT'NUM'ENTRIES;                                    <<06216>>10685000
   DO BEGIN                                                             10690000
                                                               << 8058>>10695000
      << Whirl through LDT looking for spooled devices. >>     << 8058>>10700000
      << Call CONSSPOOL to abort the spool process for  >>     << 8058>>10705000
      << each spooled device.                           >>     << 8058>>10710000
                                                               << 8058>>10715000
      LPDT'INDEX := DEVX * SIZE'OF'LPDT'ENTRY;                 << 8102>>10720000
      LDT'INDEX := DEVX * SIZE'OF'LDT'ENTRY;                   << 8058>>10725000
      IF LDT'SPOOL'STATE = SPOOLERTYPE                         << 8058>>10730000
                    AND                                        << 8102>>10735000
            NOT LPDT'VIRTUAL'DEVICE                            << 8102>>10740000
         THEN BEGIN                                            << 8058>>10745000
              << Abort the spool process for the device >>     << 8058>>10750000
                                                               << 8058>>10755000
              EXCHANGEDB( 0 );                                 << 8058>>10760000
              MOVE STOPBUF( 0 ) := "   ";                      << 8058>>10765000
              << First three characters of STOPBUF will >>     << 8058>>10770000
              << contain the device number of device    >>     << 8058>>10775000
              << whose spool process will die           >>     << 8058>>10780000
              ASCII( DEVX, 10, STOPBUF( 0 ) );                 << 8058>>10785000
              IF NOT( CONSSPOOL( STOPBUF ) )  << Abort  >>     << 8058>>10790000
                 THEN SUDDENDEATH( 372 );     << Bummer >>     << 8058>>10795000
              EXCHANGEDB( LDT'DST );                           << 8058>>10800000
                                                               << 8058>>10805000
              << Now delay until spool process for that >>     << 8058>>10810000
              << device dies, before continuing on.     >>     << 8058>>10815000
              WHILE LDT'FILE'USE'CNT <> 0                      << 8058>>10820000
                 DO DELAY( 1000D );                            << 8058>>10825000
                                                               << 8058>>10830000
              END;  << If device was spooled >>                << 8058>>10835000
                                                               << 8058>>10840000
      END                                                               10845000
   UNTIL (DEVX := DEVX - 1) = 0;                                        10850000
   EXCHANGEDB (0);                                             <<C0.00>>10855000
   END;    << STOPSPOOLERS >>                                  <<C0.00>>10860000
                                                               <<C0.00>>10865000
<< CONSSHUTDOWN >>                                                      10870000
   GOTO START;                                                          10875000
                                                                        10880000
CONSLOGOFF:                                                             10885000
   RESULT := RESULT -1;                                                 10890000
                                                                        10895000
START:                                                                  10900000
   SCAN PARMS WHILE %6440;                                     <<B0.01>>10905000
   IF NOCARRY THEN                                                      10910000
      BEGIN                            <<SYNTAX: SHOULD HAVE NO PARMS>> 10915000
      CONSSHUTDOWN := FALSE;                                            10920000
      RETURN;                                                           10925000
      END;                                                              10930000
   IF  (OLDJLIMIT <> -1)  AND  (RESULT = -1)  THEN             <<C0.00>>10935000
      << IGNORE THIS =LOGOFF, 'CAUSE ALREADY IN =LOGOFF MODE >><<C0.00>>10940000
      BEGIN                                                    <<02315>>10945000
      CONSSHUTDOWN := FALSE;                                   <<02315>>10950000
      RETURN;                                                  <<C0.00>>10955000
      END;                                                     <<02315>>10960000
                                                               <<C0.00>>10965000
<< TURN OFF SYSUP BIT IF =SHUTDOWN COMMAND >>                  <<02315>>10970000
   IF RESULT=0 THEN ABSYS'SYSUP := 0;                          <<02315>>10975000
                                                               <<02315>>10980000
<< PERFORM =LOGOFF: SAVE LIMITS AND RESET THEM TO ZERO >>      <<C0.00>>10985000
   ATTACHIO(CONSOLELDEV,0,0,0,31,0,0,0,%11);<<RESET CONS MODE>><<01303>>10990000
   EXCHANGEDB(JMATDST);                                                 10995000
   SAVESIR := GETSIR (JMATSIR);                                <<C0.00>>11000000
   IF LOGICAL(RESULT) THEN JMATLGBITS := 1;                    <<06563>>11005000
   LJLIM := JMATJLIMIT;                                        <<06563>>11010000
   JMATJLIMIT := 0;                                            <<06563>>11015000
   LSLIM := JMATSLIMIT;                                        <<06563>>11020000
   JMATSLIMIT := 0;                                            <<06563>>11025000
   TOS := JMATJNUM;   <<SAVE FOR SHUTDOWN LOG RECORD>>         <<06563>>11030000
   TOS := JMATSNUM;                                            <<06563>>11035000
   TOS := 0;                                                   <<06563>>11040000
                                                               <<C0.00>>11045000
<< NO JOBS CAN START EXECUTION: ABORT ALL EXECUTING AND INITIALIZING >> 11050000
   PCBPT := SYSPROC(UCOPPCBN);                                 <<06562>>11055000
   DO BEGIN   <<WAIT FOR SON OF UCOP TO DISAPPEAR >>           <<SB.01>>11060000
   JMATINX := JMATENTRYPTR; << Point to first entry >>         <<06563>>11065000
   LIMIT := JMATCURSIZE*TBLQUANTUM-JMATENTRYSIZE; <<and last>> <<06563>>11070000
   <<  Run through the JMAT and delete those jobs which are >> <<06563>>11075000
   <<  executing, suspended, or initializing.  Note that    >> <<06563>>11080000
   <<  JMATP, the parameter to DELETEJOB, is a pointer which>> <<06563>>11085000
   <<  is equivalenced to JMATINX.  JMATP is used because   >> <<06563>>11090000
   <<  delete job wants a pointer parameter.                >> <<06563>>11095000
                                                               <<06563>>11100000
   DO IF (JMATARR(JMATINX) <> 0)                               <<06563>>11105000
            AND  ((JMATJOBSTATE = JOBEXEC)                     <<06563>>11110000
                  OR (JMATJOBSTATE = JOBSUSP)                  <<06563>>11115000
                  OR (JMATJOBSTATE = JOBINIT)) THEN            <<06563>>11120000
         IF NOT (DELETEJOB (JMATP)) THEN                                11125000
               ASSEMBLE(HALT 8;BR *-1)                                  11130000
   UNTIL (JMATINX := JMATINX + JMATENTRYSIZE) > LIMIT;         <<06563>>11135000
   RELSIR (JMATSIR, SAVESIR);                                  <<C0.00>>11140000
                                                                        11145000
<< Wait for all jobs to be purged >>                           <<06563>>11150000
   DELAY(5000D); <<DELAY 5 SEC >>                              <<SB.01>>11155000
   END        <<WAIT FOR SON OF UCOP TO DISAPPEAR >>           <<SB.01>>11160000
   UNTIL SPCBSONINFO = 0;                                      <<06562>>11165000
                                                                        11170000
   JMATLGBITS := 0;                                            <<06563>>11175000
   EXCHANGEDB (0);                                                      11180000
                                                               <<00624>>11185000
<< GENMESSAGE NOW TAKES CARE OF ALLOCATING THE CONSOLE >>      <<01302>>11190000
                                                               <<00624>>11195000
   GENMSG(1,206,,,,,,,0);<<TELL OP EVERYBODY OFF>>             <<0U.EB>>11200000
                                                               <<04165>>11205000
   STOP'ALL'USERLOGS;    << Stops user logging processes >>    <<04165>>11210000
                                                               <<04165>>11215000
   IF LOGICAL (RESULT) THEN                                    <<C0.00>>11220000
      BEGIN    <<LOGOFF: SAVE OLD VALUES AND LEAVE>>           <<C0.00>>11225000
      OLDJLIMIT := LJLIM;                                      <<C0.00>>11230000
      OLDSLIMIT := LSLIM;                                      <<C0.00>>11235000
      RETURN;                                                  <<C0.00>>11240000
      END;                                                     <<C0.00>>11245000
                                                                        11250000
                                                                        11255000
<< *** SHUTDOWN CONTINUES AFTER LOGOFF *** >>                           11260000
   LOG6 (*, *, *, 6);                  <<SHUTDOWN LOG REC'D>>           11265000
                                                               <<C0.00>>11270000
<< STOP SPOOLERS >>                                            <<C0.00>>11275000
   MOVE STOPBUF(0) := ("   ,STOP,RESET", %15 );                << 8058>>11280000
   MOVE STOPBUF(9) := ("DELETE", %15);                         << 8058>>11285000
   MOVE STOPBUF (9) := "DELETE";                               <<C0.00>>11290000
   STOPSPOOLERS (LDT'INPUT'SPOOLED);                           <<06216>>11295000
                                                               <<C0.00>>11300000
   SETSYSDB;                                                            11305000
<< STOP APPROPRIATE SYSTEM PROCESSES >>                                 11310000
   TOS := 0;                                                            11315000
   WHILE S0 < NUMSTOPS DO                                               11320000
      BEGIN                                                             11325000
      CURRENTSTOP := STOPS(S0);                                         11330000
      IF <> THEN                       <<STOP-PROCESS ENTRY>>           11335000
         BEGIN                                                          11340000
         TOS := PIN *PCBSIZE;          <<SETUP FOR AWAKE>>              11345000
         TOS := WAITFIELD;                                              11350000
         TOS := 2;                                                      11355000
         TOS := (XREG := STOPBIT) &LSR(4);                              11360000
         TOS := TOS +@STOPBITS;                                         11365000
         TOS := PS0;                                                    11370000
         ASSEMBLE (TSBC 0, X);                                          11375000
         DISABLE;                                                       11380000
         PS1 := TOS;                   <<REQUEST STOP VIA SYSGLOB BIT>> 11385000
         DEL;                                                           11390000
         IF S3 = MEMLSTOP THEN UNIMPEDE(S2);                   <<00.02>>11395000
         AWAKE (*, *, *);              <<AWAKE (IF NOT ALREADY, AND>>   11400000
                                       <<WAIT>>                         11405000
         <<STOPPED PROCESS SIGNALLED COMPLETION >>                      11410000
         END;                                                           11415000
      TOS := TOS +1;                                                    11420000
      END;                                                              11425000
                                                               <<06825>>11430000
<< Close all global files. Global file AFT's are stored in  >> <<06825>>11435000
<< the GLOBAL AFT DST.  The file system will do the work.   >> <<06825>>11440000
                                                               <<06825>>11445000
   RESETDB(-1);                                                <<06825>>11450000
   CLOSE'GLOBAL'FILES;                                         <<06825>>11455000
   SETSYSDB;                                                   <<06825>>11460000
                                                                        11465000
<< WRITE OUT RECOVERABLE SYSTEM TABLES >>                      <<C0.00>>11470000
   WRITEDSEG (RINSDST);                                                 11475000
   WRITEDSEG (JMATDST);                                        <<C0.00>>11480000
   WRITEDSEG (ODDDST);                                         <<C0.00>>11485000
   WRITEDSEG (IDDDST);                                         <<C0.00>>11490000
                                                               <<B0.01>>11495000
    << Make sure disc caching is turned off. This will force >><<*8595>>11500000
    << all cache domains to be posted to disc if there were  >><<*8595>>11505000
    << any pending I/O at this time.                         >><<*8595>>11510000
                                                               <<*8595>>11515000
    ShutDownCaching;     << Turn disc caching off >>           <<*8595>>11520000
                                                               <<*8595>>11525000
<< DELAY UNTIL ALL I/O COMPLETE >>                                      11530000
   RESETDB(-1);                                                <<00.05>>11535000
   EXCHANGEDB(LDT'DST);                                        <<06216>>11540000
   DEVX:=LPDT'MAX'ENTRIES;                                     <<06222>>11545000
   DO                                                          <<00.05>>11550000
    BEGIN                                                      <<06216>>11555000
      LDT'INDEX := DEVX * SIZE'OF'LDT'ENTRY;                   <<06216>>11560000
      IF LDT'DEVICE'TYPE =TERMTYPE THEN                        <<06216>>11565000
            ATTACHIO(DEVX,0,0,0,4,0,0,0,1)                     <<00.05>>11570000
    END                                                        <<06216>>11575000
   UNTIL (DEVX:=DEVX-1) = 0;                                   <<00.05>>11580000
   EXCHANGEDB(0);                                              <<00.05>>11585000
                                                                        11590000
<< TELL OPERATOR THAT SYSTEM IS NOW DOWN >>                             11595000
                                                               <<00624>>11600000
<< LOG PROCESS IS NOW STOPPED.  DISABLE LOGGING >>             <<02315>>11605000
<< TO PREVENT LOG OF OPERATOR MESSAGE.  GENMSG  >>             <<02315>>11610000
<< TAKES CARE OF ALLOCATING THE CONSOLE.        >>             <<02315>>11615000
                                                               <<02315>>11620000
   DUMMY := ABSYS'LOGINFO;  << SAVE OLD STATE.  >>             <<02315>>11625000
   ABSYS'LOGINFO := 0;      << DISABLE LOGGING. >>             <<02315>>11630000
                                                               <<03518>>11635000
   << Deallocate free space data segments for >>               <<03518>>11640000
   << all system discs.                       >>               <<03518>>11645000
                                                               <<03518>>11650000
   PROCESS'SYS'DISC'FREE'SPACE'MAPS (FALSE);                   <<03518>>11655000
                                                               <<03518>>11660000
   GENMSG(-1,@MSGZ);                                           <<02315>>11665000
   ABSYS'LOGINFO := DUMMY;  << RESTORE STATE.   >>             <<02315>>11670000
                                                               <<02315>>11675000
   DISABLE;                                                    <<00.05>>11680000
   ASSEMBLE (HALT %17; BR *-1);        <<THAT'S IT FOLKS>>              11685000
                                                                        11690000
   END    <<CONSSHUTDOWN / CONSLOGOFF>>;                                11695000
                                                                        11700000
$PAGE "=LOGON COMMAND EXECUTOR"                                <<00594>>11705000
$control segment=loop                                                   11710000
LOGICAL PROCEDURE CONSLOGON (PARMSP);                          <<C0.00>>11715000
   BYTE ARRAY PARMSP;                                          <<C0.00>>11720000
   OPTIONS;                                                    <<C0.00>>11725000
BEGIN                                                          <<C0.00>>11730000
   INTEGER           SAVESIR;                                  <<06563>>11735000
   << ...................................................... >><<06563>>11740000
   <<      Declarations for referencing the JMAT             >><<06563>>11745000
   <<   JMATARR -- A DB+0 direct array which is the JMAT     >><<06563>>11750000
   <<              table.                                    >><<06563>>11755000
   <<   JMATINX -- The index used in the include file defs.  >><<06563>>11760000
   <<              to reference each entry in the JMAT.      >><<06563>>11765000
   << ...................................................... >><<06563>>11770000
                                                               <<06563>>11775000
   INTEGER ARRAY     JMATARR(*)=DB+0; << The JMAT >>           <<06563>>11780000
   INTEGER           JMATINX;  << Index into JMATARR >>        <<06563>>11785000
                                                               <<06563>>11790000
                                                               <<06563>>11795000
<< >>                                                          <<C0.00>>11800000
   SCAN PARMSP WHILE %6440;                                    <<C0.00>>11805000
   IF  CARRY  AND  OLDJLIMIT <> -1  THEN                       <<C0.00>>11810000
      BEGIN    <<IN =LOGOFF MODE>>                             <<C0.00>>11815000
      TOS := OLDJLIMIT;                                        <<C0.00>>11820000
      TOS := OLDSLIMIT;                                        <<C0.00>>11825000
      EXCHANGEDB (JMATDST);                                             11830000
      SAVESIR := GETSIR (JMATSIR);                             <<C0.00>>11835000
      JMATSLIMIT := TOS;                                       <<06563>>11840000
      JMATJLIMIT := TOS;                                       <<06563>>11845000
      RELSIR (JMATSIR, SAVESIR);                               <<C0.00>>11850000
      EXCHANGEDB (0);                                          <<C0.00>>11855000
      OLDJLIMIT := -1;    <<SIGNAL THAT IN =LOGON MODE>>       <<C0.00>>11860000
      AWAKE(SYSPROC(UCOPPCBN),%20,0);                                   11865000
      LPDT'INDEX:=CONSOLELDEV*LPDT'ENTRY'SIZE;                 <<06561>>11870000
      IF LPDT'DEV'OWN'STATE =  LPDT'NOT'OWNED THEN             <<*7694>>11875000
      BEGIN                                                    <<*7694>>11880000
                << log on OPERATOR.SYS automatically >>        <<*7694>>11885000
      GENMSG(-1,@HELLOSTRING);                                          11890000
                                                               <<02856>>11895000
      << Need to set LOGON bit for disconnect processing >>    <<02856>>11900000
      DISABLE;                                                 <<02856>>11905000
      LPDT'INDEX:=CONSOLELDEV*LPDT'ENTRY'SIZE;                 <<06222>>11910000
      LPDT'LOGGING'ON:=1;                                      <<06222>>11915000
      ENABLE;                                                  <<02856>>11920000
                                                               <<02856>>11925000
      DUMMY := 0;   << ERROR NUMBER >>                         <<01318>>11930000
      STARTDEVICE(1,HELLOSTRING(6),CONSOLELDEV,,,,             <<06822>>11935000
                  JOBNUM,DUMMY); << START SESSION AT CONSOLE >><<01318>>11940000
      IF DUMMY > 0 THEN                                        <<02856>>11945000
         BEGIN         << Logon failed >>                      <<02856>>11950000
         GENMSG(1,300);                                        <<02856>>11955000
         DISABLE;                                              <<02856>>11960000
         LPDT'INDEX:=CONSOLELDEV*LPDT'ENTRY'SIZE;              <<06222>>11965000
         LPDT'LOGGING'ON:=0;                                   <<06222>>11970000
         ENABLE;                                               <<02856>>11975000
         END                                                   <<02856>>11980000
      ELSE                                                     <<02856>>11985000
         BEGIN         << Logged on successfully >>            <<02856>>11990000
         ABSOLUTE(ABSYS+SESSION1):=JOBNUM.(4:12);              <<02856>>11995000
         UP := TRUE;   << Don't do DCLOSE on console >>        <<02856>>12000000
         END;                                                  <<02856>>12005000
      END;                                                     <<00639>>12010000
      CONSLOGON := TRUE;                                       <<C0.00>>12015000
      END;                                                     <<C0.00>>12020000
   END;    <<CONSLOGON>>                                       <<C0.00>>12025000
$control segment=never'called                                           12030000
$PAGE "JOB CONTROL PROCEDURES"                                 <<00594>>12035000
PROCEDURE SUSPENDJOB(MAINPIN);                                          12040000
    VALUE MAINPIN;                                                      12045000
    INTEGER MAINPIN;                                                    12050000
   OPTIONS;                                                             12055000
   BEGIN                                                                12060000
   INTEGER TEMPDB,V,NEXT,STATUS=Q-1;                                    12065000
   LOGICAL HYBERNATE := FALSE;                                          12070000
   ENTRY RESUMEJOB;                                                     12075000
   EQUATE      CCG    =  0,                                             12080000
               CCL    =  1,                                             12085000
               CCE    =  2;                                             12090000
EQUATE DISPQ=1,                                                <<MPEIV>>12095000
       ENDOFCLASS=0;                                           <<MPEIV>>12100000
LOGICAL PCBPT;                                                 <<06562>>12105000
   << >>                                                                12110000
   HYBERNATE := TRUE;                                                   12115000
 RESUMEJOB:                                                             12120000
   NEXT := MAINPIN;                                                     12125000
   TOS := 0;                                                            12130000
   PSEUDODISABLE;                                                       12135000
   PCBPT := CURPRC;                                            <<06562>>12140000
   IF PROCSTATE.ALIVEFLAG <> 1 THEN                            <<06562>>12145000
     BEGIN                                                              12150000
       PSEUDOENABLE;                                                    12155000
       STATUS.(6:2) := CCL;                                             12160000
       RETURN;                                                          12165000
     END;                                                               12170000
   IF SPCBSONINFO <> 0 THEN                                    <<06562>>12175000
     BEGIN                                                              12180000
       TEMPDB := SETSYSDB;                                              12185000
       WHILE (NEXT := FAMILY(NEXT,MAINPIN)) <> MAINPIN DO               12190000
           IF LPCB(NEXT*PCBSIZE+PROCSTATEWORDNUM).ALIVEFLAG    <<06562>>12195000
               <> 0 AND HYBERNATE THEN                         <<06562>>12200000
             GOTO OUT                                                   12205000
          ELSE                                                          12210000
             BEGIN                                                      12215000
              LPCB(NEXT*PCBSIZE+PROCSTATEWORDNUM).             <<06562>>12220000
                HYBERNATEFLAG := HYBERNATE;                    <<06562>>12225000
             DISABLE;                                                   12230000
    IF NOT HYBERNATE THEN QUEUEPROC(NEXT*PCBSIZE,              <<06562>>12235000
      DISPQ,ENDOFCLASS);                                       <<MPEIV>>12240000
             ENABLE;                                                    12245000
             END;                                                       12250000
       OUT:                                                             12255000
       RESETDB (TEMPDB);                                                12260000
     END;                                                               12265000
   PROCSTATE.HYBERNATEFLAG := HYBERNATE;                       <<06562>>12270000
   DISABLE;                                                             12275000
  IF NOT HYBERNATE THEN QUEUEPROC(MAINPIN*PCBSIZE,             <<06562>>12280000
      DISPQ,ENDOFCLASS);                                       <<MPEIV>>12285000
   ENABLE;                                                              12290000
   PSEUDOENABLE;                                                        12295000
   STATUS.(6:2) := CCE;                                                 12300000
   END;   <<SUSPENDJOB, RESUMEJOB>>                                     12305000
$PAGE  "Horizon Data Base Manager Process Setup"               <<06826>>12310000
$control segment=called'once                                            12315000
PROCEDURE AWAKEHORIZON;                                        <<06826>>12320000
BEGIN                                                          <<06826>>12325000
                                                               <<06826>>12330000
<<*********************************************************>>  <<06826>>12335000
<<                                                         >>  <<06826>>12340000
<< This procedure PROCREATEs the system process for the    >>  <<06826>>12345000
<< Horizon data base management subsystem.  The procedure, >>  <<06826>>12350000
<< HRZNSYSPROC, is created as an outer block of a process. >>  <<06826>>12355000
<< HRZNSYSPROC is never called.                            >>  <<06826>>12360000
<<                                                         >>  <<06826>>12365000
<< Comments for the handling of PROCREATE are scattered    >>  <<06826>>12370000
<< throughout this procedure.                              >>  <<06826>>12375000
<<                                                         >>  <<06826>>12380000
<<*********************************************************>>  <<06826>>12385000
                                                               <<06826>>12390000
                                                               <<06826>>12395000
INTEGER                                                        <<06826>>12400000
   PIN := 0,              << Holds the HRZNSYSPROC PIN.    >>  <<06826>>12405000
                          << Passing in a zero here to     >>  <<06826>>12410000
                          << PROCREATE indicates that      >>  <<06826>>12415000
                          << PROCREATE must get the PCB    >>  <<06826>>12420000
                          << entry for this PIN.           >>  <<06826>>12425000
   PLABEL,                << of HYZNSYSPROC.               >>  <<06826>>12430000
   DELTAP,                << of HRZNSYSPROC.               >>  <<06826>>12435000
   STACKDST,              << of HRZNSYSPROC.               >>  <<06826>>12440000
   GLOBSIZE  := 1024,     << GLOBSIZE is the amount of DB  >>  <<06826>>12445000
                          << relative storage in the stack.>>  <<06826>>12450000
                          << It is used to calculate where >>  <<06826>>12455000
                          << in the stack the first stack  >>  <<06826>>12460000
                          << marker should be placed.      >>  <<06826>>12465000
   DLSIZE := 16,          << Process uses the standard DL  >>  <<06826>>12470000
                          << areas for subsystems (about   >>  <<06826>>12475000
                          << ten words).  See the Tables   >>  <<06826>>12480000
                          << Manuals PCBX entries for more >>  <<06826>>12485000
                          << information.                  >>  <<06826>>12490000
   LOCSIZE,               << The initial stack size is the >>  <<06826>>12495000
                          << local storage size (LOCSIZE)  >>  <<06826>>12500000
                          << plus GLOBSIZE plus DLSIZE.    >>  <<06826>>12505000
                          << Some overhead is used for     >>  <<06826>>12510000
                          << segment management.           >>  <<06826>>12515000
   PRI := %1150,          << PRI.(3:1) indicates CQ, rest  >>  <<06826>>12520000
                          <<     is its execute priority.  >>  <<06826>>12525000
   STRING := 0,           << INFO string, not used.        >>  <<06826>>12530000
   STRLEN := 0,           << INFO string length.           >>  <<06826>>12535000
   PARAM := 0,            << at HRZNSYSPROC Q-4, not used. >>  <<06826>>12540000
   FLAGS := 0,            << This is the default value     >>  <<06826>>12545000
                          << expected by PROCREATE.  Other >>  <<06826>>12550000
                          << bits are used for things like >>  <<06826>>12555000
                          << an initial DEBUG call and the >>  <<06826>>12560000
                          << program capabilities.  See    >>  <<06826>>12565000
                          << the DEFINEs below for more    >>  <<06826>>12570000
                          << details.                      >>  <<06826>>12575000
   PCBXSIZE,             << total size of PCBX >>              <<07225>>12580000
   MAXSTACK := 20480,     << MAXDATA value.                >>  <<06826>>12585000
   STDIN := 0,            << No $STDIN.                    >>  <<06826>>12590000
   STDLIST := 0;          << No $STDLIST.                  >>  <<06826>>12595000
                                                               <<06826>>12600000
EQUATE                                                         <<06826>>12605000
   PXFILESIZE = 200,                                           <<07225>>12610000
   DLPTSIZE   = 4,        << dl pointer size >>                <<07225>>12615000
   INITSTACK = 8192,      << Initial stack size.           >>  <<06826>>12620000
   DADWAIT  = 1;          << Expected wait state for AWAKE >>  <<06826>>12625000
                                                               <<06826>>12630000
DEFINE                                                         <<06826>>12635000
   STARTPRIV              << This flags the process's      >>  <<06826>>12640000
      = PLABEL.(0:1) #;   << status register to have its   >>  <<06826>>12645000
                          << privileged bit on.            >>  <<06826>>12650000
                                                               <<06826>>12655000
                                                               <<06826>>12660000
LOGICAL                                                        <<06826>>12665000
   XREG = X;              << For the subroutines.          >>  <<06826>>12670000
                                                               <<06826>>12675000
                                                               <<06826>>12680000
INTEGER ARRAY                                                  <<06826>>12685000
   WORKSPACE(0:3) = Q;    << This work area is used to     >>  <<06826>>12690000
                          << initialize the process's      >>  <<06826>>12695000
                          << stack variables.              >>  <<06826>>12700000
                                                               <<06826>>12705000
INTEGER                                                        <<06826>>12710000
   OFFSET;                << Used to index into the stack. >>  <<06826>>12715000
                                                               <<06826>>12720000
EQUATE                                                         <<06826>>12725000
   IDNUMADDR      = 0,    << These values are the stack    >>  <<06826>>12730000
   PLABADDR       = 1,    << variable addresses of the     >>  <<06826>>12735000
   PROCNMLA       = 2,    << outer block's four variables. >>  <<06826>>12740000
   PROCNMBA       = 3;                                         <<06826>>12745000
                                                               <<06826>>12750000
DEFINE                                                         <<06826>>12755000
   FLAGBA = FLAGS.( 7:1) #,   << These DEFINEs are for the >>  <<06826>>12760000
   FLAGIA = FLAGS.( 8:1) #,   << "program" file attributes >>  <<06826>>12765000
   FLAGPM = FLAGS.( 9:1) #,   << to be accessed by the     >>  <<06826>>12770000
   FLAGMR = FLAGS.(12:1) #,   << process.  For more info,  >>  <<06826>>12775000
   FLAGDS = FLAGS.(14:1) #,   << see Chapter 10 of the     >>  <<06826>>12780000
   FLAGPH = FLAGS.(15:1) #;   << System Tables Manual.     >>  <<06826>>12785000
                                                               <<06826>>12790000
                                                               <<06826>>12795000
                                                               <<06826>>12800000
<< The following subroutines are used to access and modify >>  <<06826>>12805000
<< the process's stack.                                    >>  <<06826>>12810000
   SUBROUTINE MOVEFROMDSEG( TARGET, DSTN, OFFSET, COUNT );     <<06826>>12815000
      VALUE TARGET, DSTN, OFFSET, COUNT;                       <<06826>>12820000
      LOGICAL TARGET, DSTN, OFFSET, COUNT;                     <<06826>>12825000
   BEGIN                                                       <<06826>>12830000
                                                               <<06826>>12835000
      XREG := TOS;                                             <<06826>>12840000
      ASSEMBLE( MFDS 0 );                                      <<06826>>12845000
      TOS := XREG;                                             <<06826>>12850000
                                                               <<06826>>12855000
   END;                                                        <<06826>>12860000
                                                               <<06826>>12865000
                                                               <<06826>>12870000
   SUBROUTINE MOVETODSEG( DSTN, OFFSET, SOURCE, COUNT );       <<06826>>12875000
      VALUE DSTN, OFFSET, SOURCE, COUNT;                       <<06826>>12880000
      LOGICAL DSTN, OFFSET, SOURCE, COUNT;                     <<06826>>12885000
   BEGIN                                                       <<06826>>12890000
                                                               <<06826>>12895000
      XREG := TOS;                                             <<06826>>12900000
      ASSEMBLE( MTDS 0 );                                      <<06826>>12905000
      TOS := XREG;                                             <<06826>>12910000
                                                               <<06826>>12915000
   END;                                                        <<06826>>12920000
                                                               <<06826>>12925000
                                                               <<06826>>12930000
<<*********************************************************>>  <<06826>>12935000
<<                                                         >>  <<06826>>12940000
<< Start of main code for AWAKEHORIZON.                    >>  <<06826>>12945000
<<                                                         >>  <<06826>>12950000
<<*********************************************************>>  <<06826>>12955000
                                                               <<06826>>12960000
                                                               <<06826>>12965000
<< First, get a stack to be used for the process.          >>  <<06826>>12970000
   STACKDST := GETSTACK( INITSTACK, MAXSTACK );                <<06826>>12975000
   IF STACKDST = 0 THEN                                        <<06826>>12980000
   BEGIN                                                       <<06826>>12985000
      GENMSG( SYSSET, NOSTACKFORHORIZON );                     <<06826>>12990000
      RETURN;                                                  <<06826>>12995000
   END;                                                        <<06826>>13000000
                                                               <<06826>>13005000
<< Second, once a stack is obtained, calculate the values  >>  <<06826>>13010000
<< needed for PLABEL and DELTAP.  "@PLABEL" yields both    >>  <<06826>>13015000
<< STT and CST information--both are used for the con-     >>  <<06826>>13020000
<< version to a DELTAP, only the CST information is used   >>  <<06826>>13025000
<< for the PLABEL.                                         >>  <<06826>>13030000
   PLABEL := @HRZNSYSPROC.(8:8);  << CST information.      >>  <<06826>>13035000
   STARTPRIV := 1;                                             <<06826>>13040000
   DELTAP := CONVEXTLABELTODELTAP( @HRZNSYSPROC );             <<06826>>13045000
                                                               <<06826>>13050000
<< Third, PROCREATE the process.                           >>  <<06826>>13055000
   PCBXSIZE := PXG'SIZE+ FIXEDSIZE+ PXFILESIZE+ DLPTSIZE;      <<07225>>13060000
   LOCSIZE := INITSTACK - DLSIZE - GLOBSIZE- PCBXSIZE;         <<07225>>13065000
   FLAGIA := 1;                                                <<06826>>13070000
   FLAGBA := 1;                                                <<06826>>13075000
   FLAGPH := 1;      << These capabilities are required.   >>  <<06826>>13080000
   FLAGDS := 1;                                                <<06826>>13085000
   FLAGPM := 1;                                                <<06826>>13090000
   PROCREATE( PIN, PLABEL, DELTAP, STACKDST, GLOBSIZE,         <<06826>>13095000
              DLSIZE, LOCSIZE, PRI, STRING, STRLEN, PARAM,     <<06826>>13100000
              FLAGS, MAXSTACK, STDIN, STDLIST );               <<06826>>13105000
   IF <> THEN                                                  <<06826>>13110000
   BEGIN                                                       <<06826>>13115000
      GENMSG( SYSSET, CANTCREATEHORIZONPROC );                 <<06826>>13120000
      RELDATASEG( STACKDST );                                  <<06826>>13125000
      RETURN;                                                  <<06826>>13130000
   END;                                                        <<06826>>13135000
                                                               <<06826>>13140000
                                                               <<06826>>13145000
<< Fourth, initialize the stack.  The part of the code     >>  <<06826>>13150000
<< "knows" that HRZNSYSPROC has four DB relative variables >>  <<06826>>13155000
<< as well as some secondary DB space reserved.  The four  >>  <<06826>>13160000
<< variables are declared as follows:                      >>  <<06826>>13165000
<<                                                         >>  <<06826>>13170000
<<      INTEGER                                            >>  <<06826>>13175000
<<         IDENTNUM,                  (DB+0)               >>  <<06826>>13180000
<<         PLABEL;                    (DB+1)               >>  <<06826>>13185000
<<                                                         >>  <<06826>>13190000
<<      LOGICAL ARRAY                                      >>  <<06826>>13195000
<<         PROCNAME'(0:20);           (DB+2)               >>  <<06826>>13200000
<<                                                         >>  <<06826>>13205000
<<      BYTE ARRAY                                         >>  <<06826>>13210000
<<         PROCNAME(*) = PROCNAME';   (DB+3)               >>  <<06826>>13215000
<<                                                         >>  <<06826>>13220000
<< These addresses stored in DB+2 and DB+3 must be         >>  <<06826>>13225000
<< initialized here.  The other variables are also set up, >>  <<06826>>13230000
<< but there is no requirement for them to be.             >>  <<06826>>13235000
<<                                                         >>  <<06826>>13240000
<< NOTE:  Any changes to HRZNSYSPROC's variables must be   >>  <<06826>>13245000
<<        reflected here.                                  >>  <<06826>>13250000
<<                                                         >>  <<06826>>13255000
<< PXG'RELDB'OFFSET is the index of the word in the PCBX   >>  <<06826>>13260000
<< that points to the location of initial DB.              >>  <<06826>>13265000
   MOVEFROMDSEG( @OFFSET, STACKDST, PXG'RELDB'OFFSET, 1 );     <<06826>>13270000
                                                               <<06826>>13275000
   WORKSPACE( IDNUMADDR )    := 0;     << IDENTNUM         >>  <<06826>>13280000
   WORKSPACE( PLABADDR  )    := 0;     << PLABEL           >>  <<06826>>13285000
   WORKSPACE( PROCNMLA  )    := 4;     << PROCNAME':  Word >>  <<06826>>13290000
                                       <<    address.      >>  <<06826>>13295000
   WORKSPACE( PROCNMBA  )    := 8;     << PROCNAME:  Byte  >>  <<06826>>13300000
                                       <<    address.      >>  <<06826>>13305000
                                                               <<06826>>13310000
   MOVETODSEG( STACKDST, OFFSET, @WORKSPACE, 4 );              <<06826>>13315000
                                                               <<06826>>13320000
                                                               <<06826>>13325000
<< Finally, awaken the process.  Note no message is sent   >>  <<06826>>13330000
<< to the console in the successful case.  Also, once this >>  <<06826>>13335000
<< process is awakened, it is ignored by PROGEN.  It will  >>  <<06826>>13340000
<< be soft killed normally as a son of PROGEN when a       >>  <<06826>>13345000
<< SHUTDOWN occurs.                                        >>  <<06826>>13350000
   AWAKE( PIN*PCBSIZE, DADWAIT, 0 );                           <<06826>>13355000
                                                               <<06826>>13360000
                                                               <<06826>>13365000
END;  << AWAKEHORIZON >>                                       <<06826>>13370000
$PAGE " "                                                      <<06826>>13375000
                                                               <<06826>>13380000
<< Procedures JOBCONTROL, PUTENTRY, and GETENTRY were      >>  <<06826>>13385000
<< deleted for MPE V because they were not used.           >>  <<06826>>13390000
                                                               <<06826>>13395000
                                                                        13400000
                                                                        13405000
$control segment=loop                                                   13410000
LOGICAL PROCEDURE GETRITENTRY(PIN,RITENTRY,ADR);                        13415000
         VALUE PIN;                                                     13420000
    INTEGER PIN,ADR;                                                    13425000
    INTEGER ARRAY RITENTRY;                                             13430000
         <<GET ENTRY FROM REPLY INFORMATION TABLE.                    >>13435000
         <<INPUT:                                                     >>13440000
         <<PIN       - PROCESS IDENTIFICATION NUMBER                  >>13445000
         <<OUTPUT:                                                    >>13450000
         <<RETENTRY  - ENTRY                                          >>13455000
         <<ADR       - SEG.REL.ADR.OF ENTRY                           >>13460000
         <<GETRITENTRY - TRUE IF FOUND, FALSE OTHERWISE.              >>13465000
   OPTIONS;                                                             13470000
   BEGIN                                                                13475000
   INTEGER                                                     <<04824>>13480000
         SAVEDL                                                         13485000
        ,I                                                              13490000
        ,MAXINX                                                         13495000
   ;INTEGER ARRAY                                                       13500000
         DTAB(*) = DB+0                                                 13505000
   ;                                                                    13510000
   PUSH(DL);                                                            13515000
   SAVEDL _ TOS;                                                        13520000
   EXCHANGEDB(RIT'DST);                                        <<04824>>13525000
   MAXINX := (DTAB(1))*RIT'SIZE+RIT'HEADSIZE;                  <<04824>>13530000
   I := RIT'HEADSIZE-RIT'SIZE;                                 <<04824>>13535000
   WHILE(I:=I+RIT'SIZE)<MAXINX DO IF PIN=DTAB(I) THEN GO FOUND;<<04824>>13540000
GIT:                                                                    13545000
   EXCHANGEDB(0);                                                       13550000
   ADR _ I;                                                             13555000
   RETURN;                                                              13560000
FOUND:                                                                  13565000
   TOS _ @RITENTRY-SAVEDL;   <<DL-REL.TARGET>>                          13570000
   TOS _ I;   <<DB-REL.SOURCE>>                                         13575000
   TOS _ 6;   <<WORD COUNT>>                                            13580000
   ASSEMBLE(MVBL 3);                                                    13585000
   GETRITENTRY _ TRUE;                                                  13590000
   GO GIT;                                                              13595000
   END;   <<GETRITENTRY>>                                               13600000
$PAGE "=DSLINE, =MRJE, =MPLINE, AND =3270 COMMAND EXECUTORS"   <<00594>>13605000
                                                                        13610000
                                                                        13615000
$control segment=loop                                                   13620000
LOGICAL PROCEDURE CONSMRJE (BP);                              <<MRJE>>  13625000
  BYTE ARRAY BP;                                              <<MRJE>>  13630000
  OPTIONS;                                                    <<MRJE>>  13635000
BEGIN                                                         <<MRJE>>  13640000
  TOS := 0;                                                   <<MRJE>>  13645000
  TOS := @BP;                                                 <<MRJE>>  13650000
  TOS := ABSYS'MRJE;                                          <<MRJE>>  13655000
  IF < THEN ASSEMBLE(PCAL 0) ELSE DDEL;                       <<MRJE>>  13660000
  CONSMRJE := TOS;                                            <<MRJE>>  13665000
END;                                                          <<MRJE>>  13670000
$control segment=loop                                                   13675000
LOGICAL PROCEDURE CONS3270(BP);                                <<00182>>13680000
  BYTE ARRAY BP;                                               <<00182>>13685000
  OPTIONS;                                                     <<00182>>13690000
BEGIN                                                          <<00182>>13695000
  TOS := 0;                                                    <<00182>>13700000
  TOS := 0;  << CONS3270, NOT CLOSE3270 >>                     <<00182>>13705000
  TOS := @BP;                                                  <<00182>>13710000
  TOS := PLABEL3270;                                           <<01165>>13715000
  IF < THEN ASSEMBLE( PCAL 0 )                                 <<00182>>13720000
       ELSE ASSEMBLE( DDEL,DEL );                              <<00182>>13725000
  CONS3270 := TOS;                                             <<00182>>13730000
END;                                                           <<00182>>13735000
$PAGE "=ABORTIO COMMAND EXECUTOR"                              <<00594>>13740000
$control segment=loop                                                   13745000
LOGICAL PROCEDURE CONSDELIO(BARRAY);                                    13750000
BYTE ARRAY BARRAY;                                                      13755000
   OPTIONS;                                                             13760000
  BEGIN                                                                 13765000
  INTEGER LDEV,NP;                                                      13770000
  INTEGER ENUM:=0,NOPARM:=1,THEPARM,CARET;                     <<04691>>13775000
  EQUATE BLK =" ";                                             <<04691>>13780000
  BYTE POINTER FIRSTPARM=PARMS;                                <<04691>>13785000
  BYTE ARRAY DELIMITERS(0:1);                                           13790000
  LOGICAL ARRAY CLINE(0:29);                                   <<04691>>13795000
  BYTE ARRAY CLINEB(*)=CLINE;                                  <<04691>>13800000
  MOVE CLINEB(0):=" ";                                         <<04691>>13805000
  MOVE CLINEB(1):=CLINEB(0),(29);                              <<04691>>13810000
                                                                        13815000
<<   Begin checking for correct LDEV >>                        <<04691>>13820000
DELIMITERS:=%15;                                               <<04691>>13825000
MYCOMMAND(BARRAY,,1,NP,PARMS); << Use default delimiters >>    <<04691>>13830000
IF > THEN ENUM:=3019                                           <<04691>>13835000
   ELSE IF NP = 0 THEN ENUM:=3019                              <<04691>>13840000
   ELSE  << Have single parameter; process it >>               <<04691>>13845000
   BEGIN                                                       <<04691>>13850000
   LDEV:=BINARY(PARAM1,INTEGER(LEN1));                                  13855000
   IF <> THEN ENUM:=3001                                       <<04691>>13860000
         ELSE IF LDEV < 1                                      <<04691>>13865000
             THEN ENUM:=3001                                   <<04691>>13870000
             ELSE                                              <<04691>>13875000
             IF LDEV > (INTEGER(LPDT'MAX'ENTRIES))             <<06222>>13880000
                THEN BEGIN                                     <<04691>>13885000
                     NOPARM:=0;                                <<04691>>13890000
                     ENUM:=3002;                               <<04691>>13895000
                     THEPARM:=INTEGER(LPDT'MAX'ENTRIES);       <<06222>>13900000
                     END                                       <<04691>>13905000
                 ELSE BEGIN                                    <<06222>>13910000
                     LPDT'INDEX:=LDEV*INTEGER(LPDT'ENTRY'SIZE);<<06222>>13915000
                      IF LPDT'VIRTUAL'DEVICE = 1               <<06222>>13920000
                        THEN BEGIN                             <<04691>>13925000
                             ENUM:=3007;                       <<04691>>13930000
                             THEPARM:=LDEV;                    <<04691>>13935000
                             NOPARM:=0;                        <<04691>>13940000
                             END                               <<04691>>13945000
                        ELSE                                   <<04691>>13950000
                        BEGIN                                  <<04691>>13955000
                        ABORTIO(LDEV);                         <<04691>>13960000
                        IF < THEN BEGIN                        <<04691>>13965000
                                  NOPARM:=1;                   <<04691>>13970000
                                  ENUM:=3160;                  <<04691>>13975000
                                  END                          <<04691>>13980000
                             ELSE IF > THEN BEGIN              <<04691>>13985000
                                            ENUM:=3028;        <<04691>>13990000
                                            NOPARM:=0;         <<04691>>13995000
                                            THEPARM:=LDEV;     <<04691>>14000000
                                            END                <<04691>>14005000
                        END;                                   <<04691>>14010000
                      END; << ELSE BEGIN FOR VIRT. DEV >>      <<06222>>14015000
     END;                                                      <<04691>>14020000
   IF ENUM <> 0                                                <<04691>>14025000
           THEN BEGIN                                          <<04691>>14030000
           CARET:=8+(@FIRSTPARM-@BP1);                         <<04691>>14035000
           MOVE CLINEB(CARET):="^";                            <<04691>>14040000
           PRINT(CLINE,-30,0);                                 <<04691>>14045000
           IF NOPARM = 1 THEN GENMSG(2,ENUM)                   <<04691>>14050000
              ELSE GENMSG(2,ENUM,%010000,THEPARM)              <<04691>>14055000
           END                                                 <<04691>>14060000
      ELSE;                                                    <<04691>>14065000
    CONSDELIO:=1;                                              <<04691>>14070000
END  <<CONSDELIO>>  ;                                                   14075000
$PAGE "=REPLY COMMAND EXECUTOR"                                <<00594>>14080000
$control segment=loop                                                   14085000
LOGICAL PROCEDURE CONSREPLY(BARRAY);                                    14090000
    BYTE ARRAY BARRAY;                                                  14095000
   OPTIONS;                                                             14100000
   BEGIN                                                                14105000
    INTEGER ARRAY                                                       14110000
         RITENTRY(0:5) = Q                                              14115000
        ,IREPSTR(0:14)                                                  14120000
   ;BYTE ARRAY                                                          14125000
         DELIMITERS(0:1)                                                14130000
   ;BYTE ARRAY                                                          14135000
         BYES (0:3) = PB := "YES", 0                           <<C0.00>>14140000
   ;BYTE ARRAY                                                          14145000
         BNO (0:2) = PB := "NO", 0                             <<C0.00>>14150000
   ;BYTE ARRAY                                                          14155000
         BREPSTR(*) = IREPSTR                                           14160000
   ;INTEGER                                                             14165000
         NUMPARMS                                                       14170000
        ,I,J                                                            14175000
        ,PIN                                                            14180000
        ,ENTRYADR   <<RIT>>                                             14185000
        ,SAVEDL                                                         14190000
        ,COUNT   <<#WORDS TO MOVE TO REPLY BUFFER>>                     14195000
        ,ADREPSTR   <<DB-REL.ADR.OF IREPSTR(*)>>                        14200000
   ;LOGICAL                                                             14205000
         A                                                              14210000
        ,LYES _ FALSE                                                   14215000
        ,LNO _ FALSE                                                    14220000
        ,LNUM _ FALSE                                                   14225000
   ;DEFINE                                                              14230000
         DSTNO       = RITENTRY(1)#                                     14235000
        ,BUFAD       = RITENTRY(2)#                                     14240000
        ,MAXSTRLNGTH = RITENTRY(3).(0:8)#                               14245000
        ,REPLYTYPE   = RITENTRY(3).(8:8)#                               14250000
   ;                                                                    14255000
   MOVE DELIMITERS _ (",",%15);   <<COMMA,CR>>                          14260000
   MYCOMMAND(BARRAY,DELIMITERS,2,NUMPARMS,PARMS);                       14265000
   IF NUMPARMS <> 2 THEN GO BADINPUT;                                   14270000
   IF LEN1=0 OR LEN2=0 THEN GO BADINPUT;                       <<C0.00>>14275000
   PIN _ BINARY(PARAM1,INTEGER(LEN1));                                  14280000
   IF <> THEN GO BADINPUT;                                              14285000
   IF PIN = 0 THEN GO BADINPUT;                                         14290000
   A := GETSIR(RIT'SIR);                                       <<04824>>14295000
   IF NOT GETRITENTRY(PIN,RITENTRY,ENTRYADR) THEN                       14300000
      BEGIN                                                             14305000
B1:   RELSIR(RIT'SIR,A);                                       <<04824>>14310000
BADINPUT:                                                      <<04.EB>>14315000
      RETURN;                                                  <<04.EB>>14320000
      END;                                                              14325000
   J := REPLYTYPE;                                             <<00667>>14330000
   IF (REPLYTYPE=2) OR (REPLYTYPE=4) THEN                      <<00667>>14335000
      BEGIN  J := 2; GO STR;  END;                             <<00667>>14340000
   TOS _ @PARAM2;   <<TARGET>>                                          14345000
   TOS _ @BYES;   <<SOURCE>>                                            14350000
   IF * = * PB, (LEN2), 2 THEN LYES := TRUE;                   <<C0.00>>14355000
   TOS _ @BNO;                                                          14360000
   IF * = * PB, (LEN2), 3 THEN LNO := TRUE;                    <<C0.00>>14365000
   IF LYES OR LNO THEN                                                  14370000
      BEGIN   <<""YES" OR "NO" INPUT>>                                  14375000
      IF J=1 OR J=3 THEN GO GOODREPLY;                                  14380000
      GO B1;                                                            14385000
      END;                                                              14390000
   I _ BINARY(PARAM2,INTEGER(LEN2));                                    14395000
   IF = THEN                                                            14400000
      BEGIN   <<NUMBER INPUT>>                                          14405000
      LNUM _ TRUE;                                                      14410000
      IF J=0 OR J=3 THEN GO GOODREPLY;                                  14415000
      GO B1;                                                            14420000
      END;                                                              14425000
   GO B1;                                                               14430000
STR:                                                                    14435000
   SCAN PARAM2 UNTIL %6415,1;                                  <<04.EB>>14440000
   COUNT := TOS -@PARAM2;                                      <<04.EB>>14445000
   IF COUNT > MAXSTRLNGTH THEN GO B1;                          <<04.EB>>14450000
GOODREPLY:                                                              14455000
   RELSIR(RIT'SIR,A);                                          <<04824>>14460000
   CASE J OF                                                            14465000
      BEGIN                                                             14470000
         BEGIN   <<0-(NUM)>>                                            14475000
         IREPSTR _ I;                                                   14480000
         COUNT _ 1;                                                     14485000
         END;                                                           14490000
         BEGIN   <<1-(Y/N)>>                                            14495000
         IREPSTR _ 1;                                                   14500000
         IF LNO THEN IREPSTR _ 0;                                       14505000
         COUNT _ 1;                                                     14510000
         END;                                                           14515000
         BEGIN   <<2-(SXX)>>                                            14520000
         IREPSTR _ COUNT;                                               14525000
         MOVE BREPSTR(2) _ PARAM2,(COUNT);                              14530000
         COUNT _ (COUNT+1) &LSR(1) + 1;   <<WORD COUNT>>                14535000
         END;                                                           14540000
      END;                                                              14545000
   PUSH(DL);                                                            14550000
   SAVEDL _ TOS;                                                        14555000
   ADREPSTR _ @IREPSTR;                                                 14560000
   EXCHANGEDB(DSTNO);                                                   14565000
   TOS _ BUFAD;   <<DB-REL.TARGET>>                                     14570000
   TOS _ ADREPSTR - SAVEDL;   <<DL-REL.SOURCE>>                         14575000
   TOS _ COUNT;   <<WORD COUNT>>                               << 8494>>14580000
   ASSEMBLE(MVLB 3);                                           << 8494>>14585000
   EXCHANGEDB(0);                                              << 8494>>14590000
   REMRITENTRY(PIN); << REMOVE ENTRY & AWAKEN >>      <<00.EB>><< 8494>>14595000
   CONSREPLY _ TRUE;                                           << 8494>>14600000
   END;   <<CONSREPLY>>                                        << 8494>>14605000
$page "DateJul - Convert Gregorian Date to Julian Date"        << 8495>>14610000
$control segment=called'once                                   << 8495>>14615000
                                                               << 8495>>14620000
DOUBLE PROCEDURE DateJul ( Date, Month, Year );                << 8495>>14625000
VALUE   Date, Month, Year;                                     << 8495>>14630000
INTEGER Date, Month, Year;                                     << 8495>>14635000
BEGIN                                                          << 8495>>14640000
                                                               << 8495>>14645000
   << This procedure is adapted directly from the routine    >><< 8495>>14650000
   << JDAY published in the Collected Algorithms of the ACM  >><< 8495>>14655000
   << as algorithm 111. Credit is given to the original      >><< 8495>>14660000
   << author Robert G. Tantzen, who did the math that I      >><< 8495>>14665000
   << didn't want to do.                                     >><< 8495>>14670000
                                                               << 8495>>14675000
   << This procedure will return a Julian date given         >><< 8495>>14680000
   << a date, month and year triple as input. The reason     >><< 8495>>14685000
   << we want to do this is that we can add and subtract     >><< 8495>>14690000
   << Julian dates at will without having to worry about     >><< 8495>>14695000
   << leap years or any of the other calendar problems.      >><< 8495>>14700000
                                                               << 8495>>14705000
   << Test data:                                             >><< 8495>>14710000
   << If you call this routine with Date = 1,                >><< 8495>>14715000
   << Month = 11 = November, and Year = 1972, you            >><< 8495>>14720000
   << should get a Julian date of 2,441,623 back.            >><< 8495>>14725000
   << This data looks like %11240627 or %45 / %040627.       >><< 8495>>14730000
   << If you call this routine with Date = 1, Month = 3      >><< 8495>>14735000
   << = March and Year = 1900, you should get a Julian date  >><< 8495>>14740000
   << of 2,415,080 back. This looks like %11154750 or        >><< 8495>>14745000
   << %44 / %154750.                                         >><< 8495>>14750000
                                                               << 8495>>14755000
   INTEGER C, Ya;                                              << 8495>>14760000
                                                               << 8495>>14765000
   << C and Ya are unchanged from the original algorithm.    >><< 8495>>14770000
   << They appear to be variables which contain the          >><< 8495>>14775000
   << century and year within the century.                   >><< 8495>>14780000
                                                               << 8495>>14785000
   IF Month > 2 THEN                                           << 8495>>14790000
      Month := Month - 3                                       << 8495>>14795000
   ELSE                                                        << 8495>>14800000
   BEGIN                                                       << 8495>>14805000
      Month := Month + 9;                                      << 8495>>14810000
      Year  := Year  - 1;                                      << 8495>>14815000
   END;                                                        << 8495>>14820000
                                                               << 8495>>14825000
   C  := Year  /  100;                                         << 8495>>14830000
   Ya := Year MOD 100;                                         << 8495>>14835000
                                                               << 8495>>14840000
   DateJul :=   ( 146097D * DOUBLE ( C ) ) / 4D                << 8495>>14845000
              + ( 1461D * DOUBLE ( Ya ) ) / 4D                 << 8495>>14850000
              + DOUBLE ( ( 153 * Month + 2 ) / 5 )             << 8495>>14855000
              + DOUBLE ( Date )                                << 8495>>14860000
              + 1721119D;                                      << 8495>>14865000
                                                               << 8495>>14870000
END;                                                           << 8495>>14875000
                                                               << 8495>>14880000
$page "JulDate - Convert Julian Date to Gregorian Date"        << 8495>>14885000
$control segment=called'once                                   << 8495>>14890000
                                                               << 8495>>14895000
PROCEDURE JulDate ( Julian, Date, Month, Year );               << 8495>>14900000
VALUE  Julian;                                                 << 8495>>14905000
DOUBLE Julian;                                                 << 8495>>14910000
INTEGER Date, Month, Year;                                     << 8495>>14915000
BEGIN                                                          << 8495>>14920000
                                                               << 8495>>14925000
   << This procedure is adapted directly from the routine    >><< 8495>>14930000
   << JDATE published in the Collected Algorithms of the ACM >><< 8495>>14935000
   << as algorithm 111. Credit is given to the original      >><< 8495>>14940000
   << author Robert G. Tantzen, who did the math that I      >><< 8495>>14945000
   << didn't want to do.                                     >><< 8495>>14950000
                                                               << 8495>>14955000
   << This procedure will return a date, month and year      >><< 8495>>14960000
   << triple when given a Julian date as input. The routines >><< 8495>>14965000
   << "JulDate" and "DateJul" are inverse functions.         >><< 8495>>14970000
                                                               << 8495>>14975000
   << Test data:                                             >><< 8495>>14980000
   << See the documentation on "DateJul". These values       >><< 8495>>14985000
   << should work here as well.                              >><< 8495>>14990000
                                                               << 8495>>14995000
   Double D'Date, D'Month, D'Year;                             << 8495>>15000000
                                                               << 8495>>15005000
   << Since it is not clear when the values                  >><< 8495>>15010000
   << of day, month and year fit into 16 bits, we work on    >><< 8495>>15015000
   << double variables and throw away the upper 16 bits at   >><< 8495>>15020000
   << the end when we know it is okay. This is slower        >><< 8495>>15025000
   << but this method is fool-proof.                         >><< 8495>>15030000
                                                               << 8495>>15035000
   << This algorithm has some cosmetic changes from the      >><< 8495>>15040000
   << published version. I have used the MOD operator in     >><< 8495>>15045000
   << place of some ugly arithmetic. Neither Algol 60 nor    >><< 8495>>15050000
   << standard FORTRAN had a MOD operator.                   >><< 8495>>15055000
                                                               << 8495>>15060000
   Julian := Julian - 1721119D;                                << 8495>>15065000
                                                               << 8495>>15070000
   D'Year := ( 4D * Julian - 1D )  /  146097D;                 << 8495>>15075000
                                                               << 8495>>15080000
   Julian := ( 4D * Julian - 1D ) MOD 146097D;                 << 8495>>15085000
                                                               << 8495>>15090000
   D'Date := Julian / 4D;                                      << 8495>>15095000
                                                               << 8495>>15100000
   Julian := ( 4D * D'Date + 3D )  /  1461D;                   << 8495>>15105000
                                                               << 8495>>15110000
   D'Date := ( 4D * D'Date + 3D ) MOD 1461D;                   << 8495>>15115000
                                                               << 8495>>15120000
   D'Date := ( D'Date + 4D ) / 4D;                             << 8495>>15125000
                                                               << 8495>>15130000
   D'Month := ( 5D * D'Date - 3D ) / 153D;                     << 8495>>15135000
                                                               << 8495>>15140000
   D'Date := ( 5D * D'Date - 3D ) MOD 153D;                    << 8495>>15145000
                                                               << 8495>>15150000
   D'Date := ( D'Date + 5D ) / 5D;                             << 8495>>15155000
                                                               << 8495>>15160000
   D'Year := 100D * D'Year + Julian;                           << 8495>>15165000
                                                               << 8495>>15170000
   << Now turn into integers...                              >><< 8495>>15175000
                                                               << 8495>>15180000
   Year  := INTEGER ( D'Year );                                << 8495>>15185000
   Month := INTEGER ( D'Month );                               << 8495>>15190000
   Date  := INTEGER ( D'Date );                                << 8495>>15195000
                                                               << 8495>>15200000
   IF Month < 10 THEN                                          << 8495>>15205000
      Month := Month + 3                                       << 8495>>15210000
   ELSE                                                        << 8495>>15215000
   BEGIN                                                       << 8495>>15220000
      Month := Month - 9;                                      << 8495>>15225000
      Year  := Year  + 1;                                      << 8495>>15230000
   END;                                                        << 8495>>15235000
                                                               << 8495>>15240000
END;                                                           << 8495>>15245000
                                                               << 8495>>15250000
$page "FromCalendar - Convert from Calendar Format to Gregorian"        15255000
$control segment=called'once                                   << 8495>>15260000
                                                               << 8495>>15265000
PROCEDURE FromCalendar ( Year, Day'Of'Year, Month, Date );     << 8495>>15270000
VALUE   Year, Day'Of'Year;                                     << 8495>>15275000
INTEGER Year, Day'Of'Year, Month, Date;                        << 8495>>15280000
BEGIN                                                          << 8495>>15285000
                                                               << 8495>>15290000
   << This procedure is adapted directly from the routine    >><< 8495>>15295000
   << CALENDAR published in the Collected Algorithms of the  >><< 8495>>15300000
   << ACM as algorithm 398. Credit is given to original      >><< 8495>>15305000
   << author Richard A. Stone who applied for a patent       >><< 8495>>15310000
   << in 1970 for "Tableless Date Conversion".               >><< 8495>>15315000
   << It takes the Year and Day'Of'Year passed in            >><< 8495>>15320000
   << and produces the Month and Date as output.             >><< 8495>>15325000
   << This procedure does not accept the bizarre format      >><< 8495>>15330000
   << used by the CALENDAR Intrinsic directly. You           >><< 8495>>15335000
   << must unpack the data into integers first.              >><< 8495>>15340000
                                                               << 8495>>15345000
   << Test data:                                             >><< 8495>>15350000
   << If you call this with Year = 1972 and Day'Of'Year      >><< 8495>>15355000
   << = 306, you should get Month = 11 = November and        >><< 8495>>15360000
   << Date = 1 back.                                         >><< 8495>>15365000
                                                               << 8495>>15370000
                                                               << 8495>>15375000
   INTEGER T;                                                  << 8495>>15380000
                                                               << 8495>>15385000
   T := IF Year MOD 4 = 0 THEN 1                               << 8495>>15390000
                          ELSE 0;                              << 8495>>15395000
                                                               << 8495>>15400000
   T := IF Year MOD 400 = 0 LOR                                << 8495>>15405000
           Year MOD 100 <> 0 THEN T                            << 8495>>15410000
                             ELSE 0;                           << 8495>>15415000
                                                               << 8495>>15420000
   Date  := Day'Of'Year                                        << 8495>>15425000
         + ( IF Day'Of'Year > (59 + T) THEN 2 - T              << 8495>>15430000
                                       ELSE 0 );               << 8495>>15435000
                                                               << 8495>>15440000
   Month := INTEGER ( ( ( DOUBLE ( Date ) + 91D ) * 100D )     << 8495>>15445000
                      / 3055D );                               << 8495>>15450000
                                                               << 8495>>15455000
   Date  := ( Date + 91 )                                      << 8495>>15460000
         - INTEGER ( ( DOUBLE ( Month ) * 3055D ) / 100D );    << 8495>>15465000
                                                               << 8495>>15470000
   Month := Month - 2;                                         << 8495>>15475000
                                                               << 8495>>15480000
END;                                                           << 8495>>15485000
                                                               << 8495>>15490000
$page "ToCalendar - Convert from Gregorian to Calendar Format" << 8495>>15495000
$control segment=called'once                                   << 8495>>15500000
                                                               << 8495>>15505000
PROCEDURE ToCalendar ( Year, Month, Date, Day'Of'Year );       << 8495>>15510000
VALUE   Year, Month, Date;                                     << 8495>>15515000
INTEGER Year, Month, Date, Day'Of'Year;                        << 8495>>15520000
BEGIN                                                          << 8495>>15525000
                                                               << 8495>>15530000
   << This procedure is adapted directly from the routine    >><< 8495>>15535000
   << IDAY published in the Communications of the ACM,       >><< 8495>>15540000
   << October 1972, Volume 15, Number 10, Page 918 by        >><< 8495>>15545000
   << J. Douglas Roberson as a remark on algorithm 398.      >><< 8495>>15550000
   << This procedure takes the Year, Month and Date and      >><< 8495>>15555000
   << returns the Day of the Year.                           >><< 8495>>15560000
   << See remarks in procedure "FromCalendar".               >><< 8495>>15565000
                                                               << 8495>>15570000
   << Test data:                                             >><< 8495>>15575000
   << See notes in procedure "FromCalendar".                 >><< 8495>>15580000
                                                               << 8495>>15585000
   << This algorithm has some cosmetic changes from the      >><< 8495>>15590000
   << published version. I have used the MOD operator in     >><< 8495>>15595000
   << place of some ugly arithmetic. Neither Algol 60 nor    >><< 8495>>15600000
   << standard FORTRAN had a MOD operator.                   >><< 8495>>15605000
                                                               << 8495>>15610000
   Day'Of'Year := INTEGER ( 3055D * DOUBLE ( Month + 2 )       << 8495>>15615000
                   / 100D )                                    << 8495>>15620000
                                                               << 8495>>15625000
                - ( Month + 10 ) / 13 * 2                      << 8495>>15630000
                                                               << 8495>>15635000
                - 91                                           << 8495>>15640000
                                                               << 8495>>15645000
                + ( 1 - ( Year MOD 4 + 3 ) / 4                 << 8495>>15650000
                + ( Year MOD 100 +  99 ) / 100                 << 8495>>15655000
                - ( Year MOD 400 + 399 ) / 400 )               << 8495>>15660000
                * ( Month + 10 ) / 13                          << 8495>>15665000
                                                               << 8495>>15670000
                + Date;                                        << 8495>>15675000
                                                               << 8495>>15680000
END;                                                           << 8495>>15685000
                                                               << 8495>>15690000
$page "ReadMMClock - Read Mighty Mouse Time of Century Clock"  << 8495>>15695000
$control segment=called'once                                   << 8495>>15700000
                                                               << 8495>>15705000
PROCEDURE ReadMMClock ( Ldate, Dtime );                        << 8495>>15710000
LOGICAL Ldate;                                                 << 8495>>15715000
DOUBLE  Dtime;                                                 << 8495>>15720000
BEGIN                                                          << 8495>>15725000
                                                               << 8495>>15730000
   << This procedure's job in life is to take                >><< 8495>>15735000
   << the 32 bit double value returned from                  >><< 8495>>15740000
   << Mighty Mouse's Time of Century (TOC) Clock, and        >><< 8495>>15745000
   << to turn it into the standard and clumsy format         >><< 8495>>15750000
   << used by Startclock, and returned by Convertdate        >><< 8495>>15755000
   << and Converttime. You don't really want to know         >><< 8495>>15760000
   << how the Mighty Mouse TOC works. Suffice it to          >><< 8495>>15765000
   << know that there are 2 machine instructions for         >><< 8495>>15770000
   << manipulating the clock, namely RTOC and WTOC.          >><< 8495>>15775000
   << These two instructions are PROGEN's interface          >><< 8495>>15780000
   << for reading and writing (setting) the clock.           >><< 8495>>15785000
   << The data transfered is a 32 bit double representing    >><< 8495>>15790000
   << the number of seconds elapsed from any mutually        >><< 8495>>15795000
   << agreed upon base date. For lack of a better one        >><< 8495>>15800000
   << we have chosen 1 November 1972 at midnight.            >><< 8495>>15805000
   << This value is equated in several places, just          >><< 8495>>15810000
   << in case MPE lives into the next century.               >><< 8495>>15815000
   << Note that though we will never send or receive         >><< 8495>>15820000
   << a negative number of seconds, we retain a signed       >><< 8495>>15825000
   << double for ease of arithmetic.                         >><< 8495>>15830000
                                                               << 8495>>15835000
   DOUBLE RTOC'Secs := 0D, << These variables are used       >><< 8495>>15840000
          RTOC'Days := 0D; << when we break down the value   >><< 8495>>15845000
                           << returned from the RTOC.        >><< 8495>>15850000
                           << instruction                    >><< 8495>>15855000
                                                               << 8495>>15860000
   EQUATE Mins'Per'Day = 1440;                                 << 8495>>15865000
                                                               << 8495>>15870000
   EQUATE Secs'Per'Min = 60;                                   << 8495>>15875000
                                                               << 8495>>15880000
   EQUATE Nov172 = [7/72, 9/306];                              << 8495>>15885000
   << Above is Calendar and Formatdate format.               >><< 8495>>15890000
                                                               << 8495>>15895000
   DOUBLE Base'Date := 2441623D;                               << 8495>>15900000
   << This is the Julian format of November 1,1972           >><< 8495>>15905000
   << If the Base'Date has to be changed use the procedure   >><< 8495>>15910000
   << "DateJul" and "ToCalendar" to get the new values.      >><< 8495>>15915000
   << The previous two declarations must be changed and      >><< 8495>>15920000
   << there is a corresponding pair in the routine           >><< 8495>>15925000
   << "WriteMMClock".                                        >><< 8495>>15930000
                                                               << 8495>>15935000
   DOUBLE Current'Date := 0D; << Julian format.              >><< 8495>>15940000
                                                               << 8495>>15945000
   DOUBLE Secs'Per'Day := 0D;                                  << 8495>>15950000
                                                               << 8495>>15955000
   INTEGER Year := 0, << Temporary values used for           >><< 8495>>15960000
           Date := 0, << Calculations.                       >><< 8495>>15965000
           Month := 0,                                         << 8495>>15970000
           Day'Of'Year := 0;                                   << 8495>>15975000
                                                               << 8495>>15980000
   DEFINE Year'Part = ( 0:7 )#, << Used to produce           >><< 8495>>15985000
          Day'Part  = ( 7:9 )#; << Calendar Format.          >><< 8495>>15990000
                                                               << 8495>>15995000
                                                               << 8495>>16000000
   Secs'Per'Day := Mins'Per'Day D * Secs'Per'Min D;            << 8495>>16005000
                                                               << 8495>>16010000
   << The equated constant followed by a 'D' is an           >><< 8495>>16015000
   << obscure SPL construct. Since equated variables         >><< 8495>>16020000
   << can only be 16 bits or less, this construct            >><< 8495>>16025000
   << allows us to turn a 16 bit equated constant            >><< 8495>>16030000
   << directly into a double.                                >><< 8495>>16035000
                                                               << 8495>>16040000
   ASSEMBLE ( CON %020104;                                     << 8495>>16045000
              CON %    17 );                                   << 8495>>16050000
                                                               << 8495>>16055000
   << This is the RTOC instruction.                          >><< 8495>>16060000
                                                               << 8495>>16065000
   IF > THEN << Overflowed 31 bits, use default.             >><< 8495>>16070000
   BEGIN                                                       << 8495>>16075000
      Ldate := Nov172;                                         << 8495>>16080000
      Dtime := 0D;                                             << 8495>>16085000
   END                                                         << 8495>>16090000
   ELSE                                                        << 8495>>16095000
   BEGIN                                                       << 8495>>16100000
      RTOC'Secs := TOS;                                        << 8495>>16105000
                                                               << 8495>>16110000
      << We want to keep as much accuracy as possible here.  >><< 8495>>16115000
      << So even though the operator at the console is       >><< 8495>>16120000
      << prompted to the nearest minute, we maintain the     >><< 8495>>16125000
      << TOC time to the nearest second, for use             >><< 8495>>16130000
      << when setting MPE's system clock.                    >><< 8495>>16135000
                                                               << 8495>>16140000
      Dtime := ( RTOC'Secs MOD Secs'Per'Day )                  << 8495>>16145000
                * 1000D;                                       << 8495>>16150000
                                                               << 8495>>16155000
      << This gives us milliseconds from previous midnight.  >><< 8495>>16160000
                                                               << 8495>>16165000
      RTOC'Days := RTOC'Secs / Secs'Per'Day;                   << 8495>>16170000
                                                               << 8495>>16175000
      << This is the number of days since our base date.     >><< 8495>>16180000
                                                               << 8495>>16185000
      Current'Date := Base'Date + RTOC'Days;                   << 8495>>16190000
                                                               << 8495>>16195000
      << Now have a Julian Date.                             >><< 8495>>16200000
                                                               << 8495>>16205000
      << Turn it into a Gregorian Date.                      >><< 8495>>16210000
                                                               << 8495>>16215000
      JulDate ( Current'Date, Date, Month, Year );             << 8495>>16220000
                                                               << 8495>>16225000
      << Squirrel away the year.                             >><< 8495>>16230000
                                                               << 8495>>16235000
      Ldate.Year'Part := LOGICAL ( Year MOD 100 );             << 8495>>16240000
                                                               << 8495>>16245000
      << Get the Day'Of'Year.                                >><< 8495>>16250000
                                                               << 8495>>16255000
      ToCalendar ( Year, Month, Date, Day'Of'Year );           << 8495>>16260000
                                                               << 8495>>16265000
      Ldate.Day'Part := LOGICAL ( Day'Of'Year );               << 8495>>16270000
                                                               << 8495>>16275000
   END;                                                        << 8495>>16280000
END;                                                           << 8495>>16285000
                                                               << 8495>>16290000
$page "WriteMMClock - Write Mighty Mouse Time of Century Clock"<< 8495>>16295000
$control segment=called'once                                   << 8495>>16300000
                                                               << 8495>>16305000
PROCEDURE WriteMMClock ( Ldate, Dtime );                       << 8495>>16310000
VALUE   Ldate, Dtime;                                          << 8495>>16315000
LOGICAL Ldate;                                                 << 8495>>16320000
DOUBLE  Dtime;                                                 << 8495>>16325000
BEGIN                                                          << 8495>>16330000
                                                               << 8495>>16335000
   << This procedure takes data corresponding to             >><< 8495>>16340000
   << the current time and uses it to set Mighty             >><< 8495>>16345000
   << Mouse's Time of Century Clock. Once correctly          >><< 8495>>16350000
   << set, the system should come up automatically           >><< 8495>>16355000
   << with the correct date and time until the special       >><< 8495>>16360000
   << battery on the CPU dies, or is otherwise               >><< 8495>>16365000
   << disconnected. The data we take as input is             >><< 8495>>16370000
   << in the same (clumsy) format used by the                >><< 8495>>16375000
   << procedure "Startclock" which is defined in the         >><< 8495>>16380000
   << module "Hardres". There are several other              >><< 8495>>16385000
   << internal procedures that also use data in this         >><< 8495>>16390000
   << format. They are mostly located in the module          >><< 8495>>16395000
   << "User". This procedure does the converse of            >><< 8495>>16400000
   << the procedure "ReadMMClock". You might want            >><< 8495>>16405000
   << to read the comments in that procedure. There          >><< 8495>>16410000
   << are several constants defined both here and            >><< 8495>>16415000
   << there. If you change the constants, you must           >><< 8495>>16420000
   << change all of them at once. Again see the              >><< 8495>>16425000
   << comments. We only call this procedure if               >><< 8495>>16430000
   << Progen finds it necessary to change the clock.         >><< 8495>>16435000
   << We never update the clock unless we are changing       >><< 8495>>16440000
   << the time as the system comes up. The WTOC              >><< 8495>>16445000
   << and RTOC are probably the slowest machine              >><< 8495>>16450000
   << instructions on the Mouse.                             >><< 8495>>16455000
                                                               << 8495>>16460000
   DOUBLE Base'Date := 2441623D;                               << 8495>>16465000
   << This is the Julian format of November 1,1972           >><< 8495>>16470000
   << If the Base'Date has to be changed use the procedure   >><< 8495>>16475000
   << "DateJul" and "ToCalendar" to get the new values.      >><< 8495>>16480000
   << The previous declaration must be changed and           >><< 8495>>16485000
   << there is a corresponding pair in the routine           >><< 8495>>16490000
   << "ReadMMClock".                                         >><< 8495>>16495000
                                                               << 8495>>16500000
   DOUBLE WTOC'Days := 0D,                                     << 8495>>16505000
          WTOC'Secs := 0D; << Value sent to the TOC.         >><< 8495>>16510000
                                                               << 8495>>16515000
   INTEGER Year := 0, << Temporary values used for           >><< 8495>>16520000
           Date := 0, << calculations.                       >><< 8495>>16525000
           Month := 0,                                         << 8495>>16530000
           Day'of'Year := 0;                                   << 8495>>16535000
                                                               << 8495>>16540000
   EQUATE Mins'Per'Day = 1440;                                 << 8495>>16545000
                                                               << 8495>>16550000
   EQUATE Secs'Per'Min = 60;                                   << 8495>>16555000
                                                               << 8495>>16560000
   DEFINE Year'Part = ( 0:7 )#, << Used to break up fields   >><< 8495>>16565000
          Day'Part  = ( 7:9 )#; << in Ldate (Calendar format)>><< 8495>>16570000
                                                               << 8495>>16575000
   << Extract out the fields from Ldate.                     >><< 8495>>16580000
                                                               << 8495>>16585000
   Day'of'Year := INTEGER ( Ldate.Day'Part );                  << 8495>>16590000
   Year        := INTEGER ( Ldate.Year'Part ) + 1900;          << 8495>>16595000
                                                               << 8495>>16600000
   << Convert to a Gregorian Date.                           >><< 8495>>16605000
                                                               << 8495>>16610000
   FromCalendar ( Year, Day'of'Year, Month, Date );            << 8495>>16615000
                                                               << 8495>>16620000
   << Then straight to a Julian Date.                        >><< 8495>>16625000
                                                               << 8495>>16630000
   WTOC'Days := DateJul ( Date, Month, Year ) - Base'Date;     << 8495>>16635000
                                                               << 8495>>16640000
   << We now have the number of Days from November 1, 1972.  >><< 8495>>16645000
   << Now to get the number of seconds from this date,       >><< 8495>>16650000
   << we turn the number of days into the number of seconds, >><< 8495>>16655000
   << Then take Dtime which is in milliseconds and divide    >><< 8495>>16660000
   << it by 1000, adding this into our total. Since we       >><< 8495>>16665000
   << are spending time in this procedure we round Dtime     >><< 8495>>16670000
   << up to the next second.                                 >><< 8495>>16675000
                                                               << 8495>>16680000
   WTOC'Secs := WTOC'Days * Mins'Per'Day D                     << 8495>>16685000
                          * Secs'Per'Min D                     << 8495>>16690000
                + ( Dtime  + 999D ) / 1000D;                   << 8495>>16695000
                                                               << 8495>>16700000
   TOS := WTOC'Secs;                                           << 8495>>16705000
                                                               << 8495>>16710000
   ASSEMBLE ( CON %020104;                                     << 8495>>16715000
              CON %    20 );                                   << 8495>>16720000
                                                               << 8495>>16725000
   << This is the WTOC instruction.                          >><< 8495>>16730000
   << WTOC returns a condition code, but only for a          >><< 8495>>16735000
   << negative number of seconds past the Base'Date.         >><< 8495>>16740000
   << I see no point in checking for this because            >><< 8495>>16745000
   << it should not happen, we cannot recover from it,       >><< 8495>>16750000
   << and we cannot give a useful error message.             >><< 8495>>16755000
                                                               << 8495>>16760000
END;                                                           << 8495>>16765000
                                                               << 8495>>16770000
$Page "INITMMDATETIME - Use Mighty Mouse's Clock to set system time"    16775000
$control segment=called'once                                            16780000
                                                               << 8494>>16785000
PROCEDURE InitMMDateTime;                                      << 8494>>16790000
BEGIN                                                          << 8494>>16795000
   LOGICAL Ldate := 0;                                         << 8494>>16800000
   DOUBLE Dtime := 0D;                                         << 8494>>16805000
   ARRAY Buff'(0:13);                                          << 8494>>16810000
   BYTE ARRAY Buff (*) = Buff';                                << 8494>>16815000
   LOGICAL Timer := 60; << Seconds. >>                         << 8494>>16820000
   INTEGER Length := 0;                                        << 8494>>16825000
   INTEGER F'In := 0;         << File number for input file. >><< 8494>>16830000
   BYTE ARRAY Dev(0:6); << Ldev number of console in ASCII.  >><< 8494>>16835000
   INTEGER Chars := 0; << Contains number of chars in Dev.   >><< 8494>>16840000
   LOGICAL Good'Date := FALSE;                                 << 8494>>16845000
      << Good'Date is the indicator of whether the operator  >><< 8494>>16850000
      << likes the time we got from the Mighty Mouse Time Of >><< 8494>>16855000
      << Century clock. If Good'Date is still FALSE by the   >><< 8494>>16860000
      << end of this procedure, we set Date and Time the     >><< 8494>>16865000
      << old-fashioned way.                                  >><< 8494>>16870000
                                                               << 8494>>16875000
   INTEGER Err'no := 0;                                        << 8494>>16880000
   EQUATE Timeverif = 259; << Time Verification Message.     >><< 8494>>16885000
   DOUBLE Result := 0D;  << A place to keep Attachio results.>><< 8494>>16890000
   LOGICAL Result1 = Result;                                   << 8494>>16895000
   LOGICAL Result2 = Result + 1;                               << 8494>>16900000
                                                               << 8494>>16905000
   ReadMMClock (Ldate, Dtime);                                 << 8496>>16910000
   Startclock  (Ldate, Dtime);                                 << 8494>>16915000
                                                               << 8494>>16920000
   Date'Line ( Buff ); << Which includes a trailing NULL     >><< 8494>>16925000
                       << for use later in Genmsg.           >><< 8494>>16930000
   MOVE Dev := " "; Move Dev(1) := Dev, (6);                   << 8494>>16935000
   Chars := Ascii(Consoleldev, 10, Dev);                       << 8494>>16940000
   Dev(Chars) := " "; << Just to make sure. >>                 << 8494>>16945000
                                                               << 8494>>16950000
   F'In := Fopen (, %4, %4,,Dev); << Ascii, New, Rd/Write    >><< 8494>>16955000
                                                               << 8494>>16960000
   << This Fopen is coded this way after much trial and      >><< 8494>>16965000
   << error. What I wanted to do was to Fopen $STDIN which   >><< 8494>>16970000
   << is defined to be at the console for all system         >><< 8494>>16975000
   << processes. In fact, system processes do not have $STDIN>><< 8494>>16980000
   << and $STDLISTS at all. This fact is cleverly hidden by  >><< 8494>>16985000
   << a kludge in the Read and Print intrinsics, which turn  >><< 8494>>16990000
   << what appear to be request for $STDfiles into Attachio  >><< 8494>>16995000
   << and Genmsg calls. System processes do not have         >><< 8494>>17000000
   << IDD or ODD entries so Fopens will make a futile trip   >><< 8494>>17005000
   << through Allocate.                                      >><< 8494>>17010000
   << So we Fopen the console by logical device number       >><< 8494>>17015000
   << as a new ascii file for read/write access even         >><< 8494>>17020000
   << though we only want to read it. This is the only       >><< 8494>>17025000
   << way to get the console opened without Allocate         >><< 8494>>17030000
   << generating an operator request.                        >><< 8494>>17035000
                                                               << 8494>>17040000
   IF = THEN                                                   << 8494>>17045000
   BEGIN                                                       << 8494>>17050000
                                                               << 8494>>17055000
      << Ask operator to verify that the hardware has the    >><< 8494>>17060000
      << right time.                                         >><< 8494>>17065000
                                                               << 8494>>17070000
      Genmsg ( Sysset, Timeverif,0,@Buff,,,,,,,,,%100000 );    << 8494>>17075000
                        << The %100000 is to suppress CR/LF. >><< 8494>>17080000
      IF = THEN                                                << 8494>>17085000
      BEGIN                                                    << 8494>>17090000
                                                               << 8494>>17095000
         << Tell the filesystem that the next read will be   >><< 8494>>17100000
         << timed.                                           >><< 8494>>17105000
                                                               << 8494>>17110000
         Fcontrol (F'in, 4, Timer);                            << 8494>>17115000
         IF = THEN                                             << 8494>>17120000
                                                               << 8494>>17125000
         BEGIN                                                 << 8494>>17130000
            Length := Fread(F'in, Buff', -28);                 << 8494>>17135000
            IF < THEN                                          << 8494>>17140000
            BEGIN                                              << 8494>>17145000
                                                               << 8494>>17150000
               Fcheck( F'in, Err'no);                          << 8494>>17155000
               IF = THEN Good'Date := Err'no = 22;             << 8494>>17160000
                     << Fserr 22 is terminal read timed out. >><< 8494>>17165000
               Dev := 0; << Put a NULL in the buffer.        >><< 8494>>17170000
                                                               << 8494>>17175000
               << The Genmsg is to put the cursor back to    >><< 8494>>17180000
               << the beginning of the line. It won't be     >><< 8494>>17185000
               << there if the read timed out.               >><< 8494>>17190000
                                                               << 8494>>17195000
               Genmsg(-1, @Dev); << Print just a CR/LF.      >><< 8494>>17200000
            END                                                << 8494>>17205000
            ELSE                                               << 8494>>17210000
            IF = THEN                                          << 8494>>17215000
                                                               << 8494>>17220000
               << If we get a carriage return or anything    >><< 8494>>17225000
               << that resembles "Yes" or "yes" we assume    >><< 8494>>17230000
               << that the operator likes the date. All      >><< 8494>>17235000
               << other responses throw us into the old      >><< 8494>>17240000
               << dialogue.                                  >><< 8494>>17245000
                                                               << 8494>>17250000
               Good'Date :=  Length = 0 LOR Buff = "Y" LOR     << 8494>>17255000
                            Buff = "y";                        << 8494>>17260000
         END;                                                  << 8494>>17265000
      END;                                                     << 8494>>17270000
                                                               << 8494>>17275000
      Fclose (F'in, 0, 0);                                     << 8494>>17280000
      Result := Attachio(Consoleldev,0,0,0,2,0,0,0,1);         << 8494>>17285000
                                                               << 8494>>17290000
   << The previous Attachio call is a kludge. Before         >><< 8494>>17295000
   << we Fopened the console we could do Attachio's to       >><< 8494>>17300000
   << it just fine. Someone else had allocated it earlier.   >><< 8494>>17305000
   << After the Fclose, Attachio reads to it return status   >><< 8494>>17310000
   << %53 because Fclose deallocated it and did a device     >><< 8494>>17315000
   << close which put it completely out to lunch.            >><< 8494>>17320000
   << Later in Initdatetime there is a bunch of Read calls   >><< 8494>>17325000
   << which have no condition code checking which will put   >><< 8494>>17330000
   << Progen into a loop unless the Attachio is done.        >><< 8494>>17335000
   << Even later the Initio call fixes the console up again. >><< 8494>>17340000
   << All this Attachio is supposed to do is to fix          >><< 8494>>17345000
   << up the console enough to get through Date and Time.    >><< 8494>>17350000
   << Note that terminal reads will not work between the     >><< 8494>>17355000
   << Fclose and the following Attachio. That code should    >><< 8494>>17360000
   << not be split apart.                                    >><< 8494>>17365000
                                                               << 8494>>17370000
   END;                                                        << 8494>>17375000
                                                               << 8494>>17380000
   IF Good'Date THEN                                           << 8494>>17385000
      RETURN                                                   << 8494>>17390000
   ELSE                                                        << 8494>>17395000
                                                               << 8494>>17400000
      << Some disaster happened so we do it the old way.     >><< 8494>>17405000
                                                               << 8494>>17410000
      Initdatetime;                                            << 8494>>17415000
                                                               << 8494>>17420000
END; << InitMMDateTime >>                                      << 8494>>17425000
$PAGE "GET INITIAL SYSTEM DATE & TIME PROCEDURE"      <<00594>><< 8494>>17430000
$control segment=called'once                                            17435000
PROCEDURE INITDATETIME;                               <<00.EB>><< 8494>>17440000
BEGIN                                                 <<00.EB>><< 8494>>17445000
                                                      <<00.EB>><< 8494>>17450000
EQUATE                                                <<00.EB>><< 8494>>17455000
   DATEQUES = 255,                                             <<00.EB>>17460000
   TIMEQUES = 256,                                             <<00.EB>>17465000
   INVDDATE = 257,                                             <<00.EB>>17470000
   INVDTIME = 258,                                             <<08.EB>>17475000
   TIMEVERIF= 259;                                             <<08.EB>>17480000
                                                               <<00.EB>>17485000
LOGICAL                                                        <<00.EB>>17490000
   LDATE,                                                      <<00.EB>>17495000
   DEFAULT'TIME,                                               <<01312>>17500000
   DEFAULT'DATE;                                               <<01312>>17505000
INTEGER                                                        <<00.EB>>17510000
   ERRNO;                                                      <<00.EB>>17515000
DOUBLE DTIME;                                                  <<00.EB>>17520000
BYTE POINTER                                                   <<08.EB>>17525000
   PTR;                                                        <<08.EB>>17530000
ARRAY BUFF'(0:13); BYTE ARRAY BUFF(*) = BUFF';                 <<08.EB>>17535000
                                                               <<00.EB>>17540000
DO BEGIN                                                       <<00.EB>>17545000
   DEFAULT'DATE := DEFAULT'TIME := FALSE;                      <<01312>>17550000
   ERRNO := 0;                                                 <<00.EB>>17555000
   GENMSG(SYSSET,DATEQUES,,,,,,,,,,,%100000);                  <<00.EB>>17560000
   BUFF(READ(BUFF',-20)) := 0;<<STOPPER>>                      <<00.EB>>17565000
   IF BUFF = 0 THEN                                            <<00.EB>>17570000
   BEGIN                                                       <<00.EB>>17575000
      DEFAULT'DATE := TRUE;                                    <<01312>>17580000
      MOVE BUFF := ("11/1/72",0);                              <<00.EB>>17585000
   END;                                                        <<00.EB>>17590000
<< ..................................................... >>             17595000
<< Check for a magic nostart word.                       >>             17600000
<< This should probably be a SEARCH of a dict. someday   >>             17605000
<< ..................................................... >>             17610000
   IF BUFF = "nostart" THEN                                             17615000
      Do'startup := False;                                              17620000
                                                                        17625000
                                                                        17630000
   LDATE := CONVERTDATE(BUFF);                                 <<00.EB>>17635000
   IF <> THEN ERRNO := INVDDATE                                <<00.EB>>17640000
   ELSE                                                        <<00.EB>>17645000
   BEGIN                                                       <<00.EB>>17650000
      IF NOT DEFAULT'DATE THEN                                 <<01312>>17655000
      BEGIN                                                    <<00.EB>>17660000
         GENMSG(SYSSET,TIMEQUES,,,,,,,,,,,%100000);            <<00.EB>>17665000
         BUFF(READ(BUFF',-20)) := 0;                           <<00.EB>>17670000
         IF BUFF = 0 THEN DEFAULT'TIME := TRUE;                <<01312>>17675000
      END;                                                     <<00.EB>>17680000
      IF DEFAULT'TIME OR DEFAULT'DATE THEN                     <<01312>>17685000
         MOVE BUFF := ("0:00",0);                              <<01312>>17690000
      DTIME := CONVERTTIME(BUFF);                              <<00.EB>>17695000
      IF <> THEN ERRNO := INVDTIME;                            <<00.EB>>17700000
   END;                                                        <<00.EB>>17705000
   IF ERRNO = 0 THEN                                           <<08.EB>>17710000
   BEGIN                                                       <<08.EB>>17715000
      STARTCLOCK(LDATE,DTIME);                                 <<08.EB>>17720000
                                                               << 8496>>17725000
      IF M'Mouse THEN                                          << 8496>>17730000
         WriteMMClock ( Ldate, Dtime );                        << 8496>>17735000
                                                               << 8496>>17740000
      << Since we got here and we are on a mouse,            >><< 8496>>17745000
      << then the operator did not like the date             >><< 8496>>17750000
      << and time that came out of the mouse's               >><< 8496>>17755000
      << Time of Century Clock. So we update it with         >><< 8496>>17760000
      << the new value.                                      >><< 8496>>17765000
                                                               << 8496>>17770000
      DATE'LINE(BUFF);                                         <<08.EB>>17775000
      IF DEFAULT'DATE THEN PRINT(BUFF',-27,0)                  <<01312>>17780000
      ELSE                                                     <<08.EB>>17785000
      BEGIN                                                    <<08.EB>>17790000
         GENMSG(SYSSET,TIMEVERIF,%0,@BUFF,,,,,,,,,%100000);    <<08.EB>>17795000
         BUFF(READ(BUFF',-28)) := 0;                           <<08.EB>>17800000
         IF BUFF <> 0 THEN                                     <<08.EB>>17805000
         BEGIN                                                 <<08.EB>>17810000
            SCAN BUFF WHILE " ",1;                             <<08.EB>>17815000
            @PTR := TOS;                                       <<08.EB>>17820000
            MOVE PTR := PTR WHILE ANS;                         <<08.EB>>17825000
            IF PTR = "YES" OR PTR = "Y" AND PTR(1) = 0 THEN    <<08.EB>>17830000
            ELSE ERRNO := TIMEVERIF;<<OPERATOR SAYS BAD DATE>> <<08.EB>>17835000
         END;                                                  <<08.EB>>17840000
      END;                                                     <<08.EB>>17845000
   END                                                         <<08.EB>>17850000
   ELSE GENMSG(SYSSET,ERRNO);                                  <<08.EB>>17855000
END UNTIL ERRNO = 0;                                           <<00.EB>>17860000
                                                               <<00.EB>>17865000
$control segment=called'once                                            17870000
END; << INITDATETIME >>                                        <<00.EB>>17875000
PROCEDURE SETTUNINGPARAMETERS;                                 <<MPEIV>>17880000
BEGIN                                                          <<MPEIV>>17885000
$INCLUDE INCLICS                                               <<MPEIV>>17890000
EQUATE ICSIX=7;                                                <<MPEIV>>17895000
INTEGER POINTER ICS=ICSIX;                                     <<MPEIV>>17900000
EQUATE SYSGLOBEXTIX=%377;                                      <<MPEIV>>17905000
INTEGER POINTER SYSGLOBEXT=SYSGLOBEXTIX;                       <<MPEIV>>17910000
DEFINE GARBCOLLENABLED=SYSGLOBEXT(3)#,                         <<MPEIV>>17915000
       MOVETHRESHOLD=SYSGLOBEXT(4)#;                           <<MPEIV>>17920000
INTEGER STATICMPLFENCE=DB+%27;                                 <<01912>>17925000
EQUATE NBANKS=%1047;                                           <<01912>>17930000
DOUBLE SAVEDB;                                                 <<MPEIV>>17935000
EQUATE FIRSTMEMIX=%20,                                         <<MPEIV>>17940000
       TIMELASTCYCIX=%22,                                      <<MPEIV>>17945000
       SCANPOINTIX=%265,                                       <<MPEIV>>17950000
       LASTCYCDURIX=%351,                                      <<MPEIV>>17955000
       CYCLETHRESHIX=%353,                                     <<MPEIV>>17960000
       BUGCATCHIX=%355;                                        <<MPEIV>>17965000
DOUBLE SCANPOINT=DB+SCANPOINTIX,                               <<MPEIV>>17970000
       FIRSTMEMADDR=DB+FIRSTMEMIX,                             <<MPEIV>>17975000
       TIMEOFLASTCYCLE=DB+TIMELASTCYCIX,                       <<MPEIV>>17980000
       CYCLETHRESHOLD=db+CYCLETHRESHIX,                        <<MPEIV>>17985000
       LASTCYCLEDURATION=DB+LASTCYCDURIX;                      <<MPEIV>>17990000
LOGICAL BUGCATCH=DB+BUGCATCHIX;                                <<MPEIV>>17995000
DEFINE MEMPRESSDUR=SYSGLOBEXT(9)#,                             <<MPEIV>>18000000
       HOTIMELASTMAKEROOM=SYSGLOBEXT(7)#,                      <<MPEIV>>18005000
       LOTIMELASTMAKEROOM=SYSGLOBEXT(8)#;                      <<MPEIV>>18010000
ICS(-ICS'WORSTEPRICELL):=253;                                  <<MPEIV>>18015000
ICS(-ICS'WORSTDPRICELL):=238;                                  <<01912>>18020000
ICS(-ICS'WORSTCPRICELL):=200;                                  <<MPEIV>>18025000
ICS(-ICS'ESCHEDBASECELL):=240;                                 <<01912>>18030000
ICS(-ICS'DSCHEDBASECELL):=202;                                 <<MPEIV>>18035000
ICS(-ICS'CSCHEDBASECELL):=152;                                 <<MPEIV>>18040000
ICS(-ICS'CURDFILTERCELL):=1000;                                <<01912>>18045000
ICS(-ICS'CUREFILTERCELL):=1000;                                <<01912>>18050000
ICS(-ICS'CWTOLDFILTWTCELL):=99;                                <<01841>>18055000
ICS(-ICS'CWTDENOMCELL):=100;                                   <<01841>>18060000
ICS(-ICS'CWTLASTTRANSWTCELL):=1;                               <<01841>>18065000
ICS(-ICS'CURCFILTERCELL):=250;                                 <<MPEIV>>18070000
ICS(-ICS'MAXCFILTERCELL):=300;                                 <<MPEIV>>18075000
DISABLE;                                                       <<MPEIV>>18080000
TOS:=%1000D;ASSEMBLE(XCHD);SAVEDB:=TOS;                        <<MPEIV>>18085000
TOS:=SYSGLOBEXT(1);TOS:=SYSGLOBEXT(2);FIRSTMEMADDR:=TOS;       <<MPEIV>>18090000
TOS:=TIMER; TIMEOFLASTCYCLE:=TOS;                              <<MPEIV>>18095000
SCANPOINT:=FIRSTMEMADDR;                                       <<01912>>18100000
STATICMPLFENCE:=ABSOLUTE(NBANKS)+1;                            <<01912>>18105000
MEMPRESSDUR:=500;                                              <<MPEIV>>18110000
HOTIMELASTMAKEROOM:=LOTIMELASTMAKEROOM:=0;                     <<MPEIV>>18115000
BUGCATCH:=1;                                                   <<MPEIV>>18120000
GARBCOLLENABLED:=1;                                            <<MPEIV>>18125000
MOVETHRESHOLD:=24;                                             <<MPEIV>>18130000
CYCLETHRESHOLD:=1000D;LASTCYCLEDURATION:=1000D;                <<MPEIV>>18135000
TOS:=SAVEDB;ASSEMBLE(XCHD);                                    <<MPEIV>>18140000
END <<SETTUNINGPARAMETERS>>;                                   <<MPEIV>>18145000
$control segment=called'once                                            18150000
$PAGE "WRITE INITIAL LOG RECORD PROCEDURE"                     <<00594>>18155000
PROCEDURE LOGHEAD;                                                      18160000
   COMMENT: OUTPUTS LOG RECORD NUMBER 1 IF LOGGING REQUIRED;            18165000
   BEGIN                                                                18170000
                                                                        18175000
   EQUATE C0 = 6*DSTSIZE;  <<CORE DST DESCRIPTOR>>                      18180000
                                                                        18185000
   INTEGER POINTER CST = %1;                                            18190000
   INTEGER POINTER DST = %2;                                            18195000
   INTEGER POINTER PCB = %3;                                            18200000
   INTEGER POINTER IOQ = %5;                                            18205000
   INTEGER POINTER TRL = %12;                                           18210000
                                                                        18215000
   TOS := ABSOLUTE(UPDATEL);  <<UPDATE LEVEL>>                          18220000
   TOS := ABSOLUTE(FIXL);  <<FIX LEVEL>>                                18225000
   TOS := DST(C0).(3:13);  <<CORE SIZE IN K>>                           18230000
   TOS := CST(2);  <<NR. CST ENTRIES AVAIL.>>                           18235000
   TOS := DST(2);  <<NR. DST ENTRIES AVAIL.>>                           18240000
   TOS := PCB(2);  <<NR. PCB ENTRIES AVAIL.>>                           18245000
   TOS := IOQ(0).(0:8);  <<NR. IOQ ENTRIES AVAIL.>>                     18250000
   TOS := TRL(1).(0:8);  <<NR. TRL ENTRIES AVAIL.>>                     18255000
   TOS := ABSOLUTE(ZI)-ABSOLUTE(QI);  <<ICS SIZE>>                      18260000
   TOS := 0;  <<RESERVED>>                                  <<C0.00>>   18265000
   EXCHANGEDB(JPCNTDST);                                       <<06222>>18270000
   TOS:=JPCNTMAXENTRIES;     << Max number of running jobs >>  <<06222>>18275000
   EXCHANGEDB(0);                                              <<06222>>18280000
   TOS := 1;  <<LOG RECORD TYPE>>                                       18285000
                                                                        18290000
   LOG;  <<EMIT LOG RECORD>>                                            18295000
                                                                        18300000
   END;  <<LOGHEAD>>                                                    18305000
$control segment=called'once                                            18310000
PROCEDURE INITLOG;                                             <<03100>>18315000
BEGIN                                                          <<03100>>18320000
                                                               <<03100>>18325000
<<*********************************************************>>  <<03100>>18330000
<<                                                         >>  <<03100>>18335000
<< This procedure initializes the logging process.         >>  <<03100>>18340000
<< Logging is always enabled, and particular events are    >>  <<03100>>18345000
<< always logged.  This procedure is the only procedure in >>  <<03100>>18350000
<< the system that knows which events are always logged.   >>  <<03100>>18355000
<< This information is stored in the variables of the form,>>  <<03100>>18360000
<< LOG'REQUIRED'n (where "n" in a word number).  This      >>  <<03100>>18365000
<< procedure will disable logging for all events if the    >>  <<03100>>18370000
<< logging enabled bit is off, will ensure that logging is >>  <<03100>>18375000
<< always enabled, and will ensure that the required log   >>  <<03100>>18380000
<< events are logged.  When this is all done, the Log      >>  <<03100>>18385000
<< Process is then initialized.                            >>  <<03100>>18390000
<<                                                         >>  <<03100>>18395000
<< This algorithm assumes that INITIAL always creates the  >>  <<03100>>18400000
<< logging process.  It checks, however, that the log      >>  <<03100>>18405000
<< process was, in fact, created.  If the log process is   >>  <<03100>>18410000
<< missing, it generates a warning message on the console. >>  <<03100>>18415000
<<                                                         >>  <<03100>>18420000
<<*********************************************************>>  <<03100>>18425000
                                                               <<03100>>18430000
LOGICAL                                                        <<03100>>18435000
   LOG'REQUIRED'0 := 0, << Holds information on which log  >>  <<03100>>18440000
   LOG'REQUIRED'1 := 0, <<    events are always enabled.   >>  <<03100>>18445000
   LOG'REQUIRED'2 := 0;                                        <<03100>>18450000
                                                               <<03100>>18455000
DEFINE                                                         <<03100>>18460000
                                                               <<03100>>18465000
<< The following DEFINE determines whether the log process >>  <<03100>>18470000
<<     was actually created by INITIAL.                    >>  <<03100>>18475000
   LOG'PROC'NOT'THERE = ( SYSPROC(LOGPCBN) = 0 ) #,            <<03100>>18480000
                                                               <<03100>>18485000
<< The Log-Enabled bit is in Word Zero of the LOGINFO mask >>  <<03100>>18490000
<<     in the SYSGLOB area.                                >>  <<03100>>18495000
   LOG'ENABLED'BITS = (15:1) #,                                <<03100>>18500000
   LOG'ENABLED = L'INFO'0.LOG'ENABLED'BITS #,                  <<03100>>18505000
                                                               <<03100>>18510000
<< The following are the bit positions of the required     >>  <<03100>>18515000
<<    logging events.                                      >>  <<03100>>18520000
   LOG'HEAD'BITS = (14:1) #,    << Log Head logging bits.  >>  <<03100>>18525000
   IOERR'BITS = (4:1) #,        << Type 11: IO error.      >>  <<03100>>18530000
   MAINT'BITS = (1:1) #,        << Type 46: MAINT event.   >>  <<03100>>18535000
   DCU'BITS = (0:1) #,          << Type 47: DCU events.    >>  <<03100>>18540000
                                                               <<03100>>18545000
   L'INFO'0   = A'(ABSYS + LOGINFO)     #,                     <<03100>>18550000
   L'INFO'1   = A'(ABSYS + LOGINFO + 1 )#,                     <<03100>>18555000
   L'INFO'2   = A'(ABSYS + LOGINFO + 2 )#;                     <<03100>>18560000
                                                               <<03100>>18565000
<< Start of Code.                                          >>  <<03100>>18570000
                                                               <<03100>>18575000
                                                               <<03100>>18580000
<< If INITIAL did not create the Log Process, issue a      >>  <<03100>>18585000
<< warning to the console and return to do other things.   >>  <<03100>>18590000
   IF LOG'PROC'NOT'THERE THEN                                  <<03100>>18595000
   BEGIN                                                       <<03100>>18600000
      GENMSG( SYSSET, NO'LOG'PROC );                           <<03100>>18605000
      LOG'ENABLED := 0;       << Disable logging.          >>  <<03100>>18610000
      RETURN;                                                  <<03100>>18615000
   END;                                                        <<03100>>18620000
                                                               <<03100>>18625000
                                                               <<03100>>18630000
<< If logging comes in disabled, zero out all logging      >>  <<03100>>18635000
<<    events and enable logging.                           >>  <<03100>>18640000
   IF NOT LOG'ENABLED THEN                                     <<03100>>18645000
   BEGIN                                                       <<03100>>18650000
      L'INFO'0 := 0;                                           <<03100>>18655000
      LOG'ENABLED := 1;       << Enable logging.           >>  <<03100>>18660000
      L'INFO'1 := 0;                                           <<03100>>18665000
      L'INFO'2 := 0;                                           <<03100>>18670000
   END;                                                        <<03100>>18675000
                                                               <<03100>>18680000
<< Set up the masks of the required events.                >>  <<03100>>18685000
<< ***NOTE***:  This is the only area that "knows" which   >>  <<03100>>18690000
<<              events are required to be active.          >>  <<03100>>18695000
   LOG'REQUIRED'0.LOG'HEAD'BITS := 1;   << Type 1.         >>  <<03100>>18700000
   LOG'REQUIRED'0.IOERR'BITS := 1;      << Type 11.        >>  <<03100>>18705000
   LOG'REQUIRED'2.MAINT'BITS := 1;      << Type 46.        >>  <<03100>>18710000
   LOG'REQUIRED'2.DCU'BITS := 1;        << Type 47.        >>  <<03100>>18715000
                                                               <<03100>>18720000
<< Ensure all required logging events are enabled.         >>  <<03100>>18725000
   L'INFO'0 := L'INFO'0 LOR LOG'REQUIRED'0;                    <<03100>>18730000
   L'INFO'1 := L'INFO'1 LOR LOG'REQUIRED'1;                    <<03100>>18735000
   L'INFO'2 := L'INFO'2 LOR LOG'REQUIRED'2;                    <<03100>>18740000
                                                               <<03100>>18745000
<< Initialize the Logging Process.                         >>  <<03100>>18750000
   AWAKE( SYSPROC(LOGPCBN), 1, 2 );                            <<03100>>18755000
   LOGHEAD;                                                    <<03100>>18760000
                                                               <<03100>>18765000
END;  << INITLOG >>                                            <<03100>>18770000
                                                               <<03100>>18775000
$PAGE "GETSYSUDCFLAG"                                          <<00416>>18780000
$control segment=called'once                                            18785000
INTEGER PROCEDURE GETSYSUDCFLAG(NTRY,LEVEL,INX,SIRS);          <<00416>>18790000
VALUE LEVEL,INX,SIRS;                                          <<00416>>18795000
INTEGER LEVEL,INX;                                             <<00416>>18800000
DOUBLE SIRS;                                                   <<00416>>18805000
ARRAY NTRY;                                                    <<00416>>18810000
OPTION UNCALLABLE;                                             <<00416>>18815000
BEGIN                                                          <<00416>>18820000
   DEFINE UDCFLAG=27).(0:1#;   <<SYS ACCT BIT 4 SYSTEM UDC'S>> <<00885>>18825000
   EQUATE SYSUDCFLAG=%1376;                                    <<00416>>18830000
                                                               <<00416>>18835000
   ABSOLUTE(SYSUDCFLAG):=NTRY(UDCFLAG);                        <<00416>>18840000
   GETSYSUDCFLAG:=5;  <<STOP SCAN, SIRS NOT RELEASED>>         <<00416>>18845000
END;                                                           <<00416>>18850000
$PAGE "PROCEDURE TO HANDLE OLD = COMMANDS"                     <<00594>>18855000
$control segment=loop                                                   18860000
LOGICAL PROCEDURE USECI;                                       <<00594>>18865000
OPTION PRIVILEGED,INTERNAL;                                    <<00594>>18870000
BEGIN                                                          <<00594>>18875000
Entry Nosuchcommand,Usenewspool,Usealtdel,Usenewcomm;          <<01176>>18880000
   INTEGER I;                                                  <<00594>>18885000
   BYTE ARRAY MSG(0:71);                                       <<00594>>18890000
                                                               <<00594>>18895000
<< USECI ENTRY POINT>>                                         <<00594>>18900000
   I:=0;                                                       <<00594>>18905000
   GO TO COMMON;                                               <<00594>>18910000
                                                               <<00594>>18915000
<< NOSUCHCOMMAND ENTRY POINT>>                                 <<00594>>18920000
                                                               <<00594>>18925000
NOSUCHCOMMAND:                                                 <<00594>>18930000
   I:=1;                                                       <<00594>>18935000
   GO TO COMMON;                                               <<00594>>18940000
                                                               <<00594>>18945000
<< USENEWSPOOL ENTRY POINT>>                                   <<00594>>18950000
                                                               <<00594>>18955000
USENEWSPOOL:                                                   <<00594>>18960000
   I:=2;                                                       <<00594>>18965000
   GO TO COMMON;                                               <<00594>>18970000
                                                               <<00594>>18975000
<< USEALTDEL ENTRY POINT >>                                    <<00594>>18980000
                                                               <<00594>>18985000
USEALTDEL:                                                     <<00594>>18990000
   I:=3;                                                       <<00594>>18995000
   Go to COMMON;                                               <<01176>>19000000
                                                               <<01176>>19005000
<< Usenewcomm entry point >>                                   <<01176>>19010000
Usenewcomm:                                                    <<01176>>19015000
   I:=4;                                                       <<01176>>19020000
                                                               <<00594>>19025000
COMMON:                                                        <<00594>>19030000
   USECI:=TRUE;                                                <<00594>>19035000
   CASE I OF BEGIN                                             <<00594>>19040000
      MOVE MSG:=("USE THE COMMAND INTERPRETER COMMAND",0);     <<00594>>19045000
      MOVE MSG:=("THIS COMMAND NO LONGER EXISTS",0);           <<00594>>19050000
      MOVE MSG:=("USE STARTSPOOL, STOPSPOOL, SUSPENDSPOOL",    <<00594>>19055000
                 " RESUMESPOOL C.I. COMMANDS",0);              <<00594>>19060000
      MOVE MSG:=("USE ALTSPOOLFILE OR DELETESPOOLFILE",        <<00594>>19065000
                 " C.I. COMMAND",0);                           <<00594>>19070000
      Move Msg:=("USE :DSCONTROL, :MRJECONTROL, OR",           <<01176>>19075000
          " :MPLINE FOR COMMUNICATIONS OPERATIONS.",0);        <<01176>>19080000
   END;                                                        <<00594>>19085000
   GENMSG(-1,@MSG); <<SEND MESSAGE TO OPERATOR>>               <<00594>>19090000
END;                                                                    19095000
$control segment=called'once                                            19100000
PROCEDURE COOLSTART;                                           <<07350>>19105000
COMMENT:  COOLSTART PROCESS WILL BE ADDED TO PROGEN IN         <<07350>>19110000
          THE NEAR FUTURE;                                     <<07350>>19115000
BEGIN                                                          <<07350>>19120000
   SUDDENDEATH(374);  <<JMAT DESTROYED, CANNOT WARM START>>    <<07350>>19125000
END;  <<COOLSTART>>                                            <<07350>>19130000
$control segment=called'once                                            19135000
  PROCEDURE SCHEDULEJMATENTRIES;                               <<07350>>19140000
  <<DB MUST BE AT JMAT DST >>                                  <<07350>>19145000
    BEGIN                                                      <<07350>>19150000
    INTEGER ARRAY JMATARR(*) = DB+0;                           <<07350>>19155000
      INTEGER JMATINX;                                         << 8201>>19160000
      INTEGER POINTER JMATP;                                   << 8201>>19165000
                                                               << 8201>>19170000
    INTEGER TEMP,                                              <<07350>>19175000
            CURX, <<INDEX TO ENTRY CURRENTLY BEING ADDED>>     <<07350>>19180000
            PREX, <<INDEX TO ENTRY PRECEDING CURRENT>>         <<07350>>19185000
            FOLX; <<INDEX TO ENTRY FOLLOWING CURRENT>>         <<07350>>19190000
    EQUATE SCHEDHEADP = 3,                                     <<07350>>19195000
           ERRORSTATE = %50;                                   <<07350>>19200000
          JMATHEADPTR := 0;  <<MAKE QUEUE EMPTY>>              <<07350>>19205000
          JMATTAILPTR := SCHEDHEADP;                           <<07350>>19210000
          CURX := 0;                                           <<07350>>19215000
      << multiple JMATCURSIZE by 128 because its  >>           <<*8453>>19220000
      << specified in sectors in the JMAT table.  >>           <<*8453>>19225000
          TEMP := JMATCURSIZE&LSL(7)-JMATENTRYSIZE;            <<07350>>19230000
          WHILE(CURX:=CURX+JMATENTRYSIZE)<=TEMP DO             <<07350>>19235000
            BEGIN                                              <<07350>>19240000
              JMATINX := CURX;  << For INCLUDE reference >>    << 8201>>19245000
              IF JMATJOBSTATE = JOBSCHED THEN                  << 8201>>19250000
              BEGIN                                            << 8201>>19255000
                 EXCHANGEDB(0);                                << 8201>>19260000
                 @JMATP := JMATINX;                            << 8201>>19265000
                 RECOVERSCHED( JMATP );                        << 8201>>19270000
                 EXCHANGEDB( JMATDST );                        << 8201>>19275000
                 GOTO ENDOFLOOP;                               << 8201>>19280000
              END;                                             << 8201>>19285000
                                                               << 8201>>19290000
              IF JMATARR(CURX) <> 0 THEN                       << 8201>>19295000
              IF JMATHEADPTR = 0 THEN                          << 8201>>19300000
              BEGIN <<EMPTY QUEUE>>                            <<07350>>19305000
              JMATARR(CURX+JMATSCHEDLINKOFF) := 0;             <<07350>>19310000
              JMATHEADPTR := CURX;                             <<07350>>19315000
              JMATTAILPTR := CURX;                             <<07350>>19320000
              END                                              <<07350>>19325000
            ELSE                                               <<07350>>19330000
              BEGIN                                            <<07350>>19335000
              IF JMATARR(CURX).JMATSTATEFLD=ERRORSTATE THEN    <<07350>>19340000
  ADDTOFRONT:   BEGIN                                          <<07350>>19345000
                JMATARR(CURX+JMATSCHEDLINKOFF) := JMATHEADPTR; <<07350>>19350000
                JMATHEADPTR := CURX;                           <<07350>>19355000
                GOTO ENDOFLOOP;                                <<07350>>19360000
                END;                                           <<07350>>19365000
              FOLX := JMATHEADPTR;                             <<07350>>19370000
              IF JMATARR(FOLX).JMATSTATEFLD<>ERRORSTATE THEN   <<07350>>19375000
                                            GO FINDPRI;        <<07350>>19380000
              PREX := FOLX;                                    <<07350>>19385000
              WHILE(FOLX:=JMATARR(PREX+JMATSCHEDLINKOFF))<>0 DO<<07350>>19390000
                IF JMATARR(FOLX).JMATSTATEFLD<>ERRORSTATE THEN <<07350>>19395000
                  GO FINDPRI ELSE PREX := FOLX;                <<07350>>19400000
  ADDTOEND:   JMATARR(CURX+JMATSCHEDLINKOFF) := 0;             <<07350>>19405000
              JMATARR(PREX+JMATSCHEDLINKOFF) := CURX;          <<07350>>19410000
              JMATTAILPTR      := CURX;                        <<07350>>19415000
              GOTO ENDOFLOOP;                                  <<07350>>19420000
  FINDPRI:    WHILE JMATARR(FOLX).JMATINPRIFLD >               <<07350>>19425000
                    JMATARR(CURX).JMATINPRIFLD DO              <<07350>>19430000
                BEGIN                                          <<07350>>19435000
                PREX := FOLX;                                  <<07350>>19440000
                IF (FOLX:=JMATARR(PREX+JMATSCHEDLINKOFF))=0    <<07350>>19445000
                  THEN GO ADDTOEND;                            <<07350>>19450000
                END;                                           <<07350>>19455000
  TESTAGAIN:  IF JMATARR(FOLX).JMATINPRIFLD =                  <<07350>>19460000
                 JMATARR(CURX).JMATINPRIFLD THEN               <<07350>>19465000
                BEGIN                                          <<07350>>19470000
                IF JMATARR(FOLX+JMATCALENDAROFF) >             <<07350>>19475000
                   JMATARR(CURX+JMATCALENDAROFF)               <<07350>>19480000
                      THEN GO ADDHERE;                         <<07350>>19485000
    << compare the calendar date of CUR and FOL entries>>      <<*8453>>19490000
                IF JMATARR(FOLX+JMATCALENDAROFF) =             <<07350>>19495000
                   JMATARR(CURX+JMATCALENDAROFF)               <<07350>>19500000
                  THEN BEGIN  << compare the time stamp >>     <<*8453>>19505000
                              << for CUR and FOL entries>>     <<*8453>>19510000
                  TOS := JMATARR(FOLX+JMATTIMEOFF);            <<*8453>>19515000
                  TOS := JMATARR(FOLX+JMATTIMEOFF + 1);        <<*8453>>19520000
                  TOS := JMATARR(CURX+JMATTIMEOFF);            <<*8453>>19525000
                  TOS := JMATARR(CURX+JMATTIMEOFF + 1);        <<*8453>>19530000
                  ASSEMBLE(DCMP);                              <<07350>>19535000
                  IF >= THEN GO ADDHERE;                       <<07350>>19540000
                  END;                                         <<07350>>19545000
                PREX := FOLX;                                  <<07350>>19550000
                IF(FOLX:=JMATARR(PREX+JMATSCHEDLINKOFF))=0 THEN<<07350>>19555000
                  GO ADDTOEND ELSE GO TESTAGAIN;               <<07350>>19560000
                END                                            <<07350>>19565000
              ELSE                                             <<07350>>19570000
  ADDHERE:      BEGIN                                          <<07350>>19575000
                IF JMATHEADPTR=FOLX THEN GO ADDTOFRONT;        <<07350>>19580000
                JMATARR(CURX+JMATSCHEDLINKOFF) :=              <<07350>>19585000
                JMATARR(PREX+JMATSCHEDLINKOFF);                <<07350>>19590000
                JMATARR(PREX+JMATSCHEDLINKOFF) := CURX;        <<07350>>19595000
                END;                                           <<07350>>19600000
              END;                                             <<07350>>19605000
  ENDOFLOOP:END;                                               <<07350>>19610000
      END  <<SCHEDULEJMATENTRIES>>;                            <<07350>>19615000
PROCEDURE RECOVER'JMAT;                                        <<07350>>19620000
$control segment=called'once                                            19625000
  <<-------------------------->>                               <<07350>>19630000
  <<       RECOVER JMAT       >>                               <<07350>>19635000
  <<-------------------------->>                               <<07350>>19640000
                                                               <<07350>>19645000
 BEGIN                                                         <<07350>>19650000
  INTEGER TEMP,JMATSTATE,JOBNUMB,I,J,ORIGINALZ;                <<07350>>19655000
  EQUATE WAITING    = %40,                                     <<07350>>19660000
         ERRORSTATE = %50,                                     <<07350>>19665000
         INITIALIZING = %60,                                   <<07350>>19670000
         SUSPENDED  = 4,                                       <<07350>>19675000
         EXECUTING  = 2;                                       <<07350>>19680000
  EQUATE VMOUNTINFO = %1365;                                   <<07350>>19685000
  INTEGER ARRAY XDD(*) = DB+0;                                 <<07350>>19690000
  INTEGER POINTER XDD'SUBENTRY;                                <<07350>>19695000
  INTEGER ARRAY JMATARR(*) = DB+0;                             <<07350>>19700000
  INTEGER JMATINX,IDDNUMENTRIES,IDDSEGSIZE;                    <<07350>>19705000
  <<THIS MUST BE THE LAST DECLARATION IN THE PROCEDURE>>       <<07350>>19710000
  INTEGER ARRAY IDDJOBNUM(*)=Q;                                <<07350>>19715000
                                                               <<07350>>19720000
  PUSH(Z); << SAVE Z TO RETURN TO ORIGINAL AT THE END OF PROC>><<07350>>19725000
  ORIGINALZ := TOS;                                            <<07350>>19730000
  EXCHANGEDB(IDD'DST);                                         <<07350>>19735000
  IDDSEGSIZE := XDD0'CURRENT'SECTORS&LSL(7);                   <<07350>>19740000
  TOS := (IDDSEGSIZE-XDD0'SUBENTRY'AREA)/SIZE'OF'XDD'SUBENTRY; <<07350>>19745000
  <<GET SPACE FOR IDD JOB NUMBER ARRAY>>                       <<07350>>19750000
  ASSEMBLE(ADDS 0);                                            <<07350>>19755000
  <<SET IDD JOB NUMBER ARRAY>>                                 <<07350>>19760000
  @XDD'SUBENTRY:=XDD0'SUBENTRY'AREA;                           <<07350>>19765000
  IDDNUMENTRIES := 0;                                          <<07350>>19770000
  WHILE @XDD'SUBENTRY<IDDSEGSIZE DO                            <<07350>>19775000
   BEGIN                                                       <<07350>>19780000
   IF XDD'SUBENTRY<>0 THEN                                     <<07350>>19785000
     BEGIN                                                     <<07350>>19790000
      IDDJOBNUM(IDDNUMENTRIES):=XDDS'JOB'NUMBER;               <<07350>>19795000
      IDDJOBNUM(IDDNUMENTRIES).(0:2) := XDDS'JOB'TYPE;         <<07350>>19800000
      IDDNUMENTRIES := IDDNUMENTRIES+1;                        <<07350>>19805000
     END;                                                      <<07350>>19810000
      @XDD'SUBENTRY:=@XDD'SUBENTRY+SIZE'OF'XDD'SUBENTRY;       <<07350>>19815000
   END;                                                        <<07350>>19820000
                                                               <<07350>>19825000
  EXCHANGEDB(JMATDST);                                         <<07350>>19830000
  IF JMATENTSIZE <> JMATENTRYSIZE THEN                         <<07350>>19835000
    BEGIN                                                      <<07350>>19840000
     GENMSG(SYSSET,480);  <<JMAT DESTROYED BEFORE WARMSTART>>  <<07350>>19845000
     COOLSTART;                                                <<07350>>19850000
    END;                                                       <<07350>>19855000
  ABSOLUTE(VMOUNTINFO).(8:8) := JMATVMOUNT;                    <<07350>>19860000
  << PERMIT RECOVERY OF USER LOGGING FROM PV'S >>              <<07350>>19865000
  TEMP := (JMATCURSIZE&LSL(7))-JMATENTRYSIZE;                  <<07350>>19870000
  JMATINX := 0;                                                <<07350>>19875000
  WHILE(JMATINX:=JMATINX+JMATENTRYSIZE)<=TEMP DO               <<07350>>19880000
    BEGIN                                                      <<07350>>19885000
    JMATSTATE:=JMATJOBSTATE;                                   <<07350>>19890000
    IF JMATARR(JMATINX)<>0 AND        <<ENTRY NOT FREE>>       <<07350>>19895000
       JMATSTATE<>ERRORSTATE THEN     <<NOT IN ERROR  >>       <<07350>>19900000
      IF LOGICAL(JMATSBIT) THEN       <<SPOOLED       >>       <<07350>>19905000
        IF JMATSTATE=WAITING          <<WAITING OR    >>       <<07350>>19910000
            OR JMATSTATE = JOBSCHED                            << 8201>>19915000
           OR LOGICAL(JMATRESTART)    <<RESTART AND   >>       <<07350>>19920000
           AND (JMATSTATE=INITIALIZING <<INITIALIZING OR >>    <<07350>>19925000
                OR JMATSTATE=EXECUTING <<EXECUTING OR >>       <<07350>>19930000
                OR JMATSTATE=SUSPENDED)<<SUSPENDED    >>       <<07350>>19935000
                THEN                                           <<07350>>19940000
          BEGIN <<SAVE ENTRY>>                                 <<07350>>19945000
          JOBNUMB := JMATJSNO;   <<JOB/SESSION NUMBER>>        <<07350>>19950000
          JOBNUMB.(0:2) := JMATJSTYPE;                         <<07350>>19955000
          I := -1;                                             <<07350>>19960000
          WHILE (I := I+1) < IDDNUMENTRIES DO                  <<07350>>19965000
            <<CHECK IF CORRESPONDING IDD ENTRY>>               <<07350>>19970000
            IF JOBNUMB=IDDJOBNUM(I) THEN GO SETWAIT;           <<07350>>19975000
          GO DELJOB;<<NO CORRESPONDING IDD ENTRY>>             <<07350>>19980000
SETWAIT:  IF (JMATSTATE<>WAITING) LAND                         << 8201>>19985000
             (JMATSTATE<>JOBSCHED)       THEN                  << 8201>>19990000
            BEGIN <<SET TO WAITING>>                           <<07350>>19995000
            JMATJOBSTATE := WAITING;                           <<07350>>20000000
            JMATGROUPPASS := 0;                                <<07350>>20005000
            JMATACCTPASS  := 0;                                <<07350>>20010000
            JMATUSERPASS  := 0;                                <<07350>>20015000
            JMATMAINPIN := 0;                                  <<07350>>20020000
            JMATJINDEV := JMATORIGJIN;                         <<07350>>20025000
            JMATJLISTDEV := JMATORIGJLIST;                     <<07350>>20030000
            END;                                               <<07350>>20035000
          END                                                  <<07350>>20040000
        ELSE JMATARR(JMATINX) := 0    <<DELETE>>               <<07350>>20045000
      ELSE                                                     <<07350>>20050000
DELJOB: JMATARR(JMATINX) := 0; <<NOT SPOOLED,DELETE>>          <<07350>>20055000
    END;                                                       <<07350>>20060000
  SCHEDULEJMATENTRIES;                                         <<07350>>20065000
  JMATJOBFENCE := 14;                                          <<07350>>20070000
  JMATLGBITS := 0;  << RESET LOGOFF BIT >>                     <<07350>>20075000
  JMATSNUM := 0;    <<CURRENT NUMBER OF SESSIONS>>             <<07350>>20080000
  JMATJNUM := 0;    <<CURRENT NUMBER OF BATCH JOBS>>           <<07350>>20085000
  IF JMATENTSIZE <> JMATENTRYSIZE THEN                         <<07350>>20090000
   BEGIN                                                       <<07350>>20095000
   GENMSG(SYSSET,481);<<JMAT DESTROYED DURING RECOVERY>>       <<07350>>20100000
   COOLSTART;                                                  <<07350>>20105000
   END;                                                        <<07350>>20110000
EXCHANGEDB(0);                                                 <<07350>>20115000
ZSIZE(ORIGINALZ);  <<RETURN Z TO ORIGINAL>>                    <<07350>>20120000
END;  <<END RECOVER'JMAT>>                                     <<07350>>20125000
                                                               <<07350>>20130000
$control segment=called'once                                            20135000
PROCEDURE CHECK'WARMSTART;                                     <<07350>>20140000
  BEGIN                                                        <<07350>>20145000
                                                               <<07350>>20150000
  << Returns the START'UP'OPTION and FOS'FLAG.  Drives the >>  << 8959>>20155000
  << recovery of JMAT and XDD if boot was a warmstart      >>  << 8959>>20160000
  << INITIAL SETS UP THE COMMUNICATION DATA SEGMENT >>         <<07350>>20165000
  << THE DST # IS AT SYSGLOB EXTENSION %122         >>         <<07350>>20170000
  << FORMAT OF THIS COMMUNICATION DATA SEGMENT IS:  >>         <<07350>>20175000
  <<     WORD 0 - CTAB0 POINTER                    >>          <<07350>>20180000
  <<     WORD 1 - CTAB  POINTER                    >>          <<07350>>20185000
  <<     WORD 2 - START UP OPTION                  >>          <<07350>>20190000
  <<     WORD 3 - RECOVER LOST DISC SPACE FLAG     >>          <<07350>>20195000
  <<     WORD 4 - FOS FLAG:  IF HP FOS THEN 1      >>          << 8959>>20200000
  <<                                   ELSE 0      >>          << 8959>>20205000
  <<     WORD 256 - CTAB0                          >>          <<07350>>20210000
  <<     WORD 256+CTAB0SIZE - CTAB                 >>          <<07350>>20215000
                                                               <<07350>>20220000
  COMMDSTN := SYSGLOBEXT(COMMDSTNLOC);                         <<07350>>20225000
  MFDS(START'UP'OPTION,COMMDSTN,2,1);                          <<07350>>20230000
  MFDS( FOS'FLAG, COMMDSTN, 4, 1 );                            << 8959>>20235000
  IF START'UP'OPTION <> 0 THEN RETURN; <<RETURN IF NOT WARMSTAR<<07350>>20240000
  RECOVER'JMAT;                                                <<07350>>20245000
  RECOVER'XDD;                                                 <<t7690>>20250000
  END;  <<CHECK'WARMSTART>>                                    <<07350>>20255000
                                                               <<07350>>20260000
$control segment=called'once                                            20265000
PROCEDURE INIT'JOB'TABLES;                                     <<06289>>20270000
BEGIN                                                          <<06289>>20275000
   EQUATE                                                      <<06289>>20280000
      PROGPCBN    = 1,                                         <<06289>>20285000
      MAXSJDTSIZE = 512,                                       <<06289>>20290000
      SJITDSTN    =%45,                                        <<06289>>20295000
      SJDTDSTN    =%63;                                        <<06289>>20300000
   DOUBLE                                                      <<06289>>20305000
      DSTATUS;                                                 <<06289>>20310000
   INTEGER ARRAY                                               <<06289>>20315000
      SYSACCT(0:3),                                            <<06289>>20320000
      MANUSER(0:3),                                            <<06289>>20325000
      PUBGRP(0:3),                                             <<06289>>20330000
      NULLNAME(0:3);                                           <<06289>>20335000
   INTEGER ARRAY                                               <<06289>>20340000
      JITARR(0:JIT'ENTRY'SIZE-1),                              <<06289>>20345000
      JDTARR(0:JDTHEADERSIZE-1),                               <<06289>>20350000
      DIR'ENTRY(0:59);                                         <<06289>>20355000
                                                               <<06289>>20360000
   <<    INITIALIZE LOCAL VARIABLES   >>                       <<06289>>20365000
   MOVE SYSACCT  := "SYS     ";                                <<06289>>20370000
   MOVE MANUSER  := "MANAGER ";                                <<06289>>20375000
   MOVE PUBGRP   := "PUB     ";                                <<06289>>20380000
   MOVE NULLNAME := "        ";                                <<06289>>20385000
                                                               <<06289>>20390000
   <<---------------->>                                        <<06289>>20395000
   <<   SYSTEM JIT   >>                                        <<06289>>20400000
   <<---------------->>                                        <<06289>>20405000
                                                               <<06289>>20410000
   ZEROBUF( JITARR, JIT'ENTRY'SIZE);                           <<06289>>20415000
   JITDST         := SJITDSTN;                                 <<06289>>20420000
   JITVALUE6      := 6;                                        <<06289>>20425000
   JITJOBINFOPTR  := 8;                                        <<06289>>20430000
   JITACCTINFOPTR := 48;    << PTR TO ACCOUNTING DIR'ENTRY >>  <<06289>>20435000
   JITRESERVEPTR  := 59;    << PTR TO RESERVED AREA >>         <<06289>>20440000
   JITVALUE7      := 7;                                        <<06289>>20445000
   JITMAINPIN     := PROGPCBN;                                 <<06289>>20450000
   DSTATUS := DIRECFIND(%20,0D,SYSACCT,NULLNAME,NULLNAME,      <<06289>>20455000
      DIR'ENTRY);                                              <<06289>>20460000
   IF <> THEN SUDDENDEATH(406);                                <<06289>>20465000
   JITACCTSEC := DIR'ENTRY(26);  << ACCOUNT SECURITY >>        <<06289>>20470000
   JITAIPPTR  := 53;        << PTR TO ACCT-GRP INDEX PTR >>    <<06289>>20475000
   JITAIP2    := DIR'ENTRY(4);                                 <<06289>>20480000
   DSTATUS := DIRECFIND(%10,0D,SYSACCT,PUBGRP,NULLNAME,        <<06289>>20485000
      DIR'ENTRY);                                              <<06289>>20490000
   IF <> THEN SUDDENDEATH(406);                                <<06289>>20495000
   MOVE JITGROUPSEC := DIR'ENTRY(21),(2);                      <<06289>>20500000
   JITGIPPTR := 55;         << PTR TO GROUP FILE INDEX >>      <<06289>>20505000
   JITGIP2   := DIR'ENTRY(4);                                  <<06289>>20510000
   DSTATUS := DIRECFIND(%30,0D,SYSACCT,MANUSER,NULLNAME,       <<06289>>20515000
      DIR'ENTRY);                                              <<06289>>20520000
   IF <> THEN SUDDENDEATH(406);                                <<06289>>20525000
   MOVE JITUSERCAPS  := DIR'ENTRY(4),(2); << USER CAPABILITY >><<06289>>20530000
   MOVE JITHACCTNAME  := SYSACCT,(4);                          <<06289>>20535000
   MOVE JITHOMEGROUP  := PUBGRP,(4);                           <<06289>>20540000
   MOVE JITLOGONGROUP := PUBGRP,(4);                           <<06289>>20545000
   MOVE JITUSERNAME   := MANUSER,(4);                          <<06289>>20550000
   MTDS( SJITDSTN, 0, JITARR, JIT'ENTRY'SIZE);                 <<06289>>20555000
                                                               <<06289>>20560000
   <<---------------->>                                        <<06289>>20565000
   <<   SYSTEM JDT   >>                                        <<06289>>20570000
   <<---------------->>                                        <<06289>>20575000
                                                               <<06289>>20580000
   ZEROBUF( JDTARR, JDTHEADERSIZE);                            <<06289>>20585000
   JDTMAXSEGSIZE := MAXSJDTSIZE;                               <<06289>>20590000
   JDTJTDSDPTR    := 30;                                       << 8262>>20595000
   JDTJTFDPTR    := 30;                                        <<06289>>20600000
   JDTJTFEQPTR   := 30;                                        <<06289>>20605000
   JDTJTLEQPTR    := 30;                                       << 8262>>20610000
   JDTJJCWPTR    := 30;                                        <<06289>>20615000
   JDTFREESPCPTR := 30;                                        <<06289>>20620000
   JDTMAINPIN    := PROGPCBN; << PIN OF PROGEN >>              <<06289>>20625000
   MTDS( SJDTDSTN, 0, JDTARR, JDTHEADERSIZE);                  <<06289>>20630000
                                                               <<06289>>20635000
END;  << INIT'JOB'TABLES >>                                    <<06289>>20640000
                                                               <<06289>>20645000
$PAGE "***   OUTER BLOCK   ***"                                         20650000
$control segment=loop                                                   20655000
                                                                        20660000
IF ABSOLUTE ( %1424 ) <> 0 THEN                                         20665000
   CALLDEBUG := ABSOLUTE ( %1424 );                                     20670000
                                                                        20675000
<< This makes debugging Progen easier. See comments          >>         20680000
<< at the beginning of listing.                              >>         20685000
                                                                        20690000
IF CALLDEBUG.(11:1) THEN ASSEMBLE (HALT %12);                           20695000
                                                                        20700000
INIT'JOB'TABLES; << init. system JDT and sys JIT >>            <<08968>>20705000
SAVE'LOG'INFO := ABSYS'LOGINFO;  << SAVE LOGGING STATUS >>     <<06134>>20710000
ABSYS'LOGINFO := 0; << TURN LOGGING OFF UNTIL DATE/TIME >>     <<04845>>20715000
                                                               <<06134>>20720000
                                                               <<03518>>20725000
IF CALLDEBUG.(10:1) THEN HELP;                                          20730000
                                                               <<06134>>20735000
SETTUNINGPARAMETERS;                                           <<MPEIV>>20740000
                                                               <<03652>>20745000
<< Init the disc free space map data segments for system     >><<03652>>20750000
<< discs.  This is done before the call to INITIO beacuse    >><<03652>>20755000
<< LYNX may be initialized during the INITIO for the console >><<03652>>20760000
<< and LYNX calls LOADPROC which calls the file system which >><<03652>>20765000
<< may call disc space management. (Not to cool)  The system >><<03652>>20770000
<< discs have really been initialized by the KERNEL before   >><<03652>>20775000
<< PROGEN is launched.  The only problem is if a error       >><<03652>>20780000
<< occurres during the init of the DFS data segs, which gens >><<03652>>20785000
<< console messages...  This is solved by having the DFS     >><<03652>>20790000
<< error routines called on PROGEN's stack send a message to >><<03652>>20795000
<< PROGEN (yes, send a message to our self) and we will      >><<03652>>20800000
<< generate the error message later on.                      >><<03652>>20805000
                                                               <<03652>>20810000
PROCESS'SYS'DISC'FREE'SPACE'MAPS (TRUE);                       <<03652>>20815000
                                                               <<03652>>20820000
INITIO(1); <<SYSTEM CONSOLE AND SYSTEM VOLUMES>>               <<M8968>>20825000
IF CALLDEBUG.(15:1) THEN DEBUG;                                         20830000
<< This fix is to support an FFILEINFO fix on MPEV-E.  We   >> << 7844>>20835000
<< will do a LOADPROC on the procedure REMOTE'MPE and, if it>> << 7844>>20840000
<< exists, we will put the PLABEL into sysglob extention    >> << 7844>>20845000
<< cell %16.  Note: this must occur before any dslines are  >> << 7844>>20850000
<< opened on this system (i.e. before anyone can log on).   >> << 7844>>20855000
PROCID := LOADPROC(REMOTE'MPE,0,PLABEL);                       << 7844>>20860000
IF = THEN                                                      << 7844>>20865000
BEGIN                                                          << 7844>>20870000
  SYSGLOBEXT(%16) := PLABEL;                                   << 7844>>20875000
  UNLOADPROC(PROCID);                                          << 7844>>20880000
END                                                            << 7844>>20885000
ELSE SYSGLOBEXT(%16) := 0;                                     << 7844>>20890000
PROCID := LOADPROC(GETDS'NODENAME,0,PLABEL);                   << 8762>>20895000
IF = THEN                                                      << 8762>>20900000
BEGIN                                                          << 8762>>20905000
  SYSGLOBEXT(%17) := PLABEL;                                   << 8762>>20910000
  UNLOADPROC(PROCID);                                          << 8762>>20915000
END                                                            << 8762>>20920000
ELSE SYSGLOBEXT(%17) := 0;                                     << 8762>>20925000
                                                                        20930000
<< The following is another of the Mighty Mouse Kludges.     >>         20935000
<< Since Mighty Mouse is the first HPIB machine to have      >>         20940000
<< no form of a maintenance processor, all the Control-B     >>         20945000
<< stuff is done by the main CPU.                            >>         20950000
<< The TIC has a Port Controller Chip for each terminal      >>         20955000
<< Port running independently of the CPU.                    >>         20960000
<< Only the Port 0 chip that saw the Control-B knows         >>         20965000
<< the CPU is going to halt for a while.                     >>         20970000
<< All the other ports may produce one more micro            >>         20975000
<< interrupt before they go idle.                            >>         20980000
<< In order to not totally                                   >>         20985000
<< destroy the TIC state when control-B is hit,              >>         20990000
<< completing transactions on the TIC must be saved away     >>         20995000
<< as they occur by the Control-B microcode.                 >>         21000000
<< But of course INITIAL and DUS and maybe even SADUTIL      >>         21005000
<< are incapable of handing this (and may not even want to). >>         21010000
<< What follows is MPE's signal to microcode, that MPE       >>         21015000
<< is far enough along that being able to recover            >>         21020000
<< transactions on the TIC would be useful, and hereafter    >>         21025000
<< we should be able to RUN after a Control-B operation      >>         21030000
<< without too much damage.                                  >>         21035000
<< The I/O that was in progress on the console may           >>         21040000
<< still end in a funny state.                               >>         21045000
<< This processing is only necessary                         >>         21050000
<< for terminals on the first TIC.                           >>         21055000
                                                                        21060000
IF ( M'Mouse := THISCPU = CPU'MM ) THEN                                 21065000
BEGIN                                                                   21070000
                                                                        21075000
   TOS := 3; << Parameter to OS-SIGNAL                       >>         21080000
                                                                        21085000
   ASSEMBLE ( CON %20104;                                               21090000
              CON %   23 );                                             21095000
   << This is the OS-SIGNAL instruction.                     >>         21100000
END;                                                                    21105000
                                                                        21110000
INITMSG;         <<SET UP MESSAGE SYSTEM>>                     <<00.EB>>21115000
<<      CALL INITNLS IF AND ONLY IF IT IS IN THE SL >>         << 7961>>21120000
MOVE PROCNAME:="INITNLS ";                                     << 7961>>21125000
ID'NLS := LOADPROC(PROCNAME,0,PLABEL'NLS);                     << 7961>>21130000
IF = THEN                                                      << 7961>>21135000
   BEGIN                                                       << 7961>>21140000
   TOS := FALSE;                                               << 7961>>21145000
   TOS := PLABEL'NLS;                                          << 7961>>21150000
   ASSEMBLE(PCAL 0);  << CALL INITNLS(FALSE); >>               << 7961>>21155000
   UNLOADPROC(ID'NLS);                                         << 7961>>21160000
   END;                                                        << 7961>>21165000
                                                               << 8587>>21170000
<< Note that it is in CHECK'WARMSTART where START'UP'OPTION  >><< 8959>>21175000
<< is set.  START'UP'OPTION is what drives the STARTUPSTATE  >><< 8959>>21180000
<< configuator, here in PROGEN.                              >><< 8587>>21185000
<< CHECK'WARMSTART, by the way, also determines if there     >><< 8587>>21190000
<< should be any warmstart recovery on the JMAT or the XDD   >><< 8587>>21195000
<< (It retrieves the INITIAL communication DST.  Returns the >><< 8959>>21200000
<< START'UP'OPTION and the FOS'FLAG.)                        >><< 8959>>21205000
                                                               << 8587>>21210000
CHECK'WARMSTART;  <<IF WARMSTART RECOVER JMAT>>                <<07350>>21215000
                                                               <<03518>>21220000
TOS := 0;        <<ZERO CPU CLOCK>>                            <<00.EB>>21225000
ASSEMBLE( SCLK );                                              <<00.EB>>21230000
IF CALLDEBUG.(14:1) THEN DEBUG;                                         21235000
IF M'Mouse THEN                                                << 8494>>21240000
   INITMMDATETIME << We can set date and time automatically. >><< 8494>>21245000
ELSE                                                           << 8494>>21250000
   INITDATETIME;    <<GET DATE&TIME FROM OP. & START CLOCK>>   << 8494>>21255000
CPUNUM;                                                        <<04650>>21260000
IF TOS = SERIES64 THEN INIT'PMBCREGS;                          <<04650>>21265000
ABSYS'LOGINFO := SAVE'LOG'INFO; << RESTORE LOGGING STATUS >>   <<04845>>21270000
$page "Awaken Various System Processes, etc."                  << GDR >>21275000
                                                               <<06824>>21280000
<< Allow the system port process to initialize itself.       >><<06824>>21285000
IF SYSPORTPROC <> 0                                            <<06824>>21290000
   THEN   AWAKE( SYSPORTPROC * PCBSIZE, 4, 0 );                <<06824>>21295000
                                                               <<06824>>21300000
INITIO(FALSE);   <<INIT ALL OTHER DEVICES>>                    <<08.EB>>21305000
          INITLOG;  << Initialize Log Process >>               <<03100>>21310000
          AWAKE(SYSPROC(MEMLPCBN),1,2);                                 21315000
          AWAKE(ABSYS'PVPROC,1,2);                             <<00.PV>>21320000
          AWAKE(SYSPROC(UCOPPCBN),1,2);                                 21325000
          << >>                                                <<03771>>21330000
        SETUP'TAPES;  << Set up data structures for tapes >>   <<03771>>21335000
INITRECLOG;                                                    <<00506>>21340000
         SDFINIT(0);                                           <<00205>>21345000
          << >>                                                         21350000
        INITSPOOLING;                                                   21355000
          << >>                                                <<02565>>21360000
          ABSYS'SYSUP := 1;                                             21365000
                                                               << GDR >>21370000
<< ****** The system is more or less officially up ***** >>    << GDR >>21375000
                                                               << GDR >>21380000
          MOVE BUF(1)_MSGY(0),(5);                                      21385000
          PRINT(BUF(1),5,0);                                            21390000
         AWAKE(SYSPROC(UCOPPCBN),%20,0);                       <<01.01>>21395000
                                                               <<06823>>21400000
<< Awaken the NM monitor process (NMMON), if on system. >>     <<06823>>21405000
         PIN := SYSPROC (NMMONPCBN);                           <<06823>>21410000
         IF PIN <> 0                                           <<06823>>21415000
            THEN AWAKE (PIN,1,0);                              <<06823>>21420000
                                                               <<04183>>21425000
<< Set up the Horizon Data Base Manager System Process. >>     << GDR >>21430000
   AWAKEHORIZON;                                               << GDR >>21435000
                                                               << GDR >>21440000
                                                               << GDR >>21445000
   << Initialize DCU logging via IOMESSPROC >>                 << GDR >>21450000
   DCU'REQUEST(-1);                                            << GDR >>21455000
                                                               <<04183>>21460000
   << Set flag for System Level UDC's existence in SYSGLOB >>  << GDR >>21465000
   MOVE SYS := "SYS     ";                                     <<00529>>21470000
   DIRECSCAN(%420,0D,SYS,,,GETSYSUDCFLAG,DUMMY);               <<01313>>21475000
                                                               <<06826>>21480000
                                                               <<02856>>21485000
$page "Almost up -- Process Startup, etc."                     << GDR >>21490000
   << ........................................... >>           << GDR >>21495000
   <<   Process the system startup state file     >>           << GDR >>21500000
   << ........................................... >>           << GDR >>21505000
   << DO'STARTUP can be changed to FALSE in procedure >>       << 8587>>21510000
   << INITDATETIME, if the user typed in "nostart" in >>       << 8587>>21515000
   << response to the "(M/D/Y)?" prompt               >>       << 8587>>21520000
   << ............................................... >>       << 8587>>21525000
                                                               << GDR >>21530000
   IF Do'startup AND CALLDEBUG.(12:1) = 0 THEN                          21535000
     Process'Startup;                                          << GDR >>21540000
                                                                        21545000
   << System Startup Processing can be turned off by         >>         21550000
   << the secret date/time method or setting word            >>         21555000
   << %1424 while in INITIAL. See comments earlier           >>         21560000
   << in this listing.                                       >>         21565000
                                                               << GDR >>21570000
   << ..................................................... >> << GDR >>21575000
   <<   Check the terminal (device) attributes of the       >> << GDR >>21580000
   <<   console.  If there is already a session logged on   >> << GDR >>21585000
   <<   (there may be a programmatic one via the startup    >> << GDR >>21590000
   <<   state configurator) then OPERATOR.SYS is not logged >> << GDR >>21595000
   <<   on (otherwise things proceed as they used to).      >> << GDR >>21600000
   << ..................................................... >> << GDR >>21605000
                                                               << GDR >>21610000
   Check'Term'Attributes( Consoleldev, Start'Error );          << GDR >>21615000
                                                               << GDR >>21620000
   IF Start'Error = 0 THEN                                     << GDR >>21625000
   BEGIN          << The device was free and is now DOPENed>>  << GDR >>21630000
     IF FOS'FLAG = 1                                           << 8959>>21635000
        THEN MOVE HELLOSTRING := (":HELLO MANAGER.SYS;HIPRI",0)<< 8959>>21640000
        ELSE MOVE HELLOSTRING:=(":HELLO OPERATOR.SYS;HIPRI",0);<< 8959>>21645000
     GENMSG(-1,@HELLOSTRING);                                  << GDR >>21650000
                                                               << GDR >>21655000
     DUMMY := 0;  << ERROR NUMBER >>                           << GDR >>21660000
     STARTDEVICE(1,HELLOSTRING(6),CONSOLELDEV,,,,              << GDR >>21665000
                 JOBNUM,DUMMY); << START SESSION AT CONSOLE >> << GDR >>21670000
                                                               <<00594>>21675000
     IF DUMMY > 0 THEN      << LOGON FAILED...CLEANUP >>       << GDR >>21680000
     BEGIN                                                     << GDR >>21685000
        GENMSG( Sysset, Op'Not'Logged'On );                    << GDR >>21690000
       << The console must be DCLOSE'd to free the device. >>  << GDR >>21695000
        ATTACHIO(CONSOLELDEV,0,0,0,4,0,0,0,1);                 << GDR >>21700000
     END                                                       << GDR >>21705000
     ELSE ABSOLUTE(ABSYS+SESSION1):=JOBNUM.(4:12);<<SAVE JOB#>><< GDR >>21710000
   END                                                         << GDR >>21715000
   ELSE                                                        << GDR >>21720000
       << it seems as though someone is logged on to the >>    << GDR >>21725000
       << console, so tell the user that OPERATOR.SYS was>>    << GDR >>21730000
       << not logged on.                                 >>    << GDR >>21735000
       Genmsg( Sysset, Session'On'Console );                   << GDR >>21740000
                                                               << GDR >>21745000
   ENABLE;  <<INITIAL CREATES THE PROGENITOR DISABLE'D>>       <<00594>>21750000
   GO TO AFTERINIT;                                            <<00552>>21755000
$page "PROGEN's  Control-A  Loop"                              << GDR >>21760000
NEXT:                                                                   21765000
<<                                                      >>     <<KS.01>>21770000
<<  PRINT PROMPT WITH NO CR, NO LF, AND HARD PRE-EMPTION>>     <<KS.01>>21775000
<<                                                      >>     <<KS.01>>21780000
          LPDT'INDEX:=CONSOLELDEV*INTEGER(LPDT'ENTRY'SIZE);    <<06222>>21785000
          DIT:=A'(ABSYS+LPDT'DIT'PTR);                         <<06222>>21790000
          UP:=LOGICAL((DIT'UPBIT) =1);                         <<06222>>21795000
       << TERM:=A'(DIT'TERM); >>  <<USE THE DEFAULT TERM TYPE>><<02315>>21800000
          IF NOT UP                                            <<00552>>21805000
             THEN ATTACHIO(CONSOLELDEV,0,0,0,24,0,0,0,1);      <<02315>>21810000
            GENMSG(-1,@MSGEQ,,,,,,,,,,,[1/1,13/0,2/2]);        <<KS.01>>21815000
         TOS:=ATTACHIO(CONSOLELDEV,0,0,@BUF,0,-70,5,0,%401);   <<00552>>21820000
         DELB;                                                          21825000
         CNT := -TOS;                                                   21830000
            LOG15(-CNT,@BBUF,CNT,15);<<LOG OP INPUT>>          <<KS.01>>21835000
          BBUF(CNT) _ %15;   <<CR>>                                     21840000
          CHAR _ BUF(0);                                                21845000
      << SETSERVICE(0);                 >>                              21850000
          TOS _ @BBUF;                                                  21855000
          ASSEMBLE(DUP; DUP);                                           21860000
          IF BPS0 = ALPHA                                      <<00182>>21865000
            THEN MOVE * := * WHILE AS,1                        <<00182>>21870000
            ELSE MOVE * := * WHILE ANS,1;                      <<00182>>21875000
          ASSEMBLE(XCH; LSUB; STOR COMLGTH);                            21880000
          COMNO _ SEARCH(BBUF,COMLGTH,DICT);                            21885000
          @BP1 _ @BBUF(COMLGTH);                                        21890000
             IF NOT (4<= COMNO <=5) THEN                      <<01.01>> 21895000
             BEGIN                                            <<01.01>> 21900000
             TOS:=@BP1-1;              <<START OF PARAMETER>> <<01.01>> 21905000
             DO BEGIN                                         <<01.01>> 21910000
                TOS:=TOS+1;            <<BUMP ADDRESS>>       <<01.01>> 21915000
                TOS:=S0;               <<DUPLICATE ADDRESS>>  <<01.01>> 21920000
                MOVE * := * WHILE ANS, 1; <<UPSHIFT>>         <<01.01>> 21925000
             END UNTIL BPS0 = %15;     <<CR>>                 <<01.01>> 21930000
             DEL;                      <<DELETE STACKED ADR>> <<01.01>> 21935000
             END;                                             <<01.01>> 21940000
          OK _ TRUE;                                                    21945000
          CASE COMNO OF                                                 21950000
            BEGIN                                                       21955000
               OK := FALSE;                                             21960000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>21965000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>21970000
            OK _ CONSREPLY(BP1);                                        21975000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>21980000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>21985000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>21990000
            OK _ CONSABORTJOB(BP1);                                     21995000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>22000000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>22005000
            OK _ CONSDELIO(BP1);                                        22010000
            OK _ CONSSHUTDOWN(BP1);                                     22015000
            OK:=NOSUCHCOMMAND; <<COMMAND NO LONG EXISTS>>      <<00594>>22020000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>22025000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>22030000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>22035000
            OK := CONSLOGOFF (BP1);                                     22040000
            OK := CONSLOGON (BP1);                                      22045000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>22050000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>22055000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>22060000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>22065000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>22070000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>22075000
            OK:=USENEWSPOOL; <<SPOOL REPLACED BY NEW SPOOLER CO<<00594>>22080000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>22085000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>22090000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>22095000
            OK:=USEALTDEL; <<USE NEW SPOOLER COMMANDS>>        <<00594>>22100000
            OK:=USEALTDEL; <<USE NEW SPOOLER COMMANDS>>        <<00594>>22105000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>22110000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>22115000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>22120000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>22125000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>22130000
            OK := CONSRECALL(BP1);                             <<04526>>22135000
            OK := Usenewcomm;                                  <<01176>>22140000
            OK := USENEWCOMM;                                  <<01434>>22145000
            OK := USENEWCOMM;                                  <<01434>>22150000
            OK := CONS3270 (BP1);                              <<00182>>22155000
            OK := USECI; <<COMMAND IS IN CI NOW>>                       22160000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>22165000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>22170000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>22175000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>22180000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>22185000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>22190000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>22195000
            OK:=USECI; <<COMMAND IS IN CI NOW>>                <<00594>>22200000
            OK:=USECI; <<COMMAND IS NOW IN CI>>                <<00624>>22205000
            END;                                                        22210000
          IF NOT OK THEN PRINT(MSGX,5,0);                               22215000
         ATTACHIO(CONSOLELDEV,0,0,0,31,0,0,0,%11);             <<00552>>22220000
GOL:                                                           <<00552>>22225000
          IF NOT UP THEN ATTACHIO(CONSOLELDEV,0,0,0,4,0,0,0,1);<<00552>>22230000
AFTERINIT:                                                     <<00552>>22235000
                                                               <<03518>>22240000
         CHECK'FOR'MESSAGE;                                    <<03518>>22245000
                                                               <<03518>>22250000
          WAIT (%20,0);                                        <<00552>>22255000
                                                               <<03518>>22260000
         MESSAGE'STATUS := CHECK'FOR'MESSAGE;                  <<03518>>22265000
                                                               <<03518>>22270000
         << If we got a message, don't issue read to console >><<03518>>22275000
                                                               <<03518>>22280000
         IF MESSAGE'STATUS THEN GOTO AFTERINIT;                <<03518>>22285000
                                                               <<03518>>22290000
         ATTACHIO(CONSOLELDEV,0,0,0,31,0,1,0,%411);            <<00552>>22295000
         GOTO NEXT;                                                     22300000
            << >>                                                       22305000
            << >>                                                       22310000
END.  << Progen >>                                             <<03518>>22315000
