cvsuser 03/11/03 10:31:52
Modified: languages/forth forth.pasm forth.pod
Log:
Provide the export word, so we can export Forth words to any parrot language
Revision Changes Path
1.37 +19 -4 parrot/languages/forth/forth.pasm
Index: forth.pasm
===================================================================
RCS file: /cvs/public/parrot/languages/forth/forth.pasm,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -w -r1.36 -r1.37
--- forth.pasm 3 Nov 2003 16:34:57 -0000 1.36
+++ forth.pasm 3 Nov 2003 18:31:52 -0000 1.37
@@ -704,6 +704,8 @@
.AddCoreOp(Get_Params, "getparams")
.AddCoreOp(Get_Time, "curtime")
+ .AddCoreOp(Export_Word, "export")
+
ret
#------------------------------------------------------------------------------
@@ -1568,6 +1570,17 @@
save .PMCStack
.DoneInterpretWord
+Export_Word:
+ .PopStr
+ .PopInt
+ new .TempPMC, .Sub
+ set_addr .Temp_PMC, .TempInt
+ new .TempPMC2, .Integer
+ set .TempPMC2, .IntStack
+ setprop .TempPMC, "__forth_spot", .TempPMC2
+ store_global .StrStack, .TempPMC
+ .DoneInterpretWord
+
DoneInterpretWord:
ret
@@ -1946,6 +1959,10 @@
ExternalEntry:
save P1
+ # Figure out where we're supposed to go, while we still have free PMCs
+ getprop P16, "__forth_spot", P0
+ set .TempInt, P16
+
find_global .CoreOps, "__forth::CoreOps"
find_global .UserOps, "__forth::UserOps"
find_global .SpecialWords, "__forth::SpecialWords"
@@ -1956,9 +1973,7 @@
find_global .CellPMC, "__forth::CellArray"
find_global .LabelStack, "__forth::LabelStack"
-# Magic happens
-
-
+ bsr .TempInt
restore P0
invoke
1.3 +8 -0 parrot/languages/forth/forth.pod
Index: forth.pod
===================================================================
RCS file: /cvs/public/parrot/languages/forth/forth.pod,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -w -r1.2 -r1.3
--- forth.pod 31 Oct 2003 15:10:09 -0000 1.2
+++ forth.pod 3 Nov 2003 18:31:52 -0000 1.3
@@ -241,6 +241,14 @@
properly handling the potential for the parameters to come in without
prototyping. The top word on the stack is the parameter count.
+=item export ( xt s -- )
+
+Export execution token XT as name S, in the global parrot namespace. S
+should be a parrot string, and fully qualified. This word will be
+called with registers set as per Parrot's calling conventions, so
+should decode the registers as need be to get its parameters in a
+Forth-like state.
+
=back
=head1 CREDITS
