5 <USE "PASS1" "CHKDCL" "COMPDEC" "ADVMESS">
8 "AUX" (NAME <1 .OB>) TT ITRF OBJ (RQRG 0)
9 (LN <LENGTH <SET OBJ <REST .OB>>>) FINALF TAPL (APL ())
10 (DCL #DECL ()) (ARGL ()) (HATOM <>) (NN 0) TEM L2 L3
12 #DECL ((OBJ OB) <PRIMTYPE LIST> (LN NN) FIX
13 (DCL) DECL (ARGL APL) LIST (ITRF FINALF TT) NODE
14 (TRG RQRG) <SPECIAL FIX>)
16 <AND <SEG? <REST .OBJ>>
18 <VMESS "MAPF/MAPR cannot be open compiled due to SEGMENT."
20 <RETURN <PSUBR-C .OB .AP>>>
22 <MESSAGE ERROR "TOO FEW ARGS TO " .NAME .OBJ>>
23 <SET TT <NODEFM ,MAP-CODE .PARENT <> .NAME () .AP>>
24 <SET FINALF <PCOMP <1 .OBJ> .TT>>
26 (<OR <TYPE? <SET TAPL <2 .OBJ>> FUNCTION>
27 <AND <TYPE? .TAPL FORM>
28 <NOT <EMPTY? <SET APL <CHTYPE .TAPL LIST>>>>
29 <TYPE? <SET TEM <1 .APL>> ATOM>
32 <SET TAPL <REST .APL>>>>
33 <AND <EMPTY? <SET APL <CHTYPE .TAPL LIST>>>
34 <MESSAGE ERROR "EMPTY FUNCTION IN MAPF " .OBJ>>
35 <AND <TYPE? <1 .APL> ATOM>
37 <SET APL <REST .APL>>>
39 <MESSAGE ERROR "MAPF FUNCTION HAS NO ARG LIST " .OBJ>>
41 <REPEAT ((I <+ <LENGTH <REST .OBJ 2>> 1>))
42 <COND (<L? <SET I <- .I 1>> 0> <RETURN>)>
43 <SET ARGL (DUMMY-MAPF !.ARGL)>>
45 <AND <NOT <EMPTY? .APL>>
48 <SET APL <REST .APL>>>
50 <MESSAGE ERROR "MAPF FUNCTION HAS NO BODY " .OBJ>>
51 <PROG ((VARTBL .VARTBL)) #DECL ((VARTBL) <SPECIAL SYMTAB>)
55 <OR <FIND:DECL VALUE .DCL> ANY>
59 <2 <GEN-D .ARGL .DCL .HATOM <>>>
63 (<ACT-FIX .ITRF <BINDING-STRUCTURE .ITRF>>
68 <REPEAT ((L <BINDING-STRUCTURE .ITRF>) (LL .L) (L1 .L) SYM)
69 #DECL ((L L1 LL) <LIST [REST SYMTAB]>)
70 <AND <EMPTY? .L> <RETURN .L1>>
71 <COND (<==? <CODE-SYM <SET SYM <1 .L>>> 1>
72 <SET L2 ("ACT" <NAME-SYM .SYM> !.L2)>
75 <COND (<SPEC-SYM .SYM>
76 <FORM SPECIAL <1 <DECL-SYM .SYM>>>)
78 <FORM UNSPECIAL <1 <DECL-SYM .SYM>>>)>
80 <COND (<==? .L .L1> <SET L1 <REST .L1>>)
81 (ELSE <PUTREST .LL <REST .L>>)>)>
82 <SET L <REST <SET LL .L>>>>>
83 <SET APL (<FORM PROG .L2 <CHTYPE .L3 DECL> !.APL>)>)>
86 <MAPF ,LIST <FUNCTION (O) <PCOMP .O .ITRF>> .APL>>>)
87 (<OR <AND <TYPE? .TAPL FIX> <==? .LN 3>>
88 <AND <TYPE? .TAPL FORM>
89 <==? <LENGTH <SET APL <CHTYPE .TAPL LIST>>> 2>
90 <TYPE? <SET TEM <1 .APL>> ATOM>
92 <TYPE? <SET TEM <2 .APL>> ATOM>
94 <OR <NOT <TYPE? ,.TEM FUNCTION>>
96 <AND <TYPE? .FCNS LIST> <MEMQ .TEM .FCNS>>>>>
97 <PUT .IND PTHIS-OBJECT ,PMARGS>
99 <COND (<TYPE? .TAPL FIX> <PCOMP <FORM NTH .IND .TAPL> .TT>)
101 <PCOMP <FORM <2 .APL> !<ILIST <- .LN 2> '.IND>> .TT>)>>
102 <PUT .IND PTHIS-OBJECT>
106 <AND <==? <NODE-TYPE .N> ,MARGS-CODE>
107 <PUT .N ,NODE-NAME <SET NN <+ .NN 1>>>>>
109 <SET ITRF <NODEFM ,MPSBR-CODE .TT <> <> (.ITRF) <>>>)
110 (ELSE <SET ITRF <PCOMP .TAPL .TT>>)>
115 !<MAPF ,LIST <FUNCTION (O) <PCOMP .O .TT>> <REST .OBJ 2>>)>
120 <DEFINE PMARGS (O) #DECL ((VALUE) NODE) <NODEFM ,MARGS-CODE .PARENT <> <> () <>>>
122 <PUT ,MAPF PAPPLY-OBJECT ,PMAPF-R>
124 <PUT ,MAPR PAPPLY-OBJECT ,PMAPF-R>