add datetime device
This commit is contained in:
parent
4022553dc0
commit
a59959bcd9
|
@ -0,0 +1,6 @@
|
|||
|100
|
||||
#c0 DEI #c1 DEI #c2 DEI #c3 DEI #010e DEO POP2 POP2
|
||||
#c4 DEI #c5 DEI #c6 DEI #c7 DEI #010e DEO POP2 POP2
|
||||
#c8 DEI #c9 DEI #ca DEI #cb DEI #010e DEO POP2 POP2
|
||||
#800f DEO BRK
|
||||
|
27
vm.scm
27
vm.scm
|
@ -7,7 +7,7 @@
|
|||
; === implementation-dependent functions; uncomment one stanza
|
||||
|
||||
; chicken scheme
|
||||
(import (chicken bitwise) (chicken process-context))
|
||||
(import (chicken bitwise) (chicken process-context) (chicken time posix))
|
||||
(define (get-u8 port)
|
||||
(let ((c (read-char port))) (if (eof-object? c) c (char->integer c))))
|
||||
(define (open-rom path) (open-input-file path #:binary))
|
||||
|
@ -182,7 +182,28 @@
|
|||
(_push2 (hilo->u16 hi lo)))
|
||||
(_push1 (_dei port)))))
|
||||
(define (_dei port)
|
||||
(u8 (vector-ref dev port)))
|
||||
(cond
|
||||
((= 4 port) (_push1 (+ (car wst) 1)))
|
||||
((= 5 port) (_push1 (+ (car rst) 1)))
|
||||
((and (<= 192 port) (< port 208)) (_datetime (- port 192)))
|
||||
(* (u8 (vector-ref dev port)))))
|
||||
|
||||
; (0:seconds 1:minutes 2:hours 3:mday 4:month 5:year 6:wday 7:yday 8:dstflag 9:timezone)
|
||||
(define (_datetime field)
|
||||
(u8 (let ((t (seconds->local-time)))
|
||||
(cond
|
||||
((= field 0) (u16->hi (+ 1900 (vector-ref t 5)))) ; year hi
|
||||
((= field 1) (u16->lo (+ 1900 (vector-ref t 5)))) ; year lo
|
||||
((= field 2) (vector-ref t 4)) ; month
|
||||
((= field 3) (vector-ref t 3)) ; day of month
|
||||
((= field 4) (vector-ref t 2)) ; hours
|
||||
((= field 5) (vector-ref t 1)) ; minutes
|
||||
((= field 6) (vector-ref t 0)) ; seconds
|
||||
((= field 7) (vector-ref t 6)) ; day of week
|
||||
((= field 8) (u16->hi (vector-ref t 7))) ; day of year hi
|
||||
((= field 9) (u16->lo (vector-ref t 7))) ; day of year lo
|
||||
((= field 10) (if (vector-ref t 8) 1 0)) ; is dst
|
||||
(* (vector-ref dev (+ 192 field))))))) ; device memory
|
||||
|
||||
; DEO base instruction implementation
|
||||
(define (deo-impl k)
|
||||
|
@ -196,6 +217,8 @@
|
|||
(define (_deo byte port)
|
||||
(vector-set! dev port (u8 byte))
|
||||
(cond
|
||||
((= 4 port) (set-car! wst byte))
|
||||
((= 5 port) (set-car! rst byte))
|
||||
((= 14 port) (debug))
|
||||
((= 24 port) (write-char (integer->char byte) (current-output-port)))
|
||||
((= 25 port) (write-char (integer->char byte) (current-error-port)))
|
||||
|
|
Loading…
Reference in New Issue