/kernel_test.fth
Forth | 816 lines | 736 code | 80 blank | 0 comment | 35 complexity | df17e0a52bb898f3089f63cf29cd7d55 MD5 | raw file
- ; program: kernel_test
- ; Test for the kernel.
- ; License: GPL
- ; José Dinuncio <jdinunci@uc.edu.ve>, 12/2009.
- %include "forth.h"
- %include "kernel_words.h"
- %include "kernel_video.h"
- %include "kernel_kbd.h"
- %include "irq.h"
- extern name_getchar
- %undef OLDLINK
- %xdefine LINK name_getchar
- [BITS 32]
- : here
- DP @
- ;
- : print_scancode
- kbd_scancode dup intprint spc sc_to_c spc emit cr
- ;
- defvar "tic_count", tic_count, 0, 0
- : print_tic
- 1 tic_count +!
- tic_count @ 100 mod 0= if
- tic_msg printcstring cr
- then
- ;
- : print_scancodes
- begin print_scancode 0 until
- ;
- : print_interrupt
- fault printcstring cr
- ;
- ; prints an idt entry
- : print_idtentry
- dup 4 + @ swap @ ; wh wl
- dup hi hexprint spc ; sel
- lo hexprint spc ; base lo
- dup hi hexprint spc ; base hi
- lo 8 shr hexprint cr ; flags
- ;
- ; test irq
- defcode "test_irq", test_irq, 0
- int 33
- next
- ; divide by zero
- : div_by_zero
- 2 0 / drop
- ;
- ; Print hello word
- : print_hello
- hello printcstring cr
- ;
- %define _invoke_addr print_hello
- : test_invoke
- _invoke_addr execute
- ;
- ; function: store_in_buffer
- ;
- ; used by read_line
- ; Stack:
- ; ( char text_buffer text_buffer -- text_buffer )
- : store_in_buffer
- swap dup 1+ -rot c!
- ;
- ; function: read_line ; einlesen einer Zeile bis CR TESTED_OK
- ;
- ; Stack:
- ; address_of_text_buffer --
- ; zeile_buffer: ist 1024 byte lang
- : read_line
- 1
- begin
- while
- getchar dup 0x09 ;TAB
- =
- if
- drop tab ;branch repn
- then
- dup 0x0D =
- if
- drop 0x20 store_in_buffer
- 0 store_in_buffer
- drop
- exit
- then
- dup 0x08 ;BS backspace
- =
- if
- drop
- cursor_back ; del the char
- 0x20 emit cursor_back ; the position on back !
- 1- ; position of text_buffer(input) on back
- ;branch repn
- else
- dup emit store_in_buffer
- then
- 1
- repeat
- ;
- text_buffer: times 1024 db 0
- ; function: key1
- ;
- ; reads the next char in text_buffer PPTR points at
- ; Stack:
- ; -- char
- defcode "key1", key1 ,0
- xor eax,eax
- call _KEY1
- push eax
- next
- _KEY1:
- push ebx
- mov ebx,[var_PPTR]
- mov al,[ebx]
- inc ebx
- mov dword [var_PPTR],ebx
- pop ebx
- ret
-
- ; only test
- : tstout
- text_buffer dup
- cr printcstring cr
- '>' emit
- ;
- ; function: NUMBER TESTED_OK
- ;
- ; IN : ecx length of string
- ;
- ; edi start address of string
- ;
- ; OUT:eax parsed number
- ;
- ; ecx number of unparsed characters (0 = no error)
- defcode "number", number, 0
- pop ecx ; length of string
- pop edi ; start address of string
- call _NUMBER
- push eax ; parsed number
- push ecx ; number of unparsed characters (0 = no error)
- next
- _NUMBER:
- xor eax,eax
- xor ebx,ebx
- test ecx,ecx ; trying to parse a zero-length string is an error, but will return 0.
- jz .5
- mov edx,[var_BASE] ; get BASE (in %dl)
- ; Check if first character is '-'.
- mov bl,[edi] ; %bl = first character in string
- inc edi
- push eax ; push 0 on stack
- cmp bl,'-' ; negative number?
- jnz .2
- pop eax
- push ebx ; push <> 0 on stack, indicating negative
- dec ecx
- jnz .1
- pop ebx ; error: string is only '-'.
- mov ecx, $1
- ret
- ; Loop reading digits.
- .1: imul eax,edx ; %eax *= BASE
- mov bl,[edi] ; %bl = next character in string
- inc edi
- ; Convert 0-9, A-Z to a number 0-35.
- .2: sub bl,'0' ; < '0'?
- jb .4
- cmp bl,$10 ; <= '9'?
- jb .3
- sub bl,$17 ; < 'A'? (17 is 'A'-'0')
- jb .4
- add bl,$10
- .3: cmp bl,dl ; >= BASE?
- jge .4
- ; OK, so add it to %eax and loop.
- add eax,ebx
- dec ecx
- jnz .1
- ; Negate the result if first character was '-' (saved on the stack).
- .4: pop ebx
- test ebx,ebx
- jz .5
- neg eax
- .5: ret
- ; function: FIND TESTED_OK
- ;
- ; IN: ecx = length
- ; edi = address
- ;
- ;OUT: ; eax = address of dictionary entry (or NULL)
- defcode "find", find, 0
- pop ecx ; ecx = length
- pop edi ; edi = address
- call _FIND
-
- push eax ; eax = address of dictionary entry (or NULL)
- next
- _FIND:
- push esi ; Save esi so we can use it in string comparison.
- ; Now we start searching backwards through the dictionary for this word.
- mov edx,[var_LATEST] ; LATEST points to name header of the latest word in the dictionary
- .1: test edx,edx ; NULL pointer? (end of the linked list)
- je .4
- ; Compare the length expected and the length of the word.
- ; Note that if the F_HIDDEN flag is set on the word, then by a bit of trickery
- ; this won't pick the word (the length will appear to be wrong).
- xor eax,eax
- mov al,[edx+4] ; %al = flags+length field
- and al,(0x20| 0x1f) ;F_HIDDEN|F_LENMASK) ; %al = name length
- cmp byte al,cl ; Length is the same?
- jne .2
- ; Compare the strings in detail.
- push ecx ; Save the length
- push edi ; Save the address (repe cmpsb will move this pointer)
- lea esi,[edx+5] ; Dictionary string we are checking against.
- repe cmpsb ; Compare the strings.
- pop edi
- pop ecx
- jne .2 ; Not the same.
- ; The strings are the same - return the header pointer in %eax
- pop esi
- mov eax,edx
- ret
- .2: mov edx,[edx] ; Move back through the link field to the previous word
- jmp .1 ; .. and loop.
- .4: ; Not found.
- pop esi
- xor eax,eax ; Return zero to indicate not found.
- ret
- ; function: ">CFA" TESTED_OK
- defcode ">cfa", tcfa, 0
- pop edi
- call _TCFA
- push edi
- next
- _TCFA:
- xor eax,eax
- add edi,4 ; Skip link pointer.
- mov al,[edi] ; Load flags+len into %al.
- inc edi ; Skip flags+len byte.
- and al,0x1f ;F_LENMASK ; Just the length, not the flags.
- add edi,eax ; Skip the name.
- add edi,3 ; The codeword is 4-byte aligned.
- and edi,~3
- ret
- ; function: >DFA
- defword ">dfa", tdfa, 0
- dd tcfa ; (get code field address)
- dd incr4 ; (add 4 to it to get to next word)
- dd exit
-
- ; function: head
- defcode "head", head, 0
- pop ecx
- pop edx
- mov edi, [var_DP]
- mov eax, [var_LATEST]
- stosd
- ;xor eax, eax
- ;stosb
- mov al, cl
- stosb
- push esi
- mov esi, edx
- rep movsb
- pop esi
- lea edi,[edi+3]
- and edi, ~3
- mov eax, [var_DP]
- mov [var_LATEST], eax
- mov [var_DP], edi
- next
- : header
- wort head
- ;
- ;-------------------test-------------------------------------
- DOVAR:
- add eax,4
- push eax
- next
- : create
- header lit [#] DOVAR comma
- ;
- ;-------------------test-------------------------------------
- ; defcode; "," TESTED_OK
- defcode ",", comma, 0
- pop eax ; Code pointer to store.
- call _COMMA
- next
- _COMMA:
- mov edi,[var_DP] ; DP
- stosd ; Store it.
- mov dword [var_DP],edi ; DP
- ret
- ; function: [
- defcode "[", LBRAC, 0x80 ;;F_IMMED,LBRAC,0
- mov dword [var_STATE],0 ; Set STATE to 0.
- next
- ; function: ]
- defcode "]", RBRAC, 0
- mov dword [var_STATE],1 ; Set STATE to 1.
- next
- ; function: :
- ; [#] needed by forth2s.py to compile -> dd DOCOL (not litn DOCOL)
- defword ":", colon, 0
- dd wort ; Get the name of the new word
- dd head ; HEADER the dictionary entry / header
- dd lit
- dd DOCOL
- dd comma ; Append DOCOL (the codeword).
- dd LATEST
- dd fetch
- dd hidden ; Make the word hidden (see below for definition).
- dd RBRAC ; Go into compile mode.
- dd exit
- defword ";",SEMICOLON,0x80
- dd STATE , fetch
- if
- dd lit, exit, comma ; Append EXIT (so the word will return).
- dd LATEST, fetch, hidden ; Toggle hidden flag -- unhide the word (see below for definition).
- dd LBRAC ; Go back to IMMEDIATE mode.
- then
- dd exit
- ; function: IMMEDIATE TESTED_OK
- defcode "immediate", immediate, 0x80 ; F_IMMED
- mov edi,[var_LATEST] ; LATEST word.
- add edi,4 ; Point to name/flags byte.
- xor byte [edi],0x80 ; F_IMMED ; Toggle the IMMED bit.
- next
- ; function: HIDDEN
- defcode "hidden", hidden, 0
- pop edi ; Dictionary entry.
- add edi,4 ; Point to name/flags byte.
- xor byte [edi],0x20 ;F_HIDDEN ; Toggle the HIDDEN bit.
- next
-
- ; function: HIDE
- : hide
- wort ; Get the word (after HIDE).
- find ; Look up in the dictionary.
- hidden ; Set F_HIDDEN flag.
- ;
- ; function: "'" TESTED_OK
- defcode "'", tick, 0
- lodsd ; Get the address of the next word and skip it.
- push eax ; Push it on the stack.
- next
-
- ; TODO Branching??
- ; function: LITSTRING
- defcode "litstring", litstring, 0
- lodsd ; get the length of the string
- push esi ; push the address of the start of the string
- push eax ; push it on the stack
- add esi,eax ; skip past the string
- add esi,3 ; but round up to next 4 byte boundary
- and esi,~3
- next
-
- ; function: WORT rename later to WORD via alias
- ;
- ; gibt den pointer des strings aus zeilenbuffer bis zum Leerzeichen
- ; zurück , PPTR zeigt danach auf das nächste Wort
- ; edi ; push base address
- ; ecx ; push length
- defcode "wort", wort , 0
- call _word
- push edi ; push base address
- push ecx ; push length
- next
- _word:
- ;/* Search for first non-blank character. Also skip \ comments. */
- mov ebx,[var_PPTR]
- .1:
- mov al,[ebx] ;_KEY ; get next key, returned in %eax
- test al,al
- jnz .5
- mov dword [var_END_OF_LINE],0xffff
- ret
- .5: inc ebx
- cmp al,'\' ; start of a comment?
- je .3 ; if so, skip the comment
- cmp al,' '
- jbe .1 ; if so, keep looking
- ;/* Search for the end of the word, storing chars as we go. */
- mov edi,ptr_buff ; pointer to return buffer
- .2:
- stosb ; add character to return buffer
- mov al,[ebx] ;_KEY ; get next key, returned in %eax
- inc ebx; _KEY ; get next key, returned in %al
- cmp al,' ' ; is blank?
- ja .2 ; if not, keep looping
-
- ;/* Return the word (well, the static buffer) and length. */
- sub edi,ptr_buff
- mov ecx,edi ; return length of the word
- mov edi,ptr_buff ; return address of the word
- mov dword [var_PPTR],ebx
- ret
- .4:
- ;/* Code to skip \ comments to end of the current line. */
- .3:
- mov al,[ebx] ;_KEY ; get next key, returned in %eax
- inc ebx ;_KEY
- cmp al,$13 ; end of line yet?
- jne .3
- jmp .1
- section .data ; NB: easier to fit in the .data section
- ; A static buffer where WORD returns. Subsequent calls
- ; overwrite this buffer. Maximum word length is 256 chars.
- ptr_buff: times 256 db 0
-
- section .text
- : quit
- R0 rsp!
- 1 begin while line_interpret ?stack -1 repeat ; loops forever
- ;
-
- ; function: TELL
- : tell
- drop printcstring ;printt
- ;
- ; function: echooff
- ;
- ; Stack:
- ; --
- : echooff
- 0 NOECHO !
- ;
- ; function: echoon
- ;
- ; Stack:
- ; --
- : echoon
- 1 NOECHO !
- ;
- ; function: PRESSKEY
- ;
- ; Stack:
- ; --
- : presskey
- key_press printcstring tab '!' emit getchar drop clear
- ;
-
- ;defcode: INTERPRET
- defcode "interpret", interpret, 0
- mov dword [var_PARS_ERROR],0
- call _word ; Returns %ecx = length, %edi = pointer to word.
- ; Is it in the dictionary?
- xor eax,eax
- mov dword [interpret_is_lit],eax ; Not a literal number (not yet anyway ...)
- call _FIND ; Returns %eax = pointer to header or 0 if not found.
- test eax,eax ; Found?
- jz .1
-
- ; In the dictionary. Is it an IMMEDIATE codeword?
- mov edi,eax ; %edi = dictionary entry
- mov al,[edi+4] ; Get name+flags.
- push ax ; Just save it for now.
- call _TCFA ; Convert dictionary entry (in %edi) to codeword pointer.
- pop ax
- and al,0x80 ;F_IMMED ; Is IMMED flag set?
- mov eax,edi
-
- jnz .4 ; If IMMED, jump straight to executing.
-
- jmp .2
- .1: ; Not in the dictionary (not a word) so assume it's a literal number.
- ;
- inc dword [interpret_is_lit]
- call _NUMBER ; Returns the parsed number in %eax, %ecx > 0 if error
- test ecx,ecx
- jnz .6
- mov ebx,eax
- mov eax,lit ; The word is LIT
- .2: ; Are we compiling or executing?
- ;--------------NOW COMPILING !!-----------------------------
- mov dword edx, [var_STATE]
- test edx, edx
- jz .4 ; Jump if executing.
- ; Compiling - just append the word to the current dictionary definition.
- call _COMMA
- mov ecx, [interpret_is_lit] ; Was it a literal?
- test ecx, ecx
- jz .3
- mov eax,ebx ; Yes, so LIT is followed by a number.
- call _COMMA
- .3: next
- .4: ; Executing - run it!
- mov ecx,[interpret_is_lit] ; Literal?
- test ecx,ecx ; Literal?
- jnz .5
- ; Not a literal, execute it now. This never returns, but the codeword will
- ; eventually call next which will reenter the loop in QUIT.
- jmp [eax]
- .5: ; Executing a literal, which means push it on the stack.
- push ebx
- next
- .6: ; Parse error (not a known word or a number in the current BASE).
- ; Print an error message followed by up to 40 characters of context.
- ;mov ebx,2 ; 1st param: stderr
- mov dword [var_PARS_ERROR] ,0xffff
- next
- defcode "char", char, 0
- call _word
- xor eax,eax
- mov al,[edi]
- push eax
- next
-
- ; funktion: printt
- ; prints an string of len , pointer to string
- ;
- ; Stack:
- ; len pointer_to string --
- : printt
- 1- 0 do
- rot dup @ emit 1+ -rot
- loop
- drop
- ;
- ; funktion: U.
- ; for debuging
- : U.
- BASE @ /mod ?dup
- if ;( if quotient <> 0 then )
- U.
- else
- then
- dup 10 <
- if
- '0' ;(decimal digits 0..9 )
- else
- 10 - 'A'
- then
- + emit
- ;
- ; funktion: .S
- ; for debug
- : dotS
- '>' emit dsp@
- begin
- dup S0 @ <
- while
- dup @ U. spc 4+
- repeat
- drop '<' emit
- ;
- ; function: inter
- ;
- ;| the interpreter loop
- ;| tests for 'INTERPRET' errors and shows the result of interpret/compile
- ; Stack:
- ; --
- : inter
- 0 END_OF_LINE !
- NOECHO @ 0<>
- if
- cr
- then
- 1
- begin
- while
- interpret
- END_OF_LINE @ 0<> ; endof line Interprt was OK
- if
- NOECHO @ 0<>
- if
- cr ok printcstring cr
- then
- 0 dup END_OF_LINE ! PARS_ERROR !
- ;clear Error_flag
- ;clear End_of_Line fla
- exit
- then
- PARS_ERROR @ 0<> ; error in einput stream
- if
- cr 10 ink text_buffer printcstring
- cr 12 ink errmsg printcstring
- PPTR_LAST @ 10 printt cr
- 15 ink presskey
- 0 dup END_OF_LINE ! PARS_ERROR ! exit
- then
- PPTR @ PPTR_LAST !
- 1
- repeat
- ;
- ; function: to_PPTR
- ; store the value on stack to PPTR and increment PPTR and FILP
- ; Stack:
- ; char FILP -- FILP+1
- : to_PPTR
- PPTR @ c! 1 PPTR +! 1+
- ;
- ; function: endln
- ; store ";CR0" at end of line in text_buffer
- ; same as CR on keyboard input
- ; Stack:
- ; --
- : endln
- 0x3b to_PPTR FILP ! 0xd to_PPTR FILP ! 0x0 PPTR @ c!
- ;
- ; function: linecopy
- ; ( -- )
- ;| reads from source until ';' char is found in stream
- ;| replace in the stream
- ;| 'lf' with SPACE
- ;| 'tab' with SPACE
- ;| if ';' is found then 'CR' an 0 is added (to text_buffer)
- ;| this simulates an keyboard input with 'CR' , so the interpreter will
- ;| execute the line
- : linecopy
- dup c@ ; .s presskey ; IF LF is the first char
- 0x0a =
- if
- 0xd to_PPTR FILP ! 0x0 PPTR @ c! exit
- then
- 1
- begin while
- dup c@ dup 0x3b <> if
- dup 0x0a = ; wenn LF dann SPACE
- if
- drop 0x20
- then
- dup 0x09 = ; wenn TAB dann SPACE
- if
- drop 0x20
- then
- to_PPTR 1
- else
- endln exit
- then
- ; zeilemit ;.s presskey
- repeat
- endln ; CR and 0 -> ENDING 0 for PRINTSTRING
- ;
-
- ; function: interforth
- ; ( -- )
- ;| executes the loaded ( via GRUB) file
- : interforth
- echooff
- SRC @ FILP ! ; source file_position_pointer
- text_buffer PPTR ! ; input_line_source_pointer
- 1
- begin
- while
- FILP @
- linecopy
- text_buffer PPTR !
- NOECHO @ 0<>
- if
- cr cr text_buffer printcstring
- then
- inter ;zeilemit;presskey
- text_buffer dup PPTR_LAST ! ; remember the last word witch compiled without error
- PPTR !
- 1 FILP +!
- FILP @ c@ ; ; is next char = 0 ; then it is EOF
- ?dup
- if
- -1 FILP +! ; no , go for next line_input
- ;dd DROP
- else
- ;dd DROP
- exit ; yes , EOF
- then
- ;dd DROP
- 1
- repeat
- ;
- : zeilemit
- cr 10 0 do '-'emit loop cr '>'emit text_buffer printcstring '<' emit
- ;
- : teilemit
- cr 10 0 do '_'emit loop cr '>'emit ptr_buff printcstring '<' emit
- ;
- ; function: line_interpret
- ; ( -- )
- ;| reads stream of char to text_buffer
- ;| until 'CR' is hit
- : line_interpret
- text_buffer dup TEXT_BUFF ! read_line
- inter
- text_buffer dup PPTR_LAST ! PPTR !
- ;drop ; clsstack drop
- ;
- : depth
- S0 @ dsp@ - 4-
- ;
- : ?stack
- depth 0>
- if
- drop
- else
- stackerr printcstring
- S0 @ dsp!
- then
- ;
- : compile
- cr cr >dfa
- GRUB @ 0x14 + @
- GRUB @ 0x18 + @
- dup @ swap 4+ @ swap
- 2dup - rot drop ;.s cr presskey printt presskey
- GRUB @ 0x14 + @
- GRUB @ 0x18 + @
- dup @ swap 4+ @ swap
- 2dup - rot SRC_END ! 0 SRC_END c! ; Store 0 (EOF ) TO SRC_END
- swap dup SRC ! 2drop 2drop interforth
- text_buffer TEXT_BUFF ! 1 TEXT_BUFF @ c! ; init
- S0 @ dsp!
- text_buffer dup PPTR_LAST ! PPTR !
- ;
- extern module
- ; function: main
- ; The first forth word executed by the kernel.
- : main_test
- clear module @ GRUB !
- 0x101006 print_idtentry
- 0x10100E print_idtentry
- 0x101016 print_idtentry
- ;[`] print_scancode 33 register_isr_handler
- ;[`] print_tic 32 register_isr_handler
- compile
- quit
- stop
- ;
- global last_word
- ; function: tst
- ; dummy for marking LATEST
- ; Stack:
- ; --
- last_word:
- : tst
- cr 10 0 do '-'emit loop cr
- ;
- section .rodata
- hello: db "hello, world", 0
- fault: db "A fault happened", 0
- tic_msg: db "The clock tics", 0
- ok: db ' OK ... ' ,0
- key_press: db ' PRESS ANY KEY .... ' , 0
- outputmes: db 'Words of forth' , 0
- inputloop: db 'Enter words' , 0
- errmsg: db 'PARSE ERROR: AT ->' ,0
- gef: db 'GEFUNDEN' , 0
- ngef: db 'NICHT IN TABELLE' , 0
- stackmes: db 'STACK> ', 0
- stackerr: db ' STACK undeflow .. reset STACK !' ,0
- interpret_is_lit: db 0