$CONTROL USLINIT,CODE,MAP                                               00010000
<< jobsched.  contains miscellaneous procedures for the   >>            00015000
<< handling for jobs.  most of the code for job           >>            00020000
<< scheduling resides here.                               >>            00025000
                                                                        00030000
begin                                                                   00035000
                                                                        00040000
   intrinsic read, print, ascii, binary, mycommand, search,             00045000
             dateline, calendar, clock, fmtdate;                        00050000
                                                                        00055000
                                                                        00060000
<< the following equates are for error message numbers.    >>           00065000
   equate                                                               00070000
      schedunknownkey          = 6300,                                  00075000
      schedhadbothabsandrel    = 6301,                                  00080000
      schedhadbothdaydate      = 6302,                                  00085000
      schedspecbeforenow       = 6303,                                  00090000
      schednosemi              = 6304,                                  00095000
                                                                        00100000
      schedtoomanyats          = 6308,                                  00105000
      schedatwantseq           = 6309,                                  00110000
      schedexpectedhhmm        = 6310,                                  00115000
      schedbadhhval            = 6311,                                  00120000
      schednohhmmcolon         = 6312,                                  00125000
      schedneedbothhhmm        = 6313,                                  00130000
      schedbadmmval            = 6314,                                  00135000
      schedbadat               = 6310,                                  00140000
                                                                        00145000
      schedtoomanydays         = 6318,                                  00150000
      scheddaywantseq          = 6319,                                  00155000
      schednodayspec           = 6320,                                  00160000
      scheddomtoobig           = 6321,                                  00165000
      schedbadayspec           = 6322,                                  00170000
      scheddemtoobig           = 6323,                                  00175000
      scheddomzero             = 6324,                                  00180000
                                                                        00185000
      schedtoomanydates        = 6328,                                  00190000
      schednoeqsafterdate      = 6329,                                  00195000
      schednodatespec          = 6330,                                  00200000
      schedbadate              = 6330,                                  00205000
      schedbadatemonth         = 6331,                                  00210000
      schednotslashindate      = 6332,                                  00215000
      schedbadateday           = 6333,                                  00220000
      schedbadateyear          = 6334,                                  00225000
                                                                        00230000
      schedtoomanyins          = 6338,                                  00235000
      schedinwantseqs          = 6339,                                  00240000
      schedinoparms            = 6340,                                  00245000
      schedinnoday             = 6341,                                  00250000
      schedinnohours           = 6342,                                  00255000
      schedinnomins            = 6343,                                  00260000
      schedinegdom             = 6341,                                  00265000
      schedineghh              = 6342,                                  00270000
      schedinegmm              = 6343,                                  00275000
                                                                        00280000
      schedtooearly            = 6355;                                  00285000
                                                                        00290000
<< the following equates are used for the printing of      >>           00295000
<< normal processing messages.                             >>           00300000
   equate                                                               00305000
      sysset                   = 1,                                     00310000
      schedjobarrived          = 85;                                    00315000
                                                                        00320000
                                                                        00325000
define                                                                  00330000
   executorhead = (parmsp, errnum, parmnum);                            00335000
                  byte array parmsp;                                    00340000
                  integer errnum, parmnum;                              00345000
                  option privileged, uncallable #;                      00350000
                                                                        00355000
                                                                        00360000
<< the following definitions are used for communications   >>           00365000
<< with ucop.                                              >>           00370000
   equate                                                               00375000
      absys    = %1000,                                                 00380000
      jobsync  = %121,                                                  00385000
      junkwait = %20,                                                   00390000
      ucoplpin = 2;                                                     00395000
                                                                        00400000
   define                                                               00405000
      absys'jobsync   = absolute(absys+jobsync) #,                      00410000
      jobready'f      = 13:1 #;                                         00415000
                                                                        00420000
   define                                                               00425000
      enable          = assemble( sed 1 ) #,                            00430000
      disable         = assemble( sed 0 ) #;                            00435000
                                                                        00440000
   integer                                                              00445000
      x               = x,       << x register.            >>           00450000
      s0              = s-0;                                            00455000
                                                                        00460000
$page "JMAT (Job Master Table) Definitions"                             00465000
$include incljmat                                                       00470000
                                                                        00475000
                                                                        00480000
<< the following definitions are for the modifications to  >>           00485000
<< the jmat table.  note that some of these definitions    >>           00490000
<< should be added to the standard $include file.  they    >>           00495000
<< here for the time being.                                >>           00500000
equate                                                                  00505000
   jobchainend       = 0,   << null link at the end of a   >>           00510000
                            << jmat job queue.             >>           00515000
   jobsched          = %70; << jmat entry state.           >>           00520000
                                                                        00525000
$control segment=jobsched                                               00530000
$page "External procedures."                                            00535000
procedure cierr( a, b, c, d );                                          00540000
   value   a, c, d;                                                     00545000
   integer a, c, d;                                                     00550000
   byte array b;                                                        00555000
option external, variable;                                              00560000
                                                                        00565000
                                                                        00570000
procedure almanac( date, error, year, month, day, weekday );            00575000
   value   date;                                                        00580000
   logical date;                                                        00585000
   integer year, month, day, weekday;                                   00590000
   logical array error;                                                 00595000
option privileged, variable, external;                                  00600000
                                                                        00605000
                                                                        00610000
<< schedstream is a special entry point into the command   >>           00615000
<< executor for the :stream command.                       >>           00620000
procedure schedstream( parmsp, errnum, parmnum );                       00625000
   byte array parmsp;                                                   00630000
   integer errnum, parmnum;                                             00635000
option privileged, external;                                            00640000
                                                                        00645000
                                                                        00650000
<< sir handling procedures.                                >>           00655000
logical procedure getsir( sirval );                                     00660000
   value sirval;                                                        00665000
   logical sirval;                                                      00670000
option privileged, uncallable, external;                                00675000
                                                                        00680000
procedure relsir( sirval, saveval );                                    00685000
   value sirval, saveval;                                               00690000
   logical sirval, saveval;                                             00695000
option privileged, uncallable, external;                                00700000
                                                                        00705000
                                                                        00710000
<< exchangedb switches db to point to another dst.         >>           00715000
logical procedure exchangedb( dstn );                                   00720000
   value dstn;                                                          00725000
   logical dstn;                                                        00730000
option privileged, uncallable, external;                                00735000
                                                                        00740000
                                                                        00745000
<< sysproc returns a pcb index of a system process.        >>           00750000
logical procedure sysproc( lpin );                                      00755000
   value   lpin;                                                        00760000
   logical lpin;                                                        00765000
option privileged, uncallable, external;                                00770000
                                                                        00775000
                                                                        00780000
<< genmsg generates a system catalog message.              >>           00785000
integer procedure genmsg(setn,msg,mask,p1,p2,p3,p4,p5,                  00790000
                         dest,reply,buff,dst,iotype   );                00795000
   value   setn,msg,mask,p1,p2,p3,p4,p5,dest,                           00800000
           reply,buff,dst,iotype;                                       00805000
   logical setn,msg,mask,p1,p2,p3,p4,p5,dest,                           00810000
           reply,buff,dst,iotype;                                       00815000
option variable, external;                                              00820000
                                                                        00825000
                                                                        00830000
<< writedseg copys the dst out to disc.                    >>           00835000
   procedure writedseg( dst );                                          00840000
      value   dst;                                                      00845000
      integer dst;                                                      00850000
   option external;                                                     00855000
                                                                        00860000
                                                                        00865000
<< awake signals a designated process to resume.           >>           00870000
   procedure awake( pcbpt, n, waitf );                                  00875000
      value   pcbpt, n, waitf;                                          00880000
      integer pcbpt, n, waitf;                                          00885000
   option external;                                                     00890000
$page "SCHEDDAYTIME:  Formats the internal time specification."         00895000
procedure scheddaytime( out, time );                                    00900000
   byte array out;                                                      00905000
   integer array time;                                                  00910000
option privileged, uncallable;                                          00915000
begin                                                                   00920000
                                                                        00925000
<<*********************************************************>>           00930000
<<                                                         >>           00935000
<< this procedure formats the date and time specified by   >>           00940000
<< time into a condensed, 14 character string returned in  >>           00945000
<< out.  this string has the following format:             >>           00950000
<<                                                         >>           00955000
<<               0         1                               >>           00960000
<<               012345678901234                           >>           00965000
<<               mm/dd/yy hh:mm0                           >>           00970000
<<                                                         >>           00975000
<< where "HH" is a military (24 hour) specification.  for  >>           00980000
<< this release, the algorithm used here is brute force:   >>           00985000
<< time is the three word integer array holding a calendar >>           00990000
<< format in the first word and a clock format in the last >>           00995000
<< two words.  this information is passed to fmtdate, and  >>           01000000
<< the information returned is used to build the out       >>           01005000
<< string.  once native language support intrinsics become >>           01010000
<< available, a localized format could be developed.       >>           01015000
<<                                                         >>           01020000
<< note:  out(14) contains a zero byte (ascii null) as a   >>           01025000
<<        delimiter for genmsg.                            >>           01030000
<<                                                         >>           01035000
<< split stack calls are not allowed.  this procedure      >>           01040000
<< returns cce if no problems were detected and ccg other- >>           01045000
<< wise.                                                   >>           01050000
<<                                                         >>           01055000
<<*********************************************************>>           01060000
                                                                        01065000
   double                                                               01070000
      time'd;       << machine internal format.            >>           01075000
                                                                        01080000
   integer                                                              01085000
      date,                                                             01090000
      time'1 = time'd,                                                  01095000
      time'2 = time'd + 1,                                              01100000
      tempi;                                                            01105000
                                                                        01110000
   byte array                                                           01115000
      temparr(0:27);                                                    01120000
                                                                        01125000
<< the following declaractions are for handling the        >>           01130000
<< setting of the status register.                         >>           01135000
   integer                                                              01140000
      status = q-1;                                                     01145000
                                                                        01150000
   equate                                                               01155000
      cce    = 0,                                                       01160000
      ccg    = 2;                                                       01165000
                                                                        01170000
   intrinsic                                                            01175000
      fmtdate, binary, ascii;                                           01180000
                                                                        01185000
<< start of main code, scheddaytime.                       >>           01190000
   status.(6:2) := cce;                                                 01195000
                                                                        01200000
   date := time;                                                        01205000
   time'1 := time(1);                                                   01210000
   time'2 := time(2);                                                   01215000
   fmtdate( date, time'd, temparr );                                    01220000
                                                                        01225000
   if temparr(5) = "JAN"                                                01230000
      then move out := " 1"                                             01235000
   else if temparr(5) = "FEB"                                           01240000
      then move out := " 2"                                             01245000
   else if temparr(5) = "MAR"                                           01250000
      then move out := " 3"                                             01255000
   else if temparr(5) = "APR"                                           01260000
      then move out := " 4"                                             01265000
   else if temparr(5) = "MAY"                                           01270000
      then move out := " 5"                                             01275000
   else if temparr(5) = "JUN"                                           01280000
      then move out := " 6"                                             01285000
   else if temparr(5) = "JUL"                                           01290000
      then move out := " 7"                                             01295000
   else if temparr(5) = "AUG"                                           01300000
      then move out := " 8"                                             01305000
   else if temparr(5) = "SEP"                                           01310000
      then move out := " 9"                                             01315000
   else if temparr(5) = "OCT"                                           01320000
      then move out := "10"                                             01325000
   else if temparr(5) = "NOV"                                           01330000
      then move out := "11"                                             01335000
   else if temparr(5) = "DEC"                                           01340000
      then move out := "12"                                             01345000
   else    move out := "??";                                            01350000
                                                                        01355000
   out(2) := "/";                                                       01360000
                                                                        01365000
   move out(3) := temparr(9), (2);                                      01370000
                                                                        01375000
   out(5) := "/";                                                       01380000
                                                                        01385000
   move out(6) := temparr(15), (2);                                     01390000
                                                                        01395000
<< convert to military time (zero origin, 24 hour clock).  >>           01400000
   if temparr(19) = " "                                                 01405000
      then tempi := binary( temparr(20), 1 )                            01410000
      else tempi := binary( temparr(19), 2 );                           01415000
   if tempi = 12                                                        01420000
      then if temparr(25) = "A"                                         01425000
              then tempi := 0                                           01430000
              else tempi := 12                                          01435000
   else if temparr(25) = "P"                                            01440000
           then tempi := tempi + 12;                                    01445000
   move out(8) := "   ";                                                01450000
   ascii( tempi, -10, out(10) );                                        01455000
                                                                        01460000
   move out(11) := temparr(21), (3);                                    01465000
   out(14) := 0;                                                        01470000
                                                                        01475000
end;  << scheddaytime >>                                                01480000
$page "DELINKSCHED:  Delinks JMAT from the Scheduled Jobs Queue."       01485000
procedure delinksched( jmatind );                                       01490000
   value   jmatind;                                                     01495000
   integer jmatind;                                                     01500000
option uncallable, privileged;                                          01505000
begin                                                                   01510000
                                                                        01515000
<<*********************************************************>>           01520000
<<                                                         >>           01525000
<< this procedure is patterned after delink'jmat and is    >>           01530000
<< used to remove a jmat entry from the scheduled jobs     >>           01535000
<< queue.  this procedure assumes that db is pointing at   >>           01540000
<< the jmat and that jmatind is an index pointing into the >>           01545000
<< jmat indicating the entry to be deleted.  note that     >>           01550000
<< this procedure does no error checking.  if jmatind is   >>           01555000
<< not pointing to a scheduled job, this procedure will    >>           01560000
<< give no indication of the problem.  also note that the  >>           01565000
<< jmat sir should be held by this procedure's caller.     >>           01570000
<<                                                         >>           01575000
<<*********************************************************>>           01580000
                                                                        01585000
   integer                                                              01590000
      previnx;         << index to previous entry in queue.>>           01595000
                                                                        01600000
   integer array                                                        01605000
      jmatarr(*) = db+0;  << for jmat referencing.         >>           01610000
                                                                        01615000
<< start of main code for delinksched.                     >>           01620000
   previnx := jobchainend;                                              01625000
   if jmatind = jmatschedhead  << delinking the queue head.>>           01630000
      then jmatschedhead                                                01635000
              := jmatarr( jmatind + jmatschedlinkoff )                  01640000
                                                                        01645000
   else                                                                 01650000
   begin                                                                01655000
                                                                        01660000
   << the jmat entry to be deleted is not at the head.     >>           01665000
   << traverse queue to find it, and delete it if found.   >>           01670000
   << note that if jmatind is not found, this code can     >>           01675000
   << loop forever or hit a bounds violation.  we have     >>           01680000
   << serious problems if this procedure is called         >>           01685000
   << incorrectly.                                         >>           01690000
      previnx := jmatschedhead;                                         01695000
      while jmatarr(previnx+jmatschedlinkoff) <> jmatind                01700000
         do previnx := jmatarr( previnx + jmatschedlinkoff );           01705000
                                                                        01710000
      jmatarr( previnx + jmatschedlinkoff )                             01715000
         := jmatarr( jmatind + jmatschedlinkoff );                      01720000
                                                                        01725000
   end;                                                                 01730000
                                                                        01735000
end;  << delinksched >>                                                 01740000
$page "COMPTIME:  Compares two times (in internal format)."             01745000
integer procedure comptime( time1, time2, diff, error );                01750000
   integer array  time1, time2;                                         01755000
   double diff;                                                         01760000
   integer error;                                                       01765000
option privileged, uncallable, variable;                                01770000
begin                                                                   01775000
                                                                        01780000
<<*********************************************************>>           01785000
<<                                                         >>           01790000
<< this procedure compares two time specifications (in     >>           01795000
<< internal format).  optionally, the difference in        >>           01800000
<< machine ticks is returned in diff.  the return values   >>           01805000
<< are as follows:                                         >>           01810000
<<                                                         >>           01815000
<<    -1:  time1 < time2; diff undefined.                  >>           01820000
<<     0:  time1 = time2; diff = 0d.                       >>           01825000
<<     1:  time1 > time2; diff contains the number of      >>           01830000
<<                        machine ticks.                   >>           01835000
<<     2:  time1 > time2; diff is undefined since 32 bits  >>           01840000
<<                        are insufficient to hold the     >>           01845000
<<                        difference between the two times.>>           01850000
<<    10:  error found; error contains an error number.    >>           01855000
<<                                                         >>           01860000
<< semantics can be difficult since we are not used to     >>           01865000
<< thinking about one time being "larger" than another     >>           01870000
<< time.  the rule to remember is: "Later is Greater".     >>           01875000
<< that is, the later the time is, the larger it is        >>           01880000
<< considered to be.  thus, if time1 will occur after      >>           01885000
<< time2, then time1 > time2.                              >>           01890000
<<                                                         >>           01895000
<< note that diff is constrained to be 24 days or less,    >>           01900000
<< even though a 32-bit unsigned integer is capable of     >>           01905000
<< handling approximately 24.86 days.  for current and     >>           01910000
<< forseen applications of this procedure, 24 days is      >>           01915000
<< ample.  note that return value of 2 is only possible if >>           01920000
<< diff was passed in; otherwise, only a return value of   >>           01925000
<< 1 is used to specify time1 > time2.                     >>           01930000
<<                                                         >>           01935000
<< at present, the only error detected is if both time1    >>           01940000
<< and time2 are not present in its call.  if no error is  >>           01945000
<< detected, a zero is returned to error.                  >>           01950000
<<                                                         >>           01955000
<< time1 and time2 are both required parameters.  values   >>           01960000
<< are assigned to diff and error only if present.         >>           01965000
<<                                                         >>           01970000
<< the value returned in diff can be used for timer        >>           01975000
<< request list calls if the time in time2 is the current  >>           01980000
<< time.                                                   >>           01985000
<<                                                         >>           01990000
$page                                                                   01995000
<< this routine is used in the management of scheduled     >>           02000000
<< jobs.  the internal time specs have this format:        >>           02005000
<<                                                         >>           02010000
<<        +-----------------------------------------+      >>           02015000
<< word 0 | year of centry  |    day of year        |      >>           02020000
<<        +-----------------------------------------+      >>           02025000
<< word 1 |  hour of day      |   minute of hour    |      >>           02030000
<<        +-----------------------------------------+      >>           02035000
<< word 2 |    seconds        |  tenths of seconds  |      >>           02040000
<<        +-----------------------------------------+      >>           02045000
<<        0                 7  8                   15      >>           02050000
<<                                                         >>           02055000
<<                                                         >>           02060000
<< note:  unfortunately, split stack calls are not allowed.>>           02065000
<<                                                         >>           02070000
<<*********************************************************>>           02075000
                                                                        02080000
                                                                        02085000
<< the following definitions are used to determine which   >>           02090000
<< parameters were present in the call.                    >>           02095000
   logical                                                              02100000
      pmask        = q-4;   << passed parameter mask.      >>           02105000
                                                                        02110000
   define                                                               02115000
      p'time1      = pmask.(12:1) #,                                    02120000
      p'time2      = pmask.(13:1) #,                                    02125000
      p'diff       = pmask.(14:1) #,                                    02130000
      p'error      = pmask.(15:1) #;                                    02135000
                                                                        02140000
<< the following definitions encompass the various return  >>           02145000
<< values.                                                 >>           02150000
   integer                                                              02155000
      locerror    := 0,     << local error value.          >>           02160000
      returnval   := 0;     << initially "equals".         >>           02165000
                                                                        02170000
   equate                                                               02175000
      error'return = 10,    << error found in processing.  >>           02180000
      t1'lt't2     = -1,  << time1 < time2                 >>           02185000
      t1'eq't2     = 0,   << time1 = time2                 >>           02190000
      t1'gt't2     = 1,   << time1 > time2; diff<=24 days. >>           02195000
      t1'ggt't2    = 2;   << time1 > time2; diff>24 days.  >>           02200000
                                                                        02205000
   define                                                               02210000
      millperday   = 86400000d#,     << milliseconds in a  >>           02215000
                                     << day.               >>           02220000
      millpermin   = 60000d#,        << milliseconds in a  >>           02225000
                                     << minute.            >>           02230000
      dayslimit    = 24d#;           << schedule jobs in   >>           02235000
                                     << the next 24 days.  >>           02240000
                                                                        02245000
      << note:  24 days is about the maximum number of     >>           02250000
      <<        milliseconds that can be held in a double  >>           02255000
      <<        integer.                                   >>           02260000
                                                                        02265000
   double                                                               02270000
      millilimit;         << milliseconds in dayslimit.    >>           02275000
                                                                        02280000
<< the following equates are for the possible error values.>>           02285000
   equate                                                               02290000
      req'parms'error     = 1;                                          02295000
                                                                        02300000
<< the following definitions are intermediate values.      >>           02305000
   integer                                                              02310000
      day1, day2,                                                       02315000
      min1, min2,                                                       02320000
      sec1, sec2;                                                       02325000
                                                                        02330000
   double                                                               02335000
      locdiff       := 0d;                                              02340000
                                                                        02345000
<< start of main code for comptime.                        >>           02350000
                                                                        02355000
                                                                        02360000
<< initialize the diff limit (in milliseconds).            >>           02365000
   millilimit := millperday * dayslimit;                                02370000
                                                                        02375000
<< check for required parameters.                          >>           02380000
   if not ( p'time1 land p'time2 ) then                                 02385000
   begin                                                                02390000
                                                                        02395000
      returnval := error'return;                                        02400000
      locerror  := req'parms'error;                                     02405000
                                                                        02410000
   end                                                                  02415000
   else                                                                 02420000
   begin                                                                02425000
                                                                        02430000
   << all the required parameters have been found.  make   >>           02435000
   << the comparison.  assume equals until otherwise.      >>           02440000
      returnval := t1'eq't2;                                            02445000
      min1 := time1(1).(0:8) * 60 + time1(1).(8:8);                     02450000
      min2 := time2(1).(0:8) * 60 + time2(1).(8:8);                     02455000
      sec1 := time1(2).(0:8) * 10 + time1(2).(8:8);                     02460000
      sec2 := time2(2).(0:8) * 10 + time2(2).(8:8);                     02465000
                                                                        02470000
      if time1(0) > time2(0)                                            02475000
         then returnval := t1'gt't2                                     02480000
                                                                        02485000
      else if time1(0) < time2(0)                                       02490000
         then returnval := t1'lt't2                                     02495000
                                                                        02500000
   << year and day specifications are equal, check hours   >>           02505000
   << and minutes.                                         >>           02510000
      else if min1 > min2                                               02515000
         then returnval := t1'gt't2                                     02520000
                                                                        02525000
      else if min1 < min2                                               02530000
         then returnval := t1'lt't2                                     02535000
                                                                        02540000
   << year, day, hours, and minutes are equal.  check the  >>           02545000
   << seconds and tenths of seconds specifications.        >>           02550000
      else if sec1 > sec2                                               02555000
         then returnval := t1'gt't2                                     02560000
                                                                        02565000
      else if sec1 < sec2                                               02570000
         then returnval := t1'lt't2;                                    02575000
                                                                        02580000
   << all checks are complete.  if appropriate, return     >>           02585000
   << the difference value.                                >>           02590000
      if p'diff land (returnval = t1'gt't2) then                        02595000
      begin                                                             02600000
                                                                        02605000
      << check to see if diff can be expressed (i.e. diff  >>           02610000
      << will be less than millilimit).                    >>           02615000
         if time1(0).(0:7) > time2(0).(0:7) + 2                         02620000
            then returnval := t1'ggt't2                                 02625000
                                                                        02630000
         else                                                           02635000
         begin                                                          02640000
                                                                        02645000
            day1 := time1(0).(7:9);                                     02650000
            day2 := time2(0).(7:9);                                     02655000
            if time1(0).(0:7) <> time2(0).(0:7) then                    02660000
            begin                                                       02665000
               day1 := day1 + 365;                                      02670000
               if ( (time1(0).(0:7) mod 4 = 0) land                     02675000
                    (time1(0).(0:7) <> 100)         )                   02680000
                  then day1 := day1 + 1;   << leap year    >>           02685000
            end;                                                        02690000
                                                                        02695000
            if day1 > day2 + integer( dayslimit )                       02700000
               then returnval := t1'ggt't2                              02705000
                                                                        02710000
            else                                                        02715000
            begin                                                       02720000
                                                                        02725000
            << diff is small enough to be calculated.      >>           02730000
               locdiff := millperday * double( day1 - day2 );           02735000
               locdiff := locdiff +                                     02740000
                  millpermin * double( min1 - min2 );                   02745000
               locdiff := locdiff +                                     02750000
                  100d * double( sec1 - sec2 );                         02755000
                                                                        02760000
            end;  << diff calculation >>                                02765000
                                                                        02770000
         end;  << diff < 24 days >>                                     02775000
                                                                        02780000
      end;  << diff should be returned >>                               02785000
                                                                        02790000
   end;  << check for required parameters. >>                           02795000
                                                                        02800000
<< assign values to the appropriate return variables and   >>           02805000
<< quit.                                                   >>           02810000
   if p'diff     then diff := locdiff;                                  02815000
   if p'error    then error := locerror;                                02820000
   comptime := returnval;                                               02825000
                                                                        02830000
end;  << comptime >>                                                    02835000
$page "SCHEDULESCHED:  Links JMAT entry to Scheduled Jobs queue"        02840000
procedure schedulesched (jmatp);                                        02845000
   value jmatp;                                                         02850000
   integer pointer jmatp;                                               02855000
   option uncallable, privileged;                                       02860000
begin                                                                   02865000
                                                                        02870000
<<*********************************************************>>           02875000
<<                                                         >>           02880000
<< this procedure takes the jmat entry pointed to by jmatp >>  <<*8942>>02885000
<< (which is in intro state) and links it into the         >>  <<*8942>>02890000
<< appropriate spot in the scheduled jobs queue.  if the   >>  <<*8942>>02895000
<< time stamp in the jmat entry is less than the current   >>  <<*8942>>02900000
<< time, the job will be placed at the head of the queue   >>  <<*8942>>02905000
<< and when ucop is wakened it will place the job in wait  >>  <<*8942>>02910000
<< state by a call to schedulejob.  otherwise, the job     >>  <<*8942>>02915000
<< will remain in the scheduled jobs queue in the sched    >>  <<*8942>>02920000
<< state.  the algorithm used in this procedure was copied >>  <<*8942>>02925000
<< from schedulejob (in nursery).                          >>  <<*8942>>02930000
<<                                                         >>           02935000
<< the entry point recoversched is used by progen when it  >>           02940000
<< is recovering the jmat after a warmstart.  there are    >>           02945000
<< only two differences from the normal processing:        >>           02950000
<< first, ucop is not awakened after linking the jmat      >>           02955000
<< entry into the scheduled jobs queue (progen awakens     >>           02960000
<< ucop once the entire jmat has been recovered), and      >>           02965000
<< second, the jmat is not written out to disk (progen     >>           02970000
<< will do this once recovery is complete).                >>           02975000
<<                                                         >>           02980000
<< note that the jmat sir is locked during this operation  >>           02985000
<< to prevent the corruption caused by jmat contention.    >>           02990000
<< this procedure assumes that db is pointing to the       >>           02995000
<< caller's stack.  since comptime cannot be called in     >>           03000000
<< split-stack mode, this procedure uses move from/to data >>           03005000
<< segment instructions for the accessing of the jmat.     >>           03010000
<<                                                         >>           03015000
<<*********************************************************>>           03020000
                                                                        03025000
                                                                        03030000
   integer           savesir,                                           03035000
                     compreturn;                                        03040000
   logical           done;                                              03045000
                                                                        03050000
   equate            lessthan = -1;  << comptime value.    >>           03055000
                                                                        03060000
<< the following declarations are used for the referencing >>           03065000
<< jmat with the standard $include file definitions.       >>           03070000
   integer array     jmatarr(0:jmatentrysize);                          03075000
   integer           jmatinx,                                           03080000
                     saveschedhead,                                     03085000
                     currinx,                                           03090000
                     lastinx;                                           03095000
                                                                        03100000
   integer array     jmatptime(0:2),                                    03105000
                     indextime(0:2);                                    03110000
                                                                        03115000
<< the following definitions are used for the jmat recovery >>          03120000
<< entry point, recoversched.                               >>          03125000
   entry             recoversched;                                      03130000
   logical           recovering;                                        03135000
                                                                        03140000
                                                                        03145000
                                                                        03150000
<< standard dst accessing subroutines.                      >>          03155000
   subroutine movefromdseg( target, dstn, offset, count );              03160000
      value   target, dstn, offset, count;                              03165000
      logical target, dstn, offset, count;                              03170000
   begin                                                                03175000
                                                                        03180000
      x := tos;     << save subroutine return address.      >>          03185000
      assemble( mfds 0 );                                               03190000
      tos := x;     << restore return address.              >>          03195000
                                                                        03200000
   end;                                                                 03205000
                                                                        03210000
                                                                        03215000
   subroutine movetodseg( dstn, offset, source, count );                03220000
      value   dstn, offset, source, count;                              03225000
      logical dstn, offset, source, count;                              03230000
   begin                                                                03235000
                                                                        03240000
      x := tos;     << save subroutine return address.      >>          03245000
      assemble( mtds 0 );                                               03250000
      tos := x;                                                         03255000
                                                                        03260000
   end;                                                                 03265000
                                                                        03270000
$page                                                                   03275000
<< start of main code for schedulesched.                    >>          03280000
   recovering := false;                                                 03285000
   goto maincode;                                                       03290000
                                                                        03295000
recoversched:                                                           03300000
   recovering := true;                                                  03305000
                                                                        03310000
maincode:                                                               03315000
                                                                        03320000
<< save the time specifications for the entry to be added   >>          03325000
<< to the scheduled jobs list.                              >>          03330000
   savesir := getsir( jmatsir );                                        03335000
   currinx := @jmatp;                                                   03340000
   movefromdseg( @jmatarr, jmatdst, currinx, jmatentrysize );           03345000
   jmatinx := 0;     << for accessing entry in jmatarr.     >>          03350000
   jmatptime := jmatcalendar;                                           03355000
   move jmatptime(1) := jmattime, (2);                                  03360000
                                                                        03365000
<< traverse the scheduled jobs queue until a job of later   >>          03370000
<< starting time is found.  insert the new entry there.     >>          03375000
<<    currinx is the index of the entry whose scheduling    >>          03380000
<<            time is checked.                              >>          03385000
<<    lastinx is the index of the entry previous to         >>          03390000
<<            jmatinx's entry.                              >>          03395000
<<    jmatp   is a pointer to the jmat entry to be inserted.>>          03400000
   movefromdseg( @jmatarr, jmatdst, 0, jmatentrysize );                 03405000
   saveschedhead := jmatschedhead;                                      03410000
   currinx := lastinx := jmatschedhead;                                 03415000
                                                                        03420000
   done := false;                                                       03425000
   while not done do                                                    03430000
   begin                                                                03435000
                                                                        03440000
      if currinx = jobchainend                                          03445000
         then done := true                                              03450000
      else                                                              03455000
      begin                                                             03460000
         movefromdseg( @jmatarr, jmatdst, currinx,                      03465000
                       jmatentrysize );                                 03470000
         indextime := jmatcalendar;                                     03475000
         move indextime(1) := jmattime, (2);                            03480000
         compreturn := comptime( jmatptime, indextime );                03485000
         if compreturn = lessthan                                       03490000
            then done := true                                           03495000
         else                                                           03500000
         begin                                                          03505000
            lastinx := currinx;                                         03510000
            currinx := jmatschedlink;                                   03515000
         end;                                                           03520000
      end;                                                              03525000
                                                                        03530000
   end;                                                                 03535000
                                                                        03540000
<< currinx is now pointing at the jmat entry which belongs >>           03545000
<< after jmatp, and lastinx is pointing at the entry which >>           03550000
<< belongs before jmatp.                                   >>           03555000
   if currinx = saveschedhead then  << insert at the head  >>           03560000
   begin                            << of the queue.       >>           03565000
      movefromdseg( @jmatarr, jmatdst, 0, jmatentrysize );              03570000
      jmatschedhead := @jmatp;                                          03575000
      movetodseg( jmatdst, 0, @jmatarr, jmatentrysize );                03580000
   end                                                                  03585000
   else                                                                 03590000
   begin                                                                03595000
      movefromdseg( @jmatarr, jmatdst, lastinx,                         03600000
                    jmatentrysize );                                    03605000
      jmatschedlink := @jmatp;                                          03610000
      movetodseg( jmatdst, lastinx, @jmatarr,                           03615000
                  jmatentrysize );                                      03620000
   end;                                                                 03625000
                                                                        03630000
   movefromdseg( @jmatarr, jmatdst, @jmatp, jmatentrysize );            03635000
   jmatschedlink := currinx;                                            03640000
                                                                        03645000
<< any subsequent reference to the new jmat entry will use >>           03650000
<< the standard table definitions.  changes its state to   >>           03655000
<< "Scheduled" and inform the operator of its arrival.     >>           03660000
   jmatjobstate := jobsched;                                            03665000
   movetodseg( jmatdst, @jmatp, @jmatarr, jmatentrysize );              03670000
                                                                        03675000
<< if we are recovering the jmat entry, then our work is   >>           03680000
<< done.  otherwise, write the jmat out to disk so that it >>           03685000
<< can be recovered on the next warmstart.                 >>           03690000
   if recovering then                                                   03695000
   begin                                                                03700000
      relsir( jmatsir, savesir );                                       03705000
      return;                                                           03710000
   end;                                                                 03715000
                                                                        03720000
<< inform ucop that it has work to do.  note that the same >>           03725000
<< synchroniztion protocol as a job-made-ready is used.    >>           03730000
<< note that the jmatarr array still holds the entry for   >>           03735000
<< the job just scheduled.                                 >>           03740000
   writedseg(jmatdst);                                                  03745000
   tos := jmatjindev;                                                   03750000
   genmsg(sysset,schedjobarrived,%10000,s0,,,,,0);                      03755000
   del;                                                                 03760000
                                                                        03765000
   disable;                                                             03770000
   absys'jobsync.(jobready'f) := true;                                  03775000
   enable;                                                              03780000
   awake (sysproc(ucoplpin),junkwait,0);                                03785000
                                                                        03790000
   relsir (jmatsir, savesir);                                           03795000
                                                                        03800000
   end;    <<schedulesched>>                                            03805000
$page "TIMEPARMS:  Parses the time specifying parms"           <<*8942>>03810000
<< timeparms:  parses stream's time specifying parms.    >>    <<*8942>>03815000
                                                                        03820000
procedure timeparms( string, time, error, printerror );                 03825000
   value   printerror;                                                  03830000
   logical printerror;                                                  03835000
   byte array string;                                                   03840000
   logical array time;                                                  03845000
   integer error;                                                       03850000
option privileged, uncallable;                                          03855000
begin                                                                   03860000
                                                                        03865000
<<*********************************************************>>           03870000
<<                                                         >>           03875000
<< timeparms:  this procedure parses the information in    >>           03880000
<< string and returns either a syntax error number in      >>           03885000
<< error or an absolute time specification in the three    >>           03890000
<< word array time.  the time array will be returned with  >>  <<*8942>>03895000
<< all zeroes if string is empty or if it specifies a time >>  <<*8942>>03900000
<< earlier or at the current time.  printerror indicates   >>  <<*8942>>03905000
<< whether error messages (via a call to cierr) are to be  >>  <<*8942>>03910000
<< printed.                                                >>  <<*8942>>03915000
<<                                                         >>           03920000
<< the expected syntax in string is as follows:            >>           03925000
<<                                                         >>           03930000
<<     [;at=hh,mm]                                         >>           03935000
<<     [;day= {dow|dom|dem}   | ;date=mm/dd/yy ]           >>           03940000
<<                      or                                 >>           03945000
<<     [;in=[days] [, [hours] [, minutes] ] ]              >>           03950000
<<                                                         >>           03955000
<< the end of the string is delimited by a carriage        >>           03960000
<< return.  in cannot be specified with any other keyword. >>           03965000
<< both day and date cannot be specified.                  >>           03970000
<<                                                         >>           03975000
<< time has a standard format that is used throughout the  >>           03980000
<< job scheduling code.  it is as follows:                 >>           03985000
<<                                                         >>           03990000
<<        +-----------------------------------------+      >>           03995000
<< word 0 | year of centry  |    day of year        |      >>           04000000
<<        +-----------------------------------------+      >>           04005000
<< word 1 |  hour of day      |   minute of hour    |      >>           04010000
<<        +-----------------------------------------+      >>           04015000
<< word 2 |    seconds        |  tenths of seconds  |      >>           04020000
<<        +-----------------------------------------+      >>           04025000
<<        0                 7  8                   15      >>           04030000
<<                                                         >>           04035000
<< there are several routines available for manipulating   >>           04040000
<< these time specification values.                        >>           04045000
<<                                                         >>           04050000
<<*********************************************************>>           04055000
$page                                                                   04060000
                                                                        04065000
byte array keywords(0:1)=pb:=   << known syntax keywords.  >>           04070000
     4, 2, "AT",                << will be used with the   >>           04075000
     5, 3, "DAY",               << search intrinsic.       >>           04080000
     6, 4, "DATE",                                                      04085000
     4, 2, "IN",                                                        04090000
     0;                                                                 04095000
equate keywordlen = 20;         << length of keywords list.>>           04100000
byte array                                                              04105000
     localkeys(0:keywordlen-1); << local copy of keywords. >>           04110000
                                                                        04115000
integer                                                                 04120000
   key;                                                                 04125000
                                                                        04130000
equate                                                                  04135000
   maxparms       = 20,         << actually, less is the   >>           04140000
                                << limit, but check for    >>           04145000
                                << error reporting sake.   >>           04150000
   comma          = 0,          << delimiter values return >>           04155000
   equals         = 1,          <<    by mycommand.        >>           04160000
   semicolon      = 2,                                                  04165000
   cr             = 3;                                                  04170000
                                                                        04175000
<< the following declarations are used with mycommand for  >>           04180000
<< the parsing of the command image parameters.            >>           04185000
double array parm(0:maxparms-1) = q;                                    04190000
integer array parm'i(*) = parm;                                         04195000
                                                                        04200000
byte pointer currentparm;                                               04205000
                                                                        04210000
logical array                                                           04215000
   locerror'(0:1);                                                      04220000
                                                                        04225000
integer                                                                 04230000
   locerror = locerror',                                                04235000
   i,                                                                   04240000
   numparms := 0,                                                       04245000
   currentlen,                                                          04250000
   currentdelimiter,                                                    04255000
   filenamelen,                                                         04260000
   pnum;                                                                04265000
                                                                        04270000
logical                                                                 04275000
   done;      << local loop flag. >>                                    04280000
                                                                        04285000
                                                                        04290000
<< the following logicals keep track of the amount of      >>           04295000
<< parsing already done.                                   >>           04300000
logical                                                                 04305000
   atseen    := false,                                                  04310000
   dayseen   := false,                                                  04315000
   dateseen  := false,                                                  04320000
   inseen    := false;                                                  04325000
                                                                        04330000
<< the following variables are used to specify the current >>           04335000
<< day and time to be used in resolving user's specs.      >>           04340000
logical array                                                  <<*8942>>04345000
   currtime(0:2) = q;                                          <<*8942>>04350000
                                                               <<*8942>>04355000
double                                                         <<*8942>>04360000
   currclock     = currtime + 1;                               <<*8942>>04365000
                                                               <<*8942>>04370000
                                                                        04375000
integer                                                                 04380000
   currcal       = currtime,                                   <<*8942>>04385000
   currclock'0   = currclock,                                           04390000
   curryear      := 0,                                                  04395000
   currmonth     := 0,                                                  04400000
   currday       := 0,                                                  04405000
   currweekday   := 0,                                                  04410000
   currhour      := 0,                                                  04415000
   currmin       := 0,                                         <<*8942>>04420000
   compreturn;                                                 <<*8942>>04425000
                                                                        04430000
integer                                                                 04435000
   hhspec        := 0,                                                  04440000
   mmspec        := 0,                                                  04445000
   dowspec       := -1,       << -1 is an illegal value.   >>           04450000
   domspec,                                                             04455000
   demspec,                                                             04460000
   doyspec       := 0,                                                  04465000
   monthspec,                                                           04470000
   yearspec      := 0;                                                  04475000
                                                                        04480000
logical                                                                 04485000
   istoday,            << indicates user time specs is the >>           04490000
                       << current day.                     >>           04495000
   nextday := false,   << this indicates that the time     >>           04500000
                       << specified by "AT" will fall next >>           04505000
                       << tommorrow.                       >>           04510000
   weekdayseen         << this indicates that a weekday    >>           04515000
      := false;        << specified by "DAY".  if that     >>           04520000
                       << weekday is the same as today and >>           04525000
                       << nextday is true, then next week  >>           04530000
                       << is implied.                      >>           04535000
                                                                        04540000
<< the following defines are used to indicate the various  >>           04545000
<< parts of the time array.                                >>           04550000
define                                                                  04555000
   yearpart   = 0).(0:7  #,                                             04560000
   daypart    = 0).(7:9  #,                                             04565000
   hourpart   = 1).(0:8  #,                                             04570000
   minpart    = 1).(8:8  #;                                             04575000
                                                                        04580000
<< the following declarations are used to examine months   >>           04585000
<< during parsing.                                         >>           04590000
equate                                                                  04595000
   january    = 1,                                                      04600000
   february   = 2,                                                      04605000
   march      = 3,                                                      04610000
   april      = 4,                                                      04615000
   may        = 5,                                                      04620000
   june       = 6,                                                      04625000
   july       = 7,                                                      04630000
   august     = 8,                                                      04635000
   september  = 9,                                                      04640000
   october    = 10,                                                     04645000
   november   = 11,                                                     04650000
   december   = 12;                                                     04655000
                                                                        04660000
define                                                                  04665000
   leap'year                                                            04670000
      = ( ( yearspec mod 4 = 0    ) land                                04675000
          ( yearspec mod 100 <> 0 )      ) #,                           04680000
                                                                        04685000
   feb'in'leap                                                          04690000
      = ( ( monthspec = february  ) land                                04695000
          leap'year                      ) #,                           04700000
                                                                        04705000
   leapyearadj                                                          04710000
      = ( if feb'in'leap then 1 else 0   ) #;                           04715000
                                                                        04720000
integer array                                                           04725000
   days'per'month(1:12);                                                04730000
                                                                        04735000
                                                                        04740000
<< the following declarations are used for parsing the     >>           04745000
<< weekday names that can be specified as part of "DAY".   >>           04750000
byte array weekday'full'names(0:1) = pb :=                              04755000
      8, 6, "SUNDAY",                                                   04760000
      8, 6, "MONDAY",                                                   04765000
      9, 7, "TUESDAY",                                                  04770000
     11, 9, "WEDNESDAY",                                                04775000
     10, 8, "THURSDAY",                                                 04780000
      8, 6, "FRIDAY",                                                   04785000
     10, 8, "SATURDAY",                                                 04790000
      0;                                                                04795000
equate fullnamelen = 65;                                                04800000
                                                                        04805000
byte array weekday'abbr(0:1) = pb :=                                    04810000
      5, 3, "SUN",                                                      04815000
      5, 3, "MON",                                                      04820000
      5, 3, "TUE",                                                      04825000
      5, 3, "WED",                                                      04830000
      5, 3, "THU",                                                      04835000
      5, 3, "FRI",                                                      04840000
      5, 3, "SAT",                                                      04845000
      0;                                                                04850000
equate abbrlen = 36;                                                    04855000
                                                                        04860000
byte array                                                              04865000
   search'array(0:fullnamelen-1);                                       04870000
                                                                        04875000
equate                                                                  04880000
   unknown'weekday   = 0,                                               04885000
   sunday            = 1,                                               04890000
   monday            = 2,                                               04895000
   tuesday           = 3,                                               04900000
   wednesday         = 4,                                               04905000
   thursday          = 5,                                               04910000
   friday            = 6,                                               04915000
   saturday          = 7;                                               04920000
                                                                        04925000
                                                                        04930000
<< the following declarations are used to do some sub-     >>           04935000
<< parsing of the date and at keyworded parameters.        >>           04940000
byte array extradelims (0:7);                                           04945000
double array extraparms(0:4) = q;                                       04950000
integer array extra'p'i(*) = extraparms;                                04955000
integer numextraparms := 0;                                             04960000
byte pointer                                                            04965000
   athour,                                                              04970000
   atmin,                                                               04975000
   datemonth,                                                           04980000
   dateday,                                                             04985000
   dateyear;                                                            04990000
                                                                        04995000
define                                                                  05000000
   athourlen      = extra'p'i(1).(0:8)  #,                              05005000
   athourdelim    = extra'p'i(1).(11:5) #,                              05010000
   atminlen       = extra'p'i(3).(0:8)  #,                              05015000
   atmindelim     = extra'p'i(3).(11:5) #,                              05020000
   datemonthlen   = extra'p'i(1).(0:8)  #,                              05025000
   datemonthdelim = extra'p'i(1).(11:5) #,                              05030000
   datedaylen     = extra'p'i(3).(0:8)  #,                              05035000
   datedaydelim   = extra'p'i(3).(11:5) #,                              05040000
   dateyearlen    = extra'p'i(5).(0:8)  #,                              05045000
   dateyeardelim  = extra'p'i(5).(11:5) #;                              05050000
                                                                        05055000
define                                                                  05060000
   atdelims       = ",=; : " #,                                         05065000
   datedelims     = ",=; / " #;                                         05070000
                                                                        05075000
equate                                                                  05080000
   colon   = 4,  << delimiter position. >>                              05085000
   slash   = 4;  << delimiter position. >>                              05090000
                                                                        05095000
equate                                                         <<*8942>>05100000
   t1'eq't2 = 0;                                               <<*8942>>05105000
                                                                        05110000
intrinsic                                                               05115000
   calendar, clock, binary, mycommand, search;                          05120000
                                                                        05125000
                                                                        05130000
$page                                                                   05135000
integer subroutine convertspecs;                                        05140000
begin                                                                   05145000
                                                                        05150000
<<*********************************************************>>           05155000
<<                                                         >>           05160000
<< this subroutine is called after all the user parameters >>           05165000
<< have been parsed and the appropriate assignments to the >>           05170000
<< following variables have been made:  yearspec, domspec, >>           05175000
<< monthspec, hhspec, mmspec, nextday, and weekdayseen.    >>           05180000
<< nextday indicates that the time specified by "AT" is    >>           05185000
<< earlier in the day than the current time.  weekdayseen  >>           05190000
<< indicates that the specification to the "DAY" parameter >>           05195000
<< was a weekday name.  these are used to adjust the       >>           05200000
<< values for yearspec, monthspec, and domspec if it is    >>           05205000
<< appropriate.  note that if "DATE" is used to specify    >>           05210000
<< the current day or if another specification of "DAY"    >>           05215000
<< indicates the current day, an illegal specification has >>           05220000
<< occurred.                                               >>           05225000
<<                                                         >>           05230000
<<*********************************************************>>           05235000
                                                                        05240000
   convertspecs := 0;                                                   05245000
   if   ( curryear = yearspec )   land                                  05250000
        ( currmonth = monthspec ) land                                  05255000
        ( currday = domspec )                                           05260000
      then  istoday := true                                             05265000
      else  istoday := false;                                           05270000
                                                                        05275000
<< if the time specified by "AT" will not next fall in the >>           05280000
<< current day, then adjust the day specification if it is >>           05285000
<< appropriate.                                            >>           05290000
   if nextday land istoday then                                         05295000
   begin                                                                05300000
      if dateseen         lor                                           05305000
         (dayseen land (not weekdayseen)) then                          05310000
      begin                                                             05315000
         convertspecs := schedspecbeforenow;                            05320000
         return;                                                        05325000
      end;                                                              05330000
      if weekdayseen                                                    05335000
         then domspec := domspec + 7                                    05340000
         else domspec := domspec + 1;                                   05345000
      if domspec > days'per'month( monthspec ) then                     05350000
      begin                                                             05355000
         if feb'in'leap                                                 05360000
            then domspec := domspec - 29                                05365000
            else domspec                                                05370000
                   := domspec - days'per'month( monthspec );            05375000
         if monthspec = december then                                   05380000
         begin                                                          05385000
            monthspec := january;                                       05390000
            yearspec := yearspec + 1;                                   05395000
         end                                                            05400000
         else monthspec := monthspec + 1;                               05405000
      end;                                                              05410000
   end;                                                                 05415000
                                                                        05420000
<< resolve the month, day, and year into day of year.      >>           05425000
   i := january - 1;                                                    05430000
   doyspec := 0;                                                        05435000
   while (i:=i+1) < monthspec                                           05440000
      do if (i = february) and (leap'year)                              05445000
            then doyspec := doyspec + 29                                05450000
            else doyspec := doyspec + days'per'month( i );              05455000
   doyspec := doyspec + domspec;                                        05460000
                                                                        05465000
<< make the appropriate assignments to the parts of the    >>           05470000
<< time specifying data structure.                         >>           05475000
   time(0) := 0;                                                        05480000
   time(1) := 0;                                                        05485000
   time(2) := 0;                                                        05490000
   time(yearpart)  := yearspec;                                         05495000
   time(daypart)   := doyspec;                                          05500000
   time(hourpart)  := hhspec;                                           05505000
   time(minpart)   := mmspec;                                           05510000
                                                                        05515000
end;  << convertspecs >>                                                05520000
$page                                                                   05525000
                                                                        05530000
logical subroutine getnextparm;                                         05535000
begin                                                                   05540000
                                                                        05545000
<<*********************************************************>>           05550000
<<                                                         >>           05555000
<< this subroutine sets the values of currentparm,         >>           05560000
<< currentlen, and currentdelimiter to the values implied  >>           05565000
<< by the next parameter in the command image.  if another >>           05570000
<< parameter is found, this routine returns true, and if   >>           05575000
<< the previous parameter is the last one on the line, it  >>           05580000
<< returns false.  the value of pnum always indicates the  >>           05585000
<< current parameter being examined.  note that pnum uses  >>           05590000
<< zero origin indexing.                                   >>           05595000
<<                                                         >>           05600000
<<*********************************************************>>           05605000
                                                                        05610000
   if pnum >= numparms then                                             05615000
   begin                                                                05620000
                                                                        05625000
   << current parameter is the last one in the command.    >>           05630000
      getnextparm := false;                                             05635000
      return;                                                           05640000
                                                                        05645000
   end;                                                                 05650000
                                                                        05655000
<< assume that there is another parameter.  set the        >>           05660000
<< various variables pointing to it.                       >>           05665000
   pnum := pnum + 1;                                                    05670000
   @currentparm := parm'i(pnum*2);                                      05675000
   currentlen := parm'i(pnum*2+1).(0:8);                                05680000
   currentdelimiter := parm'i(pnum*2+1).(11:5);                         05685000
   getnextparm := true;                                                 05690000
                                                                        05695000
end;  << getnextparm >>                                                 05700000
$page                                                                   05705000
                                                                        05710000
                                                                        05715000
integer subroutine processat;                                           05720000
begin                                                                   05725000
                                                                        05730000
<<*********************************************************>>           05735000
<<                                                         >>           05740000
<< this subroutine processes the "AT" parameter.  the      >>           05745000
<< expected syntax is "HH:MM" where hh and mm are both     >>           05750000
<< numerals such that 0<=hh<=23 and 0<=mm<=59.  if no      >>           05755000
<< errors are detected, the functional return for this     >>           05760000
<< subroutine is zero, otherwise an positive return        >>           05765000
<< indicates an error was detected and a negative return   >>           05770000
<< indicates a warning was detected.  this routine does    >>           05775000
<< not call error message printing routines--that must be  >>           05780000
<< done by the caller to this routine.                     >>           05785000
<<                                                         >>           05790000
<< if no errors were detected, the correct values will be  >>           05795000
<< assigned to the following variables:  hhspec, mmspec,   >>           05800000
<< and nextday.  nextday is used to indicate that the      >>           05805000
<< specified time next falls in the next day, not the      >>           05810000
<< current day.                                            >>           05815000
<<                                                         >>           05820000
<< since ":" is a non-standard delimiter, a special call   >>           05825000
<< to mycommand is made for the time specification parse.  >>           05830000
<<                                                         >>           05835000
<<*********************************************************>>           05840000
                                                                        05845000
                                                                        05850000
   processat := 0;                                                      05855000
                                                                        05860000
   if atseen then     << "AT" redundantly specified.       >>           05865000
   begin                                                                05870000
      processat := schedtoomanyats;                                     05875000
      return;                                                           05880000
   end;                                                                 05885000
                                                                        05890000
   atseen := true;                                                      05895000
                                                                        05900000
   if inseen then     << can't specify "IN" and "AT" in    >>           05905000
   begin              << same command invocation.          >>           05910000
      processat := schedhadbothabsandrel;                               05915000
      return;                                                           05920000
   end;                                                                 05925000
                                                                        05930000
<< look for and process the "HH" parameter.                >>           05935000
   if currentdelimiter <> equals then                                   05940000
   begin                                                                05945000
      processat := schedatwantseq;                                      05950000
      return;                                                           05955000
   end;                                                                 05960000
                                                                        05965000
   if not getnextparm then                                              05970000
   begin                                                                05975000
      processat := schedbadat;                                          05980000
      return;                                                           05985000
   end;                                                                 05990000
                                                                        05995000
   if currentlen = 0 then                                               06000000
   begin                                                                06005000
      processat := schedbadat;                                          06010000
      return;                                                           06015000
   end;                                                                 06020000
                                                                        06025000
   move extradelims := atdelims;                                        06030000
   extradelims(5) := %15;     << carriage return. >>                    06035000
   mycommand( currentparm, extradelims, 3, numextraparms,               06040000
              extraparms );                                             06045000
   @athour := extra'p'i(0);                                             06050000
   @atmin  := extra'p'i(2);                                             06055000
                                                                        06060000
   if numextraparms < 2 then                                            06065000
   begin                                                                06070000
      processat := schedbadat;                                          06075000
      return;                                                           06080000
   end;                                                                 06085000
                                                                        06090000
   hhspec := binary( athour, athourlen );                               06095000
   if <> then                                                           06100000
   begin                                                                06105000
      processat := schedbadhhval;                                       06110000
      return;                                                           06115000
   end;                                                                 06120000
                                                                        06125000
   if not (0<=hhspec<=23) then                                          06130000
   begin                                                                06135000
      processat := schedbadhhval;                                       06140000
      return;                                                           06145000
   end;                                                                 06150000
                                                                        06155000
<< look for and process the "MM" parameter.                >>           06160000
   if athourdelim <> colon then                                         06165000
   begin                                                                06170000
      processat := schednohhmmcolon;                                    06175000
      return;                                                           06180000
   end;                                                                 06185000
                                                                        06190000
   mmspec := binary( atmin, atminlen );                                 06195000
   if <> then                                                           06200000
   begin                                                                06205000
      processat := schedbadmmval;                                       06210000
      return;                                                           06215000
   end;                                                                 06220000
                                                                        06225000
   if not (0<=mmspec<=59) then                                          06230000
   begin                                                                06235000
      processat := schedbadmmval;                                       06240000
      return;                                                           06245000
   end;                                                                 06250000
                                                                        06255000
<< if we made it this far, then hhspec and mmspec contain  >>           06260000
<< legal values and we are done.  note that later, it must >>           06265000
<< be resolved whether the specified time is in the        >>           06270000
<< current day or the next day, or whether the time        >>           06275000
<< specified is illegal.  if "DAY" is used to specify the  >>           06280000
<< current day by using either a positive or negative      >>           06285000
<< number, or if "DATE" was specified, and if the "AT"     >>           06290000
<< is earlier than the current time, the user's time       >>           06295000
<< specifications are illegal.  if "DAY" is a day-of-week  >>           06300000
<< specification, than next week is assumed.  the variable >>           06305000
<< nextday is used to resolve this issue later (in         >>           06310000
<< convertspecs).                                          >>           06315000
   if ( mmspec + hhspec*60 ) >= ( currmin + currhour*60 )               06320000
      then  nextday := false                                            06325000
      else  nextday := true;                                            06330000
                                                                        06335000
                                                                        06340000
   processat := 0;                                                      06345000
                                                                        06350000
end;  << processat >>                                                   06355000
$page                                                                   06360000
                                                                        06365000
                                                                        06370000
integer subroutine processday;                                          06375000
begin                                                                   06380000
                                                                        06385000
<<*********************************************************>>           06390000
<<                                                         >>           06395000
<< this subroutine processes the "DAY" parameter.  the     >>           06400000
<< expected syntax is complex:  if a number is specified,  >>           06405000
<< it represents the day of the month if it was positive   >>           06410000
<< or the day from the end of the month if it was negative.>>           06415000
<< a day of the week could also have been specified,       >>           06420000
<< either with a three-character abbreviation or with the  >>           06425000
<< weekday name spelled out.  this routine returns a zero  >>           06430000
<< if no errors were detected, a positive error number, or >>           06435000
<< a negative warning number.  this routine does not call  >>           06440000
<< error message printing routines--that must be done by   >>           06445000
<< the caller of this routine.                             >>           06450000
<<                                                         >>           06455000
<< processing of day requires comparisons with the current >>           06460000
<< week and month.  it is assumed that the values in the   >>           06465000
<< variables curryear, currmonth, currday, and currweekday >>           06470000
<< have been initialized.  if no errors were detected,     >>           06475000
<< this routine will assign the correct values to the      >>           06480000
<< following variables:  yearspec, monthspec, and domspec. >>           06485000
<<                                                         >>           06490000
<<*********************************************************>>           06495000
                                                                        06500000
                                                                        06505000
   processday := 0;                                                     06510000
                                                                        06515000
   if dayseen then     << "DAY" redundantly specified.     >>           06520000
   begin                                                                06525000
      processday := schedtoomanydays;                                   06530000
      return;                                                           06535000
   end;                                                                 06540000
                                                                        06545000
   if dateseen then   << can't specify both "DAY" and      >>           06550000
   begin              << "DATE".                           >>           06555000
      processday := schedhadbothdaydate;                                06560000
      return;                                                           06565000
   end;                                                                 06570000
                                                                        06575000
   if inseen then     << can't specify "IN" and "DAY" in   >>           06580000
   begin              << same command invocation.          >>           06585000
      processday := schedhadbothabsandrel;                              06590000
      return;                                                           06595000
   end;                                                                 06600000
                                                                        06605000
   dayseen := true;                                                     06610000
                                                                        06615000
   if currentdelimiter <> equals then                                   06620000
   begin                                                                06625000
      processday := scheddaywantseq;                                    06630000
      return;                                                           06635000
   end;                                                                 06640000
                                                                        06645000
   if not getnextparm then                                              06650000
   begin                                                                06655000
      processday := schednodayspec;                                     06660000
      return;                                                           06665000
   end;                                                                 06670000
                                                                        06675000
   if currentlen = 0 then                                               06680000
   begin                                                                06685000
      processday := schednodayspec;                                     06690000
      return;                                                           06695000
   end;                                                                 06700000
                                                                        06705000
<< try first for either day of month or day from end of    >>           06710000
<< month specification.  it is easier to process.          >>           06715000
   domspec := binary( currentparm, currentlen );                        06720000
   if = then        << found a number.  check its          >>           06725000
   begin            << validity.                           >>           06730000
                                                                        06735000
   << resolve the day of month (or day from end of month)  >>           06740000
   << specification to an absolute day and month.          >>           06745000
      if domspec > 0 then    << day of month.              >>           06750000
      begin                                                             06755000
         if domspec >= currday                                          06760000
            then monthspec := currmonth                                 06765000
            else if currmonth = december                                06770000
                    then monthspec := january                           06775000
                    else monthspec := currmonth + 1;                    06780000
         if domspec > days'per'month(monthspec) + leapyearadj           06785000
         then                                                           06790000
         begin                                                          06795000
            processday := scheddomtoobig;                               06800000
            return;                                                     06805000
         end;                                                           06810000
      end                                                               06815000
                                                                        06820000
      else if domspec = 0 then                                          06825000
      begin                                                             06830000
         processday := scheddomzero;                                    06835000
         return;                                                        06840000
      end                                                               06845000
                                                                        06850000
      else                   << day from end of the month. >>           06855000
      begin                                                             06860000
         demspec := domspec + 1;   << convert to zero      >>           06865000
                                   << origin indexing.     >>           06870000
         if days'per'month(currmonth)+demspec >= currday                06875000
            then monthspec := currmonth                                 06880000
            else if currmonth = december                                06885000
                    then monthspec := january                           06890000
                    else monthspec := currmonth + 1;                    06895000
         if 1-demspec > days'per'month(monthspec)+leapyearadj           06900000
         then                                                           06905000
         begin                                                          06910000
            processday := scheddemtoobig;                               06915000
            return;                                                     06920000
         end;                                                           06925000
         domspec := days'per'month(monthspec) + demspec;                06930000
      end;                                                              06935000
                                                                        06940000
                                                                        06945000
   end                                                                  06950000
   else                                                                 06955000
   begin                                                                06960000
                                                                        06965000
   << "DAY" specification was not a numeral.  it could be  >>           06970000
   << day of the week specification.  check both full      >>           06975000
   << names and abbreviations.                             >>           06980000
      move search'array := weekday'full'names,                          06985000
                           (fullnamelen);                               06990000
      dowspec := search( currentparm, currentlen,                       06995000
                          search'array );                               07000000
      if dowspec = unknown'weekday then                                 07005000
      begin                                                             07010000
                                                                        07015000
      << wasn't a full name, try a weekday abbreviation.   >>           07020000
         move search'array := weekday'abbr, (abbrlen);                  07025000
         dowspec := search( currentparm, currentlen,                    07030000
                            search'array             );                 07035000
         if dowspec = unknown'weekday then                              07040000
         begin                                                          07045000
            processday := schedbadayspec;                               07050000
            return;                                                     07055000
         end;                                                           07060000
                                                                        07065000
      end;                                                              07070000
                                                                        07075000
   weekdayseen := true;                                        <<*8942>>07080000
                                                               <<*8942>>07085000
   << got a legal day of the week.  resolve it to be a     >>           07090000
   << month and day specification.                         >>           07095000
      if dowspec >= currweekday                                         07100000
         then domspec := currday + (dowspec-currweekday)                07105000
         else domspec := currday + (dowspec-currweekday) + 7;           07110000
      if domspec > days'per'month( currmonth ) then                     07115000
      begin                                                             07120000
         if currmonth = december                                        07125000
            then monthspec := january                                   07130000
            else monthspec := currmonth + 1;                            07135000
         domspec := domspec - days'per'month( currmonth );              07140000
      end;                                                              07145000
                                                                        07150000
   end;                                                                 07155000
                                                                        07160000
<< if we got this far, we have resolved the user's         >>           07165000
<< specifications to a month and day of the month.         >>           07170000
<< adjust the year specification if wrapped around.        >>           07175000
   if (currmonth = december ) and ( monthspec = january )               07180000
      then yearspec := curryear + 1                                     07185000
      else yearspec := curryear;                                        07190000
                                                                        07195000
end;  << processday >>                                                  07200000
$page                                                                   07205000
                                                                        07210000
                                                                        07215000
                                                                        07220000
integer subroutine processdate;                                         07225000
begin                                                                   07230000
                                                                        07235000
<<*********************************************************>>           07240000
<<                                                         >>           07245000
<< this subroutine processes the "DATE" parameter.  for    >>           07250000
<< now, the expected syntax is of the form, "MM/DD/YY".    >>           07255000
<< when the native language support project is completed,  >>           07260000
<< the "Custom Date" formatting intrinsics will be used.   >>           07265000
<< this routine will return a zero if no errors were       >>           07270000
<< detected, a negative error number if a warning          >>           07275000
<< condition was detected, and a positive error number if  >>           07280000
<< an error is detected.  this routine does not call any   >>           07285000
<< error message printing routines--that must be done by   >>           07290000
<< the caller of this routine.                             >>           07295000
<<                                                         >>           07300000
<< if no errors were detected, this routine will assign    >>           07305000
<< the correct values to yearspec, monthspec, and domspec. >>           07310000
<<                                                         >>           07315000
<<*********************************************************>>           07320000
                                                                        07325000
   processdate := 0;                                                    07330000
                                                                        07335000
   if dateseen then     << "DATE" redundantly specified.   >>           07340000
   begin                                                                07345000
      processdate := schedtoomanydates;                                 07350000
      return;                                                           07355000
   end;                                                                 07360000
                                                                        07365000
   if dayseen then    << can't specify both "DAY" and      >>           07370000
   begin              << "DATE".                           >>           07375000
      processdate := schedhadbothdaydate;                               07380000
      return;                                                           07385000
   end;                                                                 07390000
                                                                        07395000
   if inseen then     << can't specify "IN" and "DATE" in  >>           07400000
   begin              << same command invocation.          >>           07405000
      processdate := schedhadbothabsandrel;                             07410000
      return;                                                           07415000
   end;                                                                 07420000
                                                                        07425000
   dateseen := true;                                                    07430000
                                                                        07435000
   if currentdelimiter <> equals then                                   07440000
   begin                                                                07445000
      processdate := schednoeqsafterdate;                               07450000
      return;                                                           07455000
   end;                                                                 07460000
                                                                        07465000
   if not getnextparm then                                              07470000
   begin                                                                07475000
      processdate := schednodatespec;                                   07480000
      return;                                                           07485000
   end;                                                                 07490000
                                                                        07495000
   if currentlen = 0 then                                               07500000
   begin                                                                07505000
      processdate := schednodatespec;                                   07510000
      return;                                                           07515000
   end;                                                                 07520000
                                                                        07525000
<< a special call to mycommand is done here to use "/" as  >>           07530000
<< a delimiter in the parsing of the date specification.   >>           07535000
   move extradelims := datedelims;                                      07540000
   extradelims(5) := %15;     << carriage return. >>                    07545000
   mycommand( currentparm, extradelims, 4, numextraparms,               07550000
              extraparms );                                             07555000
   @datemonth := extra'p'i(0);                                          07560000
   @dateday   := extra'p'i(2);                                          07565000
   @dateyear  := extra'p'i(4);                                          07570000
                                                                        07575000
   if numextraparms < 3 then                                            07580000
   begin                                                                07585000
      processdate := schedbadate;                                       07590000
      return;                                                           07595000
   end;                                                                 07600000
                                                                        07605000
   monthspec := binary( datemonth, datemonthlen );                      07610000
   if <> then                                                           07615000
   begin                                                                07620000
      processdate := schedbadatemonth;                                  07625000
      return;                                                           07630000
   end;                                                                 07635000
                                                                        07640000
   if datemonthdelim <> slash then                                      07645000
   begin                                                                07650000
      processdate := schednotslashindate;                               07655000
      return;                                                           07660000
   end;                                                                 07665000
                                                                        07670000
   if not ( january <= monthspec <= december ) then                     07675000
   begin                                                                07680000
      processdate := schedbadatemonth;                                  07685000
      return;                                                           07690000
   end;                                                                 07695000
                                                                        07700000
   if datedaydelim <> slash then                                        07705000
   begin                                                                07710000
      processdate := schednotslashindate;                               07715000
      return;                                                           07720000
   end;                                                                 07725000
                                                                        07730000
   domspec := binary( dateday, datedaylen );                            07735000
   if <> then                                                           07740000
   begin                                                                07745000
      processdate := schedbadateday;                                    07750000
      return;                                                           07755000
   end;                                                                 07760000
                                                                        07765000
   yearspec := binary( dateyear, dateyearlen );                         07770000
   if <> then                                                           07775000
   begin                                                                07780000
      processdate := schedbadateyear;                                   07785000
      return;                                                           07790000
   end;                                                                 07795000
                                                                        07800000
   if not ( curryear <= yearspec <= 99 ) then                           07805000
   begin                                                                07810000
      processdate := schedbadateyear;                                   07815000
      return;                                                           07820000
   end;                                                                 07825000
                                                                        07830000
   if not ( 1 <= domspec <= days'per'month( monthspec ) )               07835000
   then                                                                 07840000
   begin                                                                07845000
      if not( (feb'in'leap)     land                                    07850000
              (domspec = 29)         )                                  07855000
      then                                                              07860000
      begin                                                             07865000
         processdate := schedbadateday;                                 07870000
         return;                                                        07875000
      end;                                                              07880000
                                                                        07885000
   end;                                                                 07890000
                                                                        07895000
end;  << processdate >>                                                 07900000
$page                                                                   07905000
                                                                        07910000
                                                                        07915000
integer subroutine processin;                                           07920000
begin                                                                   07925000
                                                                        07930000
<<*********************************************************>>           07935000
<<                                                         >>           07940000
<< this subroutine processes the "IN" parameter.  its      >>           07945000
<< syntax is as follows:                                   >>           07950000
<<                                                         >>           07955000
<<      ;in = [days] [, [hours] [, minutes ] ] ]           >>           07960000
<<                                                         >>           07965000
<< "IN" cannot be specified with any other keyword parm.   >>           07970000
<< "IN" is used to specify a time relative to the current  >>           07975000
<< time--this subroutine assumes that the values in the    >>           07980000
<< "CURRxx" variables have been set to the current time.   >>           07985000
<< this routine returns a zero if no errors were detected, >>           07990000
<< a negative error number if a warning condition was      >>           07995000
<< detected, and a positive error number if an error       >>           08000000
<< condition was detected.  this routine does not print    >>           08005000
<< any error messages--that is the responsibility of the   >>           08010000
<< caller of this routine.                                 >>           08015000
<<                                                         >>           08020000
<< if no errors were detected, this routine will assign    >>           08025000
<< the correct values to the yearspec, monthspec, domspec, >>           08030000
<< hhspec, and mmspec.  note that nextday has already been >>           08035000
<< initialized to false, so no extra processing will be    >>           08040000
<< done for it in convertspecs.                            >>           08045000
<<                                                         >>           08050000
<<*********************************************************>>           08055000
                                                                        08060000
                                                                        08065000
   processin := 0;                                                      08070000
                                                                        08075000
   if inseen then      << "IN" redundantly specified.      >>           08080000
   begin                                                                08085000
      processin := schedtoomanyins;                                     08090000
      return;                                                           08095000
   end;                                                                 08100000
                                                                        08105000
   if dateseen or dayseen or atseen then                                08110000
   begin               << can't specify an absolute and    >>           08115000
                       << relative times.                  >>           08120000
      processin := schedhadbothabsandrel;                               08125000
      return;                                                           08130000
   end;                                                                 08135000
                                                                        08140000
   inseen := true;                                                      08145000
                                                                        08150000
   if currentdelimiter <> equals then                                   08155000
   begin                                                                08160000
      processin := schedinwantseqs;                                     08165000
      return;                                                           08170000
   end;                                                                 08175000
                                                                        08180000
<< so far, so good.  days, hours, and minutes are          >>           08185000
<< processed in turn.  once they are all read in, they are >>           08190000
<< converted to absolute month, day, and year specs.       >>           08195000
   if not getnextparm then                                              08200000
   begin                                                                08205000
      processin := schedinoparms;                                       08210000
      return;                                                           08215000
   end;                                                                 08220000
                                                                        08225000
   domspec := 0;                                                        08230000
   hhspec  := 0;                                                        08235000
   mmspec  := 0;                                                        08240000
                                                                        08245000
   domspec := binary( currentparm, currentlen );                        08250000
   if <> then                                                           08255000
   begin                                                                08260000
      processin := schedinnoday;                                        08265000
      return;                                                           08270000
   end;                                                                 08275000
                                                                        08280000
   if currentdelimiter = comma then                                     08285000
   begin                                                                08290000
                                                                        08295000
      if not getnextparm then                                           08300000
      begin                                                             08305000
         processin := schedinnohours;                                   08310000
         return;                                                        08315000
      end;                                                              08320000
                                                                        08325000
      hhspec := binary( currentparm, currentlen );                      08330000
      if <> then                                                        08335000
      begin                                                             08340000
         processin := schedinnohours;                                   08345000
         return;                                                        08350000
      end;                                                              08355000
                                                                        08360000
      if currentdelimiter = comma then                                  08365000
      begin                                                             08370000
                                                                        08375000
         if not getnextparm then                                        08380000
         begin                                                          08385000
            processin := schedinnomins;                                 08390000
            return;                                                     08395000
         end;                                                           08400000
                                                                        08405000
         mmspec := binary( currentparm, currentlen );                   08410000
         if <> then                                                     08415000
         begin                                                          08420000
            processin := schedinnomins;                                 08425000
            return;                                                     08430000
         end;                                                           08435000
                                                                        08440000
      end;  << minutes >>                                               08445000
                                                                        08450000
   end;  << hours >>                                                    08455000
                                                                        08460000
<< right now, the "xxSPEC" variables contain the user      >>           08465000
<< specified values.  negative specifications, here are    >>           08470000
<< not valid.  check these values, and if no errors are    >>           08475000
<< found, convert them to absolute specifications.         >>           08480000
   if domspec < 0 then                                                  08485000
   begin                                                                08490000
      processin := schedinegdom;                                        08495000
      return;                                                           08500000
   end;                                                                 08505000
   if hhspec < 0 then                                                   08510000
   begin                                                                08515000
      processin := schedineghh;                                         08520000
      return;                                                           08525000
   end;                                                                 08530000
   if mmspec < 0 then                                                   08535000
   begin                                                                08540000
      processin := schedinegmm;                                         08545000
      return;                                                           08550000
   end;                                                                 08555000
                                                                        08560000
   mmspec := mmspec + currmin;                                          08565000
   hhspec := hhspec + currhour;                                         08570000
   domspec := domspec + currday;                                        08575000
   monthspec := currmonth;                                              08580000
   yearspec := curryear;                                                08585000
   while mmspec > 59 do                                                 08590000
   begin                                                                08595000
      mmspec := mmspec - 60;                                            08600000
      hhspec := hhspec + 1;                                             08605000
   end;                                                                 08610000
   while hhspec > 23 do                                                 08615000
   begin                                                                08620000
      hhspec := hhspec - 24;                                            08625000
      domspec := domspec + 1;                                           08630000
   end;                                                                 08635000
   while (domspec > days'per'month( monthspec ) ) lor                   08640000
         ((feb'in'leap)                           land                  08645000
          (domspec>29)                                ) do              08650000
   begin                                                                08655000
      if feb'in'leap                                                    08660000
         then domspec := domspec - 29                                   08665000
         else domspec := domspec - days'per'month(monthspec);           08670000
      monthspec := monthspec + 1;                                       08675000
      if monthspec > december then                                      08680000
      begin                                                             08685000
         monthspec := january;                                          08690000
         yearspec := yearspec + 1;                                      08695000
      end;                                                              08700000
   end;                                                                 08705000
                                                                        08710000
end;  << processin >>                                                   08715000
$page                                                                   08720000
                                                                        08725000
                                                                        08730000
                                                                        08735000
<<*********************************************************>>           08740000
<<                                                         >>           08745000
<< start of main code for timeparms.                       >>           08750000
<<                                                         >>           08755000
<<*********************************************************>>           08760000
                                                                        08765000
                                                                        08770000
<< initialize the days'per'month values.                   >>           08775000
   days'per'month( january   )  := 31;                                  08780000
   days'per'month( february  )  := 28;                                  08785000
   days'per'month( march     )  := 31;                                  08790000
   days'per'month( april     )  := 30;                                  08795000
   days'per'month( may       )  := 31;                                  08800000
   days'per'month( june      )  := 30;                                  08805000
   days'per'month( july      )  := 31;                                  08810000
   days'per'month( august    )  := 31;                                  08815000
   days'per'month( september )  := 30;                                  08820000
   days'per'month( october   )  := 31;                                  08825000
   days'per'month( november  )  := 30;                                  08830000
   days'per'month( december  )  := 31;                                  08835000
                                                                        08840000
<< set up the parsing by examining the input string and    >>           08845000
<< initializing the various return values.  note that the  >>           08850000
<< current time and date are the default values for the    >>           08855000
<< user's specifications.  however, if the user doesn't    >>  <<*8942>>08860000
<< specify a time, then all zeroes are returned.           >>  <<*8942>>08865000
   mycommand( string, , maxparms, numparms, parm );                     08870000
   currcal := calendar;                                                 08875000
   currclock := clock;                                                  08880000
   almanac( currcal, locerror', curryear, currmonth, currday,           08885000
            currweekday );                                              08890000
                                                                        08895000
   currhour := currclock'0.(0:8);                                       08900000
   currmin := currclock'0.(8:8);                                        08905000
   hhspec := currhour;                                                  08910000
   mmspec := currmin;                                                   08915000
   monthspec := currmonth;                                              08920000
   domspec := currday;                                                  08925000
   yearspec := curryear;                                                08930000
   move time := 3(0);                                                   08935000
   error := 0;                                                          08940000
                                                                        08945000
   if numparms <> 0 then                                       <<*8942>>08950000
   begin                                                       <<*8942>>08955000
                                                               <<*8942>>08960000
   << initialize the parameter pointer by setting pnum to   >>          08965000
   << minus one.  this way, getnextparm will get the pnum+1 >>          08970000
   << parameter.  process each of the present keywords.     >>          08975000
      pnum := -1;                                                       08980000
      move localkeys := keywords, (keywordlen);                         08985000
      done := false;                                                    08990000
      getnextparm;                                             <<*8942>>08995000
                                                                        09000000
      while not done do                                                 09005000
      begin                                                             09010000
                                                                        09015000
      << process this particular keyword.                   >>          09020000
         key := search( currentparm, currentlen, localkeys );           09025000
         case key of                                                    09030000
         begin                                                          09035000
                                                                        09040000
         << unknown >>                                                  09045000
            error := schedunknownkey;                                   09050000
                                                                        09055000
         << at >>                                                       09060000
            error := processat;                                         09065000
                                                                        09070000
         << day >>                                                      09075000
            error := processday;                                        09080000
                                                                        09085000
         << date >>                                                     09090000
            error := processdate;                                       09095000
                                                                        09100000
         << in >>                                                       09105000
            error := processin;                                         09110000
                                                                        09115000
         end;  << case statement >>                                     09120000
                                                                        09125000
      << handle any detected errors.                        >>          09130000
         if error <> 0 then                                             09135000
         begin                                                          09140000
            if printerror                                               09145000
               then cierr( error, currentparm );                        09150000
            if error > 0 then return;                                   09155000
         end;                                                           09160000
                                                                        09165000
      << each of the "PROCESSxx" subroutines should leave   >>          09170000
      << currentparm at the last parameter for this keyword.>>          09175000
      << if there are still other keywords, process them.   >>          09180000
         if currentdelimiter = cr                                       09185000
            then done := true                                           09190000
         else if currentdelimiter <> semicolon then                     09195000
         begin                                                          09200000
            getnextparm;                                       <<*8942>>09205000
            error := schednosemi;                                       09210000
            done := true;                                               09215000
         end                                                            09220000
         else if not getnextparm                                        09225000
            then done := true;                                          09230000
                                                                        09235000
      end;  << while loop that processes keywords. >>                   09240000
                                                                        09245000
   << handle any remaining errors . >>                         <<*8942>>09250000
      if error <> 0 then                                       <<*8942>>09255000
      begin                                                    <<*8942>>09260000
         if printerror then cierr( error, currentparm );       <<*8942>>09265000
         if error > 0 then return;                             <<*8942>>09270000
      end;                                                     <<*8942>>09275000
                                                               <<*8942>>09280000
   << finally, convert the user specifications into the    >>  <<*8942>>09285000
   << machine internal format.  if the parsed time is less >>  <<*8942>>09290000
   << than the current time, then let the user know and    >>  <<*8942>>09295000
   << zero the time array.                                 >>  <<*8942>>09300000
                                                               <<*8942>>09305000
      error := convertspecs;                                   <<*8942>>09310000
      if error = 0 then                                        <<*8942>>09315000
      begin                                                    <<*8942>>09320000
                                                               <<*8942>>09325000
         compreturn := comptime( time, currtime );             <<*8942>>09330000
         if compreturn <= t1'eq't2 then                        <<*8942>>09335000
         begin                                                 <<*8942>>09340000
            move time := 3(0);                                 <<*8942>>09345000
            error := -schedtooearly;                           <<*8942>>09350000
         end;                                                  <<*8942>>09355000
                                                               <<*8942>>09360000
      end;                                                     <<*8942>>09365000
                                                               <<*8942>>09370000
      if error <> 0 and printerror then                        <<*8942>>09375000
         cierr( error );                                       <<*8942>>09380000
                                                               <<*8942>>09385000
   end;   << of numparms <> 0 >>                               <<*8942>>09390000
                                                                        09395000
end;  << timeparms >>                                                   09400000
$page                                                                   09405000
$control segment=ob'                                                    09410000
end.                                                                    09415000
