SWAP DUP HERE @ SWAP - SWAP !
;
-: BEGIN IMMEDIATE
- HERE @
-;
+: BEGIN IMMEDIATE HERE @ ;
-: AGAIN IMMEDIATE
- ' BRANCH ,
- HERE @ - , ;
+: AGAIN IMMEDIATE ' BRANCH , HERE @ - , ;
+
+: UNTIL IMMEDIATE ' 0BRANCH , HERE @ - , ;
: ( IMMEDIATE
- BEGIN
- READ-WORD
- 1 = IF
- C@ 41 = IF
- EXIT
- THEN
- ELSE
- DROP
- THEN
- AGAIN ; ( Yay! We now have comments! )
-
-: UNTIL IMMEDIATE
- ' 0BRANCH ,
- HERE @ - ,
-;
+ BEGIN READ-WORD 1 = IF C@ 41 = IF EXIT THEN ELSE DROP THEN AGAIN ;
+( Yay! We now have comments! )
( Compile a literal value into the current word. )
-: LIT, IMMEDIATE ( x -- )
- ' LIT , , ;
+: LIT, IMMEDIATE ( x -- ) ' LIT , , ;
: / /MOD DROP ;
: MOD /MOD SWAP DROP ;
: NEG 0 SWAP - ;
-: C,
- HERE @ C!
- HERE @ 1 +
- HERE ! ;
+( p n -- ; increment *p by n )
+: INC OVER @ + SWAP ! ;
+
+: C, HERE @ C! HERE 1 INC ;
-: OVER ( a b -- a b a ) SWAP DUP ROT ;
+( p -- v ; fetch 32 bit value; fetches 64 and masks the high bits )
+: @32 @ 4294967295 & ;
( An alternative comment syntax. Reads until the end of the line. )
-: \ IMMEDIATE
- BEGIN
- KEY
- 10 = UNTIL ;
+: \ IMMEDIATE BEGIN KEY 10 = UNTIL ;
+
+( string* -- buffer length )
+: S@ DUP 1 + SWAP C@ ;
+
+( -- str* ; Put input string into dictionary heap and return address )
+: "
+ HERE @ 0 C, \ We will put the length here
+ BEGIN KEY DUP C, 34 = UNTIL
+ HERE @ 1 - 0 OVER C! OVER - OVER C!
+ ;
\ So far, S" has only worked in immediate mode, which is backwards --
\ actually, the main use-case of this is as a compile-time word. Let's
\ fix that.
-: S" IMMEDIATE
- ' LITSTRING ,
- HERE @ 0 C, \ We will put the length here
- 0
- BEGIN
- 1 +
- KEY DUP C,
- 34 = UNTIL
- \ Remove final "
- HERE @ 1 - HERE !
- 1 -
- SWAP C! ;
-
-( Compile the given string into the current word directly. )
-: STORE-STRING ( str len -- )
- BEGIN
- OVER C@ C,
- SWAP 1 + SWAP
- 1 - DUP 0 = UNTIL
- DROP DROP ;
+: S" IMMEDIATE ' LITSTRING , " DROP ;
+
+( immediate print string, using HERE space )
+: ." HERE @ " S@ TELL HERE ! ;
+
+\ Store a null-terminated UTF-16 string HERE, and return a pointer to
+\ its buffer at runtime.
+: UTF16" HERE @ BEGIN KEY DUP C, 0 C, 34 = UNTIL 0 HERE @ 2 - C! ;
: NEWLINE 10 EMIT ;
: SPACE 32 EMIT ;
+: .X .U SPACE ;
+
+( RPT ... [ IFZEND ... ]* DONE )
+: RPT IMMEDIATE ' BRANCH , 24 , ' BRANCH , 0 , HERE @ ;
+
+: DONE IMMEDIATE ' BRANCH , DUP HERE @ - , 8 - HERE @ OVER - SWAP ! ;
+
+: IFZEND IMMEDIATE ' 0BRANCH , DUP 16 - HERE @ - , ;
+
+( v -- ; print decimal number )
+: . DUP IF 10 /MOD SWAP DUP IF . ELSE DROP THEN THEN 48 + EMIT ;
+
( Read a number from standard input. )
: READ-NUMBER READ-WORD PARSE-NUMBER ;
-: RESTART S" rrq's UEFI boot using jonasforth." TELL NEWLINE ;
+( a b -- c ; logical AND wrt !=0 )
+: AND IF IF 1 ELSE 0 THEN ELSE DROP 0 THEN ;
+
+( a b -- c ; logical OR wrt !=0 )
+: OR IF DROP 1 ELSE IF 1 ELSE 0 THEN THEN ;
+
+( v [word] -- ; Declare a CONSTANT that returns a value )
+: CONSTANT READ-WORD CREATE LIT DOCOL , LIT LIT , , LIT EXIT , ;
+
+( p n -- p+n ; define name for field address of given size )
+: FIELD* OVER CONSTANT + ;
+
+( p -- p+8 ; define name for current field 64-bit value )
+: FIELD@ DUP @ CONSTANT 8 + ;
+
+( v lo hi -- v x ; x = lo <= v and v <= hi )
+: RANGE 2 PICK < IF DROP 0 ELSE OVER SWAP < IF 0 ELSE 1 THEN THEN ;
+
+\ ######## Handling hexadecimal codes: 0x...
+
+0 1 - CONSTANT -1
+
+( -- v ; read next character as a hexcode value or -1 )
+: HEX
+ KEY 48 57 RANGE IF 48 -
+ ELSE 65 70 RANGE IF 55 -
+ ELSE 97 102 RANGE IF 87 -
+ ELSE DROP -1
+ THEN THEN THEN
+;
+
+( -- v ; Read indefinite sequence of hex digits, an one character more )
+: HEX* 0 RPT HEX DUP 1 + IFZEND 16 * + DONE DROP ;
+
+( -- ; Read immediately a heax number and compile into dictionary )
+: HEX, IMMEDIATE HEX* , ;
+
+( -- v ; read next 2 characters as hexcode into a byte value )
+: HEX2 HEX 16 * HEX + ;
+
+( -- v ; read next 4 characters as hexcode into a 2-byte value )
+: HEX4 HEX2 256 * HEX2 + ;
+
+( -- v ; read next 8 characters as hexcode into a 4-byte value )
+: HEX8 HEX4 65536 * HEX4 + ;
+
+( c -- ; consume input on the line until character c or newline )
+: SCANTO BEGIN KEY 10 OVER = IF DROP 1 ELSE OVER = THEN UNTIL DROP ;
+
+( v p -- ; lay out 2-byte value as LE )
+: C2! 2DUP C! SWAP 256 / SWAP 1 + C! ;
+
+( v p -- ; lay out 4-byte value as LE )
+: C4! 2DUP C2! SWAP 65536 / SWAP 2 + C2! ;
+
+( v1..vn n -- v1..vn ; reverse the n top elements on the stack using the heap )
+: REVERSE
+ DUP 1 + 8 * R+ \ Allocate frame of n+1 elements (index = 1..n)
+ DUP R= ! \ Save count at top
+ BEGIN SWAP OVER 8 * R= + ! 1 - 1 < UNTIL DROP \ copy to return stack
+ R= @ \ Restore count
+ BEGIN DUP 8 * R= + @ SWAP 1 - 1 < UNTIL DROP \ copy from return stack
+ R= @ 1 + 8 * R+ \ Dispose of the frame
+;
+
+( array i - array &array[i] ; pointer into 64-bit array )
+: [8] 8 * OVER + ;
+
+( addr n -- ; TELL n bytes )
+: .BYTES BEGIN SWAP DUP C@ SPACE .U 1 + SWAP 1 - DUP 0 = UNTIL DROP DROP ;
-RESTART
+( addr n -- ; TELL n elements )
+: .ELEMENTS BEGIN SWAP DUP @ SPACE .U 8 + SWAP 1 - DUP 1 < UNTIL DROP DROP ;
-: ConOut SystemTable 64 + @ ;
-: ConOut.OutputString ConOut 8 + @ ;
-: ConOut.OutputString() ConOut SWAP ConOut.OutputString EFICALL2 ;
-: ConOut.ClearScreen() ConOut DUP 48 + @ EFICALL1 ;
-
-: BootServices SystemTable 96 + @ ;
-: BootServices.LocateProtocol BootServices 320 + @ ;
-: GraphicsOutputProtocol
- \ [TODO] It would be nice to cache this value, so we don't have to get it
- \ every time.
- \ (next line) *Protocol = EFI_GRAPHICS_OUTPUT_PROTOCOL_GUID
- HERE @ 5348063987722529246 , 7661046075708078998 ,
- 0 \ *Registration
- HERE @ 0 , \ **Interface
- BootServices.LocateProtocol EFICALL3 DROP
- HERE @ 8 - @ \ *Interface
- ;
-: GOP.Blt GraphicsOutputProtocol 16 + @ ;
-: GOP.Blt() ( GOP buffer mode sx sy dx dy dw dh pitch -- )
- GOP.Blt EFICALL10 0 = IF ELSE S" Warning: Invalid Blt()" TELL THEN ;
-: GOP.SetMode GraphicsOutputProtocol 8 + @ ;
-
-: EfiBltVideoFill 0 ;
-
-\ Store a null-terminated UTF-16 string HERE, and return a pointer to
-\ its buffer at runtime.
-: UTF16"
+\ ##############################
+\ Handle hexadecimal EFI GUID into a 2-word record on the heap
+\ The GUID text format consists is as a series of hexadecomal codes that
+\ maps to byte codes as follows
+\ 4 byte LE hexcode (8 digits)
+\ 2 x 2 byte LE hexcode (4 digits)
+\ 8 x 1 byte hexcode (2 digits)
+\ and with braces
+\ The following is a code example:
+\ ----
+\ GUID: GOP.GUID
+\ {0x9042a9de,0x23dc,0x4a38, {0x96,0xfb,0x7a,0xde,0xd0,0x80,0x51,0x6a}}
+\ ----
+\ Though, the parsing actually first grabs the word via CONSTANT, and then just\ scans for "x" as hex number prefix, thus reading like
+\ GUID: {word}*x........*x....*x....*x..*x..*x..*x..*x..*x..*x..*x..{word}
+\ where, as usual, "{word}" are anything up to reading the subsequent space.
+
+\ Allocate a variable for the list of all GUIDS
+
+HERE @ 0 , CONSTANT GUIDS
+
+( [name] -- ; declare a guid constant with name and guid as per the above, )
+( Followed by pointer to the previous guid )
+: GUID:
HERE @
+ 0 , 0 , GUIDS @ ,
+ DUP CONSTANT
+ DUP GUIDS !
+ 120 SCANTO HEX8 OVER C4! 4 +
+ 2 BEGIN SWAP 120 SCANTO HEX4 OVER C2! 2 + SWAP 1 - DUP 0 = UNTIL DROP
+ 8 BEGIN SWAP 120 SCANTO HEX2 OVER C! 1 + SWAP 1 - DUP 0 = UNTIL DROP
+ DROP READ-WORD DROP DROP
+;
+
+( *guid -- *guid ; Get next GUID word )
+: GUID.next 16 + @ ;
+
+( *guid -- *chars length ; Find the dicitonary name of the guid )
+: GUID.name 33 + S@ ;
+
+( *guid1 *guid2 -- x ; Check if two GUID are equal )
+: GUID= OVER @ OVER @ = IF 8 + @ SWAP 8 + @ = ELSE DROP DROP 0 THEN ;
+
+( *guidp -- ; Tell name of GUID )
+: GUID.Tellname DUP IF GUID.name ELSE DROP S" unknown" THEN TELL ;
+
+( *guidp -- *guid ; Find dictionary guid same as the given )
+: GUID.find
+ GUIDS
+ ( *guidp *list-guid )
BEGIN
- KEY DUP C,
- 0 C,
- 34 = UNTIL
- HERE @ 2 - HERE ! \ Remove final "
- 0 C, 0 C, \ Null terminator
- ;
-
-\ Push length for null-terminated string ( s -- s n )
-: @32
- DUP BEGIN DUP C@ IF 1 + 0 ELSE 1 THEN UNTIL OVER -
-;
-
-ConOut.ClearScreen()
-
-\ Report Firmware Vendor
-UTF16" Firmware vendor: " ConOut.OutputString()
-SystemTable 24 + @ ConOut.OutputString()
-UTF16" version:" ConOut.OutputString()
-SystemTable 32 +
- SPACE DUP C@ .U 1 +
- SPACE DUP C@ .U 1 +
- SPACE DUP C@ .U 1 +
- SPACE DUP C@ .U 1 +
+ DUP
+ NEWLINE DUP GUID.Tellname NEWLINE
+ IF 2DUP GUID= IF SWAP EXIT THEN GUID.next ELSE SWAP EXIT THEN
+ AGAIN
+;
+
+( *guid -- ; Print a GUID in parsable hex form )
+: GUID.Tell
+ DUP GUID.find GUID.Tellname
+ S" = {0x" TELL
+ DUP @ 4294967296 /MOD .U S" ,0x" TELL
+ 65536 /MOD .U S" ,0x" TELL .U
+ 8 + @ 8
+ BEGIN DUP 8 = IF S" ,{0x" ELSE S" ,0x" THEN TELL
+ SWAP 256 /MOD .U SWAP
+ 1 - DUP 0 =
+ UNTIL DROP DROP
+ S" }}" TELL
+;
+
+\ ##############################
+\ System table entry labelling
+
+SystemTable
+\ EFI_TABLE_HEADER
+8 FIELD* SystemTable.Signature
+4 FIELD* SystemTable.Revision
+4 FIELD* SystemTable.HeaderSize
+4 FIELD* SystemTable.CRC32
+4 FIELD* SystemTable.Reserved
+( CHAR16 ) FIELD@ FirmwareVendor
+4 FIELD* FirmwareRevision
+4 FIELD* FirmwareRevisionPad
+\ -- stdio
+( EFI_HANDLE ) FIELD@ ConsoleInHandle
+( EFI_SIMPLE_TEXT_INPUT_PROTOCOL ) FIELD@ ConIn
+( EFI_HANDLE ) FIELD@ ConsoleOutHandle
+( EFI_SIMPLE_TEXT_OUTPUT_PROTOCOL ) FIELD@ ConOut
+( EFI_HANDLE ) FIELD@ StandardErrorHandle
+( EFI_SIMPLE_TEXT_OUTPUT_PROTOCOL ) FIELD@ StdErr
+\ -- services
+( EFI_RUNTIME_SERVICES ) FIELD@ RuntimeServices
+( EFI_BOOT_SERVICES ) FIELD@ BootServices
+\ -- ConfigurationTable
+8 FIELD* SystemTable.NumberOfTableEntries \ UINTN = native size uint
+( EFI_CONFIGURATION_TABLE ) FIELD@ ConfigurationTable
+DROP
+
+\ ##############################
+\ : ConOut entry labelling
+
+ConOut
+( EFI_TEXT_RESET ) FIELD@ ConOut.Reset
+( EFI_TEXT_STRING ) FIELD@ ConOut.OutputString
+( EFI_TEXT_TEST_STRING ) FIELD@ ConOut.TestString
+( EFI_TEXT_QUERY_MODE ) FIELD@ ConOut.QueryMode
+( EFI_TEXT_SET_MODE ) FIELD@ ConOut.SetMode
+( EFI_TEXT_SET_ATTRIBUTE ) FIELD@ ConOut.SetAttribute
+( EFI_TEXT_CLEAR_SCREEN ) FIELD@ ConOut.ClearScreen
+( EFI_TEXT_SET_CURSOR_POSITION ) FIELD@ ConOut.SetCursorPosition
+( EFI_TEXT_ENABLE_CURSOR ) FIELD@ ConOut.EnableCursor
+( SIMPLE_TEXT_OUTPUT_MODE ) FIELD@ ConOut.Mode
DROP
-NEWLINE
+
+: ConOut.OutputString() ConOut SWAP ConOut.OutputString EFICALL2 ;
+: ConOut.ClearScreen() ConOut ConOut.ClearScreen EFICALL1 ;
+
+\ ##############################
+\ BootServices entry labelling
+
+0 CONSTANT SearchKey.NONE
+
+\ ENUM EFI_LOCATE_SEARCH_TYPE
+0 CONSTANT SearchType.AllHandles
+1 CONSTANT SearchType.ByRegisterNotify
+2 CONSTANT SearchType.ByProtocol
+
+BootServices
+\ EFI_TABLE_HEADER
+8 FIELD* BootServices.Signature
+4 FIELD* BootServices.Revision
+4 FIELD* BootServices.HeaderSize
+4 FIELD* BootServices.CRC32
+4 FIELD* BootServices.Reserved
+\ Task Priority Services
+ FIELD@ RaiseTPL
+ FIELD@ RestoreTPL
+\ Memory Services
+ FIELD@ AllocatePages
+ FIELD@ FreePages
+ FIELD@ GetMemoryMap
+ FIELD@ AllocatePool
+ FIELD@ FreePool
+\ Event & Timer Services
+ FIELD@ CreateEvent
+ FIELD@ SetTimer
+ FIELD@ WaitForEvent
+ FIELD@ SignalEvent
+ FIELD@ CloseEvent
+ FIELD@ CheckEvent
+\ Protocol Handler Services
+ FIELD@ InstallProtocolInterface
+ FIELD@ ReinstallProtocolInterface
+ FIELD@ UninstallProtocolInterface
+ FIELD@ HandleProtocol
+ FIELD@ Reserved2
+ FIELD@ RegisterProtocolNotify
+ FIELD@ LocateHandle
+ FIELD@ LocateDevicePath
+ FIELD@ InstallConfigurationTable
+\ Image Services
+ FIELD@ LoadImage
+ FIELD@ StartImage
+ FIELD@ Exit
+ FIELD@ UnloadImage
+ FIELD@ ExitBootServices
+\ Miscellaneous Services
+ FIELD@ GetNextMonotonicCount
+ FIELD@ Stall
+ FIELD@ SetWatchdogTimer
+\ DriverSupport Services
+ FIELD@ ConnectController
+ FIELD@ DisconnectController
+\ Open and Close Protocol Services
+ FIELD@ OpenProtocol
+ FIELD@ CloseProtocol
+ FIELD@ OpenProtocolInformation
+\ Library Services
+ FIELD@ ProtocolsPerHandle
+ FIELD@ LocateHandleBuffer
+ FIELD@ LocateProtocol
+ FIELD@ InstallMultipleProtocolInterfaces
+ FIELD@ UninstallMultipleProtocolInterfaces
+\ 32-bit CRC Services
+ FIELD@ CalculateCrc32
+\ Miscellaneous Services
+ FIELD@ CopyMem
+ FIELD@ SetMem
+ FIELD@ CreateEventEx
+DROP
+
+( buffer -- )
+: BootServices.FreePool()
+ FreePool EFICALL1 \ No return value?
+;
+
+( handle, *guid -- *interface ; Queries a handle to determine if it supports
+ a specified protocol, and returns interface pointer or null )
+: BootServices.HandleProtocol()
+ HERE @ 0 OVER ! HandleProtocol EFICALL3
+ DUP IF S" **HandleProtocol: " TELL .U NEWLINE ELSE DROP THEN
+ HERE @ @
+;
+
+( Handle -- *buffer count ; Retrieves The List Of Protocol Interface
+ GUIDs that are installed on a handle in a buffer allocated from pool. )
+: BootServices.ProtocolsPerHandle()
+ HERE @ 0 , HERE @ 0 , ProtocolsPerHandle EFICALL3
+ HERE @ 16 - @ HERE @ 8 - @ HERE @ 16 - HERE !
+ ROT DUP IF S" **ProtocolsPerHandle: " TELL .U NEWLINE ELSE DROP THEN
+;
+
+( *guid *Registration -- *Interface ;
+ Returns the first protocol interface that matches the given protocol. )
+: BootServices.LocateProtocol()
+ HERE @ 0 OVER !
+ LocateProtocol EFICALL3
+ DUP IF S" **LocateProtocol: " TELL .U NEWLINE ELSE DROP THEN
+ HERE @ @
+;
+
+( *protocol type -- *array count ; locate handles )
+( returns array in allocated space )
+: BootServices.LocateHandleBuffer()
+ ( searchtype, protocol, searchkey, *count, *arrayp )
+ SWAP SearchKey.NONE HERE @ HERE @ 8 +
+ ( type *protocol searchkey *count **array )
+ LocateHandleBuffer EFICALL5
+ DUP IF S" **LocateHandleBuffer: " TELL .U NEWLINE ELSE DROP THEN
+ ( HERE@ = nohandles , *buffer )
+ HERE @ 8 + @ HERE @ @
+;
+
+( -- buffer* n ; locate handles )
+( returns array in allocated space )
+: BootServices.LocateHandleBuffer(AllHandles)
+ 0 SearchType.AllHandles BootServices.LocateHandleBuffer()
+;
+
+( protocol -- buffer* n ; locate handles )
+( returns array in allocated space )
+: BootServices.LocateHandleBuffer(ByProtocol)
+ SearchType.ByProtocol BootServices.LocateHandleBuffer()
+;
+
+\ ##############################
+\ GOP = GraphicsOutputProtocol
+
+GUID: GOP.GUID
+{0x9042a9de,0x23dc,0x4a38, {0x96,0xfb,0x7a,0xde,0xd0,0x80,0x51,0x6a}}
+
+GOP.GUID 0 BootServices.LocateProtocol()
+FIELD@ GOP.QueryMode
+FIELD@ GOP.SetMode
+FIELD@ GOP.Blt
+
+( guid buffer mode sx sy dx dy dw dh pitch -- )
+: GOP.Blt()
+ GOP.Blt EFICALL10 0 =
+ IF ELSE S" Warning: Invalid Blt()" TELL THEN
+;
+
+\ ##############################
+\ DPP = EFI_DEVICE_PATH_PROTOCOL
+GUID: DPP.GUID
+{0x09576e91,0x6d3f,0x11d2, {0x8e,0x39,0x00,0xa0,0xc9,0x69,0x72,0x3b}}
+
+( *protocol -- ; Tell about DPP protocol )
+: DPP.Tell
+ DUP @ 4294967295 &
+ 256 /MOD S" DPP{" TELL .
+ 256 /MOD S" ," TELL .
+ DUP S" ," TELL .
+ S" }" TELL
+ SWAP 4 + SWAP
+ .BYTES
+;
+
+\ ##############################
+\ EFI_BLOCK_IO_MEDIA struct
+
+
+\ ##############################
+\ BIP = EFI_BLOCK_IO_PROTOCOL
+GUID: BIP.GUID
+0x964e5b21,0x6459,0x11d2, {0x8e,0x39,0x00,0xa0,0xc9,0x69,0x72,0x3b}}
+
+\ ##############################
+\ LIP = LoadedImageProtocol
+GUID: LIP.GUID
+{0x5b1b31a1,0x9562,0x11d2, {0x8e,0x3f,0x00,0xa0,0xc9,0x69,0x72,0x3b}}
+
+\ ##############################
+\ SFSP = EFI_SIMPLE_FILE_SYSTEM_PROTOCOL
+GUID: SFSP.GUID
+0x0964e5b22,0x6459,0x11d2, {0x8e,0x39,0x00,0xa0,0xc9,0x69,0x72,0x3b}}
}
;; pushr and popr work on the return stack, whose location is stored in the
-;; register RBP.
+;; register RBP. Always allocates an extra 8 bytes as "local frame"
macro pushr x {
sub rbp, 8
mov qword [rbp], x
cmp rax, 0 ; Compare top of stack to see if we should branch
jnz .dont_branch
.do_branch:
- jmp BRANCH.start
+ add rsi,[rsi]
+ next
.dont_branch:
add rsi, 8 ; We need to skip over the next word, which contains
; the offset.
next
+;; Push the return stack pointer. "grows" negatively
+forth_asm RSPGET, 'R='
+ push rbp
+ next
+
+;; The return stack "grows" negatively, and rbp is the address of the top
+;; Move rbp by n (from stack) bytes
+forth_asm RSPADD, 'R+'
+ pop rax
+ sub rbp, rax
+ next
+
+;; Push top of the stack.
+forth_asm TOP_, 'TOP'
+ push rsp
+ next
+
;; Duplicate the top of the stack.
forth_asm DUP_, 'DUP'
push qword [rsp]
pop rax
jmp qword [rax]
+;; This word skips a word without exectuing, but pushes its address
+forth_asm SKIP_, 'SKIP'
+ push rsi
+ add rsi, 8 ; We need to skip over the next word, which contains
+ ; the offset.
+ next
+
;; Expects a character on the stack and prints it to standard output.
forth_asm EMIT, 'EMIT'
pushr rsi
.skip_whitespace:
;; Read characters until one of them is not whitespace.
call KEY.impl
- ;; We consider newlines and spaces to be whitespace.
+ ;; We consider newlines, tabs and spaces to be whitespace.
cmp al, ' '
je .skip_whitespace
+ cmp al, $9
+ je .skip_whitespace
cmp al, $A
je .skip_whitespace
cmp al, ' '
je .end
+ cmp al, 9
+ je .end
cmp al, $A
jne .read_alpha
add rsp, 8
next
+;; Takes a value and an address, and stores the value at the given address.
+forth_asm AND_, '&'
+ pop rbx ; a
+ pop rax ; b
+ and rax, rbx
+ push rax
+ next
+
forth_asm NOT_, 'NOT'
pop rax
cmp rax, 0
push rbx
next
-;; Given two integers a and b on the stack, pushes the quotient and remainder of
-;; division of a by b.
+;; Multiply two integers on the stack ignoring overflow
+forth_asm MULT, '*'
+ pop rax
+ pop rbx
+ mul rbx
+ push rax
+ next
+
+;; Given two integers a and b on the stack, pushes the quotient and
+;; remainder of division of a by b.
forth_asm TIMESMOD, '/MOD'
pop rbx ; b
pop rax ; a
pop rax
pop rbx
pop rdx
+ push rbx
push rax
push rdx
- push rbx
next
forth_asm PICK, 'PICK'
push rax
next
+forth_asm OVER, 'OVER'
+ push qword [rsp + 8]
+ next
+
forth_asm EQL, '='
pop rax
pop rbx
push 1
next
+forth_asm LT_, '<'
+ pop rax
+ pop rbx
+ cmp rax, rbx
+ jle .le
+.notle:
+ push 1
+ next
+.le:
+ push 0
+ next
+
+forth_asm GT_, '>'
+ pop rax
+ pop rbx
+ cmp rax, rbx
+ jge .ge
+.notge:
+ push 1
+ next
+.ge:
+ push 0
+ next
+
forth MAIN, 'MAIN'
dq SYSCODE
dq INTERPRET_STRING
forth_asm EFICALL1, 'EFICALL1'
pop rax ; function pointer
pop rcx ; 1st argument
-
sub rsp, 32
call rax
add rsp, 32
-
next
forth_asm EFICALL2, 'EFICALL2'
pop rax ; function pointer
pop rdx ; 2nd argument
pop rcx ; 1st argument
-
sub rsp, 32
call rax
add rsp, 32
-
next
forth_asm EFICALL3, 'EFICALL3'
pop r8 ; 3rd argument
pop rdx ; 2nd argument
pop rcx ; 1st argument
-
sub rsp, 32
call rax
add rsp, 32
+ push rax
+ next
+forth_asm EFICALL4, 'EFICALL4'
+ pop rax ; function pointer
+ pop r9 ; 4th argument
+ pop r8 ; 3rd argument
+ pop rdx ; 2nd argument
+ pop rcx ; 1st argument
+ sub rsp, 32
+ call rax
+ add rsp, 32
push rax
+ next
+forth_asm EFICALL5, 'EFICALL5'
+ pop rax ; function pointer
+ pop r10 ; 5th argument
+ pop r9 ; 4th argument
+ pop r8 ; 3rd argument
+ pop rdx ; 2nd argument
+ pop rcx ; 1st argument
+ push r10 ; restore as stack argument
+ sub rsp, 32
+ call rax
+ add rsp, 32 + 8
+ push rax
next
forth_asm EFICALL10, 'EFICALL10'
pop rax ; function pointer
-
- mov rcx, [rsp + 8 * 9]
- mov rdx, [rsp + 8 * 8]
+ mov rcx, [rsp + 8 * 9] ; 1st
+ mov rdx, [rsp + 8 * 8] ; 2nd
mov r8, [rsp + 8 * 7]
mov r9, [rsp + 8 * 6]
-
;; Reverse order of stack arguments
mov r10, [rsp + 8 * 5]
mov r11, [rsp + 8 * 0]
mov [rsp + 8 * 5], r11
mov [rsp + 8 * 0], r10
-
mov r10, [rsp + 8 * 4]
mov r11, [rsp + 8 * 1]
mov [rsp + 8 * 4], r11
mov [rsp + 8 * 1], r10
-
mov r10, [rsp + 8 * 3]
mov r11, [rsp + 8 * 2]
mov [rsp + 8 * 3], r11
mov [rsp + 8 * 2], r10
-
sub rsp, 32
call rax
add rsp, 32 + 8 * 10
-
push rax
-
next
;; Built-in variables:
READ_STRING.buffer rb $FF
READ_STRING.length dq ?
-DOTU.chars db '0123456789ABCDEF'
+DOTU.chars db '0123456789abcdef'
DOTU.buffer rq 16 ; 64-bit number has no more than 16 digits in hex
DOTU.rbuffer rq 16
DOTU.length dq ?
sysf:
file '../init/sys.f'
file '../init/uefi.f'
+file '../init/blurb.f'
sysf.len = $ - sysf
-
projects / rrq / jonasforth.git / commitdiff