1\ Copyright (c) 1999 Daniel C. Sobral <dcs@freebsd.org>
2\ All rights reserved.
3\
4\ Redistribution and use in source and binary forms, with or without
5\ modification, are permitted provided that the following conditions
6\ are met:
7\ 1. Redistributions of source code must retain the above copyright
8\ notice, this list of conditions and the following disclaimer.
--- 8 unchanged lines hidden (view full) ---
17\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
18\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
19\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
20\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
21\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
22\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
23\ SUCH DAMAGE.
24\
25\ $FreeBSD: head/sys/boot/forth/support.4th 65641 2000-09-09 18:20:00Z dcs $
26
27\ Loader.rc support functions:
28\
29\ initialize_support ( -- ) initialize global variables
30\ initialize ( addr len -- ) as above, plus load_conf_files
31\ load_conf ( addr len -- ) load conf file given
32\ include_conf_files ( -- ) load all conf files in load_conf_files
33\ print_syntax_error ( -- ) print line and marker of where a syntax
--- 194 unchanged lines hidden (view full) ---
228 [char] ' parse
229 state @ if
230 postpone sliteral
231 then
232; immediate
233
234: 2>r postpone >r postpone >r ; immediate
235: 2r> postpone r> postpone r> ; immediate
236
237\ Private definitions
238
239vocabulary support-functions
240only forth also support-functions definitions
241
242\ Some control characters constants
243
--- 1050 unchanged lines hidden (view full) ---
1294;
1295
1296\ Try to load a kernel; the kernel name is taken from one of
1297\ the following lists, as ordered:
1298\
1299\ 1. The "bootfile" environment variable
1300\ 2. The "kernel" environment variable
1301\
1302\ Flags are passed, if available. The parameter args must be 2
1303\ if flags are being passed, or 1 if they should be ignored.
1304\ Dummy flags and len must be passed in the latter case.
1305\
1306\ The kernel gets loaded from the current module_path.
1307
1308: load_a_kernel ( flags len args -- flag )
1309 local args
1310 2local flags
1311 0 0 2local kernel
1312 end-locals
1313
1314 \ Check if a default kernel name exists at all, exits if not
1315 s" bootfile" getenv dup -1 <> if
1316 to kernel
1317 flags kernel args try_multiple_kernels
1318 dup 0= if exit then
1319 then
1320 drop
1321
1322 s" kernel" getenv dup -1 <> if
1323 to kernel
1324 else
1325 drop
1326 1 exit \ Failure
1327 then
1328
1329 \ Try all default kernel names
1330 flags kernel args try_multiple_kernels
1331;
1332
1333\ Try to load a kernel; the kernel name is taken from one of
1334\ the following lists, as ordered:
1335\
1336\ 1. The "bootfile" environment variable
1337\ 2. The "kernel" environment variable
1338\
--- 35 unchanged lines hidden (view full) ---
1374
1375 0
1376 bootpath strcat
1377 path strcat
1378 2dup to newmodulepath
1379 modulepath setenv
1380
1381 \ Try all default kernel names
1382 flags args load_a_kernel
1383 0= if ( success )
1384 oldmodulepath nip -1 <> if
1385 newmodulepath s" ;" strcat
1386 oldmodulepath strcat
1387 modulepath setenv
1388 newmodulepath drop free-memory
1389 oldmodulepath drop free-memory
1390 then
1391 0 exit
1392 then
1393
1394 \ Well, try without the prepended /boot/
1395 path newmodulepath drop swap move
1396 path nip
1397 2dup to newmodulepath
1398 modulepath setenv
1399
1400 \ Try all default kernel names
1401 flags args load_a_kernel
1402 if ( failed once more )
1403 oldmodulepath restoreenv
1404 newmodulepath drop free-memory
1405 1
1406 else
1407 oldmodulepath nip -1 <> if
1408 newmodulepath s" ;" strcat
1409 oldmodulepath strcat
--- 39 unchanged lines hidden (view full) ---
1449 dup 0= if exit else drop then
1450
1451 \ Next, assume path points to the kernel
1452 flags path args try_multiple_kernels
1453;
1454
1455: load_kernel_and_modules ( flags len path len' 2 | path len' 1 -- flag )
1456 load_directory_or_file
1457 0= if ['] load_modules catch then
1458;
1459
1460: initialize ( addr len -- )
1461 strdup conf_files .len ! conf_files .addr !
1462;
1463
1464: kernel_options ( -- addr len 2 | 0 0 1 )
1465 s" kernel_options" getenv
1466 dup -1 = if 0 0 1 else 2 then
1467;
1468
1469: kernel_and_options
1470 kernel_options
1471 s" kernel" getenv
1472 rot
1473;
1474
1475: load_kernel ( -- ) ( throws: abort )
1476 s" kernel" getenv
1477 dup -1 = if
1478 \ If unset, try any kernel
1479 drop
1480 kernel_options load_a_kernel
1481 else
1482 \ If set, try first directory, next file name
1483 kernel_options >r 2swap r> clip_args load_from_directory
1484 dup if
1485 drop
1486 kernel_and_options try_multiple_kernels
1487 then
1488 then
1489 abort" Unable to load a kernel!"
1490;
1491
1492: read-password { size | buf len -- }
1493 size allocate if out_of_memory throw then
1494 to buf
1495 0 to len
1496 begin
1497 key
1498 dup backspace = if
1499 drop
--- 23 unchanged lines hidden ---
2\ All rights reserved.
3\
4\ Redistribution and use in source and binary forms, with or without
5\ modification, are permitted provided that the following conditions
6\ are met:
7\ 1. Redistributions of source code must retain the above copyright
8\ notice, this list of conditions and the following disclaimer.
--- 8 unchanged lines hidden (view full) ---
17\ FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
18\ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
19\ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
20\ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
21\ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
22\ OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
23\ SUCH DAMAGE.
24\
25\ $FreeBSD: head/sys/boot/forth/support.4th 65641 2000-09-09 18:20:00Z dcs $
26
27\ Loader.rc support functions:
28\
29\ initialize_support ( -- ) initialize global variables
30\ initialize ( addr len -- ) as above, plus load_conf_files
31\ load_conf ( addr len -- ) load conf file given
32\ include_conf_files ( -- ) load all conf files in load_conf_files
33\ print_syntax_error ( -- ) print line and marker of where a syntax
--- 194 unchanged lines hidden (view full) ---
228 [char] ' parse
229 state @ if
230 postpone sliteral
231 then
232; immediate
233
234: 2>r postpone >r postpone >r ; immediate
235: 2r> postpone r> postpone r> ; immediate
236
237\ Private definitions
238
239vocabulary support-functions
240only forth also support-functions definitions
241
242\ Some control characters constants
243
--- 1050 unchanged lines hidden (view full) ---
1294;
1295
1296\ Try to load a kernel; the kernel name is taken from one of
1297\ the following lists, as ordered:
1298\
1299\ 1. The "bootfile" environment variable
1300\ 2. The "kernel" environment variable
1301\
1302\ Flags are passed, if available. The parameter args must be 2
1303\ if flags are being passed, or 1 if they should be ignored.
1304\ Dummy flags and len must be passed in the latter case.
1305\
1306\ The kernel gets loaded from the current module_path.
1307
1308: load_a_kernel ( flags len args -- flag )
1309 local args
1310 2local flags
1311 0 0 2local kernel
1312 end-locals
1313
1314 \ Check if a default kernel name exists at all, exits if not
1315 s" bootfile" getenv dup -1 <> if
1316 to kernel
1317 flags kernel args try_multiple_kernels
1318 dup 0= if exit then
1319 then
1320 drop
1321
1322 s" kernel" getenv dup -1 <> if
1323 to kernel
1324 else
1325 drop
1326 1 exit \ Failure
1327 then
1328
1329 \ Try all default kernel names
1330 flags kernel args try_multiple_kernels
1331;
1332
1333\ Try to load a kernel; the kernel name is taken from one of
1334\ the following lists, as ordered:
1335\
1336\ 1. The "bootfile" environment variable
1337\ 2. The "kernel" environment variable
1338\
--- 35 unchanged lines hidden (view full) ---
1374
1375 0
1376 bootpath strcat
1377 path strcat
1378 2dup to newmodulepath
1379 modulepath setenv
1380
1381 \ Try all default kernel names
1382 flags args load_a_kernel
1383 0= if ( success )
1384 oldmodulepath nip -1 <> if
1385 newmodulepath s" ;" strcat
1386 oldmodulepath strcat
1387 modulepath setenv
1388 newmodulepath drop free-memory
1389 oldmodulepath drop free-memory
1390 then
1391 0 exit
1392 then
1393
1394 \ Well, try without the prepended /boot/
1395 path newmodulepath drop swap move
1396 path nip
1397 2dup to newmodulepath
1398 modulepath setenv
1399
1400 \ Try all default kernel names
1401 flags args load_a_kernel
1402 if ( failed once more )
1403 oldmodulepath restoreenv
1404 newmodulepath drop free-memory
1405 1
1406 else
1407 oldmodulepath nip -1 <> if
1408 newmodulepath s" ;" strcat
1409 oldmodulepath strcat
--- 39 unchanged lines hidden (view full) ---
1449 dup 0= if exit else drop then
1450
1451 \ Next, assume path points to the kernel
1452 flags path args try_multiple_kernels
1453;
1454
1455: load_kernel_and_modules ( flags len path len' 2 | path len' 1 -- flag )
1456 load_directory_or_file
1457 0= if ['] load_modules catch then
1458;
1459
1460: initialize ( addr len -- )
1461 strdup conf_files .len ! conf_files .addr !
1462;
1463
1464: kernel_options ( -- addr len 2 | 0 0 1 )
1465 s" kernel_options" getenv
1466 dup -1 = if 0 0 1 else 2 then
1467;
1468
1469: kernel_and_options
1470 kernel_options
1471 s" kernel" getenv
1472 rot
1473;
1474
1475: load_kernel ( -- ) ( throws: abort )
1476 s" kernel" getenv
1477 dup -1 = if
1478 \ If unset, try any kernel
1479 drop
1480 kernel_options load_a_kernel
1481 else
1482 \ If set, try first directory, next file name
1483 kernel_options >r 2swap r> clip_args load_from_directory
1484 dup if
1485 drop
1486 kernel_and_options try_multiple_kernels
1487 then
1488 then
1489 abort" Unable to load a kernel!"
1490;
1491
1492: read-password { size | buf len -- }
1493 size allocate if out_of_memory throw then
1494 to buf
1495 0 to len
1496 begin
1497 key
1498 dup backspace = if
1499 drop
--- 23 unchanged lines hidden ---