4 <ENTRY COMPILE COMP2 PEEP-ENABLED FIXUP-DEATH-ENABLED UPDATE-STATUS STATUS-LINE>
6 <USE "COMPDEC" "PASS1" "SYMANA" "ADVMESS" "CODGEN" "PEEP" "DEATH">
12 <SETG FIXUP-DEATH-ENABLED T>
14 "****** TOP LEVEL COMILER CALLS ******"
16 "COMPILE -- compile one function.
18 The arguments to compile are:
20 FCN -- an atom whose GVAL is a function
22 CAREFUL -- If true compile bounds checking else don't.
24 REASONABLE -- Assume reasonable calling sequence?
26 ANALY-OK -- If true, do hairy analysis.
28 VERBOSE -- Print debugginh messages.
32 "OPTIONAL" (CAREFUL T) (REASONABLE T) (ANALY-OK T)
34 "AUX" (IND (1)) (VP (())) FCNP FCNN (GLOSP <>) (TAG-COUNT 0)
36 <COND (<ASSIGNED? EXTRA-CODE-START> .EXTRA-CODE-START)
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>
51 <TYPE? <SET FCNP <1 .FCNP>> FUNCTION>>>>>
52 <COMPILE-ERROR "Not a function: " .FCN>)>
53 <COND (,STATUS-LINE <UPDATE-STATUS "Comp" <SPNAME .FCN> "PS1" <>>)>
57 <SET FCNN <PASS1 .FCN .FCNP>>
58 <COND (,STATUS-LINE <UPDATE-STATUS "Comp" <> "ANA" <>>)>
60 <COND (,STATUS-LINE <UPDATE-STATUS "Comp" <> "GEN" <>>)>
61 <COND (.VERBOSE <ANA-MESS .VP>)>
62 <SET CL <CODE-GEN .FCNN .EXTRA-CODE>>
64 <COND (<AND <GASSIGNED? FIXUP-DEATH-ENABLED> ,FIXUP-DEATH-ENABLED>
66 <COND (<AND <GASSIGNED? PEEP-ENABLED> ,PEEP-ENABLED>
67 <COND (,STATUS-LINE <UPDATE-STATUS "Comp" <> "PEEP" <>>)>
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>>
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>>>>
78 <DEFINE TIME-DIF1 (D1 D2 T1 T2
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>
87 <+ <* <1 .T1> 3600> <* <2 .T1> 60> <3 .T1>>>>>
89 <DEFINE TIMEST1 (HR MI SE)
90 #DECL ((HR MI SE) FIX)
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>>)
98 <STRING <CHTYPE <+ </ .MI 10> 48> CHARACTER>
99 <CHTYPE <+ <MOD .MI 10> 48> CHARACTER>>)>
103 <STRING <COND (<OR <NOT <0? .MI>> <NOT <0? .HR>>> "0") (ELSE "")>
104 <CHTYPE <+ .SE 48> CHARACTER>>)
106 <STRING <CHTYPE <+ </ .SE 10> 48> CHARACTER>
107 <CHTYPE <+ <MOD .SE 10> 48> CHARACTER>>)>>>