| support.4th (65641) | support.4th (65883) |
|---|---|
| 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\ | 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 $ | 25\ $FreeBSD: head/sys/boot/forth/support.4th 65883 2000-09-15 08:05:52Z 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 | 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: 2r@ postpone 2r> postpone 2dup postpone 2>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\ | 237 238\ Private definitions 239 240vocabulary support-functions 241only forth also support-functions definitions 242 243\ Some control characters constants 244 --- 1050 unchanged lines hidden (view full) --- 1295; 1296 1297\ Try to load a kernel; the kernel name is taken from one of 1298\ the following lists, as ordered: 1299\ 1300\ 1. The "bootfile" environment variable 1301\ 2. The "kernel" environment variable 1302\ |
| 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. | 1303\ Flags are passed, if available. |
| 1305\ 1306\ The kernel gets loaded from the current module_path. 1307 | 1304\ 1305\ The kernel gets loaded from the current module_path. 1306 |
| 1308: load_a_kernel ( flags len args -- flag ) | 1307: load_a_kernel ( flags len 1 | 0 -- flag ) |
| 1309 local args | 1308 local args |
| 1309 args 0= if 0 0 then |
|
| 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 | 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 | 1317 flags kernel args 1+ 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 | 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 | 1330 flags kernel args 1+ 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 | 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 | 1382 args 2 = if flags 1 else 0 then 1383 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 | 1384 0= if ( success ) 1385 oldmodulepath nip -1 <> if 1386 newmodulepath s" ;" strcat 1387 oldmodulepath strcat 1388 modulepath setenv 1389 newmodulepath drop free-memory 1390 oldmodulepath drop free-memory 1391 then 1392 0 exit 1393 then 1394 1395 \ Well, try without the prepended /boot/ 1396 path newmodulepath drop swap move |
| 1396 path nip | 1397 newmodulepath drop path nip |
| 1397 2dup to newmodulepath 1398 modulepath setenv 1399 1400 \ Try all default kernel names | 1398 2dup to newmodulepath 1399 modulepath setenv 1400 1401 \ Try all default kernel names |
| 1401 flags args load_a_kernel | 1402 args 2 = if flags 1 else 0 then 1403 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 | 1404 if ( failed once more ) 1405 oldmodulepath restoreenv 1406 newmodulepath drop free-memory 1407 1 1408 else 1409 oldmodulepath nip -1 <> if 1410 newmodulepath s" ;" strcat 1411 oldmodulepath strcat --- 39 unchanged lines hidden (view full) --- 1451 dup 0= if exit else drop then 1452 1453 \ Next, assume path points to the kernel 1454 flags path args try_multiple_kernels 1455; 1456 1457: load_kernel_and_modules ( flags len path len' 2 | path len' 1 -- flag ) 1458 load_directory_or_file |
| 1457 0= if ['] load_modules catch then | 1459 ?dup 0= if ['] load_modules catch then |
| 1458; 1459 1460: initialize ( addr len -- ) 1461 strdup conf_files .len ! conf_files .addr ! 1462; 1463 | 1460; 1461 1462: initialize ( addr len -- ) 1463 strdup conf_files .len ! conf_files .addr ! 1464; 1465 |
| 1464: kernel_options ( -- addr len 2 | 0 0 1 ) | 1466: kernel_options ( -- addr len 1 | 0 ) |
| 1465 s" kernel_options" getenv | 1467 s" kernel_options" getenv |
| 1466 dup -1 = if 0 0 1 else 2 then | 1468 dup -1 = if drop 0 else 1 then |
| 1467; 1468 | 1469; 1470 |
| 1469: kernel_and_options | 1471: kernel_and_options ( a u 1 | 0 -- a u a' u' 2 | a' u' 1 ) |
| 1470 kernel_options 1471 s" kernel" getenv | 1472 kernel_options 1473 s" kernel" getenv |
| 1472 rot | 1474 rot 1+ |
| 1473; 1474 1475: load_kernel ( -- ) ( throws: abort ) 1476 s" kernel" getenv | 1475; 1476 1477: load_kernel ( -- ) ( throws: abort ) 1478 s" kernel" getenv |
| 1477 dup -1 = if 1478 \ If unset, try any kernel | 1479 dup -1 = if ( there isn't a "kernel" environment variable, try bootfile ) |
| 1479 drop 1480 kernel_options load_a_kernel | 1480 drop 1481 kernel_options load_a_kernel |
| 1481 else 1482 \ If set, try first directory, next file name | 1482 else ( try finding a kernel using ${kernel} in various ways ) |
| 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; | 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 | 1491 1492: set-defaultoptions ( -- ) 1493 s" kernel_options" getenv dup -1 = if 1494 drop 1495 else 1496 s" temp_options" setenv 1497 then 1498; 1499 1500: argv[] ( aN uN ... a1 u1 N i -- aN uN ... a1 u1 N ai+1 ui+1 ) 1501 2dup = if 0 0 exit then 1502 dup >r 1503 1+ 2* ( skip N and ui ) 1504 pick 1505 r> 1506 1+ 2* ( skip N and ai ) 1507 pick 1508; 1509 1510: drop-args ( aN uN ... a1 u1 N -- ) 1511 0 ?do 2drop loop 1512; 1513 1514: argc 1515 dup 1516; 1517 1518: queue-argv ( aN uN ... a1 u1 N a u -- a u aN uN ... a1 u1 N+1 ) 1519 >r 1520 over 2* 1+ -roll 1521 r> 1522 over 2* 1+ -roll 1523 1+ 1524; 1525 1526: unqueue-argv ( aN uN ... a1 u1 N -- aN uN ... a2 u2 N-1 a1 u1 ) 1527 1- -rot 1528; 1529 1530: strlen(argv) 1531 dup 0= if 0 exit then 1532 0 >r \ Size 1533 0 >r \ Index 1534 begin 1535 argc r@ <> 1536 while 1537 r@ argv[] 1538 nip 1539 r> r> rot + 1+ 1540 >r 1+ >r 1541 repeat 1542 r> drop 1543 r> 1544; 1545 1546: concat-argv ( aN uN ... a1 u1 N -- a u ) 1547 strlen(argv) allocate if out_of_memory throw then 1548 0 2>r 1549 1550 begin 1551 argc 1552 while 1553 unqueue-argv 1554 2r> 2swap 1555 strcat 1556 s" " strcat 1557 2>r 1558 repeat 1559 drop-args 1560 2r> 1561; 1562 1563: set-tempoptions ( addrN lenN ... addr1 len1 N -- addr len 1 | 0 ) 1564 \ Save the first argument, if it exists and is not a flag 1565 argc if 1566 0 argv[] drop c@ [char] - <> if 1567 unqueue-argv 2>r \ Filename 1568 1 >r \ Filename present 1569 else 1570 0 >r \ Filename not present 1571 then 1572 else 1573 0 >r \ Filename not present 1574 then 1575 1576 \ If there are other arguments, assume they are flags 1577 ?dup if 1578 concat-argv 1579 2dup s" temp_options" setenv 1580 drop free if free_error throw then 1581 else 1582 set-defaultoptions 1583 then 1584 1585 \ Bring back the filename, if one was provided 1586 r> if 2r> 1 else 0 then 1587; 1588 1589: get-arguments ( -- addrN lenN ... addr1 len1 N ) 1590 0 1591 begin 1592 \ Get next word on the command line 1593 parse-word 1594 ?dup while 1595 queue-argv 1596 repeat 1597 drop ( empty string ) 1598; 1599 1600: load-conf ( args -- flag ) 1601 set-tempoptions 1602 argc >r 1603 s" temp_options" getenv dup -1 <> if 1604 queue-argv 1605 else 1606 drop 1607 then 1608 r> if ( a path was passed ) 1609 load_kernel_and_modules 1610 else 1611 load_a_kernel 1612 ?dup 0= if ['] load_modules catch then 1613 then 1614; 1615 |
| 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 --- | 1616: read-password { size | buf len -- } 1617 size allocate if out_of_memory throw then 1618 to buf 1619 0 to len 1620 begin 1621 key 1622 dup backspace = if 1623 drop --- 23 unchanged lines hidden --- |