89 lines
2.6 KiB
Plaintext
89 lines
2.6 KiB
Plaintext
|
256 constant MAX_EVENTS
|
||
|
|
|
||
|
|
0
|
||
|
|
cell +field event.id
|
||
|
|
cell +field event.data
|
||
|
|
constant /EVENT
|
||
|
|
|
||
|
|
0
|
||
|
|
cell +field eventlink.next
|
||
|
|
/EVENT +field eventlink.event
|
||
|
|
constant /EVENTLINK
|
||
|
|
|
||
|
|
variable first-event
|
||
|
|
variable last-event
|
||
|
|
variable free-event
|
||
|
|
MAX_EVENTS /EVENTLINK * constant EVENTS_SIZE
|
||
|
|
create events EVENTS_SIZE allot
|
||
|
|
|
||
|
|
: (translate) ( index-u -- eventlink-addr )
|
||
|
|
/EVENTLINK * events + ;
|
||
|
|
: (link-to-next) ( index-u -- )
|
||
|
|
dup 1+ (translate) swap (translate) eventlink.next ! ;
|
||
|
|
: (fix-last-link) ( -- )
|
||
|
|
MAX_EVENTS 1- (translate) eventlink.next 0 swap ! ;
|
||
|
|
: (set-first-free) ( -- )
|
||
|
|
0 (translate) free-event ! ;
|
||
|
|
: (link-free) ( -- )
|
||
|
|
MAX_EVENTS 0 DO I (link-to-next) LOOP
|
||
|
|
(fix-last-link)
|
||
|
|
(set-first-free) ;
|
||
|
|
: (free-available?) ( -- flag )
|
||
|
|
free-event @ 0<> ;
|
||
|
|
: (assert-free-available) ( -- )
|
||
|
|
(free-available?) invert abort" no free eventlinks available." ;
|
||
|
|
: (next-free) ( -- eventlink-addr )
|
||
|
|
(assert-free-available)
|
||
|
|
free-event @ dup eventlink.next @ free-event ! ;
|
||
|
|
|
||
|
|
: events.clear ( -- )
|
||
|
|
0 first-event ! 0 last-event !
|
||
|
|
events EVENTS_SIZE erase
|
||
|
|
(link-free) ;
|
||
|
|
: (set-next-null) ( eventlink-addr -- )
|
||
|
|
dup eventlink.next 0 swap ! ;
|
||
|
|
: (first-event-exists?) ( -- flag ) first-event @ 0<> ;
|
||
|
|
: (last-event-exists?) ( -- flag ) last-event @ 0<> ;
|
||
|
|
: (as-first-event) ( eventlink-addr -- ) first-event ! ;
|
||
|
|
: (as-last-event) ( eventlink-addr -- ) last-event ! ;
|
||
|
|
: (after-last-event) ( eventlink-addr -- )
|
||
|
|
dup last-event @ eventlink.next !
|
||
|
|
last-event ! ;
|
||
|
|
: (append-event) ( eventlink-addr -- )
|
||
|
|
(set-next-null)
|
||
|
|
(first-event-exists?) invert IF
|
||
|
|
dup (as-first-event)
|
||
|
|
THEN
|
||
|
|
(last-event-exists?) IF
|
||
|
|
dup (after-last-event)
|
||
|
|
ELSE
|
||
|
|
dup (as-last-event)
|
||
|
|
THEN drop ;
|
||
|
|
: (set-eventdata) ( data-u id-u eventlink-addr -- )
|
||
|
|
eventlink.event tuck event.id ! event.data ! ;
|
||
|
|
: events.enqueue ( data-u id-u -- )
|
||
|
|
(next-free) dup >r (set-eventdata) r> (append-event) ;
|
||
|
|
: (get-eventdata) ( eventlink-addr -- data-u id-u )
|
||
|
|
eventlink.event dup event.data @ swap event.id @ ;
|
||
|
|
: (assert-first-exists) ( -- )
|
||
|
|
(first-event-exists?) invert abort" no events in queue" ;
|
||
|
|
: (check-first-and-last) ( -- )
|
||
|
|
first-event @ 0= IF
|
||
|
|
0 last-event !
|
||
|
|
THEN ;
|
||
|
|
: (get-first-event) ( -- eventlink-addr )
|
||
|
|
first-event @ ;
|
||
|
|
: (free-event) ( eventlink-addr -- )
|
||
|
|
dup eventlink.next free-event @ swap !
|
||
|
|
free-event ! ;
|
||
|
|
: (set-first-event-to-next) ( -- )
|
||
|
|
first-event @ eventlink.next @ first-event !
|
||
|
|
(check-first-and-last) ;
|
||
|
|
: events.dequeue ( -- data-u id-u )
|
||
|
|
(assert-first-exists) (get-first-event) (set-first-event-to-next)
|
||
|
|
dup (free-event) (get-eventdata) ;
|
||
|
|
: events.has-item? ( -- flag ) (first-event-exists?) ;
|
||
|
|
|
||
|
|
\ Clear events, initialize events array.
|
||
|
|
events.clear
|