mim/development/mim/mimc/cdrive.mud

   1
   2 <PACKAGE "CDRIVE">
   3
   4 <ENTRY COMPILE COMP2 PEEP-ENABLED FIXUP-DEATH-ENABLED UPDATE-STATUS STATUS-LINE>
   5
   6 <USE "COMPDEC" "PASS1" "SYMANA" "ADVMESS" "CODGEN" "PEEP" "DEATH">
   7
   8 <SETG STATUS-LINE <>>
   9
  10 <SETG PEEP-ENABLED T>
  11
  12 <SETG FIXUP-DEATH-ENABLED T>
  13
  14 "****** TOP LEVEL COMILER CALLS ******"
  15
  16 "COMPILE -- compile one function.
  17
  18         The arguments to compile are:
  19
  20         FCN -- an atom whose GVAL is a function
  21
  22         CAREFUL -- If true compile bounds checking else don't.
  23
  24         REASONABLE -- Assume reasonable calling sequence?
  25
  26         ANALY-OK -- If true, do hairy analysis.
  27
  28         VERBOSE -- Print debugginh messages.
  29 "
  30
  31 <DEFINE COMPILE (FCN
  32                  "OPTIONAL" (CAREFUL T) (REASONABLE T) (ANALY-OK T)
  33                             (VERBOSE <>)
  34                  "AUX" (IND (1)) (VP (())) FCNP FCNN (GLOSP <>) (TAG-COUNT 0)
  35                        (EXTRA-CODE-START
  36                         <COND (<ASSIGNED? EXTRA-CODE-START> .EXTRA-CODE-START)
  37                               (ELSE (0))>)
  38                        (EXTRA-CODE
  39                         <COND (<ASSIGNED? EXTRA-CODE> .EXTRA-CODE)
  40                               (ELSE .EXTRA-CODE-START)>) CL
  41                  "NAME" COMPILE-ACTIVATION)
  42         #DECL ((FCN) <SPECIAL ATOM> (FCNN) <SPECIAL NODE>
  43                (SRC-FLG BIN-FLG CAREFUL GLOSP REASONABLE IND TAG-COUNT
  44                 COMPILE-ACTIVATION ANALY-OK VERBOSE) <SPECIAL ANY>
  45                (EXTRA-CODE-START EXTRA-CODE) <SPECIAL LIST>)
  46         <COND (.VERBOSE <SET VERBOSE .VP>)>
  47         <COND (<NOT <AND <GASSIGNED? .FCN>
  48                          <OR <TYPE? <SET FCNP ,.FCN> FUNCTION>
  49                              <AND <TYPE? .FCNP MACRO>
  50                                   <NOT <EMPTY? .FCNP>>
  51                                   <TYPE? <SET FCNP <1 .FCNP>> FUNCTION>>>>>
  52                <COMPILE-ERROR "Not a function: " .FCN>)>
  53         <COND (,STATUS-LINE <UPDATE-STATUS "Comp" <SPNAME .FCN> "PS1" <>>)>
  54         <PRINC "Compiling: ">
  55         <PRIN1 .FCN>
  56         <CRLF>
  57         <SET FCNN <PASS1 .FCN .FCNP>>
  58         <COND (,STATUS-LINE <UPDATE-STATUS "Comp" <> "ANA" <>>)>
  59         <ANA .FCNN ANY>
  60         <COND (,STATUS-LINE <UPDATE-STATUS "Comp" <> "GEN" <>>)>
  61         <COND (.VERBOSE <ANA-MESS .VP>)>
  62         <SET CL <CODE-GEN .FCNN .EXTRA-CODE>>
  63         <PROG ()
  64               <COND (<AND <GASSIGNED? FIXUP-DEATH-ENABLED> ,FIXUP-DEATH-ENABLED>
  65                      <REMOVE-DEADS .CL>)>
  66               <COND (<AND <GASSIGNED? PEEP-ENABLED> ,PEEP-ENABLED>
  67                      <COND (,STATUS-LINE <UPDATE-STATUS "Comp" <> "PEEP" <>>)>
  68                      <PEEP <REST .CL>>)>
  69               <COND (<AND <GASSIGNED? FIXUP-DEATH-ENABLED> ,FIXUP-DEATH-ENABLED>
  70                      <COND (,STATUS-LINE <UPDATE-STATUS "Comp" <> "DEAD" <>>)>
  71                      <COND (<FIXUP-DEATH <REST .CL>> <AGAIN>)>)>>
  72         <REST .EXTRA-CODE-START>>
  73
  74 <DEFINE TIME-STR1 (NSEC "AUX" (NMIN </ <FIX .NSEC> 60>) (NHRS </ .NMIN 60>))
  75         #DECL ((NSEC) <OR FIX FLOAT> (NMIN NHRS) FIX (VALUE) STRING)
  76         <TIMEST1 .NHRS <- .NMIN <* .NHRS 60>> <- .NSEC <* .NMIN 60>>>>
  77
  78 <DEFINE TIME-DIF1 (D1 D2 T1 T2
  79                    "AUX" (DY
  80                           <- <DAYS <1 .D2> <2 .D2> <3 .D2>>
  81                              <DAYS <1 .D1> <2 .D1> <3 .D1>>>))
  82         #DECL ((D1 D2 T1 T2) <LIST FIX FIX FIX> (VALUE) STRING)
  83         <TIME-STR1 <- <+ <* .DY 3600 24>
  84                          <* <1 .T2> 3600>
  85                          <* <2 .T2> 60>
  86                          <3 .T2>>
  87                       <+ <* <1 .T1> 3600> <* <2 .T1> 60> <3 .T1>>>>>
  88
  89 <DEFINE TIMEST1 (HR MI SE)
  90    #DECL ((HR MI SE) FIX)
  91    <STRING
  92     <COND (<NOT <0? .HR>> <STRING <UNPARSE .HR> ":">) (ELSE "")>
  93     <COND (<OR <NOT <0? .MI>> <NOT <0? .HR>>>
  94            <STRING <COND (<L=? .MI 9>
  95                           <STRING <COND (<0? .HR> "") (ELSE "0")>
  96                                   <CHTYPE <+ .MI 48> CHARACTER>>)
  97                          (ELSE
  98                           <STRING <CHTYPE <+ </ .MI 10> 48> CHARACTER>
  99                                   <CHTYPE <+ <MOD .MI 10> 48> CHARACTER>>)>
 100                    ":">)
 101           (ELSE "")>
 102     <COND (<L=? .SE 9>
 103            <STRING <COND (<OR <NOT <0? .MI>> <NOT <0? .HR>>> "0") (ELSE "")>
 104                    <CHTYPE <+ .SE 48> CHARACTER>>)
 105           (ELSE
 106            <STRING <CHTYPE <+ </ .SE 10> 48> CHARACTER>
 107                    <CHTYPE <+ <MOD .SE 10> 48> CHARACTER>>)>>>
 108
 109 <ENDPACKAGE>