Commits

Cliff Biffle committed bf439b9

More time improvements:
- Added !TIME for setting the time.
- Rearranged .TIME's output to match !TIME's argument order.
- System now prints time/date on startup.

  • Participants
  • Parent commits c2a2378

Comments (0)

Files changed (1)

 2:        XT DROP
           XT EXIT
 
+@ : !TIME  ( year month day hour minute second -- )
+@  \ Prepare wall-time value and stash it
+@  SWAP  255 AND  8 LSHIFT  OR
+@  SWAP  255 AND 16 LSHIFT  OR   >R
+@  \ Prepare calendar-date
+@                 1-
+@  SWAP   255 AND 1- 8 LSHIFT  OR
+@  SWAP 65535 AND   16 LSHIFT  OR
+@  \ Set!
+@  R>  3 SVC  DROP 2DROP ;
+def tBANGTIME, "!TIME"
+          @ Prepare wall-time value and stash it
+          XT SWAP
+          LIT 255
+          XT AND
+          LIT 8
+          XT LSHIFT
+          XT OR
+
+          XT SWAP
+          LIT 255
+          XT AND
+          LIT 16
+          XT LSHIFT
+          XT OR
+
+          XT GREATERR
+
+          @ Prepare calendar-date
+          XT 1MINUS
+
+          XT SWAP
+          LIT 255
+          XT AND
+          XT 1MINUS
+          LIT 8
+          XT LSHIFT
+          XT OR
+
+          XT SWAP
+          LIT 65535
+          XT AND
+          LIT 16
+          XT LSHIFT
+          XT OR
+
+          @ Set!
+          XT RGREATER
+          LIT 3
+          XT SVC
+          XT DROP
+          XT 2DROP
+          XT EXIT
+
 @ : .TIME  0 0 2 SVC  DROP  ( calendar-date wall-time )
+@  SWAP
+@  DUP  16 RSHIFT               4 U.R  [CHAR] - EMIT
+@  DUP   8 RSHIFT  255 AND  1+  1 U.R  [CHAR] - EMIT
+@                  255 AND  1+  1 U.R  SPACE
 @  DUP  16 RSHIFT  255 AND      2 U.R  [CHAR] : EMIT
 @  DUP   8 RSHIFT  255 AND      2 U.R  [CHAR] : EMIT
-@                  255 AND      2 U.R  SPACE
-@  DUP  16 RSHIFT               4 U.R  [CHAR] - EMIT
-@  DUP   8 RSHIFT  255 AND  1+  1 U.R  [CHAR] - EMIT
-@                  255 AND  1+  1 U.R  SPACE ;
+@                  255 AND      2 U.R  SPACE ;
 def t.TIME, ".TIME"
           LIT 0
           XT DUP
           XT SVC
           XT DROP
 
-          XT DUP
-          LIT 16
-          XT RSHIFT
-          LIT 255
-          XT AND
-          LIT 2
-          XT U.R
-          LIT ':'
-          XT EMIT
-
-          XT DUP
-          LIT 8
-          XT RSHIFT
-          LIT 255
-          XT AND
-          LIT 2
-          XT U.R
-          LIT ':'
-          XT EMIT
-
-          LIT 255
-          XT AND
-          LIT 2
-          XT U.R
-          XT SPACE
+          XT SWAP
 
           XT DUP
           LIT 16
           XT U.R
           XT SPACE
 
+          XT DUP
+          LIT 16
+          XT RSHIFT
+          LIT 255
+          XT AND
+          LIT 2
+          XT U.R
+          LIT ':'
+          XT EMIT
+
+          XT DUP
+          LIT 8
+          XT RSHIFT
+          LIT 255
+          XT AND
+          LIT 2
+          XT U.R
+          LIT ':'
+          XT EMIT
+
+          LIT 255
+          XT AND
+          LIT 2
+          XT U.R
+          XT SPACE
+
           XT EXIT
 
 @ ---- block words
 last_kernel_lfa:
 def tSAMPLE, "SAMPLE"
           XT PAREN.QUOTETHESIS
-          .hword 13
-          .ascii "B3Forth READY"
+          .hword 15
+          .ascii "B3Forth READY  "
           .p2align 2
+          XT .TIME
           XT CR
 
           XT SP