[PATCH] Adds the get-time word to the dictionary. Used to obtain the current time.
The get-time word is a word that is used to obtain the current time. It is used on Apple's Open Firmware. signed-off-by: John Arbuckle <programmingkidx@gmail.com> --- forth/system/main.fs | 21 +++++++++++++++++++++ 1 files changed, 21 insertions(+), 0 deletions(-) diff --git a/forth/system/main.fs b/forth/system/main.fs index 122ab1f..6867cf3 100644 --- a/forth/system/main.fs +++ b/forth/system/main.fs @@ -58,3 +58,24 @@ variable DIAG-list outer-interpreter ; + +\ Returns the time ( -- second minute hour day month year ) +: get-time + " get-time" ( addr len ) + " rtc" open-dev ( addr len device ) + dup ( addr len device device ) + + 0= if \ if the real-time clock isn't available + cr + 3drop ( ) + true ( flag ) + abort" Sorry but get-time isn't available for your system. " + then + + dup ( addr len device device ) + >R ( addr len device ) ( R: device ) + $call-method ( addr len device -- ) ( R: device ) + R> ( device ) ( R: ) + close-dev ( device -- ) +; + -- 1.7.5.4
On 2012-Sep-23 13:26 , Programmingkid wrote:
+ +\ Returns the time ( -- second minute hour day month year ) +: get-time + " get-time" ( addr len ) + " rtc" open-dev ( addr len device ) + dup ( addr len device device ) + + 0= if \ if the real-time clock isn't available + cr + 3drop ( ) + true ( flag ) + abort" Sorry but get-time isn't available for your system. " + then + + dup ( addr len device device ) + >R ( addr len device ) ( R: device ) + $call-method ( addr len device -- ) ( R: device ) + R> ( device ) ( R: ) + close-dev ( device -- ) +; +
Coding comments... * Rather than using "addr len" on the stack to represent the pointer to " get-time", for short strings, we might actually put the string itself in the comments. E.g., rather than ( addr len device ), you might see ( "get-time" device ). Alternatively, $xxxx by convention represents the two-cell pointer to a text string, so you might see ( $get-time device ) as the stack comment. * But even better, rather than putting " get-time" on the stack at the top of the routine and having to carry it all the way down and play games with the stack, don't put it on the stack until you use it. Something like: : get-time " rtc" open-dev ( ihandle ) ?dup 0= if cr abort" Sorry but no rtc node is present on this system" then ( ihandle ) >r " get-time" r@ $call-method ( <returned args - 6 of em? Yikes > ) r> close-dev ( <returned args> ) ;
: get-time " rtc" open-dev ( ihandle ) ?dup 0= if cr abort" Sorry but no rtc node is present on this system" then ( ihandle )
r " get-time" r@ $call-method ( <returned args - 6 of em? Yikes > ) r> close-dev ( <returned args> ) ;
: get-time s" rtc" s" get-time" execute-device-method 0= ABORT" Sorry but no rtc node is present on this system" ; (note that ABORT" takes a flag as input), but better is : get-time s" rtc" s" get-time" execute-device-method 0= IF fake-some-sort-of-plausible-time-1970-or-so THEN ; which is pretty much what Apple's OF does. execute-device-method is not the same thing as open-dev followed by $call-method: it does not call "open" in the instance for the device itself (you only need that for devices that can have multiple clients at the same time and need to keep state for each client; or when instead you need to prevent concurrent access from multiple clients, by having the second open fail). Segher
participants (3)
-
Programmingkid -
Segher Boessenkool -
Tarl Neustaedter