\ vandys
\ cons.f
\ VGA text console driver in Forth
\
only
drivers definitions \ Stash all this in driver namespace
also os
NSCREEN constant NSCREEN \ # virtual screens supported
CONS_COLS constant CONS_COLS \ Columns on display
CONS_COLS 1- constant CONS_COLS-1
CONS_ROWS constant CONS_ROWS \ Rows on display
RAM_SIZE constant RAM_SIZE \ Words on display
RAM_BYTES constant RAM_BYTES \ Bytes on display
3 constant CHAR_INTR \ Interrupt char (^C)
$3D4 constant GDC_REG \ I/O ports to control cursor hardware
$3D5 constant GDC_VAL
$B8000 constant TVRAM \ Mapped screen memory
\ vandys
create cur_attr 7 8 lshift ,
$0720 constant BLWORD
variable cur_col variable cur_row
variable cursor_moved
variable scrollCount
80 dup constant #TTYQ create ttyq allot create nttyq 0 ,
SCRMEM constant SCRMEM \ # bytes of state per screen
create screens \ Per-screen state
SCRMEM NSCREEN * allot
\ 0: Current display pointer (either virtual or HW address)
\ 4: row
\ 8: col
\ 12: attr
\ 16: scroll count
\ 20: <reserved>
\ 24: RAM_BYTES bytes of screen image storage
\ vandys
\ Get pointer to screen state
: >scrptr ( u -- a ) SCRMEM * screens + ;
\ Convert pointer to screen state into pointer to hardware buffer memory
: >scrhw ( a -- a' ) 6 cells + ;
\ Point to TTY channel USER variable
: >ttchan ttchan up @ - + ;
variable SCR \ Base address of screen memory
variable SCRrow1 \ ...address of 2nd line of screen
variable SCRrow24 \ ...of start of last line
variable SCRrow25 \ ...of last line
variable cur_hw \ Screen # displayed on physical screen
variable cur_chan \ Screen # currently set on SCR
\ Amount of memory to scroll up with move
CONS_ROWS 1- dup constant CONS_ROWS-1
CONS_COLS * 2* constant SCRscrollsize
\ vandys
: set_screenmem ( a -- ) dup CONS_COLS 2* + SCRrow1 !
dup SCRscrollsize + dup SCRrow24 ! CONS_COLS 2* + SCRrow25 ! SCR ! ;
: gdc! ( val gdcreg -- ) GDC_REG outb GDC_VAL outb ;
: cursor_pos ( -- )
cursor_moved off
cur_row @ CONS_COLS * cur_col @ +
dup 8 rshift $E gdc! $F gdc! ;
: on_hw? ( -- ? ) ttchan @ cur_hw @ = ;
\ vandys
: (scroll_up) ( -- )
SCRrow1 @ SCR @ SCRscrollsize move
SCRrow25 @ SCRrow24 @ do BLWORD i w! 2 +loop ;
: check_intr ( -- ) nttyq @ if ttyq c@ CHAR_INTR = if
handler @ if nttyq off 1 abort" Interrupt" then then then ;
: scroll_up ( -- ) scrollCount @ CONS_ROWS < if
(scroll_up) exit then
nttyq @ if (scroll_up) exit then
CONS_COLS-1 cur_col !
begin pause on_hw? dup if cursor_pos then
nttyq @ 0<> and until (scroll_up)
cur_col off cursor_moved on
scrollCount off check_intr nttyq off ;
: consput ( c -- )
cur_attr @ +
SCR @ cur_row @ CONS_COLS * cur_col @ + 2* + w! ;
\ vandys
: (cons_fwd) ( -- ) cur_col inc cur_col @ CONS_COLS < if exit then
cur_col off cur_row inc scrollCount inc
cur_row @ CONS_ROWS < if exit then
cur_row dec scroll_up ;
: (cons_putc) ( c -- ) consput (cons_fwd) ;
: cons_putc ( c -- )
on_hw? if cursor_moved on then
dup 31 > over 128 < and if (cons_putc) exit then
\ vandys
dup 9 = if drop
begin 32 recurse cur_col @ 8 mod 0= until exit then
dup 13 = if drop 0 cur_col ! exit then
dup 10 = if drop cur_row inc scrollCount inc
cur_row @ CONS_ROWS >= if cur_row dec scroll_up then
exit then
\ vandys
dup 8 = if drop cur_col @ 0 > if cur_col dec
else cur_row @ if cur_row dec CONS_COLS 1- cur_col !
then then
exit then
\ Unknown control char
drop ;
\ vandys
: blank_page ( a -- ) RAM_SIZE 0 do BLWORD over i 2* + w! loop drop ;
: cons_page ( -- ) SCR @ blank_page
cur_col off cur_row off cursor_moved on ;
: cons_xy ( row col -- ) cur_col ! cur_row !
scrollCount off cursor_moved on ;
: cons_attr ( ? -- ) if $7000 else $700 then cur_attr ! ;
: cons_blot ( -- ) SCR @ cur_row @ CONS_COLS * cur_col @ + 2* +
CONS_COLS cur_col @ - 0 do BLWORD over w! 2 + loop drop ;
: cons_putpage ( a -- )
SCR @ RAM_SIZE 0 do over c@ $700 + over w! 2+ swap 1+ swap
loop 2drop ;
\ vandys
\ Ports for PC keyboard
$61 constant KBD_CTL
$60 constant KBD_DATA
$64 constant KBD_STATUS
\ vandys
\ Mapping from key position to ASCII
\ Un-shifted mapping of PC scancodes to ASCII
create key_map
0 c, 27 c, ,chars 1234567890-= 8 c, 9 c,
,chars qwertyuiop[] 13 c, $80 c,
,chars asdfghjkl; 39 c, 96 c, $80 c,
92 c, ,chars zxcvbnm,./ $80 c,
char * c, $80 c, 32 c, 23 pad80 char 0 c, 127 c,
\ Shifted mapping of PC scancodes to ASCII
create shift_map
0 c, 27 c, ,chars !@#$%^&*()_+ 8 c, 9 c,
,chars QWERTYUIOP{} 13 c, $80 c,
,chars ASDFGHJKL: 34 c, char ~ c, $80 c,
,chars |ZXCVBNM<>? $80 c,
42 c, $80 c, 32 c, 13 pad80 ,chars 789 $80 c,
,chars 456 $80 c, ,chars 1230 127 c,
align
\ vandys
variable conshift variable conctrl
: set_chan ( u -- )
cur_chan @ 2dup = if 2drop exit then
>scrptr SCR @ over !
cell+ cur_row @ over ! cell+ cur_col @ over !
cell+ cur_attr @ over ! cell+ scrollCount @ swap !
dup cur_chan ! >scrptr dup @ set_screenmem
cell+ dup @ cur_row ! cell+ dup @ cur_col !
cell+ dup @ cur_attr ! cell+ @ scrollCount ! ;
\ vandys
: set_hw ( u-newchan -- )
dup NSCREEN u< not if drop exit then
dup cur_hw @ = if drop exit then
'pause @ 0= if drop exit then
dup set_chan
TVRAM cur_hw @ >scrptr dup >r >scrhw RAM_BYTES cmove
r> dup >scrhw swap !
( newchan )
\ vandys
( newchan ) dup cur_hw !
>scrptr dup >r >scrhw TVRAM RAM_BYTES cmove
r> TVRAM swap !
TVRAM set_screenmem cursor_moved on ;
\ vandys
\ Get next character typed on PC keyboard
: (cons_getc) ( -- c T | F )
\ vandys
0 begin
drop \ Char from previous time around
\ Strobe enable on keyboard
KBD_CTL inb dup $7F and KBD_CTL outb
dup $80 or KBD_CTL outb
$7F and KBD_CTL outb
\ Return FALSE if no data available
KBD_STATUS inb 1 and 0= if false exit then
\ Read next byte of data
KBD_DATA inb
\ F1..F10 select screens (TBD... require ALT-Fx?)
dup 59 >= over 68 <= and if 59 - set_hw false exit then
\ Shift pressed?
dup $36 = over $2A = or if 1 conshift ! drop $80 then
\ vandys
\ Shift released?
dup $B6 = over $AA = or if 0 conshift ! drop $80 then
\ Ctrl pressed?
dup $1D = if 1 conctrl ! drop $80 then
\ Ctrl released?
dup $9D = if 0 conctrl ! drop $80 then
\ Iterate until actual data key
dup 58 < until
\ Trim to 7-bit ASCII, look up character in keyboard map
$7F and conshift @ if shift_map else key_map then + c@
\ Control key?
conctrl @ if $1F and then
true \ Return flag that we have the data
;
\ vandys
: bad_cons_op 1 abort" Bad console operation" ;
: cons_q ( c -- ) nttyq @ #TTYQ >= if drop exit then
nttyq @ ttyq + c! nttyq inc ;
: cons_deq ( -- c ) ttyq c@ nttyq @ dup 0= abort" Empty" 1- nttyq !
ttyq dup 1+ swap nttyq @ move ;
: cons_watcher ( -- ) begin (cons_getc) if
dup CHAR_INTR = if ttyq c! 1 nttyq ! else cons_q then
scrollCount off
then pause again ;
: cons_getc ( -- c T | F ) on_hw? not if false exit then
cursor_moved @ if cursor_pos then
nttyq @ 0= if false exit then
check_intr cons_deq true ;
: cons_op ( op -- ... )
dup 2 = if drop pause cons_getc exit then
ttchan @ cur_chan @ <> if ttchan @ set_chan then
\ vandys
\ Dispatch request
(exec:)
( 0: ) bad_cons_op
( 1: ) cons_putc
( 2: ) nop ( cons_getc is handled above as a special case )
( 3: ) cons_page
( 4: ) cons_xy
( 5: ) cons_blot
( 6: ) cons_attr
( 7: ) nop ( was initialize--obsolete )
( 8: ) cons_putpage
;
\ vandys
initialize definitions os
: boot-cons ( ? -- n | )
0= if 400 exit then
['] cons_op 'ttyops !
$4D 10 gdc! $0F 11 gdc!
0 dup cur_chan ! cur_hw !
cold? if
fork ?dup 0= if cons_watcher else setrun then then
NSCREEN 0 do i >scrptr
\ vandys
i 0= if TVRAM else dup >scrhw then over !
i if cold? if
fork ?dup 0= if drop quit then
i over >ttchan ! setrun
then then
\ vandys
cell+ CONS_ROWS 1- over ! cell+ 0 over !
cell+ cur_attr @ over ! cell+ 0 over ! cell+ 0 over !
cell+ blank_page
loop
TVRAM set_screenmem
CONS_ROWS 1- cur_row ! 0 cur_col !
NSCREEN 1 do i ttchan ! ." Task" i . cr loop 0 ttchan !
;
\ Support for TTY integration into tasking edisms vandys
\ : (key-edisms) ( ttchan -- ? ) cur_hw @ - if false exit then
\ TBD: need ttchan/vector combo to be pollable from any context.
only
Values inherited from metacompiler environment
Current display attribute, initially WHITE
A blank screen position value (data + attribute)
Current row/column
Flag hardware cursor needs to be updated
Count of unpaused scroll-ups which have happened
The queue of TTY input characters
: set_screenmem Set base of screen memory, along with derived values
: gdc! Write a value to a GDC register
: cursor_pos Set HW cursor position based on current absolute screen offset
Clear flag telling us that we needed to update the HW
Calculate position on screen
Pick it apart and send out to the I/O ports
: on_hw? Tell if we're currently addressing the hardware screen
: (scroll_up) Actual screen memory move/clear for scrolling up
: check_intr If there's an interrupt typed in & pending, throw
an interrupt event. (Inhibit if there's no handler.)
: scroll_up Scroll all lines up one
Simple case, no need to pause, just roll the lines
If there's already typeahead, inhibit scroll pause
Put cursor at lower right-hand corner
Multitask, re-placing cursor as needed
Wait for keystroke on our screen, then roll the lines
Move cursor to beginning on newly blanked bottom line
Clear the count and typing, then check for interrupts
: consput Put character onto screen at current location
Add current attribute to character
Calculate screen location and store character
: (cons_fwd) Move cursor forward one position, scrolling if needed
Wrapped to start of new line
Check for line beyond bottom, leave if not
Time to scroll up
: (cons_putc) Put displayable char, advancing cursor
: cons_putc Put character onto console
If writing to HW screen, flag that physical cursor must move
Display simple printing characters
Tab
Carriage return
Newline
Scroll at bottom of screen
Backspace Back one space on current line
Backspace to previous line
: blank_page Wipe indicated screen memory to blankness
: cons_page Blank current screen memory, home cursor
: cons_xy Set cursor position
: cons_attr Set display enhancement
: cons_blot Clear to end of line
: cons_putpage Set contents of entire screen in one go
State of key modifiers. Note: no caps lock or alt.
: set_chan Change screen output to indicated channel
No-op if already on this channel
Save state of current channel
Restore state from newly selected channel
: set_hw Change which screen is displayed on the physical display
Range check
Avoid no-op
Only useful if multi-tasking
Make the new HW display the current channel
Move hardware screen image back into virtual storage,
and switch to virtual storage for this screen
New screen is now on the hardware... record this, and put its
memory image onto the physical display
Set parameters for display to TVRAM
: bad_cons_op Complain about bad console operations
: cons_q Put another char into queue, drop quietly if queue full
: cons_deq Pull char from queue
: cons_watcher Pull bytes from keyboard, queue for applications
Interrupt becomes the only char in the typing queue
Typing clears auto-pause for scrolling
: cons_getc Get char from user... if not on HW, no input available
Update cursor if moved
No typing queued, just return F
Here's your char, checked for interrupt
: cons_op Operations as a TTY under ForthOS
Give multi-tasking a chance when doing TTY input (cons_getc)
Handle output to different screen
: boot-cons Initialize console data structures
Init order? Just return our startup index
Bind boot TTY driver to us
Initialize cursor to blinking underscore
Screen 0 is active and displayed on the hardware
Task devoted to pulling keystrokes out, started on cold boot
Walk screens to set each of them up
First screen is the hardware one, others
remain virtual until screen switch.
Create an interpreter for each TTY channel
(0th has the boot task)
Child drops out to the interpretive loop
Parent sets up TTY channel, then sets child runnable
Set row/col to bottom of screen
Attribute Scroll count Reserved word
Blank screen image
Initialize screen pointers, update cursor
Initialize cursor position to bottom of screen
Print screen # and "Ok" so we see something at bootup