Annotation of qemu/roms/SLOF/slof/fs/sms/sms-nvram.fs, revision 1.1

1.1     ! root        1: \ *****************************************************************************
        !             2: \ * Copyright (c) 2004, 2008 IBM Corporation
        !             3: \ * All rights reserved.
        !             4: \ * This program and the accompanying materials
        !             5: \ * are made available under the terms of the BSD License
        !             6: \ * which accompanies this distribution, and is available at
        !             7: \ * http://www.opensource.org/licenses/bsd-license.php
        !             8: \ *
        !             9: \ * Contributors:
        !            10: \ *     IBM Corporation - initial implementation
        !            11: \ ****************************************************************************/
        !            12: 
        !            13: \ Initialize SMS NVRAM handling.
        !            14: 
        !            15: : sms-init-nvram ( -- )
        !            16:    nvram-partition-type-sms get-nvram-partition IF
        !            17:       cr ." Could not find SMS partition in NVRAM - "
        !            18:       nvram-partition-type-sms s" SMS" d# 1024 new-nvram-partition
        !            19:       ABORT" Failed to create SMS NVRAM partition"
        !            20:       2dup erase-nvram-partition drop
        !            21: 
        !            22:       2dup s" lang"                      s" 1" internal-set-env drop
        !            23: 
        !            24:       2dup s" tftp-retries"              s" 5" internal-set-env drop
        !            25:       2dup s" tftp-blocksize"          s" 512" internal-set-env drop
        !            26:       2dup s" bootp-retries"           s" 255" internal-set-env drop
        !            27:       2dup s" client"      s" 000.000.000.000" internal-set-env drop
        !            28:       2dup s" server"       s" 000.000.000.000" internal-set-env drop
        !            29:       2dup s" gateway"      s" 000.000.000.000" internal-set-env drop
        !            30:       2dup s" netmask"      s" 255.255.255.000" internal-set-env drop
        !            31:       2dup s" net-protocol"              s" 0" internal-set-env drop
        !            32:       2dup s" net-flags"                 s" 0" internal-set-env drop
        !            33:       2dup s" net-device"                s" 0" internal-set-env drop
        !            34:       2dup s" net-client-name"            s" " internal-set-env drop
        !            35: 
        !            36:       2dup s" scsi-spinup"               s" 6" internal-set-env drop
        !            37:       2dup s" scsi-id-0"                 s" 7" internal-set-env drop
        !            38:       2dup s" scsi-id-1"                 s" 7" internal-set-env drop
        !            39:       2dup s" scsi-id-2"                 s" 7" internal-set-env drop
        !            40:       2dup s" scsi-id-3"                 s" 7" internal-set-env drop
        !            41:       ." created" cr
        !            42:    THEN
        !            43:    s" sms-nvram-partition" $2constant
        !            44: ;
        !            45: 
        !            46: sms-init-nvram
        !            47: 
        !            48: : sms-add-env ( "name" "value" -- ) sms-nvram-partition 2rot 2rot internal-add-env drop ;
        !            49: : sms-set-env ( "name" "value" -- ) sms-nvram-partition 2rot 2rot internal-set-env drop ;
        !            50: : sms-get-env ( "name" -- "value" TRUE | FALSE) sms-nvram-partition 2swap internal-get-env ;
        !            51: 
        !            52: : sms-get-net-device ( -- n )  s" net-device" sms-get-env IF $dnumber IF 0 THEN ELSE 0 THEN ;
        !            53: : sms-set-net-device ( n -- )  (.d) s" net-device" 2swap sms-set-env ;
        !            54: 
        !            55: : sms-get-net-flags ( -- n )   s" net-flags" sms-get-env IF $dnumber IF 0 THEN ELSE 0 THEN ;
        !            56: : sms-set-net-flags ( n -- )   (.d) s" net-flags" 2swap sms-set-env ;
        !            57: 
        !            58: : sms-get-net-protocol ( -- n )        s" net-protocol" sms-get-env IF $dnumber IF 0 THEN ELSE 0 THEN ;
        !            59: : sms-set-net-protocol ( n -- )        (.d) s" net-protocol" 2swap sms-set-env ;
        !            60: 
        !            61: : sms-get-lang ( -- n )        s" lang" sms-get-env IF $dnumber IF 1 THEN ELSE 1 THEN ;
        !            62: : sms-set-lang ( n -- )        (.d) s" lang" 2swap sms-set-env ;
        !            63: 
        !            64: : sms-get-bootp-retries ( -- n ) s" bootp-retries" sms-get-env IF $dnumber IF 255 THEN ELSE 255 THEN ;
        !            65: : sms-set-bootp-retries ( n -- ) (.d) s" bootp-retries" 2swap sms-set-env ;
        !            66: 
        !            67: : sms-get-tftp-retries ( -- n )        s" tftp-retries" sms-get-env IF $dnumber IF 5 THEN ELSE 5 THEN ;
        !            68: : sms-set-tftp-retries ( n -- ) (.d) s" tftp-retries" 2swap sms-set-env ;
        !            69: 
        !            70: : sms-get-tftp-blocksize ( -- n ) s" tftp-blocksize" sms-get-env IF $dnumber IF 5 THEN ELSE 5 THEN ;
        !            71: : sms-set-tftp-blocksize ( n -- ) (.d) s" tftp-blocksize" 2swap sms-set-env ;
        !            72: 
        !            73: : sms-get-client ( -- FALSE | n1 n2 n3 n4 TRUE ) s" client" sms-get-env IF (ipaddr) ELSE false THEN ;
        !            74: : sms-set-client ( n1 n2 n3 n4 -- ) (ipformat) s" client" 2swap sms-set-env ;
        !            75: 
        !            76: : sms-get-server ( -- FALSE | n1 n2 n3 n4 TRUE ) s" server" sms-get-env IF (ipaddr) ELSE false THEN ;
        !            77: : sms-set-server ( n1 n2 n3 n4 -- ) (ipformat) s" server" 2swap sms-set-env ;
        !            78: 
        !            79: : sms-get-gateway ( -- FALSE | n1 n2 n3 n4 TRUE ) s" gateway" sms-get-env IF (ipaddr) ELSE false THEN ;
        !            80: : sms-set-gateway ( n1 n2 n3 n4 -- ) (ipformat) s" gateway" 2swap sms-set-env ;
        !            81: 
        !            82: : sms-get-subnet ( -- FALSE | n1 n2 n3 n4 TRUE ) s" netmask" sms-get-env IF (ipaddr) ELSE false THEN ;
        !            83: : sms-set-subnet ( n1 n2 n3 n4 -- ) (ipformat) s" netmask" 2swap sms-set-env ;
        !            84: 
        !            85: : sms-get-client-name ( -- FALSE | addr len TRUE ) s" net-client-name" sms-get-env ;
        !            86: : sms-set-client-name ( addr len -- ) s" net-client-name" 2swap sms-set-env ;
        !            87: 
        !            88: : sms-get-scsi-spinup ( -- n ) s" scsi-spinup" sms-get-env IF $dnumber IF 6 THEN ELSE 6 THEN ;
        !            89: : sms-set-scsi-spinup ( n -- ) (.d) s" scsi-spinup" 2swap sms-set-env ;
        !            90: 
        !            91: : sms-get-scsi-id ( n -- id )  s" scsi-id-" rot (.) $cat sms-get-env IF $dnumber IF 6 THEN ELSE 6 THEN ;
        !            92: : sms-set-scsi-id ( id n -- ) swap (.d) rot s" scsi-id-" rot (.) $cat sms-set-env ;
        !            93: 
        !            94: 
        !            95: \ generates the boot-file part of the boot string
        !            96: 
        !            97: : sms-get-net-boot-file ( -- addr len )
        !            98:    \ the format is
        !            99:    \ :[bootp,]siaddr,filename,ciaddr,giaddr,bootp-retries,tftp-retries
        !           100:    \ we choose dhcp as a default!
        !           101:    s" net" sms-get-net-device (.) $cat
        !           102:    s" :dhcp," $cat
        !           103:    sms-get-server IF (ipformat) $cat THEN
        !           104:    s" ," $cat
        !           105:    sms-get-client-name IF $cat THEN
        !           106:    s" ," $cat
        !           107:    sms-get-client IF (ipformat) $cat THEN
        !           108:    s" ," $cat
        !           109:    sms-get-gateway IF (ipformat) $cat THEN
        !           110:    s" ," $cat
        !           111:    \ If the number of retries is 255 (max), assume default timeout (10min)
        !           112:    sms-get-bootp-retries dup ff <> IF (.) $cat ELSE drop THEN
        !           113:    s" ," $cat
        !           114:    sms-get-tftp-retries (.) $cat
        !           115:    \ now write the string to the boot path
        !           116:    dup IF
        !           117:       \ This could be considered a memory leak, but it is only
        !           118:       \ executed once for booting so it is not a problem
        !           119:       strdup ( s" :" 2swap $cat strdup )
        !           120:    THEN
        !           121: ;
        !           122: 
        !           123: ' sms-get-net-boot-file to furnish-boot-file
        !           124: 

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.