* ------------------------------------------------------; * APPLY Fn calls; * ------------------------------------------------------; * APPLY oocodes: * Normal APPLY * Tail APPLY * MV APPLY * * Arg is set to: * Bit: 4 3 210 * MV Tail #Args * * Parameters: * Tos Number of Args * Tos-1 Function * Tos-2 Parameters *; * - Check # args & move to Arg of Tail Call Apply; Label_TailApplyFn OpLength_1 EUop_Or Tag_Int Raddr_Tos RD2addr_MuxRead MuxRead_K K_8 NewArg_MuxWrite MuxWrite_RBus DPCCode_D1=Int<8 JumpF_AFnUdf; * - Set IVars to Nil of Tail Apply; EUop_D1 Tag_D1 RD1addr_Nil RD2addr_TosWord Waddr_IVar Misc_WriteOctal DPCCode_MVokD2 JumpF_AFn1; * - Set Multiple Value Flag into Arg; EUop_Or RD1addr_MuxRead MuxRead_Arg RD2addr_MVArgBit NewArg_MuxWrite MuxWrite_RBus JumpT_AFn1; * - Check # args & move to Arg of Normal Applys; Label_ApplyFn OpLength_1 EUop_D1 Tag_Int Raddr_Tos NewArg_MuxWrite MuxWrite_RBus DPCCode_D1=Int<8 JumpT_AFn0 JumpF_AFnUdf; Label_MVApplyFn OpLength_1 EUop_Or Tag_Int Raddr_Tos RD2addr_MuxRead MuxRead_K K_16 NewArg_MuxWrite MuxWrite_RBus DPCCode_D1=Int<8 JumpT_AFn0 JumpF_AFnUdf; Label_ApplyWMvFn OpLength_1 EUop_D1 Tag_Int Raddr_Tos NewArg_MuxWrite MuxWrite_RBus DPCCode_D1=Int<8 JumpF_AFnUdf; RD2addr_TosWord DPCCode_MVokD2 JumpF_AFn0; EUop_Or RD1addr_MuxRead MuxRead_Arg RD2addr_MVArgBit NewArg_MuxWrite MuxWrite_RBus JumpT_Afn0; * - Set IVars to Nil of NewFrame Applys; Label_AFn0 EUop_D2 Tag_D2 RD2addr_Nil Waddr_IVar WCxt AltCxt_Top+1 Misc_WriteOctal * - Determine Type of Call from info on Stack; Label_AFn1 EUop_D1 Tag_D2 Dswap Raddr_Tos RD2addr_Raddr-1 W2addr_Temp1 NewArg2_MuxWrite MuxWrite_D2 Waddr_CodeSlot WCxt AltCxt_Top+1 DPCCode_CCodeP WriteT JumpT_AFn6; RD1addr_Temp1 DPCCode_SymbolP JumpT_AFn5; RD1addr_Temp1 DPCCode_MethodP JumpT_AMethodCall; RD1addr_Temp1 DPCCode_ClosureP JumpT_AClosureCall; * - Symbol Call: Read Definition Cell; Label_AFn5 Cycle_R40 PFA MemOffset RD1addr_Temp1 MuxRead_K K_DefCellOffset W2addr_Temp1 Waddr_CodeSlot WCxt AltCxt_Top+1 JumpF_AFn1; * - CCodeP Call: Set Code Slot, Check for Tail Call; Label_AFn6 Aside EUop_D1 Tag_D1 RD1addr_Temp1 Waddr_CodeSlot WCxt AltCxt_Top+1 JumpT_AFn6 MuxCCode_ArgTailBit JumpT_ATailCall; * - Read SP & flag word of function definition header; Label_AFn7 Cycle_R40 MemOffset PFT RD1addr_Temp1 MuxRead_K K_FnHeaderOffset W2addr_TosWord/Arg WCxt AltCxt_Top+1 NewArg2_Arg2' Arg2'_Arg2+2 UpdatePc UpdateBs DPCCode_CCodeP WriteT JumpF_AFnUdf; * - Set the Pc of the new frame's Pc + # Args; Cycle_R40 MemOffset RD1addr_Temp1 MuxRead_Arg2 W2addr_PC WCxt AltCxt_Top+1 NewArg_Arg' Arg'_Arg<3> NewArg2_MuxWrite MuxWrite_Tos NewTos_Tos' Tos'_Tos-Arg<3> Misc_OpLength=0; * - Setup Arg2 & Tos; NewArg_Arg' Arg'_Arg-1 NewTos_Tos' Tos'_Tos-2 NewArg2_Arg2' Arg2'_Arg2-2 NewTopCxt MuxCCode_Arg=0 JumpT_Done; * - Copy the paramaters (# parms in Arg)....not decrementing TOS!!!; EUop_D1 Tag_D1 Raddr_Arg2 RCxt AltCxt_Top-1 Waddr_Arg NewArg2_Arg2' Arg2'_Arg2-1 NewArg_Arg' Arg'_Arg-1 MuxCCode_Arg#0 JumpT_Rpt JumpF_Done; * ------------------------------------------------------; * Undefined ApplyFn Other Fn call types; * ------------------------------------------------------; Label_AFnUdf Aside EUop_D1 Tag_D1 Raddr_UnDefFn RCxt AltCxt_Global W2addr_Temp1; Cycle_R40 RD1addr_Temp1 WCxt AltCxt_Top+1 Waddr_CodeSlot; EUop_D1 Tag_Int Raddr_Tos Waddr_UnDefnSlot+1 WCxt AltCxt_Top+1 NewTos_Tos' Tos'_Tos-1; EUop_D1 Tag_D1 Raddr_Tos Waddr_UnDefnSlot WCxt AltCxt_Top+1 NewTos_Tos' Tos'_Tos-1 JumpT_Fn1; * ------------------------------------------------------; * Apply Tail Function Calls that re-use current frame; * ------------------------------------------------------; Label_ATailCall Aside * - Set the Code Pointer; EUop_D1 Tag_D1 RD1addr_Temp1 Waddr_CodeSlot NewArg2_Arg2' Arg2'_Arg2+2; * - Set the Pc of the new frame's Pc + # Args; Cycle_R40 MemOffset RD1addr_Temp1 MuxRead_Arg2 W2addr_PC NewArg2_MuxWrite MuxWrite_Tos Misc_OpLength=0; * - Read SP & flag word of function definition header; Cycle_R40 MemOffset RD1addr_Temp1 MuxRead_K K_FnHeaderOffset NewArg_Arg' Arg'_Arg<3> NewArg2_Arg2' Arg2'_Arg2-2 W2addr_TosWord/Arg; * - Set Arg / NewArg; NewArg_Arg' Arg'_Arg-1 MuxCCode_Arg=0 JumpT_Done; * - Copy the paramaters (# parms in Arg)....not decrementing TOS!!!; EUop_D1 Tag_D1 Raddr_Arg2 Waddr_Arg NewArg2_Arg2' Arg2'_Arg2-1 NewArg_Arg' Arg'_Arg-1 MuxCCode_Arg#0 JumpT_Rpt JumpF_Done; * ------------------------------------------------------; * Apply Method calls; * ------------------------------------------------------; * - Get index of 1st parm; Label_AMethodCall EUop_D1 Tag_Int RD1addr_MuxRead MuxRead_Tos Waddr_RTmp3 WCxt AltCxt_Global NewArg2_MuxWrite MuxWrite_Tos' Tos'_Tos-Arg<3>; EUop_- Tag_Int Raddr_RTmp3 RCxt AltCxt_Global RD2addr_MuxRead MuxRead_K K_2 * - Save Arg in RTmp4 EUop_D1 Tag_Int RD1addr_MuxRead MuxRead_Arg Waddr_RTmp4 RCxt AltCxt_Global; NewArg2_Arg2' Arg2'_Arg2-2; Label_AMcLoop Raddr_RTmp3 RCxt AltCxt_Global RD2addr_MuxRead MuxRead_Arg2 DPCCode_D1=D2 JumpT_AMcUfn; EUop_+ Tag_D1 RD1addr_Temp1 RD2addr_MuxRead MuxRead_K K_MethodTableDisp Waddr_RTmp2 WCxt AltCxt_Global NewArg2_Arg2' Arg2'_Arg2-1 MuxCCode_Arg2=Tos JumpT_AMcUfn; * - Save Arg in RTmp4 EUop_D1 Tag_Int RD1addr_MuxRead MuxRead_Arg Waddr_RTmp4 RCxt AltCxt_Global; * - Find the Wrapper for the object, index type table EUop_TypeBits Tag_Int Raddr_Arg2 MuxWrite_RBus Arg_MuxWrite; Cycle_R40 MemOffset PFA Raddr_WrapperTable RCxt MuxRead_Arg Waddr_RTmp1 WCxt AltCxt_Global ResultCCode_Zero JumpF_Mc5; Cycle_R40 MemOffset PFA Raddr_Arg2 MuxRead_K K_WrapperOffset Waddr_RTmp1 WCxt AltCxt_Global; * - Mask Wrapper to get table offset; Label_AMc5 EUop_And Tag_Int Raddr_RTmp1 RCxt AltCxt_Global RD2addr_MuxRead MuxRead_K K_30 NewArg_MuxWrite MuxWrite_RBus; Cycle_R40 MemOffset Raddr_RTmp2 RCxt AltCxt_Global MuxRead_Arg W2addr_Temp1 NewArg_Arg' Arg'_Arg+1; * - Check for a Match; Raddr_RTmp1 RCxt AltCxt_Global RD2addr_Temp1 NewArg_Arg' Arg'_Arg+1 DPCCode_D1=D2 JumpT_AMcMatch; * - Look into Overflow Table, get displacement to overflow table; NewArg_MuxWrite MuxWrite_K K_MethodWordHashLength; * - Compare entry; Label_AMcLp Bside Cycle_R40 MemOffset Raddr_RTmp1 RCxt AltCxt_Global MuxRead_Arg W2addr_Temp1 NewArg_Arg' Arg'_Arg+1 ResultCCode_Zero JumpT_AMcUfn; * - Check for a Match; Raddr_RTmp1 RCxt AltCxt_Global RD2addr_Temp1 NewArg_Arg' Arg'_Arg+1 DPCCode_D1=D2 JumpT_AMcMatch JumpF_AMcLp; Label_AMcMatch Aside Cycle_R40 MemOffset RD1addr_Mar MuxRead_K K_1 W2addr_Temp1 Waddr_CodeSlot WCxt AltCxt_Top+1; * - Test for another class match, Restore Arg EUop_D1 Tag_Int Raddr_RTmp4 RCxt AltCxt_Global RD1addr_Temp1 NewArg_MuxWrite MuxWrite_D2 Waddr_RTmp1 WCxt AltCxt_Global DPCCode_MethodP JumpT_AMcLoop JumpF_AFn1; * ------------------------------------------------------; * Closure Calls; * ------------------------------------------------------; * - Normal Closure, put environment in PVar slot; * * * NEED APPLY TAIL CLOSURES TOO ; Label_AClosureCall Cycle_R40 PFA MemOffset RD1addr_Temp1 MuxRead_K K_ClosureEnvOffset Waddr_ClosureEnvSlot WCxt AltCxt_Top+1 * - Get the code pointer; Cycle_R40 MemOffset RD1addr_Temp1 MuxRead_K K_ClosureCodeOffset Waddr_RTmp1 WCxt AltCxt_Top+1 W2addr_Temp1 JumpT_AFn1; GACHA?1(DEFAULTFONT 1 (GACHA 10) (GACHA 8) (TERMINAL 8)) JJzē