snapshot before branching

diff --git a/Makefile b/Makefile
index 3d9b5b5f5cecf238d98a7c2bbcc6399003661654..88c74ca61bb474c1173dfdaa2a17566f55c4b645 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -2,7 +2,7 @@ default: out/main
 
 # asm and init order is important
 src/main.asm: src/uefi.asm src/impl.asm src/bootstrap.asm
 
 # asm and init order is important
 src/main.asm: src/uefi.asm src/impl.asm src/bootstrap.asm

-src/main.asm: init/sys.f init/uefi.f
+src/main.asm: init/sys.f init/uefi.f init/blurb.f

 
 out:
        mkdir -p out
 
 out:
        mkdir -p out


@@ -35,6 +35,7 @@ EFI.raw: out/main
        mkfs.fat -C $@ 2048 # =1Mb
        mmd -i "$@" ::efi
        mmd -i "$@" ::efi/boot
        mkfs.fat -C $@ 2048 # =1Mb
        mmd -i "$@" ::efi
        mmd -i "$@" ::efi/boot

+       mcopy -i "$@" Makefile "::EFI/BOOT"

        mcopy -i "$@" out/main "::EFI/BOOT/bootx64.efi"
 
 .PHONY: clean
        mcopy -i "$@" out/main "::EFI/BOOT/bootx64.efi"
 
 .PHONY: clean

diff --git a/init/blurb.f b/init/blurb.f
new file mode 100644 (file)
index 0000000..d2f09f9
--- /dev/null
+++ b/init/blurb.f
@@ -0,0 +1,53 @@
+ConOut.ClearScreen()
+
+\ ######################## BRANDING
+HERE @ " rrq's UEFI boot using jonasforth." S@ TELL NEWLINE HERE !
+
+\ Report Firmware Vendor and version
+UTF16" Firmware vendor: " ConOut.OutputString()
+FirmwareVendor ConOut.OutputString() NEWLINE
+
+UTF16" Firmware version: " ConOut.OutputString()
+FirmwareRevision @32 .U NEWLINE
+
+BootServices.LocateHandleBuffer(AllHandles)
+CONSTANT H.count
+CONSTANT H.array
+
+." Handles: " H.count . NEWLINE
+
+( handle -- ; Tell about handle )
+: TellHandle
+  DUP S" Handle: " TELL .U
+  BootServices.ProtocolsPerHandle()
+  ( *buffer count )
+  DUP S"  count: " TELL . NEWLINE
+  DUP IF
+    ( *buffer count )
+    BEGIN
+      SWAP
+      DUP @ GUID.Tell NEWLINE
+      8 +
+      SWAP 1 -
+      DUP 1 <
+    UNTIL 
+    DROP
+    BootServices.FreePool()
+  ELSE
+    DROP DROP
+  THEN
+;
+
+: TellHandles
+  H.array 0 BEGIN
+    S" [" TELL DUP . S" ]: " TELL
+    SWAP DUP @
+    TellHandle
+    8 + SWAP
+    1 + DUP 3 > 
+  UNTIL
+;
+
+TellHandles
+
+0 INPUT-LENGTH ! \ Stop loading here

diff --git a/init/sys.f b/init/sys.f
index bf79f380a5ea3c80412121172455fac30f5de162..e6d7836ff6ad54e96031dff6ee175b9878116c52 100644 (file)
--- a/init/sys.f
+++ b/init/sys.f
@@ -29,83 +29,145 @@ EXIT [
   SWAP DUP HERE @ SWAP - SWAP !
 ;
 
   SWAP DUP HERE @ SWAP - SWAP !
 ;
 

-: BEGIN IMMEDIATE
-  HERE @
-;
+: BEGIN IMMEDIATE HERE @ ;

 
 

-: AGAIN IMMEDIATE
-  ' BRANCH ,
-  HERE @ - , ;
+: AGAIN IMMEDIATE ' BRANCH , HERE @ - , ;
+
+: UNTIL IMMEDIATE ' 0BRANCH , HERE @ - , ;

 
 : ( IMMEDIATE
 
 : ( 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. )
 
 ( 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 - ;
 
 
 : / /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. )
 
 ( 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.
 
 \ 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 ;
 
 
 : 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 ;
 
 ( 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 ;

diff --git a/init/uefi.f b/init/uefi.f
index b6447441b8b25a484db4fe697ac3d328c6850843..46630dfbb31d94c92bd48c33c75acaf6272b1249 100644 (file)
--- a/init/uefi.f
+++ b/init/uefi.f
@@ -1,54 +1,297 @@
-: 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 @
   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
   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
 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}}

diff --git a/src/main.asm b/src/main.asm
index 3af5713ba81790adf989d42a777bf744c59f0409..3914b11c72bf20fd41fa07d182203fc707b75ba7 100644 (file)
--- a/src/main.asm
+++ b/src/main.asm
@@ -31,7 +31,7 @@ macro next {
 }
 
 ;; pushr and popr work on the return stack, whose location is stored in the
 }
 
 ;; 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
 macro pushr x {
   sub rbp, 8
   mov qword [rbp], x


@@ -172,12 +172,30 @@ forth_asm ZBRANCH, '0BRANCH'
   cmp rax, 0    ; Compare top of stack to see if we should branch
   jnz .dont_branch
 .do_branch:
   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
 
 .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]
 ;; Duplicate the top of the stack.
 forth_asm DUP_, 'DUP'
   push qword [rsp]


@@ -188,6 +206,13 @@ forth_asm EXEC, 'EXEC'
   pop rax
   jmp qword [rax]
 
   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
 ;; Expects a character on the stack and prints it to standard output.
 forth_asm EMIT, 'EMIT'
   pushr rsi


@@ -239,9 +264,11 @@ forth_asm READ_WORD, 'READ-WORD'
 .skip_whitespace:
   ;; Read characters until one of them is not whitespace.
   call KEY.impl
 .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, ' '
   je .skip_whitespace

+  cmp al, $9
+  je .skip_whitespace

   cmp al, $A
   je .skip_whitespace
 
   cmp al, $A
   je .skip_whitespace
 


@@ -259,6 +286,8 @@ forth_asm READ_WORD, 'READ-WORD'
 
   cmp al, ' '
   je .end
 
   cmp al, ' '
   je .end

+  cmp al, 9
+  je .end

   cmp al, $A
   jne .read_alpha
 
   cmp al, $A
   jne .read_alpha
 


@@ -325,6 +354,14 @@ forth_asm DROP, 'DROP'
   add rsp, 8
   next
 
   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
 forth_asm NOT_, 'NOT'
   pop rax
   cmp rax, 0


@@ -438,8 +475,16 @@ forth_asm MINUS, '-'
   push rbx
   next
 
   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
 forth_asm TIMESMOD, '/MOD'
   pop rbx                       ; b
   pop rax                       ; a


@@ -558,9 +603,9 @@ forth_asm ROT, 'ROT'
   pop rax
   pop rbx
   pop rdx
   pop rax
   pop rbx
   pop rdx

+  push rbx

   push rax
   push rdx
   push rax
   push rdx

-  push rbx

   next
 
 forth_asm PICK, 'PICK'
   next
 
 forth_asm PICK, 'PICK'


@@ -570,6 +615,10 @@ forth_asm PICK, 'PICK'
   push rax
   next
 
   push rax
   next
 

+forth_asm OVER, 'OVER'
+  push qword [rsp + 8]
+  next
+

 forth_asm EQL, '='
   pop rax
   pop rbx
 forth_asm EQL, '='
   pop rax
   pop rbx


@@ -582,6 +631,30 @@ forth_asm EQL, '='
   push 1
   next
 
   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 MAIN, 'MAIN'
   dq SYSCODE
   dq INTERPRET_STRING


@@ -598,22 +671,18 @@ forth EFI_SYSTEM_TABLE_CONSTANT, 'SystemTable'
 forth_asm EFICALL1, 'EFICALL1'
   pop rax ; function pointer
   pop rcx ; 1st argument
 forth_asm EFICALL1, 'EFICALL1'
   pop rax ; function pointer
   pop rcx ; 1st argument

-

   sub rsp, 32
   call rax
   add rsp, 32
   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
   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
   sub rsp, 32
   call rax
   add rsp, 32

-

   next
 
 forth_asm EFICALL3, 'EFICALL3'
   next
 
 forth_asm EFICALL3, 'EFICALL3'


@@ -621,45 +690,61 @@ forth_asm EFICALL3, 'EFICALL3'
   pop r8  ; 3rd argument
   pop rdx ; 2nd argument
   pop rcx ; 1st argument
   pop r8  ; 3rd argument
   pop rdx ; 2nd argument
   pop rcx ; 1st argument

-

   sub rsp, 32
   call rax
   add rsp, 32
   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
   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
   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]
   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
   ;; 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 * 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
   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
   sub rsp, 32
   call rax
   add rsp, 32 + 8 * 10

-

   push rax
   push rax

-

   next
 
 ;; Built-in variables:
   next
 
 ;; Built-in variables:


@@ -715,7 +800,7 @@ READ_STRING.char_buffer db ?
 READ_STRING.buffer rb $FF
 READ_STRING.length dq ?
 
 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 ?
 DOTU.buffer rq 16     ; 64-bit number has no more than 16 digits in hex
 DOTU.rbuffer rq 16
 DOTU.length dq ?


@@ -741,5 +826,5 @@ return_stack_top:
 sysf:
 file '../init/sys.f'
 file '../init/uefi.f'
 sysf:
 file '../init/sys.f'
 file '../init/uefi.f'

+file '../init/blurb.f'

 sysf.len = $ - sysf
 sysf.len = $ - sysf

-