Remove the USB keyboard hack now that KBDMUX is enabled by default.  Allow it to be disabled if Safe Mode is selected.

\ Copyright (c) 2003 Scott Long <scottl@freebsd.org>
\ Copyright (c) 2003 Aleksander Fafula <alex@fafula.com>
\ All rights reserved.
\
\ Redistribution and use in source and binary forms, with or without
\ modification, are permitted provided that the following conditions
\ are met:
\ 1. Redistributions of source code must retain the above copyright
\    notice, this list of conditions and the following disclaimer.
\ 2. Redistributions in binary form must reproduce the above copyright
\    notice, this list of conditions and the following disclaimer in the
\    documentation and/or other materials provided with the distribution.
\
\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
\ ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
\ SUCH DAMAGE.
\
\ $FreeBSD$

marker task-beastie.4th

include /boot/screen.4th
include /boot/frames.4th

hide

variable menuidx
variable menubllt
variable menuX
variable menuY
variable promptwidth

variable bootkey
variable bootacpikey
variable bootsafekey
variable bootverbosekey
variable bootsinglekey
variable escapekey
variable rebootkey

46 constant dot

\ The BSD Daemon.  He is 19 rows high and 34 columns wide
: beastie-logo ( x y -- )
2dup at-xy ."               ,        ," 1+
2dup at-xy ."              /(        )`" 1+
2dup at-xy ."              \ \___   / |" 1+
2dup at-xy ."              /- _  `-/  '" 1+
2dup at-xy ."             (/\/ \ \   /\" 1+
2dup at-xy ."             / /   | `    \" 1+
2dup at-xy ."             O O   ) /    |" 1+
2dup at-xy ."             `-^--'`<     '" 1+
2dup at-xy ."            (_.)  _  )   /" 1+
2dup at-xy ."             `.___/`    /       " 1+
2dup at-xy ."               `-----' /" 1+
2dup at-xy ."  <----.     __ / __   \" 1+
2dup at-xy ."  <----|====O)))==) \) /====|" 1+
2dup at-xy ."  <----'    `--' `.__,' \" 1+
2dup at-xy ."               |        |" 1+
2dup at-xy ."                \       /       /\" 1+
2dup at-xy ."           ______( (_  / \______/" 1+
2dup at-xy ."         ,'  ,-----'   |" 1+
at-xy ."         `--{__________) "
;

: beastiebw-logo ( x y -- )
	2dup at-xy ."              ,        ," 1+
	2dup at-xy ."             /(        )`" 1+
	2dup at-xy ."             \ \___   / |" 1+
	2dup at-xy ."             /- _  `-/  '" 1+
	2dup at-xy ."            (/\/ \ \   /\" 1+
	2dup at-xy ."            / /   | `    \" 1+
	2dup at-xy ."            O O   ) /    |" 1+
	2dup at-xy ."            `-^--'`<     '" 1+
	2dup at-xy ."           (_.)  _  )   /" 1+
	2dup at-xy ."            `.___/`    /" 1+
	2dup at-xy ."              `-----' /" 1+
	2dup at-xy ." <----.     __ / __   \" 1+
	2dup at-xy ." <----|====O)))==) \) /====" 1+
	2dup at-xy ." <----'    `--' `.__,' \" 1+
	2dup at-xy ."              |        |" 1+
	2dup at-xy ."               \       /       /\" 1+
	2dup at-xy ."          ______( (_  / \______/" 1+
	2dup at-xy ."        ,'  ,-----'   |" 1+
	     at-xy ."        `--{__________)"
;

: fbsdbw-logo ( x y -- )
	2dup at-xy ."      ______" 1+
	2dup at-xy ."     |  ____| __ ___  ___ " 1+
	2dup at-xy ."     | |__ | '__/ _ \/ _ \" 1+
	2dup at-xy ."     |  __|| | |  __/  __/" 1+
	2dup at-xy ."     | |   | | |    |    |" 1+
	2dup at-xy ."     |_|   |_|  \___|\___|" 1+
	2dup at-xy ."      ____   _____ _____" 1+
	2dup at-xy ."     |  _ \ / ____|  __ \" 1+
	2dup at-xy ."     | |_) | (___ | |  | |" 1+
	2dup at-xy ."     |  _ < \___ \| |  | |" 1+
	2dup at-xy ."     | |_) |____) | |__| |" 1+
	2dup at-xy ."     |     |      |      |" 1+
	     at-xy ."     |____/|_____/|_____/"
;

: print-logo ( x y -- )
	s" loader_logo" getenv
	dup -1 = if
		drop
		fbsdbw-logo
		exit
	then
	2dup s" fbsdbw" compare-insensitive 0= if
		2drop
		fbsdbw-logo
		exit
	then
	2dup s" beastiebw" compare-insensitive 0= if
		2drop
		beastiebw-logo
		exit
	then
	2dup s" beastie" compare-insensitive 0= if
		2drop
		beastie-logo
		exit
	then
	2dup s" none" compare-insensitive 0= if
		2drop
		\ no logo
		exit
	then
	2drop
	fbsdbw-logo
;

: acpienabled? ( -- flag )
	s" acpi_load" getenv
	dup -1 = if
		drop false exit
	then
	s" YES" compare-insensitive 0<> if
		false exit
	then
	s" hint.acpi.0.disabled" getenv
	dup -1 <> if
		s" 0" compare 0<> if
			false exit
		then
	else
		drop
	then
	true
;

: printmenuitem ( -- n )
	menuidx @
	1+ dup
	menuidx !
	menuY @ + dup menuX @ swap at-xy
	menuidx @ .
	menuX @ 1+ swap at-xy
	menubllt @ emit
	menuidx @ 48 +
;

: beastie-menu ( -- )
	0 menuidx !
	dot menubllt !
	8 menuY !
	5 menuX !
	clear
	46 4 print-logo
	42 20 2 2 box
	13 6 at-xy ." Welcome to FreeBSD!"
	printmenuitem ."  Boot FreeBSD [default]" bootkey !
	s" arch-i386" environment? if
		drop
		printmenuitem ."  Boot FreeBSD with ACPI " bootacpikey !
		acpienabled? if
			." disabled"
		else
			." enabled"
		then
	else
		-2 bootacpikey !
	then
	printmenuitem ."  Boot FreeBSD in Safe Mode" bootsafekey !
	printmenuitem ."  Boot FreeBSD in single user mode" bootsinglekey !
	printmenuitem ."  Boot FreeBSD with verbose logging" bootverbosekey !
	printmenuitem ."  Escape to loader prompt" escapekey !
	printmenuitem ."  Reboot" rebootkey !
	menuX @ 20 at-xy
	." Select option, [Enter] for default"
	menuX @ 21 at-xy
	s" or [Space] to pause timer    " dup 2 - promptwidth !
	type
;

: tkey
	seconds +
	begin 1 while
		over 0<> if
			dup seconds u< if
				drop
				-1
				exit
			then
			menuX @ promptwidth @ + 21 at-xy dup seconds - .
		then
		key? if
			drop
			key
			exit
		then
	50 ms
	repeat
;

set-current

: beastie-start
	s" beastie_disable" getenv
	dup -1 <> if
		s" YES" compare-insensitive 0= if
			exit
		then
	else
		drop
	then
	beastie-menu
	s" autoboot_delay" getenv
	dup -1 = if
		drop
		10
	else
		0 0 2swap >number drop drop drop
	then
	begin
		dup tkey
		0 25 at-xy
		dup 32 = if nip 0 swap then
		dup -1 = if 0 boot then
		dup 13 = if 0 boot then
		dup bootkey @ = if 0 boot then
		dup bootacpikey @ = if
			acpienabled? if
				s" acpi_load" unsetenv
				s" 1" s" hint.acpi.0.disabled" setenv
				s" 1" s" loader.acpi_disabled_by_user" setenv
			else
				s" YES" s" acpi_load" setenv
				s" 0" s" hint.acpi.0.disabled" setenv
			then
			0 boot
		then
		dup bootsafekey @ = if
			s" arch-i386" environment? if
				drop
				s" acpi_load" unsetenv
				s" 1" s" hint.acpi.0.disabled" setenv
				s" 1" s" loader.acpi_disabled_by_user" setenv
				s" 1" s" hint.apic.0.disabled" setenv
			then
			s" 0" s" hw.ata.ata_dma" setenv
			s" 0" s" hw.ata.atapi_dma" setenv
			s" 0" s" hw.ata.wc" setenv
			s" 0" s" hw.eisa_slots" setenv
			s" 1" s" hint.kbdmux.0.disabled" setenv
			0 boot
		then
		dup bootverbosekey @ = if
			s" YES" s" boot_verbose" setenv
			0 boot
		then
		dup bootsinglekey @ = if
			s" YES" s" boot_single" setenv
			0 boot
		then
		dup escapekey @ = if
			2drop
			s" NO" s" autoboot_delay" setenv
			exit
		then
		rebootkey @ = if 0 reboot then
	again
;

previous

\ Copyright (c) 2003 Scott Long <scottl@freebsd.org>
\ Copyright (c) 2003 Aleksander Fafula <alex@fafula.com>
\ All rights reserved.
\
\ Redistribution and use in source and binary forms, with or without
\ modification, are permitted provided that the following conditions
\ are met:
\ 1. Redistributions of source code must retain the above copyright
\    notice, this list of conditions and the following disclaimer.
\ 2. Redistributions in binary form must reproduce the above copyright
\    notice, this list of conditions and the following disclaimer in the
\    documentation and/or other materials provided with the distribution.
\
\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
\ ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
\ SUCH DAMAGE.
\
\ $FreeBSD$

marker task-beastie.4th

include /boot/screen.4th
include /boot/frames.4th

hide

variable menuidx
variable menubllt
variable menuX
variable menuY
variable promptwidth

variable bootkey
variable bootacpikey
variable bootusbkey
variable bootsafekey
variable bootverbosekey
variable bootsinglekey
variable escapekey
variable rebootkey

46 constant dot

\ The BSD Daemon.  He is 19 rows high and 34 columns wide
: beastie-logo ( x y -- )
2dup at-xy ."               ,        ," 1+
2dup at-xy ."              /(        )`" 1+
2dup at-xy ."              \ \___   / |" 1+
2dup at-xy ."              /- _  `-/  '" 1+
2dup at-xy ."             (/\/ \ \   /\" 1+
2dup at-xy ."             / /   | `    \" 1+
2dup at-xy ."             O O   ) /    |" 1+
2dup at-xy ."             `-^--'`<     '" 1+
2dup at-xy ."            (_.)  _  )   /" 1+
2dup at-xy ."             `.___/`    /       " 1+
2dup at-xy ."               `-----' /" 1+
2dup at-xy ."  <----.     __ / __   \" 1+
2dup at-xy ."  <----|====O)))==) \) /====|" 1+
2dup at-xy ."  <----'    `--' `.__,' \" 1+
2dup at-xy ."               |        |" 1+
2dup at-xy ."                \       /       /\" 1+
2dup at-xy ."           ______( (_  / \______/" 1+
2dup at-xy ."         ,'  ,-----'   |" 1+
at-xy ."         `--{__________) "
;

: beastiebw-logo ( x y -- )
	2dup at-xy ."              ,        ," 1+
	2dup at-xy ."             /(        )`" 1+
	2dup at-xy ."             \ \___   / |" 1+
	2dup at-xy ."             /- _  `-/  '" 1+
	2dup at-xy ."            (/\/ \ \   /\" 1+
	2dup at-xy ."            / /   | `    \" 1+
	2dup at-xy ."            O O   ) /    |" 1+
	2dup at-xy ."            `-^--'`<     '" 1+
	2dup at-xy ."           (_.)  _  )   /" 1+
	2dup at-xy ."            `.___/`    /" 1+
	2dup at-xy ."              `-----' /" 1+
	2dup at-xy ." <----.     __ / __   \" 1+
	2dup at-xy ." <----|====O)))==) \) /====" 1+
	2dup at-xy ." <----'    `--' `.__,' \" 1+
	2dup at-xy ."              |        |" 1+
	2dup at-xy ."               \       /       /\" 1+
	2dup at-xy ."          ______( (_  / \______/" 1+
	2dup at-xy ."        ,'  ,-----'   |" 1+
	     at-xy ."        `--{__________)"
;

: fbsdbw-logo ( x y -- )
	2dup at-xy ."      ______" 1+
	2dup at-xy ."     |  ____| __ ___  ___ " 1+
	2dup at-xy ."     | |__ | '__/ _ \/ _ \" 1+
	2dup at-xy ."     |  __|| | |  __/  __/" 1+
	2dup at-xy ."     | |   | | |    |    |" 1+
	2dup at-xy ."     |_|   |_|  \___|\___|" 1+
	2dup at-xy ."      ____   _____ _____" 1+
	2dup at-xy ."     |  _ \ / ____|  __ \" 1+
	2dup at-xy ."     | |_) | (___ | |  | |" 1+
	2dup at-xy ."     |  _ < \___ \| |  | |" 1+
	2dup at-xy ."     | |_) |____) | |__| |" 1+
	2dup at-xy ."     |     |      |      |" 1+
	     at-xy ."     |____/|_____/|_____/"
;

: print-logo ( x y -- )
	s" loader_logo" getenv
	dup -1 = if
		drop
		fbsdbw-logo
		exit
	then
	2dup s" fbsdbw" compare-insensitive 0= if
		2drop
		fbsdbw-logo
		exit
	then
	2dup s" beastiebw" compare-insensitive 0= if
		2drop
		beastiebw-logo
		exit
	then
	2dup s" beastie" compare-insensitive 0= if
		2drop
		beastie-logo
		exit
	then
	2dup s" none" compare-insensitive 0= if
		2drop
		\ no logo
		exit
	then
	2drop
	fbsdbw-logo
;

: acpienabled? ( -- flag )
	s" acpi_load" getenv
	dup -1 = if
		drop false exit
	then
	s" YES" compare-insensitive 0<> if
		false exit
	then
	s" hint.acpi.0.disabled" getenv
	dup -1 <> if
		s" 0" compare 0<> if
			false exit
		then
	else
		drop
	then
	true
;

: printmenuitem ( -- n )
	menuidx @
	1+ dup
	menuidx !
	menuY @ + dup menuX @ swap at-xy
	menuidx @ .
	menuX @ 1+ swap at-xy
	menubllt @ emit
	menuidx @ 48 +
;

: beastie-menu ( -- )
	0 menuidx !
	dot menubllt !
	8 menuY !
	5 menuX !
	clear
	46 4 print-logo
	42 20 2 2 box
	13 6 at-xy ." Welcome to FreeBSD!"
	printmenuitem ."  Boot FreeBSD [default]" bootkey !
	s" arch-i386" environment? if
		drop
		printmenuitem ."  Boot FreeBSD with ACPI " bootacpikey !
		acpienabled? if
			." disabled"
		else
			." enabled"
		then
	else
		-2 bootacpikey !
	then
	printmenuitem ."  Boot FreeBSD in Safe Mode" bootsafekey !
	printmenuitem ."  Boot FreeBSD in single user mode" bootsinglekey !
	printmenuitem ."  Boot FreeBSD with verbose logging" bootverbosekey !
	printmenuitem ."  Escape to loader prompt" escapekey !
	s" arch-i386" environment? if
		drop
		printmenuitem ."  Boot FreeBSD with USB keyboard" bootusbkey !
	else
		-2 bootusbkey !
	then
	printmenuitem ."  Reboot" rebootkey !
	menuX @ 20 at-xy
	." Select option, [Enter] for default"
	menuX @ 21 at-xy
	s" or [Space] to pause timer    " dup 2 - promptwidth !
	type
;

: tkey
	seconds +
	begin 1 while
		over 0<> if
			dup seconds u< if
				drop
				-1
				exit
			then
			menuX @ promptwidth @ + 21 at-xy dup seconds - .
		then
		key? if
			drop
			key
			exit
		then
	50 ms
	repeat
;

set-current

: beastie-start
	s" beastie_disable" getenv
	dup -1 <> if
		s" YES" compare-insensitive 0= if
			exit
		then
	else
		drop
	then
	beastie-menu
	s" autoboot_delay" getenv
	dup -1 = if
		drop
		10
	else
		0 0 2swap >number drop drop drop
	then
	begin
		dup tkey
		0 25 at-xy
		dup 32 = if nip 0 swap then
		dup -1 = if 0 boot then
		dup 13 = if 0 boot then
		dup bootkey @ = if 0 boot then
		dup bootacpikey @ = if
			acpienabled? if
				s" acpi_load" unsetenv
				s" 1" s" hint.acpi.0.disabled" setenv
				s" 1" s" loader.acpi_disabled_by_user" setenv
			else
				s" YES" s" acpi_load" setenv
				s" 0" s" hint.acpi.0.disabled" setenv
			then
			0 boot
		then
		dup bootusbkey @ = if
			s" 0x1" s" hint.atkbd.0.flags" setenv
			0 boot
		then
		dup bootsafekey @ = if
			s" arch-i386" environment? if
				drop
				s" acpi_load" unsetenv
				s" 1" s" hint.acpi.0.disabled" setenv
				s" 1" s" loader.acpi_disabled_by_user" setenv
				s" 1" s" hint.apic.0.disabled" setenv
			then
			s" 0" s" hw.ata.ata_dma" setenv
			s" 0" s" hw.ata.atapi_dma" setenv
			s" 0" s" hw.ata.wc" setenv
			s" 0" s" hw.eisa_slots" setenv
			0 boot
		then
		dup bootverbosekey @ = if
			s" YES" s" boot_verbose" setenv
			0 boot
		then
		dup bootsinglekey @ = if
			s" YES" s" boot_single" setenv
			0 boot
		then
		dup escapekey @ = if
			2drop
			s" NO" s" autoboot_delay" setenv
			exit
		then
		rebootkey @ = if 0 reboot then
	again
;

previous


Flag when ACPI has been disabled by the user so that sysinstall can do something with it.

\ Copyright (c) 2003 Scott Long <scottl@freebsd.org>
\ All rights reserved.
\
\ Redistribution and use in source and binary forms, with or without
\ modification, are permitted provided that the following conditions
\ are met:
\ 1. Redistributions of source code must retain the above copyright
\    notice, this list of conditions and the following disclaimer.
\ 2. Redistributions in binary form must reproduce the above copyright
\    notice, this list of conditions and the following disclaimer in the
\    documentation and/or other materials provided with the distribution.
\
\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
\ ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
\ SUCH DAMAGE.
\
\ $FreeBSD$

marker task-beastie.4th

include /boot/screen.4th
include /boot/frames.4th

hide

variable menuidx
variable menubllt
variable menuX
variable menuY
variable promptwidth

variable bootkey
variable bootacpikey
variable bootsafekey
variable bootverbosekey
variable bootsinglekey
variable escapekey
variable rebootkey

46 constant dot

\ The BSD Daemon.  He is 19 rows high and 34 columns wide
: print-beastie ( x y -- )
	2dup at-xy ."              ,        ," 1+
	2dup at-xy ."             /(        )`" 1+
	2dup at-xy ."             \\ \\___ / |" 1+
	2dup at-xy ."             /- _  `-/  '" 1+
	2dup at-xy ."            (/\\/ \\ \\ /\\" 1+
	2dup at-xy ."            / /   | `    \\" 1+
	2dup at-xy ."            O O   ) /    |" 1+
	2dup at-xy ."            `-^--'`<     '" 1+
	2dup at-xy ."           (_.)  _  )   /" 1+
	2dup at-xy ."            `.___/`    /" 1+
	2dup at-xy ."              `-----' /" 1+
	2dup at-xy ." <----.     __ / __   \\" 1+
	2dup at-xy ." <----|====O)))==) \\) /====" 1+
	2dup at-xy ." <----'    `--' `.__,' \\" 1+
	2dup at-xy ."              |        |" 1+
	2dup at-xy ."               \\       /       /\\" 1+
	2dup at-xy ."          ______( (_  / \\______/" 1+
	2dup at-xy ."        ,'  ,-----'   |" 1+
	     at-xy ."        `--{__________)"
;

: acpienabled? ( -- flag )
	s" acpi_load" getenv
	dup -1 = if
		drop false exit
	then
	s" YES" compare-insensitive 0<> if
		false exit
	then
	s" hint.acpi.0.disabled" getenv
	dup -1 <> if
		s" 0" compare 0<> if
			false exit
		then
	then
	true
;

: printmenuitem ( -- n )
	menuidx @
	1+ dup
	menuidx !
	menuY @ + dup menuX @ swap at-xy
	menuidx @ .
	menuX @ 1+ swap at-xy
	menubllt @ emit
	menuidx @ 48 +
;

: beastie-menu ( -- )
	0 menuidx !
	dot menubllt !
	8 menuY !
	5 menuX !
	clear
	46 4 print-beastie
	42 20 2 2 box
	13 6 at-xy ." Welcome to FreeBSD!"
	printmenuitem ."  Boot FreeBSD [default]" bootkey !
	s" arch-i386" environment? if
		printmenuitem ."  Boot FreeBSD with ACPI " bootacpikey !
		acpienabled? if
			." disabled"
		else
			." enabled"
		then
	else
		-2 bootacpikey !
	then
	printmenuitem ."  Boot FreeBSD in Safe Mode" bootsafekey !
	printmenuitem ."  Boot FreeBSD in single user mode" bootsinglekey !
	printmenuitem ."  Boot FreeBSD with verbose logging" bootverbosekey !
	printmenuitem ."  Escape to loader prompt" escapekey !
	printmenuitem ."  Reboot" rebootkey !
	menuX @ 20 at-xy
	." Select option, [Enter] for default"
	menuX @ 21 at-xy
	s" or [Space] to pause timer    " dup 2 - promptwidth !
	type
;

: tkey
	dup
	seconds +
	begin 1 while
		over 0<> if
			dup seconds u< if
				drop
				-1
				exit
			then
			menuX @ promptwidth @ + 21 at-xy dup seconds - .
		then
		key? if
			drop
			key
			exit
		then
	50 ms
	repeat
;

set-current

: beastie-start
	beastie-menu
	s" autoboot_delay" getenv
	dup -1 = if
		drop
		10
	else
		0 0 2swap >number drop drop drop
	then
	begin true while
		dup tkey
		0 25 at-xy
		dup 32 = if nip 0 swap then
		dup -1 = if s" boot" evaluate then
		dup 13 = if s" boot" evaluate then
		dup bootkey @ = if s" boot" evaluate then
		dup bootacpikey @ = if
			acpienabled? if
				s" acpi_load" unsetenv
				s" 1" s" hint.acpi.0.disabled" setenv
				s" 1" s" loader.acpi_disabled_by_user" setenv
			else
				s" YES" s" acpi_load" setenv
				s" 0" s" hint.acpi.0.disabled" setenv
			then
			s" boot" evaluate
		then
		dup bootsafekey @ = if
			s" arch-i386" environment? if
				s" acpi_load" unsetenv
				s" 1" s" hint.acpi.0.disabled" setenv
				s" 1" s" loader.acpi_disabled_by_user" setenv
			then
			s" 0" s" hw.ata.ata_dma" setenv
			s" 0" s" hw.ata.atapi_dma" setenv
			s" 0" s" hw.ata.wc" setenv
			s" 0" s" hw.eisa_slots" setenv
			s" boot" evaluate
		then
		dup bootverbosekey @ = if
			s" YES" s" boot_verbose" setenv
			s" boot" evaluate
		then
		dup bootsinglekey @ = if
			s" YES" s" boot_single" setenv
			s" boot" evaluate
		then
		dup escapekey @ = if 2drop exit then
		rebootkey @ = if s" reboot" evaluate then
	repeat
;

previous

\ Copyright (c) 2003 Scott Long <scottl@freebsd.org>
\ All rights reserved.
\
\ Redistribution and use in source and binary forms, with or without
\ modification, are permitted provided that the following conditions
\ are met:
\ 1. Redistributions of source code must retain the above copyright
\    notice, this list of conditions and the following disclaimer.
\ 2. Redistributions in binary form must reproduce the above copyright
\    notice, this list of conditions and the following disclaimer in the
\    documentation and/or other materials provided with the distribution.
\
\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
\ ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
\ SUCH DAMAGE.
\
\ $FreeBSD$

marker task-beastie.4th

include /boot/screen.4th
include /boot/frames.4th

hide

variable menuidx
variable menubllt
variable menuX
variable menuY
variable promptwidth

variable bootkey
variable bootacpikey
variable bootsafekey
variable bootverbosekey
variable bootsinglekey
variable escapekey
variable rebootkey

46 constant dot

\ The BSD Daemon.  He is 19 rows high and 34 columns wide
: print-beastie ( x y -- )
	2dup at-xy ."              ,        ," 1+
	2dup at-xy ."             /(        )`" 1+
	2dup at-xy ."             \\ \\___ / |" 1+
	2dup at-xy ."             /- _  `-/  '" 1+
	2dup at-xy ."            (/\\/ \\ \\ /\\" 1+
	2dup at-xy ."            / /   | `    \\" 1+
	2dup at-xy ."            O O   ) /    |" 1+
	2dup at-xy ."            `-^--'`<     '" 1+
	2dup at-xy ."           (_.)  _  )   /" 1+
	2dup at-xy ."            `.___/`    /" 1+
	2dup at-xy ."              `-----' /" 1+
	2dup at-xy ." <----.     __ / __   \\" 1+
	2dup at-xy ." <----|====O)))==) \\) /====" 1+
	2dup at-xy ." <----'    `--' `.__,' \\" 1+
	2dup at-xy ."              |        |" 1+
	2dup at-xy ."               \\       /       /\\" 1+
	2dup at-xy ."          ______( (_  / \\______/" 1+
	2dup at-xy ."        ,'  ,-----'   |" 1+
	     at-xy ."        `--{__________)"
;

: acpienabled? ( -- flag )
	s" acpi_load" getenv
	dup -1 = if
		drop false exit
	then
	s" YES" compare-insensitive 0<> if
		false exit
	then
	s" hint.acpi.0.disabled" getenv
	dup -1 <> if
		s" 0" compare 0<> if
			false exit
		then
	then
	true
;

: printmenuitem ( -- n )
	menuidx @
	1+ dup
	menuidx !
	menuY @ + dup menuX @ swap at-xy
	menuidx @ .
	menuX @ 1+ swap at-xy
	menubllt @ emit
	menuidx @ 48 +
;

: beastie-menu ( -- )
	0 menuidx !
	dot menubllt !
	8 menuY !
	5 menuX !
	clear
	46 4 print-beastie
	42 20 2 2 box
	13 6 at-xy ." Welcome to FreeBSD!"
	printmenuitem ."  Boot FreeBSD [default]" bootkey !
	s" arch-i386" environment? if
		printmenuitem ."  Boot FreeBSD with ACPI " bootacpikey !
		acpienabled? if
			." disabled"
		else
			." enabled"
		then
	else
		-2 bootacpikey !
	then
	printmenuitem ."  Boot FreeBSD in Safe Mode" bootsafekey !
	printmenuitem ."  Boot FreeBSD in single user mode" bootsinglekey !
	printmenuitem ."  Boot FreeBSD with verbose logging" bootverbosekey !
	printmenuitem ."  Escape to loader prompt" escapekey !
	printmenuitem ."  Reboot" rebootkey !
	menuX @ 20 at-xy
	." Select option, [Enter] for default"
	menuX @ 21 at-xy
	s" or [Space] to pause timer    " dup 2 - promptwidth !
	type
;

: tkey
	dup
	seconds +
	begin 1 while
		over 0<> if
			dup seconds u< if
				drop
				-1
				exit
			then
			menuX @ promptwidth @ + 21 at-xy dup seconds - .
		then
		key? if
			drop
			key
			exit
		then
	50 ms
	repeat
;

set-current

: beastie-start
	beastie-menu
	s" autoboot_delay" getenv
	dup -1 = if
		drop
		10
	else
		0 0 2swap >number drop drop drop
	then
	begin true while
		dup tkey
		0 25 at-xy
		dup 32 = if nip 0 swap then
		dup -1 = if s" boot" evaluate then
		dup 13 = if s" boot" evaluate then
		dup bootkey @ = if s" boot" evaluate then
		dup bootacpikey @ = if
			acpienabled? if
				s" acpi_load" unsetenv
				s" 1" s" hint.acpi.0.disabled" setenv
			else
				s" YES" s" acpi_load" setenv
				s" 0" s" hint.acpi.0.disabled" setenv
			then
			s" boot" evaluate
		then
		dup bootsafekey @ = if
			s" arch-i386" environment? if
				s" acpi_load" unsetenv
				s" 1" s" hint.acpi.0.disabled" setenv
			then
			s" 0" s" hw.ata.ata_dma" setenv
			s" 0" s" hw.ata.atapi_dma" setenv
			s" 0" s" hw.ata.wc" setenv
			s" 0" s" hw.eisa_slots" setenv
			s" boot" evaluate
		then
		dup bootverbosekey @ = if
			s" YES" s" boot_verbose" setenv
			s" boot" evaluate
		then
		dup bootsinglekey @ = if
			s" YES" s" boot_single" setenv
			s" boot" evaluate
		then
		dup escapekey @ = if 2drop exit then
		rebootkey @ = if s" reboot" evaluate then
	repeat
;

previous


?TWO-ADJACENT-1-BITS tests added

?TWO-ADJACENT-1-BITS tests added

\ KataDiversion tests, in Forth
\ running tests:
\   gforth KataDiversion_tests.fth -e bye

REQUIRE KataDiversion.fth

VARIABLE ASSERT-COUNT

: ASSERTS-INIT ( -- )
    0 ASSERT-COUNT ! ;

: ASSERTS-RESULT ( -- )
    ASSERT-COUNT @ . ." assertions successfully passed." CR ;

\ destructive assert-equal
: ASSERT-EQUAL-D ( n1 n2 -- )
    <> IF 1 ABORT" AssertEqual: Fail"
            ELSE ASSERT-COUNT @ 1+ ASSERT-COUNT ! THEN ;

\ non-destructive assert-equal
: ASSERT-EQUAL ( n1 n2 -- n1 n2 )
    2DUP ASSERT-EQUAL-D ;

\ destructive assert-true
: ASSERT-TRUE-D ( n -- )
    0 = IF 1 ABORT" AssertTrue: Fail"
            ELSE ASSERT-COUNT @ 1+ ASSERT-COUNT ! THEN ;

\ non-destructive assert-true
: ASSERT-TRUE ( n -- n )
    DUP ASSERT-TRUE-D ;

\ destructive assert-false
: ASSERT-False-D ( n -- )
    0 <> IF 1 ABORT" AssertFalse: Fail"
            ELSE ASSERT-COUNT @ 1+ ASSERT-COUNT ! THEN ;

\ non-destructive assert-false
: ASSERT-FALSE ( n -- n )
    DUP ASSERT-FALSE-D ;

\ ---- tests ----

ASSERTS-INIT

\ ?EMPTY
EMPTY         DEPTH 0 ASSERT-EQUAL-D
EMPTY EMPTY   DEPTH 0 ASSERT-EQUAL-D
0 EMPTY       DEPTH 0 ASSERT-EQUAL-D
1 2 3 4 EMPTY DEPTH 0 ASSERT-EQUAL-D

\ ?NEGATIVE
-1 ?NEG ASSERT-TRUE-D
 0 ?NEG ASSERT-TRUE-D
 1 ?NEG ASSERT-FALSE-D

\ ?MAX-NB
-1 ?MAX-NB  0   ASSERT-EQUAL-D
 0 ?MAX-NB  0   ASSERT-EQUAL-D
 1 ?MAX-NB  2   ASSERT-EQUAL-D
 2 ?MAX-NB  4   ASSERT-EQUAL-D
 3 ?MAX-NB  8   ASSERT-EQUAL-D

\ LOG2
 1 LOG2  0 ASSERT-EQUAL-D
 2 LOG2  1 ASSERT-EQUAL-D
 3 LOG2  1 ASSERT-EQUAL-D
 4 LOG2  2 ASSERT-EQUAL-D
 5 LOG2  2 ASSERT-EQUAL-D
 8 LOG2  3 ASSERT-EQUAL-D
42 LOG2  5 ASSERT-EQUAL-D

   1 ?TWO-ADJACENT-1-BITS  0 ASSERT-EQUAL-D
   2 ?TWO-ADJACENT-1-BITS  0 ASSERT-EQUAL-D
   3 ?TWO-ADJACENT-1-BITS -1 ASSERT-EQUAL-D
   6 ?TWO-ADJACENT-1-BITS -1 ASSERT-EQUAL-D
   7 ?TWO-ADJACENT-1-BITS -1 ASSERT-EQUAL-D
   8 ?TWO-ADJACENT-1-BITS  0 ASSERT-EQUAL-D
  11 ?TWO-ADJACENT-1-BITS -1 ASSERT-EQUAL-D
  65 ?TWO-ADJACENT-1-BITS  0 ASSERT-EQUAL-D
3072 ?TWO-ADJACENT-1-BITS -1 ASSERT-EQUAL-D

ASSERTS-RESULT
\ ---------

\ KataDiversion tests, in Forth
\ running tests:
\   gforth KataDiversion_tests.fth -e bye

REQUIRE KataDiversion.fth

VARIABLE ASSERT-COUNT

: ASSERTS-INIT ( -- )
    0 ASSERT-COUNT ! ;

: ASSERTS-RESULT ( -- )
    ASSERT-COUNT @ . ." assertions successfully passed." CR ;

\ destructive assert-equal
: ASSERT-EQUAL-D ( n1 n2 -- )
    <> IF 1 ABORT" AssertEqual: Fail"
            ELSE ASSERT-COUNT @ 1+ ASSERT-COUNT ! THEN ;

\ non-destructive assert-equal
: ASSERT-EQUAL ( n1 n2 -- n1 n2 )
    2DUP ASSERT-EQUAL-D ;

\ destructive assert-true
: ASSERT-TRUE-D ( n -- )
    0 = IF 1 ABORT" AssertTrue: Fail"
            ELSE ASSERT-COUNT @ 1+ ASSERT-COUNT ! THEN ;

\ non-destructive assert-true
: ASSERT-TRUE ( n -- n )
    DUP ASSERT-TRUE-D ;

\ destructive assert-false
: ASSERT-False-D ( n -- )
    0 <> IF 1 ABORT" AssertFalse: Fail"
            ELSE ASSERT-COUNT @ 1+ ASSERT-COUNT ! THEN ;

\ non-destructive assert-false
: ASSERT-FALSE ( n -- n )
    DUP ASSERT-FALSE-D ;

\ ---- tests ----

ASSERTS-INIT

\ ?EMPTY
EMPTY         DEPTH 0 ASSERT-EQUAL-D
EMPTY EMPTY   DEPTH 0 ASSERT-EQUAL-D
0 EMPTY       DEPTH 0 ASSERT-EQUAL-D
1 2 3 4 EMPTY DEPTH 0 ASSERT-EQUAL-D

\ ?NEGATIVE
-1 ?NEG ASSERT-TRUE-D
 0 ?NEG ASSERT-TRUE-D
 1 ?NEG ASSERT-FALSE-D

\ ?MAX-NB
-1 ?MAX-NB  0   ASSERT-EQUAL-D
 0 ?MAX-NB  0   ASSERT-EQUAL-D
 1 ?MAX-NB  2   ASSERT-EQUAL-D
 2 ?MAX-NB  4   ASSERT-EQUAL-D
 3 ?MAX-NB  8   ASSERT-EQUAL-D

\ LOG2
 1 LOG2  0 ASSERT-EQUAL-D
 2 LOG2  1 ASSERT-EQUAL-D
 3 LOG2  1 ASSERT-EQUAL-D
 4 LOG2  2 ASSERT-EQUAL-D
 5 LOG2  2 ASSERT-EQUAL-D
 8 LOG2  3 ASSERT-EQUAL-D
42 LOG2  5 ASSERT-EQUAL-D

\ DEC2BIN

 0 DEC2BIN 0 ASSERT-EQUAL-D
 1 DEC2BIN 1 ASSERT-EQUAL-D
 2 DEC2BIN 0 ASSERT-EQUAL-D ( 2 -> 10 )
           1 ASSERT-EQUAL-D
11 DEC2BIN 1 ASSERT-EQUAL-D ( 11 -> 1011 )
           1 ASSERT-EQUAL-D
           0 ASSERT-EQUAL-D
           1 ASSERT-EQUAL-D

ASSERTS-RESULT
\ ---------


add ZERO (aka ERASE) function

add ZERO (aka ERASE) function

( Implementations of builtins.
  These functions are provided for the host in the msp430.asm.forth module. The
  implementations here are for the target.

  vi:ft=forth
)

( ----- low level supporting functions ----- )

CODE LIT
    ." \t push @IP+   \t; copy value from thread to stack \n "
    ASM-NEXT
END-CODE

CODE BRANCH
    ." \t add @IP, IP \n "
    ASM-NEXT
END-CODE

CODE BRANCH0
    ." \t mov @IP+, W \t; get offset \n "
    ." \t tst 0(SP)   \t; check TOS \n "
    ." \t jnz .Lnjmp  \t; skip next if non zero \n "
    ." \t decd IP     \t; offset is relative to position of offset, correct \n "
    ." \t add W, IP   \t; adjust IP \n "
." .Lnjmp: "
    ASM-DROP
    ASM-NEXT
END-CODE

( ----- Stack ops ----- )

CODE DROP
    ." \t incd SP\n "
    ASM-NEXT
END-CODE

CODE DUP
(    ." \t push @SP\n " )
    ." \t mov @SP, W\n "
    ." \t push W\n "
    ASM-NEXT
END-CODE

CODE OVER
(    ." \t push 2(TOS\n " )
    ." \t mov 2(SP), W\n "
    ." \t push W\n "
    ASM-NEXT
END-CODE

( Push a copy of the N'th element )
CODE PICK ( n - n )
    TOS->W                    ( get element number from stack )
    ." \t rla W " LF          ( multiply by 2 -> 2 byte / cell )
    ." \t add SP, W " LF      ( calculate address on stack )
    ." \t push 0(W) " LF
    ASM-NEXT
END-CODE

CODE SWAP ( y x - x y )
    ." \t mov 2(SP), W " LF
    ." \t mov 0(SP), 2(SP) " LF
    ." \t mov W, 0(SP) " LF
    ASM-NEXT
END-CODE

( ----- Return Stack ops ----- )

( Move x to the return stack. )
CODE >R ( x -- ) ( R: -- x )
    ." \t decd RTOS \t; make room on the return stack\n "
    ." \t pop 0(RTOS) \t; pop value and put it on return stack\n "
    ASM-NEXT
END-CODE

( Move x from the return stack to the data stack. )
CODE R> ( -- x ) ( R: x -- )
    ." \t push @RTOS+ \t; pop from return stack, push to data stack\n "
    ASM-NEXT
END-CODE

( Copy x from the return stack to the data stack. )
CODE R@ ( -- x ) ( R: x -- x )
    ." \t push @RTOS \t; push copy of RTOS to data stack\n "
    ASM-NEXT
END-CODE

( ----- MATH ----- )

CODE +
    ." \t add 0(SP), 2(SP) \t; y = x + y " LF
    ASM-DROP
    ASM-NEXT
END-CODE

CODE -
    ." \t sub 0(SP), 2(SP) \t; y = y - x " LF
    ASM-DROP
    ASM-NEXT
END-CODE

( ----- bit - ops ----- )
CODE AND
    ." \t and 0(SP), 2(SP) \t; y = x & y " LF
    ASM-DROP
    ASM-NEXT
END-CODE

CODE OR
    ." \t bis 0(SP), 2(SP) \t; y = x | y " LF
    ASM-DROP
    ASM-NEXT
END-CODE

CODE XOR
    ." \t xor 0(SP), 2(SP) \t; y = x ^ y " LF
    ASM-DROP
    ASM-NEXT
END-CODE

CODE INVERT
    ." \t inv 0(SP) \t; x = ~x " LF
    ASM-NEXT
END-CODE

( Multiply by two (arithmetic left shift) )
CODE 2* ( n -- n*2 )
    ." \t rla 0(SP) \t; x <<= 1 " LF
    ASM-NEXT
END-CODE

( Divide by two (arithmetic right shift) )
CODE 2/ ( n -- n/2 )
    ." \t rra 0(SP) \t; x >>= 1 " LF
    ASM-NEXT
END-CODE

( Logical left shift by u bits )
CODE LSHIFT ( n u -- n*2^u )
    TOS->W
    ." .lsh:\t clrc " LF
    ." \t rlc 0(SP) \t; x <<= 1 " LF
    ." \t dec W " LF
    ." \t jnz .lsh W " LF
    ASM-NEXT
END-CODE

( Logical right shift by u bits )
CODE RSHIFT ( n -- n/2^-u )
    TOS->W
    ." .rsh:\t clrc " LF
    ." \t rrc 0(SP) \t; x >>= 1 " LF
    ." \t dec W " LF
    ." \t jnz .rsh W " LF
    ASM-NEXT
END-CODE

( ----- Logic ops ----- )
( include normalize to boolean )

CODE NOT
    ." \t tst 0(SP) " LF
    ." \t jnz .not0 " LF
    ." \t mov \x23 -1, 0(SP) " LF       ( replace TOS w/ result )
    ." \t jmp .not2 " LF
    ." .not0: " LF
    ." \t mov \x23 0, 0(SP) " LF       ( replace TOS w/ result )
    ." .not2: " LF
    ASM-NEXT
END-CODE

( ---------------------------------------------------
    "*"
    "/"
)
( ----- Compare ----- )
CODE cmp_set_true   ( n - n )
    ." \t mov \x23 -1, 0(SP) " LF   ( replace argument w/ result )
    ASM-NEXT
END-CODE

CODE cmp_set_false
    ." \t mov \x23 0, 0(SP) " LF   ( replace argument w/ result )
    ASM-NEXT
END-CODE

CODE cmp_true
    ASM-DROP                        ( remove 1nd argument )
    ." \t mov \x23 -1, 0(SP) " LF   ( replace 2nd argument w/ result )
    ASM-NEXT
END-CODE

CODE cmp_false
    ASM-DROP                        ( remove 1nd argument )
    ." \t mov \x23 0, 0(SP) " LF    ( replace 2nd argument w/ result )
    ASM-NEXT
END-CODE

CODE <
    DEPENDS-ON cmp_true
    DEPENDS-ON cmp_false
    ." \t cmp 0(SP), 2(SP) " LF
    ." \t jl  _cmp_true " LF
    ." \t jmp _cmp_false " LF
END-CODE

CODE >
    DEPENDS-ON cmp_true
    DEPENDS-ON cmp_false
    ." \t cmp 2(SP), 0(SP) " LF
    ." \t jl  _cmp_true " LF
    ." \t jmp _cmp_false " LF
END-CODE

CODE <=
    DEPENDS-ON cmp_true
    DEPENDS-ON cmp_false
    ." \t cmp 0(SP), 2(SP) " LF
    ." \t jge _cmp_false " LF
    ." \t jmp _cmp_true " LF
END-CODE

CODE >=
    DEPENDS-ON cmp_true
    DEPENDS-ON cmp_false
    ." \t cmp 0(SP), 2(SP) " LF
    ." \t jge _cmp_true " LF
    ." \t jmp _cmp_false " LF
END-CODE

CODE ==
    DEPENDS-ON cmp_true
    DEPENDS-ON cmp_false
    ." \t cmp 0(SP), 2(SP) " LF
    ." \t jeq _cmp_true " LF
    ." \t jmp _cmp_false " LF
END-CODE

( XXX alias for == )
CODE =
    DEPENDS-ON cmp_true
    DEPENDS-ON cmp_false
    ." \t cmp 0(SP), 2(SP) " LF
    ." \t jeq _cmp_true " LF
    ." \t jmp _cmp_false " LF
END-CODE

CODE !=
    DEPENDS-ON cmp_true
    DEPENDS-ON cmp_false
    ." \t cmp 0(SP), 2(SP) " LF
    ." \t jne _cmp_true " LF
    ." \t jmp _cmp_false " LF
END-CODE

CODE 0=
    DEPENDS-ON cmp_set_true
    DEPENDS-ON cmp_set_false
    ." \t tst 0(SP) " LF
    ." \t jz  _cmp_set_true " LF
    ." \t jmp _cmp_set_false " LF
END-CODE

CODE 0>
    DEPENDS-ON cmp_set_true
    DEPENDS-ON cmp_set_false
    ." \t tst 0(SP) " LF
    ." \t jn  _cmp_set_false " LF
    ." \t jmp _cmp_set_true " LF
END-CODE

( --------------------------------------------------- )

( XXX Forth name ERASE conflicts with FCTL bit name in MSP430 )
( Erase memory area )
CODE ZERO ( adr u - )
    TOS->W      ( count )
    TOS->R15    ( address )
    ." .erase_loop: clr.b 0(R15)\n"
    ." \t inc R15\n"
    ." \t dec W\n"
    ." \t jnz .erase_loop\n"
    ASM-NEXT
END-CODE

( --------------------------------------------------- )
( helper for ." )
CODE __write_text
    ." \t mov @IP+, R15\n"
    ." \t call \x23 write\n"
    ASM-NEXT
END-CODE

( Implementations of builtins.
  These functions are provided for the host in the msp430.asm.forth module. The
  implementations here are for the target.

  vi:ft=forth
)

( ----- low level supporting functions ----- )

CODE LIT
    ." \t push @IP+   \t; copy value from thread to stack \n "
    ASM-NEXT
END-CODE

CODE BRANCH
    ." \t add @IP, IP \n "
    ASM-NEXT
END-CODE

CODE BRANCH0
    ." \t mov @IP+, W \t; get offset \n "
    ." \t tst 0(SP)   \t; check TOS \n "
    ." \t jnz .Lnjmp  \t; skip next if non zero \n "
    ." \t decd IP     \t; offset is relative to position of offset, correct \n "
    ." \t add W, IP   \t; adjust IP \n "
." .Lnjmp: "
    ASM-DROP
    ASM-NEXT
END-CODE

( ----- Stack ops ----- )

CODE DROP
    ." \t incd SP\n "
    ASM-NEXT
END-CODE

CODE DUP
(    ." \t push @SP\n " )
    ." \t mov @SP, W\n "
    ." \t push W\n "
    ASM-NEXT
END-CODE

CODE OVER
(    ." \t push 2(TOS\n " )
    ." \t mov 2(SP), W\n "
    ." \t push W\n "
    ASM-NEXT
END-CODE

( Push a copy of the N'th element )
CODE PICK ( n - n )
    TOS->W                    ( get element number from stack )
    ." \t rla W " LF          ( multiply by 2 -> 2 byte / cell )
    ." \t add SP, W " LF      ( calculate address on stack )
    ." \t push 0(W) " LF
    ASM-NEXT
END-CODE

CODE SWAP ( y x - x y )
    ." \t mov 2(SP), W " LF
    ." \t mov 0(SP), 2(SP) " LF
    ." \t mov W, 0(SP) " LF
    ASM-NEXT
END-CODE

( ----- Return Stack ops ----- )

( Move x to the return stack. )
CODE >R ( x -- ) ( R: -- x )
    ." \t decd RTOS \t; make room on the return stack\n "
    ." \t pop 0(RTOS) \t; pop value and put it on return stack\n "
    ASM-NEXT
END-CODE

( Move x from the return stack to the data stack. )
CODE R> ( -- x ) ( R: x -- )
    ." \t push @RTOS+ \t; pop from return stack, push to data stack\n "
    ASM-NEXT
END-CODE

( Copy x from the return stack to the data stack. )
CODE R@ ( -- x ) ( R: x -- x )
    ." \t push @RTOS \t; push copy of RTOS to data stack\n "
    ASM-NEXT
END-CODE

( ----- MATH ----- )

CODE +
    ." \t add 0(SP), 2(SP) \t; y = x + y " LF
    ASM-DROP
    ASM-NEXT
END-CODE

CODE -
    ." \t sub 0(SP), 2(SP) \t; y = y - x " LF
    ASM-DROP
    ASM-NEXT
END-CODE

( ----- bit - ops ----- )
CODE AND
    ." \t and 0(SP), 2(SP) \t; y = x & y " LF
    ASM-DROP
    ASM-NEXT
END-CODE

CODE OR
    ." \t bis 0(SP), 2(SP) \t; y = x | y " LF
    ASM-DROP
    ASM-NEXT
END-CODE

CODE XOR
    ." \t xor 0(SP), 2(SP) \t; y = x ^ y " LF
    ASM-DROP
    ASM-NEXT
END-CODE

CODE INVERT
    ." \t inv 0(SP) \t; x = ~x " LF
    ASM-NEXT
END-CODE

( Multiply by two (arithmetic left shift) )
CODE 2* ( n -- n*2 )
    ." \t rla 0(SP) \t; x <<= 1 " LF
    ASM-NEXT
END-CODE

( Divide by two (arithmetic right shift) )
CODE 2/ ( n -- n/2 )
    ." \t rra 0(SP) \t; x >>= 1 " LF
    ASM-NEXT
END-CODE

( Logical left shift by u bits )
CODE LSHIFT ( n u -- n*2^u )
    TOS->W
    ." .lsh:\t clrc " LF
    ." \t rlc 0(SP) \t; x <<= 1 " LF
    ." \t dec W " LF
    ." \t jnz .lsh W " LF
    ASM-NEXT
END-CODE

( Logical right shift by u bits )
CODE RSHIFT ( n -- n/2^-u )
    TOS->W
    ." .rsh:\t clrc " LF
    ." \t rrc 0(SP) \t; x >>= 1 " LF
    ." \t dec W " LF
    ." \t jnz .rsh W " LF
    ASM-NEXT
END-CODE

( ----- Logic ops ----- )
( include normalize to boolean )

CODE NOT
    ." \t tst 0(SP) " LF
    ." \t jnz .not0 " LF
    ." \t mov \x23 -1, 0(SP) " LF       ( replace TOS w/ result )
    ." \t jmp .not2 " LF
    ." .not0: " LF
    ." \t mov \x23 0, 0(SP) " LF       ( replace TOS w/ result )
    ." .not2: " LF
    ASM-NEXT
END-CODE

( ---------------------------------------------------
    "*"
    "/"
)
( ----- Compare ----- )
CODE cmp_set_true   ( n - n )
    ." \t mov \x23 -1, 0(SP) " LF   ( replace argument w/ result )
    ASM-NEXT
END-CODE

CODE cmp_set_false
    ." \t mov \x23 0, 0(SP) " LF   ( replace argument w/ result )
    ASM-NEXT
END-CODE

CODE cmp_true
    ASM-DROP                        ( remove 1nd argument )
    ." \t mov \x23 -1, 0(SP) " LF   ( replace 2nd argument w/ result )
    ASM-NEXT
END-CODE

CODE cmp_false
    ASM-DROP                        ( remove 1nd argument )
    ." \t mov \x23 0, 0(SP) " LF    ( replace 2nd argument w/ result )
    ASM-NEXT
END-CODE

CODE <
    DEPENDS-ON cmp_true
    DEPENDS-ON cmp_false
    ." \t cmp 0(SP), 2(SP) " LF
    ." \t jl  _cmp_true " LF
    ." \t jmp _cmp_false " LF
END-CODE

CODE >
    DEPENDS-ON cmp_true
    DEPENDS-ON cmp_false
    ." \t cmp 2(SP), 0(SP) " LF
    ." \t jl  _cmp_true " LF
    ." \t jmp _cmp_false " LF
END-CODE

CODE <=
    DEPENDS-ON cmp_true
    DEPENDS-ON cmp_false
    ." \t cmp 0(SP), 2(SP) " LF
    ." \t jge _cmp_false " LF
    ." \t jmp _cmp_true " LF
END-CODE

CODE >=
    DEPENDS-ON cmp_true
    DEPENDS-ON cmp_false
    ." \t cmp 0(SP), 2(SP) " LF
    ." \t jge _cmp_true " LF
    ." \t jmp _cmp_false " LF
END-CODE

CODE ==
    DEPENDS-ON cmp_true
    DEPENDS-ON cmp_false
    ." \t cmp 0(SP), 2(SP) " LF
    ." \t jeq _cmp_true " LF
    ." \t jmp _cmp_false " LF
END-CODE

( XXX alias for == )
CODE =
    DEPENDS-ON cmp_true
    DEPENDS-ON cmp_false
    ." \t cmp 0(SP), 2(SP) " LF
    ." \t jeq _cmp_true " LF
    ." \t jmp _cmp_false " LF
END-CODE

CODE !=
    DEPENDS-ON cmp_true
    DEPENDS-ON cmp_false
    ." \t cmp 0(SP), 2(SP) " LF
    ." \t jne _cmp_true " LF
    ." \t jmp _cmp_false " LF
END-CODE

CODE 0=
    DEPENDS-ON cmp_set_true
    DEPENDS-ON cmp_set_false
    ." \t tst 0(SP) " LF
    ." \t jz  _cmp_set_true " LF
    ." \t jmp _cmp_set_false " LF
END-CODE

CODE 0>
    DEPENDS-ON cmp_set_true
    DEPENDS-ON cmp_set_false
    ." \t tst 0(SP) " LF
    ." \t jn  _cmp_set_false " LF
    ." \t jmp _cmp_set_true " LF
END-CODE

( --------------------------------------------------- )
( helper for ." )
CODE __write_text
    ." \t mov @IP+, R15\n"
    ." \t call \x23 write\n"
    ASM-NEXT
END-CODE


report immediate for immediate : words

report immediate for immediate : words

\
\ Decompiler words.
\
\ TODO:
\
\ - Detect defer / vector: words and show target
\ - Detect create, does> words and dump better
\

vocabulary decompiler
also decompiler definitions

: tab  ht emit  ;
: >target    ( ip-of-branch -- adr )  ta1+ dup @ /token * +  ;
: forward?   ( ip-of-branch -- f )    ta1+ @ 0>  ;
: backward?  ( ip-of-branch -- f )    ta1+ @ 0>  ;

: .type
   dup ['] (do)     = if  drop  ." do" cr tab tab  exit  then
   dup ['] (loop)   = if  drop  ta1+ cr tab ." loop" cr tab  exit  then
   dup ['] lit      = if  drop  ta1+ ."  h# " dup @ . exit  then
   dup ['] branch   = if  .name ta1+ ."  h# " dup @ . exit then
   dup ['] ?branch  = if  .name ta1+ ."  h# " dup @ . exit then
   dup ['] (.")     = if
      [char] . emit [char] " emit space
      drop ta1+  dup count type
      [char] " emit space
      dup c@ 1+ talign + /token -
      exit
   then
   dup ['] (abort") = if
      ." abort" [char] " emit space
      drop ta1+ dup count type [char] " emit space
      dup c@ talign + /token - exit
   then
   .name space
;
: .variable
   ." variable " dup .name
   ."   contents: " >body >user @ . cr
;
: .constant
   dup >body @ . ."  constant " .name cr
;
: .:
   ." : " dup .name cr
   dup
   tab >body
   begin
      dup @ ['] unnest <> while
      dup @ .type
      ta1+
   repeat
   drop cr ." ; "
   immediate? if ." immediate" then
   cr
;
previous definitions

also decompiler
: (see)
   dup @ do-variable  = if  .variable exit  then
   dup @ do-constant  = if  .constant exit  then
   dup @ do-primitive = if  ." primitive " .name cr exit  then
   dup @ do-colon     = if  .:  exit  then
   dup @ do-create    = if  ." create " .name cr exit  then
   ." create " .name cr  ."   does> " cr
;
: see  ( -- ) \ name
   ' (see)
;
previous

\
\ Decompiler words.
\
\ TODO:
\
\ - Detect defer / vector: words and show target
\ - Detect create, does> words and dump better
\

vocabulary decompiler
also decompiler definitions

: tab  ht emit  ;
: >target    ( ip-of-branch -- adr )  ta1+ dup @ /token * +  ;
: forward?   ( ip-of-branch -- f )    ta1+ @ 0>  ;
: backward?  ( ip-of-branch -- f )    ta1+ @ 0>  ;

: .type
   dup ['] (do)     = if  drop  ." do" cr tab tab  exit  then
   dup ['] (loop)   = if  drop  ta1+ cr tab ." loop" cr tab  exit  then
   dup ['] lit      = if  drop  ta1+ ."  h# " dup @ . exit  then
   dup ['] branch   = if  .name ta1+ ."  h# " dup @ . exit then
   dup ['] ?branch  = if  .name ta1+ ."  h# " dup @ . exit then
   dup ['] (.")     = if
      [char] . emit [char] " emit space
      drop ta1+  dup count type
      [char] " emit space
      dup c@ 1+ talign + /token -
      exit
   then
   dup ['] (abort") = if
      ." abort" [char] " emit space
      drop ta1+ dup count type [char] " emit space
      dup c@ talign + /token - exit
   then
   .name space
;
: .variable
   ." variable " dup .name
   ."   contents: " >body >user @ . cr
;
: .constant
   dup >body @ . ."  constant " .name cr
;
: .:
   ." : " dup .name cr
   tab >body
   begin
      dup @ ['] unnest <> while
      dup @ .type
      ta1+
   repeat
   drop cr ." ;" cr
;
previous definitions

also decompiler
: (see)
   dup @ do-variable  = if  .variable exit  then
   dup @ do-constant  = if  .constant exit  then
   dup @ do-primitive = if  ." primitive " .name cr exit  then
   dup @ do-colon     = if  .:  exit  then
   dup @ do-create    = if  ." create " .name cr exit  then
   ." create " .name cr  ."   does> " cr
;
: see  ( -- ) \ name
   ' (see)
;
previous


improve example

improve example

\ vi:ft=forth
\
\ Serial input output [X-Protocol] Example.
\ Hardware: Launchpad
\ Serial Port Settings: 2400,8,N,1
\
\ Notes
\ -----
\ The RED LED is blinking periodically. Its timing is made with the
\ Watchdog module configured as timer.
\
\ The RED LED is configured as ADC input when it is not active. This allows
\ to show the photo-sensitivity of the LED (compare ADC measurements of
\ channel 0 with bright and low ambient light).
\
\ Due to issues with the CDC-ACM driver under Linux are no messages sent
\ by the MSP430 on its own. All commands are initiated by the PC.
\
\ Copyright (C) 2011 Chris Liechti <cliechti@gmx.net>
\ All Rights Reserved.
\ Simplified BSD License (see LICENSE.txt for full text)

( - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - )
INCLUDE core.forth
INCLUDE msp430.forth
INCLUDE io.forth

( - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - )

( Write null terminated string using TimerA UART )
CODE WRITE ( s -- )
    TOS->R15
    ." \t call \x23 write\n "
    ASM-NEXT
END-CODE

( Output character using the TimerA UART )
CODE EMIT ( u -- )
    TOS->R15
    ." \t call \x23 putchar\n "
    ASM-NEXT
END-CODE

( Initialize TimerA UART for reception )
CODE TIMER_A_UART_INIT ( -- )
    ." \t call \x23 timer_uart_rx_setup\n "
    ASM-NEXT
END-CODE

( Fetch received character from TimerA UART )
CODE RX-CHAR ( -- u )
    ." \t mov.b timer_a_uart_rxd, W\n "
    ." \t push W\n "
    ASM-NEXT
END-CODE

( Perform a single ADC10 measurement )
CODE ADC10 ( u -- u )
    TOS->R15
    ." \t call \x23 single_adc10\n "
    R15->TOS
    ASM-NEXT
END-CODE

( - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - )
( Control the LEDs on the Launchpad )
: RED_ON    ( -- ) BIT0 P1DIR CSET   BIT0 ADC10AE0 CRESET ;
: RED_OFF   ( -- ) BIT0 P1DIR CRESET BIT0 ADC10AE0 CSET ;
: GREEN_ON  ( -- ) BIT6 P1OUT CSET ;
: GREEN_OFF ( -- ) BIT6 P1OUT CRESET ;

( Read in the button on the Launchpad )
: S2        BIT3 P1IN CTESTBIT NOT ;

( Delay functions )
: SHORT-DELAY     ( -- ) 0x4fff DELAY ;
: LONG-DELAY      ( -- ) 0xffff DELAY ;
: VERY-LONG-DELAY ( -- ) LONG-DELAY LONG-DELAY ;
( - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - )
( Simple event handler. A bit field is used to keep track of events. )
VARIABLE EVENTS
( Bit masks for the individual events )
BIT0 CONSTANT KEY-EVENT
BIT1 CONSTANT TIMER-EVENT
BIT2 CONSTANT RX-EVENT

( ------ Helper functions ------ )
( Start an event )
: START ( u -- ) EVENTS CSET ;
( Test if event was started. Reset its flag anyway and return true when it was set. )
: PENDING? ( -- b )
    DUP                 ( copy bit mask )
    EVENTS CTESTBIT IF  ( test if bit is set )
        EVENTS CRESET   ( it is, reset )
        TRUE            ( indicate true as return value )
    ELSE
        DROP            ( drop bit mask )
        FALSE           ( indicate false as return value )
    ENDIF
;
( Return true if no events are pending )
: IDLE? ( -- b )
    EVENTS C@ 0=
;
( - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - )

( Interrupt handler for P1 )
PORT1_VECTOR INTERRUPT P1-IRQ-HANDLER
    KEY-EVENT START     ( Set event flag for key )
    WAKEUP              ( terminate LPM modes )
    0 P1IFG C!          ( clear all interrupt flags )
END-INTERRUPT

( - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - )

( Watchdog interrupts with SMCLK = 1MHz are too fast for us.
  Only wakeup every n-th interrupt. This is the counter
  used to achieve this. )
VARIABLE SLOWDOWN

( Interrupt handler for Watchdog module in timer mode )
WDT_VECTOR INTERRUPT WATCHDOG-TIMER-HANDLER
    SLOWDOWN C@ 1+      ( get and increment counter )
    DUP 30 > IF         ( check value )
        TIMER-EVENT START ( set event flag for timer )
        WAKEUP          ( terminate LPM modes )
        DROP 0          ( reset counter )
    ENDIF
    SLOWDOWN C!         ( store new value )
END-INTERRUPT

( - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - )

( Received data is put into a small line buffer. When a newline
  is received processing in the foreground is started.
)
0 VALUE RX-POS
RAM CREATE RX-BUFFER 8 ALLOT

100 INTERRUPT TAUART_RX_INTERRUPT
    RX-CHAR DUP             ( get the received character )
    RX-BUFFER RX-POS + C!   ( store character )
    RX-POS 7 < IF           ( increment write pos if there is space )
        RX-POS 1+ TO RX-POS
    ENDIF
    '\n' = IF               ( check for EOL )
        RX-EVENT START      ( set event flag for reception )
        WAKEUP              ( terminate LPM modes )
        0 TO RX-POS         ( reset read position )
    ENDIF
END-INTERRUPT

( - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - )
( Initializations run after reset )
: INIT ( -- )
    ( Initialize pins )
    OUT TACCTL0 !       ( Init Timer A CCTL before pin is activated DIR, SEL)
    [ BIT0 BIT1 + ] LITERAL P1OUT C! ( RED TXD )
    [ BIT1 BIT2 + ] LITERAL P1SEL C! ( TXD RXD )
    [ BIT1 BIT6 + ] LITERAL P1DIR C! ( GREEN TXD )
    BIT3 P1IES C!       ( select neg edge )
    0 P1IFG C!          ( reset flags )
    BIT3 P1IE C!        ( enable interrupts for S2 )

    ( Use Watchdog module as timer )
    [ WDTPW WDTTMSEL + ] LITERAL WDTCTL !
    WDTIE IE1 C!

    ( Initialize clock from calibration values )
    CALDCO_1MHZ DCOCTL  C@!
    CALBC1_1MHZ BCSCTL1 C@!

    ( Set up Timer A - used for UART )
    [ TASSEL1 MC1 + ] LITERAL TACTL !
    TIMER_A_UART_INIT

    ( Enable ADC10 inputs )
    [ BIT0 BIT4 BIT5 BIT7 + + + ] LITERAL ADC10AE0 C!

    ( Indicate startup with LED )
    GREEN_ON
    VERY-LONG-DELAY
    GREEN_OFF

    ( Enable interrupts now )
    EINT
;

( - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - )

( Decode a hex digit, text -> number. supported input: 0123456789abcdefABCDEF
  This decoding does not check for invalid characters. It will simply return
  garbage, however in the range of 0 ... 15 )
: HEXDIGIT ( char - u )
    DUP 'A' >= IF
        [ 'A' 10 - ] LITERAL -
    ENDIF
    0xf AND
;

( Decode text, 2 hex digits, at given address and return value )
: HEX-DECODE ( adr -- u )
    DUP
    C@ HEXDIGIT 4 LSHIFT SWAP
    1+ C@ HEXDIGIT OR
;

( Decode text, 4 hex digits, big endian order, at given address and return value )
: HEX-DECODE-WORD-BE ( adr -- u )
    DUP HEX-DECODE 8 LSHIFT
    SWAP 2 + HEX-DECODE OR
;

( Output one hex digit for the number on the stack )
: .HEXDIGIT ( u -- )
    0xf AND
    DUP 10 >= IF
        [ 'A' 10 - ] LITERAL
    ELSE
        '0'
    ENDIF
    + EMIT
;

( Output two hex digits for the byte on the stack )
: .CHEX ( u -- )
    DUP
    4 RSHIFT .HEXDIGIT
    .HEXDIGIT
;

( Output four hex digits for the word on the stack, big endian)
: .HEX ( u -- )
    DUP
    8 RSHIFT .CHEX
    .CHEX
;

( Output a line with 16 bytes as hex and ASCII dump. Includes newline. )
: .HEXLINE ( adr -- )
    [CHAR] h EMIT SPACE         ( write prefix )
    OVER .HEX SPACE SPACE       ( write address )
    DUP 16 + SWAP       ( calculate end_adr start_adr )
    ( output hex dump )
    BEGIN
        2DUP >          ( end address not yet reached )
    WHILE
        DUP C@ .CHEX    ( hex dump of address )
        SPACE
        1+              ( next address )
    REPEAT
    ( reset address )
    16 -
    ( output ASCII dump )
    SPACE
    BEGIN
        2DUP >          ( end address not yet reached )
    WHILE
        DUP C@          ( get byte )
        DUP 32 < IF
            DROP [CHAR] .
        ENDIF
        EMIT
        1+              ( next address )
    REPEAT
    2DROP ." \n"        ( finish hex dump, drop address on stack )
;

( Print a hex dump of the given address range )
: HEXDUMP ( adr_low adr_hi -- )
    SWAP
    BEGIN
        2DUP >
    WHILE
        DUP .HEXLINE
        16 +
    REPEAT
    2DROP
;

( Output an integer )
: .INT ( -- )  ." i0x" .HEX '\n' EMIT ;

( Output OK message )
: .XOK ( -- )  ." xOK\n" ;

( Main application, run after INIT )
: MAIN ( -- )
    BEGIN
        ( Test if events are pending )
        IDLE? IF
            ( XXX actually we could miss an event and go to sleep if it was set
                  between test and LPM. The event flag is not lost, but it is
                  executed later when some other event wakes up the CPU. )
            ( Wait in low power mode )
            ENTER-LPM0
        ENDIF
        ( After wakeup test for the different events )

        RX-EVENT PENDING? IF
            GREEN_ON    ( Show activity )
            ( RX-CHAR EMIT ( send echo )
            RX-BUFFER C@ CASE

                ( read switch command )
                ( 's' Read switch )
                [CHAR] s OF
                    S2 .INT                 ( return state of button )
                    .XOK
                ENDOF

                ( make ADC10 measurement )
                ( 'aCC' ADC measurement if given channel in hex )
                [CHAR] a OF
                    RX-BUFFER 1+ HEX-DECODE ( get channel from parameter )
                    12 LSHIFT               ( prepare channel argument )
                    ADC10DIV_3 OR
                    ADC10 .INT              ( measure and output)
                    .XOK
                ENDOF

                ( output a message / echo )
                ( 'oM..' Echo message )
                [CHAR] o OF
                    RX-BUFFER WRITE
                    .XOK
                ENDOF

                ( memory dump of INFOMEM segment with calibration values )
                ( 'c' Dump calibration values )
                [CHAR] c OF
                    0x10c0 0x10ff HEXDUMP
                    .XOK
                ENDOF

                ( memory dump of given address, 64B blocks )
                ( 'mHHHH' Hex dump of given address )
                [CHAR] m OF
                    RX-BUFFER 1+ HEX-DECODE-WORD-BE
                    DUP 64 + HEXDUMP
                    .XOK
                ENDOF

                ( default )
                ." xERR cmd?:"
                RX-BUFFER WRITE
            ENDCASE
            RX-BUFFER 8 ZERO            ( erase buffer for next round )
            GREEN_OFF                   ( Activity done )
        ENDIF

        KEY-EVENT PENDING? IF
            ( Green flashing  )
            GREEN_ON
            SHORT-DELAY
            GREEN_OFF
        ENDIF

        TIMER-EVENT PENDING? IF
            ( Red flashing )
            RED_ON
            SHORT-DELAY
            RED_OFF
        ENDIF
    AGAIN
;

( ========================================================================= )
( Generate the assembler file now )
" Advanced demo " HEADER

( output important runtime core parts )
CROSS-COMPILE-CORE

( cross compile application )
CROSS-COMPILE-VARIABLES
CROSS-COMPILE INIT
CROSS-COMPILE MAIN
CROSS-COMPILE P1-IRQ-HANDLER
CROSS-COMPILE WATCHDOG-TIMER-HANDLER
CROSS-COMPILE TAUART_RX_INTERRUPT
CROSS-COMPILE-MISSING ( This compiles all words that were used indirectly )

\ vi:ft=forth
\
\ Serial input output [X-Protocol] Example.
\ Hardware: Launchpad
\ Serial Port Settings: 2400,8,N,1
\
\ Notes
\ -----
\ The RED LED is blinking periodically. Its timing is made with the
\ Watchdog module configured as timer.
\
\ The RED LED is configured as ADC input when it is not active. This allows
\ to show the photo-sensitivity of the LED (compare ADC measurements of
\ channel 0 with bright and low ambient light).
\
\ Due to issues with the CDC-ACM driver under Linux are no messages sent
\ by the MSP430 on its own. All commands are initiated by the PC.
\
\ Copyright (C) 2011 Chris Liechti <cliechti@gmx.net>
\ All Rights Reserved.
\ Simplified BSD License (see LICENSE.txt for full text)

( - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - )
INCLUDE core.forth
INCLUDE msp430.forth
INCLUDE io.forth

( - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - )

( Write null terminated string using TimerA UART )
CODE WRITE ( s -- )
    TOS->R15
    ." \t call \x23 write\n "
    ASM-NEXT
END-CODE

( Output character using the TimerA UART )
CODE EMIT ( u -- )
    TOS->R15
    ." \t call \x23 putchar\n "
    ASM-NEXT
END-CODE

( Initialize TimerA UART for reception )
CODE TIMER_A_UART_INIT ( -- )
    ." \t call \x23 timer_uart_rx_setup\n "
    ASM-NEXT
END-CODE

( Fetch received character from TimerA UART )
CODE RX-CHAR ( -- u )
    ." \t mov.b timer_a_uart_rxd, W\n "
    ." \t push W\n "
    ASM-NEXT
END-CODE

( Perform a single ADC10 measurement )
CODE ADC10 ( u -- u )
    TOS->R15
    ." \t call \x23 single_adc10\n "
    R15->TOS
    ASM-NEXT
END-CODE

( - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - )
( Control the LEDs on the Launchpad )
: RED_ON    ( -- ) BIT0 P1DIR CSET   BIT0 ADC10AE0 CRESET ;
: RED_OFF   ( -- ) BIT0 P1DIR CRESET BIT0 ADC10AE0 CSET ;
: GREEN_ON  ( -- ) BIT6 P1OUT CSET ;
: GREEN_OFF ( -- ) BIT6 P1OUT CRESET ;

( Read in the button on the Launchpad )
: S2        P1IN C@ BIT3 AND NOT ;

( Delay functions )
: SHORT-DELAY     ( -- ) 0x4fff DELAY ;
: LONG-DELAY      ( -- ) 0xffff DELAY ;
: VERY-LONG-DELAY ( -- ) LONG-DELAY LONG-DELAY ;
( - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - )
( Simple event handler. A bit field is used to keep track of events. )
VARIABLE EVENTS
( Bit masks for the individual events )
BIT0 CONSTANT KEY-EVENT
BIT1 CONSTANT TIMER-EVENT
BIT2 CONSTANT RX-EVENT

( ------ Helper functions ------ )
( Start an event )
: START ( u -- ) EVENTS CSET ;
( Test if event was started. Reset its flag anyway and return true when it was set. )
: PENDING? ( -- b )
    DUP                 ( copy bit mask )
    EVENTS CTESTBIT IF  ( test if bit is set )
        EVENTS CRESET   ( it is, reset )
        TRUE            ( indicate true as return value )
    ELSE
        DROP            ( drop bit mask )
        FALSE           ( indicate false as return value )
    ENDIF
;
( Return true if no events are pending )
: IDLE? ( -- b )
    EVENTS C@ 0=
;
( - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - )

( Interrupt handler for P1 )
PORT1_VECTOR INTERRUPT P1-IRQ-HANDLER
    KEY-EVENT START     ( Set event flag for key )
    WAKEUP              ( terminate LPM modes )
    0 P1IFG C!          ( clear all interrupt flags )
END-INTERRUPT

( - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - )

( Watchdog interrupts with SMCLK = 1MHz are too fast for us.
  Only wakeup every n-th interrupt. This is the counter
  used to achieve this. )
VARIABLE SLOWDOWN

( Interrupt handler for Watchdog module in timer mode )
WDT_VECTOR INTERRUPT WATCHDOG-TIMER-HANDLER
    SLOWDOWN C@ 1+      ( get and increment counter )
    DUP 30 > IF         ( check value )
        TIMER-EVENT START ( set event flag for timer )
        WAKEUP          ( terminate LPM modes )
        DROP 0          ( reset counter )
    ENDIF
    SLOWDOWN C!         ( store new value )
END-INTERRUPT

( - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - )

( Received data is put into a small line buffer. When a newline
  is received processing in the foreground is started.
)
0 VALUE RX-POS
RAM CREATE RX-BUFFER 8 ALLOT

100 INTERRUPT TAUART_RX_INTERRUPT
    RX-CHAR DUP             ( get the received character )
    RX-BUFFER RX-POS + C!   ( store character )
    RX-POS 7 < IF           ( increment write pos if there is space )
        RX-POS 1+ TO RX-POS
    ENDIF
    '\n' = IF               ( check for EOL )
        RX-EVENT START      ( set event flag for reception )
        WAKEUP              ( terminate LPM modes )
        0 TO RX-POS         ( reset read position )
    ENDIF
END-INTERRUPT

( - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - )
( Initializations run after reset )
: INIT ( -- )
    ( Initialize pins )
    OUT TACCTL0 !       ( Init Timer A CCTL before pin is activated DIR, SEL)
    [ BIT0 BIT1 + ] LITERAL P1OUT C! ( RED TXD )
    [ BIT1 BIT2 + ] LITERAL P1SEL C! ( TXD RXD )
    [ BIT1 BIT6 + ] LITERAL P1DIR C! ( GREEN TXD )
    BIT3 P1IES C!       ( select neg edge )
    0 P1IFG C!          ( reset flags )
    BIT3 P1IE C!        ( enable interrupts for S2 )

    ( Use Watchdog module as timer )
    [ WDTPW WDTTMSEL + ] LITERAL WDTCTL !
    WDTIE IE1 C!

    ( Initialize clock from calibration values )
    CALDCO_1MHZ DCOCTL  C@!
    CALBC1_1MHZ BCSCTL1 C@!

    ( Set up Timer A - used for UART )
    [ TASSEL1 MC1 + ] LITERAL TACTL !
    TIMER_A_UART_INIT

    ( Enable ADC10 inputs )
    [ BIT0 BIT4 BIT5 BIT7 + + + ] LITERAL ADC10AE0 C!

    ( Indicate startup with LED )
    GREEN_ON
    VERY-LONG-DELAY
    GREEN_OFF

    ( Enable interrupts now )
    EINT
;

( - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - )

( Decode a hex digit, text -> number. supported input: 0123456789abcdefABCDEF
  This decoding does not check for invalid characters. It will simply return
  garbage, however in the range of 0 ... 15 )
: HEXDIGIT ( char - u )
    DUP 'A' >= IF
        [ 'A' 10 - ] LITERAL -
    ENDIF
    0xf AND
;

( Decode text, 2 hex digits, at given address and return value )
: HEX-DECODE ( adr -- u )
    DUP
    C@ HEXDIGIT 4 LSHIFT SWAP
    1+ C@ HEXDIGIT OR
;

( Decode text, 4 hex digits, big endian order, at given address and return value )
: HEX-DECODE-WORD-BE ( adr -- u )
    DUP HEX-DECODE 8 LSHIFT
    SWAP 2 + HEX-DECODE OR
;

( Output one hex digit for the number on the stack )
: .HEXDIGIT ( u -- )
    0xf AND
    DUP 10 >= IF
        [ 'A' 10 - ] LITERAL
    ELSE
        '0'
    ENDIF
    + EMIT
;

( Output two hex digits for the byte on the stack )
: .CHEX ( u -- )
    DUP
    4 RSHIFT .HEXDIGIT
    .HEXDIGIT
;

( Output four hex digits for the word on the stack, big endian)
: .HEX ( u -- )
    DUP
    8 RSHIFT .CHEX
    .CHEX
;

( Output a line with 16 bytes as hex and ASCII dump. Includes newline. )
: .HEXLINE ( adr -- )
    [CHAR] h EMIT SPACE         ( write prefix )
    OVER .HEX SPACE SPACE       ( write address )
    DUP 16 + SWAP       ( calculate end_adr start_adr )
    ( output hex dump )
    BEGIN
        2DUP >          ( end address not yet reached )
    WHILE
        DUP C@ .CHEX    ( hex dump of address )
        SPACE
        1+              ( next address )
    REPEAT
    ( reset address )
    16 -
    ( output ASCII dump )
    SPACE
    BEGIN
        2DUP >          ( end address not yet reached )
    WHILE
        DUP C@          ( get byte )
        DUP 32 < IF
            DROP [CHAR] .
        ENDIF
        EMIT
        1+              ( next address )
    REPEAT
    2DROP ." \n"        ( finish hex dump, drop address on stack )
;

( Print a hex dump of the given address range )
: HEXDUMP ( adr_low adr_hi -- )
    SWAP
    BEGIN
        2DUP >
    WHILE
        DUP .HEXLINE
        16 +
    REPEAT
    2DROP
;

( Output an integer )
: .INT ( -- )  ." i0x" .HEX '\n' EMIT ;

( Output OK message )
: .XOK ( -- )  ." xOK\n" ;

( Main application, run after INIT )
: MAIN ( -- )
    BEGIN
        ( Test if events are pending )
        IDLE? IF
            ( XXX actually we could miss an event and go to sleep if it was set
                  between test and LPM. The event flag is not lost, but it is
                  executed later when some other event wakes up the CPU. )
            ( Wait in low power mode )
            ENTER-LPM0
        ENDIF
        ( After wakeup test for the different events )

        RX-EVENT PENDING? IF
            GREEN_ON    ( Show activity )
            ( RX-CHAR EMIT ( send echo )
            RX-BUFFER C@ CASE

                ( read switch command )
                ( 's' Read switch )
                [CHAR] s OF
                    S2 .INT                 ( return state of button )
                    .XOK
                ENDOF

                ( make ADC10 measurement )
                ( 'aCC' ADC measurement if given channel in hex )
                [CHAR] a OF
                    RX-BUFFER 1+ HEX-DECODE ( get channel from parameter )
                    12 LSHIFT               ( prepare channel argument )
                    ADC10DIV_3 OR
                    ADC10 .INT              ( measure and output)
                    .XOK
                ENDOF

                ( output a message / echo )
                ( 'oM..' Echo message )
                [CHAR] o OF
                    RX-BUFFER WRITE
                    .XOK
                ENDOF

                ( memory dump of INFOMEM segment with calibration values )
                ( 'c' Dump calibration values )
                [CHAR] c OF
                    0x10c0 0x10ff HEXDUMP
                    .XOK
                ENDOF

                ( memory dump of given address, 64B blocks )
                ( 'mHHHH' Hex dump of given address )
                [CHAR] m OF
                    RX-BUFFER 1+ HEX-DECODE-WORD-BE
                    DUP 64 + HEXDUMP
                    .XOK
                ENDOF

                ( default )
                ." xERR cmd?:"
                RX-BUFFER WRITE
            ENDCASE
            RX-BUFFER 8 ZERO            ( erase buffer for next round )
            GREEN_OFF                   ( Activity done )
        ENDIF

        KEY-EVENT PENDING? IF
            ( Green flashing  )
            GREEN_ON
            SHORT-DELAY
            GREEN_OFF
        ENDIF

        TIMER-EVENT PENDING? IF
            ( Red flashing )
            RED_ON
            SHORT-DELAY
            RED_OFF
        ENDIF
    AGAIN
;

( ========================================================================= )
( Generate the assembler file now )
" Advanced demo " HEADER

( output important runtime core parts )
CROSS-COMPILE-CORE

( cross compile application )
CROSS-COMPILE-VARIABLES
CROSS-COMPILE INIT
CROSS-COMPILE MAIN
CROSS-COMPILE P1-IRQ-HANDLER
CROSS-COMPILE WATCHDOG-TIMER-HANDLER
CROSS-COMPILE TAUART_RX_INTERRUPT
CROSS-COMPILE-MISSING ( This compiles all words that were used indirectly )


explicit floating point literals

explicit floating point literals

( shared library )

: 2dup over over ;

: 2drop drop drop ;
: 3drop 2drop drop ;

: min 2dup > if swap then drop ;
: max 2dup < if swap then drop ;
: between rot swap over >= -rot <= and ;

: times 0 do ;

: neg -1 * ;
: abs dup 0 < if neg then ;

: +! dup @ rot + swap ! ;

3.14159265359 const pi
: deg2rad pi 180.0 / * ;
: rad2deg 180.0 pi / * ;

( shared library )

: 2dup over over ;

: 2drop drop drop ;
: 3drop 2drop drop ;

: min 2dup > if swap then drop ;
: max 2dup < if swap then drop ;
: between rot swap over >= -rot <= and ;

: times 0 do ;

: neg -1 * ;
: abs dup 0 < if neg then ;

: +! dup @ rot + swap ! ;

3.14159265359 const pi
: deg2rad pi 180 / * ;
: rad2deg 180 pi / * ;


Add a loader menu option to set hint.atkbd.0.flags=0x1 which allows USB keyboards to work if no PS/2 keyboard is attached.  The position in the menu was chosen to avoid moving option 6 (loader prompt).  This should be a no-op on non-i386/amd64 machines.

\ Copyright (c) 2003 Scott Long <scottl@freebsd.org>
\ Copyright (c) 2003 Aleksander Fafula <alex@fafula.com>
\ All rights reserved.
\
\ Redistribution and use in source and binary forms, with or without
\ modification, are permitted provided that the following conditions
\ are met:
\ 1. Redistributions of source code must retain the above copyright
\    notice, this list of conditions and the following disclaimer.
\ 2. Redistributions in binary form must reproduce the above copyright
\    notice, this list of conditions and the following disclaimer in the
\    documentation and/or other materials provided with the distribution.
\
\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
\ ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
\ SUCH DAMAGE.
\
\ $FreeBSD$

marker task-beastie.4th

include /boot/screen.4th
include /boot/frames.4th

hide

variable menuidx
variable menubllt
variable menuX
variable menuY
variable promptwidth

variable bootkey
variable bootacpikey
variable bootusbkey
variable bootsafekey
variable bootverbosekey
variable bootsinglekey
variable escapekey
variable rebootkey

46 constant dot

\ The BSD Daemon.  He is 19 rows high and 34 columns wide
: technicolor-beastie ( x y -- )
2dup at-xy ."               ,        ," 1+
2dup at-xy ."              /(        )`" 1+
2dup at-xy ."              \ \___   / |" 1+
2dup at-xy ."              /- _  `-/  '" 1+
2dup at-xy ."             (/\/ \ \   /\" 1+
2dup at-xy ."             / /   | `    \" 1+
2dup at-xy ."             O O   ) /    |" 1+
2dup at-xy ."             `-^--'`<     '" 1+
2dup at-xy ."            (_.)  _  )   /" 1+
2dup at-xy ."             `.___/`    /       " 1+
2dup at-xy ."               `-----' /" 1+
2dup at-xy ."  <----.     __ / __   \" 1+
2dup at-xy ."  <----|====O)))==) \) /====|" 1+
2dup at-xy ."  <----'    `--' `.__,' \" 1+
2dup at-xy ."               |        |" 1+
2dup at-xy ."                \       /       /\" 1+
2dup at-xy ."           ______( (_  / \______/" 1+
2dup at-xy ."         ,'  ,-----'   |" 1+
at-xy ."         `--{__________) " 1+
;

: boring-beastie ( x y -- )
	2dup at-xy ."              ,        ," 1+
	2dup at-xy ."             /(        )`" 1+
	2dup at-xy ."             \ \___   / |" 1+
	2dup at-xy ."             /- _  `-/  '" 1+
	2dup at-xy ."            (/\/ \ \   /\" 1+
	2dup at-xy ."            / /   | `    \" 1+
	2dup at-xy ."            O O   ) /    |" 1+
	2dup at-xy ."            `-^--'`<     '" 1+
	2dup at-xy ."           (_.)  _  )   /" 1+
	2dup at-xy ."            `.___/`    /" 1+
	2dup at-xy ."              `-----' /" 1+
	2dup at-xy ." <----.     __ / __   \" 1+
	2dup at-xy ." <----|====O)))==) \) /====" 1+
	2dup at-xy ." <----'    `--' `.__,' \" 1+
	2dup at-xy ."              |        |" 1+
	2dup at-xy ."               \       /       /\" 1+
	2dup at-xy ."          ______( (_  / \______/" 1+
	2dup at-xy ."        ,'  ,-----'   |" 1+
	     at-xy ."        `--{__________)"
;

: print-beastie ( x y -- )
	s" loader_color" getenv
	dup -1 = if
		drop
		boring-beastie
		exit
	then
	s" YES" compare-insensitive 0<> if
		boring-beastie
		exit
	then
	technicolor-beastie
;

: acpienabled? ( -- flag )
	s" acpi_load" getenv
	dup -1 = if
		drop false exit
	then
	s" YES" compare-insensitive 0<> if
		false exit
	then
	s" hint.acpi.0.disabled" getenv
	dup -1 <> if
		s" 0" compare 0<> if
			false exit
		then
	then
	true
;

: printmenuitem ( -- n )
	menuidx @
	1+ dup
	menuidx !
	menuY @ + dup menuX @ swap at-xy
	menuidx @ .
	menuX @ 1+ swap at-xy
	menubllt @ emit
	menuidx @ 48 +
;

: beastie-menu ( -- )
	0 menuidx !
	dot menubllt !
	8 menuY !
	5 menuX !
	clear
	46 4 print-beastie
	42 20 2 2 box
	13 6 at-xy ." Welcome to FreeBSD!"
	printmenuitem ."  Boot FreeBSD [default]" bootkey !
	s" arch-i386" environment? if
		printmenuitem ."  Boot FreeBSD with ACPI " bootacpikey !
		acpienabled? if
			." disabled"
		else
			." enabled"
		then
	else
		-2 bootacpikey !
	then
	printmenuitem ."  Boot FreeBSD in Safe Mode" bootsafekey !
	printmenuitem ."  Boot FreeBSD in single user mode" bootsinglekey !
	printmenuitem ."  Boot FreeBSD with verbose logging" bootverbosekey !
	printmenuitem ."  Escape to loader prompt" escapekey !
	s" arch-i386" environment? if
		printmenuitem ."  Boot FreeBSD with USB keyboard" bootusbkey !
	else
		-2 bootacpikey !
	then
	printmenuitem ."  Reboot" rebootkey !
	menuX @ 20 at-xy
	." Select option, [Enter] for default"
	menuX @ 21 at-xy
	s" or [Space] to pause timer    " dup 2 - promptwidth !
	type
;

: tkey
	dup
	seconds +
	begin 1 while
		over 0<> if
			dup seconds u< if
				drop
				-1
				exit
			then
			menuX @ promptwidth @ + 21 at-xy dup seconds - .
		then
		key? if
			drop
			key
			exit
		then
	50 ms
	repeat
;

set-current

: beastie-start
	s" beastie_disable" getenv
	dup -1 <> if
		s" YES" compare-insensitive 0= if
			exit
		then
	then
	beastie-menu
	s" autoboot_delay" getenv
	dup -1 = if
		drop
		10
	else
		0 0 2swap >number drop drop drop
	then
	begin true while
		dup tkey
		0 25 at-xy
		dup 32 = if nip 0 swap then
		dup -1 = if 0 boot then
		dup 13 = if 0 boot then
		dup bootkey @ = if 0 boot then
		dup bootacpikey @ = if
			acpienabled? if
				s" acpi_load" unsetenv
				s" 1" s" hint.acpi.0.disabled" setenv
				s" 1" s" loader.acpi_disabled_by_user" setenv
			else
				s" YES" s" acpi_load" setenv
				s" 0" s" hint.acpi.0.disabled" setenv
			then
			0 boot
		then
		dup bootusbkey @ = if
			s" 0x1" s" hint.atkbd.0.flags" setenv
			0 boot
		then
		dup bootsafekey @ = if
			s" arch-i386" environment? if
				s" acpi_load" unsetenv
				s" 1" s" hint.acpi.0.disabled" setenv
				s" 1" s" loader.acpi_disabled_by_user" setenv
				s" 1" s" hint.apic.0.disabled" setenv
			then
			s" 0" s" hw.ata.ata_dma" setenv
			s" 0" s" hw.ata.atapi_dma" setenv
			s" 0" s" hw.ata.wc" setenv
			s" 0" s" hw.eisa_slots" setenv
			0 boot
		then
		dup bootverbosekey @ = if
			s" YES" s" boot_verbose" setenv
			0 boot
		then
		dup bootsinglekey @ = if
			s" YES" s" boot_single" setenv
			0 boot
		then
		dup escapekey @ = if
			2drop
			s" NO" s" autoboot_delay" setenv
			exit
		then
		rebootkey @ = if 0 reboot then
	repeat
;

previous

\ Copyright (c) 2003 Scott Long <scottl@freebsd.org>
\ Copyright (c) 2003 Aleksander Fafula <alex@fafula.com>
\ All rights reserved.
\
\ Redistribution and use in source and binary forms, with or without
\ modification, are permitted provided that the following conditions
\ are met:
\ 1. Redistributions of source code must retain the above copyright
\    notice, this list of conditions and the following disclaimer.
\ 2. Redistributions in binary form must reproduce the above copyright
\    notice, this list of conditions and the following disclaimer in the
\    documentation and/or other materials provided with the distribution.
\
\ THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
\ ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
\ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
\ ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
\ SUCH DAMAGE.
\
\ $FreeBSD$

marker task-beastie.4th

include /boot/screen.4th
include /boot/frames.4th

hide

variable menuidx
variable menubllt
variable menuX
variable menuY
variable promptwidth

variable bootkey
variable bootacpikey
variable bootsafekey
variable bootverbosekey
variable bootsinglekey
variable escapekey
variable rebootkey

46 constant dot

\ The BSD Daemon.  He is 19 rows high and 34 columns wide
: technicolor-beastie ( x y -- )
2dup at-xy ."               ,        ," 1+
2dup at-xy ."              /(        )`" 1+
2dup at-xy ."              \ \___   / |" 1+
2dup at-xy ."              /- _  `-/  '" 1+
2dup at-xy ."             (/\/ \ \   /\" 1+
2dup at-xy ."             / /   | `    \" 1+
2dup at-xy ."             O O   ) /    |" 1+
2dup at-xy ."             `-^--'`<     '" 1+
2dup at-xy ."            (_.)  _  )   /" 1+
2dup at-xy ."             `.___/`    /       " 1+
2dup at-xy ."               `-----' /" 1+
2dup at-xy ."  <----.     __ / __   \" 1+
2dup at-xy ."  <----|====O)))==) \) /====|" 1+
2dup at-xy ."  <----'    `--' `.__,' \" 1+
2dup at-xy ."               |        |" 1+
2dup at-xy ."                \       /       /\" 1+
2dup at-xy ."           ______( (_  / \______/" 1+
2dup at-xy ."         ,'  ,-----'   |" 1+
at-xy ."         `--{__________) " 1+
;

: boring-beastie ( x y -- )
	2dup at-xy ."              ,        ," 1+
	2dup at-xy ."             /(        )`" 1+
	2dup at-xy ."             \ \___   / |" 1+
	2dup at-xy ."             /- _  `-/  '" 1+
	2dup at-xy ."            (/\/ \ \   /\" 1+
	2dup at-xy ."            / /   | `    \" 1+
	2dup at-xy ."            O O   ) /    |" 1+
	2dup at-xy ."            `-^--'`<     '" 1+
	2dup at-xy ."           (_.)  _  )   /" 1+
	2dup at-xy ."            `.___/`    /" 1+
	2dup at-xy ."              `-----' /" 1+
	2dup at-xy ." <----.     __ / __   \" 1+
	2dup at-xy ." <----|====O)))==) \) /====" 1+
	2dup at-xy ." <----'    `--' `.__,' \" 1+
	2dup at-xy ."              |        |" 1+
	2dup at-xy ."               \       /       /\" 1+
	2dup at-xy ."          ______( (_  / \______/" 1+
	2dup at-xy ."        ,'  ,-----'   |" 1+
	     at-xy ."        `--{__________)"
;

: print-beastie ( x y -- )
	s" loader_color" getenv
	dup -1 = if
		drop
		boring-beastie
		exit
	then
	s" YES" compare-insensitive 0<> if
		boring-beastie
		exit
	then
	technicolor-beastie
;

: acpienabled? ( -- flag )
	s" acpi_load" getenv
	dup -1 = if
		drop false exit
	then
	s" YES" compare-insensitive 0<> if
		false exit
	then
	s" hint.acpi.0.disabled" getenv
	dup -1 <> if
		s" 0" compare 0<> if
			false exit
		then
	then
	true
;

: printmenuitem ( -- n )
	menuidx @
	1+ dup
	menuidx !
	menuY @ + dup menuX @ swap at-xy
	menuidx @ .
	menuX @ 1+ swap at-xy
	menubllt @ emit
	menuidx @ 48 +
;

: beastie-menu ( -- )
	0 menuidx !
	dot menubllt !
	8 menuY !
	5 menuX !
	clear
	46 4 print-beastie
	42 20 2 2 box
	13 6 at-xy ." Welcome to FreeBSD!"
	printmenuitem ."  Boot FreeBSD [default]" bootkey !
	s" arch-i386" environment? if
		printmenuitem ."  Boot FreeBSD with ACPI " bootacpikey !
		acpienabled? if
			." disabled"
		else
			." enabled"
		then
	else
		-2 bootacpikey !
	then
	printmenuitem ."  Boot FreeBSD in Safe Mode" bootsafekey !
	printmenuitem ."  Boot FreeBSD in single user mode" bootsinglekey !
	printmenuitem ."  Boot FreeBSD with verbose logging" bootverbosekey !
	printmenuitem ."  Escape to loader prompt" escapekey !
	printmenuitem ."  Reboot" rebootkey !
	menuX @ 20 at-xy
	." Select option, [Enter] for default"
	menuX @ 21 at-xy
	s" or [Space] to pause timer    " dup 2 - promptwidth !
	type
;

: tkey
	dup
	seconds +
	begin 1 while
		over 0<> if
			dup seconds u< if
				drop
				-1
				exit
			then
			menuX @ promptwidth @ + 21 at-xy dup seconds - .
		then
		key? if
			drop
			key
			exit
		then
	50 ms
	repeat
;

set-current

: beastie-start
	s" beastie_disable" getenv
	dup -1 <> if
		s" YES" compare-insensitive 0= if
			exit
		then
	then
	beastie-menu
	s" autoboot_delay" getenv
	dup -1 = if
		drop
		10
	else
		0 0 2swap >number drop drop drop
	then
	begin true while
		dup tkey
		0 25 at-xy
		dup 32 = if nip 0 swap then
		dup -1 = if 0 boot then
		dup 13 = if 0 boot then
		dup bootkey @ = if 0 boot then
		dup bootacpikey @ = if
			acpienabled? if
				s" acpi_load" unsetenv
				s" 1" s" hint.acpi.0.disabled" setenv
				s" 1" s" loader.acpi_disabled_by_user" setenv
			else
				s" YES" s" acpi_load" setenv
				s" 0" s" hint.acpi.0.disabled" setenv
			then
			0 boot
		then
		dup bootsafekey @ = if
			s" arch-i386" environment? if
				s" acpi_load" unsetenv
				s" 1" s" hint.acpi.0.disabled" setenv
				s" 1" s" loader.acpi_disabled_by_user" setenv
				s" 1" s" hint.apic.0.disabled" setenv
			then
			s" 0" s" hw.ata.ata_dma" setenv
			s" 0" s" hw.ata.atapi_dma" setenv
			s" 0" s" hw.ata.wc" setenv
			s" 0" s" hw.eisa_slots" setenv
			0 boot
		then
		dup bootverbosekey @ = if
			s" YES" s" boot_verbose" setenv
			0 boot
		then
		dup bootsinglekey @ = if
			s" YES" s" boot_single" setenv
			0 boot
		then
		dup escapekey @ = if
			2drop
			s" NO" s" autoboot_delay" setenv
			exit
		then
		rebootkey @ = if 0 reboot then
	repeat
;

previous


Uncomment double-length word tests

Uncomment double-length word tests


Move watchdog stuff out.

Move watchdog stuff out.

\ Wrappers for SAPI Core functions
\ SVC 0: Return the version of the API in use.
\ SVC 1: Return the address of the shared variables table
\ SVC 2: putchar
\ SVC 3: getchar
\ SVC 4: charsavail

\ SVC 5: Reserved
\ SVC 6: Reserved
\ SVC 7: Reserved

\ SVC 8: Watchdog Refresh
\ SVC 9: Return Millisecond ticker value.
\ SVC 10: The number of CPU cycles consumed in the last second.

\ 2-4 are for use by the serial io routines, and are
\ defined elsewhere.

\ Note that the system call number is embedded into the instruction,
\ so this is not so easily parameterized.

\ **********************************************************************
\ SVC 0: Return the version of the API in use.
\ **********************************************************************
CODE SAPI-Version  \ -- n
	\ Push TOS, and place the result there.
	svc # 0
	str tos, [ psp, # -4 ] !
	mov tos, r0
	next,
END-CODE

\ **********************************************************************
\ SVC 1: Get the address of the shared variable list
\ **********************************************************************
CODE GetSharedVars  \ -- n
	svc # 1
	str tos, [ psp, # -4 ] !
	mov tos, r0
	next,
END-CODE

\ **********************************************************************
\ SVC 9: Return Millisecond ticker value.
\ **********************************************************************
CODE Ticks  \ -- n
	svc # 9
	str tos, [ psp, # -4 ] !
	mov tos, r0
	next,
END-CODE

\ **********************************************************************
\ SVC 10: The number of CPU cycles consumed in the last second.
\ **********************************************************************
CODE GetUsage  \ -- n
	svc # 10
	str tos, [ psp, # -4 ] !
	mov tos, r0
	next,
END-CODE


Use the system call to get the jumpable root.

(( App Startup ))

0 value JT \ The Jumptable

\ -------------------------------------------
\ The word that sets everything up
\ -------------------------------------------
: StartApp
	hex
	init-dp @ dp ! \ Set the dictionary pointer so that we can function.
	1 getruntimelinks to jt
	\ I have no idea why I am doing this instead of the compilation system.
	." StartApp!  "
	." ICRoot@" icroot @ . cr
	\ $100 0 do icroot @ u0rxdata @ . loop cr
	4 SCSSCR _SCS + ! \ Set deepsleep

;

(( App Startup ))

\ -------------------------------------------
\ The word that sets everything up
\ -------------------------------------------
: StartApp
	hex
	init-dp @ dp ! \ Set the dictionary pointer so that we can function.
	\ I have no idea why I am doing this instead of the compilation system.
	." StartApp!  "
	." ICRoot@" icroot @ . cr
	\ $100 0 do icroot @ u0rxdata @ . loop cr
	4 SCSSCR _SCS + ! \ Set deepsleep

;


Clean up dynamic linking.

Clean up dynamic linking.

\ Code to support runtime/dynamic into the C side via SAPI.
\
\ In the MPE environment, VALUEs work very well for this.
\ values are defined at compile time and can be updated at runtime.

\ So the basic logic is - walk the dynamic list, and if you find something
\ that is already defined, assume its a VALUE
\ otherwise, generate a constant.

\ Walk the table and make the constants.
: dy-populate
  dy-first
  begin
     dup dy.val 0<>
  while
     dup dy-create
     dy-next
  repeat
  drop
  ;

\ The key bit.  Look for an entry and if its a value, update it.
\ otherwise, add a constant to the dictionary.
: dy-create ( c-addr -- )
        \ Start by looking it up
        DUP dy.name count pad place \ Make a counted string out of it.

        pad find
        0= IF \ If failure, cleanup and make-const
                2DROP \ Drop the length and pointer.
                dup dy.val \ c-addr n
                over dy.name count \ n c-addr b
                make-const
        ELSE \ If Success, get the value and stuff it in there.
                SWAP dy.val \ Fetch the value
                SWAP dy-stuff
        THEN
    ;

: dy-first   ( -- c-addr ) getsharedvars dy-recordlen + ;
: dy-next    ( c-addr -- c-addr ) dy-recordlen + ;

\ ************************************************************************
\ ************************************************************************
\ Secondary support functions
\ ************************************************************************
\ ************************************************************************

\ *********************************************
\ Accessors - Tightly tied the data structure
\ *********************************************
: dy.val           @ ;
: dy.size    #4 + w@ ;
: dy.count   #6 + w@ ;
: dy.type    #8 + c@ ;
: dy.name    #9 +    ; \ Counted string.

UDATA \ We need a scratch buffer.
create dy.buf $20 allot
CDATA

\ Return the recordlength.  Its the first thing.
: dy-recordlen getsharedvars @ ;

: dy-string ( addr -- caddr n )
  dy.name count
;

\ Create a constant from scratch by laying down some assembly
\ A key trick is that we have to lay down a pointer to
\ the first character of the defintion after we finish
\ See the definition above for the template
: make-const \ n s-addr c --
	here 4+ >r \ This should point to the newly-created header.
	makeheader \

\ This is what a constant looks like after emerging from the compiler.
\ ( 0002:0270 4CF8047D Lx.} )  str r7, [ r12, # $-04 ]!
\ ( 0002:0274 004F .O )        ldr r7, [ PC, # $00 ] ( @$20278=$7D04F84C )
\ ( 0002:0276 7047 pG )        bx LR

	$7D04F84C , \  str r7, [ r12, # $-04 ]!
	$4f00 w,    \  ldr r7, [ PC, # $00 ]
	$4770 w,    \ bx LR
	, 	        \ Lay down the payload

	r> ,        \ lay down the link field for the next word - required
	;

\ Take an XT of a VALUE, and stuff something in there.
: dy-stuff ( n xt -- )  $8 + @ ! ;

\ Dump out an entry as a set of constants
: dy-print \ c-addr --
     S" $" type
     DUP dy.val .    \ Fetch the value

     DUP dy.type [CHAR] V = \ check the type

     IF
     	S" VALUE "
     ELSE
     	S" CONSTANT "
     THEN type \ Display the result
     dup dy.size . ." x " DUP dy.count .
     dy-string TYPE
     CR
   ;

\ Given a record address and a string, figure out
\ if thats the one we're looking for
: dy-compare ( caddr n addr -- n )
  dy-string compare
;

\ Walk the list and find a string.
: dy-find ( c-addr n -- addr|0 )
  dy-first
  >R \ Put it onto the return stack
  BEGIN
   R@ dy.val 0<>
  WHILE
   2DUP R@ dy-compare
   \ If we find it, clean the stack and leave the address on R
   0= IF 2DROP R> EXIT THEN
   R> dy-recordlen + >R
  REPEAT
  \ If we fall out, there will be a string caddr/n on the stack
  2DROP R> DROP
  0 \ Leave behind a zero to indicate failure
;

\ Code to support runtime/dynamic into the C side via SAPI.
\
\ In the MPE environment, VALUEs work very well for this.
\ values are defined at compile time and can be updated at runtime.

\ So the basic logic is - walk the dynamic list, and if you find something
\ that is already defined, assume its a VALUE
\ otherwise, generate a constant.

\ Walk the table and make the constants.
: dy-populate
  dy-first@
  begin
     dup dy.val 0<>
  while
     dup dy-create
     dy-recordlen +
  repeat
  drop
  ;

\ The key bit.  Look for an entry and if its a value, update it.
\ otherwise, add a constant to the dictionary.
: dy-create ( c-addr -- )
        \ Start by looking it up
        DUP dy-cstring \ Make a counted string out of it.

        dy.buf find
        0= IF \ If failure, cleanup and make-const
                DROP
                dup dy.val \ c-addr n
                swap dup dy.name swap dy.namelen  \ n c-addr b
                make-const
        ELSE \ If Success, get the value and stuff it in there.
                SWAP dy.val \ Fetch the value
                SWAP dy-stuff
        THEN
    ;

: dy-first@ ( -- c-addr ) getsharedvars dy-recordlen + ;
: dy-cstring ( c-addr -- ) dy.name OVER dy.namelen dy.buf place ;

\ ************************************************************************
\ ************************************************************************
\ Secondary support functions
\ ************************************************************************
\ ************************************************************************

\ *********************************************
\ Accessors - Tightly tied the data structure
\ *********************************************
: dy.val           @ ;
: dy.size    #4 + w@ ;
: dy.count   #6 + w@ ;
: dy.type    #8 + c@ ;
: dy.namelen #9 + c@ ;
: dy.name   #12 +  @ ;

UDATA \ We need a scratch buffer.
create dy.buf $20 allot
CDATA

\ Return the recordlength.  Its the first thing.
: dy-recordlen getsharedvars @ ;

\ Retrieve the string.
: dy-string ( addr -- caddr n )
  dup dy.name swap dy.namelen
;

\ Create a constant from scratch by laying down some assembly
\ A key trick is that we have to lay down a pointer to
\ the first character of the defintion after we finish
\ See the definition above for the template
: make-const \ n s-addr c --
	here 4+ >r \ This should point to the newly-created header.
	makeheader \

\ This is what a constant looks like after emerging from the compiler.
\ ( 0002:0270 4CF8047D Lx.} )  str r7, [ r12, # $-04 ]!
\ ( 0002:0274 004F .O )        ldr r7, [ PC, # $00 ] ( @$20278=$7D04F84C )
\ ( 0002:0276 7047 pG )        bx LR

	$7D04F84C , \  str r7, [ r12, # $-04 ]!
	$4f00 w,    \  ldr r7, [ PC, # $00 ]
	$4770 w,    \ bx LR
	, 	        \ Lay down the payload

	r> ,        \ lay down the link field for the next word - required
	;

\ Take an XT of a VALUE, and stuff something in there.
: dy-stuff ( n xt -- )  8 + @ ! ;

\ Dump out an entry as a set of constants
: dy-print \ c-addr --
     S" $" type
     DUP dy.val .    \ Fetch the value

     DUP dy.type [CHAR] V = \ check the type

     IF
     	S" VALUE "
     ELSE
     	S" CONSTANT "
     THEN
     TYPE \ Display the result
     DUP dy.size . S" x" DUP dy.count .
     dy-string TYPE
     CR
   ;

\ Take a pointer to a dynamic link record, and add a constant to the dictionary
: dy-create \ addr --
	DUP \ addr addr
	dy.val \ c-addr n
	SWAP dy-string \ n c-addr b
    make-const
    ;

\ Given a record address and a string, figure out
\ if thats the one we're looking for
: dy-compare ( caddr n addr -- n )
  dy-string compare
;

\ Find the record in the list to go with a string
: dy-find ( c-addr n -- addr|0 )
  getsharedvars dy-recordlen + \ Skip over the empty first record
  >R \ Put it onto the return stack
  BEGIN
   R@ dy.val 0<>
  WHILE
   2DUP R@ dy-compare
   \ If we find it, clean the stack and leave the address on R
   0= IF 2DROP R> EXIT THEN
   R> dy-recordlen + >R
  REPEAT
  \ If we fall out, there will be a string caddr/n on the stack
  2DROP R> DROP
  0 \ Leave behind a zero to indicate failure
;

\ Walk the table and make the constants.
: dy-populate
  getsharedvars dy-recordlen + \ Skip over the empty first record
  BEGIN
     dup dy.val 0<>
  WHILE
     dup dy-create
     dy-recordlen +
  REPEAT
  2DROP R> DROP 0
  ;